Theory Cachera

(*File: Cachera.thy
  Author: L Beringer & M Hofmann, LMU Munich
  Date: 05/12/2008
  Purpose: Strong interpretation of, and derived proof system for,
           heap analysis a la Cachera/Jensen/Pichardie/Schneider,
           using invariants.
*)
(*<*)
theory Cachera imports Logic begin
(*>*)

section‹A derived logic for a strong type system›

text‹In this section we consider a system of derived assertions, for
a type system for bounded heap consumption. The type system arises by
reformulating the analysis of Cachera, Jensen, Pichardie, and
Schneider cite"CaJePiSc05MemoryUsage" for a high-level functional
language. The original approach of Cachera et al.~consists of
formalising the correctness proof of a certain analysis technique in
Coq. Consequently, the verification of a program requires the
execution of the analysis algorithm inside the theorem prover, which
involves the computation of the (method) call graph and fixed point
iterations.  In contrast, our approach follows the proof-carrying code
paradigm more closely: the analysis amounts to a type inference which
is left unformalised and can thus be carried out outside the trusted
code base. Only the result of the analysis is communicated to the code
recipient.  The recipient verifies the validity of the certificate by
a largely syntax-directed single-pass traversal of the (low-level)
code using a domain-specific program logic. This approach to
proof-carrying code was already explored in the MRG project, with
respect to program logics of partial correctness
cite"BeringerHofmannMomiglianoShkaravska:LPAR2004" and a type system
for memory consumption by Hofmann and
Jost~cite"HofmannJost:POPL2003". In order to obtain
syntax-directedness of the proof rules, these had to be formulated at
the granularity of typing judgements. In contrast, the present proof
system admits proof rules for individual JVM instructions.

Having derived proof rules for individual JVM instructions, we
introduce a type system for a small functional language, and a
compilation into bytecode.  The type system associates a natural
number $n$ to an expression $e$, in a typing context
$\Sigma$. Informally, the interpretation of a typing judgement
$\Sigma \rhd e:n$ is that the evaluation of $e$ (which may include
the invocation of functions whose resource behaviour is specified in
$\Sigma$) does not perform more than $n$ allocations. The type system
is then formally proven sound, using the derived logic for bytecode.
By virtue of the invariants, the guarantee given by the present system
is stronger than the one given by our encoding of the Hofmann-Jost
system, as even non-terminating programs can be verified in a
meaningful way.›

subsection‹Syntax and semantics of judgements›

text‹The formal interpretation at JVM level of a type n› is
given by a triple $$\mathit{Cachera}(n) = (A, B, I)$$ consisting of a
(trivial) precondition, a post-condition, and a strong invariant.›

definition Cachera::"nat  (Assn × Post × Inv)" where
"Cachera n = (λ s0 s . True,
              λ s0 (ops,s,h) (k,v) . |k|  |h| + n,
              λ s0 (ops,s,h) k.  |k|  |h| + n)"

text‹This definition is motivated by the expectation that $\rhd
\lbrace A \rbrace\; \ulcorner\, e \urcorner\, \lbrace B \rbrace\, I$
should be derivable whenever the type judgement $\Sigma \rhd e:n$
holds, where $ \ulcorner e \urcorner$ is the translation of compiling
the expression $e$ into JVML, and the specification table MST›
contains the interpretations of the entries in $\Sigma$.›

text‹We abbreviate the above construction of judgements by a
predicate deriv›.›

definition deriv::"CTXT  Class  Method  Label  
                    (Assn × Post × Inv)  bool" where
"deriv G C m l (ABI) = (let (A,B,I) = ABI in (G   A  C,m,l  B  I))"

text‹Thus, the intended interpretation of a typing judgement $\Sigma
\rhd e: n$ is $$\mathit{deriv}\; C\; m\; l\; (\mathit{Cachera}\; n)$$
if $e$ translates to a code block whose first instruction is at
$C.m.l$.›

text‹We also define a judgement of the auxiliary form of
sequents.›

definition derivAssum::"CTXT  Class  Method  Label  
                         (Assn × Post × Inv)  bool" where
"derivAssum G C m l (ABI) = (let (A,B,I) = ABI in G    A  C,m,l  B  I)"

text‹The following operation converts a derived judgement into the
syntactical form of method specifications.›

definition mkSPEC::"(Assn × Post × Inv)  ANNO 
                   (MethSpec × MethInv × ANNO)" where
"mkSPEC (ABI) Anno = (let (A,B,I) = ABI in
       (λ s0 t . B s0 (mkState s0) t, λ s0 h . I s0 (mkState s0) h, Anno))"

text‹This enables the interpretation of typing contexts $\Sigma$ as a
set of constraints on the specification table MST›.›

subsection‹Derived proof rules›
(*<*)
declare Let_def[simp]
(*>*)
text‹We are now ready to prove derived rules, i.e.~proof rules where
assumptions as well as conclusions are of the restricted assertion
form. While their justification unfolds the definition of the
predicate deriv›, their application will not. We first give
syntax-directed proof rules for all JVM instructions:›

lemma CACH_NEW:
 " ins_is C m l (new c); MST(C,m)=Some(Mspec,Minv,Anno);
    Anno(l) = None; n = k + 1; derivAssum G C m (l+1) (Cachera k) 
  deriv G C m l (Cachera n)"
(*<*)
apply (simp add: ins_is_def Cachera_def deriv_def derivAssum_def, clarsimp)
apply (rule INSTR) apply assumption+ apply simp apply (simp add: heap_def)
apply fast
apply (erule CONSEQ)
apply (simp add: SP_pre_def) 
apply clarsimp apply (simp add: SP_post_def) apply clarsimp
  apply (drule NewElim1, fastforce) apply clarsimp
  apply (subgoal_tac "ba(nextLoc ba) = None")
    apply (simp add: AL_Size_UpdateSuc) 
  apply (rule nextLoc_fresh)
apply clarsimp
  apply (simp add: SP_inv_def)
  apply clarsimp
  apply (drule NewElim1, fastforce) apply clarsimp
  apply (subgoal_tac "ba(nextLoc ba) = None")
    apply (simp add: AL_Size_UpdateSuc) 
  apply (rule nextLoc_fresh)
done
(*>*)

lemma CACH_INSTR:
 " ins_is C m l I; 
    I  { const c, dup, pop, swap, load x, store x, binop f, 
          unop g, getfield d F, putfield d F, checkcast d}; 
    MST(C,m)=Some(Mspec,Minv,Anno); Anno(l) = None; 
    derivAssum G C m (l+1) (Cachera n) 
  deriv G C m l (Cachera n)"
(*<*)
apply (simp add: ins_is_def Cachera_def deriv_def derivAssum_def, clarsimp)
apply (rule INSTR) apply assumption+ apply simp apply (simp add: heap_def)
apply fast
apply (erule CONSEQ)
apply (simp add: SP_pre_def) 
apply (simp add: SP_post_def) apply clarsimp 
apply safe
apply (drule ConstElim1, fastforce) apply clarsimp
apply (drule DupElim1, fastforce) apply clarsimp
apply (drule PopElim1, fastforce) apply clarsimp
apply (drule SwapElim1, fastforce) apply clarsimp
apply (drule LoadElim1, fastforce) apply clarsimp
apply (drule StoreElim1, fastforce) apply clarsimp
apply (drule BinopElim1, fastforce) apply clarsimp
apply (drule UnopElim1, fastforce) apply clarsimp
apply (drule GetElim1, fastforce) apply clarsimp
apply (drule PutElim1, fastforce) apply clarsimp
  apply (simp add: updSize) 
apply (drule CastElim1, fastforce) apply clarsimp

apply (simp_all add: SP_inv_def)
apply safe
apply (drule ConstElim1, fastforce) apply clarsimp
apply (drule DupElim1, fastforce) apply clarsimp
apply (drule PopElim1, fastforce) apply clarsimp
apply (drule SwapElim1, fastforce) apply clarsimp
apply (drule LoadElim1, fastforce) apply clarsimp
apply (drule StoreElim1, fastforce) apply clarsimp
apply (drule BinopElim1, fastforce) apply clarsimp
apply (drule UnopElim1, fastforce) apply clarsimp
apply (drule GetElim1, fastforce) apply clarsimp
apply (drule PutElim1, fastforce) apply clarsimp
  apply (simp add: updSize) 
