(***************************************************************** +
−
  +
−
  Isabelle Tutorial+
−
  -----------------+
−
+
−
  1st June 2009, Beijing +
−
+
−
*)+
−
+
−
theory Lec2+
−
  imports "Main" +
−
begin+
−
+
−
text {***********************************************************+
−
+
−
  Automatic proofs again:+
−
+
−
*}+
−
+
−
inductive+
−
 even :: "nat \<Rightarrow> bool"+
−
where+
−
  eZ[intro]:  "even 0"+
−
| eSS[intro]: "even n \<Longrightarrow> even (Suc (Suc n))"+
−
+
−
text {* +
−
  In the following two lemmas we have to indicate the induction,+
−
  but the routine calculations can be done completely automatically+
−
  by Isabelle's internal tools. +
−
*}+
−
+
−
lemma even_twice:+
−
  shows "even (n + n)"+
−
by (induct n) (auto)+
−
+
−
lemma even_add:+
−
  assumes a: "even n"+
−
  and     b: "even m"+
−
  shows "even (n + m)"+
−
using a b by (induct) (auto)+
−
+
−
text {* +
−
  In the next proof it was crucial that we introduced+
−
  the equation+
−
   +
−
     (Suc (Suc n) * m) = (m + m) + (n * m)+
−
    +
−
  because this allowed us to use the induction hypothesis+
−
  and the previous two lemmas. *}+
−
+
−
lemma even_mul:+
−
  assumes a: "even n"+
−
  shows "even (n * m)"+
−
using a+
−
proof (induct)+
−
  case eZ+
−
  show "even (0 * m)" by auto+
−
next+
−
  case (eSS n)+
−
  have as: "even n" by fact+
−
  have ih: "even (n * m)" by fact+
−
  have "(Suc (Suc n) * m) = (m + m) + (n * m)" by simp+
−
  moreover +
−
  have "even (m + m)" using even_twice by simp+
−
  ultimately +
−
  show "even (Suc (Suc n) * m)" using ih even_add by (simp only:)+
−
qed+
−
+
−
text {* +
−
  This proof cannot be found by the internal tools, but+
−
  Isabelle has an interface to external provers. This+
−
  interface is called sledgehammer and it finds the +
−
  proof more or less automatically.+
−
+
−
*}+
−
+
−
+
−
lemma even_mul_auto:+
−
  assumes a: "even n"+
−
  shows "even (n * m)"+
−
using a+
−
apply(induct)+
−
apply(metis eZ mult_is_0)+
−
apply(metis even_add even_twice mult_Suc_right nat_add_assoc nat_mult_commute)+
−
done+
−
+
−
text {*+
−
  The disadvantage of such proofs is that you do+
−
  not know why they are true.+
−
*}+
−
+
−
+
−
text {***************************************************************** +
−
+
−
  Function Definitions+
−
  --------------------+
−
+
−
  Many functions over datatypes can be defined by recursion on the+
−
  structure. For this purpose, Isabelle provides "fun". To use it one needs +
−
  to give a name for the function, its type, optionally some pretty-syntax +
−
  and then some equations defining the function. Like in "inductive",+
−
  "fun" expects that more than one such equation is separated by "|".+
−
+
−
  The Fibonacci function:+
−
+
−
*}+
−
+
−
fun+
−
  fib :: "nat \<Rightarrow> nat"+
−
where+
−
  "fib 0 = 1"+
−
| "fib (Suc 0) = 1"+
−
| "fib (Suc (Suc n)) = fib n + fib (Suc n)"+
−
+
−
text {* The Ackermann function: *}+
−
+
−
fun +
−
  ack :: "nat \<Rightarrow> nat \<Rightarrow> nat"+
−
where+
−
  "ack 0 m = Suc m"+
−
| "ack (Suc n) 0 = ack n (Suc 0)"+
−
| "ack (Suc n) (Suc m) = ack n (ack (Suc n) m)"+
−
+
−
text {*+
−
  Non-terminating functions can lead to inconsistencies.+
−
*}+
−
+
−
lemma+
−
  assumes a: "f x = f x + (1::nat)"+
−
  shows "False"+
−
proof -+
−
  from a have "0 = (1::nat)" by simp+
