src/HOL/Hoare/SepLogHeap.thy
author nipkow
Thu, 26 Jun 2003 18:14:04 +0200
changeset 14074 93dfce3b6f86
child 16417 9bc16273c2d4
permissions -rw-r--r--
*** empty log message ***
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
14074
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
     1
(*  Title:      HOL/Hoare/Heap.thy
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
     2
    ID:         $Id$
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
     3
    Author:     Tobias Nipkow
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
     4
    Copyright   2002 TUM
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
     5
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
     6
Heap abstractions (at the moment only Path and List)
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
     7
for Separation Logic.
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
     8
*)
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
     9
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    10
theory SepLogHeap = Main:
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    11
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    12
types heap = "(nat \<Rightarrow> nat option)"
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    13
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    14
text{* Some means allocated, none means free. Address 0 serves as the
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    15
null reference. *}
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    16
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    17
subsection "Paths in the heap"
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    18
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    19
consts
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    20
 Path :: "heap \<Rightarrow> nat \<Rightarrow> nat list \<Rightarrow> nat \<Rightarrow> bool"
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    21
primrec
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    22
"Path h x [] y = (x = y)"
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    23
"Path h x (a#as) y = (x\<noteq>0 \<and> a=x \<and> (\<exists>b. h x = Some b \<and> Path h b as y))"
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    24
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    25
lemma [iff]: "Path h 0 xs y = (xs = [] \<and> y = 0)"
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    26
apply(case_tac xs)
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    27
apply fastsimp
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    28
apply fastsimp
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    29
done
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    30
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    31
lemma [simp]: "x\<noteq>0 \<Longrightarrow> Path h x as z =
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    32
 (as = [] \<and> z = x  \<or>  (\<exists>y bs. as = x#bs \<and> h x = Some y & Path h y bs z))"
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    33
apply(case_tac as)
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    34
apply fastsimp
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    35
apply fastsimp
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    36
done
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    37
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    38
lemma [simp]: "\<And>x. Path f x (as@bs) z = (\<exists>y. Path f x as y \<and> Path f y bs z)"
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    39
by(induct as, auto)
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    40
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    41
lemma Path_upd[simp]:
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    42
 "\<And>x. u \<notin> set as \<Longrightarrow> Path (f(u := v)) x as y = Path f x as y"
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    43
by(induct as, simp, simp add:eq_sym_conv)
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    44
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    45
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    46
subsection "Lists on the heap"
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    47
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    48
constdefs
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    49
 List :: "heap \<Rightarrow> nat \<Rightarrow> nat list \<Rightarrow> bool"
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    50
"List h x as == Path h x as 0"
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    51
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    52
lemma [simp]: "List h x [] = (x = 0)"
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    53
by(simp add:List_def)
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    54
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    55
lemma [simp]:
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    56
 "List h x (a#as) = (x\<noteq>0 \<and> a=x \<and> (\<exists>y. h x = Some y \<and> List h y as))"
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    57
by(simp add:List_def)
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    58
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    59
lemma [simp]: "List h 0 as = (as = [])"
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    60
by(case_tac as, simp_all)
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    61
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    62
lemma List_non_null: "a\<noteq>0 \<Longrightarrow>
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    63
 List h a as = (\<exists>b bs. as = a#bs \<and> h a = Some b \<and> List h b bs)"
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    64
by(case_tac as, simp_all)
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    65
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    66
theorem notin_List_update[simp]:
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    67
 "\<And>x. a \<notin> set as \<Longrightarrow> List (h(a := y)) x as = List h x as"
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    68
apply(induct as)
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    69
apply simp
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    70
apply(clarsimp simp add:fun_upd_apply)
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    71
done
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    72
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    73
lemma List_unique: "\<And>x bs. List h x as \<Longrightarrow> List h x bs \<Longrightarrow> as = bs"
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    74
by(induct as, auto simp add:List_non_null)
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    75
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    76
lemma List_unique1: "List h p as \<Longrightarrow> \<exists>!as. List h p as"
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    77
by(blast intro:List_unique)
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    78
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    79
lemma List_app: "\<And>x. List h x (as@bs) = (\<exists>y. Path h x as y \<and> List h y bs)"
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    80
by(induct as, auto)
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    81
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    82
lemma List_hd_not_in_tl[simp]: "List h b as \<Longrightarrow> h a = Some b \<Longrightarrow> a \<notin> set as"
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    83
apply (clarsimp simp add:in_set_conv_decomp)
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    84
apply(frule List_app[THEN iffD1])
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    85
apply(fastsimp dest: List_unique)
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    86
done
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    87
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    88
lemma List_distinct[simp]: "\<And>x. List h x as \<Longrightarrow> distinct as"
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    89
apply(induct as, simp)
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    90
apply(fastsimp dest:List_hd_not_in_tl)
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    91
done
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    92
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    93
lemma list_in_heap: "\<And>p. List h p ps \<Longrightarrow> set ps \<subseteq> dom h"
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    94
by(induct ps, auto)
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    95
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    96
lemma list_ortho_sum1[simp]:
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    97
 "\<And>p. \<lbrakk> List h1 p ps; dom h1 \<inter> dom h2 = {}\<rbrakk> \<Longrightarrow> List (h1++h2) p ps"
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    98
by(induct ps, auto simp add:map_add_def split:option.split)
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
    99
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
   100
lemma list_ortho_sum2[simp]:
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
   101
 "\<And>p. \<lbrakk> List h2 p ps; dom h1 \<inter> dom h2 = {}\<rbrakk> \<Longrightarrow> List (h1++h2) p ps"
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
   102
by(induct ps, auto simp add:map_add_def split:option.split)
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
   103
93dfce3b6f86 *** empty log message ***
nipkow
parents:
diff changeset
   104
end