Theory Eval

(*  Title:      HOL/MicroJava/J/Eval.thy
    Author:     David von Oheimb
    Copyright   1999 Technische Universitaet Muenchen
*)

section ‹Operational Evaluation (big step) Semantics›

theory Eval imports State WellType begin


  ― ‹Auxiliary notions›

definition fits :: "java_mb prog ⇒ state ⇒ val ⇒ ty ⇒ bool" ("_,_⊢_ fits _"[61,61,61,61]60) where
 "G,s⊢a' fits T  ≡ case T of PrimT T' ⇒ False | RefT T' ⇒ a'=Null ∨ G⊢obj_ty(lookup_obj s a')≼T"

definition catch :: "java_mb prog ⇒ xstate ⇒ cname ⇒ bool" ("_,_⊢catch _"[61,61,61]60) where
 "G,s⊢catch C≡  case abrupt s of None ⇒ False | Some a ⇒ G,store s⊢ a fits Class C"

definition lupd :: "vname ⇒ val ⇒ state ⇒ state" ("lupd'(_↦_')"[10,10]1000) where
 "lupd vn v   ≡ λ (hp,loc). (hp, (loc(vn↦v)))"

definition new_xcpt_var :: "vname ⇒ xstate ⇒ xstate" where
 "new_xcpt_var vn ≡  λ(x,s). Norm (lupd(vn↦the x) s)"


  ― ‹Evaluation relations›

inductive
  eval :: "[java_mb prog,xstate,expr,val,xstate] => bool "
          ("_ ⊢ _ -_≻_-> _" [51,82,60,82,82] 81)
  and evals :: "[java_mb prog,xstate,expr list,
                        val list,xstate] => bool "
          ("_ ⊢ _ -_[≻]_-> _" [51,82,60,51,82] 81)
  and exec :: "[java_mb prog,xstate,stmt,    xstate] => bool "
          ("_ ⊢ _ -_-> _" [51,82,60,82] 81)
  for G :: "java_mb prog"
where

  ― ‹evaluation of expressions›

  XcptE:"G⊢(Some xc,s) -e≻undefined-> (Some xc,s)"  ― ‹cf. 15.5›

  ― ‹cf. 15.8.1›
| NewC: "[| h = heap s; (a,x) = new_Addr h;
            h'= h(a↦(C,init_vars (fields (G,C)))) |] ==>
         G⊢Norm s -NewC C≻Addr a-> c_hupd h' (x,s)"

  ― ‹cf. 15.15›
| Cast: "[| G⊢Norm s0 -e≻v-> (x1,s1);
            x2 = raise_if (¬ cast_ok G C (heap s1) v) ClassCast x1 |] ==>
         G⊢Norm s0 -Cast C e≻v-> (x2,s1)"

  ― ‹cf. 15.7.1›
| Lit:  "G⊢Norm s -Lit v≻v-> Norm s"

| BinOp:"[| G⊢Norm s -e1≻v1-> s1;
            G⊢s1     -e2≻v2-> s2;
            v = (case bop of Eq  => Bool (v1 = v2)
                           | Add => Intg (the_Intg v1 + the_Intg v2)) |] ==>
         G⊢Norm s -BinOp bop e1 e2≻v-> s2"

  ― ‹cf. 15.13.1, 15.2›
| LAcc: "G⊢Norm s -LAcc v≻the (locals s v)-> Norm s"

  ― ‹cf. 15.25.1›
