IMP/Equiv.ML
author nipkow
Wed, 31 Aug 1994 16:25:19 +0200
changeset 132 47be9d22a0d6
parent 131 41bf53133ba6
child 137 bca8203b0e91
permissions -rw-r--r--
Renamed a few types and vars
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
132
47be9d22a0d6 Renamed a few types and vars
nipkow
parents: 131
diff changeset
     1
(*  Title: 	HOL/IMP/Equiv.ML
131
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
     2
    ID:         $Id$
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
     3
    Author: 	Heiko Loetzbeyer & Robert Sandner, TUM
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
     4
    Copyright   1994 TUM
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
     5
*)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
     6
132
47be9d22a0d6 Renamed a few types and vars
nipkow
parents: 131
diff changeset
     7
goal Equiv.thy "(<a,s> -a-> n) = (A(a,s) = n)";
131
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
     8
by (res_inst_tac [("x","n")] spec 1);                     (* quantify n *)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
     9
by (aexp.induct_tac "a" 1);                		  (* struct. ind. *)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    10
by (rewrite_goals_tac A_rewrite_rules);			  (* rewr. Den.   *)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    11
by (TRYALL (fast_tac (set_cs addSIs (evala.intrs@prems)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    12
                             addSEs aexp_elim_cases)));
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    13
val aexp_iff = result();
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    14
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    15
val aexp1 = aexp_iff RS iffD1;
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    16
val aexp2 = aexp_iff RS iffD2;
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    17
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    18
132
47be9d22a0d6 Renamed a few types and vars
nipkow
parents: 131
diff changeset
    19
goal Equiv.thy "(<b,s> -b-> w) = (B(b,s) = w)";
131
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    20
by (res_inst_tac [("x","w")] spec 1);			(* quantify w *)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    21
by (bexp.induct_tac "b" 1);		                (* struct. ind. *)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    22
by (rewrite_goals_tac B_rewrite_rules);			(* rewr. Den.   *)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    23
by (safe_tac (HOL_cs addSIs (aexp2::evalb.intrs)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    24
                     addSDs [aexp1] addSEs bexp_elim_cases)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    25
    THEN ALLGOALS(best_tac HOL_cs));
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    26
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    27
val bexp_iff = result();
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    28
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    29
val bexp1 = bexp_iff RS iffD1;
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    30
val bexp2 = bexp_iff RS iffD2;
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    31
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    32
val BfstI = read_instantiate_sg (sign_of Equiv.thy)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    33
              [("P","%x.B(?b,x)")] (fst_conv RS ssubst);
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    34
val BfstD = read_instantiate_sg (sign_of Equiv.thy)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    35
              [("P","%x.B(?b,x)")] (fst_conv RS subst);
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    36
132
47be9d22a0d6 Renamed a few types and vars
nipkow
parents: 131
diff changeset
    37
goal Equiv.thy "!!c. <c,s> -c-> t ==> <s,t> : C(c)";
131
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    38
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    39
(* start with rule induction *)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    40
be (evalc.mutual_induct RS spec RS spec RS spec RSN (2,rev_mp)) 1;
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    41
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    42
by (rewrite_tac (Gamma_def::C_rewrite_rules));
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    43
(* skip *)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    44
by (fast_tac comp_cs 1);
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    45
(* assign *)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    46
by (asm_full_simp_tac (prod_ss addsimps [aexp1]) 1);
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    47
(* comp *)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    48
by (fast_tac comp_cs 1);
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    49
(* if *)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    50
by(fast_tac (set_cs addSIs [BfstI] addSDs [BfstD,bexp1]) 1);
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    51
by(fast_tac (set_cs addSIs [BfstI] addSDs [BfstD,bexp1]) 1);
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    52
(* while *)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    53
by (rtac (rewrite_rule [Gamma_def] (Gamma_mono RS lfp_Tarski RS ssubst)) 1);
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    54
by (fast_tac (comp_cs addSIs [bexp1,BfstI] addSDs [BfstD,bexp1]) 1);
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    55
by (rtac (rewrite_rule [Gamma_def] (Gamma_mono RS lfp_Tarski RS ssubst)) 1);
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    56
by (fast_tac (comp_cs addSIs [bexp1,BfstI] addSDs [BfstD,bexp1]) 1);
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    57
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    58
val com1 = result();
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    59
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    60
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    61
val com_cs = comp_cs addSIs [aexp2,bexp2] addIs evalc.intrs;
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    62
132
47be9d22a0d6 Renamed a few types and vars
nipkow
parents: 131
diff changeset
    63
goal Equiv.thy "!io:C(c). <c,fst(io)> -c-> snd(io)";
131
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    64
by (com.induct_tac "c" 1);
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    65
by (rewrite_tac C_rewrite_rules);
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    66
by (safe_tac com_cs);
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    67
by (ALLGOALS (asm_full_simp_tac prod_ss));
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    68
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    69
(* skip *)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    70
by (fast_tac com_cs 1);
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    71
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    72
(* assign *)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    73
by (fast_tac com_cs 1);
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    74
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    75
(* comp *)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    76
by (REPEAT (EVERY [(dtac bspec 1),(atac 1)]));
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    77
by (asm_full_simp_tac prod_ss 1);
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    78
by (fast_tac com_cs 1);
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    79
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    80
(* while *)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    81
by (etac (Gamma_mono RSN (2,induct)) 1);
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    82
by (rewrite_goals_tac [Gamma_def]);  
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    83
by (safe_tac com_cs);
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    84
by (EVERY1 [dtac bspec, atac]);
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    85
by (ALLGOALS (asm_full_simp_tac prod_ss));
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    86
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    87
(* while, if *)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    88
by (ALLGOALS (fast_tac com_cs));
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    89
val com2 = result();
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    90
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    91
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    92
(**** Proof of Equivalence ****)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    93
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    94
val com_iff_cs = set_cs addEs [com2 RS bspec]
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    95
                        addDs [com1];
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    96
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    97
goal Equiv.thy "C(c) = {io . <c,fst(io)> -c-> snd(io)}";
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    98
by (rtac equalityI 1);
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
    99
(* => *)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
   100
by (fast_tac com_iff_cs 1);
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
   101
(* <= *)
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
   102
by (REPEAT (step_tac com_iff_cs 1));
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
   103
by (asm_full_simp_tac (prod_ss addsimps [surjective_pairing RS sym])1);
41bf53133ba6 Equivalence of op. and den. sem. for simple while language.
nipkow
parents:
diff changeset
   104
val com_equivalence = result();