src/HOL/Hoare/Heap.thy
author haftmann
Fri, 17 Jun 2005 16:12:49 +0200
changeset 16417 9bc16273c2d4
parent 13875 12997e3ddd8d
child 19399 fd2ba98056a2
permissions -rw-r--r--
migrated theory headers to new format
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
13875
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
     1
(*  Title:      HOL/Hoare/Heap.thy
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
     2
    ID:         $Id$
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
     3
    Author:     Tobias Nipkow
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
     4
    Copyright   2002 TUM
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
     5
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
     6
Pointers, heaps and heap abstractions.
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
     7
See the paper by Mehta and Nipkow.
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
     8
*)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
     9
16417
9bc16273c2d4 migrated theory headers to new format
haftmann
parents: 13875
diff changeset
    10
theory Heap imports Main begin
13875
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    11
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    12
subsection "References"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    13
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    14
datatype 'a ref = Null | Ref 'a
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    15
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    16
lemma not_Null_eq [iff]: "(x ~= Null) = (EX y. x = Ref y)"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    17
  by (induct x) auto
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    18
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    19
lemma not_Ref_eq [iff]: "(ALL y. x ~= Ref y) = (x = Null)"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    20
  by (induct x) auto
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    21
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    22
consts addr :: "'a ref \<Rightarrow> 'a"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    23
primrec "addr(Ref a) = a"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    24
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    25
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    26
section "The heap"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    27
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    28
subsection "Paths in the heap"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    29
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    30
consts
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    31
 Path :: "('a \<Rightarrow> 'a ref) \<Rightarrow> 'a ref \<Rightarrow> 'a list \<Rightarrow> 'a ref \<Rightarrow> bool"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    32