apply (drule CastElim1, fastforce) apply clarsimp
done
(*>*)

lemma CACH_RET: 
 " ins_is C m l vreturn; MST(C,m)=Some(Mspec,Minv,Anno); 
    Anno(l) = None 
   deriv G C m l (Cachera 0)"
(*<*)
apply (simp add: ins_is_def Cachera_def deriv_def derivAssum_def, clarsimp)
apply (rule VRET) apply assumption+  apply simp apply (simp add: heap_def)
apply clarsimp
done
(*>*)

lemma CACH_GOTO:
 " ins_is C m l (goto pc); MST(C,m)=Some(Mspec,Minv,Anno);
    Anno(l) = None; derivAssum G C m pc (Cachera n) 
  deriv G C m l (Cachera n)"
(*<*)
apply (simp add: ins_is_def Cachera_def deriv_def derivAssum_def, clarsimp)
apply (rule GOTO) apply assumption+ apply simp apply (simp add: heap_def)
apply (erule CONSEQ)
apply (simp add: SP_pre_def) 
apply (simp add: SP_post_def) apply clarsimp apply (drule GotoElim1, fastforce)
apply clarsimp
apply (simp add: SP_inv_def) apply clarsimp apply (drule GotoElim1, fastforce)
apply clarsimp
done
(*>*)

lemma CACH_IF:
  " ins_is C m l (iftrue pc); MST(C,m)=Some(Mspec,Minv,Anno); 
     Anno(l) = None; derivAssum G C m pc (Cachera n);
     derivAssum G C m (l+1) (Cachera n) 
   deriv G C m l (Cachera n)"
(*<*)
apply (simp add: ins_is_def Cachera_def deriv_def derivAssum_def, clarsimp)
apply (rule IF) apply assumption+ apply (simp, simp add: heap_def)
apply (erule CONSEQ)
apply (simp add: SP_pre_def)
apply (simp add: SP_post_def) apply clarsimp apply (drule IfElim1, fastforce) apply clarsimp
apply (simp add: SP_inv_def) apply clarsimp  apply (drule IfElim1, fastforce) apply clarsimp
apply clarsimp
apply (erule CONSEQ)
apply (simp add: SP_pre_def)
apply (simp add: SP_post_def) apply clarsimp apply (drule IfElim1, fastforce) apply clarsimp
apply (simp add: SP_inv_def) apply clarsimp  apply (drule IfElim1, fastforce) apply clarsimp
done
(*>*)

lemma CACH_INVS: 
  " ins_is C m l (invokeS D m'); mbody_is D m' (par,code,l0);
     MST(C,m)=Some(Mspec,Minv,Anno); Anno(l) = None; 
     MST(D, m') = Some(mkSPEC (Cachera k) Anno2);
     nk = n+k; derivAssum G C m (l+1) (Cachera n)
    deriv G C m l (Cachera nk)"
(*<*)
apply (simp add: ins_is_def Cachera_def deriv_def derivAssum_def, clarsimp)

apply (rule INVS) apply assumption+ 
apply (simp add: mkSPEC_def) apply fastforce apply simp apply (simp add: heap_def)
apply (simp add: mkState_def)
apply (erule CONSEQ)
apply clarsimp
apply clarsimp apply (simp add: SINV_post_def mkState_def) 
apply clarsimp apply (simp add: SINV_inv_def mkState_def) 
done
(*>*)

text‹In addition, we have two rules for subtyping›

lemma CACH_SUB:
 " deriv G C m l (Cachera n); n  k  deriv G C m l (Cachera k)"
(*<*)
apply (simp add: deriv_def derivAssum_def Cachera_def)
apply (rule CONSEQ, assumption+) 
apply simp
apply simp
apply simp
done
(*>*)

lemma CACHAssum_SUB:
 " derivAssum G C m l (Cachera n); n  k
   derivAssum G C m l (Cachera k)"
(*<*)
apply (simp add: derivAssum_def Cachera_def)
apply (rule CONSEQ, assumption+) 
apply simp
apply simp
apply simp
done
(*>*)

text‹and specialised forms of the axiom rule and the injection rule.›

lemma CACH_AX:
 " G(C,m,l) = Some (Cachera n); MST(C,m)=Some(Mspec,Minv,Anno); 
    Anno(l) = None 
  derivAssum G C m l (Cachera n)"
(*<*)
apply (simp add: derivAssum_def Cachera_def)
apply (drule AX) apply assumption apply simp apply (simp add: heap_def)
apply (rule CONSEQ) apply assumption+ apply simp apply simp apply simp
done
(*>*)

lemma CACH_INJECT:
  "deriv G C m l (Cachera n)  derivAssum G C m l (Cachera n)"
(*<*)
apply (simp add: deriv_def derivAssum_def Cachera_def)
apply (erule INJECT)
done
(*>*)

text‹Finally, a verified-program rule relates specifications to
judgements for the method bodies. Thus, even the method specifications
may be given as derived assertions (modulo the mkSPEC›-conversion).›

lemma CACH_VP:
 "  c m par code l0. mbody_is c m (par, code, l0) 
          ( n Anno . MST(c,m) = Some(mkSPEC(Cachera n) Anno)  
                 deriv G c m l0 (Cachera n));
     c m l A B I. G(c,m,l) = Some(A,B,I) 
                   ( n . (A,B,I) = Cachera n  deriv G c m l (Cachera n)) 
   VP"
(*<*)
apply (simp add: VP_def) apply (rule_tac x=G in exI, simp add: VP_G_def)
apply safe
(*G*)
  apply (erule thin_rl)
  apply (erule_tac x=C in allE, erule_tac x=m in allE, erule_tac x=l in allE, clarsimp)
  apply (simp add: deriv_def)
(*MST*)
apply (rotate_tac 1, erule thin_rl)
apply (erule_tac x=C in allE, erule_tac x=m in allE) 
apply(erule_tac x=par in allE, erule_tac x=code in allE, erule_tac x=l0 in allE, clarsimp)
apply (simp add: Cachera_def mkSPEC_def deriv_def, clarsimp)
apply (rule CONSEQ) apply assumption+ 
apply simp
apply (simp add: mkPost_def mkState_def)
apply (simp add: mkState_def mkInv_def)
done
(*>*)

subsection‹Soundness of high-level type system›

text‹We define a first-order functional language where expressions
are stratified into primitive expressions and general expressions. The
language supports the construction of lists using constructors
$\mathit{NilPrim}$ and $\mathit{ConsPrim}\; h\; t$, and includes a
corresponding pattern match operation. In order to simplify the
compilation, function identifiers are taken to be pairs of class names
and method names.›

type_synonym Fun = "Class × Method"

datatype Prim =
  IntPrim int
| UnPrim "Val  Val" Var 
| BinPrim "Val  Val  Val" Var Var
| NilPrim
| ConsPrim Var Var
| CallPrim Fun "Var list"

datatype Expr = 
  PrimE Prim
| LetE Var Prim Expr
| CondE Var Expr Expr
| MatchE Var Expr Var Var Expr

type_synonym FunProg = "(Fun,Var list × Expr) AssList"

text‹The type system uses contexts that associate a type (natural
number) to function identifiers.›

type_synonym TP_Sig = "(Fun, nat) AssList"

text‹We first give the rules for primitive expressions.›

inductive_set TP_prim::"(TP_Sig × Prim × nat)set"
where
TP_int: "(Σ,IntPrim i,0) : TP_prim"
|
TP_un: "(Σ,UnPrim f x,0) : TP_prim"
|
TP_bin: "(Σ,BinPrim f x y,0) : TP_prim"
|
TP_nil: "(Σ,NilPrim,0) : TP_prim"
|
TP_cons: "(Σ,ConsPrim x y,1) : TP_prim"
|
TP_Call: "Σf = Some n  (Σ,CallPrim f args,n) : TP_prim"

text‹Next, the rules for general expressions.›

inductive_set TP_expr::"(TP_Sig × Expr × nat) set"
where
TP_sub: "(Σ,e,m):TP_expr; m  n  (Σ,e,n):TP_expr"
|
TP_prim:"(Σ,p,n):TP_prim  (Σ,PrimE p,n) : TP_expr"
|
TP_let: "(Σ,p,k):TP_prim; (Σ,e,m):TP_expr; n = k+m 
         (Σ,LetE x p e,n) : TP_expr"
|
TP_Cond:"(Σ,e1,n):TP_expr; (Σ,e2,n):TP_expr 
        (Σ,CondE x e1 e2,n) : TP_expr"
|
TP_Match:"(Σ,e1,n):TP_expr; (Σ,e2,n):TP_expr 
           (Σ,MatchE x e1 h t e2,n):TP_expr"

text‹A functional program is well-typed if its domain agrees with
that of some context such that each function body validates the
context entry.›

definition TP::"TP_Sig  FunProg  bool" where
"TP Σ F = (( f . (Σf = None) = (Ff = None))  
          ( f n par e . Σf = Some n  Ff = Some (par,e)  (Σ,e,n):TP_expr))"

