src/HOL/MicroJava/Comp/TranslCompTp.thy
changeset 39758 b8a53e3a0ee2
parent 35417 47ee18b6ae32
child 60304 3f429b7d8eb5
equal deleted inserted replaced
39757:21423597a80d 39758:b8a53e3a0ee2
    43 
    43 
    44 abbreviation (input)
    44 abbreviation (input)
    45   sttp_of :: "method_type \<times> state_type \<Rightarrow> state_type"
    45   sttp_of :: "method_type \<times> state_type \<Rightarrow> state_type"
    46   where "sttp_of == snd"
    46   where "sttp_of == snd"
    47 
    47 
    48 consts
       
    49   compTpExpr  :: "java_mb \<Rightarrow> java_mb prog \<Rightarrow> expr
       
    50                    \<Rightarrow> state_type \<Rightarrow> method_type \<times> state_type"
       
    51 
       
    52   compTpExprs :: "java_mb \<Rightarrow> java_mb prog \<Rightarrow> expr list
       
    53                    \<Rightarrow> state_type \<Rightarrow> method_type \<times> state_type"
       
    54 
       
    55   compTpStmt  :: "java_mb \<Rightarrow> java_mb prog \<Rightarrow> stmt
       
    56                    \<Rightarrow> state_type \<Rightarrow> method_type \<times> state_type"
       
    57 
       
    58 definition nochangeST :: "state_type \<Rightarrow> method_type \<times> state_type" where
    48 definition nochangeST :: "state_type \<Rightarrow> method_type \<times> state_type" where
    59   "nochangeST sttp == ([Some sttp], sttp)"
    49   "nochangeST sttp == ([Some sttp], sttp)"
    60 
    50 
    61 definition pushST :: "[ty list, state_type] \<Rightarrow> method_type \<times> state_type" where
    51 definition pushST :: "[ty list, state_type] \<Rightarrow> method_type \<times> state_type" where
    62   "pushST tps == (\<lambda> (ST, LT). ([Some (ST, LT)], (tps @ ST, LT)))"
    52   "pushST tps == (\<lambda> (ST, LT). ([Some (ST, LT)], (tps @ ST, LT)))"
    78   "storeST i tp == (\<lambda> (ST, LT). ([Some (ST, LT)], (tl ST, LT [i:= OK tp])))"
    68   "storeST i tp == (\<lambda> (ST, LT). ([Some (ST, LT)], (tl ST, LT [i:= OK tp])))"
    79 
    69 
    80 
    70 
    81 (* Expressions *)
    71 (* Expressions *)
    82 
    72 
    83 primrec
    73 primrec compTpExpr :: "java_mb \<Rightarrow> java_mb prog \<Rightarrow> expr \<Rightarrow>
    84 
    74     state_type \<Rightarrow> method_type \<times> state_type"
       
    75   and compTpExprs :: "java_mb \<Rightarrow> java_mb prog \<Rightarrow> expr list \<Rightarrow>
       
    76     state_type \<Rightarrow> method_type \<times> state_type"
       
    77 where
    85   "compTpExpr jmb G (NewC c) = pushST [Class c]"
    78   "compTpExpr jmb G (NewC c) = pushST [Class c]"
    86 
    79 | "compTpExpr jmb G (Cast c e) = (compTpExpr jmb G e) \<box> (replST 1 (Class c))"
    87   "compTpExpr jmb G (Cast c e) = 
    80 | "compTpExpr jmb G (Lit val) = pushST [the (typeof (\<lambda>v. None) val)]"
    88   (compTpExpr jmb G e) \<box> (replST 1 (Class c))"
    81 | "compTpExpr jmb G (BinOp bo e1 e2) =
    89 
       
    90   "compTpExpr jmb G (Lit val) = pushST [the (typeof (\<lambda>v. None) val)]"
       
    91 
       
    92   "compTpExpr jmb G (BinOp bo e1 e2) = 
       
    93      (compTpExpr jmb G e1) \<box> (compTpExpr jmb G e2) \<box> 
    82      (compTpExpr jmb G e1) \<box> (compTpExpr jmb G e2) \<box> 
    94      (case bo of 
    83      (case bo of 
    95        Eq => popST 2 \<box> pushST [PrimT Boolean] \<box> popST 1 \<box> pushST [PrimT Boolean]
    84        Eq => popST 2 \<box> pushST [PrimT Boolean] \<box> popST 1 \<box> pushST [PrimT Boolean]
    96      | Add => replST 2 (PrimT Integer))"
    85      | Add => replST 2 (PrimT Integer))"
    97 
    86 | "compTpExpr jmb G (LAcc vn) = (\<lambda> (ST, LT). 
    98   "compTpExpr jmb G (LAcc vn) = (\<lambda> (ST, LT). 
       
    99       pushST [ok_val (LT ! (index jmb vn))] (ST, LT))"
    87       pushST [ok_val (LT ! (index jmb vn))] (ST, LT))"
   100 
    88 | "compTpExpr jmb G (vn::=e) = 
   101   "compTpExpr jmb G (vn::=e) = 
       
   102       (compTpExpr jmb G e) \<box> dupST \<box> (popST 1)"
    89       (compTpExpr jmb G e) \<box> dupST \<box> (popST 1)"
   103 
    90 | "compTpExpr jmb G ( {cn}e..fn ) = 
   104 
       
   105   "compTpExpr jmb G ( {cn}e..fn ) = 
       
   106       (compTpExpr jmb G e) \<box> replST 1 (snd (the (field (G,cn) fn)))"
    91       (compTpExpr jmb G e) \<box> replST 1 (snd (the (field (G,cn) fn)))"
   107 
    92 | "compTpExpr jmb G (FAss cn e1 fn e2 ) = 
   108   "compTpExpr jmb G (FAss cn e1 fn e2 ) = 
       
   109       (compTpExpr jmb G e1) \<box> (compTpExpr jmb G e2) \<box> dup_x1ST \<box> (popST 2)"
    93       (compTpExpr jmb G e1) \<box> (compTpExpr jmb G e2) \<box> dup_x1ST \<box> (popST 2)"
   110 
    94 | "compTpExpr jmb G ({C}a..mn({fpTs}ps)) =
   111 
       
   112   "compTpExpr jmb G ({C}a..mn({fpTs}ps)) =
       
   113        (compTpExpr jmb G a) \<box> (compTpExprs jmb G ps) \<box> 
    95        (compTpExpr jmb G a) \<box> (compTpExprs jmb G ps) \<box> 
   114        (replST ((length ps) + 1) (method_rT (the (method (G,C) (mn,fpTs)))))"
    96        (replST ((length ps) + 1) (method_rT (the (method (G,C) (mn,fpTs)))))"
   115 
    97 | "compTpExprs jmb G [] = comb_nil"
   116 
    98 | "compTpExprs jmb G (e#es) = (compTpExpr jmb G e) \<box> (compTpExprs jmb G es)"
   117 (* Expression lists *)
       
   118 
       
   119   "compTpExprs jmb G [] = comb_nil"
       
   120 
       
   121   "compTpExprs jmb G (e#es) = (compTpExpr jmb G e) \<box> (compTpExprs jmb G es)"
       
   122 
    99 
   123 
   100 
   124 (* Statements *)
   101 (* Statements *)
   125 primrec
   102 primrec compTpStmt :: "java_mb \<Rightarrow> java_mb prog \<Rightarrow> stmt \<Rightarrow> 
   126    "compTpStmt jmb G Skip = comb_nil"
   103     state_type \<Rightarrow> method_type \<times> state_type"
   127 
   104 where
   128    "compTpStmt jmb G (Expr e) =  (compTpExpr jmb G e) \<box> popST 1"
   105   "compTpStmt jmb G Skip = comb_nil"
   129 
   106 | "compTpStmt jmb G (Expr e) =  (compTpExpr jmb G e) \<box> popST 1"
   130    "compTpStmt jmb G (c1;; c2) = (compTpStmt jmb G c1) \<box> (compTpStmt jmb G c2)"
   107 | "compTpStmt jmb G (c1;; c2) = (compTpStmt jmb G c1) \<box> (compTpStmt jmb G c2)"
   131 
   108 | "compTpStmt jmb G (If(e) c1 Else c2) = 
   132    "compTpStmt jmb G (If(e) c1 Else c2) = 
       
   133       (pushST [PrimT Boolean]) \<box> (compTpExpr jmb G e) \<box> popST 2 \<box>
   109       (pushST [PrimT Boolean]) \<box> (compTpExpr jmb G e) \<box> popST 2 \<box>
   134       (compTpStmt jmb G c1) \<box> nochangeST \<box> (compTpStmt jmb G c2)"
   110       (compTpStmt jmb G c1) \<box> nochangeST \<box> (compTpStmt jmb G c2)"
   135 
   111 | "compTpStmt jmb G (While(e) c) = 
   136    "compTpStmt jmb G (While(e) c) = 
       
   137       (pushST [PrimT Boolean]) \<box> (compTpExpr jmb G e) \<box> popST 2 \<box>
   112       (pushST [PrimT Boolean]) \<box> (compTpExpr jmb G e) \<box> popST 2 \<box>
   138       (compTpStmt jmb G c) \<box> nochangeST"
   113       (compTpStmt jmb G c) \<box> nochangeST"
   139 
   114 
   140 definition compTpInit :: "java_mb \<Rightarrow> (vname * ty)
   115 definition compTpInit :: "java_mb \<Rightarrow> (vname * ty)
   141                    \<Rightarrow> state_type \<Rightarrow> method_type \<times> state_type" where
   116                    \<Rightarrow> state_type \<Rightarrow> method_type \<times> state_type" where
   142   "compTpInit jmb == (\<lambda> (vn,ty). (pushST [ty]) \<box>  (storeST (index jmb vn) ty))"
   117   "compTpInit jmb == (\<lambda> (vn,ty). (pushST [ty]) \<box>  (storeST (index jmb vn) ty))"
   143 
   118 
   144 consts
   119 primrec compTpInitLvars :: "[java_mb, (vname \<times> ty) list] \<Rightarrow>
   145   compTpInitLvars :: "[java_mb, (vname \<times> ty) list] 
   120     state_type \<Rightarrow> method_type \<times> state_type"
   146                    \<Rightarrow> state_type \<Rightarrow> method_type \<times> state_type"
   121 where
   147 
       
   148 primrec 
       
   149   "compTpInitLvars jmb [] = comb_nil"
   122   "compTpInitLvars jmb [] = comb_nil"
   150   "compTpInitLvars jmb (lv#lvars) = (compTpInit jmb lv) \<box> (compTpInitLvars jmb lvars)"
   123 | "compTpInitLvars jmb (lv#lvars) = (compTpInit jmb lv) \<box> (compTpInitLvars jmb lvars)"
   151 
   124 
   152 definition start_ST :: "opstack_type" where
   125 definition start_ST :: "opstack_type" where
   153   "start_ST == []"
   126   "start_ST == []"
   154 
   127 
   155 definition start_LT :: "cname \<Rightarrow> ty list \<Rightarrow> nat \<Rightarrow> locvars_type" where
   128 definition start_LT :: "cname \<Rightarrow> ty list \<Rightarrow> nat \<Rightarrow> locvars_type" where