−
  then show "False" by simp+
−
qed+
−
+
−
text {*+
−
  If Isabelle cannot automatically prove termination,+
−
  then you can give an explicit measure that establishes+
−
  termination. For example a generalisation of the+
−
  Fibonacci function to integers can be shown terminating+
−
  +
−
*}+
−
+
−
function+
−
  fib' :: "int \<Rightarrow> int"+
−
where+
−
  "n< -1 \<Longrightarrow> fib' n = fib' (n + 2) - fib' (n + 1)"+
−
| "fib' -1 = (1::int)"+
−
| "fib' 0 = (0::int)"+
−
| "fib' 1 = (1::int)"+
−
| "n > 1 \<Longrightarrow> fib' n = fib' (n - 1) + fib' (n - 2)"+
−
  by (atomize_elim, presburger) (auto)+
−
+
−
termination+
−
  by (relation "measure (\<lambda>x. nat (\<bar>x\<bar>))")+
−
     (simp_all add: zabs_def)+
−
+
−
+
−
text {***************************************************************** +
−
+
−
  Datatypes+
−
  ---------+
−
+
−
  Datatypes can be defined in Isabelle as follows: we have to provide the name +
−
  of the datatype and list its type-constructors. Each type-constructor needs +
−
  to have the information about the types of its arguments, and optionally +
−
  can also contain some information about pretty syntax. For example, we write+
−
  "[]" for Nil and ":::" for Cons.+
−
+
−
*}+
−
+
−
datatype 'a mylist =+
−
  MyNil                   ("[]")+
−
| MyCons "'a" "'a mylist" ("_ ::: _" 65)+
−
+
−
text {*+
−
  You can easily define functions over the structure of datatypes.+
−
*}+
−
+
−
fun+
−
  myappend :: "'a mylist \<Rightarrow> 'a mylist \<Rightarrow> 'a mylist" ("_ @@ _" 65)+
−
where+
−
  "[] @@ xs = xs"+
−
| "(y:::ys) @@ xs = y:::(ys @@ xs)"+
−
+
−
fun+
−
  myrev :: "'a mylist \<Rightarrow> 'a mylist"+
−
where+
−
  "myrev [] = []"+
−
| "myrev (x:::xs) = (myrev xs) @@ (x:::[])"+
−
+
−
text {*****************************************************************+
−
+
−
  Exercise: Prove the following fact about append and reversal.+
−
+
−
*}+
−
+
−
lemma myrev_append:+
−
  shows "myrev (xs @@ ys) = (myrev ys) @@ (myrev xs)"+
−
proof (induct xs)+
−
  case MyNil+
−
  show "myrev ([] @@ ys) = myrev ys @@ myrev []" sorry+
−
next+
−
  case (MyCons x xs)+
−
  have ih: "myrev (xs @@ ys) = myrev ys @@ myrev xs" by fact+
−
  +
−
  show "myrev ((x:::xs) @@ ys) = myrev ys @@ myrev (x:::xs)" sorry+
−
qed+
−
+
−
+
−
+
−
+
−
+
−
+
−
+
−
+
−
+
−
+
−
+
−
+
−
+
−
+
−
+
−
+
−
text {* auxiliary lemmas *}+
−
+
−
lemma mynil_append[simp]:+
−
  shows "xs @@ [] = xs"+
−
by (induct xs) (auto)+
−
+
−
lemma myappend_assoc[simp]: +
−
  "(xs @@ ys) @@ zs = xs @@ (ys @@ zs)"+
−
by (induct xs) (auto)+
−
+
−
lemma +
−
  shows "myrev (xs @@ ys) = (myrev ys) @@ (myrev xs)"+
−
by (induct xs) (auto)+
−
+
−
text {***************************************************************** +
−
+
−
  A WHILE Language:+
−
+
−
  Arithmetic Expressions, Boolean Expressions, Commands+
−
  -----------------------------------------------------+
−
+
−
*}+
−
+
−
types memory = "nat \<Rightarrow> nat"+
−
+
−
datatype aexp = +
−
    C nat+
−
  | X nat+
−
  | Op1 "nat \<Rightarrow> nat" aexp+
−
  | Op2 "nat \<Rightarrow> nat \<Rightarrow> nat" aexp aexp+
