src/HOL/NanoJava/State.thy
changeset 11565 ab004c0ecc63
parent 11558 6539627881e8
child 11772 cf618fe8facd
equal deleted inserted replaced
11564:7b87c95fdf3b 11565:ab004c0ecc63
    11 constdefs
    11 constdefs
    12 
    12 
    13   body :: "cname \<times> mname => stmt"
    13   body :: "cname \<times> mname => stmt"
    14  "body \<equiv> \<lambda>(C,m). bdy (the (method C m))"
    14  "body \<equiv> \<lambda>(C,m). bdy (the (method C m))"
    15 
    15 
    16 text {* locations, i.e.\ abstract references to objects *}
    16 text {* Locations, i.e.\ abstract references to objects *}
    17 typedecl loc 
    17 typedecl loc 
    18 
    18 
    19 datatype val
    19 datatype val
    20   = Null        --{* null reference *}
    20   = Null        --{* null reference *}
    21   | Addr loc    --{* address, i.e. location of object *}
    21   | Addr loc    --{* address, i.e. location of object *}
    33 constdefs
    33 constdefs
    34 
    34 
    35   init_vars:: "('a \<leadsto> 'b) => ('a \<leadsto> val)"
    35   init_vars:: "('a \<leadsto> 'b) => ('a \<leadsto> val)"
    36  "init_vars m == option_map (\<lambda>T. Null) o m"
    36  "init_vars m == option_map (\<lambda>T. Null) o m"
    37   
    37   
    38 text {* private *}
    38 text {* private: *}
    39 types	heap   = "loc   \<leadsto> obj"
    39 types	heap   = "loc   \<leadsto> obj"
    40         locals = "vname \<leadsto> val"	
    40         locals = "vname \<leadsto> val"	
    41 
    41 
    42 text {* private *}
    42 text {* private: *}
    43 record  state
    43 record  state
    44 	= heap   :: heap
    44 	= heap   :: heap
    45           locals :: locals
    45           locals :: locals
    46 
    46 
    47 translations
    47 translations
    54 
    54 
    55   reset_locs     :: "state => state"
    55   reset_locs     :: "state => state"
    56  "reset_locs s \<equiv> s (| locals := empty |)"
    56  "reset_locs s \<equiv> s (| locals := empty |)"
    57 
    57 
    58   init_locs     :: "cname => mname => state => state"
    58   init_locs     :: "cname => mname => state => state"
    59  "init_locs C m s \<equiv> s (| locals:=init_vars (map_of (lcl (the (method C m)))) |)"
    59  "init_locs C m s \<equiv> s (| locals := locals s ++ 
       
    60                          init_vars (map_of (lcl (the (method C m)))) |)"
    60 
    61 
    61 text {* The first parameter of @{term set_locs} is of type @{typ state} 
    62 text {* The first parameter of @{term set_locs} is of type @{typ state} 
    62         rather than @{typ locals} in order to keep @{typ locals} private.*}
    63         rather than @{typ locals} in order to keep @{typ locals} private.*}
    63 constdefs
    64 constdefs
    64   set_locs  :: "state => state => state"
    65   set_locs  :: "state => state => state"
    97  "upd_obj a f v s \<equiv> let (C,fs) = the (heap s a) in hupd(a\<mapsto>(C,fs(f\<mapsto>v))) s"
    98  "upd_obj a f v s \<equiv> let (C,fs) = the (heap s a) in hupd(a\<mapsto>(C,fs(f\<mapsto>v))) s"
    98 
    99 
    99   new_Addr	:: "state => val"
   100   new_Addr	:: "state => val"
   100  "new_Addr s == SOME v. (\<exists>a. v = Addr a \<and> (heap s) a = None) | v = Null"
   101  "new_Addr s == SOME v. (\<exists>a. v = Addr a \<and> (heap s) a = None) | v = Null"
   101 
   102 
       
   103 
       
   104 subsection "Properties not used in the meta theory"
       
   105 
       
   106 lemma locals_upd_id [simp]: "s\<lparr>locals := locals s\<rparr> = s" 
       
   107 by simp
       
   108 
       
   109 lemma lupd_get_local_same [simp]: "lupd(x\<mapsto>v) s<x> = v"
       
   110 by (simp add: lupd_def get_local_def)
       
   111 
       
   112 lemma lupd_get_local_other [simp]: "x \<noteq> y \<Longrightarrow> lupd(x\<mapsto>v) s<y> = s<y>"
       
   113 apply (drule not_sym)
       
   114 by (simp add: lupd_def get_local_def)
       
   115 
       
   116 lemma get_field_lupd [simp]:
       
   117   "get_field (lupd(x\<mapsto>y) s) a f = get_field s a f"
       
   118 by (simp add: lupd_def get_field_def get_obj_def)
       
   119 
       
   120 lemma get_field_set_locs [simp]:
       
   121   "get_field (set_locs l s) a f = get_field s a f"
       
   122 by (simp add: lupd_def get_field_def set_locs_def get_obj_def)
       
   123 
       
   124 lemma get_field_set_locs [simp]:
       
   125   "get_field (reset_locs s) a f = get_field s a f"
       
   126 by (simp add: lupd_def get_field_def reset_locs_def get_obj_def)
       
   127 
       
   128 lemma new_obj_get_local [simp]: "new_obj a C s <x> = s<x>"
       
   129 by (simp add: new_obj_def hupd_def get_local_def)
       
   130 
       
   131 lemma heap_lupd [simp]: "heap (lupd(x\<mapsto>y) s) = heap s"
       
   132 by (simp add: lupd_def)
       
   133 
       
   134 lemma heap_hupd_same [simp]: "heap (hupd(a\<mapsto>obj) s) a = Some obj"
       
   135 by (simp add: hupd_def)
       
   136 
       
   137 lemma heap_hupd_other [simp]: "aa \<noteq> a  \<Longrightarrow> heap (hupd(aa\<mapsto>obj) s) a = heap s a"
       
   138 apply (drule not_sym)
       
   139 by (simp add: hupd_def)
       
   140 
       
   141 lemma hupd_hupd [simp]: "hupd(a\<mapsto>obj) (hupd(a\<mapsto>obj') s) = hupd(a\<mapsto>obj) s"
       
   142 by (simp add: hupd_def)
       
   143 
       
   144 lemma heap_reset_locs [simp]: "heap (reset_locs s) = heap s"
       
   145 by (simp add: reset_locs_def)
       
   146 
       
   147 lemma heap_set_locs [simp]: "heap (set_locs l s) = heap s"
       
   148 by (simp add: set_locs_def)
       
   149 
       
   150 lemma hupd_lupd [simp]: 
       
   151   "hupd(a\<mapsto>obj) (lupd(x\<mapsto>y) s) = lupd(x\<mapsto>y) (hupd(a\<mapsto>obj) s)"
       
   152 by (simp add: hupd_def lupd_def)
       
   153 
       
   154 lemma hupd_reset_locs [simp]: 
       
   155   "hupd(a\<mapsto>obj) (reset_locs s) = reset_locs (hupd(a\<mapsto>obj) s)"
       
   156 by (simp add: hupd_def reset_locs_def)
       
   157 
       
   158 lemma new_obj_lupd [simp]: 
       
   159   "new_obj a C (lupd(x\<mapsto>y) s) = lupd(x\<mapsto>y) (new_obj a C s)"
       
   160 by (simp add: new_obj_def)
       
   161 
       
   162 lemma new_obj_reset_locs [simp]: 
       
   163   "new_obj a C (reset_locs s) = reset_locs (new_obj a C s)"
       
   164 by (simp add: new_obj_def)
       
   165 
       
   166 lemma upd_obj_lupd [simp]: 
       
   167   "upd_obj a f v (lupd(x\<mapsto>y) s) = lupd(x\<mapsto>y) (upd_obj a f v s)"
       
   168 by (simp add: upd_obj_def Let_def split_beta)
       
   169 
       
   170 lemma upd_obj_reset_locs [simp]: 
       
   171   "upd_obj a f v (reset_locs s) = reset_locs (upd_obj a f v s)"
       
   172 by (simp add: upd_obj_def Let_def split_beta)
       
   173 
       
   174 lemma get_field_hupd_same [simp]:
       
   175  "get_field (hupd(a\<mapsto>(C, fs)) s) a = the \<circ> fs"
       
   176 apply (rule ext)
       
   177 by (simp add: get_field_def get_obj_def)
       
   178 
       
   179 lemma get_field_hupd_other [simp]:
       
   180  "aa \<noteq> a  \<Longrightarrow> get_field (hupd(aa\<mapsto>obj) s) a = get_field s a"
       
   181 apply (rule ext)
       
   182 by (simp add: get_field_def get_obj_def)
       
   183 
   102 lemma new_AddrD: 
   184 lemma new_AddrD: 
   103 "new_Addr s = v \<Longrightarrow> (\<exists>a. v = Addr a \<and> heap s a = None) | v = Null"
   185 "new_Addr s = v \<Longrightarrow> (\<exists>a. v = Addr a \<and> heap s a = None) | v = Null"
   104 apply (unfold new_Addr_def)
   186 apply (unfold new_Addr_def)
   105 apply (erule subst)
   187 apply (erule subst)
   106 apply (rule someI)
   188 apply (rule someI)