| LAss: "[| G⊢Norm s -e≻v-> (x,(h,l));
            l' = (if x = None then l(va↦v) else l) |] ==>
         G⊢Norm s -va::=e≻v-> (x,(h,l'))"

  ― ‹cf. 15.10.1, 15.2›
| FAcc: "[| G⊢Norm s0 -e≻a'-> (x1,s1); 
            v = the (snd (the (heap s1 (the_Addr a'))) (fn,T)) |] ==>
         G⊢Norm s0 -{T}e..fn≻v-> (np a' x1,s1)"

  ― ‹cf. 15.25.1›
| FAss: "[| G⊢     Norm s0  -e1≻a'-> (x1,s1); a = the_Addr a';
            G⊢(np a' x1,s1) -e2≻v -> (x2,s2);
            h  = heap s2; (c,fs) = the (h a);
            h' = h(a↦(c,(fs((fn,T)↦v)))) |] ==>
         G⊢Norm s0 -{T}e1..fn:=e2≻v-> c_hupd h' (x2,s2)"

  ― ‹cf. 15.11.4.1, 15.11.4.2, 15.11.4.4, 15.11.4.5, 14.15›
| Call: "[| G⊢Norm s0 -e≻a'-> s1; a = the_Addr a';
            G⊢s1 -ps[≻]pvs-> (x,(h,l)); dynT = fst (the (h a));
            (md,rT,pns,lvars,blk,res) = the (method (G,dynT) (mn,pTs));
            G⊢(np a' x,(h,(init_vars lvars)(pns[↦]pvs, This↦a'))) -blk-> s3;
            G⊢ s3 -res≻v -> (x4,s4) |] ==>
         G⊢Norm s0 -{C}e..mn({pTs}ps)≻v-> (x4,(heap s4,l))"


  ― ‹evaluation of expression lists›

  ― ‹cf. 15.5›
| XcptEs:"G⊢(Some xc,s) -e[≻]undefined-> (Some xc,s)"

  ― ‹cf. 15.11.???›
| Nil:  "G⊢Norm s0 -[][≻][]-> Norm s0"

  ― ‹cf. 15.6.4›
| Cons: "[| G⊢Norm s0 -e  ≻ v -> s1;
            G⊢     s1 -es[≻]vs-> s2 |] ==>
         G⊢Norm s0 -e#es[≻]v#vs-> s2"


  ― ‹execution of statements›

  ― ‹cf. 14.1›
| XcptS:"G⊢(Some xc,s) -c-> (Some xc,s)"

  ― ‹cf. 14.5›
| Skip: "G⊢Norm s -Skip-> Norm s"

  ― ‹cf. 14.7›
| Expr: "[| G⊢Norm s0 -e≻v-> s1 |] ==>
         G⊢Norm s0 -Expr e-> s1"

  ― ‹cf. 14.2›
| Comp: "[| G⊢Norm s0 -c1-> s1;
            G⊢     s1 -c2-> s2|] ==>
         G⊢Norm s0 -c1;; c2-> s2"

  ― ‹cf. 14.8.2›
| Cond: "[| G⊢Norm s0  -e≻v-> s1;
            G⊢ s1 -(if the_Bool v then c1 else c2)-> s2|] ==>
         G⊢Norm s0 -If(e) c1 Else c2-> s2"

  ― ‹cf. 14.10, 14.10.1›
| LoopF:"[| G⊢Norm s0 -e≻v-> s1; ¬the_Bool v |] ==>
         G⊢Norm s0 -While(e) c-> s1"
| LoopT:"[| G⊢Norm s0 -e≻v-> s1;  the_Bool v;
      G⊢s1 -c-> s2; G⊢s2 -While(e) c-> s3 |] ==>
         G⊢Norm s0 -While(e) c-> s3"


lemmas eval_evals_exec_induct = eval_evals_exec.induct [split_format (complete)]

lemma NewCI: "[|new_Addr (heap s) = (a,x);  
       s' = c_hupd ((heap s)(a↦(C,init_vars (fields (G,C))))) (x,s)|] ==>  
       G⊢Norm s -NewC C≻Addr a-> s'"
apply simp
apply (rule eval_evals_exec.NewC)
apply auto
done

lemma eval_evals_exec_no_xcpt: 
 "!!s s'. (G⊢(x,s) -e ≻  v -> (x',s') --> x'=None --> x=None) ∧  
          (G⊢(x,s) -es[≻]vs-> (x',s') --> x'=None --> x=None) ∧  
          (G⊢(x,s) -c       -> (x',s') --> x'=None --> x=None)"
apply(simp only: split_tupled_all)
apply(rule eval_evals_exec_induct)
apply(unfold c_hupd_def)
apply(simp_all)
done

lemma eval_no_xcpt: "G⊢(x,s) -e≻v-> (None,s') ==> x=None"
apply (drule eval_evals_exec_no_xcpt [THEN conjunct1, THEN mp])
apply (fast)
done

lemma evals_no_xcpt: "G⊢(x,s) -e[≻]v-> (None,s') ==> x=None"
apply (drule eval_evals_exec_no_xcpt [THEN conjunct2, THEN conjunct1, THEN mp])
apply (fast)
done

lemma exec_no_xcpt: "G ⊢ (x, s) -c-> (None, s')
⟹ x = None"
apply (drule eval_evals_exec_no_xcpt [THEN conjunct2 [THEN conjunct2], rule_format])
apply simp+
done


lemma eval_evals_exec_xcpt: 
"!!s s'. (G⊢(x,s) -e ≻  v -> (x',s') --> x=Some xc --> x'=Some xc ∧ s'=s) ∧  
         (G⊢(x,s) -es[≻]vs-> (x',s') --> x=Some xc --> x'=Some xc ∧ s'=s) ∧  
         (G⊢(x,s) -c       -> (x',s') --> x=Some xc --> x'=Some xc ∧ s'=s)"
apply (simp only: split_tupled_all)
apply (rule eval_evals_exec_induct)
apply (unfold c_hupd_def)
apply (simp_all)
done

lemma eval_xcpt: "G⊢(Some xc,s) -e≻v-> (x',s') ==> x'=Some xc ∧  s'=s"
apply (drule eval_evals_exec_xcpt [THEN conjunct1, THEN mp])
apply (fast)
done

lemma exec_xcpt: "G⊢(Some xc,s) -s0-> (x',s') ==> x'=Some xc ∧  s'=s"
apply (drule eval_evals_exec_xcpt [THEN conjunct2, THEN conjunct2, THEN mp])
apply (fast)
done


lemma eval_LAcc_code: "G⊢Norm (h, l) -LAcc v≻the (l v)-> Norm (h, l)"
using LAcc[of G "(h, l)" v] by simp

lemma eval_Call_code:
  "[| G⊢Norm s0 -e≻a'-> s1; a = the_Addr a';
      G⊢s1 -ps[≻]pvs-> (x,(h,l)); dynT = fst (the (h a));
      (md,rT,pns,lvars,blk,res) = the (method (G,dynT) (mn,pTs));
      G⊢(np a' x,(h,(init_vars lvars)(pns[↦]pvs, This↦a'))) -blk-> s3;
      G⊢ s3 -res≻v -> (x4,(h4, l4)) |] ==>
   G⊢Norm s0 -{C}e..mn({pTs}ps)≻v-> (x4,(h4,l))"