text‹For the translation into bytecode, we introduce identifiers for
a class of lists, the expected field names, and a temporary (reserved)
variable name.› 

axiomatization
  LIST::Class and
  HD::Field and
  TL::Field and
  tmp::Var

text‹The compilation of primitive expressions extends a code block by
a sequence of JVM instructions that leave a value on the top of the
operand stack.›

inductive_set compilePrim::
  "(Label ×  (Label,Instr) AssList × Prim × ((Label,Instr) AssList × Label)) set" 
where
compileInt: "(l, code, IntPrim i, (code[l(const (IVal i))],l+1)) : compilePrim"
|
compileUn:
  "(l, code, UnPrim f x, (code[l(load x)][(l+1)(unop f)],l+2)) : compilePrim"
|
compileBin: 
 "(l, code, BinPrim f x y,
     (code[l(load x)][(l+1)(load y)][(l+2)(binop f)],l+3)) : compilePrim"
|
compileNil:
  "(l, code, NilPrim, (code[l(const (RVal Nullref))],l+1)) : compilePrim"
|
compileCons:
  "(l, code, ConsPrim x y, 
      (code[l(load y)][(l+1)(load x)]
           [(l+2)(new LIST)][(l+3)store tmp]
           [(l+4)load tmp][(l+5)(putfield LIST HD)]
           [(l+6)load tmp][(l+7)(putfield LIST TL)]
           [(l+8)(load tmp)], l+9)) : compilePrim"
|
compileCall_Nil:
  "(l, code, CallPrim f [],(code[linvokeS (fst f) (snd f)],l+1)): compilePrim"  
|
compileCall_Cons:
  " (l+1,code[lload x], CallPrim f args, OUT) : compilePrim
    (l, code, CallPrim f (x#args), OUT): compilePrim"            

text‹The following lemma shows that the resulting code is an
extension of the code submitted as an argument, and that the
new instructions define a contiguous block.›

lemma compilePrim_Prop1[rule_format]:
"(l, code, p, OUT) : compilePrim 
 ( code1l1 . OUT = (code1, l1) 
     (l < l1  ( ll . ll < l  code1ll = codell)  
       ( ll . l  ll  ll < l1  ( ins . code1ll = Some ins))))"
(*<*)
apply (erule compilePrim.induct)
apply clarsimp 
  apply rule
  apply clarsimp apply (rule AL_update2) apply simp 
  apply (rule, rule AL_update1)
apply clarsimp
  apply rule
    apply clarsimp
    apply (rule AL_update5)
    apply (rule AL_update5)
    apply (simp, simp, simp)
  apply clarsimp
    apply (case_tac "ll=l", clarsimp, rule)
      apply (rule AL_update5)
      apply (simp add: AL_update1)
      apply simp
    apply (case_tac "ll=l+1", clarsimp, rule)
      apply (simp add: AL_update1)
    apply simp
(*BIN*)
 apply clarsimp
  apply rule
    apply clarsimp
    apply (rule AL_update5)
    apply (rule AL_update5)
    apply (rule AL_update5)
    apply (simp, simp, simp, simp)
  apply clarsimp
    apply (case_tac "ll=l", clarsimp, rule)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (simp add: AL_update1)
      apply (simp, simp)
    apply (case_tac "ll=l+1", clarsimp, rule)
      apply (rule AL_update5)
      apply (simp add: AL_update1)
      apply simp
    apply (case_tac "ll=l+2", clarsimp, rule)
      apply (simp add: AL_update1)
    apply simp
apply clarsimp 
  apply rule
    apply clarsimp apply (rule AL_update2) apply simp
    apply (rule, rule AL_update1) apply simp
apply clarsimp
  apply rule apply clarsimp
    apply (rule AL_update5)
    apply (rule AL_update5)
    apply (rule AL_update5)
    apply (rule AL_update5)
    apply (rule AL_update5)
    apply (rule AL_update5)
    apply (rule AL_update5)
    apply (rule AL_update5)
    apply (rule AL_update5)
    apply (simp, simp, simp, simp)
    apply (simp, simp, simp, simp)
    apply (simp, simp)
  apply clarsimp
    apply (case_tac "ll=l", clarsimp, rule)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (simp add: AL_update1)
      apply (simp, simp, simp,simp)
      apply (simp, simp, simp,simp)
    apply (case_tac "ll=l+1", clarsimp, rule)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (simp add: AL_update1)
      apply (simp, simp, simp,simp)
      apply (simp, simp, simp)
    apply (case_tac "ll=l+2", clarsimp, rule)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (simp add: AL_update1)
      apply (simp, simp, simp,simp)
      apply (simp, simp)
    apply (case_tac "ll=l+3", clarsimp, rule)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update1) 
      apply (simp, simp, simp,simp)
      apply simp
    apply (case_tac "ll=l+4", clarsimp, rule)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update1) 
      apply (simp, simp, simp,simp)
    apply (case_tac "ll=l+5", clarsimp, rule)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update1) 
      apply (simp, simp, simp)
    apply (case_tac "ll=l+6", clarsimp, rule)
      apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update1) 
      apply (simp, simp)
    apply (case_tac "ll=l+7", clarsimp, rule)
      apply (rule AL_update5)
      apply (rule AL_update1) 
      apply (simp)
    apply (case_tac "ll=l+8", clarsimp, rule)
      apply (rule AL_update1)
      apply simp
(*CALL-NIL*)
apply clarsimp 
  apply (rule, clarsimp)
    apply (rule AL_update5) apply (simp ,simp)
  apply (rule, rule AL_update1)
(*CALL-CONS*)
apply clarsimp
  apply (rule, clarsimp)
    apply (rule AL_update5) apply simp apply simp
  apply clarsimp
    apply (erule_tac x=ll in allE)+ apply clarsimp 
    apply (case_tac "l=ll", clarsimp) apply (rule, rule AL_update1) 
    apply clarsimp
done
(*>*)

text‹A signature corresponds to a method specification table if all
context entries are represented as MST› entries and method
names that are defined in the global program P›.›

definition Sig_good::"TP_Sig  bool" where
"Sig_good Σ =
 ( C m n. Σ(C,m) = Some n  
    (MST(C, m) = Some (mkSPEC (Cachera n) emp) 
    ( par code l0 . mbody_is C m (par,code,l0))))"

text‹This definition requires MST› to associate the
specification $$\mathit{mkSPEC}\; (\mathit{Cachera}\; n)\;
\mathit{emp}$$ to each method to which the type signature associates
the type $n$. In particular, this requires the annotation table of
such a method to be empty. Additionally, the global program $P$ is
required to contain a method definition for each method
(i.e.~function) name occurring in the domain of the signature.›

text‹An auxiliary abbreviation that captures when a block of code has
trivial annotations and only comprises defined program labels.›

