Theory State (Isabelle2005: October 2005)

# Theory State

Up to index of Isabelle/HOL/NanoJava

theory State
imports TypeRel
begin

    (*  Title:      HOL/NanoJava/State.thy
        ID:         $Id: State.thy,v 1.10 2005/06/17 14:13:09 haftmann Exp $
        Author:     David von Oheimb
        Copyright   2001 Technische Universitaet Muenchen
    *)

    header "Program State"

    theory State imports TypeRel begin

    constdefs

      body :: "cname × mname => stmt"
     "body ≡ λ(C,m). bdy (the (method C m))"

    text {* Locations, i.e.\ abstract references to objects *}
    typedecl loc

    datatype val
      = Null        --{* null reference *}
      | Addr loc    --{* address, i.e. location of object *}

    types   fields
            = "(fname \<rightharpoonup> val)"

            obj = "cname × fields"

    translations

      "fields" \<leftharpoondown> (type)"fname => val option"
      "obj"    \<leftharpoondown> (type)"cname × fields"

    constdefs

      init_vars:: "('a \<rightharpoonup> 'b) => ('a \<rightharpoonup> val)"
     "init_vars m == option_map (λT. Null) o m"

    text {* private: *}
    types   heap   = "loc   \<rightharpoonup> obj"
            locals = "vname \<rightharpoonup> val"

    text {* private: *}
    record  state
            = heap   :: heap
              locals :: locals

    translations

      "heap"   \<leftharpoondown> (type)"loc   => obj option"
      "locals" \<leftharpoondown> (type)"vname => val option"
      "state" \<leftharpoondown> (type)"(|heap :: heap, locals :: locals|)"

    constdefs

      del_locs     :: "state => state"
     "del_locs s ≡ s (| locals := empty |)"

      init_locs     :: "cname => mname => state => state"
     "init_locs C m s ≡ s (| locals := locals s ++
                             init_vars (map_of (lcl (the (method C m)))) |)"

    text {* The first parameter of @{term set_locs} is of type @{typ state}
            rather than @{typ locals} in order to keep @{typ locals} private.*}
    constdefs
      set_locs  :: "state => state => state"
     "set_locs s s' ≡ s' (| locals := locals s |)"

      get_local     :: "state => vname => val" ("_<_>" [99,0] 99)
     "get_local s x  ≡ the (locals s x)"

    --{* local function: *}
      get_obj       :: "state => loc => obj"
     "get_obj s a ≡ the (heap s a)"

      obj_class     :: "state => loc => cname"
     "obj_class s a ≡ fst (get_obj s a)"

      get_field     :: "state => loc => fname => val"
     "get_field s a f ≡ the (snd (get_obj s a) f)"

    --{* local function: *}
      hupd       :: "loc => obj => state => state"   ("hupd'(_|->_')" [10,10] 1000)
     "hupd a obj s ≡ s (| heap   := ((heap   s)(a\<mapsto>obj))|)"

      lupd       :: "vname => val => state => state" ("lupd'(_|->_')" [10,10] 1000)
     "lupd x v s   ≡ s (| locals := ((locals s)(x\<mapsto>v  ))|)"

    syntax (xsymbols)
      hupd       :: "loc => obj => state => state"   ("hupd'(_\<mapsto>_')" [10,10] 1000)
      lupd       :: "vname => val => state => state" ("lupd'(_\<mapsto>_')" [10,10] 1000)

    constdefs

      new_obj    :: "loc => cname => state => state"
     "new_obj a C   ≡ hupd(a\<mapsto>(C,init_vars (field C)))"

      upd_obj    :: "loc => fname => val => state => state"
     "upd_obj a f v s ≡ let (C,fs) = the (heap s a) in hupd(a\<mapsto>(C,fs(f\<mapsto>v))) s"

      new_Addr      :: "state => val"
     "new_Addr s == SOME v. (∃a. v = Addr a ∧ (heap s) a = None) | v = Null"

    subsection "Properties not used in the meta theory"

    lemma locals_upd_id [simp]: "s(|locals := locals s|)), = s"
    by simp

    lemma lupd_get_local_same [simp]: "lupd(x\<mapsto>v) s<x> = v"
    by (simp add: lupd_def get_local_def)

    lemma lupd_get_local_other [simp]: "x ≠ y ==> lupd(x\<mapsto>v) s<y> = s<y>"
    apply (drule not_sym)
    by (simp add: lupd_def get_local_def)

    lemma get_field_lupd [simp]:
      "get_field (lupd(x\<mapsto>y) s) a f = get_field s a f"
    by (simp add: lupd_def get_field_def get_obj_def)

    lemma get_field_set_locs [simp]:
      "get_field (set_locs l s) a f = get_field s a f"
    by (simp add: lupd_def get_field_def set_locs_def get_obj_def)

    lemma get_field_del_locs [simp]:
      "get_field (del_locs s) a f = get_field s a f"
    by (simp add: lupd_def get_field_def del_locs_def get_obj_def)

    lemma new_obj_get_local [simp]: "new_obj a C s <x> = s<x>"
    by (simp add: new_obj_def hupd_def get_local_def)

    lemma heap_lupd [simp]: "heap (lupd(x\<mapsto>y) s) = heap s"
    by (simp add: lupd_def)

    lemma heap_hupd_same [simp]: "heap (hupd(a\<mapsto>obj) s) a = Some obj"
    by (simp add: hupd_def)

    lemma heap_hupd_other [simp]: "aa ≠ a  ==> heap (hupd(aa\<mapsto>obj) s) a = heap s a"
    apply (drule not_sym)
    by (simp add: hupd_def)

    lemma hupd_hupd [simp]: "hupd(a\<mapsto>obj) (hupd(a\<mapsto>obj') s) = hupd(a\<mapsto>obj) s"
    by (simp add: hupd_def)

    lemma heap_del_locs [simp]: "heap (del_locs s) = heap s"
    by (simp add: del_locs_def)

    lemma heap_set_locs [simp]: "heap (set_locs l s) = heap s"
    by (simp add: set_locs_def)

    lemma hupd_lupd [simp]:
      "hupd(a\<mapsto>obj) (lupd(x\<mapsto>y) s) = lupd(x\<mapsto>y) (hupd(a\<mapsto>obj) s)"
    by (simp add: hupd_def lupd_def)

    lemma hupd_del_locs [simp]:
      "hupd(a\<mapsto>obj) (del_locs s) = del_locs (hupd(a\<mapsto>obj) s)"
    by (simp add: hupd_def del_locs_def)

    lemma new_obj_lupd [simp]:
      "new_obj a C (lupd(x\<mapsto>y) s) = lupd(x\<mapsto>y) (new_obj a C s)"
    by (simp add: new_obj_def)

    lemma new_obj_del_locs [simp]:
      "new_obj a C (del_locs s) = del_locs (new_obj a C s)"
    by (simp add: new_obj_def)

    lemma upd_obj_lupd [simp]:
      "upd_obj a f v (lupd(x\<mapsto>y) s) = lupd(x\<mapsto>y) (upd_obj a f v s)"
    by (simp add: upd_obj_def Let_def split_beta)

    lemma upd_obj_del_locs [simp]:
      "upd_obj a f v (del_locs s) = del_locs (upd_obj a f v s)"
    by (simp add: upd_obj_def Let_def split_beta)

    lemma get_field_hupd_same [simp]:
     "get_field (hupd(a\<mapsto>(C, fs)) s) a = the o fs"
    apply (rule ext)
    by (simp add: get_field_def get_obj_def)

    lemma get_field_hupd_other [simp]:
     "aa ≠ a  ==> get_field (hupd(aa\<mapsto>obj) s) a = get_field s a"
    apply (rule ext)
    by (simp add: get_field_def get_obj_def)

    lemma new_AddrD:
    "new_Addr s = v ==> (∃a. v = Addr a ∧ heap s a = None) | v = Null"
    apply (unfold new_Addr_def)
    apply (erule subst)
    apply (rule someI)
    apply (rule disjI2)
    apply (rule HOL.refl)
    done

    end