−
+
−
datatype bexp = +
−
    TRUE+
−
  | FALSE+
−
  | ROp  "nat \<Rightarrow> nat \<Rightarrow> bool" aexp aexp+
−
  | NOT bexp+
−
  | AND bexp bexp  +
−
  | OR  bexp bexp+
−
+
−
datatype cmd = +
−
    SKIP                    +
−
  | ASSIGN nat aexp      ("_ ::= _ " 60)+
−
  | SEQ    cmd cmd       ("_; _" [60, 60] 10)+
−
  | COND   bexp cmd cmd  ("IF _ THEN _ ELSE _" 60)+
−
  | WHILE  bexp cmd      ("WHILE _ DO _" 60)+
−
+
−
text {***************************************************************** +
−
+
−
  Big-step Evaluation Semantics +
−
  -----------------------------+
−
+
−
*}+
−
+
−
inductive+
−
  evala :: "aexp \<Rightarrow> memory \<Rightarrow> nat \<Rightarrow> bool"  ("'(_,_') \<longrightarrow>a _" [100,100] 50)+
−
where+
−
  C:   "(C n, m) \<longrightarrow>a n"+
−
| X:   "(X i, m) \<longrightarrow>a m i" +
−
| Op1: "(e, m) \<longrightarrow>a n \<Longrightarrow> (Op1 f e, m) \<longrightarrow>a (f n)"+
−
| Op2: "\<lbrakk>(e0, m) \<longrightarrow>a n0;  (e1, m)  \<longrightarrow>a n1\<rbrakk> \<Longrightarrow> (Op2 f e0 e1, m) \<longrightarrow>a f n0 n1"+
−
+
−
inductive+
−
  evalb :: "bexp \<Rightarrow> memory \<Rightarrow> bool \<Rightarrow> bool"  ("'(_,_') \<longrightarrow>b _" [100,100] 50)+
−
where+
−
  TRUE:  "(TRUE, m) \<longrightarrow>b True"+
−
| FALSE: "(FALSE, m) \<longrightarrow>b False" +
−
| ROp:   "\<lbrakk>(e1, m) \<longrightarrow>a n1; (e2, m) \<longrightarrow>a n2\<rbrakk> \<Longrightarrow> (ROp f e1 e2, m) \<longrightarrow>b (f n1 n2)" +
−
| NOT:   "(e, m) \<longrightarrow>b b \<Longrightarrow> (NOT e, m) \<longrightarrow>b (Not b)"+
−
| AND:   "\<lbrakk>(e1, m) \<longrightarrow>b b1; (e2, m) \<longrightarrow>b b2\<rbrakk> \<Longrightarrow> (AND e1 e2, m) \<longrightarrow>b (b1 \<and> b2)"+
−
| OR:    "\<lbrakk>(e1, m) \<longrightarrow>b b1; (e2, m) \<longrightarrow>b b2\<rbrakk> \<Longrightarrow> (OR e1 e2, m) \<longrightarrow>b (b1 \<or> b2)"+
−
+
−
inductive+
−
  evalc :: "cmd \<Rightarrow> memory \<Rightarrow> memory \<Rightarrow> bool" ("'(_,_') \<longrightarrow>c _" [0,0,60] 60)+
−
where+
−
  SKIP:    "(SKIP, m) \<longrightarrow>c m"+
−
| ASSIGN:  "(a, m) \<longrightarrow>a n \<Longrightarrow> (x::=a, m) \<longrightarrow>c m(x:=n)"+
−
| SEQ:     "\<lbrakk>(c0, m) \<longrightarrow>c m'; (c1, m') \<longrightarrow>c m''\<rbrakk> \<Longrightarrow> (c0; c1, m) \<longrightarrow>c m''"+
−
| IFTrue:  "\<lbrakk>(e, m) \<longrightarrow>b True; (c0, m) \<longrightarrow>c m'\<rbrakk> \<Longrightarrow> (IF e THEN c0 ELSE c1, m) \<longrightarrow>c m'"+
−
| IFFalse: "\<lbrakk>(e, m) \<longrightarrow>b False; (c1, m) \<longrightarrow>c m'\<rbrakk> \<Longrightarrow> (IF e THEN c0 ELSE c1, m) \<longrightarrow>c m'"+
−
| WHILEFalse: "(e, m) \<longrightarrow>b False \<Longrightarrow> (WHILE e DO c,m) \<longrightarrow>c m"+
−
| WHILETrue:  "\<lbrakk>(e, m) \<longrightarrow>b True; (c,m) \<longrightarrow>c m'; (WHILE e DO c, m') \<longrightarrow>c m''\<rbrakk>+
−
               \<Longrightarrow> (WHILE e DO c, m) \<longrightarrow>c m''"+
