src/HOL/Hoare/Pointer_ExamplesAbort.thy
author haftmann
Fri, 17 Jun 2005 16:12:49 +0200
changeset 16417 9bc16273c2d4
parent 13875 12997e3ddd8d
child 38353 d98baa2cf589
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/Pointer_ExamplesAbort.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
Examples of verifications of pointer programs
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
     7
*)
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
     8
16417
9bc16273c2d4 migrated theory headers to new format
haftmann
parents: 13875
diff changeset
     9
theory Pointer_ExamplesAbort imports HeapSyntaxAbort begin
13875
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    10
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    11
section "Verifications"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    12
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    13
subsection "List reversal"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    14
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    15
text "Interestingly, this proof is the same as for the unguarded program:"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    16
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    17
lemma "VARS tl p q r
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    18
  {List tl p Ps \<and> List tl q Qs \<and> set Ps \<inter> set Qs = {}}
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    19
  WHILE p \<noteq> Null
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    20
  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
    21
                 rev ps @ qs = rev Ps @ Qs}
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    22
  DO r := p; (p \<noteq> Null \<rightarrow> p := p^.tl); r^.tl := q; q := r OD
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    23
  {List tl q (rev Ps @ Qs)}"
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    24
apply vcg_simp
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    25
  apply fastsimp
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    26
 apply(fastsimp intro:notin_List_update[THEN iffD2])
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    27
apply fastsimp
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    28
done
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    29
12997e3ddd8d *** empty log message ***
nipkow
parents:
diff changeset
    30
end