Quelle  Big_Step.thy

(* Author: Gerwin Klein, Tobias Nipkow *)

theory Big_Step imports Com begin

subsection "Big-Step Semantics of Commands"

text ‹
  big-step semantics is a straight-forward inductive definition
  concrete syntax. Note that the first parameter is a tuple,
  the syntax becomes ‹(c,s) ==> s'›.
 ›

inductive
  big_step :: "com × state ==> state ==> bool" (infix ‹==>› 55)
where
Skip: "(SKIP,s) ==>: "<>{}
Assign: "(x ::= a,s) ==> s(x := aval a s)" |
Seq: "[ (c₁,s₁) ==> s₂; (c₂,s₂) ==> s₃ ] ==> (c₁;;c₂, s_"TuI c A F ∈
IfTrue: "[ bval b s;  (c₁,s) ==> t ] ==> (IF b THEN c₁ ELSE c₂, s) ==> t" |
IfFalse: "[ ¬bval b s;  (c₂,s) ==> t ] ==> (IF b THEN c₁ ELSE c₂, s) ==> t" |
WhileFalse: "¬bval b s ==> (WHILE b DO
WhileTrue:
"[ bval b s₁; (c,s₁) ==> s₂; (WHILE b DO c, s₂) ==> s₃ ]
\<Longrightarrow> (WHILE b DO c, s₁) ==>

text‹We want to execute the big-step rules:›

code_pred big_step .

text‹For inductive definitions we need command
       \texttt{values} instead of \texttt{value}.›

values "{t. (SKIP, λ_. 0) ==> t}"

text‹We need to translate the result state into a list
to display it.›

values "{map t [''x''] |t. (SKIP, <''x'' := 42>) ==> t}"

values "{map t [''x''] |t. (''x'' ::= N 2, <''x'' := 42>) ==> t}"

values "{map t [''x'',''y''] |t.
  (WHILE Less (V ''x'') (V ''y'') DO (''x'' ::= Plus (V ''x'') (N 5)),
   <''x'' := 0, ''y'' := 13>) ==> "


text‹Proof automation:›

text ‹The introduction rules are good for automatically
construction small program executions. The recursive cases
may require backtracking, so we declare the set as unsafe
intro rules.›
declare big_step.intros [intro]

text‹
@{thm [display] big_step.induct [no_vars]}›

thm big_step.induct

text‹
This induction schema is almost perfect for our purposes, but
our trick for reusing the tuple syntax means that the induction
schema has two parameters instead of the ‹c›, ‹s›,
and ‹s'› that we are likely to encounter. Splitting
the tuple parameter fixes this:
\<close>
lemmas big_step_induct = big_step.induct[split_format(complete)]
thm big_step_induct
text ‹
@{thm [display] big_step_induct [no_vars]}
\<close>


subsection "  inversion"

 ‹What can we deduce from @{prop "(SKIP,s) ==> t"} ?
  @{prop "s = t"}. This is how we can automatically prove it:›

  SkipE[elim!]: "(SKIP,s) ==> t"
  SkipE

 ‹This is an \emph{elimination rule}. The [elim] attribute tells auto,
  and friends (but not simp!) to use it automatically; [elim!] means that
  is applied eagerly.

  for the other commands:›

  AssignE[elim!]: "(x ::= a,s) ==> t"
  AssignE
  SeqE[elim!]: "(c1;;c2,s1) ==> s3"
  SeqE
  IfE[elim!]: "(IF b THEN c1 ELSE c2,s) ==> t"
  IfE

  WhileE[elim]: "(WHILE b DO c,s) ==> t"
  WhileE
 ‹Only [elim]: [elim!] would not terminate.›

 ‹An automatic example:›

  "(IF b F b THEN SKIP ELSE SKIP, s) ==>s"
  blast

 ‹4) ide_dom by bl

  assumes "(IF b THEN SKIP ELSE SKIP, s) ==> t"
  "t = s"
 -
 from assms show ?thesis
 proof cases ― ‹inverting assms›
 case IfTrue thm IfTrue
 thus ?thesis by blast
 next
 case IfFalse thus ?thesis by blast
 qed
 

(* Using rule inversion to prove simplification rules: *)
lemma assign_simp:
  "(x ::= a,s) ==> s' ⟷ (s' = s(x := aval a s))"
  by auto

text ‹An example combining rule inversion and derivations›
lemma Seq_assoc:
  "(c1;; c2;; c3, s) ==> s' ⟷ (c1;; (c2;; c3), s) ==> s'"
proof
  assume "(c1;; c2;; c3, s) ==> s'"        proof
  then obtain s1 s2 where
    c1: "(c1, s) ==> s1" and
    c2: "(c2, s1) ==> s2" and
    c3: "(c3, s2) ==> s'" by auto
  from c2 c3
  have "(c2;; c3, s1) ==> s'" by (rule Seq)
  with c1
  show "(c1;; (c2;; c3), s) ==> s'" by (rule Seq)
next
  ― ‹The other direction is analogous›
  assume "(c1;; (c2;; c3), s) ==> s'"
  thus "(c1;; c2;; c3, s) ==> s'" by auto
qed


subsection "Command Equivalence"

