src/HOL/IMP/Transition.ML
author paulson
Wed Nov 05 13:23:46 1997 +0100 (1997-11-05)
changeset 4153 e534c4c32d54
parent 4089 96fba19bcbe2
child 4477 b3e5857d8d99
permissions -rw-r--r--
Ran expandshort, especially to introduce Safe_tac
nipkow@1700
     1
(*  Title:      HOL/IMP/Transition.ML
nipkow@1700
     2
    ID:         $Id$
nipkow@1700
     3
    Author:     Tobias Nipkow & Robert Sandner, TUM
nipkow@1700
     4
    Copyright   1996 TUM
nipkow@1700
     5
nipkow@1700
     6
Equivalence of Natural and Transition semantics
nipkow@1700
     7
*)
nipkow@1700
     8
nipkow@1700
     9
open Transition;
nipkow@1700
    10
nipkow@1707
    11
section "Winskel's Proof";
nipkow@1707
    12
nipkow@1973
    13
AddSEs [rel_pow_0_E];
nipkow@1700
    14
nipkow@1973
    15
val evalc1_SEs = map (evalc1.mk_cases com.simps)
nipkow@1973
    16
   ["(SKIP,s) -1-> t", "(x:=a,s) -1-> t","(c1;c2, s) -1-> t", 
nipkow@1973
    17
    "(IF b THEN c1 ELSE c2, s) -1-> t"];
nipkow@1973
    18
val evalc1_Es = map (evalc1.mk_cases com.simps)
nipkow@1973
    19
   ["(WHILE b DO c,s) -1-> t"];
nipkow@1700
    20
nipkow@1973
    21
AddSEs evalc1_SEs;
nipkow@1973
    22
nipkow@1973
    23
AddIs evalc1.intrs;
nipkow@1700
    24
nipkow@1701
    25
goal Transition.thy "!!s. (SKIP,s) -m-> (SKIP,t) ==> s = t & m = 0";
paulson@2031
    26
by (etac rel_pow_E2 1);
nipkow@1700
    27
by (Asm_full_simp_tac 1);
paulson@2031
    28
by (Fast_tac 1);
nipkow@1973
    29
val hlemma = result();
nipkow@1700
    30
nipkow@1700
    31
nipkow@1700
    32
goal Transition.thy
nipkow@1701
    33
  "!s t u c d. (c,s) -n-> (SKIP,t) --> (d,t) -*-> (SKIP,u) --> \
nipkow@1700
    34
\              (c;d, s) -*-> (SKIP, u)";
paulson@2031
    35
by (nat_ind_tac "n" 1);
nipkow@1700
    36
 (* case n = 0 *)
wenzelm@4089
    37
 by (fast_tac (claset() addIs [rtrancl_into_rtrancl2])1);
nipkow@1700
    38
(* induction step *)
wenzelm@4089
    39
by (safe_tac (claset() addSDs [rel_pow_Suc_D2]));
paulson@2031
    40
by (split_all_tac 1);
wenzelm@4089
    41
by (fast_tac (claset() addIs [rtrancl_into_rtrancl2]) 1);
nipkow@1700
    42
qed_spec_mp "lemma1";
nipkow@1700
    43
nipkow@1700
    44
paulson@1730
    45
goal Transition.thy "!!c s s1. <c,s> -c-> s1 ==> (c,s) -*-> (SKIP,s1)";
paulson@2031
    46
by (etac evalc.induct 1);
nipkow@1700
    47
nipkow@1700
    48
(* SKIP *)
paulson@2031
    49
by (rtac rtrancl_refl 1);
nipkow@1700
    50
nipkow@1700
    51
(* ASSIGN *)
wenzelm@4089
    52
by (fast_tac (claset() addSIs [r_into_rtrancl]) 1);
nipkow@1700
    53
nipkow@1700
    54
(* SEMI *)
wenzelm@4089
    55
by (fast_tac (claset() addDs [rtrancl_imp_UN_rel_pow] addIs [lemma1]) 1);
nipkow@1700
    56
nipkow@1700
    57
(* IF *)
wenzelm@4089
    58
by (fast_tac (claset() addIs [rtrancl_into_rtrancl2]) 1);
wenzelm@4089
    59
by (fast_tac (claset() addIs [rtrancl_into_rtrancl2]) 1);
nipkow@1700
    60
nipkow@1700
    61
(* WHILE *)
wenzelm@4089
    62
by (fast_tac (claset() addSIs [r_into_rtrancl]) 1);
wenzelm@4089
    63
by (fast_tac (claset() addDs [rtrancl_imp_UN_rel_pow]
nipkow@1700
    64
                        addIs [rtrancl_into_rtrancl2,lemma1]) 1);
nipkow@1700
    65
paulson@1730
    66
qed "evalc_impl_evalc1";
nipkow@1700
    67
nipkow@1700
    68