primrec
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    33
"Path h x [] y = (x = y)"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    34
"Path h x (a#as) y = (x = Ref a \<and> Path h (h a) as y)"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    35
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    36
lemma [iff]: "Path h Null xs y = (xs = [] \<and> y = Null)"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    37
apply(case_tac xs)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    38
apply fastsimp
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    39
apply fastsimp
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    40
done
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    41
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    42
lemma [simp]: "Path h (Ref a) as z =
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    43
 (as = [] \<and> z = Ref a  \<or>  (\<exists>bs. as = a#bs \<and> Path h (h a) bs z))"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    44
apply(case_tac as)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    45
apply fastsimp
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    46
apply fastsimp
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    47
done
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    48
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    49
lemma [simp]: "\<And>x. Path f x (as@bs) z = (\<exists>y. Path f x as y \<and> Path f y bs z)"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    50
by(induct as, simp+)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    51
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    52
lemma Path_upd[simp]:
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    53
 "\<And>x. u \<notin> set as \<Longrightarrow> Path (f(u := v)) x as y = Path f x as y"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    54
by(induct as, simp, simp add:eq_sym_conv)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    55
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    56
lemma Path_snoc:
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    57
 "Path (f(a := q)) p as (Ref a) \<Longrightarrow> Path (f(a := q)) p (as @ [a]) q"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    58
by simp
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    59
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    60
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    61
subsection "Lists on the heap"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    62
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    63
subsubsection "Relational abstraction"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    64
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    65
constdefs
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    66
 List :: "('a \<Rightarrow> 'a ref) \<Rightarrow> 'a ref \<Rightarrow> 'a list \<Rightarrow> bool"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    67
"List h x as == Path h x as Null"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    68
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    69
lemma [simp]: "List h x [] = (x = Null)"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    70
by(simp add:List_def)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    71
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    72
lemma [simp]: "List h x (a#as) = (x = Ref a \<and> List h (h a) as)"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    73
by(simp add:List_def)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    74
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    75
lemma [simp]: "List h Null as = (as = [])"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    76
by(case_tac as, simp_all)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    77
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    78
lemma List_Ref[simp]: "List h (Ref a) as = (\<exists>bs. as = a#bs \<and> List h (h a) bs)"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    79
by(case_tac as, simp_all, fast)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    80
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    81
theorem notin_List_update[simp]:
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    82
 "\<And>x. a \<notin> set as \<Longrightarrow> List (h(a := y)) x as = List h x as"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    83
apply(induct as)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    84
apply simp
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    85
apply(clarsimp simp add:fun_upd_apply)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    86
done
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    87
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    88
lemma List_unique: "\<And>x bs. List h x as \<Longrightarrow> List h x bs \<Longrightarrow> as = bs"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    89
by(induct as, simp, clarsimp)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    90
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    91
lemma List_unique1: "List h p as \<Longrightarrow> \<exists>!as. List h p as"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    92
by(blast intro:List_unique)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    93
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    94
lemma List_app: "\<And>x. List h x (as@bs) = (\<exists>y. Path h x as y \<and> List h y bs)"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    95
by(induct as, simp, clarsimp)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    96
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    97
lemma List_hd_not_in_tl[simp]: "List h (h a) as \<Longrightarrow> a \<notin> set as"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    98
apply (clarsimp simp add:in_set_conv_decomp)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    99
apply(frule List_app[THEN iffD1])
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   100
apply(fastsimp dest: List_unique)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   101
done
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   102
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   103
lemma List_distinct[simp]: "\<And>x. List h x as \<Longrightarrow> distinct as"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   104
apply(induct as, simp)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   105
apply(fastsimp dest:List_hd_not_in_tl)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   106
done
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   107
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   108
subsection "Functional abstraction"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   109
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   110
constdefs
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   111
 islist :: "('a \<Rightarrow> 'a ref) \<Rightarrow> 'a ref \<Rightarrow> bool"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   112
"islist h p == \<exists>as. List h p as"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   113
 list :: "('a \<Rightarrow> 'a ref) \<Rightarrow> 'a ref \<Rightarrow> 'a list"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   114
"list h p == SOME as. List h p as"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   115
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   116
lemma List_conv_islist_list: "List h p as = (islist h p \<and> as = list h p)"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   117
apply(simp add:islist_def list_def)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   118
apply(rule iffI)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   119
apply(rule conjI)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   120
apply blast
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   121
apply(subst some1_equality)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   122
  apply(erule List_unique1)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   123
 apply assumption
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   124
apply(rule refl)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   125
apply simp
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   126
apply(rule someI_ex)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   127
apply fast
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   128
done
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   129
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   130
lemma [simp]: "islist h Null"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   131
by(simp add:islist_def)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   132
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   133
lemma [simp]: "islist h (Ref a) = islist h (h a)"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   134
by(simp add:islist_def)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   135
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   136
lemma [simp]: "list h Null = []"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   137
by(simp add:list_def)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   138
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   139
lemma list_Ref_conv[simp]:
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   140
 "islist h (h a) \<Longrightarrow> list h (Ref a) = a # list h (h a)"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   141
apply(insert List_Ref[of h])
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   142
apply(fastsimp simp:List_conv_islist_list)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   143
done
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   144
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   145
lemma [simp]: "islist h (h a) \<Longrightarrow> a \<notin> set(list h (h a))"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   146
apply(insert List_hd_not_in_tl[of h])
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   147
apply(simp add:List_conv_islist_list)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   148
done
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   149
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   150
lemma list_upd_conv[simp]:
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   151
 "islist h p \<Longrightarrow> y \<notin> set(list h p) \<Longrightarrow> list (h(y := q)) p = list h p"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   152
apply(drule notin_List_update[of _ _ h q p])
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   153
apply(simp add:List_conv_islist_list)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   154
done
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   155
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   156
lemma islist_upd[simp]:
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   157
 "islist h p \<Longrightarrow> y \<notin> set(list h p) \<Longrightarrow> islist (h(y := q)) p"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   158
apply(frule notin_List_update[of _ _ h q p])
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   159
apply(simp add:List_conv_islist_list)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   160
done
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   161
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
   162
end