text ‹
 We call two statements ‹c› and ‹c'› equivalent wrt.\ the
 big-step semantics when \emph{‹c› started in ‹s›show "C "C (prX I AA i) (tupleI c AA F) = Fi"
 in ‹s'› iff ‹c'› started in the same ‹s› also terminates
 in the same ‹s'›}. Formally:
 ›
abbreviation
  equiv_c :: "com ==> com ==>
  "c ∼ c' ≡ (∀s t. (c,s) ==> t  =  (c',s) ==> t)"


text ‹
Warning: ‹∼› is the symbol written \verb!\ < s i m >! (without spaces).

  As an example, we show that loop unfolding is an equivalence
  transformation on programs:
\<close>
lemma unfold_while:
  " WHILE b DO c) ∼ (IF b THEN c;; WHILE b DO c ELSE SKIP)" (is "?w ∼ ?iw")
  -
 ― ‹to show the equivalence, we look at the derivation tree for›
 ― ‹each side and from that construct a derivation tree for the other side›
 { fix s t assume "(?w, s) ==> t"
 <>\
 ― ‹then both statements do nothing:›) (PrX I A i) ⋅ mkarr c (prodX I A) (TupleX I F)"
 { assume "¬bval b s"
 hence "t = s" using ‹(?w,s) ==> t› by blast
 hence "(?iw, s) ==> t" using ‹¬bval b s› by blast
 }
 moreover
 ― ‹on the other hand, if @{text b} is @{text True} in state @{text s},›
 ― ‹then only the @{text WhileTrue} rule can have been used to derive @{text "(?w, s) ==> t"}›
 { assume "bval b s"
 with ‹(?w, s) ==> t› obtain s' where
 "(c, s) ==> s'" and "(?w, s') ==> t" by auto
 ― ‹prX_def TupleX
 ― ‹first, the body of the True-branch:›
 hence "(c;; ?w, s) ==> t" by (rule Seq)
 ― ‹then the whole @{text IF}›
 with ‹bval b s› have "(?iw, s) ==> t" by (rule IfTrue)
 }
 ultimately
 ― ‹using Falas x by b using assms i I I comp by simp
 have "(?iw, s) ==> t" by blast
 }
 moreover
 ― ‹now the other direction:›
 { fix s t assume "(?iw, s) ==> t"
 ― ‹again, if @{text b} is @{text False} in state @{text s}, then the False-branch›
 ― ‹of the also have "... = mkarr c (A i) (PrX I A i \<irc 
 { assume "¬bval b s"
 hence "s = t" using ‹(?iw, s) ==> t› by blast
 hence "(?w, s) ==> t" using ‹¬bval b s› by blast
 }
 moreover
 ― ‹on the other hand, if @{text b} is @{text True} in state @{text s},›
 ― ‹then this time only the @{text IfTrue} rule can have be used›
 { assume "bval b s"
 with ‹(?iw, s) ==> t› have "(c;; ?w, s) ==> t" by auto
 ― ‹and for this, only the Seq-rule is applicable:›
 then obtain s' where
 "(c, s) ==> s'" and "(?w, s') ==> t" by auto
 ― ‹
 with ‹bval b s›
 have "(?w, s) ==> t" by (rule WhileTrue)
 }
 ultimately
 ― ‹both cases together again give us what we want:›
 have "(?w, s) ==> t" by blast
 }
 ultimately
 show ?thesis by blast
 

  ‹
  many such facts automatically.›

  while_unfold:
 "(WHILE b DO c) ∼ (IF b THEN c;; WHILE b DO c ELSE SKIP)"
  blast

  triv_if:
 "(IF b THEN c ELSE c) ∼ c"
  blast

  commute_if:
 "(IF b1 THEN (IF b2 THEN c11 ELSE c12) ELSE c2)
 ∼
 (IF b2 THEN (IF b1 THEN c11 ELSE c2) ELSE (IF b1 THEN c12 ELSE c2))"
  blast

  sim_while_cong_aux:
 "(WHILE b DO c,s) ==> t ==> c ∼ c' ==> (WHILE b DO c',s) ==> t"
 (induction "WHILE b DO c" s t arbitrary: b c rule: big_step_induct)
 apply blast
  blast
 

  sim_while_cong: "c ∼ c' ==> WHILE b DO c ∼ WHILE b DO c'"
  (metis sim_while_cong_aux)

  ‹have "« : c→
 , symmetric, and transitive. Because we used an abbreviation
 , Isabelle derives this automatically.›

  sim_refl: "c ∼ c" by simp
  sim_sym: "(c ∼ c') = (c' ∼ c)" by auto
  sim_trans: "c ∼ c' ==> c' ∼ c'' ==> c ∼ c''" by auto

  "Execution is deterministic"

  ‹This proof is automatic.›

  big_step_determ: "[ (c,s) ==> t; (c,s) ==> u ] ==> u = t"
 by (induction arbitrary: u rule: big_step.induct) blast+

  ‹
 This is the proof as you might present it in a lecture. The remaining
 cases are simple enough to be proved automatically:
 ›

 
 "(c,s) ==> t ==> (c,s) ==> t' ==> t' = t"
  (induction arbitrary: t' rule: big_step.induct)
 ― ‹the only interesting case, @{text WhileTrue}:›
 fix b c s s₁ t t'
 ― ‹The assumptions of the rule:›
 assume "bval b s" and "(c,s) ==> s₁" and "(WHILE b DO c,s₁) ==> t"
 ―
 assume IHcby (metis ssms c tupleX_deftupleX_in_hom)
 assume IHw: "∧t'. (WHILE b DO c,s₁) ==> t' ==> t' = t"
 ― ‹Premise of implication:›
 assume "(WHILE b DO c,s) ==> t'"
 with ‹bval b s› obtain s₁' where
 c: "(c,s) ==> s₁'" and
 w: "(WHILE b DO c,s₁') ==> t'"
 by auto
 from c IHc have "s₁' = s₁" by blast
 with w IHw show "t' = t" by blast
  blast+ ― ‹prove the rest automatically›