−
+
−
lemmas evala.intros[intro] evalb.intros[intro] evalc.intros[intro]+
−
+
−
text {***************************************************************** +
−
+
−
  Machine Instructions+
−
  --------------------+
−
+
−
*}+
−
+
−
datatype instr = +
−
    JPFZ  "nat"               (* JUMP forward n steps, if top of stack is False *)+
−
  | JPB   "nat"               (* JUMP backward n steps *)+
−
  | FETCH "nat"               (* move memory to top of stack *)  +
−
  | STORE "nat"               (* move top of stack to memory *)+
−
  | PUSH  "nat"               (* push to stack *) +
−
  | OPU   "nat \<Rightarrow> nat"        (* pop one from stack and apply f *)+
−
  | OPB   "nat \<Rightarrow> nat \<Rightarrow> nat" (* pop two from stack and apply f *)+
−
+
−
text {***************************************************************** +
−
+
−
  Booleans 'as' Zero and One+
−
  --------------------------+
−
+
−
*}+
−
+
−
fun+
−
  WRAP::"bool\<Rightarrow>nat"+
−
where+
−
  "WRAP True = Suc 0"+
−
| "WRAP False = 0"+
−
+
−
fun+
−
  MNot::"nat \<Rightarrow> nat"+
−
where+
−
  "MNot 0 = 1"+
−
| "MNot (Suc 0) = 0"+
−
+
−
fun+
−
  MAnd::"nat \<Rightarrow> nat \<Rightarrow> nat"+
−
where+
−
  "MAnd 0 x = 0"+
−
| "MAnd x 0 = 0"+
−
| "MAnd (Suc 0) (Suc 0) = 1"+
−
+
−
fun+
−
  MOr::"nat \<Rightarrow> nat \<Rightarrow> nat"+
−
where+
−
  "MOr 0 0 = 0"+
−
| "MOr (Suc 0) x = 1"+
−
| "MOr x (Suc 0) = 1"+
−
+
−
lemma MNot_WRAP:+
−
  "MNot (WRAP b) = WRAP (Not b)"+
−
by (cases b) (auto)+
−
+
−
lemma MAnd_WRAP:+
−
  "MAnd (WRAP b1) (WRAP b2) = WRAP (b1 \<and> b2)"+
−
by (cases b1, auto) (cases b2, simp_all)+
−
+
−
+
−
lemma MOr_WRAP:+
−
  "MOr (WRAP b1) (WRAP b2) = WRAP (b1 \<or> b2)"+
−
by (cases b1, auto) (cases b2, simp_all)+
−
+
−
lemmas WRAP_lems = MNot_WRAP MAnd_WRAP MOr_WRAP+
−
+
−
text {***************************************************************** +
−
+
−
  Compiler Functions+
−
  ------------------+
−
+
−
*}+
−
+
−
fun+
−
 compa+
−
where+
−
  "compa (C n) = [PUSH n]"+
−
| "compa (X l) = [FETCH l]"+
−
| "compa (Op1 f e) = (compa e) @ [OPU f]"+
−
| "compa (Op2 f e1 e2) = (compa e1) @ (compa e2) @ [OPB f]"+
−
+
−
fun+
−
 compb+
−
where+
−
  "compb (TRUE) = [PUSH 1]"+
−
| "compb (FALSE) = [PUSH 0]"+
−
| "compb (ROp f e1 e2) = (compa e1) @ (compa e2) @ [OPB (\<lambda>x y. WRAP (f x y))]"+
−
| "compb (NOT e) = (compb e) @ [OPU MNot]"+
−
| "compb (AND e1 e2) = (compb e1) @ (compb e2) @ [OPB MAnd]"+
−
| "compb (OR e1 e2) = (compb e1) @ (compb e2) @ [OPB MOr]"+
−
+
−
fun+
−
  compc :: "cmd \<Rightarrow> instr list"+