definition Segment::
  "Class  Method  Label  Label  (Label,Instr)AssList  bool"
where
"Segment C m l l1 code =
    ( Mspec Minv Anno . MST(C,m) = Some(Mspec,Minv,Anno)  
      (ll. l  ll  ll < l1 
          Anno(ll) = None  (ins. ins_is C m ll ins  codell = Some ins)))"

(*<*)
lemma Segment_triv:
  "Segment C m l l1 code; MST(C,m) = Some(Mspec,Minv,Anno); l  ll; ll < l1 
   (Anno(ll) = None  (ins. ins_is C m ll ins  codell = Some ins))"
by (simp add: Segment_def)

lemma Segment_triv1:
  "Segment C m l l1 code; MST(C,m) = Some(Mspec,Minv,Anno); l  ll; ll < l1  Anno(ll) = None"
by (simp add: Segment_def)

lemma Segment_triv2:
  "Segment C m l l1 code; l  ll; ll < l1  (ins. ins_is C m ll ins  codell = Some ins)"
apply (simp add: Segment_def) apply clarsimp done

lemma Segment_A:
  "Segment C m l l1 code; l  ll; ll < l1  Segment C m ll l1 code" by (simp add: Segment_def, clarsimp)
(*>*)

text‹The soundness of (the translation of) a function call is proven
by induction on the list of arguments.›

lemma Call_SoundAux[rule_format]:
 "Σf = Some n  
    MST(fst f,snd f) = Some(mkSPEC (Cachera n) Anno2) 
    ( par body l0 . mbody_is (fst f) (snd f) (par,body,l0)) 
       (l code code1 l1 G C m T MI k.
          (l, code, CallPrim f args, code1, l1)  compilePrim 
          MST(C, m) = Some (T, MI,Anno)  Segment C m l l1 code1 
          derivAssum G C m l1 (Cachera k)  
          deriv G C m l (Cachera (n+k)))"
(*<*)
supply [[simproc del: defined_all]]
apply (induct args)
apply clarsimp
  apply (erule compilePrim.cases) apply (simp,simp,simp, simp, simp, clarsimp)  
    apply (drule Segment_triv) apply assumption apply (subgoal_tac "la  la", assumption, simp) apply clarsimp 
  apply (erule conjE)+ apply (erule exE)+ apply (erule conjE)+
  apply (rule CACH_INVS) 
    apply (simp add: AL_update1) apply clarsimp apply fast
    apply assumption
    apply assumption
    apply assumption
    apply assumption
    apply simp
    apply simp
  apply simp
(*CONS*)
  apply clarsimp
  apply (erule compilePrim.cases) apply (simp, simp, simp, simp, simp, simp) apply clarsimp
  apply (erule impE) apply fast
  apply (erule_tac x="la+1" in allE, rotate_tac -1)
  apply (erule_tac x="codea[laload x]" in allE, rotate_tac -1)
  apply (erule_tac x=ab in allE, rotate_tac -1)
  apply (erule_tac x=ba in allE, clarsimp)
  apply (erule_tac x=G in allE, rotate_tac -1)
  apply (erule_tac x=C in allE, rotate_tac -1)
  apply (erule_tac x=m in allE, clarsimp)
  apply (frule compilePrim_Prop1) apply fastforce apply clarsimp 
  apply (erule impE, erule Segment_A) apply simp apply simp 
    apply (drule Segment_triv) apply assumption apply (subgoal_tac "la  la", assumption, simp) apply clarsimp 
  apply (erule conjE)+ apply (erule exE)+ apply (erule conjE)+
  apply (rule CACH_INSTR) apply assumption 
    apply (rotate_tac -5, erule_tac x=la in allE, clarsimp)   apply (simp add: AL_update1) 
      apply clarsimp apply fast
    apply assumption
    apply assumption
  apply (rule CACH_INJECT)
  apply simp
done
(*>*)

lemma Call_Sound:
 " Sig_good Σ; Σf = Some n; 
   (l, code, CallPrim f args, code1, l1)  compilePrim;
   MST(C,m) = Some (T, MI,Anno); Segment C m l l1 code1;
   derivAssum G C m l1 (Cachera nn); k = n+nn 
  deriv G C m l (Cachera k)"
(*<*)
apply (case_tac f, clarsimp)
apply (rule Call_SoundAux)
apply assumption apply (simp add: Sig_good_def) apply (simp add: Sig_good_def) 
apply assumption apply assumption apply assumption apply assumption 
done
(*>*)
 
text‹The definition of basic instructions.›

definition basic::"Instr  bool" where
"basic ins = (( c . ins = const c)  ins = dup  
              ins= pop  ins= swap  ( x. ins= load x) 
              ( y. ins= store y)  ( f. ins= binop f) 
              ( g. ins= unop g)  ( c1 F1. ins= getfield c1 F1) 
              ( c2 F2. ins=  putfield c2 F2) 
              ( c3. ins=  checkcast c3))"

text‹Next, we prove the soundness of basic instructions. The
hypothesis refers to instructions located at the program
continuation.›

lemma Basic_Sound: 
  " Segment C m l ll code; MST(C,m) = Some (T, MI,Anno); ll1; l1 < ll;
     l2=l1+1; codel1 = Some ins; basic ins; derivAssum G C m l2 (Cachera n)
    deriv G C m l1 (Cachera n)"
(*<*)
apply (drule Segment_triv) apply assumption+ apply clarsimp  apply (simp add: basic_def)
apply (erule disjE, clarsimp) apply (erule CACH_INSTR) apply fast apply assumption apply assumption apply simp
apply (erule disjE, clarsimp) apply (erule CACH_INSTR) apply fast apply assumption apply assumption apply simp
apply (erule disjE, clarsimp) apply (erule CACH_INSTR) apply fast apply assumption apply assumption apply simp
apply (erule disjE, clarsimp) apply (erule CACH_INSTR) apply fast apply assumption apply assumption apply simp
apply (erule disjE, clarsimp) apply (erule CACH_INSTR) apply fast apply assumption apply assumption apply simp
apply (erule disjE, clarsimp) apply (erule CACH_INSTR) apply fast apply assumption apply assumption apply simp
apply (erule disjE, clarsimp) apply (erule CACH_INSTR) apply fast apply assumption apply assumption apply simp
apply (erule disjE, clarsimp) apply (erule CACH_INSTR) apply fast apply assumption apply assumption apply simp
apply (erule disjE, clarsimp) apply (erule CACH_INSTR) apply fast apply assumption apply assumption apply simp 
apply (erule disjE, clarsimp) apply (erule CACH_INSTR) apply fast apply assumption apply assumption apply simp
apply clarsimp apply (erule CACH_INSTR) apply fast apply assumption apply assumption apply simp 
done
(*>*)

text‹Following this, the soundness of the type system for primitive
expressions. The proof proceeds by induction on the typing
judgement.›

lemma TP_prim_Sound[rule_format]:
  "(Σ,p,n):TP_prim  
   Sig_good Σ 
   ( l code code1 l1 G C m T MI Anno nn k.
         (l, code, p, (code1,l1)) : compilePrim  
         MST(C,m) = Some (T,MI,Anno) 
         Segment C m l l1 code1  derivAssum G C m l1 (Cachera nn)  
         k = n+nn  deriv G C m l (Cachera k))"
(*<*)
apply (erule TP_prim.induct)
(*INT*)
apply clarsimp apply (erule thin_rl)
  apply (erule compilePrim.cases, simp_all, clarsimp)
  apply (rule Basic_Sound) apply assumption apply assumption apply (simp,simp) apply simp
  apply (simp add: AL_update1)
  apply (simp add: basic_def)
  apply assumption
(*UN*) 
apply clarsimp apply (erule thin_rl)
  apply (erule compilePrim.cases, simp_all, clarsimp)
  apply (rule Basic_Sound) apply assumption apply assumption apply (simp, simp) 
  apply simp 
  apply (rule AL_update5) apply (simp add: AL_update1) apply simp
  apply (simp add: basic_def)
  apply (rule CACH_INJECT) 
  apply (rule Basic_Sound) apply assumption apply assumption apply (simp, simp) 
  apply simp 
  apply (simp add: AL_update1) 
  apply (simp add: basic_def)
   apply (subgoal_tac "la+2=2+la", clarsimp,simp)