nipkow@1700
    69
goal Transition.thy
nipkow@1701
    70
  "!c d s u. (c;d,s) -n-> (SKIP,u) --> \
nipkow@1701
    71
\            (? t m. (c,s) -*-> (SKIP,t) & (d,t) -m-> (SKIP,u) & m <= n)";
paulson@2031
    72
by (nat_ind_tac "n" 1);
nipkow@1700
    73
 (* case n = 0 *)
wenzelm@4089
    74
 by (fast_tac (claset() addss simpset()) 1);
nipkow@1700
    75
(* induction step *)
wenzelm@4089
    76
by (fast_tac (claset() addSIs [le_SucI,le_refl]
nipkow@1700
    77
                     addSDs [rel_pow_Suc_D2]
nipkow@1973
    78
                     addSEs [rel_pow_imp_rtrancl,rtrancl_into_rtrancl2]) 1);
nipkow@1700
    79
qed_spec_mp "lemma2";
nipkow@1700
    80
nipkow@1700
    81
goal Transition.thy "!s t. (c,s) -*-> (SKIP,t) --> <c,s> -c-> t";
nipkow@1700
    82
by (com.induct_tac "c" 1);
wenzelm@4089
    83
by (safe_tac (claset() addSDs [rtrancl_imp_UN_rel_pow]));
nipkow@1700
    84
nipkow@1700
    85
(* SKIP *)
wenzelm@4089
    86
by (fast_tac (claset() addSEs [rel_pow_E2]) 1);
nipkow@1700
    87
nipkow@1700
    88
(* ASSIGN *)
wenzelm@4089
    89
by (fast_tac (claset() addSDs [hlemma]  addSEs [rel_pow_E2]
paulson@4153
    90
                       addss simpset()) 1);
nipkow@1700
    91
nipkow@1700
    92
(* SEMI *)
wenzelm@4089
    93
by (fast_tac (claset() addSDs [lemma2,rel_pow_imp_rtrancl]) 1);
nipkow@1700
    94
nipkow@1700
    95
(* IF *)
paulson@2031
    96
by (etac rel_pow_E2 1);
nipkow@1700
    97
by (Asm_full_simp_tac 1);
wenzelm@4089
    98
by (fast_tac (claset() addSDs [rel_pow_imp_rtrancl]) 1);
nipkow@1700
    99
nipkow@1700
   100
(* WHILE, induction on the length of the computation *)
paulson@4153
   101
by (eres_inst_tac [("P","?X -n-> ?Y")] rev_mp 1);
nipkow@1700
   102
by (res_inst_tac [("x","s")] spec 1);
paulson@2031
   103
by (res_inst_tac [("n","n")] less_induct 1);
nipkow@1700
   104
by (strip_tac 1);
paulson@2031
   105
by (etac rel_pow_E2 1);
nipkow@1700
   106
 by (Asm_full_simp_tac 1);
nipkow@1973
   107
by (eresolve_tac evalc1_Es 1);
nipkow@1700
   108
nipkow@1700
   109
(* WhileFalse *)
wenzelm@4089
   110
 by (fast_tac (claset() addSDs [hlemma]) 1);
nipkow@1700
   111
nipkow@1700
   112
(* WhileTrue *)
wenzelm@4089
   113
by (fast_tac(claset() addSDs[lemma2,le_imp_less_or_eq,less_Suc_eq RS iffD2])1);
nipkow@1700
   114
nipkow@1700
   115
qed_spec_mp "evalc1_impl_evalc";
nipkow@1700
   116
nipkow@1700
   117
nipkow@1700
   118
(**** proof of the equivalence of evalc and evalc1 ****)
nipkow@1700
   119
nipkow@1700
   120
goal Transition.thy "((c, s) -*-> (SKIP, t)) = (<c,s> -c-> t)";
nipkow@1700
   121
by (fast_tac (HOL_cs addSEs [evalc1_impl_evalc,evalc_impl_evalc1]) 1);
nipkow@1700
   122
qed "evalc1_eq_evalc";
nipkow@1707
   123
nipkow@1707
   124
nipkow@1707
   125
section "A Proof Without -n->";
nipkow@1707
   126
nipkow@1707
   127
goal Transition.thy
nipkow@1707
   128
 "!!c1. (c1,s1) -*-> (SKIP,s2) ==> \
nipkow@1939
   129
\ (c2,s2) -*-> cs3 --> (c1;c2,s1) -*-> cs3";
nipkow@3439
   130
by (etac inverse_rtrancl_induct2 1);
wenzelm@4089
   131
by (fast_tac (claset() addIs [rtrancl_into_rtrancl2]) 1);
wenzelm@4089
   132
by (fast_tac (claset() addIs [rtrancl_into_rtrancl2]) 1);
nipkow@1707
   133
qed_spec_mp "my_lemma1";
nipkow@1707
   134