−
where+
−
  "compc SKIP = []"+
−
| "compc (x::=a) = (compa a) @ [STORE x]"+
−
| "compc (c1;c2) = compc c1 @ compc c2"+
−
| "compc (IF b THEN c1 ELSE c2) =+
−
    (compb b) @ [JPFZ (length(compc c1) + 2)] @ compc c1 @   +
−
    [PUSH 0, JPFZ (length(compc c2))] @ compc c2" +
−
| "compc (WHILE b DO c) = +
−
    (compb b) @+
−
    [JPFZ (length(compc c) + 1)] @ compc c @+
−
    [JPB (length(compc c) + length(compb b)+1)]"+
−
+
−
value "compc SKIP"+
−
value "compc (SKIP; SKIP)"+
−
value "compa (Op2 (op +) (C 2) (C 3))"+
−
value "compb (ROp (op <) (C 2) (C 3))"+
−
value "compc (IF (ROp (op <) (C 2) (C 3)) THEN SKIP ELSE SKIP)"+
−
value "compc (WHILE (ROp (op <) (C 2) (C 3)) DO SKIP)"+
−
value "compc (x::= C 0; WHILE (ROp (op <) (X x) (C 3)) DO (x::= (Op2 (op +) (X x) (C 1))))"+
−
+
−
text {***************************************************************** +
−
+
−
  Machine Execution+
−
  -----------------+
−
+
−
*}+
−
+
−
types instrs = "instr list"+
−
types stack = "nat list"+
−
+
−
abbreviation +
−
 "rtake i xs \<equiv> rev (take i xs)"+
−
+
−
inductive+
−
  step :: "instrs \<Rightarrow> instrs \<Rightarrow> stack \<Rightarrow> memory \<Rightarrow> +
−
           instrs \<Rightarrow> instrs \<Rightarrow> stack \<Rightarrow> memory \<Rightarrow> bool" ("'(_,_,_,_') \<longrightarrow>m '(_,_,_,_')")+
−
where+
−
    "(PUSH n#p, q, s, m) \<longrightarrow>m (p, PUSH n#q, n#s, m)"+
−
  | "(FETCH i#p, q, s, m) \<longrightarrow>m (p, FETCH i#q, m i#s, m)"+
−
  | "(OPU f#p, q, n#s, m) \<longrightarrow>m (p, OPU f#q, f n#s, m)"+
−
  | "(OPB f#p, q, n1#n2#s, m) \<longrightarrow>m (p, OPB f#q, f n2 n1#s, m)"+
−
  | "(STORE i#p, q, n#s, m) \<longrightarrow>m (p, STORE i#q, s, m(i:=n))"+
−
  | "(JPFZ i#p, q, Suc 0#s, m) \<longrightarrow>m (p, JPFZ i#q, s, m)"+
−
  | "i\<le>length p\<Longrightarrow>(JPFZ i#p, q, 0#s, m) \<longrightarrow>m (drop i p, (rtake i p) @ (JPFZ i#q), s, m)"+
−
  | "i\<le>length q\<Longrightarrow>(JPB i#p, q, s, m) \<longrightarrow>m ((rtake i q) @ (JPB i#p), drop i q, s, m)"+
−
+
−
lemmas step.intros[intro]+
−
+
−
inductive_cases step_elim[elim]:+
−
   "(p,q,s,m) \<longrightarrow>m (p',q',s',m')"+
−
+
−
lemma exec_simp:+
−
  shows "(instr#p, q, s, m) \<longrightarrow>m (p', q', s', m') =+
