src/HOL/IMP/Hoare.ML
author clasohm
Wed, 04 Oct 1995 13:12:14 +0100
changeset 1266 3ae9fe3c0f68
parent 1115 c2d51f10b9ee
child 1447 bc2c0acbbf29
permissions -rw-r--r--
added local simpsets
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
936
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
     1
(*  Title: 	HOL/IMP/Hoare.ML
938
621be7ec81d7 *** empty log message ***
nipkow
parents: 936
diff changeset
     2
    ID:         $Id$
936
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
     3
    Author: 	Tobias Nipkow
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
     4
    Copyright   1995 TUM
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
     5
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
     6
Derivation of Hoare rules
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
     7
*)
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
     8
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
     9
open Hoare;
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    10
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    11
Unify.trace_bound := 30;
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    12
Unify.search_bound := 30;
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    13
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    14
goalw Hoare.thy [spec_def]
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    15
  "!!P.[| !s. P' s --> P s; {{P}}c{{Q}}; !s. Q s --> Q' s |] \
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    16
\  ==> {{P'}}c{{Q'}}";
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    17
by(fast_tac HOL_cs 1);
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    18
bind_thm("hoare_conseq", impI RSN (3,allI RSN (3,impI RS allI RS result())));
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    19
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    20
goalw Hoare.thy (spec_def::C_simps)  "{{P}} skip {{P}}";
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    21
by(fast_tac comp_cs 1);
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    22
qed"hoare_skip";
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    23
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    24
goalw Hoare.thy (spec_def::C_simps)
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    25
  "!!P. [| !s. P s --> Q(s[A a s/x]) |] ==> {{P}} x := a {{Q}}";
1266
3ae9fe3c0f68 added local simpsets
clasohm
parents: 1115
diff changeset
    26
by(Asm_full_simp_tac 1);
936
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    27
qed"hoare_assign";
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    28
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    29
goalw Hoare.thy (spec_def::C_simps)
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    30
  "!!P. [| {{P}} c {{Q}}; {{Q}} d {{R}} |] ==> {{P}} c;d {{R}}";
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    31
by(fast_tac comp_cs 1);
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    32
qed"hoare_seq";
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    33
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    34
goalw Hoare.thy (spec_def::C_simps)
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    35
  "!!P. [| {{%s. P s & B b s}} c {{Q}}; {{%s. P s & ~B b s}} d {{Q}} |] ==> \
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    36
\  {{P}} ifc b then c else d {{Q}}";
1266
3ae9fe3c0f68 added local simpsets
clasohm
parents: 1115
diff changeset
    37
by(Simp_tac 1);
936
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    38
by(fast_tac comp_cs 1);
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    39
qed"hoare_if";
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    40
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    41
goalw Hoare.thy (spec_def::C_simps)
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    42
  "!!P. [| {{%s. P s & B b s}} c {{P}} |] ==> \
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    43
\  {{P}} while b do c {{%s. P s & ~B b s}}";
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    44
br allI 1;
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    45
br allI 1;
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    46
br impI 1;
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    47
be induct2 1;
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    48
br Gamma_mono 1;
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    49
by (rewrite_goals_tac [Gamma_def]);  
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    50
by(eres_inst_tac [("x","a")] allE 1);
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    51
by (safe_tac comp_cs);
1266
3ae9fe3c0f68 added local simpsets
clasohm
parents: 1115
diff changeset
    52
by(ALLGOALS Asm_full_simp_tac);
936
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    53
qed"hoare_while";
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    54
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    55
fun while_tac inv ss i =
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    56
  EVERY[res_inst_tac[("P",inv)] hoare_conseq i, atac i, rtac hoare_while i,
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    57
        asm_full_simp_tac ss (i+1)];
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    58
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    59
fun assign_tac ss = EVERY'[rtac hoare_assign, simp_tac ss,
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    60
                           TRY o (strip_tac THEN' atac)];
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    61
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    62
fun hoare_tac ss =
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    63
  REPEAT(STATE(fn th => FIRST'[rtac hoare_seq, assign_tac ss] (nprems_of th)));
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    64
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    65
(* example *)
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    66
val prems = goal Hoare.thy
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    67
  "[| u ~= y; u ~= z; y ~= z |] ==> \
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    68
\  {{%s.s(x)=i & s(y)=j}} \
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    69
\  z := X x; (u := N 0; \
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    70
\  while noti(ROp op = (X u) (X y)) \
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    71
\             do (u := Op1 Suc (X u); z := Op1 Suc (X z))) \
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    72
\  {{%s. s(z)=i+j}}";
1266
3ae9fe3c0f68 added local simpsets
clasohm
parents: 1115
diff changeset
    73
val ss = !simpset addsimps (eq_sym_conv::assign_def::prems);
936
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    74
by(hoare_tac ss);
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    75
by(while_tac "%s.s z = i + s u & s y = j" ss 3);
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    76
by(hoare_tac ss);
a6d7b4084761 Hoare logic
nipkow
parents:
diff changeset
    77
result();