(*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 @{text 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 \<Rightarrow> (Assn \<times> Post \<times> Inv)" where
"Cachera n = (\<lambda> s0 s . True,
              \<lambda> s0 (ops,s,h) (k,v) . |k| \<le> |h| + n,
              \<lambda> s0 (ops,s,h) k.  |k| \<le> |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 @{text MST}
contains the interpretations of the entries in $\Sigma$.*}

text{*We abbreviate the above construction of judgements by a
predicate @{text deriv}.*}

definition deriv::"CTXT \<Rightarrow> Class \<Rightarrow> Method \<Rightarrow> Label \<Rightarrow>
                    (Assn \<times> Post \<times> Inv) \<Rightarrow> bool" where
"deriv G C m l (ABI) = (let (A,B,I) = ABI in (G \<rhd> \<lbrace> A \<rbrace> C,m,l \<lbrace> B \<rbrace> 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 \<Rightarrow> Class \<Rightarrow> Method \<Rightarrow> Label \<Rightarrow>
                         (Assn \<times> Post \<times> Inv) \<Rightarrow> bool" where
"derivAssum G C m l (ABI) = (let (A,B,I) = ABI in G \<rhd>  \<langle> A \<rangle> C,m,l \<langle> B \<rangle> I)"

text{*The following operation converts a derived judgement into the
syntactical form of method specifications.*}

definition mkSPEC::"(Assn \<times> Post \<times> Inv) \<Rightarrow> ANNO \<Rightarrow>
                   (MethSpec \<times> MethInv \<times> ANNO)" where
"mkSPEC (ABI) Anno = (let (A,B,I) = ABI in
       (\<lambda> s0 t . B s0 (mkState s0) t, \<lambda> 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 @{text 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 @{text deriv}, their application will not. We first give
syntax-directed proof rules for all JVM instructions:*}

lemma CACH_NEW:
 "\<lbrakk> ins_is C m l (new c); MST\<down>(C,m)=Some(Mspec,Minv,Anno);
    Anno\<down>(l) = None; n = k + 1; derivAssum G C m (l+1) (Cachera k) \<rbrakk>
 \<Longrightarrow> 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\<down>(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\<down>(nextLoc ba) = None")
    apply (simp add: AL_Size_UpdateSuc)
  apply (rule nextLoc_fresh)
done
(*>*)

lemma CACH_INSTR:
 "\<lbrakk> ins_is C m l I;
    I \<in> { const c, dup, pop, swap, load x, store x, binop f,
          unop g, getfield d F, putfield d F, checkcast d};
    MST\<down>(C,m)=Some(Mspec,Minv,Anno); Anno\<down>(l) = None;
    derivAssum G C m (l+1) (Cachera n) \<rbrakk>
 \<Longrightarrow> 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:
 "\<lbrakk> ins_is C m l vreturn; MST\<down>(C,m)=Some(Mspec,Minv,Anno);
    Anno\<down>(l) = None \<rbrakk>
  \<Longrightarrow> 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:
 "\<lbrakk> ins_is C m l (goto pc); MST\<down>(C,m)=Some(Mspec,Minv,Anno);
    Anno\<down>(l) = None; derivAssum G C m pc (Cachera n) \<rbrakk>
 \<Longrightarrow> 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:
  "\<lbrakk> ins_is C m l (iftrue pc); MST\<down>(C,m)=Some(Mspec,Minv,Anno);
     Anno\<down>(l) = None; derivAssum G C m pc (Cachera n);
     derivAssum G C m (l+1) (Cachera n) \<rbrakk>
  \<Longrightarrow> 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:
  "\<lbrakk> ins_is C m l (invokeS D m'); mbody_is D m' (par,code,l0);
     MST\<down>(C,m)=Some(Mspec,Minv,Anno); Anno\<down>(l) = None;
     MST\<down>(D, m') = Some(mkSPEC (Cachera k) Anno2);
     nk = n+k; derivAssum G C m (l+1) (Cachera n)\<rbrakk>
   \<Longrightarrow> 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:
 "\<lbrakk> deriv G C m l (Cachera n); n \<le> k\<rbrakk> \<Longrightarrow> 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:
 "\<lbrakk> derivAssum G C m l (Cachera n); n \<le> k\<rbrakk>
  \<Longrightarrow> 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:
 "\<lbrakk> G\<down>(C,m,l) = Some (Cachera n); MST\<down>(C,m)=Some(Mspec,Minv,Anno);
    Anno\<down>(l) = None\<rbrakk>
 \<Longrightarrow> 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) \<Longrightarrow> 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 @{text
mkSPEC}-conversion).*}

lemma CACH_VP:
 "\<lbrakk> \<forall> c m par code l0. mbody_is c m (par, code, l0) \<longrightarrow>
          (\<exists> n Anno . MST\<down>(c,m) = Some(mkSPEC(Cachera n) Anno) \<and>
                 deriv G c m l0 (Cachera n));
    \<forall> c m l A B I. G\<down>(c,m,l) = Some(A,B,I) \<longrightarrow>
                   (\<exists> n . (A,B,I) = Cachera n \<and> deriv G c m l (Cachera n))\<rbrakk>
  \<Longrightarrow> 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 \<times> Method"

datatype Prim =
  IntPrim int
| UnPrim "Val \<Rightarrow> Val" Var
| BinPrim "Val \<Rightarrow> Val \<Rightarrow> 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 \<times> 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 \<times> Prim \<times> nat)set"
where
TP_int: "(\<Sigma>,IntPrim i,0) : TP_prim"
|
TP_un: "(\<Sigma>,UnPrim f x,0) : TP_prim"
|
TP_bin: "(\<Sigma>,BinPrim f x y,0) : TP_prim"
|
TP_nil: "(\<Sigma>,NilPrim,0) : TP_prim"
|
TP_cons: "(\<Sigma>,ConsPrim x y,1) : TP_prim"
|
TP_Call: "\<lbrakk>\<Sigma>\<down>f = Some n\<rbrakk> \<Longrightarrow> (\<Sigma>,CallPrim f args,n) : TP_prim"

text{*Next, the rules for general expressions.*}

inductive_set TP_expr::"(TP_Sig \<times> Expr \<times> nat) set"
where
TP_sub: "\<lbrakk>(\<Sigma>,e,m):TP_expr; m \<le> n\<rbrakk> \<Longrightarrow> (\<Sigma>,e,n):TP_expr"
|
TP_prim:"\<lbrakk>(\<Sigma>,p,n):TP_prim\<rbrakk> \<Longrightarrow> (\<Sigma>,PrimE p,n) : TP_expr"
|
TP_let: "\<lbrakk>(\<Sigma>,p,k):TP_prim; (\<Sigma>,e,m):TP_expr; n = k+m\<rbrakk>
        \<Longrightarrow> (\<Sigma>,LetE x p e,n) : TP_expr"
|
TP_Cond:"\<lbrakk>(\<Sigma>,e1,n):TP_expr; (\<Sigma>,e2,n):TP_expr\<rbrakk>
        \<Longrightarrow>(\<Sigma>,CondE x e1 e2,n) : TP_expr"
|
TP_Match:"\<lbrakk>(\<Sigma>,e1,n):TP_expr; (\<Sigma>,e2,n):TP_expr \<rbrakk>
          \<Longrightarrow> (\<Sigma>,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 \<Rightarrow> FunProg \<Rightarrow> bool" where
"TP \<Sigma> F = ((\<forall> f . (\<Sigma>\<down>f = None) = (F\<down>f = None)) \<and>
          (\<forall> f n par e . \<Sigma>\<down>f = Some n \<longrightarrow> F\<down>f = Some (par,e) \<longrightarrow> (\<Sigma>,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 \<times>  (Label,Instr) AssList \<times> Prim \<times> ((Label,Instr) AssList \<times> Label)) set"
where
compileInt: "(l, code, IntPrim i, (code[l\<mapsto>(const (IVal i))],l+1)) : compilePrim"
|
compileUn:
  "(l, code, UnPrim f x, (code[l\<mapsto>(load x)][(l+1)\<mapsto>(unop f)],l+2)) : compilePrim"
|
compileBin:
 "(l, code, BinPrim f x y,
     (code[l\<mapsto>(load x)][(l+1)\<mapsto>(load y)][(l+2)\<mapsto>(binop f)],l+3)) : compilePrim"
|
compileNil:
  "(l, code, NilPrim, (code[l\<mapsto>(const (RVal Nullref))],l+1)) : compilePrim"
|
compileCons:
  "(l, code, ConsPrim x y,
      (code[l\<mapsto>(load y)][(l+1)\<mapsto>(load x)]
           [(l+2)\<mapsto>(new LIST)][(l+3)\<mapsto>store tmp]
           [(l+4)\<mapsto>load tmp][(l+5)\<mapsto>(putfield LIST HD)]
           [(l+6)\<mapsto>load tmp][(l+7)\<mapsto>(putfield LIST TL)]
           [(l+8)\<mapsto>(load tmp)], l+9)) : compilePrim"
|
compileCall_Nil:
  "(l, code, CallPrim f [],(code[l\<mapsto>invokeS (fst f) (snd f)],l+1)): compilePrim"
|
compileCall_Cons:
  "\<lbrakk> (l+1,code[l\<mapsto>load x], CallPrim f args, OUT) : compilePrim\<rbrakk>
   \<Longrightarrow> (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 \<Longrightarrow>
 (\<forall> code1l1 . OUT = (code1, l1) \<longrightarrow>
     (l < l1 \<and> (\<forall> ll . ll < l \<longrightarrow> code1\<down>ll = code\<down>ll) \<and>
       (\<forall> ll . l \<le> ll \<longrightarrow> ll < l1 \<longrightarrow> (\<exists> ins . code1\<down>ll = 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 @{text MST} entries and method
names that are defined in the global program @{text P}.*}

definition Sig_good::"TP_Sig \<Rightarrow> bool" where
"Sig_good \<Sigma> =
 (\<forall> C m n. \<Sigma>\<down>(C,m) = Some n \<longrightarrow>
    (MST\<down>(C, m) = Some (mkSPEC (Cachera n) emp) \<and>
    (\<exists> par code l0 . mbody_is C m (par,code,l0))))"

text{*This definition requires @{text 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 \<Rightarrow> Method \<Rightarrow> Label \<Rightarrow> Label \<Rightarrow> (Label,Instr)AssList \<Rightarrow> bool"
where
"Segment C m l l1 code =
    (\<exists> Mspec Minv Anno . MST\<down>(C,m) = Some(Mspec,Minv,Anno) \<and>
      (\<forall>ll. l \<le> ll \<longrightarrow> ll < l1 \<longrightarrow>
          Anno\<down>(ll) = None \<and> (\<exists>ins. ins_is C m ll ins \<and> code\<down>ll = Some ins)))"

(*<*)
lemma Segment_triv:
  "\<lbrakk>Segment C m l l1 code; MST\<down>(C,m) = Some(Mspec,Minv,Anno); l \<le> ll; ll < l1\<rbrakk>
  \<Longrightarrow> (Anno\<down>(ll) = None \<and> (\<exists>ins. ins_is C m ll ins \<and> code\<down>ll = Some ins))"
by (simp add: Segment_def)

lemma Segment_triv1:
  "\<lbrakk>Segment C m l l1 code; MST\<down>(C,m) = Some(Mspec,Minv,Anno); l \<le> ll; ll < l1\<rbrakk> \<Longrightarrow> Anno\<down>(ll) = None"
by (simp add: Segment_def)

lemma Segment_triv2:
  "\<lbrakk>Segment C m l l1 code; l \<le> ll; ll < l1\<rbrakk> \<Longrightarrow> (\<exists>ins. ins_is C m ll ins \<and> code\<down>ll = Some ins)"
apply (simp add: Segment_def) apply clarsimp done

lemma Segment_A:
  "\<lbrakk>Segment C m l l1 code; l \<le> ll; ll < l1\<rbrakk> \<Longrightarrow> 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]:
 "\<Sigma>\<down>f = Some n \<longrightarrow>
    MST\<down>(fst f,snd f) = Some(mkSPEC (Cachera n) Anno2) \<longrightarrow>
    (\<exists> par body l0 . mbody_is (fst f) (snd f) (par,body,l0)) \<longrightarrow>
       (\<forall>l code code1 l1 G C m T MI k.
          (l, code, CallPrim f args, code1, l1) \<in> compilePrim \<longrightarrow>
          MST\<down>(C, m) = Some (T, MI,Anno) \<longrightarrow> Segment C m l l1 code1 \<longrightarrow>
          derivAssum G C m l1 (Cachera k) \<longrightarrow>
          deriv G C m l (Cachera (n+k)))"
(*<*)
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 \<le> 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[la\<mapsto>load 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 \<le> 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:
 "\<lbrakk> Sig_good \<Sigma>; \<Sigma>\<down>f = Some n;
   (l, code, CallPrim f args, code1, l1) \<in> compilePrim;
   MST\<down>(C,m) = Some (T, MI,Anno); Segment C m l l1 code1;
   derivAssum G C m l1 (Cachera nn); k = n+nn\<rbrakk>
 \<Longrightarrow> 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 \<Rightarrow> bool" where
"basic ins = ((\<exists> c . ins = const c) \<or> ins = dup \<or>
              ins= pop \<or> ins= swap \<or> (\<exists> x. ins= load x) \<or>
              (\<exists> y. ins= store y) \<or> (\<exists> f. ins= binop f) \<or>
              (\<exists> g. ins= unop g) \<or> (\<exists> c1 F1. ins= getfield c1 F1) \<or>
              (\<exists> c2 F2. ins=  putfield c2 F2) \<or>
              (\<exists> 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:
  "\<lbrakk> Segment C m l ll code; MST\<down>(C,m) = Some (T, MI,Anno); l\<le>l1; l1 < ll;
     l2=l1+1; code\<down>l1 = Some ins; basic ins; derivAssum G C m l2 (Cachera n)\<rbrakk>
   \<Longrightarrow> 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]:
  "(\<Sigma>,p,n):TP_prim \<Longrightarrow>
   Sig_good \<Sigma> \<longrightarrow>
   (\<forall> l code code1 l1 G C m T MI Anno nn k.
         (l, code, p, (code1,l1)) : compilePrim \<longrightarrow>
         MST\<down>(C,m) = Some (T,MI,Anno) \<longrightarrow>
         Segment C m l l1 code1 \<longrightarrow> derivAssum G C m l1 (Cachera nn) \<longrightarrow>
         k = n+nn \<longrightarrow> 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 \<le> 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 \<times> (Label,Instr) AssList \<times> Expr \<times> ((Label,Instr) AssList \<times> Label)) set"
where
compilePrimE:
 "\<lbrakk>(l, code, p, (code1,l1)) : compilePrim; OUT = (code1[l1\<mapsto>vreturn],l1+1)\<rbrakk>
   \<Longrightarrow> (l, code, PrimE p, OUT):compileExpr"
|
compileLetE:
  "\<lbrakk>(l, code, p, (code1,l1)) : compilePrim; (code2,l2) = (code1[l1\<mapsto>(store x)],l1+1);
     (l2, code2, e, OUT) : compileExpr\<rbrakk>
   \<Longrightarrow> (l, code, LetE x p e, OUT) : compileExpr"
|
compileCondE:
  "\<lbrakk>(l+2, code, e2, (codeElse,XXX)) : compileExpr;
     (XXX, codeElse, e1, (codeThen,YYY) ) : compileExpr ;
     OUT = (codeThen[l\<mapsto>load x][(l+1)\<mapsto>(iftrue XXX)], YYY)\<rbrakk>
   \<Longrightarrow> (l, code, CondE x e1 e2, OUT): compileExpr"
|
compileMatchE:
  "\<lbrakk>(l+9, code, e2, (codeCons,lNil)) : compileExpr;
     (lNil, codeCons, e1, (codeNil,lRes) ) : compileExpr ;
     OUT = (codeNil[l\<mapsto>(load x)]
                   [(l+1)\<mapsto>(unop (\<lambda> v . if v = RVal Nullref
                                 then TRUE else FALSE))]
                   [(l+2)\<mapsto>(iftrue lNil)]
                   [(l+3)\<mapsto>(load x)]
                   [(l+4)\<mapsto>(getfield LIST HD)]
                   [(l+5)\<mapsto>(store h)]
                   [(l+6)\<mapsto>(load x)]
                   [(l+7)\<mapsto>(getfield LIST TL)]
                   [(l+8)\<mapsto>(store t)], lRes) \<rbrakk>
   \<Longrightarrow> (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 \<Longrightarrow>
  (\<forall> code1 l1 . OUT = (code1, l1) \<longrightarrow>
      (l < l1 \<and>
       (\<forall> ll . ll < l \<longrightarrow> code1\<down>ll = code\<down>ll) \<and>
       (\<forall> ll . l \<le> ll \<longrightarrow> ll < l1 \<longrightarrow> (\<exists> ins . code1\<down>ll = 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 \<le> 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 \<le> 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]:
"(\<Sigma>,e,n):TP_expr \<Longrightarrow> Sig_good \<Sigma> \<longrightarrow>
 (\<forall> l code code1 l1 G C m T MI Anno.
    (l, code, e, (code1,l1)):compileExpr \<longrightarrow>
    MST\<down>(C,m) = Some (T,MI,Anno) \<longrightarrow>
    Segment C m l l1 code1 \<longrightarrow> deriv G C m l (Cachera n))"
(*<*)
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[l1a\<mapsto>store 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 \<le> l1a", assumption, simp)
    prefer 3 apply (subgoal_tac "a\<down>l1a = 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 \<le> 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 \<le> 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 \<le> 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 \<le> 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 \<le> 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 \<le> lNil", assumption, simp, simp)
  apply (frule Segment_triv) apply assumption apply (subgoal_tac "la \<le> 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 \<le> 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 \<le> 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 \<le> 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 \<le> 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 \<le> 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 \<le> 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 \<le> 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 \<Rightarrow> bool" where
"compileProg F =
  ((\<forall> C m par e. F\<down>(C,m) = Some(par,e) \<longrightarrow>
          (\<exists> code l0 l. mbody_is C m (rev par,code,l0) \<and>
                       (l0,[],e,(code,l)):compileExpr)) \<and>
   (\<forall> C m. (\<exists> M. mbody_is C m M) = (\<exists> fdecl . F\<down>(C,m) = Some fdecl)))"

text{*The final condition relating a typing context to a method
specification table.*}

definition TP_MST::"TP_Sig \<Rightarrow> bool" where
"TP_MST \<Sigma> =
   (\<forall> C m . case (MST\<down>(C,m)) of
            None \<Rightarrow> \<Sigma>\<down>(C,m) = None
          | Some(T,MI,Anno) \<Rightarrow> Anno = emp \<and>
                                (\<exists> n . \<Sigma>\<down>(C,m)=Some n \<and>
                                (T,MI,Anno) = mkSPEC (Cachera n) emp))"

text{*For well-typed programs, this property implies the earlier
condition on signatures. *}

lemma translation_good: "\<lbrakk>compileProg F; TP_MST \<Sigma>; TP \<Sigma> F\<rbrakk> \<Longrightarrow> Sig_good \<Sigma>"
(*<*)
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\<down>(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]:
  "\<lbrakk> mbody_is C m (par, code, l); compileProg F; TP_MST \<Sigma>; TP \<Sigma> F\<rbrakk>
  \<Longrightarrow> \<exists> n . MST\<down>(C,m) = Some(mkSPEC(Cachera n) emp) \<and>
            deriv [] C m l (Cachera n)"
(*<*)
apply (subgoal_tac "(\<forall> C m par e. F\<down>(C,m) = Some(par,e) \<longrightarrow>
                     (\<exists> code l0 l. mbody_is C m (rev par,code,l0) \<and>
                                   (l0,[],e,(code,l)):compileExpr)) \<and>
                 (\<forall> C m . (\<exists> M. mbody_is C m M) = (\<exists> fdecl . F\<down>(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 "((\<Sigma>\<down>(C,m) = None) = (F\<down>(C,m) = None)) \<and>
                       (\<forall> n par e . \<Sigma>\<down>(C,m) = Some n \<longrightarrow> F\<down>(C,m) = Some (par,e) \<longrightarrow> (\<Sigma>,e,n):TP_expr)")
prefer 2 apply (simp add: TP_def, clarsimp)
apply (subgoal_tac "MST\<down>(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\<down>(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: "\<lbrakk>TP \<Sigma> F; TP_MST \<Sigma>; compileProg F\<rbrakk> \<Longrightarrow> VP"
(*<*)
apply (rule CACH_VP)
apply clarsimp apply (drule CACH_BodiesDerivable) apply assumption+ apply fast
apply clarsimp
done
(*>*)

(*<*)
end
(*>*)


(*<*)(*:maxLineLen=68:*)
theory SB_fin
  imports SB
begin
(*>*)

declare %invisible[[show_types]]

default_sort %invisible"{finite,chan}"

subsection \<open>SB Functions with restricted domains \label{sub:sbfin}\<close>

text\<open>This section will provide some additional functions and
properties that only hold, if the domain of a \gls{sb} is empty. We
also introduce locals for constructing \Gls{sb}.\<close>

subsubsection \<open>Cont version of sbHdElem\_h \label{subsub:sbhdelemc}\<close>

text\<open>The @{const sbHdElem_h}\ref{subsub:sbhdelem} operator is in
general monotone, but not continuous. Nevertheless, the additional
restriction to a finite domain is enough for gaining this property.
Hence, we introduce a continuous lifted version of
@{const sbHdElem_h}.\<close>

lemma cont_h2:
  assumes"\<exists>s. s\<in>UNIV \<and> s\<notin>{c::'c. \<exists>i::nat. Y i  \<^enum>  c \<noteq> \<epsilon>}"
  shows"{c::'c. \<exists>i::nat. Y i  \<^enum>  c \<noteq> \<epsilon>}\<noteq>UNIV"
  using assms by auto

lift_definition sbHdElem_h_cont::"('c::{finite,chan})\<^sup>\<Omega> \<rightarrow> ('c\<^sup>\<surd>) u"is
"sbHdElem_h"
  apply(simp add: sbHdElem_h_def)
  apply(intro cont2cont)
  apply(rule Cont.contI2)
  apply(rule monofunI)
  apply auto[1]
  apply (metis sbhdelem_mono_eq sbhdelem_some sbhdelemchain)
proof-
  fix Y::"nat \<Rightarrow> 'c\<^sup>\<Omega>"
  assume ch1:"chain Y"
  assume ch2:"chain (\<lambda>i::nat. if sbIsLeast (Y i) then \<bottom> else
              Iup (Abs_sbElem (Some (\<lambda>c::'c. shd (Y i  \<^enum>  c)))))"
  have "adm (\<lambda>sb::'c\<^sup>\<Omega>. \<exists>c::'c. sb \<^enum> c= \<epsilon>)"
  proof(rule admI)
    fix Y::"nat \<Rightarrow> 'c\<^sup>\<Omega>"
    assume chain:"chain Y"
    assume epsholds:"\<forall>i::nat. \<exists>c::'c. Y i  \<^enum>  c = \<epsilon>"
    have well:"\<forall> i.  \<not> sbHdElemWell (Y i) "
      by (simp add: epsholds sbHdElemWell_def)
    have h0:"\<forall>c i. ((Y i) \<^enum> c \<noteq> \<epsilon>) \<longrightarrow> ((\<Squnion>i::nat. Y i)  \<^enum>  c \<noteq> \<epsilon>)"
      by (metis (full_types) chain is_ub_thelub minimal
          monofun_cfun_arg po_eq_conv)
    then obtain set_not_eps where set_not_eps_def:
      "set_not_eps = {c::'c. \<exists>i. Y i \<^enum> c \<noteq> \<epsilon>}"
    by simp
    have h01:"finite set_not_eps"
      by simp
    have h1:"\<forall>c\<in>(UNIV - set_not_eps). (\<Squnion>i::nat. Y i)  \<^enum>  c = \<epsilon>"
      by (simp add: chain contlub_cfun_arg set_not_eps_def)
    have "set_not_eps \<noteq> UNIV"
    proof(auto)
      assume a1: "set_not_eps = UNIV"
      have "\<exists>c \<in> UNIV. (\<Squnion>i::nat. Y i)  \<^enum>  c \<noteq> \<epsilon>"
        using a1 h0 set_not_eps_def by blast
      have "\<exists> i. sbHdElemWell (Y i)"
      proof (rule ccontr, simp)
       assume a10: "\<forall>i::nat. \<not> sbHdElemWell (Y i)"
       have f110: "\<And> i::nat. \<not> sbHdElemWell (Y i)"
         by (simp add: a10)
       obtain i where i_def: "\<not> sbHdElemWell (Y i)"
         by (simp add: a10)
       obtain ch_not_eps where ch_not_eps_def:
         "ch_not_eps = {{i. Y i \<^enum> (ch) \<noteq> \<epsilon>}|ch::'c. True }"
         by blast
       obtain surj_f where surj_f_def:
         "surj_f = (\<lambda> ch. {i. Y i \<^enum> (ch::'c) \<noteq> \<epsilon>})"
         by simp
       have "ch_not_eps \<subseteq>  surj_f ` ({c::'c | c. True})"
         using ch_not_eps_def surj_f_def by auto
       then have ch_not_epsfinite: "finite ch_not_eps"
         by (metis finite_code finite_surj)
       have ch_not_eps_ele_not_emp: "\<forall> ele \<in> ch_not_eps. ele \<noteq> {}"
         using ch_not_eps_def a1 set_not_eps_def by blast
       have dom_emty_iff:"\<And>c. (ch_not_eps={}) \<longleftrightarrow>
                          (Rep (c::'c) \<in> cEmpty)"
         by (metis (mono_tags, lifting) Collect_empty_eq
            Diff_eq_empty_iff IntI chDom_def ch_not_eps_def
            ch_not_eps_ele_not_emp chan_botsingle empty_iff
            mem_Collect_eq repinrange sbGetCh.rep_eq)
       have dom_not_emp_false: "ch_not_eps= {}"
       proof -
         have el_ch_not_eps_least: "\<forall> ele. ele \<in> ch_not_eps
            \<longrightarrow> (\<exists> i. i \<in> ele \<and> (\<forall> j \<in> ele. i \<le> j))"
         proof (rule ccontr, simp)
           assume a1111: "\<exists>ele::nat set. ele \<in> ch_not_eps \<and>
                 (\<forall>i::nat. i \<in> ele \<longrightarrow> (\<exists>x::nat\<in>ele. \<not> i \<le> x))"
           obtain the_ch where the_ch_def:
               "(surj_f the_ch) \<in> ch_not_eps \<and>
               (\<forall>i::nat. i \<in> (surj_f the_ch)
                \<longrightarrow> (\<exists>x::nat \<in> (surj_f the_ch). \<not> i \<le> x))"
                and the_ch_def2:
                "(surj_f the_ch) = {i. Y i \<^enum> the_ch \<noteq> \<epsilon>}"
             using a1111 ch_not_eps_def surj_f_def by blast
           obtain the_i where the_i_def: "the_i \<in> (surj_f the_ch)"
             using ch_not_eps_ele_not_emp the_ch_def by auto
           obtain the_subs where the_subst_def:
             "the_subs = {i. i \<le> the_i \<and> Y i \<^enum> the_ch \<noteq> \<epsilon>}"
             by simp
           have the_subs_fin: "finite the_subs"
             by (simp add: the_subst_def)
           hence the_min_in_subs: "Min the_subs \<in> the_subs"
             using Min_in the_subs_fin the_i_def the_subst_def
                   the_ch_def2 by blast
           hence the_min_min: "\<forall> i \<in> (surj_f the_ch).
                                    Min the_subs \<le> i"
             using the_ch_def2 nat_le_linear the_subst_def
             by fastforce
           show False
             using the_ch_def the_min_in_subs the_min_min surj_f_def
               the_ch_def the_subst_def by auto
         qed
          obtain bla::"nat set \<Rightarrow> nat set" where bla_def:
      "bla = (\<lambda> da_set. {the_i. (\<forall> i \<in> da_set. the_i \<le> i) \<and>
      the_i \<in> da_set})"
            by simp
          obtain min_set_set::"nat set" where min_set_set_def:
      "min_set_set = {THE i. i \<in> bla da_set |
      da_set. da_set \<in> ch_not_eps}"
            by simp
          have i_max_is_max: "\<forall> ch::'c. \<exists> i .
      (i \<in> min_set_set) \<longrightarrow> Y i \<^enum> ch \<noteq> \<epsilon>"
            using a1 set_not_eps_def by blast
          have min_set_set_finite: "finite min_set_set"
            by (simp add: ch_not_epsfinite min_set_set_def)
          obtain the_max where the_max_def:
                "the_max = Max min_set_set"
            by simp
          have "the_max \<in> min_set_set"
            by (metis (mono_tags, lifting) Max_in min_set_set_finite
                ch_not_eps_def empty_Collect_eq equals0I
                min_set_set_def the_max_def)
          have "sbHdElemWell (Y the_max)"
          proof (simp add: sbHdElemWell_def, rule)
            fix c::'c
            obtain the_set where the_set_def: "the_set = surj_f c"
              by simp
            then obtain the_min where the_min_def:
              "the_min \<in> the_set \<and> (\<forall> j \<in> the_set. the_min \<le> j)"
              using el_ch_not_eps_least ch_not_eps_def surj_f_def
                    the_set_def by blast
            have "bla the_set = {the_min}"
              using bla_def the_min_def by force
            hence "(THE i::nat. i \<in> bla the_set) = the_min"
              by auto
            hence the_min_min_set_set_in: "the_min \<in> min_set_set"
              using min_set_set_def ch_not_eps_def surj_f_def
                    the_set_def by blast
            have "Y the_min \<^enum> c \<noteq> \<epsilon>"
              using surj_f_def the_min_def the_set_def by blast
            thus "Y the_max  \<^enum>  c \<noteq> \<epsilon>"
              by (metis min_set_set_finite the_max_def chain
                  po_class.chain_mono minimal monofun_cfun_arg
                  po_eq_conv Max_ge the_min_min_set_set_in)
          qed
          then show ?thesis
            by (simp add: a10)
        qed
        then show False
          using ch_not_eps_def by auto
      qed
      thus False
        by (metis well)
    qed
    then show "\<exists>c::'c. (\<Squnion>i::nat. Y i)  \<^enum>  c = \<epsilon>"
      using h1 by blast
  qed
  hence "\<forall>i::nat. \<exists>c::'c. Y i  \<^enum>  c = \<epsilon>
          \<Longrightarrow> \<exists>c::'c. (\<Squnion>i::nat. Y i)  \<^enum>  c = \<epsilon>"
    using admD ch1 by blast
  hence finiteIn:"\<forall>c::'c. (\<Squnion>i::nat. Y i)  \<^enum>  c \<noteq> \<epsilon>
          \<Longrightarrow> \<exists>i. \<forall>c::'c. (Y i) \<^enum> c \<noteq> \<epsilon>"
    by blast
  thus "(if sbIsLeast (\<Squnion>i::nat. Y i) then \<bottom> else
Iup (Abs_sbElem (Some (\<lambda>c::'c. shd ((\<Squnion>i::nat. Y i)  \<^enum>  c))))) \<sqsubseteq>
       (\<Squnion>i::nat. if sbIsLeast (Y i) then \<bottom>
else Iup (Abs_sbElem (Some (\<lambda>c::'c. shd (Y i  \<^enum>  c)))))"
  proof(cases "sbIsLeast (\<Squnion>i::nat. Y i)")
    case True
    then show ?thesis
      using sbnleast_mex by auto
  next
    case False
    obtain n where n_def:"\<not>sbIsLeast (Y n)"
      by (metis False finiteIn sbHdElemWell_def)
    have "sbHdElemWell (\<Squnion>x::nat. Y x) \<Longrightarrow>
    Abs_sbElem (Some (\<lambda>c::'c. shd ((\<Squnion>x::nat. Y x)  \<^enum>  c))) =
    Abs_sbElem (Some (\<lambda>c::'c. shd (Y n  \<^enum>  c)))"
      by (metis below_shd ch1 is_ub_thelub n_def sbHdElemWell_def
          sbgetch_sbelow)
    hence "(if sbIsLeast (\<Squnion>i. Y i) then \<bottom> else Iup
(Abs_sbElem (Some (\<lambda>c::'c. shd ((\<Squnion>i::nat. Y i)  \<^enum>  c))))) \<sqsubseteq>
 Iup (Abs_sbElem (Some (\<lambda>c::'c. shd (Y n  \<^enum>  c))))"
      by auto
    then show ?thesis
      by (metis (mono_tags, lifting) below_lub ch2 n_def)
  qed
qed

subsubsection\<open>SB step functions\<close>

text\<open>Often a \gls{sb} is processed element wise. If there is no
complete element in the \gls{sb} we return \<open>\<bottom>\<close>. We use the
following definition for realising the automaton semantics, but it
could also be used to define a continuous version of @{const sbLen}
\ref{subsub:sblen} for \Gls{sb} with a finite domain or other
operators.\<close>

definition sb_split::"('cs\<^sup>\<surd> \<Rightarrow> 'cs\<^sup>\<Omega> \<rightarrow> 'a::pcpo) \<rightarrow> 'cs\<^sup>\<Omega> \<rightarrow> 'a" where
"sb_split \<equiv> \<Lambda> k sb. fup\<cdot>(\<Lambda> sbe. k sbe\<cdot>(sbRt\<cdot>sb))\<cdot>(sbHdElem_h_cont\<cdot>sb)"

text\<open>The @{const sb_split} function takes a function that describes
the split wise mapping of a @{type sbElem} and a \gls{sb} and
returns a function, that only takes a \gls{sb} as an input. And maps
its first element accordingly.\<close>

lemma sb_split_insert:"sb_split\<cdot>k\<cdot>sb = (case sbHdElem_h_cont\<cdot>sb of
up\<cdot>(sbe::'b\<^sup>\<surd>) \<Rightarrow> k sbe\<cdot>(sbRt\<cdot>sb))"
  apply(simp add: sb_split_def)
  apply(subst beta_cfun)
  apply(intro cont2cont,simp_all)
  using cont2cont_fst cont_fst cont_snd discr_cont3 by blast

text\<open>Interestingly, the output of @{const sb_split} is only strict
by definition, if the domain of its input is not empty. For the
empty domain it behaves according to the function it gets as a
input.\<close>

lemma sb_splits_bot[simp]:
"\<not>(chDomEmpty (TYPE ('cs))) \<Longrightarrow> sb_split\<cdot>f\<cdot>(\<bottom>::'cs\<^sup>\<Omega>) = \<bottom>"
  by(simp add: sb_split_insert sbHdElem_h_cont.rep_eq sbHdElem_h_def
      chDom_def)

theorem sb_splits_leastbot[simp]:
"\<not>(chDomEmpty (TYPE ('cs))) \<Longrightarrow> sbIsLeast sb
  \<Longrightarrow> sb_split\<cdot>f\<cdot>(sb::'cs\<^sup>\<Omega>) = \<bottom>"
  by(simp add: sb_split_insert sbHdElem_h_cont.rep_eq sbHdElem_h_def
      chDom_def)

text\<open>Hence, it is only a helper function construct mappings over
\Gls{sb} from a step wise mapping over @{type sbElem}s.\<close>

theorem sb_splits_sbe[simp]:"sb_split\<cdot>f\<cdot>(sbe \<bullet>\<^sup>\<surd> sb) = f sbe\<cdot>sb"
  apply (subst sb_split_insert)
  apply (subst sbrt_sbecons)
  by(simp add: sbHdElem_h_cont.rep_eq sbhdelem_h_sbe)

lemma sb_splits_sbe_empty[simp]:
"chDomEmpty TYPE('cs) \<Longrightarrow> sb_split\<cdot>f\<cdot>(sb::'cs\<^sup>\<Omega>) = f sbe\<cdot>sb"
  by (metis (full_types) sb_splits_sbe sbtypeepmpty_sbbot)

subsection\<open>Datatype Constructors for SBs \label{sub:sblocals}\<close>

text\<open>This section introduces two locals. Both locals use constructor
functions to define (almost) bijective mappings.
The first local provides two mappings. The fist one maps some
type \<open>'a\<close> to a @{type sbElem}. The second one maps a
\<open>'a\<close> @{type stream} to a \gls{sb}. It is injective , but not
surjective.
The second local provides a bijektive mapping from \<open>'a \<close> to
\gls{sb}. In the following we will refer to there mappings as
setters and getters. Setters construct a @{type sbElem} or \gls{sb},
and getters destruct them to there original type.\<close>

text\<open>Type \<open>'a\<close> can be interpreted as a tuple. Because we have
almost no assumptions for \<open>'a \<close>, the user can freely choose \<open>'a\<close>.
Hence, he will not use the datatype \<open>M\<close>. These locals could for
example create setters from from \<open>'a = (nat \<times> bool) stream\<close> and
\<open>'a = (nat stream \<times> bool stream)\<close> to a bundle with one bool-channel
and one nat-channel. Thus, we can construct all bundles with an
finite domain.\<close>

text\<open>Furthermore, those locals contain important lemmas that always
follow from the locals assumptions. These can be accessed without
additional proofs after interpreting the constructor. Same goes for
the setters and getters.\<close>

subsubsection\<open>sbElem Local\<close>

text\<open>The first local needs some assumption for the constructor
function and its types. If the domain be empty, \<open>'a \<close>
must be a singleton, else, the constructor has to map to a function
that can be interpreted as a @{type sbElem}, is also has to map to
every possible @{type sbElem} and be injective.\<close>

locale sbeGen =
  fixes lConstructor::"'a::countable \<Rightarrow> 'cs::{chan, finite} \<Rightarrow> M"
  assumes c_well: "\<And>a. \<not>chDomEmpty TYPE ('cs)
                        \<Longrightarrow> sbElem_well (Some (lConstructor a))"
      and c_inj: "\<not>chDomEmpty TYPE ('cs) \<Longrightarrow> inj lConstructor"
      and c_surj: "\<And>sbe. \<not>chDomEmpty TYPE ('cs)
                        \<Longrightarrow> sbElem_well (Some sbe)
                        \<Longrightarrow> sbe\<in>range lConstructor"
      and c_empty: "chDomEmpty TYPE ('cs)
                        \<Longrightarrow> is_singleton(UNIV::'a set)"
begin

text\<open>For constructing the setter and getter function, we use our
constructor. It essentially is our setter, if the domain is not
empty.\<close>

lift_definition setter::"'a \<Rightarrow> 'cs\<^sup>\<surd>" is
"if(chDomEmpty TYPE ('cs)) then (\<lambda>_. None) else Some o lConstructor"
  using c_well sbtypeempty_sbewell by auto

text\<open>The getter work analogous with the inverse constructor.\<close>

definition getter::"'cs\<^sup>\<surd> \<Rightarrow> 'a" where
"getter sbe = (case (Rep_sbElem sbe) of
        None   \<Rightarrow> (SOME x. True)        |
        Some f \<Rightarrow> (inv lConstructor) f)"

text\<open>We can then show the bijectivity and hence, their inverse
behavior.\<close>

theorem get_set[simp]: "getter (setter a) = a"
  unfolding getter_def
  apply (simp add: setter.rep_eq c_inj c_empty)
  by (metis (full_types)UNIV_I c_empty is_singletonE singleton_iff)

lemma set_inj: "inj setter"
  by (metis get_set injI)

lemma set_surj: "surj setter"
  unfolding setter_def
  apply(cases "\<not>(chDomEmpty(TYPE('cs)))",auto)
  apply(simp add: chDom_def)
  apply auto
proof-
  fix xb::"'cs\<^sup>\<surd>" and xa::'cs
  assume chnEmpty:"Rep xa \<notin> cEmpty"
  obtain f where f_def:"Rep_sbElem xb=(Some f)"
    using chnEmpty sbtypenotempty_fex cempty_rule by blast
  then obtain x where x_def:"f = lConstructor x"
    by (metis c_surj rangeE sbelemwell2fwell sbtypeempty_notsbewell)
  then show "xb\<in>range (\<lambda>x::'a. Abs_sbElem (Some (lConstructor x)))"
    by (metis (no_types,lifting) Rep_sbElem_inverse f_def range_eqI)
qed

theorem set_bij: "bij setter"
  by (metis bijI inj_onI sbeGen.get_set sbeGen_axioms set_surj)

lemma get_inv_set: "getter = (inv setter)"
  by (metis get_set set_surj surj_imp_inv_eq)

theorem set_get[simp]: "setter (getter sbe) = sbe"
  apply(simp add: get_inv_set)
  by (meson bij_inv_eq_iff set_bij)

lemma "getter A = getter B \<Longrightarrow> A = B"
  by (metis set_get)

text\<open>These @{const setter} and @{const getter} functions for
@{type sbElem}s can then be used to define setter and getter
functions for \Gls{sb}. Because we construct those \Gls{sb} purely
by appending @{type sbElem}s, we can only construct a subset of all
\Gls{sb}.\<close>

fixrec setterSB::"'a stream \<rightarrow> 'cs\<^sup>\<Omega>" where
"setterSB\<cdot>((up\<cdot>l)&&ls) = (setter (undiscr l)) \<bullet>\<^sup>\<surd> (setterSB\<cdot>ls)"

lemma settersb_unfold[simp]:
"setterSB\<cdot>(\<up>a \<bullet> s) = (setter a) \<bullet>\<^sup>\<surd> setterSB\<cdot>s"
  unfolding setterSB_def
  apply(subst fix_eq)
  apply simp
  apply(subgoal_tac "\<exists>l. \<up>a \<bullet> s = (up\<cdot>l)&&s")
  apply auto
  apply (metis (no_types, lifting) lshd_updis stream.sel_rews(4)
         undiscr_Discr up_inject)
  by (metis lscons_conv)

lemma settersb_emptyfix[simp]:
"chDomEmpty (TYPE ('cs)) \<Longrightarrow> setterSB\<cdot>s = \<bottom>"
  by simp

lemma settersb_strict[simp]:"setterSB\<cdot>\<epsilon> = \<bottom>"
  apply(simp add: setterSB_def)
  apply(subst fix_eq)
  by auto

definition getterSB::"'cs\<^sup>\<Omega> \<rightarrow> 'a stream" where
"getterSB \<equiv> fix\<cdot>(\<Lambda> h. sb_split\<cdot>
                (\<lambda>sbe. \<Lambda> sb. updis (getter sbe) && h\<cdot>sb))"

text\<open>The following theorems describe when @{const setterSB} and
@{const getterSB} are behave inverse to each other.\<close>

lemma gettersb_unfold[simp]:
"getterSB\<cdot>(sbe \<bullet>\<^sup>\<surd> sb) = \<up>(getter sbe) \<bullet> getterSB\<cdot>sb"
  unfolding getterSB_def
  apply(subst fix_eq)
  apply simp
  by (simp add: lscons_conv)

lemma gettersb_emptyfix:
  "chDomEmpty (TYPE ('cs))
  \<Longrightarrow> getterSB\<cdot>sb = \<up>(getter (Abs_sbElem None)) \<bullet> getterSB\<cdot>sb"
  by (metis(full_types) gettersb_unfold sbtypeepmpty_sbbot)

lemma gettersb_empty_inf: "chDomEmpty (TYPE ('cs))
  \<Longrightarrow> getterSB\<cdot>sb = sinftimes (\<up>(getter (Abs_sbElem None)))"
  using gettersb_emptyfix s2sinftimes by blast

lemma gettersb_realboteps[simp]:
  "\<not>(chDomEmpty (TYPE ('cs))) \<Longrightarrow> getterSB\<cdot>\<bottom> = \<epsilon>"
  unfolding getterSB_def
  apply(subst fix_eq)
  by (simp)

lemma gettersb_boteps[simp]:
  "\<not>(chDomEmpty (TYPE ('cs))) \<Longrightarrow> sbIsLeast sb \<Longrightarrow> getterSB\<cdot>sb = \<epsilon>"
  unfolding getterSB_def
  apply(subst fix_eq)
  by (simp)

lemma gettersb_inftimes:
  assumes "chDomEmpty (TYPE ('cs))"
  shows "(getterSB\<cdot>sb) = (sinftimes(\<up>(a)))"
  apply(insert assms,subst gettersb_emptyfix,simp)
  using gettersb_emptyfix s2sinftimes c_empty
  by (metis (mono_tags) get_set sbtypeepmpty_sbenone)

lemma "\<not>chDomEmpty TYPE('cs) \<Longrightarrow> sbLen (setterSB\<cdot>s) = #s"
  oops

lemma "a \<sqsubseteq> getterSB\<cdot>(setterSB\<cdot>a)"
  apply(induction a rule: ind)
  apply(auto)
  by (simp add: monofun_cfun_arg)

theorem getset_eq[simp]:
  "\<not>chDomEmpty (TYPE ('cs)) \<Longrightarrow> getterSB\<cdot>(setterSB\<cdot>a) = a"
  apply(induction a rule: ind)
  by auto

lemma "setterSB\<cdot>(getterSB\<cdot>sb) \<sqsubseteq> sb"
  apply(induction sb,simp)
  apply(cases "chDomEmpty(TYPE('cs))",simp,simp)
  apply(subst gettersb_unfold;subst settersb_unfold)
  by (metis cont_pref_eq1I set_get)

lemma "sb1 = sb2 \<Longrightarrow> sbe \<bullet>\<^sup>\<surd> sb1 = sbe \<bullet>\<^sup>\<surd> sb2"
  by simp

(*Important TODO*)
lemma setget_eq:"(\<forall>c. #(sb \<^enum> c) = k) \<Longrightarrow>setterSB\<cdot>(getterSB\<cdot>sb) = sb"
  oops

(*<*)
fun setterList::"'a list \<Rightarrow> 'cs\<^sup>\<Omega>" where
"setterList [] = \<bottom>" |
"setterList (l#ls) = (setter l) \<bullet>\<^sup>\<surd> (setterList ls)"

(*>*)
end

subsubsection \<open>SB Local\<close>

text\<open>Since the \gls{sb} setter and getter from local @{const sbeGen}
are bijektive in all cases, we introduce another local to provide
bijektive setters and getters for \Gls{sb}. We also have no
assumption for the domain. The constructor has to be injective and
maps precisely to all possible functions, that can be lifted to
stream bundles.\<close>

(*Todo exchange c_type with sb_well assumption*)

locale sbGen =
  fixes lConstructor::" 'a::pcpo \<Rightarrow> 'cs::chan  \<Rightarrow> M stream"
  assumes c_type: "\<And>a c. sValues\<cdot>(lConstructor a c) \<subseteq> ctype (Rep c)"
    and c_inj: "inj lConstructor"
    and c_surj: "\<And>f. sb_well f \<Longrightarrow> f\<in>range lConstructor"
begin

text\<open>The setter and getter defined in this local are each others
inverse.\<close>

lift_definition setter::"'a \<Rightarrow> ('cs::chan)\<^sup>\<Omega>"is"lConstructor"
  by (simp add: c_type sb_well_def)

definition getter::"'cs\<^sup>\<Omega> \<Rightarrow> 'a" where
"getter= (inv lConstructor) o  Rep_sb"

text\<open>Hence, the cancel each other as shown in the following
theorems.\<close>

theorem get_set[simp]: "getter (setter a) = a"
  unfolding getter_def
  by (simp add: setter.rep_eq c_inj)

lemma set_inj: "inj setter"
  by (metis get_set injI)

lemma set_surj: "surj setter"
  unfolding setter_def
proof(simp add: surj_def,auto)
  fix y::"'cs\<^sup>\<Omega>"
 obtain f where f_def:"Rep_sb y=f"
   by simp
 then obtain x where x_def:"f = lConstructor x"
    by (metis c_inj c_surj f_the_inv_into_f sbwell2fwell)
  then show "\<exists>x::'a. y = Abs_sb (lConstructor x)"
    by (metis Rep_sb_inverse f_def)
qed

theorem set_bij: "bij setter"
  using bij_betw_def set_inj set_surj by auto

lemma get_inv_set: "getter = (inv setter)"
  by (metis get_set set_surj surj_imp_inv_eq)

theorem set_get[simp]: "setter (getter sbe) = sbe"
  apply(simp add: get_inv_set)
  by (meson bij_inv_eq_iff set_bij)

lemma "getter A = getter B \<Longrightarrow> A = B"
  by (metis set_get)

end
(*<*)
end
(*>*)


(*  Title:      HOL/MicroJava/J/JBasis.thy
    Author:     David von Oheimb, TU Muenchen
*)

chapter \<open>Java Source Language \label{cha:j}\<close>

section \<open>Some Auxiliary Definitions\<close>

theory JBasis
imports
  Main
  "~~/src/HOL/Library/Transitive_Closure_Table"
  "~~/src/HOL/Eisbach/Eisbach"
begin

lemmas [simp] = Let_def

subsection "unique"

definition unique :: "('a \<times> 'b) list => bool" where
  "unique == distinct \<circ> map fst"

lemma fst_in_set_lemma: "(x, y) : set xys ==> x : fst ` set xys"
  by (induct xys) auto

lemma unique_Nil [simp]: "unique []"
  by (simp add: unique_def)

lemma unique_Cons [simp]: "unique ((x,y)#l) = (unique l & (!y. (x,y) ~: set l))"
  by (auto simp: unique_def dest: fst_in_set_lemma)

lemma unique_append: "unique l' ==> unique l ==>
    (!(x,y):set l. !(x',y'):set l'. x' ~= x) ==> unique (l @ l')"
  by (induct l) (auto dest: fst_in_set_lemma)

lemma unique_map_inj: "unique l ==> inj f ==> unique (map (%(k,x). (f k, g k x)) l)"
  by (induct l) (auto dest: fst_in_set_lemma simp add: inj_eq)

subsection "More about Maps"

lemma map_of_SomeI: "unique l ==> (k, x) : set l ==> map_of l k = Some x"
  by (induct l) auto

lemma Ball_set_table: "(\<forall>(x,y)\<in>set l. P x y) ==> (\<forall>x. \<forall>y. map_of l x = Some y --> P x y)"
  by (induct l) auto

lemma table_of_remap_SomeD:
  "map_of (map (\<lambda>((k,k'),x). (k,(k',x))) t) k = Some (k',x) ==>
    map_of t (k, k') = Some x"
  by (atomize (full), induct t) auto

end