−
    (case instr of+
−
        PUSH n \<Rightarrow> (p' = p \<and> q' = instr#q \<and> s' = n#s \<and> m' = m)+
−
      | FETCH i \<Rightarrow> (p' = p \<and> q' = instr#q \<and> s' = m i#s \<and> m' = m)     +
−
      | OPU f \<Rightarrow> (\<exists>n si. p' = p \<and> q' = instr#q \<and> s = n#si \<and> s' = f n#si \<and> m' = m) +
−
      | OPB f \<Rightarrow> (\<exists>n1 n2 si. p' = p \<and> q' = instr#q \<and> s = n1#n2#si \<and> s' = f n2 n1#si \<and> m' = m) +
−
      | STORE i \<Rightarrow> (\<exists>n si. p' = p \<and> q' = instr#q \<and> s = n#si \<and> s' = si \<and> m' = m(i:=n))+
−
      | JPFZ i \<Rightarrow> (\<exists>si. (p' = p \<and> q' = instr#q \<and> s = Suc 0#si \<and> s' = si \<and> m' = m) \<or>+
−
                        (i\<le> length p \<and> p' = (drop i p) \<and> q' = (rev (take i p))@(instr#q) +
−
                         \<and> s = 0#si \<and> s' = si \<and> m' = m )) +
−
      | JPB i \<Rightarrow> (i \<le> length q \<and> p' = (rtake i q)@(JPB i#p) \<and> q' = drop i q \<and> s' = s \<and> m' = m))"+
−
by (auto split: instr.split_asm split_if_asm)+
−
+
−
inductive+
−
  steps :: "instrs \<Rightarrow> instrs \<Rightarrow> stack \<Rightarrow> memory \<Rightarrow> +
−
            instrs \<Rightarrow> instrs \<Rightarrow> stack \<Rightarrow> memory \<Rightarrow> bool" ("'(_,_,_,_') \<longrightarrow>m* '(_,_,_,_')")+
−
where+
−
  refl: "(p,q,s,m) \<longrightarrow>m* (p,q,s,m)"+
−
| step: "\<lbrakk>(p1,q1,s1,m1) \<longrightarrow>m (p2,q2,s2,m2); (p2,q2,s2,m2) \<longrightarrow>m* (p3,q3,s3,m3)\<rbrakk> +
−
         \<Longrightarrow> (p1,q1,s1,m1) \<longrightarrow>m* (p3,q3,s3,m3)"+
−
+
−
lemmas steps.step[intro]+
−
lemmas steps.refl[simp]+
−
+
−
inductive_cases steps_elim[elim]:+
−
  "(p,q,s,m) \<longrightarrow>m* (p',q',s',m')"+
−
+
−
lemma steps_trans:+
−
  assumes a: "(p1,q1,s1,m1) \<longrightarrow>m* (p2,q2,s2,m2)" +
−
  and     b: "(p2,q2,s2,m2) \<longrightarrow>m* (p3,q3,s3,m3)" +
−
  shows "(p1,q1,s1,m1) \<longrightarrow>m* (p3,q3,s3,m3)"+
−
using a b by (induct) (auto)+
−
+
−
lemma steps_simp:+
−
  shows "(i#p,q,s,m) \<longrightarrow>m* (p',q',s',m') = +
−
        ((i#p,q,s,m) = (p',q',s',m') \<or> +
−
         (\<exists>pi qi si mi. (i#p,q,s,m) \<longrightarrow>m (pi,qi,si,mi) \<and> (pi,qi,si,mi) \<longrightarrow>m* (p',q',s',m')))"+
−
by (auto)+
−
+
−
lemma compa_first_attempt:+
−
  assumes a: "(e, m) \<longrightarrow>a n"+
−
  shows "(compa e, [], [], m) \<longrightarrow>m* ([], rev (compa e), [n], m)"+
−
using a+
−
proof (induct)+
−
  case (C n m)+
−
  show "(compa (C n),[],[],m) \<longrightarrow>m* ([],rev (compa (C n)),[n],m)" +
−
    sorry+
−
next+
−
  case (X i m)+
−
  show "(compa (X i),[],[],m) \<longrightarrow>m* ([],rev (compa (X i)),[m i],m)" +
−
    sorry+
−
next+
−
  case (Op1 e m n f)+
−
  have as: "(e, m) \<longrightarrow>a n" by fact+
−
  have ih: "(compa e,[],[],m) \<longrightarrow>m* ([],rev (compa e),[n],m)" by fact+
−
  show "(compa (Op1 f e),[],[],m) \<longrightarrow>m* ([],rev (compa (Op1 f e)),[f n],m)" +
−
    using ih sorry+
−
next+
−
  case (Op2 e0 m n0 e1 n1 f)+
−
  have as1: "(e0, m) \<longrightarrow>a n0" by fact+
−
  have as2: "(e1, m) \<longrightarrow>a n1" by fact+
−
  have ih1: "(compa e0,[],[],m) \<longrightarrow>m* ([],rev (compa e0),[n0],m)" by fact+
−
  have ih2: "(compa e1,[],[],m) \<longrightarrow>m* ([],rev (compa e1),[n1],m)" by fact+
−
  show "(compa (Op2 f e0 e1),[],[],m) \<longrightarrow>m* ([],rev (compa (Op2 f e0 e1)),[f n0 n1],m)" +
−
    using ih1[THEN steps_trans] ih2[THEN steps_trans] +
−
    sorry+
−
qed+
−
+
−
+
−
+
−
+
−
+
−
+
−
+
−
+
−
+
−
+
−
+
−
+
−
+
−
+
−
+
−
lemma compa_aux:+
−
  assumes a: "(e, m) \<longrightarrow>a n"+
−
  shows "(compa e@p, q, s, m) \<longrightarrow>m* (p, rev (compa e)@q, n#s, m)"+
−
using a+
−
proof (induct arbitrary: p q s)+
−
  case (C n m p q s)+
−
  show "(compa (C n)@p,q,s,m) \<longrightarrow>m* (p,rev (compa (C n))@q,n#s,m)" +
−
    by (simp add: steps_simp exec_simp)+
−
next+
−
  case (X i m p q s)+
−
  show "(compa (X i)@p,q,s,m) \<longrightarrow>m* (p,rev (compa (X i))@q,m i#s,m)" +
−
    by (simp add: steps_simp exec_simp)+
−
next+
−
  case (Op1 e m n f p q s)+
−
  have as: "(e, m) \<longrightarrow>a n" by fact+
−
  have ih: "\<And>p q s. (compa e@p,q,s,m) \<longrightarrow>m* (p,rev (compa e)@q,n#s,m)" by fact+
−
  show "(compa (Op1 f e)@p,q,s,m) \<longrightarrow>m* (p,rev (compa (Op1 f e))@q,f n#s,m)" +
−
    using ih[THEN steps_trans] by (simp add: steps_simp exec_simp)+
−
next+
−
  case (Op2 e0 m n0 e1 n1 f p q s)+
−
  have as1: "(e0, m) \<longrightarrow>a n0" by fact+
−
  have as2: "(e1, m) \<longrightarrow>a n1" by fact+
−
  have ih1: "\<And>p q s. (compa e0@p,q,s,m) \<longrightarrow>m* (p,rev (compa e0)@q,n0#s,m)" by fact+
−
  have ih2: "\<And>p q s. (compa e1@p,q,s,m) \<longrightarrow>m* (p,rev (compa e1)@q,n1#s,m)" by fact+
−
  show "(compa (Op2 f e0 e1)@p,q,s,m) \<longrightarrow>m* (p,rev (compa (Op2 f e0 e1))@q,f n0 n1#s,m)" +
−
    using ih1[THEN steps_trans] ih2[THEN steps_trans] +
−
    by (simp add: steps_simp exec_simp)+
−
qed+
−
+
−
+
−
text {*+
−
  After the fact I constructed the detailed proof, I +
−
  could guide Isabelle to find the proof automatically.+
−
+
−
  *B U T    T H A T    I S   C H E A T I N G!!!*+
−
*}+
−
+
−
lemma compa_aux_cheating:+
−
  assumes a: "(e,m) \<longrightarrow>a n"+
−
  shows "(compa e@p,q,s,m) \<longrightarrow>m* (p,rev (compa e)@q,n#s,m)"+
−
using a+
−
by (induct arbitrary: p q s)+
−
   (force intro: steps_trans simp add: steps_simp exec_simp)++
−
+
−
+
−
lemma compb_aux_cheating:+
−
  assumes a: "(e,m) \<longrightarrow>b b"+
−
  shows "(compb e@p,q,s,m) \<longrightarrow>m* (p,rev (compb e)@q,(WRAP b)#s,m)"+
−
using a+
−
by (induct arbitrary: p q s)+
−
   (force intro: compa_aux steps_trans +
−
          simp add: steps_simp exec_simp WRAP_lems)++
−
+
−
text {*+
−
  +
−
  Exercise: After you know the lemma is provable,+
−
  try to give all details.+
−
+
−
*}+
−
+
−
lemma compb_aux:+
−
  assumes a: "(e, m) \<longrightarrow>b b"+
−
  shows "(compb e@p, q, s, m) \<longrightarrow>m* (p, rev (compb e)@q, WRAP b#s, m)"+
−
using a+
−
proof (induct arbitrary: p q s)+
−
  case (TRUE m p q s)+
−
  show "(compb TRUE@p,q,s,m) \<longrightarrow>m* (p,rev (compb TRUE)@q,WRAP True#s,m)"+
−
    sorry+
−
next+
−
  case (FALSE m p q s)+
−
   show "(compb FALSE@p,q,s,m) \<longrightarrow>m* (p,rev (compb FALSE)@q,WRAP False#s,m)"+
−
    sorry+
−
next+
−
  case (ROp e1 m n1 e2 n2 f p q s)+
−
  have as1: "(e1, m) \<longrightarrow>a n1" by fact+
−
  have as2: "(e2, m) \<longrightarrow>a n2" by fact+
−
  show "(compb (ROp f e1 e2)@p,q,s,m) +
−
          \<longrightarrow>m* (p,rev (compb (ROp f e1 e2))@q,WRAP (f n1 n2)#s,m)"+
−
    using as1 as2 sorry+
−
next+
−
  case (NOT e m b p q s)+
−
  have ih: "\<And>p q s. (compb e@p,q,s,m) \<longrightarrow>m* (p,rev (compb e)@q,WRAP b#s,m)" by fact+
−
  show "(compb (NOT e)@p,q,s,m) \<longrightarrow>m* (p,rev (compb (NOT e))@q,WRAP (\<not>b)#s,m)"+
−
    using ih[THEN steps_trans] +
−
    sorry+
−
next+
−
  case (AND e1 m b1 e2 b2 p q s)+
−
  have ih1: "\<And>p q s. (compb e1@p,q,s,m) \<longrightarrow>m* (p,rev (compb e1)@q,WRAP b1#s,m)" by fact+
−
  have ih2: "\<And>p q s. (compb e2@p,q,s,m) \<longrightarrow>m* (p,rev (compb e2)@q,WRAP b2#s,m)" by fact+
−
  show "(compb (AND e1 e2)@p,q,s,m) \<longrightarrow>m* (p,rev (compb (AND e1 e2))@q,WRAP (b1 \<and> b2)#s,m)"+
−
    using ih1[THEN steps_trans] ih2[THEN steps_trans]+
−
    sorry+
−
next+
−
  case (OR e1 m b1 e2 b2 p q s)+
−
  have ih1: "\<And>p q s. (compb e1@p,q,s,m) \<longrightarrow>m* (p,rev (compb e1)@q,WRAP b1#s,m)" by fact+
−
  have ih2: "\<And>p q s. (compb e2@p,q,s,m) \<longrightarrow>m* (p,rev (compb e2)@q,WRAP b2#s,m)" by fact+
−
  show "(compb (OR e1 e2)@p,q,s,m) \<longrightarrow>m* (p,rev (compb (OR e1 e2))@q,WRAP (b1 \<or> b2)#s,m)"+
−
    using ih1[THEN steps_trans] ih2[THEN steps_trans]+
−
    sorry+
−
qed+
−
+
−
text {*+
−
  +
−
  Also the detailed proof of this lemma is left as an exercise.+
−
+
−
*}+
−
+
−
lemma compc_aux_cheating:+
−
  assumes a: "(c,m) \<longrightarrow>c m'"+
−
  shows "(compc c@p,q,s,m) \<longrightarrow>m* (p,rev (compc c)@q,s,m')"+
−
using a+
−
by (induct arbitrary: p q)+
−
   (force intro: compa_aux compb_aux_cheating steps_trans +
−
            simp add: steps_simp exec_simp)++
−
+
−
end    +
−
   +
−
+
−
+
−
+
−
  +
−
+
−
  +
−
  +
−
+
−
+
−