(*BIN*)
apply clarsimp apply (erule thin_rl)
  apply (erule compilePrim.cases, simp_all, clarsimp)
  apply (rule Basic_Sound) apply assumption apply assumption apply (simp, simp) apply simp 
  apply (rule AL_update5) apply (rule AL_update5) apply (simp add: AL_update1) apply (simp, simp)
  apply (simp add: basic_def)
  apply (rule CACH_INJECT) 
  apply (rule Basic_Sound) apply assumption apply assumption apply (simp, simp) 
  apply simp 
  apply (rule AL_update5) apply (simp add: AL_update1) apply simp
  apply (simp add: basic_def)
  apply (rule CACH_INJECT) 
  apply (rule Basic_Sound) apply assumption apply assumption apply (simp, simp) 
  apply simp 
  apply (rule AL_update1a) apply simp
  apply (simp add: basic_def)
   apply (subgoal_tac "la+3=3+la", clarsimp, simp)
(*Nil*)
apply clarsimp apply (erule thin_rl)
  apply (erule compilePrim.cases, simp_all, clarsimp)
  apply (rule Basic_Sound) apply assumption apply assumption apply (simp,simp) apply simp 
  apply (simp add: AL_update1)
  apply (simp add: basic_def)
  apply assumption
(*CONS*)
apply clarsimp apply (erule thin_rl)
  apply (erule compilePrim.cases, simp_all, clarsimp)
  apply (rule Basic_Sound) apply assumption apply assumption apply (simp, simp) apply simp
  apply (rule AL_update5) apply (rule AL_update5) apply (rule AL_update5) apply (rule AL_update5)
    apply (rule AL_update5) apply (rule AL_update5) apply (rule AL_update5) apply (rule AL_update5) 
    apply (simp add: AL_update1) apply (simp,simp,simp,simp) apply (simp,simp,simp,simp)
  apply (simp add: basic_def)
  apply (rule CACH_INJECT) 
  apply (rule Basic_Sound) apply assumption apply assumption apply (simp, simp) apply simp
  apply (rule AL_update5) apply (rule AL_update5) apply (rule AL_update5) apply (rule AL_update5)
    apply (rule AL_update5) apply (rule AL_update5) apply (rule AL_update5) 
    apply (simp add: AL_update1) apply (simp,simp,simp,simp) apply (simp,simp,simp)
  apply (simp add: basic_def)
  apply (rule CACH_INJECT) 
  apply (frule Segment_triv) apply assumption apply (subgoal_tac "la  la+2", assumption, simp) 
    apply simp 
  apply (subgoal_tac "la+2=2+la", clarsimp)
    apply (drule AL_update3, simp) 
    apply (drule AL_update3, simp) 
    apply (drule AL_update3, simp) 
    apply (drule AL_update3, simp) 
    apply (drule AL_update3, simp) 
    apply (drule AL_update3, simp) apply (simp add: AL_update1) apply clarsimp
    apply (rule CACH_NEW) apply assumption+
      apply (simp, simp)
    apply (rule CACH_INJECT) 
    apply (rule Basic_Sound) apply assumption apply assumption apply (simp, simp) apply simp
      apply (rule AL_update5) apply (rule AL_update5) apply (rule AL_update5) apply (rule AL_update5)
      apply (rule AL_update5)
      apply (rule AL_update1a) apply simp apply (simp,simp,simp,simp) apply simp
      apply (simp add: basic_def)
    apply (rule CACH_INJECT) 
    apply (rule Basic_Sound) apply assumption apply assumption apply (simp, simp) apply simp
      apply (rule AL_update5) apply (rule AL_update5) apply (rule AL_update5) apply (rule AL_update5)
        apply (rule AL_update1a) apply simp apply (simp,simp,simp,simp) 
    apply (simp add: basic_def)
    apply (rule CACH_INJECT) 
      apply (rule Basic_Sound) apply assumption apply assumption apply (simp, simp) apply simp
      apply (rule AL_update5) apply (rule AL_update5) apply (rule AL_update5) 
        apply (rule AL_update1a) apply simp apply (simp,simp,simp) 
        apply (simp add: basic_def)
    apply (rule CACH_INJECT) 
    apply (rule Basic_Sound) apply assumption apply assumption apply (simp, simp) apply simp
      apply (rule AL_update5) apply (rule AL_update5) 
        apply (rule AL_update1a) apply simp apply (simp,simp) 
        apply (simp add: basic_def)
    apply (rule CACH_INJECT) 
    apply (rule Basic_Sound) apply assumption apply assumption apply (simp, simp) apply simp
      apply (rule AL_update5) 
        apply (rule AL_update1a) apply simp apply simp
        apply (simp add: basic_def)
    apply (rule CACH_INJECT) 
    apply (rule Basic_Sound) apply assumption apply assumption apply (simp, simp) apply simp
      apply (rule AL_update1a) apply simp 
      apply (simp add: basic_def)
      apply (subgoal_tac "la+9=9+la", clarsimp, simp)
  apply simp
(*Call*)
apply clarsimp
  apply (rule Call_Sound) apply assumption+ apply simp
done
(*>*)

text‹The translation of general expressions is defined similarly, but
no code continuation is required.›

inductive_set compileExpr::
  "(Label × (Label,Instr) AssList × Expr × ((Label,Instr) AssList × Label)) set"
where
compilePrimE: 
 "(l, code, p, (code1,l1)) : compilePrim; OUT = (code1[l1vreturn],l1+1)
    (l, code, PrimE p, OUT):compileExpr"
|
compileLetE:
  "(l, code, p, (code1,l1)) : compilePrim; (code2,l2) = (code1[l1(store x)],l1+1);
     (l2, code2, e, OUT) : compileExpr
    (l, code, LetE x p e, OUT) : compileExpr"
|
compileCondE:
  "(l+2, code, e2, (codeElse,XXX)) : compileExpr;
     (XXX, codeElse, e1, (codeThen,YYY) ) : compileExpr ;
     OUT = (codeThen[lload x][(l+1)(iftrue XXX)], YYY)
    (l, code, CondE x e1 e2, OUT): compileExpr" 
|                                                                        
compileMatchE:
  "(l+9, code, e2, (codeCons,lNil)) : compileExpr;
     (lNil, codeCons, e1, (codeNil,lRes) ) : compileExpr ;
     OUT = (codeNil[l(load x)]
                   [(l+1)(unop (λ v . if v = RVal Nullref
                                 then TRUE else FALSE))]
                   [(l+2)(iftrue lNil)]
                   [(l+3)(load x)]
                   [(l+4)(getfield LIST HD)]
                   [(l+5)(store h)]
                   [(l+6)(load x)]
                   [(l+7)(getfield LIST TL)]
                   [(l+8)(store t)], lRes) 
    (l, code, MatchE x e1 h t e2, OUT): compileExpr"

text‹Again, we prove an auxiliary result on the emitted code, by
induction on the compilation judgement.›

lemma compileExpr_Prop1[rule_format]:
"(l,code,e,OUT) : compileExpr  
  ( code1 l1 . OUT = (code1, l1)  
      (l < l1  
       ( ll . ll < l  code1ll = codell)  
       ( ll . l  ll  ll < l1  ( ins . code1ll = Some ins))))"
(*<*)
apply (erule compileExpr.induct)
(*PRIM*)
apply clarsimp apply (drule compilePrim_Prop1) apply fastforce  apply clarsimp
  apply rule apply clarsimp apply (erule_tac x=ll in allE, clarsimp)
    apply (erule AL_update5) apply simp 
  apply clarsimp apply (case_tac "ll < l1", clarsimp) 
      apply (rotate_tac 1, erule_tac x=ll in allE, clarsimp) 
        apply (rule, erule AL_update5) apply simp 
  apply (subgoal_tac "ll= l1", clarsimp) apply (rule, simp add: AL_update1) apply simp