nipkow@1707
   135
paulson@1730
   136
goal Transition.thy "!!c s s1. <c,s> -c-> s1 ==> (c,s) -*-> (SKIP,s1)";
paulson@2031
   137
by (etac evalc.induct 1);
nipkow@1707
   138
nipkow@1707
   139
(* SKIP *)
paulson@2031
   140
by (rtac rtrancl_refl 1);
nipkow@1707
   141
nipkow@1707
   142
(* ASSIGN *)
wenzelm@4089
   143
by (fast_tac (claset() addSIs [r_into_rtrancl]) 1);
nipkow@1707
   144
nipkow@1707
   145
(* SEMI *)
wenzelm@4089
   146
by (fast_tac (claset() addIs [my_lemma1]) 1);
nipkow@1707
   147
nipkow@1707
   148
(* IF *)
wenzelm@4089
   149
by (fast_tac (claset() addIs [rtrancl_into_rtrancl2]) 1);
wenzelm@4089
   150
by (fast_tac (claset() addIs [rtrancl_into_rtrancl2]) 1);
nipkow@1707
   151
nipkow@1707
   152
(* WHILE *)
wenzelm@4089
   153
by (fast_tac (claset() addSIs [r_into_rtrancl]) 1);
wenzelm@4089
   154
by (fast_tac (claset() addIs [rtrancl_into_rtrancl2,my_lemma1]) 1);
nipkow@1707
   155
paulson@1730
   156
qed "evalc_impl_evalc1";
nipkow@1707
   157
nipkow@1707
   158
(* The opposite direction is based on a Coq proof done by Ranan Fraer and
nipkow@1707
   159
   Yves Bertot. The following sketch is from an email by Ranan Fraer.
nipkow@1707
   160
*)
nipkow@1707
   161
(*
nipkow@1707
   162
First we've broke it into 2 lemmas:
nipkow@1707
   163
nipkow@1707
   164
Lemma 1
nipkow@1707
   165
((c,s) --> (SKIP,t)) => (<c,s> -c-> t)
nipkow@1707
   166
nipkow@1707
   167
This is a quick one, dealing with the cases skip, assignment
nipkow@1707
   168
and while_false.
nipkow@1707
   169
nipkow@1707
   170
Lemma 2
nipkow@1707
   171
((c,s) -*-> (c',s')) /\ <c',s'> -c'-> t
nipkow@1707
   172
  => 
nipkow@1707
   173
<c,s> -c-> t
nipkow@1707
   174
nipkow@1707
   175
This is proved by rule induction on the  -*-> relation
nipkow@1707
   176
and the induction step makes use of a third lemma: 
nipkow@1707
   177
nipkow@1707
   178
Lemma 3
nipkow@1707
   179
((c,s) --> (c',s')) /\ <c',s'> -c'-> t
nipkow@1707
   180
  => 
nipkow@1707
   181
<c,s> -c-> t
nipkow@1707
   182
nipkow@1707
   183
This captures the essence of the proof, as it shows that <c',s'> 
nipkow@1707
   184
behaves as the continuation of <c,s> with respect to the natural
nipkow@1707
   185
semantics.
nipkow@1707
   186
The proof of Lemma 3 goes by rule induction on the --> relation,
nipkow@1707
   187
dealing with the cases sequence1, sequence2, if_true, if_false and
nipkow@1707
   188
while_true. In particular in the case (sequence1) we make use again
nipkow@1707
   189
of Lemma 1.
nipkow@1707
   190
*)
nipkow@1707
   191
nipkow@1707
   192
paulson@1730
   193
goal Transition.thy 
paulson@1730
   194
  "!!c s. ((c,s) -1-> (c',s')) ==> (!t. <c',s'> -c-> t --> <c,s> -c-> t)";
paulson@2031
   195
by (etac evalc1.induct 1);
paulson@3023
   196
by (Auto_tac());
paulson@1730
   197
qed_spec_mp "FB_lemma3";
nipkow@1707
   198
nipkow@1707
   199
val [major] = goal Transition.thy
nipkow@1707
   200
  "(c,s) -*-> (c',s') ==> <c',s'> -c-> t --> <c,s> -c-> t";
paulson@2031
   201
by (rtac (major RS rtrancl_induct2) 1);
paulson@2031
   202
by (Fast_tac 1);
wenzelm@4089
   203
by (fast_tac (claset() addIs [FB_lemma3] addbefore split_all_tac) 1);
nipkow@1707
   204
qed_spec_mp "FB_lemma2";
nipkow@1707
   205
nipkow@1707
   206
goal Transition.thy "!!c. (c,s) -*-> (SKIP,t) ==> <c,s> -c-> t";
wenzelm@4089
   207
by (fast_tac (claset() addEs [FB_lemma2]) 1);
nipkow@1707
   208
qed "evalc1_impl_evalc";