### Properties not used in the meta theory

lemma locals_upd_id:

      s(| locals := locals s |) = s

lemma lupd_get_local_same:

      lupd(x|->v) s<x> = v

lemma lupd_get_local_other:

      x ≠ y ==> lupd(x|->v) s<y> = s<y>

lemma get_field_lupd:

      get_field (lupd(x|->y) s) a f = get_field s a f

lemma get_field_set_locs:

      get_field (set_locs l s) a f = get_field s a f

lemma get_field_del_locs:

      get_field (del_locs s) a f = get_field s a f

lemma new_obj_get_local:

      new_obj a C s<x> = s<x>

lemma heap_lupd:

      heap (lupd(x|->y) s) = heap s

lemma heap_hupd_same:

      heap (hupd(a|->obj) s) a = Some obj

lemma heap_hupd_other:

      aa ≠ a ==> heap (hupd(aa|->obj) s) a = heap s a

lemma hupd_hupd:

      hupd(a|->obj) (hupd(a|->obj') s) = hupd(a|->obj) s

lemma heap_del_locs:

      heap (del_locs s) = heap s

lemma heap_set_locs:

      heap (set_locs l s) = heap s

lemma hupd_lupd:

      hupd(a|->obj) (lupd(x|->y) s) = lupd(x|->y) (hupd(a|->obj) s)

lemma hupd_del_locs:

      hupd(a|->obj) (del_locs s) = del_locs (hupd(a|->obj) s)

lemma new_obj_lupd:

      new_obj a C (lupd(x|->y) s) = lupd(x|->y) (new_obj a C s)

lemma new_obj_del_locs:

      new_obj a C (del_locs s) = del_locs (new_obj a C s)

lemma upd_obj_lupd:

      upd_obj a f v (lupd(x|->y) s) = lupd(x|->y) (upd_obj a f v s)

lemma upd_obj_del_locs:

      upd_obj a f v (del_locs s) = del_locs (upd_obj a f v s)

lemma get_field_hupd_same:

      get_field (hupd(a|->(C, fs)) s) a = the o fs

lemma get_field_hupd_other:

      aa ≠ a ==> get_field (hupd(aa|->obj) s) a = get_field s a

lemma new_AddrD:

      new_Addr s = v ==> (∃a. v = Addr a ∧ heap s a = None) ∨ v = Null