(*LET*)
apply clarsimp
  apply (drule compilePrim_Prop1) apply fastforce apply clarsimp
  apply rule apply clarsimp
    apply (rule AL_update5) apply simp apply simp
  apply clarsimp apply (erule_tac x=ll in allE)+ apply clarsimp 
    apply (case_tac "ll <l1", clarsimp) apply (rule, erule AL_update5) apply simp
     apply (subgoal_tac "ll=l1", clarsimp)
     apply (simp add: AL_update1) apply simp
(*COND*)
apply clarsimp 
  apply (rule, clarsimp)
    apply (rule AL_update5)
    apply (rule AL_update5) apply (simp ,simp)
    apply simp
  apply clarsimp
    apply (case_tac "ll=l+1", clarsimp, rule) apply(rule AL_update1)
    apply (case_tac "ll=l", clarsimp, rule) 
      apply (rule AL_update5) apply(simp add: AL_update1) apply simp
    apply (case_tac "XXX  ll", clarsimp)
      apply (rotate_tac -3, erule_tac x=ll in allE, clarsimp)
        apply rule apply (rule AL_update5) apply (erule AL_update5) apply (simp, simp)
    apply clarsimp 
      apply (rotate_tac -6, erule_tac x=ll in allE, clarsimp)
      apply (rotate_tac -2, erule_tac x=ll in allE, clarsimp)
        apply rule apply (rule AL_update5) apply (erule AL_update5) apply (simp, simp)
(*Match*)
apply clarsimp 
  apply (rule, clarsimp)
    apply (rule AL_update5)
    apply (rule AL_update5) 
    apply (rule AL_update5)
    apply (rule AL_update5)
    apply (rule AL_update5) 
    apply (rule AL_update5) 
    apply (rule AL_update5)
    apply (rule AL_update5) 
    apply (rule AL_update5) apply (simp ,simp, simp) apply (simp ,simp, simp) apply (simp ,simp, simp)
    apply simp
  apply clarsimp
    apply (case_tac "ll=l+8", clarsimp, rule) apply(simp add: AL_update1)
    apply (case_tac "ll=l+7", clarsimp, rule) apply (rule AL_update5) apply(simp add: AL_update1) apply simp
    apply (case_tac "ll=l+6", clarsimp, rule) apply (rule AL_update5) apply (rule AL_update5) 
      apply(simp add: AL_update1) apply simp apply simp
    apply (case_tac "ll=l+5", clarsimp, rule) apply (rule AL_update5)  apply (rule AL_update5) 
      apply (rule AL_update5)  apply(simp add: AL_update1) apply (simp,simp,simp)
    apply (case_tac "ll=l+4", clarsimp, rule) apply (rule AL_update5) apply (rule AL_update5) 
      apply (rule AL_update5) apply (rule AL_update5) apply(simp add: AL_update1) apply (simp,simp,simp,simp)
    apply (case_tac "ll=l+3", clarsimp, rule) apply (rule AL_update5) apply (rule AL_update5) 
      apply (rule AL_update5) apply (rule AL_update5) apply (rule AL_update5) apply(simp add: AL_update1)
      apply (simp,simp,simp,simp,simp)
    apply (case_tac "ll=l+2", clarsimp, rule) apply (rule AL_update5) apply (rule AL_update5) 
      apply (rule AL_update5) apply (rule AL_update5) apply (rule AL_update5) apply (rule AL_update5) 
      apply(simp add: AL_update1)
      apply (simp,simp,simp,simp,simp, simp)
    apply (case_tac "ll=l+1", clarsimp, rule) apply (rule AL_update5) apply (rule AL_update5) 
      apply (rule AL_update5) apply (rule AL_update5) apply (rule AL_update5) apply (rule AL_update5) 
      apply (rule AL_update5) apply(simp add: AL_update1) 
      apply (simp,simp,simp,simp,simp, simp, simp) 
    apply (case_tac "ll=l", clarsimp, rule) apply (rule AL_update5) apply (rule AL_update5) 
      apply (rule AL_update5) apply (rule AL_update5) apply (rule AL_update5) apply (rule AL_update5) 
      apply (rule AL_update5) apply (rule AL_update5) apply(simp add: AL_update1) apply (simp, simp)
      apply (simp,simp,simp,simp,simp, simp)
    apply (case_tac "lNil  ll", clarsimp)
      apply (rotate_tac -3, erule_tac x=ll in allE, clarsimp)
        apply rule apply (rule AL_update5) apply (rule AL_update5) apply (rule AL_update5)
            apply (rule AL_update5) apply (rule AL_update5) apply (rule AL_update5)
            apply (rule AL_update5) apply (rule AL_update5) apply (erule AL_update5)
          apply (simp, simp, simp)
          apply (simp, simp, simp)
          apply (simp, simp, simp)
(*   apply simp*)
      apply (rotate_tac 5) apply( erule_tac x=ll in allE, erule impE) apply (erule thin_rl) 
         apply (erule thin_rl) apply (rotate_tac -1, erule thin_rl)
         apply (rotate_tac -1, erule thin_rl) 
         apply (rotate_tac -1, erule thin_rl) 
         apply (rotate_tac -1, erule thin_rl) 
         apply (rotate_tac -1, erule thin_rl) apply simp 
         apply (subgoal_tac "ll < lNil")
         prefer 2 apply(  erule thin_rl, erule thin_rl) 
           apply (erule thin_rl, erule thin_rl) 
           apply (erule thin_rl, erule thin_rl) 
           apply (erule thin_rl, erule thin_rl) 
           apply (erule thin_rl, erule thin_rl) 
           apply (erule thin_rl, erule thin_rl) 
           apply (erule thin_rl, rotate_tac 1, erule thin_rl) 
           apply (erule thin_rl, erule thin_rl) 
           apply (erule thin_rl, erule thin_rl) apply simp
         apply (erule impE, assumption) 
      apply (erule_tac x=ll in allE, erule impE, assumption)
      apply (erule exE)
        apply rule apply (rule AL_update5) apply (rule AL_update5) apply (rule AL_update5) 
         apply (rule AL_update5) apply (rule AL_update5) apply (rule AL_update5) 
         apply (rule AL_update5) apply (rule AL_update5) apply (rule AL_update5)
           apply (erule thin_rl, erule thin_rl) 
           apply (erule thin_rl, erule thin_rl) 
           apply (erule thin_rl, erule thin_rl)  
           apply (erule thin_rl, erule thin_rl) 
           apply (erule thin_rl, erule thin_rl) 
           apply (erule thin_rl, erule thin_rl) 
           apply (erule thin_rl, erule thin_rl) 
           apply (erule thin_rl, erule thin_rl) 
           apply (erule thin_rl, erule thin_rl) apply simp
          apply fast+ 
done
(*>*)

text‹Then, soundness of the epxression type system is proven by
induction on the typing judgement.›

lemma TP_epxr_Sound[rule_format]:
"(Σ,e,n):TP_expr  Sig_good Σ 
 ( l code code1 l1 G C m T MI Anno.
    (l, code, e, (code1,l1)):compileExpr 
    MST(C,m) = Some (T,MI,Anno) 
    Segment C m l l1 code1  deriv G C m l (Cachera n))"
(*<*)
supply [[simproc del: defined_all]]
apply (erule TP_expr.induct)
(*SUB*)
apply clarsimp
   apply (rotate_tac 2, erule thin_rl, rotate_tac -2)
   apply (erule_tac x=l in allE, erule_tac x=code in allE)
   apply (erule_tac x=code1 in allE, rotate_tac -1, erule_tac x=l1 in allE, clarsimp)
   apply (erule_tac x=G in allE, erule_tac x=C in allE)
   apply (erule_tac x=ma in allE, clarsimp)
   apply (erule CACH_SUB) apply assumption