using Call[of G s0 e a' s1 a ps pvs x h l dynT md rT pns lvars blk res mn pTs s3 v x4 "(h4, l4)" C]
by simp

lemmas [code_pred_intro] = XcptE NewC Cast Lit BinOp
lemmas [code_pred_intro LAcc_code] = eval_LAcc_code
lemmas [code_pred_intro] = LAss FAcc FAss
lemmas [code_pred_intro Call_code] = eval_Call_code
lemmas [code_pred_intro] = XcptEs Nil Cons XcptS Skip Expr Comp Cond LoopF 
lemmas [code_pred_intro LoopT_code] = LoopT

code_pred
  (modes: 
    eval: i ⇒ i ⇒ i ⇒ o ⇒ o ⇒ bool
  and
    evals: i ⇒ i ⇒ i ⇒ o ⇒ o ⇒ bool
  and
    exec: i ⇒ i ⇒ i ⇒ o ⇒ bool)
  eval
proof -
  case eval
  from eval.prems show thesis
  proof(cases (no_simp))
    case LAcc with eval.LAcc_code show ?thesis by auto
  next
    case (Call a b c d e f g h i j k l m n o p q r s t u v s4)
    with eval.Call_code show ?thesis
      by(cases "s4") auto
  qed(erule (3) eval.that[OF refl]|assumption)+
next
  case evals
  from evals.prems show thesis
    by(cases (no_simp))(erule (3) evals.that[OF refl]|assumption)+
next
  case exec
  from exec.prems show thesis
  proof(cases (no_simp))
    case LoopT thus ?thesis by(rule exec.LoopT_code[OF refl])
  qed(erule (2) exec.that[OF refl]|assumption)+
qed

end