src/HOL/Hoare/Pointer_ExamplesAbort.thy
author blanchet
Wed, 24 Sep 2014 15:45:55 +0200
changeset 58425 246985c6b20b
parent 44890 22f665a2e91c
child 71989 bad75618fb82
permissions -rw-r--r--
simpler proof
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
13875
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
     1
(*  Title:      HOL/Hoare/Pointer_ExamplesAbort.thy
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
     2
    Author:     Tobias Nipkow
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
     3
    Copyright   2002 TUM
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
     4
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
     5
Examples of verifications of pointer programs
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
     6
*)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
     7
16417
9bc16273c2d4 migrated theory headers to new format
haftmann
parents: 13875
diff changeset
     8
theory Pointer_ExamplesAbort imports HeapSyntaxAbort begin
13875
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
     9
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    10
section "Verifications"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    11
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    12
subsection "List reversal"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    13
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    14
text "Interestingly, this proof is the same as for the unguarded program:"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    15
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    16
lemma "VARS tl p q r
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    17
  {List tl p Ps \<and> List tl q Qs \<and> set Ps \<inter> set Qs = {}}
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    18
  WHILE p \<noteq> Null
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    19
  INV {\<exists>ps qs. List tl p ps \<and> List tl q qs \<and> set ps \<inter> set qs = {} \<and>
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    20
                 rev ps @ qs = rev Ps @ Qs}
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    21
  DO r := p; (p \<noteq> Null \<rightarrow> p := p^.tl); r^.tl := q; q := r OD
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    22
  {List tl q (rev Ps @ Qs)}"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    23
apply vcg_simp
44890
22f665a2e91c new fastforce replacing fastsimp - less confusing name
nipkow
parents: 38353
diff changeset
    24
  apply fastforce
22f665a2e91c new fastforce replacing fastsimp - less confusing name
nipkow
parents: 38353
diff changeset
    25
 apply(fastforce intro:notin_List_update[THEN iffD2])
22f665a2e91c new fastforce replacing fastsimp - less confusing name
nipkow
parents: 38353
diff changeset
    26
apply fastforce
13875
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    27
done
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    28
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    29
end