(*PRIM*)
apply clarsimp 
  apply (erule compileExpr.cases) 
  prefer 2 apply simp
  prefer 2 apply simp
  prefer 2 apply simp
  apply clarsimp 
  apply (erule TP_prim_Sound) apply fast  apply assumption+
     apply (simp add: Segment_def, clarsimp)
     apply (erule_tac x=ll in allE, clarsimp) 
       apply (drule AL_update3) apply simp 
       apply (rule, rule, assumption, assumption)
     prefer 2 apply simp
  apply (simp add: Segment_def)
     apply (erule_tac x=l1a in allE, simp) apply (erule impE)
       apply (drule compilePrim_Prop1) apply fastforce   apply simp
     apply clarsimp  
     apply (simp add: AL_update1, clarsimp)
     apply (rule CACH_INJECT)
     apply (erule CACH_RET)  apply assumption apply assumption
(*LET*)
apply clarsimp 
  apply (erule compileExpr.cases) 
  apply simp
  prefer 2 apply simp
  prefer 2 apply simp
  apply clarsimp
  apply (frule compilePrim_Prop1) apply fastforce
  apply (frule compileExpr_Prop1) apply fastforce apply clarsimp 
  apply (erule_tac x="l1a+1" in allE, erule_tac x="code1a[l1astore xa]" in allE, 
         erule_tac x=a in allE, rotate_tac -1)
  apply (erule_tac x=b in allE, clarsimp)
  apply (erule_tac x=G in allE, erule_tac x=C in allE, erule_tac x=ma in allE, clarsimp)
  apply (erule impE) apply (erule Segment_A) apply (simp,simp)
  apply (rule TP_prim_Sound) apply assumption apply assumption
       apply assumption apply assumption 
         apply (simp add: Segment_def) apply clarsimp apply (erule_tac x=ll in allE, clarsimp) apply (rule, rule, assumption)
          apply(drule AL_update3) apply simp apply assumption
    prefer 2 apply simp
  apply (rule CACH_INJECT)
    apply (rule Basic_Sound) prefer 2 apply assumption prefer 4 apply simp prefer 2 apply (subgoal_tac "l1a  l1a", assumption, simp)
    prefer 3 apply (subgoal_tac "al1a = Some(store xa)", assumption)
         apply (rotate_tac -3, erule_tac x=l1a in allE, clarsimp) apply (simp add: AL_update1)
    apply (subgoal_tac "Segment C ma l1a b a", assumption) apply (erule Segment_A) apply (simp,simp) 
    apply simp
    apply (simp add: basic_def)
    apply (erule CACH_INJECT)
(*Cond*)
apply clarsimp
  apply (erule compileExpr.cases) 
  apply simp apply simp prefer 2 apply simp
  apply clarsimp
  apply (erule_tac x=XXX in allE, erule_tac x= codeElse in allE, 
         erule_tac x=codeThen in allE, rotate_tac -1) 
  apply (erule_tac x= YYY in allE, clarsimp)
  apply (erule_tac x=G in allE, rotate_tac -1, erule_tac x=C in allE,
         erule_tac x=m in allE, clarsimp)
  apply (erule_tac x="la+2" in allE, erule_tac x= codea in allE, 
         erule_tac x=codeElse in allE, rotate_tac -1) 
  apply (erule_tac x= XXX in allE, clarsimp)
  apply (erule_tac x=G in allE, rotate_tac -1, erule_tac x=C in allE,
         erule_tac x=m in allE, clarsimp)
  apply (drule compileExpr_Prop1) apply fastforce apply clarsimp 
  apply (drule compileExpr_Prop1) apply fastforce apply clarsimp 
  apply (erule impE) apply (rotate_tac 5, erule thin_rl, simp add: Segment_def,clarsimp)
    apply (rotate_tac -3, erule_tac x=ll in allE, clarsimp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp) apply (rule, rule, assumption, assumption)
  apply (erule impE) apply (simp add: Segment_def,clarsimp)
    apply (erule_tac x=ll in allE, clarsimp)
    apply (erule_tac x=ll in allE, clarsimp)
    apply (erule_tac x=ll in allE, clarsimp)
    apply (erule_tac x=ll in allE, clarsimp)
    apply (erule_tac x=ll in allE, clarsimp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp) apply clarsimp
  apply (frule Segment_triv) apply assumption apply (subgoal_tac "la  la", assumption, simp) apply simp
  apply clarsimp
  apply (drule AL_update3) apply simp apply (simp add: AL_update1) apply clarsimp
  apply (rule CACH_INSTR) 
    apply assumption    
    apply fast
    apply assumption
    apply assumption
  apply (rule CACH_INJECT)
  apply (frule Segment_triv) apply assumption apply (subgoal_tac "la  la+1", assumption, simp) apply simp
  apply clarsimp
  apply (simp add: AL_update1) apply clarsimp
  apply (frule Segment_triv) apply assumption apply (subgoal_tac "la  XXX", assumption, simp) apply simp
  apply clarsimp
  apply (drule AL_update3, simp)
  apply (drule AL_update3, simp)
  apply (rule CACH_IF) 
    apply assumption 
    apply assumption
    apply assumption
    apply (erule CACH_INJECT) 
    apply (subgoal_tac "la+2=2+la", clarsimp) apply (erule CACH_INJECT) apply simp
(*Match*)
apply clarsimp
  apply (erule compileExpr.cases) 
  apply simp apply simp apply simp
  apply clarsimp
  apply (erule_tac x=lNil in allE, erule_tac x= codeCons in allE, 
         erule_tac x=codeNil in allE, rotate_tac -1) 
  apply (erule_tac x=lRes in allE, clarsimp)
  apply (erule_tac x=G in allE, rotate_tac -1, erule_tac x=C in allE,
         erule_tac x=m in allE, clarsimp)
  apply (erule_tac x="la+9" in allE, erule_tac x=codea in allE, 
         erule_tac x=codeCons in allE, rotate_tac -1) 
  apply (erule_tac x=lNil in allE, clarsimp)
  apply (erule_tac x=G in allE, rotate_tac -1, erule_tac x=C in allE,
         erule_tac x=m in allE, clarsimp)
  apply (drule compileExpr_Prop1) apply fastforce apply clarsimp 
  apply (drule compileExpr_Prop1) apply fastforce apply clarsimp 
  apply (erule impE) apply (rotate_tac 5, erule thin_rl)
    apply (simp add: Segment_def, clarsimp)
    apply (erule_tac x=ll in allE, clarsimp)
    apply (erule_tac x=ll in allE, clarsimp)
    apply (erule_tac x=ll in allE, clarsimp)
    apply (erule_tac x=ll in allE, clarsimp)
    apply (erule_tac x=ll in allE, clarsimp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp) apply clarsimp
  apply (erule impE) 
    apply (simp add: Segment_def, clarsimp)
    apply (erule_tac x=ll in allE, clarsimp)
    apply (erule_tac x=ll in allE, clarsimp)
    apply (erule_tac x=ll in allE, clarsimp)
    apply (erule_tac x=ll in allE, clarsimp)
    apply (erule_tac x=ll in allE, clarsimp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp) apply clarsimp
  apply (rule Basic_Sound) prefer 2 apply assumption prefer 4 apply simp prefer 2 apply (subgoal_tac "la  la", assumption, simp)
    apply (erule Segment_A) apply simp apply simp apply simp
    apply (rule AL_update5) 
    apply (rule AL_update5) 
    apply (rule AL_update5) 
    apply (rule AL_update5) 
    apply (rule AL_update5) 
    apply (rule AL_update5) 
    apply (rule AL_update5) 
    apply (rule AL_update5) 
    apply (simp add: AL_update1)  apply (simp, simp, simp) apply (simp, simp, simp)  apply (simp, simp)
    apply (simp add: basic_def)
    apply (rule CACH_INJECT)
  apply (rule Basic_Sound) prefer 2 apply assumption prefer 4 apply simp prefer 2 apply (subgoal_tac "la +1  la+1", assumption, simp)
    apply (erule Segment_A) apply simp apply simp apply simp
    apply (rule AL_update5) 
    apply (rule AL_update5) 
    apply (rule AL_update5) 
    apply (rule AL_update5) 
    apply (rule AL_update5) 
    apply (rule AL_update5) 
    apply (rule AL_update5)
    apply (simp add: AL_update1)  apply (simp, simp, simp) apply (simp, simp, simp)  apply simp
    apply (simp add: basic_def)
    apply (rule CACH_INJECT)
  apply (frule Segment_triv) apply assumption apply (subgoal_tac "la  lNil", assumption, simp, simp)
  apply (frule Segment_triv) apply assumption apply (subgoal_tac "la  la+3", assumption, simp, simp)
  apply clarsimp
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (subgoal_tac "la+3=3+la", clarsimp) prefer 2 apply simp
    apply (simp add: AL_update1) apply clarsimp
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (frule Segment_triv) apply assumption apply (subgoal_tac "la  2+la", assumption, simp, simp,clarsimp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (drule AL_update3, simp)
    apply (simp add: AL_update1a, clarsimp)    
    apply (rule CACH_IF)
      apply assumption
      apply assumption
      apply assumption
      apply (erule CACH_INJECT)
    apply simp
    apply (rule CACH_INJECT)
    apply (rule Basic_Sound)
      prefer 2 apply assumption
      prefer 2 apply (subgoal_tac "3+la  3+la", assumption, simp)
      apply (erule Segment_A) apply (simp,simp)
      apply simp
      apply simp 
      apply (rule AL_update5) 
      apply (rule AL_update5) 
      apply (rule AL_update5) 
      apply (rule AL_update5) 
      apply (rule AL_update5) 
      apply (simp add: AL_update1) 
      apply (simp,simp,simp)
      apply (simp,simp)
      apply (simp add: basic_def)
    apply (rule CACH_INJECT)
    apply (rule Basic_Sound)
      prefer 2 apply assumption 
      prefer 2 apply (subgoal_tac "4+la  4+la", assumption, simp)
      apply (erule Segment_A) apply (simp,simp)
      apply simp
      apply simp 
      apply (rule AL_update5) 
      apply (rule AL_update5) 
      apply (rule AL_update5) 
      apply (rule AL_update5) 
      apply (rule AL_update1a) apply simp
      apply (simp,simp,simp)
      apply simp
      apply (simp add: basic_def)
      apply (rule CACH_INJECT)
    apply (rule Basic_Sound)
      prefer 2 apply assumption
      prefer 2 apply (subgoal_tac "5+la  5+la", assumption, simp)
      apply (erule Segment_A) apply (simp,simp)
      apply simp
      apply simp 
      apply (rule AL_update5) 
      apply (rule AL_update5) 
      apply (rule AL_update5) 
      apply (rule AL_update1a) apply simp
      apply (simp,simp,simp)
      apply (simp add: basic_def)
      apply (rule CACH_INJECT)
    apply (rule Basic_Sound)
      prefer 2 apply assumption
      prefer 2 apply (subgoal_tac "6+la  6+la", assumption, simp)
      apply (erule Segment_A) apply (simp,simp)
      apply simp
      apply simp 
      apply (rule AL_update5) 
      apply (rule AL_update5) 
      apply (rule AL_update1a) apply simp
      apply (simp,simp)
      apply (simp add: basic_def)
      apply (rule CACH_INJECT)
    apply (rule Basic_Sound)
      prefer 2 apply assumption
      prefer 2 apply (subgoal_tac "7+la  7+la", assumption, simp)
      apply (erule Segment_A) apply (simp,simp)
      apply simp
      apply simp 
      apply (rule AL_update5)
      apply (rule AL_update1a) apply simp
      apply simp
      apply (simp add: basic_def)
      apply (rule CACH_INJECT)
    apply (rule Basic_Sound)
      prefer 2 apply assumption
      prefer 2 apply (subgoal_tac "8+la  8+la", assumption, simp)
      apply (erule Segment_A) apply (simp,simp)
      apply simp
      apply simp 
      apply (rule AL_update1a) apply simp
      apply (simp add: basic_def)
    apply (rule CACH_INJECT) apply (subgoal_tac "la+9=9+la", clarsimp)
    apply simp
done
(*>*)

text‹The full translation of a functional program into a bytecode
program is defined as follows.›

definition compileProg::"FunProg  bool" where
"compileProg F =
  (( C m par e. F(C,m) = Some(par,e)  
          ( code l0 l. mbody_is C m (rev par,code,l0) 
                       (l0,[],e,(code,l)):compileExpr)) 
   ( C m. ( M. mbody_is C m M) = ( fdecl . F(C,m) = Some fdecl)))"

text‹The final condition relating a typing context to a method
specification table.›

definition TP_MST::"TP_Sig  bool" where
"TP_MST Σ =
   ( C m . case (MST(C,m)) of
            None  Σ(C,m) = None
          | Some(T,MI,Anno)  Anno = emp  
                                ( n . Σ(C,m)=Some n  
                                (T,MI,Anno) = mkSPEC (Cachera n) emp))"

text‹For well-typed programs, this property implies the earlier
condition on signatures.›

lemma translation_good: "compileProg F; TP_MST Σ; TP Σ F  Sig_good Σ"
(*<*)
apply (simp add: compileProg_def TP_MST_def Sig_good_def TP_def, clarsimp)
apply (erule_tac x=C in allE, erule_tac x=m in allE)
apply (erule_tac x=C in allE, erule_tac x=m in allE)
apply (erule_tac x=C in allE, erule_tac x=m in allE)
apply (erule_tac x=C in allE, erule_tac x=m in allE)
apply (erule_tac x=C in allE, erule_tac x=m in allE)
apply (case_tac "MST(C,m)", clarsimp,clarsimp)
done
(*>*)

text‹We can thus prove that well-typed function bodies satisfy the
specifications asserted by the typing context.›

lemma CACH_BodiesDerivable[rule_format]:
  " mbody_is C m (par, code, l); compileProg F; TP_MST Σ; TP Σ F 
    n . MST(C,m) = Some(mkSPEC(Cachera n) emp)  
            deriv [] C m l (Cachera n)"
(*<*)
apply (subgoal_tac "( C m par e. F(C,m) = Some(par,e)  
                     ( code l0 l. mbody_is C m (rev par,code,l0) 
                                   (l0,[],e,(code,l)):compileExpr)) 
                 ( C m . ( M. mbody_is C m M) = ( fdecl . F(C,m) = Some fdecl))")
prefer 2 apply (simp add: compileProg_def, clarsimp)
apply (erule_tac x=C in allE, erule_tac x=m in allE)
apply (erule_tac x=C in allE, erule_tac x=m in allE, auto)
apply (simp add: mbody_is_def, clarsimp)
apply (subgoal_tac "((Σ(C,m) = None) = (F(C,m) = None))  
                       ( n par e . Σ(C,m) = Some n  F(C,m) = Some (par,e)  (Σ,e,n):TP_expr)")
prefer 2 apply (simp add: TP_def, clarsimp)
apply (subgoal_tac "MST(C, m) = Some (mkSPEC (Cachera y) emp)", clarsimp)
prefer 2 apply (simp add: TP_MST_def) 
  apply (erule_tac x=C in allE, erule_tac x=m in allE)
  apply (case_tac "MST(C, m)", clarsimp, clarsimp)
apply (rule_tac x=y in exI, simp)
apply (rule TP_epxr_Sound) apply assumption 
  apply (erule translation_good) apply assumption+
  apply (simp add: mkSPEC_def Cachera_def)

apply (drule compileExpr_Prop1) apply fastforce apply clarsimp
apply (simp add: Segment_def) 
apply (rule, rule, rule, rule, simp add: mkSPEC_def Cachera_def)
apply clarsimp apply (rule, rule AL_emp1) 
apply (erule_tac x=ll in allE)+ 
apply clarsimp 
apply (simp add: mbody_is_def get_ins_def ins_is_def) 
done
(*>*)

text‹From this, the overall soundness result follows easily.›

theorem CACH_VERIFIED: "TP Σ F; TP_MST Σ; compileProg F  VP"
(*<*)
apply (rule CACH_VP)
apply clarsimp apply (drule CACH_BodiesDerivable) apply assumption+ apply fast
apply clarsimp
done
(*>*)

(*<*)
end
(*>*)