backported parts of abstract byte code verifier from AFP/Jinja
authorhaftmann
Tue Nov 24 14:37:23 2009 +0100 (2009-11-24)
changeset 339541bc3b688548c
parent 33930 6a973bd43949
child 33955 fff6f11b1f09
backported parts of abstract byte code verifier from AFP/Jinja
src/HOL/IsaMakefile
src/HOL/MicroJava/BV/Altern.thy
src/HOL/MicroJava/BV/BVExample.thy
src/HOL/MicroJava/BV/BVNoTypeError.thy
src/HOL/MicroJava/BV/BVSpec.thy
src/HOL/MicroJava/BV/BVSpecTypeSafe.thy
src/HOL/MicroJava/BV/Correct.thy
src/HOL/MicroJava/BV/Effect.thy
src/HOL/MicroJava/BV/EffectMono.thy
src/HOL/MicroJava/BV/Err.thy
src/HOL/MicroJava/BV/JType.thy
src/HOL/MicroJava/BV/JVM.thy
src/HOL/MicroJava/BV/JVMType.thy
src/HOL/MicroJava/BV/Kildall.thy
src/HOL/MicroJava/BV/LBVComplete.thy
src/HOL/MicroJava/BV/LBVCorrect.thy
src/HOL/MicroJava/BV/LBVJVM.thy
src/HOL/MicroJava/BV/LBVSpec.thy
src/HOL/MicroJava/BV/Listn.thy
src/HOL/MicroJava/BV/Opt.thy
src/HOL/MicroJava/BV/Product.thy
src/HOL/MicroJava/BV/Semilat.thy
src/HOL/MicroJava/BV/SemilatAlg.thy
src/HOL/MicroJava/BV/Typing_Framework.thy
src/HOL/MicroJava/BV/Typing_Framework_JVM.thy
src/HOL/MicroJava/BV/Typing_Framework_err.thy
src/HOL/MicroJava/Comp/AuxLemmas.thy
src/HOL/MicroJava/Comp/CorrComp.thy
src/HOL/MicroJava/Comp/CorrCompTp.thy
src/HOL/MicroJava/Comp/DefsComp.thy
src/HOL/MicroJava/Comp/Index.thy
src/HOL/MicroJava/Comp/LemmasComp.thy
src/HOL/MicroJava/Comp/NatCanonify.thy
src/HOL/MicroJava/Comp/TranslComp.thy
src/HOL/MicroJava/Comp/TranslCompTp.thy
src/HOL/MicroJava/Comp/TypeInf.thy
src/HOL/MicroJava/DFA/Abstract_BV.thy
src/HOL/MicroJava/DFA/Err.thy
src/HOL/MicroJava/DFA/Kildall.thy
src/HOL/MicroJava/DFA/LBVComplete.thy
src/HOL/MicroJava/DFA/LBVCorrect.thy
src/HOL/MicroJava/DFA/LBVSpec.thy
src/HOL/MicroJava/DFA/Listn.thy
src/HOL/MicroJava/DFA/Opt.thy
src/HOL/MicroJava/DFA/Product.thy
src/HOL/MicroJava/DFA/Semilat.thy
src/HOL/MicroJava/DFA/SemilatAlg.thy
src/HOL/MicroJava/DFA/Semilattices.thy
src/HOL/MicroJava/DFA/Typing_Framework.thy
src/HOL/MicroJava/DFA/Typing_Framework_err.thy
src/HOL/MicroJava/J/Conform.thy
src/HOL/MicroJava/J/Decl.thy
src/HOL/MicroJava/J/Eval.thy
src/HOL/MicroJava/J/Example.thy
src/HOL/MicroJava/J/Exceptions.thy
src/HOL/MicroJava/J/JBasis.thy
src/HOL/MicroJava/J/JListExample.thy
src/HOL/MicroJava/J/JTypeSafe.thy
src/HOL/MicroJava/J/State.thy
src/HOL/MicroJava/J/SystemClasses.thy
src/HOL/MicroJava/J/Term.thy
src/HOL/MicroJava/J/Type.thy
src/HOL/MicroJava/J/TypeRel.thy
src/HOL/MicroJava/J/Value.thy
src/HOL/MicroJava/J/WellForm.thy
src/HOL/MicroJava/J/WellType.thy
src/HOL/MicroJava/JVM/JVMDefensive.thy
src/HOL/MicroJava/JVM/JVMExceptions.thy
src/HOL/MicroJava/JVM/JVMExec.thy
src/HOL/MicroJava/JVM/JVMExecInstr.thy
src/HOL/MicroJava/JVM/JVMInstructions.thy
src/HOL/MicroJava/JVM/JVMListExample.thy
src/HOL/MicroJava/JVM/JVMState.thy
src/HOL/MicroJava/MicroJava.thy
src/HOL/MicroJava/ROOT.ML
src/HOL/MicroJava/document/introduction.tex
src/HOL/MicroJava/document/root.bib
src/HOL/MicroJava/document/root.tex
     1.1 --- a/src/HOL/IsaMakefile	Wed Dec 02 12:04:07 2009 +0100
     1.2 +++ b/src/HOL/IsaMakefile	Tue Nov 24 14:37:23 2009 +0100
     1.3 @@ -848,20 +848,20 @@
     1.4    MicroJava/J/JListExample.thy MicroJava/JVM/JVMExec.thy		\
     1.5    MicroJava/JVM/JVMInstructions.thy MicroJava/JVM/JVMState.thy		\
     1.6    MicroJava/JVM/JVMExecInstr.thy MicroJava/JVM/JVMListExample.thy	\
     1.7 -  MicroJava/JVM/JVMExceptions.thy MicroJava/BV/BVSpec.thy		\
     1.8 +  MicroJava/JVM/JVMExceptions.thy MicroJava/DFA/Abstract_BV.thy		\
     1.9 +  MicroJava/DFA/Err.thy MicroJava/DFA/Kildall.thy			\
    1.10 +  MicroJava/DFA/LBVComplete.thy MicroJava/DFA/LBVCorrect.thy		\
    1.11 +  MicroJava/DFA/LBVSpec.thy MicroJava/DFA/Listn.thy			\
    1.12 +  MicroJava/DFA/Opt.thy MicroJava/DFA/Product.thy			\
    1.13 +  MicroJava/DFA/SemilatAlg.thy MicroJava/DFA/Semilat.thy		\
    1.14 +  MicroJava/DFA/Semilattices.thy MicroJava/DFA/Typing_Framework_err.thy	\
    1.15 +  MicroJava/DFA/Typing_Framework.thy MicroJava/BV/BVSpec.thy		\
    1.16    MicroJava/BV/BVSpecTypeSafe.thy MicroJava/BV/Correct.thy		\
    1.17 -  MicroJava/BV/Err.thy MicroJava/BV/JType.thy MicroJava/BV/JVM.thy	\
    1.18 -  MicroJava/BV/JVMType.thy MicroJava/BV/Kildall.thy			\
    1.19 -  MicroJava/BV/LBVSpec.thy MicroJava/BV/Listn.thy MicroJava/BV/Opt.thy	\
    1.20 -  MicroJava/BV/Product.thy MicroJava/BV/Semilat.thy			\
    1.21 +  MicroJava/BV/JType.thy MicroJava/BV/JVM.thy MicroJava/BV/JVMType.thy	\
    1.22    MicroJava/BV/Effect.thy MicroJava/BV/EffectMono.thy			\
    1.23 -  MicroJava/BV/Typing_Framework.thy					\
    1.24 -  MicroJava/BV/Typing_Framework_err.thy					\
    1.25    MicroJava/BV/Typing_Framework_JVM.thy MicroJava/BV/BVExample.thy	\
    1.26 -  MicroJava/BV/LBVSpec.thy MicroJava/BV/LBVCorrect.thy			\
    1.27 -  MicroJava/BV/LBVComplete.thy MicroJava/BV/LBVJVM.thy			\
    1.28 -  MicroJava/document/root.bib MicroJava/document/root.tex		\
    1.29 -  MicroJava/document/introduction.tex
    1.30 +  MicroJava/BV/LBVJVM.thy MicroJava/document/root.bib			\
    1.31 +  MicroJava/document/root.tex MicroJava/document/introduction.tex
    1.32  	@$(ISABELLE_TOOL) usedir -g true $(OUT)/HOL MicroJava
    1.33  
    1.34  
     2.1 --- a/src/HOL/MicroJava/BV/Altern.thy	Wed Dec 02 12:04:07 2009 +0100
     2.2 +++ b/src/HOL/MicroJava/BV/Altern.thy	Tue Nov 24 14:37:23 2009 +0100
     2.3 @@ -1,15 +1,12 @@
     2.4  (*  Title:      HOL/MicroJava/BV/Altern.thy
     2.5 -    ID:         $Id$
     2.6      Author:     Martin Strecker
     2.7  *)
     2.8  
     2.9 -
    2.10 -(* Alternative definition of well-typing of bytecode, 
    2.11 -   used in compiler type correctness proof *)
    2.12 +header {* Alternative definition of well-typing of bytecode,  used in compiler type correctness proof *}
    2.13  
    2.14 -
    2.15 -theory Altern imports BVSpec begin
    2.16 -
    2.17 +theory Altern
    2.18 +imports BVSpec
    2.19 +begin
    2.20  
    2.21  constdefs
    2.22    check_type :: "jvm_prog \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> JVMType.state \<Rightarrow> bool"
     3.1 --- a/src/HOL/MicroJava/BV/BVExample.thy	Wed Dec 02 12:04:07 2009 +0100
     3.2 +++ b/src/HOL/MicroJava/BV/BVExample.thy	Tue Nov 24 14:37:23 2009 +0100
     3.3 @@ -66,27 +66,28 @@
     3.4  
     3.5  text {* The subclass releation spelled out: *}
     3.6  lemma subcls1:
     3.7 -  "subcls1 E = (\<lambda>C D. (C, D) \<in> {(list_name,Object), (test_name,Object), (Xcpt NullPointer, Object),
     3.8 -                (Xcpt ClassCast, Object), (Xcpt OutOfMemory, Object)})"
     3.9 +  "subcls1 E = {(list_name,Object), (test_name,Object), (Xcpt NullPointer, Object),
    3.10 +                (Xcpt ClassCast, Object), (Xcpt OutOfMemory, Object)}"
    3.11  apply (simp add: subcls1_def2)
    3.12  apply (simp add: name_defs class_defs system_defs E_def class_def)
    3.13 -apply (auto simp: expand_fun_eq)
    3.14 +apply (simp add: Sigma_def)
    3.15 +apply auto
    3.16  done
    3.17  
    3.18  text {* The subclass relation is acyclic; hence its converse is well founded: *}
    3.19  lemma notin_rtrancl:
    3.20 -  "r\<^sup>*\<^sup>* a b \<Longrightarrow> a \<noteq> b \<Longrightarrow> (\<And>y. \<not> r a y) \<Longrightarrow> False"
    3.21 -  by (auto elim: converse_rtranclpE)
    3.22 +  "(a, b) \<in> r\<^sup>* \<Longrightarrow> a \<noteq> b \<Longrightarrow> (\<And>y. (a, y) \<notin> r) \<Longrightarrow> False"
    3.23 +  by (auto elim: converse_rtranclE)
    3.24  
    3.25 -lemma acyclic_subcls1_E: "acyclicP (subcls1 E)"
    3.26 -  apply (rule acyclicI [to_pred])
    3.27 +lemma acyclic_subcls1_E: "acyclic (subcls1 E)"
    3.28 +  apply (rule acyclicI)
    3.29    apply (simp add: subcls1)
    3.30 -  apply (auto dest!: tranclpD)
    3.31 +  apply (auto dest!: tranclD)
    3.32    apply (auto elim!: notin_rtrancl simp add: name_defs distinct_classes)
    3.33    done
    3.34  
    3.35 -lemma wf_subcls1_E: "wfP ((subcls1 E)\<inverse>\<inverse>)"
    3.36 -  apply (rule finite_acyclic_wf_converse [to_pred])
    3.37 +lemma wf_subcls1_E: "wf ((subcls1 E)\<inverse>)"
    3.38 +  apply (rule finite_acyclic_wf_converse)
    3.39    apply (simp add: subcls1 del: insert_iff)
    3.40    apply (rule acyclic_subcls1_E)
    3.41    done  
     4.1 --- a/src/HOL/MicroJava/BV/BVNoTypeError.thy	Wed Dec 02 12:04:07 2009 +0100
     4.2 +++ b/src/HOL/MicroJava/BV/BVNoTypeError.thy	Tue Nov 24 14:37:23 2009 +0100
     4.3 @@ -4,7 +4,9 @@
     4.4  
     4.5  header {* \isaheader{Welltyped Programs produce no Type Errors} *}
     4.6  
     4.7 -theory BVNoTypeError imports "../JVM/JVMDefensive" BVSpecTypeSafe begin
     4.8 +theory BVNoTypeError
     4.9 +imports "../JVM/JVMDefensive" BVSpecTypeSafe
    4.10 +begin
    4.11  
    4.12  text {*
    4.13    Some simple lemmas about the type testing functions of the
     5.1 --- a/src/HOL/MicroJava/BV/BVSpec.thy	Wed Dec 02 12:04:07 2009 +0100
     5.2 +++ b/src/HOL/MicroJava/BV/BVSpec.thy	Tue Nov 24 14:37:23 2009 +0100
     5.3 @@ -1,8 +1,6 @@
     5.4  (*  Title:      HOL/MicroJava/BV/BVSpec.thy
     5.5 -    ID:         $Id$
     5.6      Author:     Cornelia Pusch, Gerwin Klein
     5.7      Copyright   1999 Technische Universitaet Muenchen
     5.8 -
     5.9  *)
    5.10  
    5.11  header {* \isaheader{The Bytecode Verifier}\label{sec:BVSpec} *}
     7.1 --- a/src/HOL/MicroJava/BV/Correct.thy	Wed Dec 02 12:04:07 2009 +0100
     7.2 +++ b/src/HOL/MicroJava/BV/Correct.thy	Tue Nov 24 14:37:23 2009 +0100
     7.3 @@ -1,15 +1,13 @@
     7.4 -
     7.5  (*  Title:      HOL/MicroJava/BV/Correct.thy
     7.6 -    ID:         $Id$
     7.7      Author:     Cornelia Pusch, Gerwin Klein
     7.8      Copyright   1999 Technische Universitaet Muenchen
     7.9 -
    7.10 -The invariant for the type safety proof.
    7.11  *)
    7.12  
    7.13  header {* \isaheader{BV Type Safety Invariant} *}
    7.14  
    7.15 -theory Correct imports BVSpec "../JVM/JVMExec" begin
    7.16 +theory Correct
    7.17 +imports BVSpec "../JVM/JVMExec"
    7.18 +begin
    7.19  
    7.20  constdefs
    7.21    approx_val :: "[jvm_prog,aheap,val,ty err] \<Rightarrow> bool"
     8.1 --- a/src/HOL/MicroJava/BV/Effect.thy	Wed Dec 02 12:04:07 2009 +0100
     8.2 +++ b/src/HOL/MicroJava/BV/Effect.thy	Tue Nov 24 14:37:23 2009 +0100
     8.3 @@ -9,7 +9,6 @@
     8.4  imports JVMType "../JVM/JVMExceptions"
     8.5  begin
     8.6  
     8.7 -
     8.8  types
     8.9    succ_type = "(p_count \<times> state_type option) list"
    8.10  
     9.1 --- a/src/HOL/MicroJava/BV/EffectMono.thy	Wed Dec 02 12:04:07 2009 +0100
     9.2 +++ b/src/HOL/MicroJava/BV/EffectMono.thy	Tue Nov 24 14:37:23 2009 +0100
     9.3 @@ -1,13 +1,13 @@
     9.4  (*  Title:      HOL/MicroJava/BV/EffMono.thy
     9.5 -    ID:         $Id$
     9.6      Author:     Gerwin Klein
     9.7      Copyright   2000 Technische Universitaet Muenchen
     9.8  *)
     9.9  
    9.10  header {* \isaheader{Monotonicity of eff and app} *}
    9.11  
    9.12 -theory EffectMono imports Effect begin
    9.13 -
    9.14 +theory EffectMono
    9.15 +imports Effect
    9.16 +begin
    9.17  
    9.18  lemma PrimT_PrimT: "(G \<turnstile> xb \<preceq> PrimT p) = (xb = PrimT p)"
    9.19    by (auto elim: widen.cases)
    10.1 --- a/src/HOL/MicroJava/BV/Err.thy	Wed Dec 02 12:04:07 2009 +0100
    10.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    10.3 @@ -1,353 +0,0 @@
    10.4 -(*  Title:      HOL/MicroJava/BV/Err.thy
    10.5 -    ID:         $Id$
    10.6 -    Author:     Tobias Nipkow
    10.7 -    Copyright   2000 TUM
    10.8 -
    10.9 -The error type
   10.10 -*)
   10.11 -
   10.12 -header {* \isaheader{The Error Type} *}
   10.13 -
   10.14 -theory Err
   10.15 -imports Semilat
   10.16 -begin
   10.17 -
   10.18 -datatype 'a err = Err | OK 'a
   10.19 -
   10.20 -types 'a ebinop = "'a \<Rightarrow> 'a \<Rightarrow> 'a err"
   10.21 -      'a esl =    "'a set * 'a ord * 'a ebinop"
   10.22 -
   10.23 -consts
   10.24 -  ok_val :: "'a err \<Rightarrow> 'a"
   10.25 -primrec
   10.26 -  "ok_val (OK x) = x"
   10.27 -
   10.28 -constdefs
   10.29 - lift :: "('a \<Rightarrow> 'b err) \<Rightarrow> ('a err \<Rightarrow> 'b err)"
   10.30 -"lift f e == case e of Err \<Rightarrow> Err | OK x \<Rightarrow> f x"
   10.31 -
   10.32 - lift2 :: "('a \<Rightarrow> 'b \<Rightarrow> 'c err) \<Rightarrow> 'a err \<Rightarrow> 'b err \<Rightarrow> 'c err"
   10.33 -"lift2 f e1 e2 ==
   10.34 - case e1 of Err  \<Rightarrow> Err
   10.35 -          | OK x \<Rightarrow> (case e2 of Err \<Rightarrow> Err | OK y \<Rightarrow> f x y)"
   10.36 -
   10.37 - le :: "'a ord \<Rightarrow> 'a err ord"
   10.38 -"le r e1 e2 ==
   10.39 -        case e2 of Err \<Rightarrow> True |
   10.40 -                   OK y \<Rightarrow> (case e1 of Err \<Rightarrow> False | OK x \<Rightarrow> x <=_r y)"
   10.41 -
   10.42 - sup :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> ('a err \<Rightarrow> 'b err \<Rightarrow> 'c err)"
   10.43 -"sup f == lift2(%x y. OK(x +_f y))"
   10.44 -
   10.45 - err :: "'a set \<Rightarrow> 'a err set"
   10.46 -"err A == insert Err {x . ? y:A. x = OK y}"
   10.47 -
   10.48 - esl :: "'a sl \<Rightarrow> 'a esl"
   10.49 -"esl == %(A,r,f). (A,r, %x y. OK(f x y))"
   10.50 -
   10.51 - sl :: "'a esl \<Rightarrow> 'a err sl"
   10.52 -"sl == %(A,r,f). (err A, le r, lift2 f)"
   10.53 -
   10.54 -syntax
   10.55 - err_semilat :: "'a esl \<Rightarrow> bool"
   10.56 -translations
   10.57 -"err_semilat L" == "semilat(Err.sl L)"
   10.58 -
   10.59 -
   10.60 -consts
   10.61 -  strict  :: "('a \<Rightarrow> 'b err) \<Rightarrow> ('a err \<Rightarrow> 'b err)"
   10.62 -primrec
   10.63 -  "strict f Err    = Err"
   10.64 -  "strict f (OK x) = f x"
   10.65 -
   10.66 -lemma strict_Some [simp]: 
   10.67 -  "(strict f x = OK y) = (\<exists> z. x = OK z \<and> f z = OK y)"
   10.68 -  by (cases x, auto)
   10.69 -
   10.70 -lemma not_Err_eq:
   10.71 -  "(x \<noteq> Err) = (\<exists>a. x = OK a)" 
   10.72 -  by (cases x) auto
   10.73 -
   10.74 -lemma not_OK_eq:
   10.75 -  "(\<forall>y. x \<noteq> OK y) = (x = Err)"
   10.76 -  by (cases x) auto  
   10.77 -
   10.78 -lemma unfold_lesub_err:
   10.79 -  "e1 <=_(le r) e2 == le r e1 e2"
   10.80 -  by (simp add: lesub_def)
   10.81 -
   10.82 -lemma le_err_refl:
   10.83 -  "!x. x <=_r x \<Longrightarrow> e <=_(Err.le r) e"
   10.84 -apply (unfold lesub_def Err.le_def)
   10.85 -apply (simp split: err.split)
   10.86 -done 
   10.87 -
   10.88 -lemma le_err_trans [rule_format]:
   10.89 -  "order r \<Longrightarrow> e1 <=_(le r) e2 \<longrightarrow> e2 <=_(le r) e3 \<longrightarrow> e1 <=_(le r) e3"
   10.90 -apply (unfold unfold_lesub_err le_def)
   10.91 -apply (simp split: err.split)
   10.92 -apply (blast intro: order_trans)
   10.93 -done
   10.94 -
   10.95 -lemma le_err_antisym [rule_format]:
   10.96 -  "order r \<Longrightarrow> e1 <=_(le r) e2 \<longrightarrow> e2 <=_(le r) e1 \<longrightarrow> e1=e2"
   10.97 -apply (unfold unfold_lesub_err le_def)
   10.98 -apply (simp split: err.split)
   10.99 -apply (blast intro: order_antisym)
  10.100 -done 
  10.101 -
  10.102 -lemma OK_le_err_OK:
  10.103 -  "(OK x <=_(le r) OK y) = (x <=_r y)"
  10.104 -  by (simp add: unfold_lesub_err le_def)
  10.105 -
  10.106 -lemma order_le_err [iff]:
  10.107 -  "order(le r) = order r"
  10.108 -apply (rule iffI)
  10.109 - apply (subst Semilat.order_def)
  10.110 - apply (blast dest: order_antisym OK_le_err_OK [THEN iffD2]
  10.111 -              intro: order_trans OK_le_err_OK [THEN iffD1])
  10.112 -apply (subst Semilat.order_def)
  10.113 -apply (blast intro: le_err_refl le_err_trans le_err_antisym
  10.114 -             dest: order_refl)
  10.115 -done 
  10.116 -
  10.117 -lemma le_Err [iff]:  "e <=_(le r) Err"
  10.118 -  by (simp add: unfold_lesub_err le_def)
  10.119 -
  10.120 -lemma Err_le_conv [iff]:
  10.121 - "Err <=_(le r) e  = (e = Err)"
  10.122 -  by (simp add: unfold_lesub_err le_def  split: err.split)
  10.123 -
  10.124 -lemma le_OK_conv [iff]:
  10.125 -  "e <=_(le r) OK x  =  (? y. e = OK y & y <=_r x)"
  10.126 -  by (simp add: unfold_lesub_err le_def split: err.split)
  10.127 -
  10.128 -lemma OK_le_conv:
  10.129 - "OK x <=_(le r) e  =  (e = Err | (? y. e = OK y & x <=_r y))"
  10.130 -  by (simp add: unfold_lesub_err le_def split: err.split)
  10.131 -
  10.132 -lemma top_Err [iff]: "top (le r) Err";
  10.133 -  by (simp add: top_def)
  10.134 -
  10.135 -lemma OK_less_conv [rule_format, iff]:
  10.136 -  "OK x <_(le r) e = (e=Err | (? y. e = OK y & x <_r y))"
  10.137 -  by (simp add: lesssub_def lesub_def le_def split: err.split)
  10.138 -
  10.139 -lemma not_Err_less [rule_format, iff]:
  10.140 -  "~(Err <_(le r) x)"
  10.141 -  by (simp add: lesssub_def lesub_def le_def split: err.split)
  10.142 -
  10.143 -lemma semilat_errI [intro]:
  10.144 -  assumes semilat: "semilat (A, r, f)"
  10.145 -  shows "semilat(err A, Err.le r, lift2(%x y. OK(f x y)))"
  10.146 -  apply(insert semilat)
  10.147 -  apply (unfold semilat_Def closed_def plussub_def lesub_def 
  10.148 -    lift2_def Err.le_def err_def)
  10.149 -  apply (simp split: err.split)
  10.150 -  done
  10.151 -
  10.152 -lemma err_semilat_eslI_aux:
  10.153 -  assumes semilat: "semilat (A, r, f)"
  10.154 -  shows "err_semilat(esl(A,r,f))"
  10.155 -  apply (unfold sl_def esl_def)
  10.156 -  apply (simp add: semilat_errI[OF semilat])
  10.157 -  done
  10.158 -
  10.159 -lemma err_semilat_eslI [intro, simp]:
  10.160 - "\<And>L. semilat L \<Longrightarrow> err_semilat(esl L)"
  10.161 -by(simp add: err_semilat_eslI_aux split_tupled_all)
  10.162 -
  10.163 -lemma acc_err [simp, intro!]:  "acc r \<Longrightarrow> acc(le r)"
  10.164 -apply (unfold acc_def lesub_def le_def lesssub_def)
  10.165 -apply (simp add: wfP_eq_minimal split: err.split)
  10.166 -apply clarify
  10.167 -apply (case_tac "Err : Q")
  10.168 - apply blast
  10.169 -apply (erule_tac x = "{a . OK a : Q}" in allE)
  10.170 -apply (case_tac "x")
  10.171 - apply fast
  10.172 -apply blast
  10.173 -done 
  10.174 -
  10.175 -lemma Err_in_err [iff]: "Err : err A"
  10.176 -  by (simp add: err_def)
  10.177 -
  10.178 -lemma Ok_in_err [iff]: "(OK x : err A) = (x:A)"
  10.179 -  by (auto simp add: err_def)
  10.180 -
  10.181 -section {* lift *}
  10.182 -
  10.183 -lemma lift_in_errI:
  10.184 -  "\<lbrakk> e : err S; !x:S. e = OK x \<longrightarrow> f x : err S \<rbrakk> \<Longrightarrow> lift f e : err S"
  10.185 -apply (unfold lift_def)
  10.186 -apply (simp split: err.split)
  10.187 -apply blast
  10.188 -done 
  10.189 -
  10.190 -lemma Err_lift2 [simp]: 
  10.191 -  "Err +_(lift2 f) x = Err"
  10.192 -  by (simp add: lift2_def plussub_def)
  10.193 -
  10.194 -lemma lift2_Err [simp]: 
  10.195 -  "x +_(lift2 f) Err = Err"
  10.196 -  by (simp add: lift2_def plussub_def split: err.split)
  10.197 -
  10.198 -lemma OK_lift2_OK [simp]:
  10.199 -  "OK x +_(lift2 f) OK y = x +_f y"
  10.200 -  by (simp add: lift2_def plussub_def split: err.split)
  10.201 -
  10.202 -
  10.203 -section {* sup *}
  10.204 -
  10.205 -lemma Err_sup_Err [simp]:
  10.206 -  "Err +_(Err.sup f) x = Err"
  10.207 -  by (simp add: plussub_def Err.sup_def Err.lift2_def)
  10.208 -
  10.209 -lemma Err_sup_Err2 [simp]:
  10.210 -  "x +_(Err.sup f) Err = Err"
  10.211 -  by (simp add: plussub_def Err.sup_def Err.lift2_def split: err.split)
  10.212 -
  10.213 -lemma Err_sup_OK [simp]:
  10.214 -  "OK x +_(Err.sup f) OK y = OK(x +_f y)"
  10.215 -  by (simp add: plussub_def Err.sup_def Err.lift2_def)
  10.216 -
  10.217 -lemma Err_sup_eq_OK_conv [iff]:
  10.218 -  "(Err.sup f ex ey = OK z) = (? x y. ex = OK x & ey = OK y & f x y = z)"
  10.219 -apply (unfold Err.sup_def lift2_def plussub_def)
  10.220 -apply (rule iffI)
  10.221 - apply (simp split: err.split_asm)
  10.222 -apply clarify
  10.223 -apply simp
  10.224 -done
  10.225 -
  10.226 -lemma Err_sup_eq_Err [iff]:
  10.227 -  "(Err.sup f ex ey = Err) = (ex=Err | ey=Err)"
  10.228 -apply (unfold Err.sup_def lift2_def plussub_def)
  10.229 -apply (simp split: err.split)
  10.230 -done 
  10.231 -
  10.232 -section {* semilat (err A) (le r) f *}
  10.233 -
  10.234 -lemma semilat_le_err_Err_plus [simp]:
  10.235 -  "\<lbrakk> x: err A; semilat(err A, le r, f) \<rbrakk> \<Longrightarrow> Err +_f x = Err"
  10.236 -  by (blast intro: Semilat.le_iff_plus_unchanged [OF Semilat.intro, THEN iffD1]
  10.237 -                   Semilat.le_iff_plus_unchanged2 [OF Semilat.intro, THEN iffD1])
  10.238 -
  10.239 -lemma semilat_le_err_plus_Err [simp]:
  10.240 -  "\<lbrakk> x: err A; semilat(err A, le r, f) \<rbrakk> \<Longrightarrow> x +_f Err = Err"
  10.241 -  by (blast intro: Semilat.le_iff_plus_unchanged [OF Semilat.intro, THEN iffD1]
  10.242 -                   Semilat.le_iff_plus_unchanged2 [OF Semilat.intro, THEN iffD1])
  10.243 -
  10.244 -lemma semilat_le_err_OK1:
  10.245 -  "\<lbrakk> x:A; y:A; semilat(err A, le r, f); OK x +_f OK y = OK z \<rbrakk> 
  10.246 -  \<Longrightarrow> x <=_r z";
  10.247 -apply (rule OK_le_err_OK [THEN iffD1])
  10.248 -apply (erule subst)
  10.249 -apply (simp add: Semilat.ub1 [OF Semilat.intro])
  10.250 -done
  10.251 -
  10.252 -lemma semilat_le_err_OK2:
  10.253 -  "\<lbrakk> x:A; y:A; semilat(err A, le r, f); OK x +_f OK y = OK z \<rbrakk> 
  10.254 -  \<Longrightarrow> y <=_r z"
  10.255 -apply (rule OK_le_err_OK [THEN iffD1])
  10.256 -apply (erule subst)
  10.257 -apply (simp add: Semilat.ub2 [OF Semilat.intro])
  10.258 -done
  10.259 -
  10.260 -lemma eq_order_le:
  10.261 -  "\<lbrakk> x=y; order r \<rbrakk> \<Longrightarrow> x <=_r y"
  10.262 -apply (unfold Semilat.order_def)
  10.263 -apply blast
  10.264 -done
  10.265 -
  10.266 -lemma OK_plus_OK_eq_Err_conv [simp]:
  10.267 -  assumes "x:A" and "y:A" and "semilat(err A, le r, fe)"
  10.268 -  shows "((OK x) +_fe (OK y) = Err) = (~(? z:A. x <=_r z & y <=_r z))"
  10.269 -proof -
  10.270 -  have plus_le_conv3: "\<And>A x y z f r. 
  10.271 -    \<lbrakk> semilat (A,r,f); x +_f y <=_r z; x:A; y:A; z:A \<rbrakk> 
  10.272 -    \<Longrightarrow> x <=_r z \<and> y <=_r z"
  10.273 -    by (rule Semilat.plus_le_conv [OF Semilat.intro, THEN iffD1])
  10.274 -  from prems show ?thesis
  10.275 -  apply (rule_tac iffI)
  10.276 -   apply clarify
  10.277 -   apply (drule OK_le_err_OK [THEN iffD2])
  10.278 -   apply (drule OK_le_err_OK [THEN iffD2])
  10.279 -   apply (drule Semilat.lub [OF Semilat.intro, of _ _ _ "OK x" _ "OK y"])
  10.280 -        apply assumption
  10.281 -       apply assumption
  10.282 -      apply simp
  10.283 -     apply simp
  10.284 -    apply simp
  10.285 -   apply simp
  10.286 -  apply (case_tac "(OK x) +_fe (OK y)")
  10.287 -   apply assumption
  10.288 -  apply (rename_tac z)
  10.289 -  apply (subgoal_tac "OK z: err A")
  10.290 -  apply (drule eq_order_le)
  10.291 -    apply (erule Semilat.orderI [OF Semilat.intro])
  10.292 -   apply (blast dest: plus_le_conv3) 
  10.293 -  apply (erule subst)
  10.294 -  apply (blast intro: Semilat.closedI [OF Semilat.intro] closedD)
  10.295 -  done 
  10.296 -qed
  10.297 -
  10.298 -section {* semilat (err(Union AS)) *}
  10.299 -
  10.300 -(* FIXME? *)
  10.301 -lemma all_bex_swap_lemma [iff]:
  10.302 -  "(!x. (? y:A. x = f y) \<longrightarrow> P x) = (!y:A. P(f y))"
  10.303 -  by blast
  10.304 -
  10.305 -lemma closed_err_Union_lift2I: 
  10.306 -  "\<lbrakk> !A:AS. closed (err A) (lift2 f); AS ~= {}; 
  10.307 -      !A:AS.!B:AS. A~=B \<longrightarrow> (!a:A.!b:B. a +_f b = Err) \<rbrakk> 
  10.308 -  \<Longrightarrow> closed (err(Union AS)) (lift2 f)"
  10.309 -apply (unfold closed_def err_def)
  10.310 -apply simp
  10.311 -apply clarify
  10.312 -apply simp
  10.313 -apply fast
  10.314 -done 
  10.315 -
  10.316 -text {* 
  10.317 -  If @{term "AS = {}"} the thm collapses to
  10.318 -  @{prop "order r & closed {Err} f & Err +_f Err = Err"}
  10.319 -  which may not hold 
  10.320 -*}
  10.321 -lemma err_semilat_UnionI:
  10.322 -  "\<lbrakk> !A:AS. err_semilat(A, r, f); AS ~= {}; 
  10.323 -      !A:AS.!B:AS. A~=B \<longrightarrow> (!a:A.!b:B. ~ a <=_r b & a +_f b = Err) \<rbrakk> 
  10.324 -  \<Longrightarrow> err_semilat(Union AS, r, f)"
  10.325 -apply (unfold semilat_def sl_def)
  10.326 -apply (simp add: closed_err_Union_lift2I)
  10.327 -apply (rule conjI)
  10.328 - apply blast
  10.329 -apply (simp add: err_def)
  10.330 -apply (rule conjI)
  10.331 - apply clarify
  10.332 - apply (rename_tac A a u B b)
  10.333 - apply (case_tac "A = B")
  10.334 -  apply simp
  10.335 - apply simp
  10.336 -apply (rule conjI)
  10.337 - apply clarify
  10.338 - apply (rename_tac A a u B b)
  10.339 - apply (case_tac "A = B")
  10.340 -  apply simp
  10.341 - apply simp
  10.342 -apply clarify
  10.343 -apply (rename_tac A ya yb B yd z C c a b)
  10.344 -apply (case_tac "A = B")
  10.345 - apply (case_tac "A = C")
  10.346 -  apply simp
  10.347 - apply (rotate_tac -1)
  10.348 - apply simp
  10.349 -apply (rotate_tac -1)
  10.350 -apply (case_tac "B = C")
  10.351 - apply simp
  10.352 -apply (rotate_tac -1)
  10.353 -apply simp
  10.354 -done 
  10.355 -
  10.356 -end
    11.1 --- a/src/HOL/MicroJava/BV/JType.thy	Wed Dec 02 12:04:07 2009 +0100
    11.2 +++ b/src/HOL/MicroJava/BV/JType.thy	Tue Nov 24 14:37:23 2009 +0100
    11.3 @@ -1,12 +1,13 @@
    11.4  (*  Title:      HOL/MicroJava/BV/JType.thy
    11.5 -    ID:         $Id$
    11.6      Author:     Tobias Nipkow, Gerwin Klein
    11.7      Copyright   2000 TUM
    11.8  *)
    11.9  
   11.10  header {* \isaheader{The Java Type System as Semilattice} *}
   11.11  
   11.12 -theory JType imports "../J/WellForm" Err begin
   11.13 +theory JType
   11.14 +imports "../DFA/Semilattices" "../J/WellForm"
   11.15 +begin
   11.16  
   11.17  constdefs
   11.18    super :: "'a prog \<Rightarrow> cname \<Rightarrow> cname"
   11.19 @@ -34,7 +35,7 @@
   11.20  
   11.21    is_ty :: "'c prog \<Rightarrow> ty \<Rightarrow> bool"
   11.22    "is_ty G T == case T of PrimT P \<Rightarrow> True | RefT R \<Rightarrow>
   11.23 -               (case R of NullT \<Rightarrow> True | ClassT C \<Rightarrow> (subcls1 G)^** C Object)"
   11.24 +               (case R of NullT \<Rightarrow> True | ClassT C \<Rightarrow> (C, Object) \<in> (subcls1 G)^*)"
   11.25  
   11.26  
   11.27  translations
   11.28 @@ -78,7 +79,7 @@
   11.29      have "R \<noteq> ClassT Object \<Longrightarrow> ?thesis"
   11.30       by (auto simp add: is_ty_def is_class_def split_tupled_all
   11.31                 elim!: subcls1.cases
   11.32 -               elim: converse_rtranclpE
   11.33 +               elim: converse_rtranclE
   11.34                 split: ref_ty.splits)
   11.35      ultimately    
   11.36      show ?thesis by blast
   11.37 @@ -86,7 +87,7 @@
   11.38  qed
   11.39  
   11.40  lemma order_widen:
   11.41 -  "acyclicP (subcls1 G) \<Longrightarrow> order (subtype G)"
   11.42 +  "acyclic (subcls1 G) \<Longrightarrow> order (subtype G)"
   11.43    apply (unfold Semilat.order_def lesub_def subtype_def)
   11.44    apply (auto intro: widen_trans)
   11.45    apply (case_tac x)
   11.46 @@ -102,16 +103,16 @@
   11.47    apply (case_tac ref_tya)
   11.48     apply simp
   11.49    apply simp
   11.50 -  apply (auto dest: acyclic_impl_antisym_rtrancl [to_pred] antisymD)
   11.51 +  apply (auto dest: acyclic_impl_antisym_rtrancl antisymD)
   11.52    done
   11.53  
   11.54  lemma wf_converse_subcls1_impl_acc_subtype:
   11.55 -  "wfP ((subcls1 G)^--1) \<Longrightarrow> acc (subtype G)"
   11.56 +  "wf ((subcls1 G)^-1) \<Longrightarrow> acc (subtype G)"
   11.57  apply (unfold Semilat.acc_def lesssub_def)
   11.58 -apply (drule_tac p = "inf ((subcls1 G)^--1) op \<noteq>" in wfP_subset)
   11.59 +apply (drule_tac p = "((subcls1 G)^-1) - Id" in wf_subset)
   11.60   apply auto
   11.61 -apply (drule wfP_trancl)
   11.62 -apply (simp add: wfP_eq_minimal)
   11.63 +apply (drule wf_trancl)
   11.64 +apply (simp add: wf_eq_minimal)
   11.65  apply clarify
   11.66  apply (unfold lesub_def subtype_def)
   11.67  apply (rename_tac M T) 
   11.68 @@ -146,20 +147,20 @@
   11.69  apply (case_tac t)
   11.70   apply simp
   11.71  apply simp
   11.72 -apply (insert rtranclp_r_diff_Id [symmetric, standard, of "subcls1 G"])
   11.73 +apply (insert rtrancl_r_diff_Id [symmetric, standard, of "subcls1 G"])
   11.74  apply simp
   11.75 -apply (erule rtranclp.cases)
   11.76 +apply (erule rtrancl.cases)
   11.77   apply blast
   11.78 -apply (drule rtranclp_converseI)
   11.79 -apply (subgoal_tac "(inf (subcls1 G) op \<noteq>)^--1 = (inf ((subcls1 G)^--1) op \<noteq>)")
   11.80 +apply (drule rtrancl_converseI)
   11.81 +apply (subgoal_tac "(subcls1 G - Id)^-1 = (subcls1 G)^-1 - Id")
   11.82   prefer 2
   11.83 - apply (simp add: converse_meet)
   11.84 + apply (simp add: converse_Int) apply safe[1]
   11.85  apply simp
   11.86 -apply (blast intro: rtranclp_into_tranclp2)
   11.87 -done 
   11.88 +apply (blast intro: rtrancl_into_trancl2)
   11.89 +done
   11.90  
   11.91  lemma closed_err_types:
   11.92 -  "\<lbrakk> ws_prog G; single_valuedP (subcls1 G); acyclicP (subcls1 G) \<rbrakk> 
   11.93 +  "\<lbrakk> ws_prog G; single_valued (subcls1 G); acyclic (subcls1 G) \<rbrakk> 
   11.94    \<Longrightarrow> closed (err (types G)) (lift2 (sup G))"
   11.95    apply (unfold closed_def plussub_def lift2_def sup_def)
   11.96    apply (auto split: err.split)
   11.97 @@ -171,13 +172,13 @@
   11.98  
   11.99  
  11.100  lemma sup_subtype_greater:
  11.101 -  "\<lbrakk> ws_prog G; single_valuedP (subcls1 G); acyclicP (subcls1 G);
  11.102 +  "\<lbrakk> ws_prog G; single_valued (subcls1 G); acyclic (subcls1 G);
  11.103        is_type G t1; is_type G t2; sup G t1 t2 = OK s \<rbrakk> 
  11.104    \<Longrightarrow> subtype G t1 s \<and> subtype G t2 s"
  11.105  proof -
  11.106    assume ws_prog:       "ws_prog G"
  11.107 -  assume single_valued: "single_valuedP (subcls1 G)"
  11.108 -  assume acyclic:       "acyclicP (subcls1 G)"
  11.109 +  assume single_valued: "single_valued (subcls1 G)"
  11.110 +  assume acyclic:       "acyclic (subcls1 G)"
  11.111   
  11.112    { fix c1 c2
  11.113      assume is_class: "is_class G c1" "is_class G c2"
  11.114 @@ -188,7 +189,7 @@
  11.115        by (blast intro: subcls_C_Object)
  11.116      with ws_prog single_valued
  11.117      obtain u where
  11.118 -      "is_lub ((subcls1 G)^** ) c1 c2 u"
  11.119 +      "is_lub ((subcls1 G)^* ) c1 c2 u"
  11.120        by (blast dest: single_valued_has_lubs)
  11.121      moreover
  11.122      note acyclic
  11.123 @@ -210,14 +211,14 @@
  11.124  qed
  11.125  
  11.126  lemma sup_subtype_smallest:
  11.127 -  "\<lbrakk> ws_prog G; single_valuedP (subcls1 G); acyclicP (subcls1 G);
  11.128 +  "\<lbrakk> ws_prog G; single_valued (subcls1 G); acyclic (subcls1 G);
  11.129        is_type G a; is_type G b; is_type G c; 
  11.130        subtype G a c; subtype G b c; sup G a b = OK d \<rbrakk>
  11.131    \<Longrightarrow> subtype G d c"
  11.132  proof -
  11.133    assume ws_prog:       "ws_prog G"
  11.134 -  assume single_valued: "single_valuedP (subcls1 G)"
  11.135 -  assume acyclic:       "acyclicP (subcls1 G)"
  11.136 +  assume single_valued: "single_valued (subcls1 G)"
  11.137 +  assume acyclic:       "acyclic (subcls1 G)"
  11.138  
  11.139    { fix c1 c2 D
  11.140      assume is_class: "is_class G c1" "is_class G c2"
  11.141 @@ -229,7 +230,7 @@
  11.142        by (blast intro: subcls_C_Object)
  11.143      with ws_prog single_valued
  11.144      obtain u where
  11.145 -      lub: "is_lub ((subcls1 G)^** ) c1 c2 u"
  11.146 +      lub: "is_lub ((subcls1 G)^*) c1 c2 u"
  11.147        by (blast dest: single_valued_has_lubs)   
  11.148      with acyclic
  11.149      have "exec_lub (subcls1 G) (super G) c1 c2 = u"
  11.150 @@ -260,12 +261,12 @@
  11.151             split: ty.splits ref_ty.splits)
  11.152  
  11.153  lemma err_semilat_JType_esl_lemma:
  11.154 -  "\<lbrakk> ws_prog G; single_valuedP (subcls1 G); acyclicP (subcls1 G) \<rbrakk> 
  11.155 +  "\<lbrakk> ws_prog G; single_valued (subcls1 G); acyclic (subcls1 G) \<rbrakk> 
  11.156    \<Longrightarrow> err_semilat (esl G)"
  11.157  proof -
  11.158    assume ws_prog:   "ws_prog G"
  11.159 -  assume single_valued: "single_valuedP (subcls1 G)"
  11.160 -  assume acyclic:   "acyclicP (subcls1 G)"
  11.161 +  assume single_valued: "single_valued (subcls1 G)"
  11.162 +  assume acyclic:   "acyclic (subcls1 G)"
  11.163    
  11.164    hence "order (subtype G)"
  11.165      by (rule order_widen)
  11.166 @@ -275,10 +276,10 @@
  11.167      by (rule closed_err_types)
  11.168    moreover
  11.169  
  11.170 -  from ws_prog single_valued acyclic 
  11.171 +  from ws_prog single_valued acyclic
  11.172    have
  11.173 -    "(\<forall>x\<in>err (types G). \<forall>y\<in>err (types G). x <=_(le (subtype G)) x +_(lift2 (sup G)) y) \<and> 
  11.174 -     (\<forall>x\<in>err (types G). \<forall>y\<in>err (types G). y <=_(le (subtype G)) x +_(lift2 (sup G)) y)"
  11.175 +    "(\<forall>x\<in>err (types G). \<forall>y\<in>err (types G). x <=_(Err.le (subtype G)) x +_(lift2 (sup G)) y) \<and> 
  11.176 +     (\<forall>x\<in>err (types G). \<forall>y\<in>err (types G). y <=_(Err.le (subtype G)) x +_(lift2 (sup G)) y)"
  11.177      by (auto simp add: lesub_def plussub_def Err.le_def lift2_def sup_subtype_greater split: err.split)
  11.178  
  11.179    moreover
  11.180 @@ -286,18 +287,18 @@
  11.181    from ws_prog single_valued acyclic 
  11.182    have
  11.183      "\<forall>x\<in>err (types G). \<forall>y\<in>err (types G). \<forall>z\<in>err (types G). 
  11.184 -    x <=_(le (subtype G)) z \<and> y <=_(le (subtype G)) z \<longrightarrow> x +_(lift2 (sup G)) y <=_(le (subtype G)) z"
  11.185 +    x <=_(Err.le (subtype G)) z \<and> y <=_(Err.le (subtype G)) z \<longrightarrow> x +_(lift2 (sup G)) y <=_(Err.le (subtype G)) z"
  11.186      by (unfold lift2_def plussub_def lesub_def Err.le_def)
  11.187         (auto intro: sup_subtype_smallest sup_exists split: err.split)
  11.188  
  11.189    ultimately
  11.190    
  11.191    show ?thesis
  11.192 -    by (unfold esl_def semilat_def sl_def) auto
  11.193 +    by (unfold esl_def semilat_def Err.sl_def) auto
  11.194  qed
  11.195  
  11.196  lemma single_valued_subcls1:
  11.197 -  "ws_prog G \<Longrightarrow> single_valuedP (subcls1 G)"
  11.198 +  "ws_prog G \<Longrightarrow> single_valued (subcls1 G)"
  11.199    by (auto simp add: ws_prog_def unique_def single_valued_def
  11.200      intro: subcls1I elim!: subcls1.cases)
  11.201  
    12.1 --- a/src/HOL/MicroJava/BV/JVM.thy	Wed Dec 02 12:04:07 2009 +0100
    12.2 +++ b/src/HOL/MicroJava/BV/JVM.thy	Tue Nov 24 14:37:23 2009 +0100
    12.3 @@ -5,8 +5,9 @@
    12.4  
    12.5  header {* \isaheader{Kildall for the JVM}\label{sec:JVM} *}
    12.6  
    12.7 -theory JVM imports Kildall Typing_Framework_JVM begin
    12.8 -
    12.9 +theory JVM
   12.10 +imports Typing_Framework_JVM
   12.11 +begin
   12.12  
   12.13  constdefs
   12.14    kiljvm :: "jvm_prog \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> ty \<Rightarrow> exception_table \<Rightarrow> 
   12.15 @@ -39,7 +40,7 @@
   12.16           simp add: symmetric sl_triple_conv)
   12.17        apply (simp (no_asm) add: JVM_le_unfold)
   12.18        apply (blast intro!: order_widen wf_converse_subcls1_impl_acc_subtype
   12.19 -                   dest: wf_subcls1 wfP_acyclicP wf_prog_ws_prog)
   12.20 +                   dest: wf_subcls1 wf_acyclic wf_prog_ws_prog)
   12.21       apply (simp add: JVM_le_unfold)
   12.22      apply (erule exec_pres_type)
   12.23     apply assumption
    13.1 --- a/src/HOL/MicroJava/BV/JVMType.thy	Wed Dec 02 12:04:07 2009 +0100
    13.2 +++ b/src/HOL/MicroJava/BV/JVMType.thy	Tue Nov 24 14:37:23 2009 +0100
    13.3 @@ -1,13 +1,13 @@
    13.4  (*  Title:      HOL/MicroJava/BV/JVM.thy
    13.5 -    ID:         $Id$
    13.6      Author:     Gerwin Klein
    13.7      Copyright   2000 TUM
    13.8 -
    13.9  *)
   13.10  
   13.11  header {* \isaheader{The JVM Type System as Semilattice} *}
   13.12  
   13.13 -theory JVMType imports Opt Product Listn JType begin
   13.14 +theory JVMType
   13.15 +imports JType
   13.16 +begin
   13.17  
   13.18  types
   13.19    locvars_type = "ty err list"
    14.1 --- a/src/HOL/MicroJava/BV/Kildall.thy	Wed Dec 02 12:04:07 2009 +0100
    14.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    14.3 @@ -1,498 +0,0 @@
    14.4 -(*  Title:      HOL/MicroJava/BV/Kildall.thy
    14.5 -    ID:         $Id$
    14.6 -    Author:     Tobias Nipkow, Gerwin Klein
    14.7 -    Copyright   2000 TUM
    14.8 -
    14.9 -Kildall's algorithm
   14.10 -*)
   14.11 -
   14.12 -header {* \isaheader{Kildall's Algorithm}\label{sec:Kildall} *}
   14.13 -
   14.14 -theory Kildall
   14.15 -imports SemilatAlg While_Combinator
   14.16 -begin
   14.17 -
   14.18 -
   14.19 -consts
   14.20 - iter :: "'s binop \<Rightarrow> 's step_type \<Rightarrow>
   14.21 -          's list \<Rightarrow> nat set \<Rightarrow> 's list \<times> nat set"
   14.22 - propa :: "'s binop \<Rightarrow> (nat \<times> 's) list \<Rightarrow> 's list \<Rightarrow> nat set \<Rightarrow> 's list * nat set"
   14.23 -
   14.24 -primrec
   14.25 -"propa f []      ss w = (ss,w)"
   14.26 -"propa f (q'#qs) ss w = (let (q,t) = q';
   14.27 -                             u = t +_f ss!q;
   14.28 -                             w' = (if u = ss!q then w else insert q w)
   14.29 -                         in propa f qs (ss[q := u]) w')"
   14.30 -
   14.31 -defs iter_def:
   14.32 -"iter f step ss w ==
   14.33 - while (%(ss,w). w \<noteq> {})
   14.34 -       (%(ss,w). let p = SOME p. p \<in> w
   14.35 -                 in propa f (step p (ss!p)) ss (w-{p}))
   14.36 -       (ss,w)"
   14.37 -
   14.38 -constdefs
   14.39 - unstables :: "'s ord \<Rightarrow> 's step_type \<Rightarrow> 's list \<Rightarrow> nat set"
   14.40 -"unstables r step ss == {p. p < size ss \<and> \<not>stable r step ss p}"
   14.41 -
   14.42 - kildall :: "'s ord \<Rightarrow> 's binop \<Rightarrow> 's step_type \<Rightarrow> 's list \<Rightarrow> 's list"
   14.43 -"kildall r f step ss == fst(iter f step ss (unstables r step ss))"
   14.44 -
   14.45 -consts merges :: "'s binop \<Rightarrow> (nat \<times> 's) list \<Rightarrow> 's list \<Rightarrow> 's list"
   14.46 -primrec
   14.47 -"merges f []      ss = ss"
   14.48 -"merges f (p'#ps) ss = (let (p,s) = p' in merges f ps (ss[p := s +_f ss!p]))"
   14.49 -
   14.50 -
   14.51 -lemmas [simp] = Let_def Semilat.le_iff_plus_unchanged [OF Semilat.intro, symmetric]
   14.52 -
   14.53 -
   14.54 -lemma (in Semilat) nth_merges:
   14.55 - "\<And>ss. \<lbrakk>p < length ss; ss \<in> list n A; \<forall>(p,t)\<in>set ps. p<n \<and> t\<in>A \<rbrakk> \<Longrightarrow>
   14.56 -  (merges f ps ss)!p = map snd [(p',t') \<leftarrow> ps. p'=p] ++_f ss!p"
   14.57 -  (is "\<And>ss. \<lbrakk>_; _; ?steptype ps\<rbrakk> \<Longrightarrow> ?P ss ps")
   14.58 -proof (induct ps)
   14.59 -  show "\<And>ss. ?P ss []" by simp
   14.60 -
   14.61 -  fix ss p' ps'
   14.62 -  assume ss: "ss \<in> list n A"
   14.63 -  assume l:  "p < length ss"
   14.64 -  assume "?steptype (p'#ps')"
   14.65 -  then obtain a b where
   14.66 -    p': "p'=(a,b)" and ab: "a<n" "b\<in>A" and ps': "?steptype ps'"
   14.67 -    by (cases p') auto
   14.68 -  assume "\<And>ss. p< length ss \<Longrightarrow> ss \<in> list n A \<Longrightarrow> ?steptype ps' \<Longrightarrow> ?P ss ps'"
   14.69 -  from this [OF _ _ ps'] have IH: "\<And>ss. ss \<in> list n A \<Longrightarrow> p < length ss \<Longrightarrow> ?P ss ps'" .
   14.70 -
   14.71 -  from ss ab
   14.72 -  have "ss[a := b +_f ss!a] \<in> list n A" by (simp add: closedD)
   14.73 -  moreover
   14.74 -  from calculation l
   14.75 -  have "p < length (ss[a := b +_f ss!a])" by simp
   14.76 -  ultimately
   14.77 -  have "?P (ss[a := b +_f ss!a]) ps'" by (rule IH)
   14.78 -  with p' l
   14.79 -  show "?P ss (p'#ps')" by simp
   14.80 -qed
   14.81 -
   14.82 -
   14.83 -(** merges **)
   14.84 -
   14.85 -lemma length_merges [rule_format, simp]:
   14.86 -  "\<forall>ss. size(merges f ps ss) = size ss"
   14.87 -  by (induct_tac ps, auto)
   14.88 -
   14.89 -
   14.90 -lemma (in Semilat) merges_preserves_type_lemma:
   14.91 -shows "\<forall>xs. xs \<in> list n A \<longrightarrow> (\<forall>(p,x) \<in> set ps. p<n \<and> x\<in>A)
   14.92 -          \<longrightarrow> merges f ps xs \<in> list n A"
   14.93 -apply (insert closedI)
   14.94 -apply (unfold closed_def)
   14.95 -apply (induct_tac ps)
   14.96 - apply simp
   14.97 -apply clarsimp
   14.98 -done
   14.99 -
  14.100 -lemma (in Semilat) merges_preserves_type [simp]:
  14.101 - "\<lbrakk> xs \<in> list n A; \<forall>(p,x) \<in> set ps. p<n \<and> x\<in>A \<rbrakk>
  14.102 -  \<Longrightarrow> merges f ps xs \<in> list n A"
  14.103 -by (simp add: merges_preserves_type_lemma)
  14.104 -
  14.105 -lemma (in Semilat) merges_incr_lemma:
  14.106 - "\<forall>xs. xs \<in> list n A \<longrightarrow> (\<forall>(p,x)\<in>set ps. p<size xs \<and> x \<in> A) \<longrightarrow> xs <=[r] merges f ps xs"
  14.107 -apply (induct_tac ps)
  14.108 - apply simp
  14.109 -apply simp
  14.110 -apply clarify
  14.111 -apply (rule order_trans)
  14.112 -  apply simp
  14.113 - apply (erule list_update_incr)
  14.114 -  apply simp
  14.115 - apply simp
  14.116 -apply (blast intro!: listE_set intro: closedD listE_length [THEN nth_in])
  14.117 -done
  14.118 -
  14.119 -lemma (in Semilat) merges_incr:
  14.120 - "\<lbrakk> xs \<in> list n A; \<forall>(p,x)\<in>set ps. p<size xs \<and> x \<in> A \<rbrakk> 
  14.121 -  \<Longrightarrow> xs <=[r] merges f ps xs"
  14.122 -  by (simp add: merges_incr_lemma)
  14.123 -
  14.124 -
  14.125 -lemma (in Semilat) merges_same_conv [rule_format]:
  14.126 - "(\<forall>xs. xs \<in> list n A \<longrightarrow> (\<forall>(p,x)\<in>set ps. p<size xs \<and> x\<in>A) \<longrightarrow> 
  14.127 -     (merges f ps xs = xs) = (\<forall>(p,x)\<in>set ps. x <=_r xs!p))"
  14.128 -  apply (induct_tac ps)
  14.129 -   apply simp
  14.130 -  apply clarsimp
  14.131 -  apply (rename_tac p x ps xs)
  14.132 -  apply (rule iffI)
  14.133 -   apply (rule context_conjI)
  14.134 -    apply (subgoal_tac "xs[p := x +_f xs!p] <=[r] xs")
  14.135 -     apply (drule_tac p = p in le_listD)
  14.136 -      apply simp
  14.137 -     apply simp
  14.138 -    apply (erule subst, rule merges_incr)
  14.139 -       apply (blast intro!: listE_set intro: closedD listE_length [THEN nth_in])
  14.140 -      apply clarify
  14.141 -      apply (rule conjI)
  14.142 -       apply simp
  14.143 -       apply (blast dest: boundedD)
  14.144 -      apply blast
  14.145 -   apply clarify
  14.146 -   apply (erule allE)
  14.147 -   apply (erule impE)
  14.148 -    apply assumption
  14.149 -   apply (drule bspec)
  14.150 -    apply assumption
  14.151 -   apply (simp add: le_iff_plus_unchanged [THEN iffD1] list_update_same_conv [THEN iffD2])
  14.152 -   apply blast
  14.153 -  apply clarify 
  14.154 -  apply (simp add: le_iff_plus_unchanged [THEN iffD1] list_update_same_conv [THEN iffD2])
  14.155 -  done
  14.156 -
  14.157 -
  14.158 -lemma (in Semilat) list_update_le_listI [rule_format]:
  14.159 -  "set xs <= A \<longrightarrow> set ys <= A \<longrightarrow> xs <=[r] ys \<longrightarrow> p < size xs \<longrightarrow>  
  14.160 -   x <=_r ys!p \<longrightarrow> x\<in>A \<longrightarrow> xs[p := x +_f xs!p] <=[r] ys"
  14.161 -  apply(insert semilat)
  14.162 -  apply (unfold Listn.le_def lesub_def semilat_def)
  14.163 -  apply (simp add: list_all2_conv_all_nth nth_list_update)
  14.164 -  done
  14.165 -
  14.166 -lemma (in Semilat) merges_pres_le_ub:
  14.167 -  assumes "set ts <= A" and "set ss <= A"
  14.168 -    and "\<forall>(p,t)\<in>set ps. t <=_r ts!p \<and> t \<in> A \<and> p < size ts" and "ss <=[r] ts"
  14.169 -  shows "merges f ps ss <=[r] ts"
  14.170 -proof -
  14.171 -  { fix t ts ps
  14.172 -    have
  14.173 -    "\<And>qs. \<lbrakk>set ts <= A; \<forall>(p,t)\<in>set ps. t <=_r ts!p \<and> t \<in> A \<and> p< size ts \<rbrakk> \<Longrightarrow>
  14.174 -    set qs <= set ps  \<longrightarrow> 
  14.175 -    (\<forall>ss. set ss <= A \<longrightarrow> ss <=[r] ts \<longrightarrow> merges f qs ss <=[r] ts)"
  14.176 -    apply (induct_tac qs)
  14.177 -     apply simp
  14.178 -    apply (simp (no_asm_simp))
  14.179 -    apply clarify
  14.180 -    apply (rotate_tac -2)
  14.181 -    apply simp
  14.182 -    apply (erule allE, erule impE, erule_tac [2] mp)
  14.183 -     apply (drule bspec, assumption)
  14.184 -     apply (simp add: closedD)
  14.185 -    apply (drule bspec, assumption)
  14.186 -    apply (simp add: list_update_le_listI)
  14.187 -    done 
  14.188 -  } note this [dest]
  14.189 -  
  14.190 -  from prems show ?thesis by blast
  14.191 -qed
  14.192 -
  14.193 -
  14.194 -(** propa **)
  14.195 -
  14.196 -
  14.197 -lemma decomp_propa:
  14.198 -  "\<And>ss w. (\<forall>(q,t)\<in>set qs. q < size ss) \<Longrightarrow> 
  14.199 -   propa f qs ss w = 
  14.200 -   (merges f qs ss, {q. \<exists>t. (q,t)\<in>set qs \<and> t +_f ss!q \<noteq> ss!q} Un w)"
  14.201 -  apply (induct qs)
  14.202 -   apply simp   
  14.203 -  apply (simp (no_asm))
  14.204 -  apply clarify  
  14.205 -  apply simp
  14.206 -  apply (rule conjI) 
  14.207 -   apply blast
  14.208 -  apply (simp add: nth_list_update)
  14.209 -  apply blast
  14.210 -  done 
  14.211 -
  14.212 -(** iter **)
  14.213 -
  14.214 -lemma (in Semilat) stable_pres_lemma:
  14.215 -shows "\<lbrakk>pres_type step n A; bounded step n; 
  14.216 -     ss \<in> list n A; p \<in> w; \<forall>q\<in>w. q < n; 
  14.217 -     \<forall>q. q < n \<longrightarrow> q \<notin> w \<longrightarrow> stable r step ss q; q < n; 
  14.218 -     \<forall>s'. (q,s') \<in> set (step p (ss ! p)) \<longrightarrow> s' +_f ss ! q = ss ! q; 
  14.219 -     q \<notin> w \<or> q = p \<rbrakk> 
  14.220 -  \<Longrightarrow> stable r step (merges f (step p (ss!p)) ss) q"
  14.221 -  apply (unfold stable_def)
  14.222 -  apply (subgoal_tac "\<forall>s'. (q,s') \<in> set (step p (ss!p)) \<longrightarrow> s' : A")
  14.223 -   prefer 2
  14.224 -   apply clarify
  14.225 -   apply (erule pres_typeD)
  14.226 -    prefer 3 apply assumption
  14.227 -    apply (rule listE_nth_in)
  14.228 -     apply assumption
  14.229 -    apply simp
  14.230 -   apply simp
  14.231 -  apply simp
  14.232 -  apply clarify
  14.233 -  apply (subst nth_merges)
  14.234 -       apply simp
  14.235 -       apply (blast dest: boundedD)
  14.236 -      apply assumption
  14.237 -     apply clarify
  14.238 -     apply (rule conjI)
  14.239 -      apply (blast dest: boundedD)
  14.240 -     apply (erule pres_typeD)
  14.241 -       prefer 3 apply assumption
  14.242 -      apply simp
  14.243 -     apply simp
  14.244 -apply(subgoal_tac "q < length ss")
  14.245 -prefer 2 apply simp
  14.246 -  apply (frule nth_merges [of q _ _ "step p (ss!p)"]) (* fixme: why does method subst not work?? *)
  14.247 -apply assumption
  14.248 -  apply clarify
  14.249 -  apply (rule conjI)
  14.250 -   apply (blast dest: boundedD)
  14.251 -  apply (erule pres_typeD)
  14.252 -     prefer 3 apply assumption
  14.253 -    apply simp
  14.254 -   apply simp
  14.255 -  apply (drule_tac P = "\<lambda>x. (a, b) \<in> set (step q x)" in subst)
  14.256 -   apply assumption
  14.257 -
  14.258 - apply (simp add: plusplus_empty)
  14.259 - apply (cases "q \<in> w")
  14.260 -  apply simp
  14.261 -  apply (rule ub1')
  14.262 -     apply (rule semilat)
  14.263 -    apply clarify
  14.264 -    apply (rule pres_typeD)
  14.265 -       apply assumption
  14.266 -      prefer 3 apply assumption
  14.267 -     apply (blast intro: listE_nth_in dest: boundedD)
  14.268 -    apply (blast intro: pres_typeD dest: boundedD)
  14.269 -   apply (blast intro: listE_nth_in dest: boundedD)
  14.270 -  apply assumption
  14.271 -
  14.272 - apply simp
  14.273 - apply (erule allE, erule impE, assumption, erule impE, assumption)
  14.274 - apply (rule order_trans)
  14.275 -   apply simp
  14.276 -  defer
  14.277 - apply (rule pp_ub2)(*
  14.278 -    apply assumption*)
  14.279 -   apply simp
  14.280 -   apply clarify
  14.281 -   apply simp
  14.282 -   apply (rule pres_typeD)
  14.283 -      apply assumption
  14.284 -     prefer 3 apply assumption
  14.285 -    apply (blast intro: listE_nth_in dest: boundedD)
  14.286 -   apply (blast intro: pres_typeD dest: boundedD)
  14.287 -  apply (blast intro: listE_nth_in dest: boundedD)
  14.288 - apply blast
  14.289 - done
  14.290 -
  14.291 -
  14.292 -lemma (in Semilat) merges_bounded_lemma:
  14.293 - "\<lbrakk> mono r step n A; bounded step n; 
  14.294 -    \<forall>(p',s') \<in> set (step p (ss!p)). s' \<in> A; ss \<in> list n A; ts \<in> list n A; p < n; 
  14.295 -    ss <=[r] ts; \<forall>p. p < n \<longrightarrow> stable r step ts p \<rbrakk> 
  14.296 -  \<Longrightarrow> merges f (step p (ss!p)) ss <=[r] ts" 
  14.297 -  apply (unfold stable_def)
  14.298 -  apply (rule merges_pres_le_ub)
  14.299 -     apply simp
  14.300 -    apply simp
  14.301 -   prefer 2 apply assumption
  14.302 -
  14.303 -  apply clarsimp
  14.304 -  apply (drule boundedD, assumption+)
  14.305 -  apply (erule allE, erule impE, assumption)
  14.306 -  apply (drule bspec, assumption)
  14.307 -  apply simp
  14.308 -
  14.309 -  apply (drule monoD [of _ _ _ _ p "ss!p"  "ts!p"])
  14.310 -     apply assumption
  14.311 -    apply simp
  14.312 -   apply (simp add: le_listD)
  14.313 -  
  14.314 -  apply (drule lesub_step_typeD, assumption) 
  14.315 -  apply clarify
  14.316 -  apply (drule bspec, assumption)
  14.317 -  apply simp
  14.318 -  apply (blast intro: order_trans)
  14.319 -  done
  14.320 -
  14.321 -lemma termination_lemma:
  14.322 -  assumes semilat: "semilat (A, r, f)"
  14.323 -  shows "\<lbrakk> ss \<in> list n A; \<forall>(q,t)\<in>set qs. q<n \<and> t\<in>A; p\<in>w \<rbrakk> \<Longrightarrow> 
  14.324 -  ss <[r] merges f qs ss \<or> 
  14.325 -  merges f qs ss = ss \<and> {q. \<exists>t. (q,t)\<in>set qs \<and> t +_f ss!q \<noteq> ss!q} Un (w-{p}) < w" (is "PROP ?P")
  14.326 -proof -
  14.327 -  interpret Semilat A r f using assms by (rule Semilat.intro)
  14.328 -  show "PROP ?P" apply(insert semilat)
  14.329 -    apply (unfold lesssub_def)
  14.330 -    apply (simp (no_asm_simp) add: merges_incr)
  14.331 -    apply (rule impI)
  14.332 -    apply (rule merges_same_conv [THEN iffD1, elim_format]) 
  14.333 -    apply assumption+
  14.334 -    defer
  14.335 -    apply (rule sym, assumption)
  14.336 -    defer apply simp
  14.337 -    apply (subgoal_tac "\<forall>q t. \<not>((q, t) \<in> set qs \<and> t +_f ss ! q \<noteq> ss ! q)")
  14.338 -    apply (blast intro!: psubsetI elim: equalityE)
  14.339 -    apply clarsimp
  14.340 -    apply (drule bspec, assumption) 
  14.341 -    apply (drule bspec, assumption)
  14.342 -    apply clarsimp
  14.343 -    done
  14.344 -qed
  14.345 -
  14.346 -lemma iter_properties[rule_format]:
  14.347 -  assumes semilat: "semilat (A, r, f)"
  14.348 -  shows "\<lbrakk> acc r ; pres_type step n A; mono r step n A;
  14.349 -     bounded step n; \<forall>p\<in>w0. p < n; ss0 \<in> list n A;
  14.350 -     \<forall>p<n. p \<notin> w0 \<longrightarrow> stable r step ss0 p \<rbrakk> \<Longrightarrow>
  14.351 -   iter f step ss0 w0 = (ss',w')
  14.352 -   \<longrightarrow>
  14.353 -   ss' \<in> list n A \<and> stables r step ss' \<and> ss0 <=[r] ss' \<and>
  14.354 -   (\<forall>ts\<in>list n A. ss0 <=[r] ts \<and> stables r step ts \<longrightarrow> ss' <=[r] ts)"
  14.355 -  (is "PROP ?P")
  14.356 -proof -
  14.357 -  interpret Semilat A r f using assms by (rule Semilat.intro)
  14.358 -  show "PROP ?P" apply(insert semilat)
  14.359 -apply (unfold iter_def stables_def)
  14.360 -apply (rule_tac P = "%(ss,w).
  14.361 - ss \<in> list n A \<and> (\<forall>p<n. p \<notin> w \<longrightarrow> stable r step ss p) \<and> ss0 <=[r] ss \<and>
  14.362 - (\<forall>ts\<in>list n A. ss0 <=[r] ts \<and> stables r step ts \<longrightarrow> ss <=[r] ts) \<and>
  14.363 - (\<forall>p\<in>w. p < n)" and
  14.364 - r = "{(ss',ss) . ss <[r] ss'} <*lex*> finite_psubset"
  14.365 -       in while_rule)
  14.366 -
  14.367 --- "Invariant holds initially:"
  14.368 -apply (simp add:stables_def)
  14.369 -
  14.370 --- "Invariant is preserved:"
  14.371 -apply(simp add: stables_def split_paired_all)
  14.372 -apply(rename_tac ss w)
  14.373 -apply(subgoal_tac "(SOME p. p \<in> w) \<in> w")
  14.374 - prefer 2; apply (fast intro: someI)
  14.375 -apply(subgoal_tac "\<forall>(q,t) \<in> set (step (SOME p. p \<in> w) (ss ! (SOME p. p \<in> w))). q < length ss \<and> t \<in> A")
  14.376 - prefer 2
  14.377 - apply clarify
  14.378 - apply (rule conjI)
  14.379 -  apply(clarsimp, blast dest!: boundedD)
  14.380 - apply (erule pres_typeD)
  14.381 -  prefer 3
  14.382 -  apply assumption
  14.383 -  apply (erule listE_nth_in)
  14.384 -  apply simp
  14.385 - apply simp
  14.386 -apply (subst decomp_propa)
  14.387 - apply fast
  14.388 -apply simp
  14.389 -apply (rule conjI)
  14.390 - apply (rule merges_preserves_type)
  14.391 - apply blast
  14.392 - apply clarify
  14.393 - apply (rule conjI)
  14.394 -  apply(clarsimp, fast dest!: boundedD)
  14.395 - apply (erule pres_typeD)
  14.396 -  prefer 3
  14.397 -  apply assumption
  14.398 -  apply (erule listE_nth_in)
  14.399 -  apply blast
  14.400 - apply blast
  14.401 -apply (rule conjI)
  14.402 - apply clarify
  14.403 - apply (blast intro!: stable_pres_lemma)
  14.404 -apply (rule conjI)
  14.405 - apply (blast intro!: merges_incr intro: le_list_trans)
  14.406 -apply (rule conjI)
  14.407 - apply clarsimp
  14.408 - apply (blast intro!: merges_bounded_lemma)
  14.409 -apply (blast dest!: boundedD)
  14.410 -
  14.411 -
  14.412 --- "Postcondition holds upon termination:"
  14.413 -apply(clarsimp simp add: stables_def split_paired_all)
  14.414 -
  14.415 --- "Well-foundedness of the termination relation:"
  14.416 -apply (rule wf_lex_prod)
  14.417 - apply (insert orderI [THEN acc_le_listI])
  14.418 - apply (simp add: acc_def lesssub_def wfP_wf_eq [symmetric])
  14.419 -apply (rule wf_finite_psubset) 
  14.420 -
  14.421 --- "Loop decreases along termination relation:"
  14.422 -apply(simp add: stables_def split_paired_all)
  14.423 -apply(rename_tac ss w)
  14.424 -apply(subgoal_tac "(SOME p. p \<in> w) \<in> w")
  14.425 - prefer 2; apply (fast intro: someI)
  14.426 -apply(subgoal_tac "\<forall>(q,t) \<in> set (step (SOME p. p \<in> w) (ss ! (SOME p. p \<in> w))). q < length ss \<and> t \<in> A")
  14.427 - prefer 2
  14.428 - apply clarify
  14.429 - apply (rule conjI)
  14.430 -  apply(clarsimp, blast dest!: boundedD)
  14.431 - apply (erule pres_typeD)
  14.432 -  prefer 3
  14.433 -  apply assumption
  14.434 -  apply (erule listE_nth_in)
  14.435 -  apply blast
  14.436 - apply blast
  14.437 -apply (subst decomp_propa)
  14.438 - apply blast
  14.439 -apply clarify
  14.440 -apply (simp del: listE_length
  14.441 -    add: lex_prod_def finite_psubset_def 
  14.442 -         bounded_nat_set_is_finite)
  14.443 -apply (rule termination_lemma)
  14.444 -apply assumption+
  14.445 -defer
  14.446 -apply assumption
  14.447 -apply clarsimp
  14.448 -done
  14.449 -
  14.450 -qed
  14.451 -
  14.452 -lemma kildall_properties:
  14.453 -assumes semilat: "semilat (A, r, f)"
  14.454 -shows "\<lbrakk> acc r; pres_type step n A; mono r step n A;
  14.455 -     bounded step n; ss0 \<in> list n A \<rbrakk> \<Longrightarrow>
  14.456 -  kildall r f step ss0 \<in> list n A \<and>
  14.457 -  stables r step (kildall r f step ss0) \<and>
  14.458 -  ss0 <=[r] kildall r f step ss0 \<and>
  14.459 -  (\<forall>ts\<in>list n A. ss0 <=[r] ts \<and> stables r step ts \<longrightarrow>
  14.460 -                 kildall r f step ss0 <=[r] ts)"
  14.461 -  (is "PROP ?P")
  14.462 -proof -
  14.463 -  interpret Semilat A r f using assms by (rule Semilat.intro)
  14.464 -  show "PROP ?P"
  14.465 -apply (unfold kildall_def)
  14.466 -apply(case_tac "iter f step ss0 (unstables r step ss0)")
  14.467 -apply(simp)
  14.468 -apply (rule iter_properties)
  14.469 -apply (simp_all add: unstables_def stable_def)
  14.470 -apply (rule semilat)
  14.471 -done
  14.472 -qed
  14.473 -
  14.474 -lemma is_bcv_kildall:
  14.475 -assumes semilat: "semilat (A, r, f)"
  14.476 -shows "\<lbrakk> acc r; top r T; pres_type step n A; bounded step n; mono r step n A \<rbrakk>
  14.477 -  \<Longrightarrow> is_bcv r T step n A (kildall r f step)"
  14.478 -  (is "PROP ?P")
  14.479 -proof -
  14.480 -  interpret Semilat A r f using assms by (rule Semilat.intro)
  14.481 -  show "PROP ?P"
  14.482 -apply(unfold is_bcv_def wt_step_def)
  14.483 -apply(insert semilat kildall_properties[of A])
  14.484 -apply(simp add:stables_def)
  14.485 -apply clarify
  14.486 -apply(subgoal_tac "kildall r f step ss \<in> list n A")
  14.487 - prefer 2 apply (simp(no_asm_simp))
  14.488 -apply (rule iffI)
  14.489 - apply (rule_tac x = "kildall r f step ss" in bexI) 
  14.490 -  apply (rule conjI)
  14.491 -   apply (blast)
  14.492 -  apply (simp  (no_asm_simp))
  14.493 - apply(assumption)
  14.494 -apply clarify
  14.495 -apply(subgoal_tac "kildall r f step ss!p <=_r ts!p")
  14.496 - apply simp
  14.497 -apply (blast intro!: le_listD less_lengthI)
  14.498 -done
  14.499 -qed
  14.500 -
  14.501 -end
    15.1 --- a/src/HOL/MicroJava/BV/LBVComplete.thy	Wed Dec 02 12:04:07 2009 +0100
    15.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    15.3 @@ -1,379 +0,0 @@
    15.4 -(*  Title:      HOL/MicroJava/BV/LBVComplete.thy
    15.5 -    ID:         $Id$
    15.6 -    Author:     Gerwin Klein
    15.7 -    Copyright   2000 Technische Universitaet Muenchen
    15.8 -*)
    15.9 -
   15.10 -header {* \isaheader{Completeness of the LBV} *}
   15.11 -
   15.12 -theory LBVComplete
   15.13 -imports LBVSpec Typing_Framework
   15.14 -begin
   15.15 -
   15.16 -constdefs
   15.17 -  is_target :: "['s step_type, 's list, nat] \<Rightarrow> bool" 
   15.18 -  "is_target step phi pc' \<equiv>
   15.19 -     \<exists>pc s'. pc' \<noteq> pc+1 \<and> pc < length phi \<and> (pc',s') \<in> set (step pc (phi!pc))"
   15.20 -
   15.21 -  make_cert :: "['s step_type, 's list, 's] \<Rightarrow> 's certificate"
   15.22 -  "make_cert step phi B \<equiv> 
   15.23 -     map (\<lambda>pc. if is_target step phi pc then phi!pc else B) [0..<length phi] @ [B]"
   15.24 -
   15.25 -lemma [code]:
   15.26 -  "is_target step phi pc' =
   15.27 -  list_ex (\<lambda>pc. pc' \<noteq> pc+1 \<and> pc' mem (map fst (step pc (phi!pc)))) [0..<length phi]"
   15.28 -by (force simp: list_ex_iff is_target_def mem_iff)
   15.29 -
   15.30 -
   15.31 -locale lbvc = lbv + 
   15.32 -  fixes phi :: "'a list" ("\<phi>")
   15.33 -  fixes c   :: "'a list" 
   15.34 -  defines cert_def: "c \<equiv> make_cert step \<phi> \<bottom>"
   15.35 -
   15.36 -  assumes mono: "mono r step (length \<phi>) A"
   15.37 -  assumes pres: "pres_type step (length \<phi>) A" 
   15.38 -  assumes phi:  "\<forall>pc < length \<phi>. \<phi>!pc \<in> A \<and> \<phi>!pc \<noteq> \<top>"
   15.39 -  assumes bounded: "bounded step (length \<phi>)"
   15.40 -
   15.41 -  assumes B_neq_T: "\<bottom> \<noteq> \<top>" 
   15.42 -
   15.43 -
   15.44 -lemma (in lbvc) cert: "cert_ok c (length \<phi>) \<top> \<bottom> A"
   15.45 -proof (unfold cert_ok_def, intro strip conjI)  
   15.46 -  note [simp] = make_cert_def cert_def nth_append 
   15.47 -
   15.48 -  show "c!length \<phi> = \<bottom>" by simp
   15.49 -
   15.50 -  fix pc assume pc: "pc < length \<phi>" 
   15.51 -  from pc phi B_A show "c!pc \<in> A" by simp
   15.52 -  from pc phi B_neq_T show "c!pc \<noteq> \<top>" by simp
   15.53 -qed
   15.54 -
   15.55 -lemmas [simp del] = split_paired_Ex
   15.56 -
   15.57 -
   15.58 -lemma (in lbvc) cert_target [intro?]:
   15.59 -  "\<lbrakk> (pc',s') \<in> set (step pc (\<phi>!pc));
   15.60 -      pc' \<noteq> pc+1; pc < length \<phi>; pc' < length \<phi> \<rbrakk>
   15.61 -  \<Longrightarrow> c!pc' = \<phi>!pc'"
   15.62 -  by (auto simp add: cert_def make_cert_def nth_append is_target_def)
   15.63 -
   15.64 -
   15.65 -lemma (in lbvc) cert_approx [intro?]:
   15.66 -  "\<lbrakk> pc < length \<phi>; c!pc \<noteq> \<bottom> \<rbrakk>
   15.67 -  \<Longrightarrow> c!pc = \<phi>!pc"
   15.68 -  by (auto simp add: cert_def make_cert_def nth_append)
   15.69 -
   15.70 -
   15.71 -lemma (in lbv) le_top [simp, intro]:
   15.72 -  "x <=_r \<top>"
   15.73 -  by (insert top) simp
   15.74 -  
   15.75 -
   15.76 -lemma (in lbv) merge_mono:
   15.77 -  assumes less:  "ss2 <=|r| ss1"
   15.78 -  assumes x:     "x \<in> A"
   15.79 -  assumes ss1:   "snd`set ss1 \<subseteq> A"
   15.80 -  assumes ss2:   "snd`set ss2 \<subseteq> A"
   15.81 -  shows "merge c pc ss2 x <=_r merge c pc ss1 x" (is "?s2 <=_r ?s1")
   15.82 -proof-
   15.83 -  have "?s1 = \<top> \<Longrightarrow> ?thesis" by simp
   15.84 -  moreover {
   15.85 -    assume merge: "?s1 \<noteq> T" 
   15.86 -    from x ss1 have "?s1 =
   15.87 -      (if \<forall>(pc', s')\<in>set ss1. pc' \<noteq> pc + 1 \<longrightarrow> s' <=_r c!pc'
   15.88 -      then (map snd [(p', t') \<leftarrow> ss1 . p'=pc+1]) ++_f x
   15.89 -      else \<top>)" 
   15.90 -      by (rule merge_def)  
   15.91 -    with merge obtain
   15.92 -      app: "\<forall>(pc',s')\<in>set ss1. pc' \<noteq> pc+1 \<longrightarrow> s' <=_r c!pc'" 
   15.93 -           (is "?app ss1") and
   15.94 -      sum: "(map snd [(p',t') \<leftarrow> ss1 . p' = pc+1] ++_f x) = ?s1" 
   15.95 -           (is "?map ss1 ++_f x = _" is "?sum ss1 = _")
   15.96 -      by (simp split: split_if_asm)
   15.97 -    from app less 
   15.98 -    have "?app ss2" by (blast dest: trans_r lesub_step_typeD)
   15.99 -    moreover {
  15.100 -      from ss1 have map1: "set (?map ss1) \<subseteq> A" by auto
  15.101 -      with x have "?sum ss1 \<in> A" by (auto intro!: plusplus_closed semilat)
  15.102 -      with sum have "?s1 \<in> A" by simp
  15.103 -      moreover    
  15.104 -      have mapD: "\<And>x ss. x \<in> set (?map ss) \<Longrightarrow> \<exists>p. (p,x) \<in> set ss \<and> p=pc+1" by auto
  15.105 -      from x map1 
  15.106 -      have "\<forall>x \<in> set (?map ss1). x <=_r ?sum ss1"
  15.107 -        by clarify (rule pp_ub1)
  15.108 -      with sum have "\<forall>x \<in> set (?map ss1). x <=_r ?s1" by simp
  15.109 -      with less have "\<forall>x \<in> set (?map ss2). x <=_r ?s1"
  15.110 -        by (fastsimp dest!: mapD lesub_step_typeD intro: trans_r)
  15.111 -      moreover 
  15.112 -      from map1 x have "x <=_r (?sum ss1)" by (rule pp_ub2)
  15.113 -      with sum have "x <=_r ?s1" by simp
  15.114 -      moreover 
  15.115 -      from ss2 have "set (?map ss2) \<subseteq> A" by auto
  15.116 -      ultimately
  15.117 -      have "?sum ss2 <=_r ?s1" using x by - (rule pp_lub)
  15.118 -    }
  15.119 -    moreover
  15.120 -    from x ss2 have 
  15.121 -      "?s2 =
  15.122 -      (if \<forall>(pc', s')\<in>set ss2. pc' \<noteq> pc + 1 \<longrightarrow> s' <=_r c!pc'
  15.123 -      then map snd [(p', t') \<leftarrow> ss2 . p' = pc + 1] ++_f x
  15.124 -      else \<top>)" 
  15.125 -      by (rule merge_def)
  15.126 -    ultimately have ?thesis by simp
  15.127 -  }
  15.128 -  ultimately show ?thesis by (cases "?s1 = \<top>") auto
  15.129 -qed
  15.130 -
  15.131 -
  15.132 -lemma (in lbvc) wti_mono:
  15.133 -  assumes less: "s2 <=_r s1"
  15.134 -  assumes pc:   "pc < length \<phi>" 
  15.135 -  assumes s1:   "s1 \<in> A"
  15.136 -  assumes s2:   "s2 \<in> A"
  15.137 -  shows "wti c pc s2 <=_r wti c pc s1" (is "?s2' <=_r ?s1'")
  15.138 -proof -
  15.139 -  from mono pc s2 less have "step pc s2 <=|r| step pc s1" by (rule monoD)
  15.140 -  moreover
  15.141 -  from cert B_A pc have "c!Suc pc \<in> A" by (rule cert_okD3)
  15.142 -  moreover 
  15.143 -  from pres s1 pc
  15.144 -  have "snd`set (step pc s1) \<subseteq> A" by (rule pres_typeD2)
  15.145 -  moreover
  15.146 -  from pres s2 pc
  15.147 -  have "snd`set (step pc s2) \<subseteq> A" by (rule pres_typeD2)
  15.148 -  ultimately
  15.149 -  show ?thesis by (simp add: wti merge_mono)
  15.150 -qed 
  15.151 -
  15.152 -lemma (in lbvc) wtc_mono:
  15.153 -  assumes less: "s2 <=_r s1"
  15.154 -  assumes pc:   "pc < length \<phi>" 
  15.155 -  assumes s1:   "s1 \<in> A"
  15.156 -  assumes s2:   "s2 \<in> A"
  15.157 -  shows "wtc c pc s2 <=_r wtc c pc s1" (is "?s2' <=_r ?s1'")
  15.158 -proof (cases "c!pc = \<bottom>")
  15.159 -  case True 
  15.160 -  moreover from less pc s1 s2 have "wti c pc s2 <=_r wti c pc s1" by (rule wti_mono)
  15.161 -  ultimately show ?thesis by (simp add: wtc)
  15.162 -next
  15.163 -  case False
  15.164 -  have "?s1' = \<top> \<Longrightarrow> ?thesis" by simp
  15.165 -  moreover {
  15.166 -    assume "?s1' \<noteq> \<top>" 
  15.167 -    with False have c: "s1 <=_r c!pc" by (simp add: wtc split: split_if_asm)
  15.168 -    with less have "s2 <=_r c!pc" ..
  15.169 -    with False c have ?thesis by (simp add: wtc)
  15.170 -  }
  15.171 -  ultimately show ?thesis by (cases "?s1' = \<top>") auto
  15.172 -qed
  15.173 -
  15.174 -
  15.175 -lemma (in lbv) top_le_conv [simp]:
  15.176 -  "\<top> <=_r x = (x = \<top>)"
  15.177 -  by (insert semilat) (simp add: top top_le_conv) 
  15.178 -
  15.179 -lemma (in lbv) neq_top [simp, elim]:
  15.180 -  "\<lbrakk> x <=_r y; y \<noteq> \<top> \<rbrakk> \<Longrightarrow> x \<noteq> \<top>"
  15.181 -  by (cases "x = T") auto
  15.182 -
  15.183 -
  15.184 -lemma (in lbvc) stable_wti:
  15.185 -  assumes stable:  "stable r step \<phi> pc"
  15.186 -  assumes pc:      "pc < length \<phi>"
  15.187 -  shows "wti c pc (\<phi>!pc) \<noteq> \<top>"
  15.188 -proof -
  15.189 -  let ?step = "step pc (\<phi>!pc)"
  15.190 -  from stable 
  15.191 -  have less: "\<forall>(q,s')\<in>set ?step. s' <=_r \<phi>!q" by (simp add: stable_def)
  15.192 -  
  15.193 -  from cert B_A pc 
  15.194 -  have cert_suc: "c!Suc pc \<in> A" by (rule cert_okD3)
  15.195 -  moreover  
  15.196 -  from phi pc have "\<phi>!pc \<in> A" by simp
  15.197 -  from pres this pc 
  15.198 -  have stepA: "snd`set ?step \<subseteq> A" by (rule pres_typeD2) 
  15.199 -  ultimately
  15.200 -  have "merge c pc ?step (c!Suc pc) =
  15.201 -    (if \<forall>(pc',s')\<in>set ?step. pc'\<noteq>pc+1 \<longrightarrow> s' <=_r c!pc'
  15.202 -    then map snd [(p',t') \<leftarrow> ?step.p'=pc+1] ++_f c!Suc pc
  15.203 -    else \<top>)" unfolding mrg_def by (rule lbv.merge_def [OF lbvc.axioms(1), OF lbvc_axioms])
  15.204 -  moreover {
  15.205 -    fix pc' s' assume s': "(pc', s') \<in> set ?step" and suc_pc: "pc' \<noteq> pc+1"
  15.206 -    with less have "s' <=_r \<phi>!pc'" by auto
  15.207 -    also 
  15.208 -    from bounded pc s' have "pc' < length \<phi>" by (rule boundedD)
  15.209 -    with s' suc_pc pc have "c!pc' = \<phi>!pc'" ..
  15.210 -    hence "\<phi>!pc' = c!pc'" ..
  15.211 -    finally have "s' <=_r c!pc'" .
  15.212 -  } hence "\<forall>(pc',s')\<in>set ?step. pc'\<noteq>pc+1 \<longrightarrow> s' <=_r c!pc'" by auto
  15.213 -  moreover
  15.214 -  from pc have "Suc pc = length \<phi> \<or> Suc pc < length \<phi>" by auto
  15.215 -  hence "map snd [(p',t') \<leftarrow> ?step.p'=pc+1] ++_f c!Suc pc \<noteq> \<top>" 
  15.216 -         (is "?map ++_f _ \<noteq> _")
  15.217 -  proof (rule disjE)
  15.218 -    assume pc': "Suc pc = length \<phi>"
  15.219 -    with cert have "c!Suc pc = \<bottom>" by (simp add: cert_okD2)
  15.220 -    moreover 
  15.221 -    from pc' bounded pc 
  15.222 -    have "\<forall>(p',t')\<in>set ?step. p'\<noteq>pc+1" by clarify (drule boundedD, auto)
  15.223 -    hence "[(p',t') \<leftarrow> ?step.p'=pc+1] = []" by (blast intro: filter_False) 
  15.224 -    hence "?map = []" by simp
  15.225 -    ultimately show ?thesis by (simp add: B_neq_T)  
  15.226 -  next
  15.227 -    assume pc': "Suc pc < length \<phi>"
  15.228 -    from pc' phi have "\<phi>!Suc pc \<in> A" by simp
  15.229 -    moreover note cert_suc
  15.230 -    moreover from stepA 
  15.231 -    have "set ?map \<subseteq> A" by auto
  15.232 -    moreover
  15.233 -    have "\<And>s. s \<in> set ?map \<Longrightarrow> \<exists>t. (Suc pc, t) \<in> set ?step" by auto
  15.234 -    with less have "\<forall>s' \<in> set ?map. s' <=_r \<phi>!Suc pc" by auto
  15.235 -    moreover
  15.236 -    from pc' have "c!Suc pc <=_r \<phi>!Suc pc" 
  15.237 -      by (cases "c!Suc pc = \<bottom>") (auto dest: cert_approx)
  15.238 -    ultimately
  15.239 -    have "?map ++_f c!Suc pc <=_r \<phi>!Suc pc" by (rule pp_lub)
  15.240 -    moreover
  15.241 -    from pc' phi have "\<phi>!Suc pc \<noteq> \<top>" by simp
  15.242 -    ultimately
  15.243 -    show ?thesis by auto
  15.244 -  qed
  15.245 -  ultimately
  15.246 -  have "merge c pc ?step (c!Suc pc) \<noteq> \<top>" by simp
  15.247 -  thus ?thesis by (simp add: wti)  
  15.248 -qed
  15.249 -
  15.250 -lemma (in lbvc) wti_less:
  15.251 -  assumes stable:  "stable r step \<phi> pc"
  15.252 -  assumes suc_pc:   "Suc pc < length \<phi>"
  15.253 -  shows "wti c pc (\<phi>!pc) <=_r \<phi>!Suc pc" (is "?wti <=_r _")
  15.254 -proof -
  15.255 -  let ?step = "step pc (\<phi>!pc)"
  15.256 -
  15.257 -  from stable 
  15.258 -  have less: "\<forall>(q,s')\<in>set ?step. s' <=_r \<phi>!q" by (simp add: stable_def)
  15.259 -   
  15.260 -  from suc_pc have pc: "pc < length \<phi>" by simp
  15.261 -  with cert B_A have cert_suc: "c!Suc pc \<in> A" by (rule cert_okD3)
  15.262 -  moreover  
  15.263 -  from phi pc have "\<phi>!pc \<in> A" by simp
  15.264 -  with pres pc have stepA: "snd`set ?step \<subseteq> A" by - (rule pres_typeD2)
  15.265 -  moreover
  15.266 -  from stable pc have "?wti \<noteq> \<top>" by (rule stable_wti)
  15.267 -  hence "merge c pc ?step (c!Suc pc) \<noteq> \<top>" by (simp add: wti)
  15.268 -  ultimately
  15.269 -  have "merge c pc ?step (c!Suc pc) =
  15.270 -    map snd [(p',t')\<leftarrow> ?step.p'=pc+1] ++_f c!Suc pc" by (rule merge_not_top_s) 
  15.271 -  hence "?wti = \<dots>" (is "_ = (?map ++_f _)" is "_ = ?sum") by (simp add: wti)
  15.272 -  also {
  15.273 -    from suc_pc phi have "\<phi>!Suc pc \<in> A" by simp
  15.274 -    moreover note cert_suc
  15.275 -    moreover from stepA have "set ?map \<subseteq> A" by auto
  15.276 -    moreover
  15.277 -    have "\<And>s. s \<in> set ?map \<Longrightarrow> \<exists>t. (Suc pc, t) \<in> set ?step" by auto
  15.278 -    with less have "\<forall>s' \<in> set ?map. s' <=_r \<phi>!Suc pc" by auto
  15.279 -    moreover
  15.280 -    from suc_pc have "c!Suc pc <=_r \<phi>!Suc pc"
  15.281 -      by (cases "c!Suc pc = \<bottom>") (auto dest: cert_approx)
  15.282 -    ultimately
  15.283 -    have "?sum <=_r \<phi>!Suc pc" by (rule pp_lub)
  15.284 -  }
  15.285 -  finally show ?thesis .
  15.286 -qed
  15.287 -
  15.288 -lemma (in lbvc) stable_wtc:
  15.289 -  assumes stable:  "stable r step phi pc"
  15.290 -  assumes pc:      "pc < length \<phi>"
  15.291 -  shows "wtc c pc (\<phi>!pc) \<noteq> \<top>"
  15.292 -proof -
  15.293 -  from stable pc have wti: "wti c pc (\<phi>!pc) \<noteq> \<top>" by (rule stable_wti)
  15.294 -  show ?thesis
  15.295 -  proof (cases "c!pc = \<bottom>")
  15.296 -    case True with wti show ?thesis by (simp add: wtc)
  15.297 -  next
  15.298 -    case False
  15.299 -    with pc have "c!pc = \<phi>!pc" ..    
  15.300 -    with False wti show ?thesis by (simp add: wtc)
  15.301 -  qed
  15.302 -qed
  15.303 -
  15.304 -lemma (in lbvc) wtc_less:
  15.305 -  assumes stable: "stable r step \<phi> pc"
  15.306 -  assumes suc_pc: "Suc pc < length \<phi>"
  15.307 -  shows "wtc c pc (\<phi>!pc) <=_r \<phi>!Suc pc" (is "?wtc <=_r _")
  15.308 -proof (cases "c!pc = \<bottom>")
  15.309 -  case True
  15.310 -  moreover from stable suc_pc have "wti c pc (\<phi>!pc) <=_r \<phi>!Suc pc"
  15.311 -    by (rule wti_less)
  15.312 -  ultimately show ?thesis by (simp add: wtc)
  15.313 -next
  15.314 -  case False
  15.315 -  from suc_pc have pc: "pc < length \<phi>" by simp
  15.316 -  with stable have "?wtc \<noteq> \<top>" by (rule stable_wtc)
  15.317 -  with False have "?wtc = wti c pc (c!pc)" 
  15.318 -    by (unfold wtc) (simp split: split_if_asm)
  15.319 -  also from pc False have "c!pc = \<phi>!pc" .. 
  15.320 -  finally have "?wtc = wti c pc (\<phi>!pc)" .
  15.321 -  also from stable suc_pc have "wti c pc (\<phi>!pc) <=_r \<phi>!Suc pc" by (rule wti_less)
  15.322 -  finally show ?thesis .
  15.323 -qed
  15.324 -
  15.325 -
  15.326 -lemma (in lbvc) wt_step_wtl_lemma:
  15.327 -  assumes wt_step: "wt_step r \<top> step \<phi>"
  15.328 -  shows "\<And>pc s. pc+length ls = length \<phi> \<Longrightarrow> s <=_r \<phi>!pc \<Longrightarrow> s \<in> A \<Longrightarrow> s\<noteq>\<top> \<Longrightarrow>
  15.329 -                wtl ls c pc s \<noteq> \<top>"
  15.330 -  (is "\<And>pc s. _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> ?wtl ls pc s \<noteq> _")
  15.331 -proof (induct ls)
  15.332 -  fix pc s assume "s\<noteq>\<top>" thus "?wtl [] pc s \<noteq> \<top>" by simp
  15.333 -next
  15.334 -  fix pc s i ls
  15.335 -  assume "\<And>pc s. pc+length ls=length \<phi> \<Longrightarrow> s <=_r \<phi>!pc \<Longrightarrow> s \<in> A \<Longrightarrow> s\<noteq>\<top> \<Longrightarrow> 
  15.336 -                  ?wtl ls pc s \<noteq> \<top>"
  15.337 -  moreover
  15.338 -  assume pc_l: "pc + length (i#ls) = length \<phi>"
  15.339 -  hence suc_pc_l: "Suc pc + length ls = length \<phi>" by simp
  15.340 -  ultimately
  15.341 -  have IH: "\<And>s. s <=_r \<phi>!Suc pc \<Longrightarrow> s \<in> A \<Longrightarrow> s \<noteq> \<top> \<Longrightarrow> ?wtl ls (Suc pc) s \<noteq> \<top>" .
  15.342 -
  15.343 -  from pc_l obtain pc: "pc < length \<phi>" by simp
  15.344 -  with wt_step have stable: "stable r step \<phi> pc" by (simp add: wt_step_def)
  15.345 -  from this pc have wt_phi: "wtc c pc (\<phi>!pc) \<noteq> \<top>" by (rule stable_wtc)
  15.346 -  assume s_phi: "s <=_r \<phi>!pc"
  15.347 -  from phi pc have phi_pc: "\<phi>!pc \<in> A" by simp
  15.348 -  assume s: "s \<in> A"
  15.349 -  with s_phi pc phi_pc have wt_s_phi: "wtc c pc s <=_r wtc c pc (\<phi>!pc)" by (rule wtc_mono)
  15.350 -  with wt_phi have wt_s: "wtc c pc s \<noteq> \<top>" by simp
  15.351 -  moreover
  15.352 -  assume s': "s \<noteq> \<top>" 
  15.353 -  ultimately
  15.354 -  have "ls = [] \<Longrightarrow> ?wtl (i#ls) pc s \<noteq> \<top>" by simp
  15.355 -  moreover {
  15.356 -    assume "ls \<noteq> []" 
  15.357 -    with pc_l have suc_pc: "Suc pc < length \<phi>" by (auto simp add: neq_Nil_conv)
  15.358 -    with stable have "wtc c pc (phi!pc) <=_r \<phi>!Suc pc" by (rule wtc_less)
  15.359 -    with wt_s_phi have "wtc c pc s <=_r \<phi>!Suc pc" by (rule trans_r)      
  15.360 -    moreover
  15.361 -    from cert suc_pc have "c!pc \<in> A" "c!(pc+1) \<in> A" 
  15.362 -      by (auto simp add: cert_ok_def)
  15.363 -    from pres this s pc have "wtc c pc s \<in> A" by (rule wtc_pres)
  15.364 -    ultimately
  15.365 -    have "?wtl ls (Suc pc) (wtc c pc s) \<noteq> \<top>" using IH wt_s by blast
  15.366 -    with s' wt_s have "?wtl (i#ls) pc s \<noteq> \<top>" by simp
  15.367 -  }
  15.368 -  ultimately show "?wtl (i#ls) pc s \<noteq> \<top>" by (cases ls) blast+
  15.369 -qed
  15.370 -
  15.371 -  
  15.372 -theorem (in lbvc) wtl_complete:
  15.373 -  assumes wt: "wt_step r \<top> step \<phi>"
  15.374 -    and s: "s <=_r \<phi>!0" "s \<in> A" "s \<noteq> \<top>"
  15.375 -    and len: "length ins = length phi"
  15.376 -  shows "wtl ins c 0 s \<noteq> \<top>"
  15.377 -proof -
  15.378 -  from len have "0+length ins = length phi" by simp
  15.379 -  from wt this s show ?thesis by (rule wt_step_wtl_lemma)
  15.380 -qed
  15.381 -
  15.382 -end
    16.1 --- a/src/HOL/MicroJava/BV/LBVCorrect.thy	Wed Dec 02 12:04:07 2009 +0100
    16.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    16.3 @@ -1,223 +0,0 @@
    16.4 -(*
    16.5 -    ID:         $Id$
    16.6 -    Author:     Gerwin Klein
    16.7 -    Copyright   1999 Technische Universitaet Muenchen
    16.8 -*)
    16.9 -
   16.10 -header {* \isaheader{Correctness of the LBV} *}
   16.11 -
   16.12 -theory LBVCorrect
   16.13 -imports LBVSpec Typing_Framework
   16.14 -begin
   16.15 -
   16.16 -locale lbvs = lbv +
   16.17 -  fixes s0  :: 'a ("s\<^sub>0")
   16.18 -  fixes c   :: "'a list"
   16.19 -  fixes ins :: "'b list"
   16.20 -  fixes phi :: "'a list" ("\<phi>")
   16.21 -  defines phi_def:
   16.22 -  "\<phi> \<equiv> map (\<lambda>pc. if c!pc = \<bottom> then wtl (take pc ins) c 0 s0 else c!pc) 
   16.23 -       [0..<length ins]"
   16.24 -
   16.25 -  assumes bounded: "bounded step (length ins)"
   16.26 -  assumes cert: "cert_ok c (length ins) \<top> \<bottom> A"
   16.27 -  assumes pres: "pres_type step (length ins) A"
   16.28 -
   16.29 -
   16.30 -lemma (in lbvs) phi_None [intro?]:
   16.31 -  "\<lbrakk> pc < length ins; c!pc = \<bottom> \<rbrakk> \<Longrightarrow> \<phi> ! pc = wtl (take pc ins) c 0 s0"
   16.32 -  by (simp add: phi_def)
   16.33 -
   16.34 -lemma (in lbvs) phi_Some [intro?]:
   16.35 -  "\<lbrakk> pc < length ins; c!pc \<noteq> \<bottom> \<rbrakk> \<Longrightarrow> \<phi> ! pc = c ! pc"
   16.36 -  by (simp add: phi_def)
   16.37 -
   16.38 -lemma (in lbvs) phi_len [simp]:
   16.39 -  "length \<phi> = length ins"
   16.40 -  by (simp add: phi_def)
   16.41 -
   16.42 -
   16.43 -lemma (in lbvs) wtl_suc_pc:
   16.44 -  assumes all: "wtl ins c 0 s\<^sub>0 \<noteq> \<top>" 
   16.45 -  assumes pc:  "pc+1 < length ins"
   16.46 -  shows "wtl (take (pc+1) ins) c 0 s0 \<le>\<^sub>r \<phi>!(pc+1)"
   16.47 -proof -
   16.48 -  from all pc
   16.49 -  have "wtc c (pc+1) (wtl (take (pc+1) ins) c 0 s0) \<noteq> T" by (rule wtl_all)
   16.50 -  with pc show ?thesis by (simp add: phi_def wtc split: split_if_asm)
   16.51 -qed
   16.52 -
   16.53 -
   16.54 -lemma (in lbvs) wtl_stable:
   16.55 -  assumes wtl: "wtl ins c 0 s0 \<noteq> \<top>" 
   16.56 -  assumes s0:  "s0 \<in> A" 
   16.57 -  assumes pc:  "pc < length ins" 
   16.58 -  shows "stable r step \<phi> pc"
   16.59 -proof (unfold stable_def, clarify)
   16.60 -  fix pc' s' assume step: "(pc',s') \<in> set (step pc (\<phi> ! pc))" 
   16.61 -                      (is "(pc',s') \<in> set (?step pc)")
   16.62 -  
   16.63 -  from bounded pc step have pc': "pc' < length ins" by (rule boundedD)
   16.64 -
   16.65 -  from wtl have tkpc: "wtl (take pc ins) c 0 s0 \<noteq> \<top>" (is "?s1 \<noteq> _") by (rule wtl_take)
   16.66 -  from wtl have s2: "wtl (take (pc+1) ins) c 0 s0 \<noteq> \<top>" (is "?s2 \<noteq> _") by (rule wtl_take)
   16.67 -  
   16.68 -  from wtl pc have wt_s1: "wtc c pc ?s1 \<noteq> \<top>" by (rule wtl_all)
   16.69 -
   16.70 -  have c_Some: "\<forall>pc t. pc < length ins \<longrightarrow> c!pc \<noteq> \<bottom> \<longrightarrow> \<phi>!pc = c!pc" 
   16.71 -    by (simp add: phi_def)
   16.72 -  from pc have c_None: "c!pc = \<bottom> \<Longrightarrow> \<phi>!pc = ?s1" ..
   16.73 -
   16.74 -  from wt_s1 pc c_None c_Some
   16.75 -  have inst: "wtc c pc ?s1  = wti c pc (\<phi>!pc)"
   16.76 -    by (simp add: wtc split: split_if_asm)
   16.77 -
   16.78 -  from pres cert s0 wtl pc have "?s1 \<in> A" by (rule wtl_pres)
   16.79 -  with pc c_Some cert c_None
   16.80 -  have "\<phi>!pc \<in> A" by (cases "c!pc = \<bottom>") (auto dest: cert_okD1)
   16.81 -  with pc pres
   16.82 -  have step_in_A: "snd`set (?step pc) \<subseteq> A" by (auto dest: pres_typeD2)
   16.83 -
   16.84 -  show "s' <=_r \<phi>!pc'" 
   16.85 -  proof (cases "pc' = pc+1")
   16.86 -    case True
   16.87 -    with pc' cert
   16.88 -    have cert_in_A: "c!(pc+1) \<in> A" by (auto dest: cert_okD1)
   16.89 -    from True pc' have pc1: "pc+1 < length ins" by simp
   16.90 -    with tkpc have "?s2 = wtc c pc ?s1" by - (rule wtl_Suc)
   16.91 -    with inst 
   16.92 -    have merge: "?s2 = merge c pc (?step pc) (c!(pc+1))" by (simp add: wti)
   16.93 -    also    
   16.94 -    from s2 merge have "\<dots> \<noteq> \<top>" (is "?merge \<noteq> _") by simp
   16.95 -    with cert_in_A step_in_A
   16.96 -    have "?merge = (map snd [(p',t') \<leftarrow> ?step pc. p'=pc+1] ++_f (c!(pc+1)))"
   16.97 -      by (rule merge_not_top_s) 
   16.98 -    finally
   16.99 -    have "s' <=_r ?s2" using step_in_A cert_in_A True step 
  16.100 -      by (auto intro: pp_ub1')
  16.101 -    also 
  16.102 -    from wtl pc1 have "?s2 <=_r \<phi>!(pc+1)" by (rule wtl_suc_pc)
  16.103 -    also note True [symmetric]
  16.104 -    finally show ?thesis by simp    
  16.105 -  next
  16.106 -    case False
  16.107 -    from wt_s1 inst
  16.108 -    have "merge c pc (?step pc) (c!(pc+1)) \<noteq> \<top>" by (simp add: wti)
  16.109 -    with step_in_A
  16.110 -    have "\<forall>(pc', s')\<in>set (?step pc). pc'\<noteq>pc+1 \<longrightarrow> s' <=_r c!pc'" 
  16.111 -      by - (rule merge_not_top)
  16.112 -    with step False 
  16.113 -    have ok: "s' <=_r c!pc'" by blast
  16.114 -    moreover
  16.115 -    from ok
  16.116 -    have "c!pc' = \<bottom> \<Longrightarrow> s' = \<bottom>" by simp
  16.117 -    moreover
  16.118 -    from c_Some pc'
  16.119 -    have "c!pc' \<noteq> \<bottom> \<Longrightarrow> \<phi>!pc' = c!pc'" by auto
  16.120 -    ultimately
  16.121 -    show ?thesis by (cases "c!pc' = \<bottom>") auto 
  16.122 -  qed
  16.123 -qed
  16.124 -
  16.125 -  
  16.126 -lemma (in lbvs) phi_not_top:
  16.127 -  assumes wtl: "wtl ins c 0 s0 \<noteq> \<top>"
  16.128 -  assumes pc:  "pc < length ins"
  16.129 -  shows "\<phi>!pc \<noteq> \<top>"
  16.130 -proof (cases "c!pc = \<bottom>")
  16.131 -  case False with pc
  16.132 -  have "\<phi>!pc = c!pc" ..
  16.133 -  also from cert pc have "\<dots> \<noteq> \<top>" by (rule cert_okD4)
  16.134 -  finally show ?thesis .
  16.135 -next
  16.136 -  case True with pc
  16.137 -  have "\<phi>!pc = wtl (take pc ins) c 0 s0" ..
  16.138 -  also from wtl have "\<dots> \<noteq> \<top>" by (rule wtl_take)
  16.139 -  finally show ?thesis .
  16.140 -qed
  16.141 -
  16.142 -lemma (in lbvs) phi_in_A:
  16.143 -  assumes wtl: "wtl ins c 0 s0 \<noteq> \<top>"
  16.144 -  assumes s0:  "s0 \<in> A"
  16.145 -  shows "\<phi> \<in> list (length ins) A"
  16.146 -proof -
  16.147 -  { fix x assume "x \<in> set \<phi>"
  16.148 -    then obtain xs ys where "\<phi> = xs @ x # ys" 
  16.149 -      by (auto simp add: in_set_conv_decomp)
  16.150 -    then obtain pc where pc: "pc < length \<phi>" and x: "\<phi>!pc = x"
  16.151 -      by (simp add: that [of "length xs"] nth_append)
  16.152 -    
  16.153 -    from pres cert wtl s0 pc
  16.154 -    have "wtl (take pc ins) c 0 s0 \<in> A" by (auto intro!: wtl_pres)
  16.155 -    moreover
  16.156 -    from pc have "pc < length ins" by simp
  16.157 -    with cert have "c!pc \<in> A" ..
  16.158 -    ultimately
  16.159 -    have "\<phi>!pc \<in> A" using pc by (simp add: phi_def)
  16.160 -    hence "x \<in> A" using x by simp
  16.161 -  } 
  16.162 -  hence "set \<phi> \<subseteq> A" ..
  16.163 -  thus ?thesis by (unfold list_def) simp
  16.164 -qed
  16.165 -
  16.166 -
  16.167 -lemma (in lbvs) phi0:
  16.168 -  assumes wtl: "wtl ins c 0 s0 \<noteq> \<top>"
  16.169 -  assumes 0:   "0 < length ins"
  16.170 -  shows "s0 <=_r \<phi>!0"
  16.171 -proof (cases "c!0 = \<bottom>")
  16.172 -  case True
  16.173 -  with 0 have "\<phi>!0 = wtl (take 0 ins) c 0 s0" ..
  16.174 -  moreover have "wtl (take 0 ins) c 0 s0 = s0" by simp
  16.175 -  ultimately have "\<phi>!0 = s0" by simp
  16.176 -  thus ?thesis by simp
  16.177 -next
  16.178 -  case False
  16.179 -  with 0 have "phi!0 = c!0" ..
  16.180 -  moreover 
  16.181 -  from wtl have "wtl (take 1 ins) c 0 s0 \<noteq> \<top>"  by (rule wtl_take)
  16.182 -  with 0 False 
  16.183 -  have "s0 <=_r c!0" by (auto simp add: neq_Nil_conv wtc split: split_if_asm)
  16.184 -  ultimately
  16.185 -  show ?thesis by simp
  16.186 -qed
  16.187 -
  16.188 -
  16.189 -theorem (in lbvs) wtl_sound:
  16.190 -  assumes wtl: "wtl ins c 0 s0 \<noteq> \<top>" 
  16.191 -  assumes s0: "s0 \<in> A" 
  16.192 -  shows "\<exists>ts. wt_step r \<top> step ts"
  16.193 -proof -
  16.194 -  have "wt_step r \<top> step \<phi>"
  16.195 -  proof (unfold wt_step_def, intro strip conjI)
  16.196 -    fix pc assume "pc < length \<phi>"
  16.197 -    then have pc: "pc < length ins" by simp
  16.198 -    with wtl show "\<phi>!pc \<noteq> \<top>" by (rule phi_not_top)
  16.199 -    from wtl s0 pc show "stable r step \<phi> pc" by (rule wtl_stable)
  16.200 -  qed
  16.201 -  thus ?thesis ..
  16.202 -qed
  16.203 -
  16.204 -
  16.205 -theorem (in lbvs) wtl_sound_strong:
  16.206 -  assumes wtl: "wtl ins c 0 s0 \<noteq> \<top>" 
  16.207 -  assumes s0: "s0 \<in> A" 
  16.208 -  assumes nz: "0 < length ins"
  16.209 -  shows "\<exists>ts \<in> list (length ins) A. wt_step r \<top> step ts \<and> s0 <=_r ts!0"
  16.210 -proof -
  16.211 -  from wtl s0 have "\<phi> \<in> list (length ins) A" by (rule phi_in_A)
  16.212 -  moreover
  16.213 -  have "wt_step r \<top> step \<phi>"
  16.214 -  proof (unfold wt_step_def, intro strip conjI)
  16.215 -    fix pc assume "pc < length \<phi>"
  16.216 -    then have pc: "pc < length ins" by simp
  16.217 -    with wtl show "\<phi>!pc \<noteq> \<top>" by (rule phi_not_top)
  16.218 -    from wtl s0 pc show "stable r step \<phi> pc" by (rule wtl_stable)
  16.219 -  qed
  16.220 -  moreover
  16.221 -  from wtl nz have "s0 <=_r \<phi>!0" by (rule phi0)
  16.222 -  ultimately
  16.223 -  show ?thesis by fast
  16.224 -qed
  16.225 -
  16.226 -end
    17.1 --- a/src/HOL/MicroJava/BV/LBVJVM.thy	Wed Dec 02 12:04:07 2009 +0100
    17.2 +++ b/src/HOL/MicroJava/BV/LBVJVM.thy	Tue Nov 24 14:37:23 2009 +0100
    17.3 @@ -1,5 +1,4 @@
    17.4  (*  Title:      HOL/MicroJava/BV/JVM.thy
    17.5 -    ID:         $Id$
    17.6      Author:     Tobias Nipkow, Gerwin Klein
    17.7      Copyright   2000 TUM
    17.8  *)
    17.9 @@ -7,7 +6,7 @@
   17.10  header {* \isaheader{LBV for the JVM}\label{sec:JVM} *}
   17.11  
   17.12  theory LBVJVM
   17.13 -imports LBVCorrect LBVComplete Typing_Framework_JVM
   17.14 +imports Typing_Framework_JVM
   17.15  begin
   17.16  
   17.17  types prog_cert = "cname \<Rightarrow> sig \<Rightarrow> JVMType.state list"
    18.1 --- a/src/HOL/MicroJava/BV/LBVSpec.thy	Wed Dec 02 12:04:07 2009 +0100
    18.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    18.3 @@ -1,381 +0,0 @@
    18.4 -(*  Title:      HOL/MicroJava/BV/LBVSpec.thy
    18.5 -    Author:     Gerwin Klein
    18.6 -    Copyright   1999 Technische Universitaet Muenchen
    18.7 -*)
    18.8 -
    18.9 -header {* \isaheader{The Lightweight Bytecode Verifier} *}
   18.10 -
   18.11 -theory LBVSpec
   18.12 -imports SemilatAlg Opt
   18.13 -begin
   18.14 -
   18.15 -types
   18.16 -  's certificate = "'s list"   
   18.17 -
   18.18 -consts
   18.19 -merge :: "'s certificate \<Rightarrow> 's binop \<Rightarrow> 's ord \<Rightarrow> 's \<Rightarrow> nat \<Rightarrow> (nat \<times> 's) list \<Rightarrow> 's \<Rightarrow> 's"
   18.20 -primrec
   18.21 -"merge cert f r T pc []     x = x"
   18.22 -"merge cert f r T pc (s#ss) x = merge cert f r T pc ss (let (pc',s') = s in 
   18.23 -                                  if pc'=pc+1 then s' +_f x
   18.24 -                                  else if s' <=_r (cert!pc') then x
   18.25 -                                  else T)"
   18.26 -
   18.27 -constdefs
   18.28 -wtl_inst :: "'s certificate \<Rightarrow> 's binop \<Rightarrow> 's ord \<Rightarrow> 's \<Rightarrow>
   18.29 -             's step_type \<Rightarrow> nat \<Rightarrow> 's \<Rightarrow> 's"
   18.30 -"wtl_inst cert f r T step pc s \<equiv> merge cert f r T pc (step pc s) (cert!(pc+1))"
   18.31 -
   18.32 -wtl_cert :: "'s certificate \<Rightarrow> 's binop \<Rightarrow> 's ord \<Rightarrow> 's \<Rightarrow> 's \<Rightarrow>
   18.33 -             's step_type \<Rightarrow> nat \<Rightarrow> 's \<Rightarrow> 's"
   18.34 -"wtl_cert cert f r T B step pc s \<equiv>
   18.35 -  if cert!pc = B then 
   18.36 -    wtl_inst cert f r T step pc s
   18.37 -  else
   18.38 -    if s <=_r (cert!pc) then wtl_inst cert f r T step pc (cert!pc) else T"
   18.39 -
   18.40 -consts 
   18.41 -wtl_inst_list :: "'a list \<Rightarrow> 's certificate \<Rightarrow> 's binop \<Rightarrow> 's ord \<Rightarrow> 's \<Rightarrow> 's \<Rightarrow>
   18.42 -                  's step_type \<Rightarrow> nat \<Rightarrow> 's \<Rightarrow> 's"
   18.43 -primrec
   18.44 -"wtl_inst_list []     cert f r T B step pc s = s"
   18.45 -"wtl_inst_list (i#is) cert f r T B step pc s = 
   18.46 -    (let s' = wtl_cert cert f r T B step pc s in
   18.47 -      if s' = T \<or> s = T then T else wtl_inst_list is cert f r T B step (pc+1) s')"
   18.48 -
   18.49 -constdefs
   18.50 -  cert_ok :: "'s certificate \<Rightarrow> nat \<Rightarrow> 's \<Rightarrow> 's \<Rightarrow> 's set \<Rightarrow> bool"
   18.51 -  "cert_ok cert n T B A \<equiv> (\<forall>i < n. cert!i \<in> A \<and> cert!i \<noteq> T) \<and> (cert!n = B)"
   18.52 -
   18.53 -constdefs
   18.54 -  bottom :: "'a ord \<Rightarrow> 'a \<Rightarrow> bool"
   18.55 -  "bottom r B \<equiv> \<forall>x. B <=_r x"
   18.56 -
   18.57 -
   18.58 -locale lbv = Semilat +
   18.59 -  fixes T :: "'a" ("\<top>") 
   18.60 -  fixes B :: "'a" ("\<bottom>") 
   18.61 -  fixes step :: "'a step_type" 
   18.62 -  assumes top: "top r \<top>"
   18.63 -  assumes T_A: "\<top> \<in> A"
   18.64 -  assumes bot: "bottom r \<bottom>" 
   18.65 -  assumes B_A: "\<bottom> \<in> A"
   18.66 -
   18.67 -  fixes merge :: "'a certificate \<Rightarrow> nat \<Rightarrow> (nat \<times> 'a) list \<Rightarrow> 'a \<Rightarrow> 'a"
   18.68 -  defines mrg_def: "merge cert \<equiv> LBVSpec.merge cert f r \<top>"
   18.69 -
   18.70 -  fixes wti :: "'a certificate \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a"
   18.71 -  defines wti_def: "wti cert \<equiv> wtl_inst cert f r \<top> step"
   18.72 - 
   18.73 -  fixes wtc :: "'a certificate \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a"
   18.74 -  defines wtc_def: "wtc cert \<equiv> wtl_cert cert f r \<top> \<bottom> step"
   18.75 -
   18.76 -  fixes wtl :: "'b list \<Rightarrow> 'a certificate \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a"
   18.77 -  defines wtl_def: "wtl ins cert \<equiv> wtl_inst_list ins cert f r \<top> \<bottom> step"
   18.78 -
   18.79 -
   18.80 -lemma (in lbv) wti:
   18.81 -  "wti c pc s \<equiv> merge c pc (step pc s) (c!(pc+1))"
   18.82 -  by (simp add: wti_def mrg_def wtl_inst_def)
   18.83 -
   18.84 -lemma (in lbv) wtc: 
   18.85 -  "wtc c pc s \<equiv> if c!pc = \<bottom> then wti c pc s else if s <=_r c!pc then wti c pc (c!pc) else \<top>"
   18.86 -  by (unfold wtc_def wti_def wtl_cert_def)
   18.87 -
   18.88 -
   18.89 -lemma cert_okD1 [intro?]:
   18.90 -  "cert_ok c n T B A \<Longrightarrow> pc < n \<Longrightarrow> c!pc \<in> A"
   18.91 -  by (unfold cert_ok_def) fast
   18.92 -
   18.93 -lemma cert_okD2 [intro?]:
   18.94 -  "cert_ok c n T B A \<Longrightarrow> c!n = B"
   18.95 -  by (simp add: cert_ok_def)
   18.96 -
   18.97 -lemma cert_okD3 [intro?]:
   18.98 -  "cert_ok c n T B A \<Longrightarrow> B \<in> A \<Longrightarrow> pc < n \<Longrightarrow> c!Suc pc \<in> A"
   18.99 -  by (drule Suc_leI) (auto simp add: le_eq_less_or_eq dest: cert_okD1 cert_okD2)
  18.100 -
  18.101 -lemma cert_okD4 [intro?]:
  18.102 -  "cert_ok c n T B A \<Longrightarrow> pc < n \<Longrightarrow> c!pc \<noteq> T"
  18.103 -  by (simp add: cert_ok_def)
  18.104 -
  18.105 -declare Let_def [simp]
  18.106 -
  18.107 -section "more semilattice lemmas"
  18.108 -
  18.109 -
  18.110 -lemma (in lbv) sup_top [simp, elim]:
  18.111 -  assumes x: "x \<in> A" 
  18.112 -  shows "x +_f \<top> = \<top>"
  18.113 -proof -
  18.114 -  from top have "x +_f \<top> <=_r \<top>" ..
  18.115 -  moreover from x T_A have "\<top> <=_r x +_f \<top>" ..
  18.116 -  ultimately show ?thesis ..
  18.117 -qed
  18.118 -  
  18.119 -lemma (in lbv) plusplussup_top [simp, elim]:
  18.120 -  "set xs \<subseteq> A \<Longrightarrow> xs ++_f \<top> = \<top>"
  18.121 -  by (induct xs) auto
  18.122 -
  18.123 -
  18.124 -
  18.125 -lemma (in Semilat) pp_ub1':
  18.126 -  assumes S: "snd`set S \<subseteq> A" 
  18.127 -  assumes y: "y \<in> A" and ab: "(a, b) \<in> set S" 
  18.128 -  shows "b <=_r map snd [(p', t') \<leftarrow> S . p' = a] ++_f y"
  18.129 -proof -
  18.130 -  from S have "\<forall>(x,y) \<in> set S. y \<in> A" by auto
  18.131 -  with semilat y ab show ?thesis by - (rule ub1')
  18.132 -qed 
  18.133 -
  18.134 -lemma (in lbv) bottom_le [simp, intro]:
  18.135 -  "\<bottom> <=_r x"
  18.136 -  by (insert bot) (simp add: bottom_def)
  18.137 -
  18.138 -lemma (in lbv) le_bottom [simp]:
  18.139 -  "x <=_r \<bottom> = (x = \<bottom>)"
  18.140 -  by (blast intro: antisym_r)
  18.141 -
  18.142 -
  18.143 -
  18.144 -section "merge"
  18.145 -
  18.146 -lemma (in lbv) merge_Nil [simp]:
  18.147 -  "merge c pc [] x = x" by (simp add: mrg_def)
  18.148 -
  18.149 -lemma (in lbv) merge_Cons [simp]:
  18.150 -  "merge c pc (l#ls) x = merge c pc ls (if fst l=pc+1 then snd l +_f x
  18.151 -                                        else if snd l <=_r (c!fst l) then x
  18.152 -                                        else \<top>)"
  18.153 -  by (simp add: mrg_def split_beta)
  18.154 -
  18.155 -lemma (in lbv) merge_Err [simp]:
  18.156 -  "snd`set ss \<subseteq> A \<Longrightarrow> merge c pc ss \<top> = \<top>"
  18.157 -  by (induct ss) auto
  18.158 -
  18.159 -lemma (in lbv) merge_not_top:
  18.160 -  "\<And>x. snd`set ss \<subseteq> A \<Longrightarrow> merge c pc ss x \<noteq> \<top> \<Longrightarrow> 
  18.161 -  \<forall>(pc',s') \<in> set ss. (pc' \<noteq> pc+1 \<longrightarrow> s' <=_r (c!pc'))"
  18.162 -  (is "\<And>x. ?set ss \<Longrightarrow> ?merge ss x \<Longrightarrow> ?P ss")
  18.163 -proof (induct ss)
  18.164 -  show "?P []" by simp
  18.165 -next
  18.166 -  fix x ls l
  18.167 -  assume "?set (l#ls)" then obtain set: "snd`set ls \<subseteq> A" by simp
  18.168 -  assume merge: "?merge (l#ls) x" 
  18.169 -  moreover
  18.170 -  obtain pc' s' where l: "l = (pc',s')" by (cases l)
  18.171 -  ultimately
  18.172 -  obtain x' where merge': "?merge ls x'" by simp 
  18.173 -  assume "\<And>x. ?set ls \<Longrightarrow> ?merge ls x \<Longrightarrow> ?P ls" hence "?P ls" using set merge' .
  18.174 -  moreover
  18.175 -  from merge set
  18.176 -  have "pc' \<noteq> pc+1 \<longrightarrow> s' <=_r (c!pc')" by (simp add: l split: split_if_asm)
  18.177 -  ultimately
  18.178 -  show "?P (l#ls)" by (simp add: l)
  18.179 -qed
  18.180 -
  18.181 -
  18.182 -lemma (in lbv) merge_def:
  18.183 -  shows 
  18.184 -  "\<And>x. x \<in> A \<Longrightarrow> snd`set ss \<subseteq> A \<Longrightarrow>
  18.185 -  merge c pc ss x = 
  18.186 -  (if \<forall>(pc',s') \<in> set ss. pc'\<noteq>pc+1 \<longrightarrow> s' <=_r c!pc' then
  18.187 -    map snd [(p',t') \<leftarrow> ss. p'=pc+1] ++_f x
  18.188 -  else \<top>)" 
  18.189 -  (is "\<And>x. _ \<Longrightarrow> _ \<Longrightarrow> ?merge ss x = ?if ss x" is "\<And>x. _ \<Longrightarrow> _ \<Longrightarrow> ?P ss x")
  18.190 -proof (induct ss)
  18.191 -  fix x show "?P [] x" by simp
  18.192 -next 
  18.193 -  fix x assume x: "x \<in> A" 
  18.194 -  fix l::"nat \<times> 'a" and ls  
  18.195 -  assume "snd`set (l#ls) \<subseteq> A"
  18.196 -  then obtain l: "snd l \<in> A" and ls: "snd`set ls \<subseteq> A" by auto
  18.197 -  assume "\<And>x. x \<in> A \<Longrightarrow> snd`set ls \<subseteq> A \<Longrightarrow> ?P ls x" 
  18.198 -  hence IH: "\<And>x. x \<in> A \<Longrightarrow> ?P ls x" using ls by iprover
  18.199 -  obtain pc' s' where [simp]: "l = (pc',s')" by (cases l)
  18.200 -  hence "?merge (l#ls) x = ?merge ls 
  18.201 -    (if pc'=pc+1 then s' +_f x else if s' <=_r c!pc' then x else \<top>)"
  18.202 -    (is "?merge (l#ls) x = ?merge ls ?if'")
  18.203 -    by simp 
  18.204 -  also have "\<dots> = ?if ls ?if'" 
  18.205 -  proof -
  18.206 -    from l have "s' \<in> A" by simp
  18.207 -    with x have "s' +_f x \<in> A" by simp
  18.208 -    with x T_A have "?if' \<in> A" by auto
  18.209 -    hence "?P ls ?if'" by (rule IH) thus ?thesis by simp
  18.210 -  qed
  18.211 -  also have "\<dots> = ?if (l#ls) x"
  18.212 -    proof (cases "\<forall>(pc', s')\<in>set (l#ls). pc'\<noteq>pc+1 \<longrightarrow> s' <=_r c!pc'")
  18.213 -      case True
  18.214 -      hence "\<forall>(pc', s')\<in>set ls. pc'\<noteq>pc+1 \<longrightarrow> s' <=_r c!pc'" by auto
  18.215 -      moreover
  18.216 -      from True have 
  18.217 -        "map snd [(p',t')\<leftarrow>ls . p'=pc+1] ++_f ?if' = 
  18.218 -        (map snd [(p',t')\<leftarrow>l#ls . p'=pc+1] ++_f x)"
  18.219 -        by simp
  18.220 -      ultimately
  18.221 -      show ?thesis using True by simp
  18.222 -    next
  18.223 -      case False 
  18.224 -      moreover
  18.225 -      from ls have "set (map snd [(p', t')\<leftarrow>ls . p' = Suc pc]) \<subseteq> A" by auto
  18.226 -      ultimately show ?thesis by auto
  18.227 -    qed
  18.228 -  finally show "?P (l#ls) x" .
  18.229 -qed
  18.230 -
  18.231 -lemma (in lbv) merge_not_top_s:
  18.232 -  assumes x:  "x \<in> A" and ss: "snd`set ss \<subseteq> A"
  18.233 -  assumes m:  "merge c pc ss x \<noteq> \<top>"
  18.234 -  shows "merge c pc ss x = (map snd [(p',t') \<leftarrow> ss. p'=pc+1] ++_f x)"
  18.235 -proof -
  18.236 -  from ss m have "\<forall>(pc',s') \<in> set ss. (pc' \<noteq> pc+1 \<longrightarrow> s' <=_r c!pc')" 
  18.237 -    by (rule merge_not_top)
  18.238 -  with x ss m show ?thesis by - (drule merge_def, auto split: split_if_asm)
  18.239 -qed
  18.240 -
  18.241 -section "wtl-inst-list"
  18.242 -
  18.243 -lemmas [iff] = not_Err_eq
  18.244 -
  18.245 -lemma (in lbv) wtl_Nil [simp]: "wtl [] c pc s = s" 
  18.246 -  by (simp add: wtl_def)
  18.247 -
  18.248 -lemma (in lbv) wtl_Cons [simp]: 
  18.249 -  "wtl (i#is) c pc s = 
  18.250 -  (let s' = wtc c pc s in if s' = \<top> \<or> s = \<top> then \<top> else wtl is c (pc+1) s')"
  18.251 -  by (simp add: wtl_def wtc_def)
  18.252 -
  18.253 -lemma (in lbv) wtl_Cons_not_top:
  18.254 -  "wtl (i#is) c pc s \<noteq> \<top> = 
  18.255 -  (wtc c pc s \<noteq> \<top> \<and> s \<noteq> T \<and> wtl is c (pc+1) (wtc c pc s) \<noteq> \<top>)"
  18.256 -  by (auto simp del: split_paired_Ex)
  18.257 -
  18.258 -lemma (in lbv) wtl_top [simp]:  "wtl ls c pc \<top> = \<top>"
  18.259 -  by (cases ls) auto
  18.260 -
  18.261 -lemma (in lbv) wtl_not_top:
  18.262 -  "wtl ls c pc s \<noteq> \<top> \<Longrightarrow> s \<noteq> \<top>"
  18.263 -  by (cases "s=\<top>") auto
  18.264 -
  18.265 -lemma (in lbv) wtl_append [simp]:
  18.266 -  "\<And>pc s. wtl (a@b) c pc s = wtl b c (pc+length a) (wtl a c pc s)"
  18.267 -  by (induct a) auto
  18.268 -
  18.269 -lemma (in lbv) wtl_take:
  18.270 -  "wtl is c pc s \<noteq> \<top> \<Longrightarrow> wtl (take pc' is) c pc s \<noteq> \<top>"
  18.271 -  (is "?wtl is \<noteq> _ \<Longrightarrow> _")
  18.272 -proof -
  18.273 -  assume "?wtl is \<noteq> \<top>"
  18.274 -  hence "?wtl (take pc' is @ drop pc' is) \<noteq> \<top>" by simp  
  18.275 -  thus ?thesis by (auto dest!: wtl_not_top simp del: append_take_drop_id)
  18.276 -qed
  18.277 -
  18.278 -lemma take_Suc:
  18.279 -  "\<forall>n. n < length l \<longrightarrow> take (Suc n) l = (take n l)@[l!n]" (is "?P l")
  18.280 -proof (induct l)
  18.281 -  show "?P []" by simp
  18.282 -next
  18.283 -  fix x xs assume IH: "?P xs"  
  18.284 -  show "?P (x#xs)"
  18.285 -  proof (intro strip)
  18.286 -    fix n assume "n < length (x#xs)"
  18.287 -    with IH show "take (Suc n) (x # xs) = take n (x # xs) @ [(x # xs) ! n]" 
  18.288 -      by (cases n, auto)
  18.289 -  qed
  18.290 -qed
  18.291 -
  18.292 -lemma (in lbv) wtl_Suc:
  18.293 -  assumes suc: "pc+1 < length is"
  18.294 -  assumes wtl: "wtl (take pc is) c 0 s \<noteq> \<top>"
  18.295 -  shows "wtl (take (pc+1) is) c 0 s = wtc c pc (wtl (take pc is) c 0 s)"
  18.296 -proof -
  18.297 -  from suc have "take (pc+1) is=(take pc is)@[is!pc]" by (simp add: take_Suc)
  18.298 -  with suc wtl show ?thesis by (simp add: min_max.inf_absorb2)
  18.299 -qed
  18.300 -
  18.301 -lemma (in lbv) wtl_all:
  18.302 -  assumes all: "wtl is c 0 s \<noteq> \<top>" (is "?wtl is \<noteq> _") 
  18.303 -  assumes pc:  "pc < length is"
  18.304 -  shows  "wtc c pc (wtl (take pc is) c 0 s) \<noteq> \<top>"
  18.305 -proof -
  18.306 -  from pc have "0 < length (drop pc is)" by simp
  18.307 -  then  obtain i r where Cons: "drop pc is = i#r" 
  18.308 -    by (auto simp add: neq_Nil_conv simp del: length_drop drop_eq_Nil)
  18.309 -  hence "i#r = drop pc is" ..
  18.310 -  with all have take: "?wtl (take pc is@i#r) \<noteq> \<top>" by simp 
  18.311 -  from pc have "is!pc = drop pc is ! 0" by simp
  18.312 -  with Cons have "is!pc = i" by simp
  18.313 -  with take pc show ?thesis by (auto simp add: min_max.inf_absorb2)
  18.314 -qed
  18.315 -
  18.316 -section "preserves-type"
  18.317 -
  18.318 -lemma (in lbv) merge_pres:
  18.319 -  assumes s0: "snd`set ss \<subseteq> A" and x: "x \<in> A"
  18.320 -  shows "merge c pc ss x \<in> A"
  18.321 -proof -
  18.322 -  from s0 have "set (map snd [(p', t')\<leftarrow>ss . p'=pc+1]) \<subseteq> A" by auto
  18.323 -  with x  have "(map snd [(p', t')\<leftarrow>ss . p'=pc+1] ++_f x) \<in> A"
  18.324 -    by (auto intro!: plusplus_closed semilat)
  18.325 -  with s0 x show ?thesis by (simp add: merge_def T_A)
  18.326 -qed
  18.327 -  
  18.328 -
  18.329 -lemma pres_typeD2:
  18.330 -  "pres_type step n A \<Longrightarrow> s \<in> A \<Longrightarrow> p < n \<Longrightarrow> snd`set (step p s) \<subseteq> A"
  18.331 -  by auto (drule pres_typeD)
  18.332 -
  18.333 -
  18.334 -lemma (in lbv) wti_pres [intro?]:
  18.335 -  assumes pres: "pres_type step n A" 
  18.336 -  assumes cert: "c!(pc+1) \<in> A"
  18.337 -  assumes s_pc: "s \<in> A" "pc < n"
  18.338 -  shows "wti c pc s \<in> A"
  18.339 -proof -
  18.340 -  from pres s_pc have "snd`set (step pc s) \<subseteq> A" by (rule pres_typeD2)
  18.341 -  with cert show ?thesis by (simp add: wti merge_pres)
  18.342 -qed
  18.343 -
  18.344 -
  18.345 -lemma (in lbv) wtc_pres:
  18.346 -  assumes pres: "pres_type step n A"
  18.347 -  assumes cert: "c!pc \<in> A" and cert': "c!(pc+1) \<in> A"
  18.348 -  assumes s: "s \<in> A" and pc: "pc < n"
  18.349 -  shows "wtc c pc s \<in> A"
  18.350 -proof -
  18.351 -  have "wti c pc s \<in> A" using pres cert' s pc ..
  18.352 -  moreover have "wti c pc (c!pc) \<in> A" using pres cert' cert pc ..
  18.353 -  ultimately show ?thesis using T_A by (simp add: wtc) 
  18.354 -qed
  18.355 -
  18.356 -
  18.357 -lemma (in lbv) wtl_pres:
  18.358 -  assumes pres: "pres_type step (length is) A"
  18.359 -  assumes cert: "cert_ok c (length is) \<top> \<bottom> A"
  18.360 -  assumes s:    "s \<in> A" 
  18.361 -  assumes all:  "wtl is c 0 s \<noteq> \<top>"
  18.362 -  shows "pc < length is \<Longrightarrow> wtl (take pc is) c 0 s \<in> A"
  18.363 -  (is "?len pc \<Longrightarrow> ?wtl pc \<in> A")
  18.364 -proof (induct pc)
  18.365 -  from s show "?wtl 0 \<in> A" by simp
  18.366 -next
  18.367 -  fix n assume IH: "Suc n < length is"
  18.368 -  then have n: "n < length is" by simp  
  18.369 -  from IH have n1: "n+1 < length is" by simp
  18.370 -  assume prem: "n < length is \<Longrightarrow> ?wtl n \<in> A"
  18.371 -  have "wtc c n (?wtl n) \<in> A"
  18.372 -  using pres _ _ _ n
  18.373 -  proof (rule wtc_pres)
  18.374 -    from prem n show "?wtl n \<in> A" .
  18.375 -    from cert n show "c!n \<in> A" by (rule cert_okD1)
  18.376 -    from cert n1 show "c!(n+1) \<in> A" by (rule cert_okD1)
  18.377 -  qed
  18.378 -  also
  18.379 -  from all n have "?wtl n \<noteq> \<top>" by - (rule wtl_take)
  18.380 -  with n1 have "wtc c n (?wtl n) = ?wtl (n+1)" by (rule wtl_Suc [symmetric])
  18.381 -  finally  show "?wtl (Suc n) \<in> A" by simp
  18.382 -qed
  18.383 -
  18.384 -end
    19.1 --- a/src/HOL/MicroJava/BV/Listn.thy	Wed Dec 02 12:04:07 2009 +0100
    19.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    19.3 @@ -1,544 +0,0 @@
    19.4 -(*  Title:      HOL/MicroJava/BV/Listn.thy
    19.5 -    Author:     Tobias Nipkow
    19.6 -    Copyright   2000 TUM
    19.7 -
    19.8 -Lists of a fixed length
    19.9 -*)
   19.10 -
   19.11 -header {* \isaheader{Fixed Length Lists} *}
   19.12 -
   19.13 -theory Listn
   19.14 -imports Err
   19.15 -begin
   19.16 -
   19.17 -constdefs
   19.18 -
   19.19 - list :: "nat \<Rightarrow> 'a set \<Rightarrow> 'a list set"
   19.20 -"list n A == {xs. length xs = n & set xs <= A}"
   19.21 -
   19.22 - le :: "'a ord \<Rightarrow> ('a list)ord"
   19.23 -"le r == list_all2 (%x y. x <=_r y)"
   19.24 -
   19.25 -syntax "@lesublist" :: "'a list \<Rightarrow> 'a ord \<Rightarrow> 'a list \<Rightarrow> bool"
   19.26 -       ("(_ /<=[_] _)" [50, 0, 51] 50)
   19.27 -syntax "@lesssublist" :: "'a list \<Rightarrow> 'a ord \<Rightarrow> 'a list \<Rightarrow> bool"
   19.28 -       ("(_ /<[_] _)" [50, 0, 51] 50)
   19.29 -translations
   19.30 - "x <=[r] y" == "x <=_(Listn.le r) y"
   19.31 - "x <[r] y"  == "x <_(Listn.le r) y"
   19.32 -
   19.33 -constdefs
   19.34 - map2 :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'a list \<Rightarrow> 'b list \<Rightarrow> 'c list"
   19.35 -"map2 f == (%xs ys. map (split f) (zip xs ys))"
   19.36 -
   19.37 -syntax "@plussublist" :: "'a list \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'b list \<Rightarrow> 'c list"
   19.38 -       ("(_ /+[_] _)" [65, 0, 66] 65)
   19.39 -translations  "x +[f] y" == "x +_(map2 f) y"
   19.40 -
   19.41 -consts coalesce :: "'a err list \<Rightarrow> 'a list err"
   19.42 -primrec
   19.43 -"coalesce [] = OK[]"
   19.44 -"coalesce (ex#exs) = Err.sup (op #) ex (coalesce exs)"
   19.45 -
   19.46 -constdefs
   19.47 - sl :: "nat \<Rightarrow> 'a sl \<Rightarrow> 'a list sl"
   19.48 -"sl n == %(A,r,f). (list n A, le r, map2 f)"
   19.49 -
   19.50 - sup :: "('a \<Rightarrow> 'b \<Rightarrow> 'c err) \<Rightarrow> 'a list \<Rightarrow> 'b list \<Rightarrow> 'c list err"
   19.51 -"sup f == %xs ys. if size xs = size ys then coalesce(xs +[f] ys) else Err"
   19.52 -
   19.53 - upto_esl :: "nat \<Rightarrow> 'a esl \<Rightarrow> 'a list esl"
   19.54 -"upto_esl m == %(A,r,f). (Union{list n A |n. n <= m}, le r, sup f)"
   19.55 -
   19.56 -lemmas [simp] = set_update_subsetI
   19.57 -
   19.58 -lemma unfold_lesub_list:
   19.59 -  "xs <=[r] ys == Listn.le r xs ys"
   19.60 -  by (simp add: lesub_def)
   19.61 -
   19.62 -lemma Nil_le_conv [iff]:
   19.63 -  "([] <=[r] ys) = (ys = [])"
   19.64 -apply (unfold lesub_def Listn.le_def)
   19.65 -apply simp
   19.66 -done
   19.67 -
   19.68 -lemma Cons_notle_Nil [iff]: 
   19.69 -  "~ x#xs <=[r] []"
   19.70 -apply (unfold lesub_def Listn.le_def)
   19.71 -apply simp
   19.72 -done
   19.73 -
   19.74 -
   19.75 -lemma Cons_le_Cons [iff]:
   19.76 -  "x#xs <=[r] y#ys = (x <=_r y & xs <=[r] ys)"
   19.77 -apply (unfold lesub_def Listn.le_def)
   19.78 -apply simp
   19.79 -done
   19.80 -
   19.81 -lemma Cons_less_Conss [simp]:
   19.82 -  "order r \<Longrightarrow> 
   19.83 -  x#xs <_(Listn.le r) y#ys = 
   19.84 -  (x <_r y & xs <=[r] ys  |  x = y & xs <_(Listn.le r) ys)"
   19.85 -apply (unfold lesssub_def)
   19.86 -apply blast
   19.87 -done  
   19.88 -
   19.89 -lemma list_update_le_cong:
   19.90 -  "\<lbrakk> i<size xs; xs <=[r] ys; x <=_r y \<rbrakk> \<Longrightarrow> xs[i:=x] <=[r] ys[i:=y]";
   19.91 -apply (unfold unfold_lesub_list)
   19.92 -apply (unfold Listn.le_def)
   19.93 -apply (simp add: list_all2_conv_all_nth nth_list_update)
   19.94 -done
   19.95 -
   19.96 -
   19.97 -lemma le_listD:
   19.98 -  "\<lbrakk> xs <=[r] ys; p < size xs \<rbrakk> \<Longrightarrow> xs!p <=_r ys!p"
   19.99 -apply (unfold Listn.le_def lesub_def)
  19.100 -apply (simp add: list_all2_conv_all_nth)
  19.101 -done
  19.102 -
  19.103 -lemma le_list_refl:
  19.104 -  "!x. x <=_r x \<Longrightarrow> xs <=[r] xs"
  19.105 -apply (unfold unfold_lesub_list)
  19.106 -apply (simp add: Listn.le_def list_all2_conv_all_nth)
  19.107 -done
  19.108 -
  19.109 -lemma le_list_trans:
  19.110 -  "\<lbrakk> order r; xs <=[r] ys; ys <=[r] zs \<rbrakk> \<Longrightarrow> xs <=[r] zs"
  19.111 -apply (unfold unfold_lesub_list)
  19.112 -apply (simp add: Listn.le_def list_all2_conv_all_nth)
  19.113 -apply clarify
  19.114 -apply simp
  19.115 -apply (blast intro: order_trans)
  19.116 -done
  19.117 -
  19.118 -lemma le_list_antisym:
  19.119 -  "\<lbrakk> order r; xs <=[r] ys; ys <=[r] xs \<rbrakk> \<Longrightarrow> xs = ys"
  19.120 -apply (unfold unfold_lesub_list)
  19.121 -apply (simp add: Listn.le_def list_all2_conv_all_nth)
  19.122 -apply (rule nth_equalityI)
  19.123 - apply blast
  19.124 -apply clarify
  19.125 -apply simp
  19.126 -apply (blast intro: order_antisym)
  19.127 -done
  19.128 -
  19.129 -lemma order_listI [simp, intro!]:
  19.130 -  "order r \<Longrightarrow> order(Listn.le r)"
  19.131 -apply (subst Semilat.order_def)
  19.132 -apply (blast intro: le_list_refl le_list_trans le_list_antisym
  19.133 -             dest: order_refl)
  19.134 -done
  19.135 -
  19.136 -
  19.137 -lemma lesub_list_impl_same_size [simp]:
  19.138 -  "xs <=[r] ys \<Longrightarrow> size ys = size xs"  
  19.139 -apply (unfold Listn.le_def lesub_def)
  19.140 -apply (simp add: list_all2_conv_all_nth)
  19.141 -done 
  19.142 -
  19.143 -lemma lesssub_list_impl_same_size:
  19.144 -  "xs <_(Listn.le r) ys \<Longrightarrow> size ys = size xs"
  19.145 -apply (unfold lesssub_def)
  19.146 -apply auto
  19.147 -done  
  19.148 -
  19.149 -lemma le_list_appendI:
  19.150 -  "\<And>b c d. a <=[r] b \<Longrightarrow> c <=[r] d \<Longrightarrow> a@c <=[r] b@d"
  19.151 -apply (induct a)
  19.152 - apply simp
  19.153 -apply (case_tac b)
  19.154 -apply auto
  19.155 -done
  19.156 -
  19.157 -lemma le_listI:
  19.158 -  "length a = length b \<Longrightarrow> (\<And>n. n < length a \<Longrightarrow> a!n <=_r b!n) \<Longrightarrow> a <=[r] b"
  19.159 -  apply (unfold lesub_def Listn.le_def)
  19.160 -  apply (simp add: list_all2_conv_all_nth)
  19.161 -  done
  19.162 -
  19.163 -lemma listI:
  19.164 -  "\<lbrakk> length xs = n; set xs <= A \<rbrakk> \<Longrightarrow> xs : list n A"
  19.165 -apply (unfold list_def)
  19.166 -apply blast
  19.167 -done
  19.168 -
  19.169 -lemma listE_length [simp]:
  19.170 -   "xs : list n A \<Longrightarrow> length xs = n"
  19.171 -apply (unfold list_def)
  19.172 -apply blast
  19.173 -done 
  19.174 -
  19.175 -lemma less_lengthI:
  19.176 -  "\<lbrakk> xs : list n A; p < n \<rbrakk> \<Longrightarrow> p < length xs"
  19.177 -  by simp
  19.178 -
  19.179 -lemma listE_set [simp]:
  19.180 -  "xs : list n A \<Longrightarrow> set xs <= A"
  19.181 -apply (unfold list_def)
  19.182 -apply blast
  19.183 -done 
  19.184 -
  19.185 -lemma list_0 [simp]:
  19.186 -  "list 0 A = {[]}"
  19.187 -apply (unfold list_def)
  19.188 -apply auto
  19.189 -done 
  19.190 -
  19.191 -lemma in_list_Suc_iff: 
  19.192 -  "(xs : list (Suc n) A) = (\<exists>y\<in> A. \<exists>ys\<in> list n A. xs = y#ys)"
  19.193 -apply (unfold list_def)
  19.194 -apply (case_tac "xs")
  19.195 -apply auto
  19.196 -done 
  19.197 -
  19.198 -lemma Cons_in_list_Suc [iff]:
  19.199 -  "(x#xs : list (Suc n) A) = (x\<in> A & xs : list n A)";
  19.200 -apply (simp add: in_list_Suc_iff)
  19.201 -done 
  19.202 -
  19.203 -lemma list_not_empty:
  19.204 -  "\<exists>a. a\<in> A \<Longrightarrow> \<exists>xs. xs : list n A";
  19.205 -apply (induct "n")
  19.206 - apply simp
  19.207 -apply (simp add: in_list_Suc_iff)
  19.208 -apply blast
  19.209 -done
  19.210 -
  19.211 -
  19.212 -lemma nth_in [rule_format, simp]:
  19.213 -  "!i n. length xs = n \<longrightarrow> set xs <= A \<longrightarrow> i < n \<longrightarrow> (xs!i) : A"
  19.214 -apply (induct "xs")
  19.215 - apply simp
  19.216 -apply (simp add: nth_Cons split: nat.split)
  19.217 -done
  19.218 -
  19.219 -lemma listE_nth_in:
  19.220 -  "\<lbrakk> xs : list n A; i < n \<rbrakk> \<Longrightarrow> (xs!i) : A"
  19.221 -  by auto
  19.222 -
  19.223 -
  19.224 -lemma listn_Cons_Suc [elim!]:
  19.225 -  "l#xs \<in> list n A \<Longrightarrow> (\<And>n'. n = Suc n' \<Longrightarrow> l \<in> A \<Longrightarrow> xs \<in> list n' A \<Longrightarrow> P) \<Longrightarrow> P"
  19.226 -  by (cases n) auto
  19.227 -
  19.228 -lemma listn_appendE [elim!]:
  19.229 -  "a@b \<in> list n A \<Longrightarrow> (\<And>n1 n2. n=n1+n2 \<Longrightarrow> a \<in> list n1 A \<Longrightarrow> b \<in> list n2 A \<Longrightarrow> P) \<Longrightarrow> P" 
  19.230 -proof -
  19.231 -  have "\<And>n. a@b \<in> list n A \<Longrightarrow> \<exists>n1 n2. n=n1+n2 \<and> a \<in> list n1 A \<and> b \<in> list n2 A"
  19.232 -    (is "\<And>n. ?list a n \<Longrightarrow> \<exists>n1 n2. ?P a n n1 n2")
  19.233 -  proof (induct a)
  19.234 -    fix n assume "?list [] n"
  19.235 -    hence "?P [] n 0 n" by simp
  19.236 -    thus "\<exists>n1 n2. ?P [] n n1 n2" by fast
  19.237 -  next
  19.238 -    fix n l ls
  19.239 -    assume "?list (l#ls) n"
  19.240 -    then obtain n' where n: "n = Suc n'" "l \<in> A" and list_n': "ls@b \<in> list n' A" by fastsimp
  19.241 -    assume "\<And>n. ls @ b \<in> list n A \<Longrightarrow> \<exists>n1 n2. n = n1 + n2 \<and> ls \<in> list n1 A \<and> b \<in> list n2 A"
  19.242 -    hence "\<exists>n1 n2. n' = n1 + n2 \<and> ls \<in> list n1 A \<and> b \<in> list n2 A" by this (rule list_n')
  19.243 -    then obtain n1 n2 where "n' = n1 + n2" "ls \<in> list n1 A" "b \<in> list n2 A" by fast
  19.244 -    with n have "?P (l#ls) n (n1+1) n2" by simp
  19.245 -    thus "\<exists>n1 n2. ?P (l#ls) n n1 n2" by fastsimp
  19.246 -  qed
  19.247 -  moreover
  19.248 -  assume "a@b \<in> list n A" "\<And>n1 n2. n=n1+n2 \<Longrightarrow> a \<in> list n1 A \<Longrightarrow> b \<in> list n2 A \<Longrightarrow> P"
  19.249 -  ultimately
  19.250 -  show ?thesis by blast
  19.251 -qed
  19.252 -
  19.253 -
  19.254 -lemma listt_update_in_list [simp, intro!]:
  19.255 -  "\<lbrakk> xs : list n A; x\<in> A \<rbrakk> \<Longrightarrow> xs[i := x] : list n A"
  19.256 -apply (unfold list_def)
  19.257 -apply simp
  19.258 -done 
  19.259 -
  19.260 -lemma plus_list_Nil [simp]:
  19.261 -  "[] +[f] xs = []"
  19.262 -apply (unfold plussub_def map2_def)
  19.263 -apply simp
  19.264 -done 
  19.265 -
  19.266 -lemma plus_list_Cons [simp]:
  19.267 -  "(x#xs) +[f] ys = (case ys of [] \<Rightarrow> [] | y#ys \<Rightarrow> (x +_f y)#(xs +[f] ys))"
  19.268 -  by (simp add: plussub_def map2_def split: list.split)
  19.269 -
  19.270 -lemma length_plus_list [rule_format, simp]:
  19.271 -  "!ys. length(xs +[f] ys) = min(length xs) (length ys)"
  19.272 -apply (induct xs)
  19.273 - apply simp
  19.274 -apply clarify
  19.275 -apply (simp (no_asm_simp) split: list.split)
  19.276 -done
  19.277 -
  19.278 -lemma nth_plus_list [rule_format, simp]:
  19.279 -  "!xs ys i. length xs = n \<longrightarrow> length ys = n \<longrightarrow> i<n \<longrightarrow> 
  19.280 -  (xs +[f] ys)!i = (xs!i) +_f (ys!i)"
  19.281 -apply (induct n)
  19.282 - apply simp
  19.283 -apply clarify
  19.284 -apply (case_tac xs)
  19.285 - apply simp
  19.286 -apply (force simp add: nth_Cons split: list.split nat.split)
  19.287 -done
  19.288 -
  19.289 -
  19.290 -lemma (in Semilat) plus_list_ub1 [rule_format]:
  19.291 - "\<lbrakk> set xs <= A; set ys <= A; size xs = size ys \<rbrakk> 
  19.292 -  \<Longrightarrow> xs <=[r] xs +[f] ys"
  19.293 -apply (unfold unfold_lesub_list)
  19.294 -apply (simp add: Listn.le_def list_all2_conv_all_nth)
  19.295 -done
  19.296 -
  19.297 -lemma (in Semilat) plus_list_ub2:
  19.298 - "\<lbrakk>set xs <= A; set ys <= A; size xs = size ys \<rbrakk>
  19.299 -  \<Longrightarrow> ys <=[r] xs +[f] ys"
  19.300 -apply (unfold unfold_lesub_list)
  19.301 -apply (simp add: Listn.le_def list_all2_conv_all_nth)
  19.302 -done
  19.303 -
  19.304 -lemma (in Semilat) plus_list_lub [rule_format]:
  19.305 -shows "!xs ys zs. set xs <= A \<longrightarrow> set ys <= A \<longrightarrow> set zs <= A 
  19.306 -  \<longrightarrow> size xs = n & size ys = n \<longrightarrow> 
  19.307 -  xs <=[r] zs & ys <=[r] zs \<longrightarrow> xs +[f] ys <=[r] zs"
  19.308 -apply (unfold unfold_lesub_list)
  19.309 -apply (simp add: Listn.le_def list_all2_conv_all_nth)
  19.310 -done
  19.311 -
  19.312 -lemma (in Semilat) list_update_incr [rule_format]:
  19.313 - "x\<in> A \<Longrightarrow> set xs <= A \<longrightarrow> 
  19.314 -  (!i. i<size xs \<longrightarrow> xs <=[r] xs[i := x +_f xs!i])"
  19.315 -apply (unfold unfold_lesub_list)
  19.316 -apply (simp add: Listn.le_def list_all2_conv_all_nth)
  19.317 -apply (induct xs)
  19.318 - apply simp
  19.319 -apply (simp add: in_list_Suc_iff)
  19.320 -apply clarify
  19.321 -apply (simp add: nth_Cons split: nat.split)
  19.322 -done
  19.323 -
  19.324 -lemma equals0I_aux:
  19.325 -  "(\<And>y. A y \<Longrightarrow> False) \<Longrightarrow> A = bot_class.bot"
  19.326 -  by (rule equals0I) (auto simp add: mem_def)
  19.327 -
  19.328 -lemma acc_le_listI [intro!]:
  19.329 -  "\<lbrakk> order r; acc r \<rbrakk> \<Longrightarrow> acc(Listn.le r)"
  19.330 -apply (unfold acc_def)
  19.331 -apply (subgoal_tac
  19.332 - "wfP (SUP n. (\<lambda>ys xs. size xs = n & size ys = n & xs <_(Listn.le r) ys))")
  19.333 - apply (erule wfP_subset)
  19.334 - apply (blast intro: lesssub_list_impl_same_size)
  19.335 -apply (rule wfP_SUP)
  19.336 - prefer 2
  19.337 - apply clarify
  19.338 - apply (rename_tac m n)
  19.339 - apply (case_tac "m=n")
  19.340 -  apply simp
  19.341 - apply (fast intro!: equals0I_aux dest: not_sym)
  19.342 -apply clarify
  19.343 -apply (rename_tac n)
  19.344 -apply (induct_tac n)
  19.345 - apply (simp add: lesssub_def cong: conj_cong)
  19.346 -apply (rename_tac k)
  19.347 -apply (simp add: wfP_eq_minimal)
  19.348 -apply (simp (no_asm) add: length_Suc_conv cong: conj_cong)
  19.349 -apply clarify
  19.350 -apply (rename_tac M m)
  19.351 -apply (case_tac "\<exists>x xs. size xs = k & x#xs : M")
  19.352 - prefer 2
  19.353 - apply (erule thin_rl)
  19.354 - apply (erule thin_rl)
  19.355 - apply blast
  19.356 -apply (erule_tac x = "{a. \<exists>xs. size xs = k & a#xs:M}" in allE)
  19.357 -apply (erule impE)
  19.358 - apply blast
  19.359 -apply (thin_tac "\<exists>x xs. ?P x xs")
  19.360 -apply clarify
  19.361 -apply (rename_tac maxA xs)
  19.362 -apply (erule_tac x = "{ys. size ys = size xs & maxA#ys : M}" in allE)
  19.363 -apply (erule impE)
  19.364 - apply blast
  19.365 -apply clarify
  19.366 -apply (thin_tac "m : M")
  19.367 -apply (thin_tac "maxA#xs : M")
  19.368 -apply (rule bexI)
  19.369 - prefer 2
  19.370 - apply assumption
  19.371 -apply clarify
  19.372 -apply simp
  19.373 -apply blast
  19.374 -done 
  19.375 -
  19.376 -lemma closed_listI:
  19.377 -  "closed S f \<Longrightarrow> closed (list n S) (map2 f)"
  19.378 -apply (unfold closed_def)
  19.379 -apply (induct n)
  19.380 - apply simp
  19.381 -apply clarify
  19.382 -apply (simp add: in_list_Suc_iff)
  19.383 -apply clarify
  19.384 -apply simp
  19.385 -done
  19.386 -
  19.387 -
  19.388 -lemma Listn_sl_aux:
  19.389 -assumes "semilat (A, r, f)" shows "semilat (Listn.sl n (A,r,f))"
  19.390 -proof -
  19.391 -  interpret Semilat A r f using assms by (rule Semilat.intro)
  19.392 -show ?thesis
  19.393 -apply (unfold Listn.sl_def)
  19.394 -apply (simp (no_asm) only: semilat_Def split_conv)
  19.395 -apply (rule conjI)
  19.396 - apply simp
  19.397 -apply (rule conjI)
  19.398 - apply (simp only: closedI closed_listI)
  19.399 -apply (simp (no_asm) only: list_def)
  19.400 -apply (simp (no_asm_simp) add: plus_list_ub1 plus_list_ub2 plus_list_lub)
  19.401 -done
  19.402 -qed
  19.403 -
  19.404 -lemma Listn_sl: "\<And>L. semilat L \<Longrightarrow> semilat (Listn.sl n L)"
  19.405 - by(simp add: Listn_sl_aux split_tupled_all)
  19.406 -
  19.407 -lemma coalesce_in_err_list [rule_format]:
  19.408 -  "!xes. xes : list n (err A) \<longrightarrow> coalesce xes : err(list n A)"
  19.409 -apply (induct n)
  19.410 - apply simp
  19.411 -apply clarify
  19.412 -apply (simp add: in_list_Suc_iff)
  19.413 -apply clarify
  19.414 -apply (simp (no_asm) add: plussub_def Err.sup_def lift2_def split: err.split)
  19.415 -apply force
  19.416 -done 
  19.417 -
  19.418 -lemma lem: "\<And>x xs. x +_(op #) xs = x#xs"
  19.419 -  by (simp add: plussub_def)
  19.420 -
  19.421 -lemma coalesce_eq_OK1_D [rule_format]:
  19.422 -  "semilat(err A, Err.le r, lift2 f) \<Longrightarrow> 
  19.423 -  !xs. xs : list n A \<longrightarrow> (!ys. ys : list n A \<longrightarrow> 
  19.424 -  (!zs. coalesce (xs +[f] ys) = OK zs \<longrightarrow> xs <=[r] zs))"
  19.425 -apply (induct n)
  19.426 -  apply simp
  19.427 -apply clarify
  19.428 -apply (simp add: in_list_Suc_iff)
  19.429 -apply clarify
  19.430 -apply (simp split: err.split_asm add: lem Err.sup_def lift2_def)
  19.431 -apply (force simp add: semilat_le_err_OK1)
  19.432 -done
  19.433 -
  19.434 -lemma coalesce_eq_OK2_D [rule_format]:
  19.435 -  "semilat(err A, Err.le r, lift2 f) \<Longrightarrow> 
  19.436 -  !xs. xs : list n A \<longrightarrow> (!ys. ys : list n A \<longrightarrow> 
  19.437 -  (!zs. coalesce (xs +[f] ys) = OK zs \<longrightarrow> ys <=[r] zs))"
  19.438 -apply (induct n)
  19.439 - apply simp
  19.440 -apply clarify
  19.441 -apply (simp add: in_list_Suc_iff)
  19.442 -apply clarify
  19.443 -apply (simp split: err.split_asm add: lem Err.sup_def lift2_def)
  19.444 -apply (force simp add: semilat_le_err_OK2)
  19.445 -done 
  19.446 -
  19.447 -lemma lift2_le_ub:
  19.448 -  "\<lbrakk> semilat(err A, Err.le r, lift2 f); x\<in> A; y\<in> A; x +_f y = OK z; 
  19.449 -      u\<in> A; x <=_r u; y <=_r u \<rbrakk> \<Longrightarrow> z <=_r u"
  19.450 -apply (unfold semilat_Def plussub_def err_def)
  19.451 -apply (simp add: lift2_def)
  19.452 -apply clarify
  19.453 -apply (rotate_tac -3)
  19.454 -apply (erule thin_rl)
  19.455 -apply (erule thin_rl)
  19.456 -apply force
  19.457 -done
  19.458 -
  19.459 -lemma coalesce_eq_OK_ub_D [rule_format]:
  19.460 -  "semilat(err A, Err.le r, lift2 f) \<Longrightarrow> 
  19.461 -  !xs. xs : list n A \<longrightarrow> (!ys. ys : list n A \<longrightarrow> 
  19.462 -  (!zs us. coalesce (xs +[f] ys) = OK zs & xs <=[r] us & ys <=[r] us 
  19.463 -           & us : list n A \<longrightarrow> zs <=[r] us))"
  19.464 -apply (induct n)
  19.465 - apply simp
  19.466 -apply clarify
  19.467 -apply (simp add: in_list_Suc_iff)
  19.468 -apply clarify
  19.469 -apply (simp (no_asm_use) split: err.split_asm add: lem Err.sup_def lift2_def)
  19.470 -apply clarify
  19.471 -apply (rule conjI)
  19.472 - apply (blast intro: lift2_le_ub)
  19.473 -apply blast
  19.474 -done 
  19.475 -
  19.476 -lemma lift2_eq_ErrD:
  19.477 -  "\<lbrakk> x +_f y = Err; semilat(err A, Err.le r, lift2 f); x\<in> A; y\<in> A \<rbrakk> 
  19.478 -  \<Longrightarrow> ~(\<exists>u\<in> A. x <=_r u & y <=_r u)"
  19.479 -  by (simp add: OK_plus_OK_eq_Err_conv [THEN iffD1])
  19.480 -
  19.481 -
  19.482 -lemma coalesce_eq_Err_D [rule_format]:
  19.483 -  "\<lbrakk> semilat(err A, Err.le r, lift2 f) \<rbrakk> 
  19.484 -  \<Longrightarrow> !xs. xs\<in> list n A \<longrightarrow> (!ys. ys\<in> list n A \<longrightarrow> 
  19.485 -      coalesce (xs +[f] ys) = Err \<longrightarrow> 
  19.486 -      ~(\<exists>zs\<in> list n A. xs <=[r] zs & ys <=[r] zs))"
  19.487 -apply (induct n)
  19.488 - apply simp
  19.489 -apply clarify
  19.490 -apply (simp add: in_list_Suc_iff)
  19.491 -apply clarify
  19.492 -apply (simp split: err.split_asm add: lem Err.sup_def lift2_def)
  19.493 - apply (blast dest: lift2_eq_ErrD)
  19.494 -done 
  19.495 -
  19.496 -lemma closed_err_lift2_conv:
  19.497 -  "closed (err A) (lift2 f) = (\<forall>x\<in> A. \<forall>y\<in> A. x +_f y : err A)"
  19.498 -apply (unfold closed_def)
  19.499 -apply (simp add: err_def)
  19.500 -done 
  19.501 -
  19.502 -lemma closed_map2_list [rule_format]:
  19.503 -  "closed (err A) (lift2 f) \<Longrightarrow> 
  19.504 -  \<forall>xs. xs : list n A \<longrightarrow> (\<forall>ys. ys : list n A \<longrightarrow> 
  19.505 -  map2 f xs ys : list n (err A))"
  19.506 -apply (unfold map2_def)
  19.507 -apply (induct n)
  19.508 - apply simp
  19.509 -apply clarify
  19.510 -apply (simp add: in_list_Suc_iff)
  19.511 -apply clarify
  19.512 -apply (simp add: plussub_def closed_err_lift2_conv)
  19.513 -done
  19.514 -
  19.515 -lemma closed_lift2_sup:
  19.516 -  "closed (err A) (lift2 f) \<Longrightarrow> 
  19.517 -  closed (err (list n A)) (lift2 (sup f))"
  19.518 -  by (fastsimp  simp add: closed_def plussub_def sup_def lift2_def
  19.519 -                          coalesce_in_err_list closed_map2_list
  19.520 -                split: err.split)
  19.521 -
  19.522 -lemma err_semilat_sup:
  19.523 -  "err_semilat (A,r,f) \<Longrightarrow> 
  19.524 -  err_semilat (list n A, Listn.le r, sup f)"
  19.525 -apply (unfold Err.sl_def)
  19.526 -apply (simp only: split_conv)
  19.527 -apply (simp (no_asm) only: semilat_Def plussub_def)
  19.528 -apply (simp (no_asm_simp) only: Semilat.closedI [OF Semilat.intro] closed_lift2_sup)
  19.529 -apply (rule conjI)
  19.530 - apply (drule Semilat.orderI [OF Semilat.intro])
  19.531 - apply simp
  19.532 -apply (simp (no_asm) only: unfold_lesub_err Err.le_def err_def sup_def lift2_def)
  19.533 -apply (simp (no_asm_simp) add: coalesce_eq_OK1_D coalesce_eq_OK2_D split: err.split)
  19.534 -apply (blast intro: coalesce_eq_OK_ub_D dest: coalesce_eq_Err_D)
  19.535 -done 
  19.536 -
  19.537 -lemma err_semilat_upto_esl:
  19.538 -  "\<And>L. err_semilat L \<Longrightarrow> err_semilat(upto_esl m L)"
  19.539 -apply (unfold Listn.upto_esl_def)
  19.540 -apply (simp (no_asm_simp) only: split_tupled_all)
  19.541 -apply simp
  19.542 -apply (fastsimp intro!: err_semilat_UnionI err_semilat_sup
  19.543 -                dest: lesub_list_impl_same_size 
  19.544 -                simp add: plussub_def Listn.sup_def)
  19.545 -done
  19.546 -
  19.547 -end
    20.1 --- a/src/HOL/MicroJava/BV/Opt.thy	Wed Dec 02 12:04:07 2009 +0100
    20.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    20.3 @@ -1,295 +0,0 @@
    20.4 -(*  Title:      HOL/MicroJava/BV/Opt.thy
    20.5 -    ID:         $Id$
    20.6 -    Author:     Tobias Nipkow
    20.7 -    Copyright   2000 TUM
    20.8 -
    20.9 -More about options
   20.10 -*)
   20.11 -
   20.12 -header {* \isaheader{More about Options} *}
   20.13 -
   20.14 -theory Opt
   20.15 -imports Err
   20.16 -begin
   20.17 -
   20.18 -constdefs
   20.19 - le :: "'a ord \<Rightarrow> 'a option ord"
   20.20 -"le r o1 o2 == case o2 of None \<Rightarrow> o1=None |
   20.21 -                              Some y \<Rightarrow> (case o1 of None \<Rightarrow> True
   20.22 -                                                  | Some x \<Rightarrow> x <=_r y)"
   20.23 -
   20.24 - opt :: "'a set \<Rightarrow> 'a option set"
   20.25 -"opt A == insert None {x . ? y:A. x = Some y}"
   20.26 -
   20.27 - sup :: "'a ebinop \<Rightarrow> 'a option ebinop"
   20.28 -"sup f o1 o2 ==  
   20.29 - case o1 of None \<Rightarrow> OK o2 | Some x \<Rightarrow> (case o2 of None \<Rightarrow> OK o1
   20.30 -     | Some y \<Rightarrow> (case f x y of Err \<Rightarrow> Err | OK z \<Rightarrow> OK (Some z)))"
   20.31 -
   20.32 - esl :: "'a esl \<Rightarrow> 'a option esl"
   20.33 -"esl == %(A,r,f). (opt A, le r, sup f)"
   20.34 -
   20.35 -lemma unfold_le_opt:
   20.36 -  "o1 <=_(le r) o2 = 
   20.37 -  (case o2 of None \<Rightarrow> o1=None | 
   20.38 -              Some y \<Rightarrow> (case o1 of None \<Rightarrow> True | Some x \<Rightarrow> x <=_r y))"
   20.39 -apply (unfold lesub_def le_def)
   20.40 -apply (rule refl)
   20.41 -done
   20.42 -
   20.43 -lemma le_opt_refl:
   20.44 -  "order r \<Longrightarrow> o1 <=_(le r) o1"
   20.45 -by (simp add: unfold_le_opt split: option.split)
   20.46 -
   20.47 -lemma le_opt_trans [rule_format]:
   20.48 -  "order r \<Longrightarrow> 
   20.49 -   o1 <=_(le r) o2 \<longrightarrow> o2 <=_(le r) o3 \<longrightarrow> o1 <=_(le r) o3"
   20.50 -apply (simp add: unfold_le_opt split: option.split)
   20.51 -apply (blast intro: order_trans)
   20.52 -done
   20.53 -
   20.54 -lemma le_opt_antisym [rule_format]:
   20.55 -  "order r \<Longrightarrow> o1 <=_(le r) o2 \<longrightarrow> o2 <=_(le r) o1 \<longrightarrow> o1=o2"
   20.56 -apply (simp add: unfold_le_opt split: option.split)
   20.57 -apply (blast intro: order_antisym)
   20.58 -done
   20.59 -
   20.60 -lemma order_le_opt [intro!,simp]:
   20.61 -  "order r \<Longrightarrow> order(le r)"
   20.62 -apply (subst Semilat.order_def)
   20.63 -apply (blast intro: le_opt_refl le_opt_trans le_opt_antisym)
   20.64 -done 
   20.65 -
   20.66 -lemma None_bot [iff]: 
   20.67 -  "None <=_(le r) ox"
   20.68 -apply (unfold lesub_def le_def)
   20.69 -apply (simp split: option.split)
   20.70 -done 
   20.71 -
   20.72 -lemma Some_le [iff]:
   20.73 -  "(Some x <=_(le r) ox) = (? y. ox = Some y & x <=_r y)"
   20.74 -apply (unfold lesub_def le_def)
   20.75 -apply (simp split: option.split)
   20.76 -done 
   20.77 -
   20.78 -lemma le_None [iff]:
   20.79 -  "(ox <=_(le r) None) = (ox = None)";
   20.80 -apply (unfold lesub_def le_def)
   20.81 -apply (simp split: option.split)
   20.82 -done 
   20.83 -
   20.84 -
   20.85 -lemma OK_None_bot [iff]:
   20.86 -  "OK None <=_(Err.le (le r)) x"
   20.87 -  by (simp add: lesub_def Err.le_def le_def split: option.split err.split)
   20.88 -
   20.89 -lemma sup_None1 [iff]:
   20.90 -  "x +_(sup f) None = OK x"
   20.91 -  by (simp add: plussub_def sup_def split: option.split)
   20.92 -
   20.93 -lemma sup_None2 [iff]:
   20.94 -  "None +_(sup f) x = OK x"
   20.95 -  by (simp add: plussub_def sup_def split: option.split)
   20.96 -
   20.97 -
   20.98 -lemma None_in_opt [iff]:
   20.99 -  "None : opt A"
  20.100 -by (simp add: opt_def)
  20.101 -
  20.102 -lemma Some_in_opt [iff]:
  20.103 -  "(Some x : opt A) = (x:A)"
  20.104 -apply (unfold opt_def)
  20.105 -apply auto
  20.106 -done 
  20.107 -
  20.108 -
  20.109 -lemma semilat_opt [intro, simp]:
  20.110 -  "\<And>L. err_semilat L \<Longrightarrow> err_semilat (Opt.esl L)"
  20.111 -proof (unfold Opt.esl_def Err.sl_def, simp add: split_tupled_all)
  20.112 -  
  20.113 -  fix A r f
  20.114 -  assume s: "semilat (err A, Err.le r, lift2 f)"
  20.115 - 
  20.116 -  let ?A0 = "err A"
  20.117 -  let ?r0 = "Err.le r"
  20.118 -  let ?f0 = "lift2 f"
  20.119 -
  20.120 -  from s
  20.121 -  obtain
  20.122 -    ord: "order ?r0" and
  20.123 -    clo: "closed ?A0 ?f0" and
  20.124 -    ub1: "\<forall>x\<in>?A0. \<forall>y\<in>?A0. x <=_?r0 x +_?f0 y" and
  20.125 -    ub2: "\<forall>x\<in>?A0. \<forall>y\<in>?A0. y <=_?r0 x +_?f0 y" and
  20.126 -    lub: "\<forall>x\<in>?A0. \<forall>y\<in>?A0. \<forall>z\<in>?A0. x <=_?r0 z \<and> y <=_?r0 z \<longrightarrow> x +_?f0 y <=_?r0 z"
  20.127 -    by (unfold semilat_def) simp
  20.128 -
  20.129 -  let ?A = "err (opt A)" 
  20.130 -  let ?r = "Err.le (Opt.le r)"
  20.131 -  let ?f = "lift2 (Opt.sup f)"
  20.132 -
  20.133 -  from ord
  20.134 -  have "order ?r"
  20.135 -    by simp
  20.136 -
  20.137 -  moreover
  20.138 -
  20.139 -  have "closed ?A ?f"
  20.140 -  proof (unfold closed_def, intro strip)
  20.141 -    fix x y    
  20.142 -    assume x: "x : ?A" 
  20.143 -    assume y: "y : ?A" 
  20.144 -
  20.145 -    { fix a b
  20.146 -      assume ab: "x = OK a" "y = OK b"
  20.147 -      
  20.148 -      with x 
  20.149 -      have a: "\<And>c. a = Some c \<Longrightarrow> c : A"
  20.150 -        by (clarsimp simp add: opt_def)
  20.151 -
  20.152 -      from ab y
  20.153 -      have b: "\<And>d. b = Some d \<Longrightarrow> d : A"
  20.154 -        by (clarsimp simp add: opt_def)
  20.155 -      
  20.156 -      { fix c d assume "a = Some c" "b = Some d"
  20.157 -        with ab x y
  20.158 -        have "c:A & d:A"
  20.159 -          by (simp add: err_def opt_def Bex_def)
  20.160 -        with clo
  20.161 -        have "f c d : err A"
  20.162 -          by (simp add: closed_def plussub_def err_def lift2_def)
  20.163 -        moreover
  20.164 -        fix z assume "f c d = OK z"
  20.165 -        ultimately
  20.166 -        have "z : A" by simp
  20.167 -      } note f_closed = this    
  20.168 -
  20.169 -      have "sup f a b : ?A"
  20.170 -      proof (cases a)
  20.171 -        case None
  20.172 -        thus ?thesis
  20.173 -          by (simp add: sup_def opt_def) (cases b, simp, simp add: b Bex_def)
  20.174 -      next
  20.175 -        case Some
  20.176 -        thus ?thesis
  20.177 -          by (auto simp add: sup_def opt_def Bex_def a b f_closed split: err.split option.split)
  20.178 -      qed
  20.179 -    }
  20.180 -
  20.181 -    thus "x +_?f y : ?A"
  20.182 -      by (simp add: plussub_def lift2_def split: err.split)
  20.183 -  qed
  20.184 -    
  20.185 -  moreover
  20.186 -
  20.187 -  { fix a b c 
  20.188 -    assume "a \<in> opt A" "b \<in> opt A" "a +_(sup f) b = OK c" 
  20.189 -    moreover
  20.190 -    from ord have "order r" by simp
  20.191 -    moreover
  20.192 -    { fix x y z
  20.193 -      assume "x \<in> A" "y \<in> A" 
  20.194 -      hence "OK x \<in> err A \<and> OK y \<in> err A" by simp
  20.195 -      with ub1 ub2
  20.196 -      have "(OK x) <=_(Err.le r) (OK x) +_(lift2 f) (OK y) \<and>
  20.197 -            (OK y) <=_(Err.le r) (OK x) +_(lift2 f) (OK y)"
  20.198 -        by blast
  20.199 -      moreover
  20.200 -      assume "x +_f y = OK z"
  20.201 -      ultimately
  20.202 -      have "x <=_r z \<and> y <=_r z"
  20.203 -        by (auto simp add: plussub_def lift2_def Err.le_def lesub_def)
  20.204 -    }
  20.205 -    ultimately
  20.206 -    have "a <=_(le r) c \<and> b <=_(le r) c"
  20.207 -      by (auto simp add: sup_def le_def lesub_def plussub_def 
  20.208 -               dest: order_refl split: option.splits err.splits)
  20.209 -  }
  20.210 -     
  20.211 -  hence "(\<forall>x\<in>?A. \<forall>y\<in>?A. x <=_?r x +_?f y) \<and> (\<forall>x\<in>?A. \<forall>y\<in>?A. y <=_?r x +_?f y)"
  20.212 -    by (auto simp add: lesub_def plussub_def Err.le_def lift2_def split: err.split)
  20.213 -
  20.214 -  moreover
  20.215 -
  20.216 -  have "\<forall>x\<in>?A. \<forall>y\<in>?A. \<forall>z\<in>?A. x <=_?r z \<and> y <=_?r z \<longrightarrow> x +_?f y <=_?r z"
  20.217 -  proof (intro strip, elim conjE)
  20.218 -    fix x y z
  20.219 -    assume xyz: "x : ?A" "y : ?A" "z : ?A"
  20.220 -    assume xz: "x <=_?r z"
  20.221 -    assume yz: "y <=_?r z"
  20.222 -
  20.223 -    { fix a b c
  20.224 -      assume ok: "x = OK a" "y = OK b" "z = OK c"
  20.225 -
  20.226 -      { fix d e g
  20.227 -        assume some: "a = Some d" "b = Some e" "c = Some g"
  20.228 -        
  20.229 -        with ok xyz
  20.230 -        obtain "OK d:err A" "OK e:err A" "OK g:err A"
  20.231 -          by simp
  20.232 -        with lub
  20.233 -        have "\<lbrakk> (OK d) <=_(Err.le r) (OK g); (OK e) <=_(Err.le r) (OK g) \<rbrakk>
  20.234 -          \<Longrightarrow> (OK d) +_(lift2 f) (OK e) <=_(Err.le r) (OK g)"
  20.235 -          by blast
  20.236 -        hence "\<lbrakk> d <=_r g; e <=_r g \<rbrakk> \<Longrightarrow> \<exists>y. d +_f e = OK y \<and> y <=_r g"
  20.237 -          by simp
  20.238 -
  20.239 -        with ok some xyz xz yz
  20.240 -        have "x +_?f y <=_?r z"
  20.241 -          by (auto simp add: sup_def le_def lesub_def lift2_def plussub_def Err.le_def)
  20.242 -      } note this [intro!]
  20.243 -
  20.244 -      from ok xyz xz yz
  20.245 -      have "x +_?f y <=_?r z"
  20.246 -        by - (cases a, simp, cases b, simp, cases c, simp, blast)
  20.247 -    }
  20.248 -    
  20.249 -    with xyz xz yz
  20.250 -    show "x +_?f y <=_?r z"
  20.251 -      by - (cases x, simp, cases y, simp, cases z, simp+)
  20.252 -  qed
  20.253 -
  20.254 -  ultimately
  20.255 -
  20.256 -  show "semilat (?A,?r,?f)"
  20.257 -    by (unfold semilat_def) simp
  20.258 -qed 
  20.259 -
  20.260 -lemma top_le_opt_Some [iff]: 
  20.261 -  "top (le r) (Some T) = top r T"
  20.262 -apply (unfold top_def)
  20.263 -apply (rule iffI)
  20.264 - apply blast
  20.265 -apply (rule allI)
  20.266 -apply (case_tac "x")
  20.267 -apply simp+
  20.268 -done 
  20.269 -
  20.270 -lemma Top_le_conv:
  20.271 -  "\<lbrakk> order r; top r T \<rbrakk> \<Longrightarrow> (T <=_r x) = (x = T)"
  20.272 -apply (unfold top_def)
  20.273 -apply (blast intro: order_antisym)
  20.274 -done 
  20.275 -
  20.276 -
  20.277 -lemma acc_le_optI [intro!]:
  20.278 -  "acc r \<Longrightarrow> acc(le r)"
  20.279 -apply (unfold acc_def lesub_def le_def lesssub_def)
  20.280 -apply (simp add: wfP_eq_minimal split: option.split)
  20.281 -apply clarify
  20.282 -apply (case_tac "? a. Some a : Q")
  20.283 - apply (erule_tac x = "{a . Some a : Q}" in allE)
  20.284 - apply blast
  20.285 -apply (case_tac "x")
  20.286 - apply blast
  20.287 -apply blast
  20.288 -done 
  20.289 -
  20.290 -lemma option_map_in_optionI:
  20.291 -  "\<lbrakk> ox : opt S; !x:S. ox = Some x \<longrightarrow> f x : S \<rbrakk> 
  20.292 -  \<Longrightarrow> Option.map f ox : opt S";
  20.293 -apply (unfold Option.map_def)
  20.294 -apply (simp split: option.split)
  20.295 -apply blast
  20.296 -done 
  20.297 -
  20.298 -end
    21.1 --- a/src/HOL/MicroJava/BV/Product.thy	Wed Dec 02 12:04:07 2009 +0100
    21.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    21.3 @@ -1,146 +0,0 @@
    21.4 -(*  Title:      HOL/MicroJava/BV/Product.thy
    21.5 -    ID:         $Id$
    21.6 -    Author:     Tobias Nipkow
    21.7 -    Copyright   2000 TUM
    21.8 -
    21.9 -Products as semilattices
   21.10 -*)
   21.11 -
   21.12 -header {* \isaheader{Products as Semilattices} *}
   21.13 -
   21.14 -theory Product
   21.15 -imports Err
   21.16 -begin
   21.17 -
   21.18 -constdefs
   21.19 - le :: "'a ord \<Rightarrow> 'b ord \<Rightarrow> ('a * 'b) ord"
   21.20 -"le rA rB == %(a,b) (a',b'). a <=_rA a' & b <=_rB b'"
   21.21 -
   21.22 - sup :: "'a ebinop \<Rightarrow> 'b ebinop \<Rightarrow> ('a * 'b)ebinop"
   21.23 -"sup f g == %(a1,b1)(a2,b2). Err.sup Pair (a1 +_f a2) (b1 +_g b2)"
   21.24 -
   21.25 - esl :: "'a esl \<Rightarrow> 'b esl \<Rightarrow> ('a * 'b ) esl"
   21.26 -"esl == %(A,rA,fA) (B,rB,fB). (A <*> B, le rA rB, sup fA fB)"
   21.27 -
   21.28 -syntax "@lesubprod" :: "'a*'b \<Rightarrow> 'a ord \<Rightarrow> 'b ord \<Rightarrow> 'b \<Rightarrow> bool"
   21.29 -       ("(_ /<='(_,_') _)" [50, 0, 0, 51] 50)
   21.30 -translations "p <=(rA,rB) q" == "p <=_(Product.le rA rB) q"
   21.31 -
   21.32 -lemma unfold_lesub_prod:
   21.33 -  "p <=(rA,rB) q == le rA rB p q"
   21.34 -  by (simp add: lesub_def)
   21.35 -
   21.36 -lemma le_prod_Pair_conv [iff]:
   21.37 -  "((a1,b1) <=(rA,rB) (a2,b2)) = (a1 <=_rA a2 & b1 <=_rB b2)"
   21.38 -  by (simp add: lesub_def le_def)
   21.39 -
   21.40 -lemma less_prod_Pair_conv:
   21.41 -  "((a1,b1) <_(Product.le rA rB) (a2,b2)) = 
   21.42 -  (a1 <_rA a2 & b1 <=_rB b2 | a1 <=_rA a2 & b1 <_rB b2)"
   21.43 -apply (unfold lesssub_def)
   21.44 -apply simp
   21.45 -apply blast
   21.46 -done
   21.47 -
   21.48 -lemma order_le_prod [iff]:
   21.49 -  "order(Product.le rA rB) = (order rA & order rB)"
   21.50 -apply (unfold Semilat.order_def)
   21.51 -apply simp
   21.52 -apply blast
   21.53 -done 
   21.54 -
   21.55 -
   21.56 -lemma acc_le_prodI [intro!]:
   21.57 -  "\<lbrakk> acc rA; acc rB \<rbrakk> \<Longrightarrow> acc(Product.le rA rB)"
   21.58 -apply (unfold acc_def)
   21.59 -apply (rule wfP_subset)
   21.60 - apply (erule wf_lex_prod [to_pred, THEN wfP_wf_eq [THEN iffD2]])
   21.61 - apply assumption
   21.62 -apply (auto simp add: lesssub_def less_prod_Pair_conv lex_prod_def)
   21.63 -done
   21.64 -
   21.65 -
   21.66 -lemma closed_lift2_sup:
   21.67 -  "\<lbrakk> closed (err A) (lift2 f); closed (err B) (lift2 g) \<rbrakk> \<Longrightarrow> 
   21.68 -  closed (err(A<*>B)) (lift2(sup f g))";
   21.69 -apply (unfold closed_def plussub_def lift2_def err_def sup_def)
   21.70 -apply (simp split: err.split)
   21.71 -apply blast
   21.72 -done 
   21.73 -
   21.74 -lemma unfold_plussub_lift2:
   21.75 -  "e1 +_(lift2 f) e2 == lift2 f e1 e2"
   21.76 -  by (simp add: plussub_def)
   21.77 -
   21.78 -
   21.79 -lemma plus_eq_Err_conv [simp]:
   21.80 -  assumes "x:A" and "y:A"
   21.81 -    and "semilat(err A, Err.le r, lift2 f)"
   21.82 -  shows "(x +_f y = Err) = (~(? z:A. x <=_r z & y <=_r z))"
   21.83 -proof -
   21.84 -  have plus_le_conv2:
   21.85 -    "\<And>r f z. \<lbrakk> z : err A; semilat (err A, r, f); OK x : err A; OK y : err A;
   21.86 -                 OK x +_f OK y <=_r z\<rbrakk> \<Longrightarrow> OK x <=_r z \<and> OK y <=_r z"
   21.87 -    by (rule Semilat.plus_le_conv [OF Semilat.intro, THEN iffD1])
   21.88 -  from prems show ?thesis
   21.89 -  apply (rule_tac iffI)
   21.90 -   apply clarify
   21.91 -   apply (drule OK_le_err_OK [THEN iffD2])
   21.92 -   apply (drule OK_le_err_OK [THEN iffD2])
   21.93 -   apply (drule Semilat.lub [OF Semilat.intro, of _ _ _ "OK x" _ "OK y"])
   21.94 -        apply assumption
   21.95 -       apply assumption
   21.96 -      apply simp
   21.97 -     apply simp
   21.98 -    apply simp
   21.99 -   apply simp
  21.100 -  apply (case_tac "x +_f y")
  21.101 -   apply assumption
  21.102 -  apply (rename_tac "z")
  21.103 -  apply (subgoal_tac "OK z: err A")
  21.104 -  apply (frule plus_le_conv2)
  21.105 -       apply assumption
  21.106 -      apply simp
  21.107 -      apply blast
  21.108 -     apply simp
  21.109 -    apply (blast dest: Semilat.orderI [OF Semilat.intro] order_refl)
  21.110 -   apply blast
  21.111 -  apply (erule subst)
  21.112 -  apply (unfold semilat_def err_def closed_def)
  21.113 -  apply simp
  21.114 -  done
  21.115 -qed
  21.116 -
  21.117 -lemma err_semilat_Product_esl:
  21.118 -  "\<And>L1 L2. \<lbrakk> err_semilat L1; err_semilat L2 \<rbrakk> \<Longrightarrow> err_semilat(Product.esl L1 L2)"
  21.119 -apply (unfold esl_def Err.sl_def)
  21.120 -apply (simp (no_asm_simp) only: split_tupled_all)
  21.121 -apply simp
  21.122 -apply (simp (no_asm) only: semilat_Def)
  21.123 -apply (simp (no_asm_simp) only: Semilat.closedI [OF Semilat.intro] closed_lift2_sup)
  21.124 -apply (simp (no_asm) only: unfold_lesub_err Err.le_def unfold_plussub_lift2 sup_def)
  21.125 -apply (auto elim: semilat_le_err_OK1 semilat_le_err_OK2
  21.126 -            simp add: lift2_def  split: err.split)
  21.127 -apply (blast dest: Semilat.orderI [OF Semilat.intro])
  21.128 -apply (blast dest: Semilat.orderI [OF Semilat.intro])
  21.129 -
  21.130 -apply (rule OK_le_err_OK [THEN iffD1])
  21.131 -apply (erule subst, subst OK_lift2_OK [symmetric], rule Semilat.lub [OF Semilat.intro])
  21.132 -apply simp
  21.133 -apply simp
  21.134 -apply simp
  21.135 -apply simp
  21.136 -apply simp
  21.137 -apply simp
  21.138 -
  21.139 -apply (rule OK_le_err_OK [THEN iffD1])
  21.140 -apply (erule subst, subst OK_lift2_OK [symmetric], rule Semilat.lub [OF Semilat.intro])
  21.141 -apply simp
  21.142 -apply simp
  21.143 -apply simp
  21.144 -apply simp
  21.145 -apply simp
  21.146 -apply simp
  21.147 -done 
  21.148 -
  21.149 -end
    22.1 --- a/src/HOL/MicroJava/BV/Semilat.thy	Wed Dec 02 12:04:07 2009 +0100
    22.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    22.3 @@ -1,373 +0,0 @@
    22.4 -(*  Title:      HOL/MicroJava/BV/Semilat.thy
    22.5 -    ID:         $Id$
    22.6 -    Author:     Tobias Nipkow
    22.7 -    Copyright   2000 TUM
    22.8 -
    22.9 -Semilattices
   22.10 -*)
   22.11 -
   22.12 -header {* 
   22.13 -  \chapter{Bytecode Verifier}\label{cha:bv}
   22.14 -  \isaheader{Semilattices} 
   22.15 -*}
   22.16 -
   22.17 -theory Semilat
   22.18 -imports Main While_Combinator
   22.19 -begin
   22.20 -
   22.21 -types 'a ord    = "'a \<Rightarrow> 'a \<Rightarrow> bool"
   22.22 -      'a binop  = "'a \<Rightarrow> 'a \<Rightarrow> 'a"
   22.23 -      'a sl     = "'a set * 'a ord * 'a binop"
   22.24 -
   22.25 -consts
   22.26 - "@lesub"   :: "'a \<Rightarrow> 'a ord \<Rightarrow> 'a \<Rightarrow> bool" ("(_ /<='__ _)" [50, 1000, 51] 50)
   22.27 - "@lesssub" :: "'a \<Rightarrow> 'a ord \<Rightarrow> 'a \<Rightarrow> bool" ("(_ /<'__ _)" [50, 1000, 51] 50)
   22.28 -defs
   22.29 -lesub_def:   "x <=_r y == r x y"
   22.30 -lesssub_def: "x <_r y  == x <=_r y & x ~= y"
   22.31 -
   22.32 -syntax (xsymbols)
   22.33 - "@lesub" :: "'a \<Rightarrow> 'a ord \<Rightarrow> 'a \<Rightarrow> bool" ("(_ /\<le>\<^sub>_ _)" [50, 1000, 51] 50)
   22.34 -
   22.35 -consts
   22.36 - "@plussub" :: "'a \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'b \<Rightarrow> 'c" ("(_ /+'__ _)" [65, 1000, 66] 65)
   22.37 -defs
   22.38 -plussub_def: "x +_f y == f x y"
   22.39 -
   22.40 -syntax (xsymbols)
   22.41 - "@plussub" :: "'a \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'b \<Rightarrow> 'c" ("(_ /+\<^sub>_ _)" [65, 1000, 66] 65)
   22.42 -
   22.43 -syntax (xsymbols)
   22.44 - "@plussub" :: "'a \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'b \<Rightarrow> 'c" ("(_ /\<squnion>\<^sub>_ _)" [65, 1000, 66] 65)
   22.45 -
   22.46 -
   22.47 -constdefs
   22.48 - order :: "'a ord \<Rightarrow> bool"
   22.49 -"order r == (!x. x <=_r x) &
   22.50 -            (!x y. x <=_r y & y <=_r x \<longrightarrow> x=y) &
   22.51 -            (!x y z. x <=_r y & y <=_r z \<longrightarrow> x <=_r z)"
   22.52 -
   22.53 - acc :: "'a ord \<Rightarrow> bool"
   22.54 -"acc r == wfP (\<lambda>y x. x <_r y)"
   22.55 -
   22.56 - top :: "'a ord \<Rightarrow> 'a \<Rightarrow> bool"
   22.57 -"top r T == !x. x <=_r T"
   22.58 -
   22.59 - closed :: "'a set \<Rightarrow> 'a binop \<Rightarrow> bool"
   22.60 -"closed A f == !x:A. !y:A. x +_f y : A"
   22.61 -
   22.62 - semilat :: "'a sl \<Rightarrow> bool"
   22.63 -"semilat == %(A,r,f). order r & closed A f &
   22.64 -                (!x:A. !y:A. x <=_r x +_f y)  &
   22.65 -                (!x:A. !y:A. y <=_r x +_f y)  &
   22.66 -                (!x:A. !y:A. !z:A. x <=_r z & y <=_r z \<longrightarrow> x +_f y <=_r z)"
   22.67 -
   22.68 - is_ub :: "'a ord \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool"
   22.69 -"is_ub r x y u == r x u & r y u"
   22.70 -
   22.71 - is_lub :: "'a ord \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool"
   22.72 -"is_lub r x y u == is_ub r x y u & (!z. is_ub r x y z \<longrightarrow> r u z)"
   22.73 -
   22.74 - some_lub :: "'a ord \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a"
   22.75 -"some_lub r x y == SOME z. is_lub r x y z";
   22.76 -
   22.77 -locale Semilat =
   22.78 -  fixes A :: "'a set"
   22.79 -    and r :: "'a ord"
   22.80 -    and f :: "'a binop"
   22.81 -  assumes semilat: "semilat(A,r,f)"
   22.82 -
   22.83 -lemma order_refl [simp, intro]:
   22.84 -  "order r \<Longrightarrow> x <=_r x";
   22.85 -  by (simp add: order_def)
   22.86 -
   22.87 -lemma order_antisym:
   22.88 -  "\<lbrakk> order r; x <=_r y; y <=_r x \<rbrakk> \<Longrightarrow> x = y"
   22.89 -apply (unfold order_def)
   22.90 -apply (simp (no_asm_simp))
   22.91 -done
   22.92 -
   22.93 -lemma order_trans:
   22.94 -   "\<lbrakk> order r; x <=_r y; y <=_r z \<rbrakk> \<Longrightarrow> x <=_r z"
   22.95 -apply (unfold order_def)
   22.96 -apply blast
   22.97 -done 
   22.98 -
   22.99 -lemma order_less_irrefl [intro, simp]:
  22.100 -   "order r \<Longrightarrow> ~ x <_r x"
  22.101 -apply (unfold order_def lesssub_def)
  22.102 -apply blast
  22.103 -done 
  22.104 -
  22.105 -lemma order_less_trans:
  22.106 -  "\<lbrakk> order r; x <_r y; y <_r z \<rbrakk> \<Longrightarrow> x <_r z"
  22.107 -apply (unfold order_def lesssub_def)
  22.108 -apply blast
  22.109 -done 
  22.110 -
  22.111 -lemma topD [simp, intro]:
  22.112 -  "top r T \<Longrightarrow> x <=_r T"
  22.113 -  by (simp add: top_def)
  22.114 -
  22.115 -lemma top_le_conv [simp]:
  22.116 -  "\<lbrakk> order r; top r T \<rbrakk> \<Longrightarrow> (T <=_r x) = (x = T)"
  22.117 -  by (blast intro: order_antisym)
  22.118 -
  22.119 -lemma semilat_Def:
  22.120 -"semilat(A,r,f) == order r & closed A f & 
  22.121 -                 (!x:A. !y:A. x <=_r x +_f y) & 
  22.122 -                 (!x:A. !y:A. y <=_r x +_f y) & 
  22.123 -                 (!x:A. !y:A. !z:A. x <=_r z & y <=_r z \<longrightarrow> x +_f y <=_r z)"
  22.124 -apply (unfold semilat_def split_conv [THEN eq_reflection])
  22.125 -apply (rule refl [THEN eq_reflection])
  22.126 -done
  22.127 -
  22.128 -lemma (in Semilat) orderI [simp, intro]:
  22.129 -  "order r"
  22.130 -  by (insert semilat) (simp add: semilat_Def)
  22.131 -
  22.132 -lemma (in Semilat) closedI [simp, intro]:
  22.133 -  "closed A f"
  22.134 -  by (insert semilat) (simp add: semilat_Def)
  22.135 -
  22.136 -lemma closedD:
  22.137 -  "\<lbrakk> closed A f; x:A; y:A \<rbrakk> \<Longrightarrow> x +_f y : A"
  22.138 -  by (unfold closed_def) blast
  22.139 -
  22.140 -lemma closed_UNIV [simp]: "closed UNIV f"
  22.141 -  by (simp add: closed_def)
  22.142 -
  22.143 -
  22.144 -lemma (in Semilat) closed_f [simp, intro]:
  22.145 -  "\<lbrakk>x:A; y:A\<rbrakk>  \<Longrightarrow> x +_f y : A"
  22.146 -  by (simp add: closedD [OF closedI])
  22.147 -
  22.148 -lemma (in Semilat) refl_r [intro, simp]:
  22.149 -  "x <=_r x"
  22.150 -  by simp
  22.151 -
  22.152 -lemma (in Semilat) antisym_r [intro?]:
  22.153 -  "\<lbrakk> x <=_r y; y <=_r x \<rbrakk> \<Longrightarrow> x = y"
  22.154 -  by (rule order_antisym) auto
  22.155 -  
  22.156 -lemma (in Semilat) trans_r [trans, intro?]:
  22.157 -  "\<lbrakk>x <=_r y; y <=_r z\<rbrakk> \<Longrightarrow> x <=_r z"
  22.158 -  by (auto intro: order_trans)    
  22.159 -  
  22.160 -
  22.161 -lemma (in Semilat) ub1 [simp, intro?]:
  22.162 -  "\<lbrakk> x:A; y:A \<rbrakk> \<Longrightarrow> x <=_r x +_f y"
  22.163 -  by (insert semilat) (unfold semilat_Def, simp)
  22.164 -
  22.165 -lemma (in Semilat) ub2 [simp, intro?]:
  22.166 -  "\<lbrakk> x:A; y:A \<rbrakk> \<Longrightarrow> y <=_r x +_f y"
  22.167 -  by (insert semilat) (unfold semilat_Def, simp)
  22.168 -
  22.169 -lemma (in Semilat) lub [simp, intro?]:
  22.170 - "\<lbrakk> x <=_r z; y <=_r z; x:A; y:A; z:A \<rbrakk> \<Longrightarrow> x +_f y <=_r z";
  22.171 -  by (insert semilat) (unfold semilat_Def, simp)
  22.172 -
  22.173 -
  22.174 -lemma (in Semilat) plus_le_conv [simp]:
  22.175 -  "\<lbrakk> x:A; y:A; z:A \<rbrakk> \<Longrightarrow> (x +_f y <=_r z) = (x <=_r z & y <=_r z)"
  22.176 -  by (blast intro: ub1 ub2 lub order_trans)
  22.177 -
  22.178 -lemma (in Semilat) le_iff_plus_unchanged:
  22.179 -  "\<lbrakk> x:A; y:A \<rbrakk> \<Longrightarrow> (x <=_r y) = (x +_f y = y)"
  22.180 -apply (rule iffI)
  22.181 - apply (blast intro: antisym_r refl_r lub ub2)
  22.182 -apply (erule subst)
  22.183 -apply simp
  22.184 -done
  22.185 -
  22.186 -lemma (in Semilat) le_iff_plus_unchanged2:
  22.187 -  "\<lbrakk> x:A; y:A \<rbrakk> \<Longrightarrow> (x <=_r y) = (y +_f x = y)"
  22.188 -apply (rule iffI)
  22.189 - apply (blast intro: order_antisym lub order_refl ub1)
  22.190 -apply (erule subst)
  22.191 -apply simp
  22.192 -done 
  22.193 -
  22.194 -
  22.195 -lemma (in Semilat) plus_assoc [simp]:
  22.196 -  assumes a: "a \<in> A" and b: "b \<in> A" and c: "c \<in> A"
  22.197 -  shows "a +_f (b +_f c) = a +_f b +_f c"
  22.198 -proof -
  22.199 -  from a b have ab: "a +_f b \<in> A" ..
  22.200 -  from this c have abc: "(a +_f b) +_f c \<in> A" ..
  22.201 -  from b c have bc: "b +_f c \<in> A" ..
  22.202 -  from a this have abc': "a +_f (b +_f c) \<in> A" ..
  22.203 -
  22.204 -  show ?thesis
  22.205 -  proof    
  22.206 -    show "a +_f (b +_f c) <=_r (a +_f b) +_f c"
  22.207 -    proof -
  22.208 -      from a b have "a <=_r a +_f b" .. 
  22.209 -      also from ab c have "\<dots> <=_r \<dots> +_f c" ..
  22.210 -      finally have "a<": "a <=_r (a +_f b) +_f c" .
  22.211 -      from a b have "b <=_r a +_f b" ..
  22.212 -      also from ab c have "\<dots> <=_r \<dots> +_f c" ..
  22.213 -      finally have "b<": "b <=_r (a +_f b) +_f c" .
  22.214 -      from ab c have "c<": "c <=_r (a +_f b) +_f c" ..    
  22.215 -      from "b<" "c<" b c abc have "b +_f c <=_r (a +_f b) +_f c" ..
  22.216 -      from "a<" this a bc abc show ?thesis ..
  22.217 -    qed
  22.218 -    show "(a +_f b) +_f c <=_r a +_f (b +_f c)" 
  22.219 -    proof -
  22.220 -      from b c have "b <=_r b +_f c" .. 
  22.221 -      also from a bc have "\<dots> <=_r a +_f \<dots>" ..
  22.222 -      finally have "b<": "b <=_r a +_f (b +_f c)" .
  22.223 -      from b c have "c <=_r b +_f c" ..
  22.224 -      also from a bc have "\<dots> <=_r a +_f \<dots>" ..
  22.225 -      finally have "c<": "c <=_r a +_f (b +_f c)" .
  22.226 -      from a bc have "a<": "a <=_r a +_f (b +_f c)" ..
  22.227 -      from "a<" "b<" a b abc' have "a +_f b <=_r a +_f (b +_f c)" ..
  22.228 -      from this "c<" ab c abc' show ?thesis ..
  22.229 -    qed
  22.230 -  qed
  22.231 -qed
  22.232 -
  22.233 -lemma (in Semilat) plus_com_lemma:
  22.234 -  "\<lbrakk>a \<in> A; b \<in> A\<rbrakk> \<Longrightarrow> a +_f b <=_r b +_f a"
  22.235 -proof -
  22.236 -  assume a: "a \<in> A" and b: "b \<in> A"  
  22.237 -  from b a have "a <=_r b +_f a" .. 
  22.238 -  moreover from b a have "b <=_r b +_f a" ..
  22.239 -  moreover note a b
  22.240 -  moreover from b a have "b +_f a \<in> A" ..
  22.241 -  ultimately show ?thesis ..
  22.242 -qed
  22.243 -
  22.244 -lemma (in Semilat) plus_commutative:
  22.245 -  "\<lbrakk>a \<in> A; b \<in> A\<rbrakk> \<Longrightarrow> a +_f b = b +_f a"
  22.246 -by(blast intro: order_antisym plus_com_lemma)
  22.247 -
  22.248 -lemma is_lubD:
  22.249 -  "is_lub r x y u \<Longrightarrow> is_ub r x y u & (!z. is_ub r x y z \<longrightarrow> r u z)"
  22.250 -  by (simp add: is_lub_def)
  22.251 -
  22.252 -lemma is_ubI:
  22.253 -  "\<lbrakk> r x u; r y u \<rbrakk> \<Longrightarrow> is_ub r x y u"
  22.254 -  by (simp add: is_ub_def)
  22.255 -
  22.256 -lemma is_ubD:
  22.257 -  "is_ub r x y u \<Longrightarrow> r x u & r y u"
  22.258 -  by (simp add: is_ub_def)
  22.259 -
  22.260 -
  22.261 -lemma is_lub_bigger1 [iff]:  
  22.262 -  "is_lub (r^** ) x y y = r^** x y"
  22.263 -apply (unfold is_lub_def is_ub_def)
  22.264 -apply blast
  22.265 -done
  22.266 -
  22.267 -lemma is_lub_bigger2 [iff]:
  22.268 -  "is_lub (r^** ) x y x = r^** y x"
  22.269 -apply (unfold is_lub_def is_ub_def)
  22.270 -apply blast 
  22.271 -done
  22.272 -
  22.273 -lemma extend_lub:
  22.274 -  "\<lbrakk> single_valuedP r; is_lub (r^** ) x y u; r x' x \<rbrakk> 
  22.275 -  \<Longrightarrow> EX v. is_lub (r^** ) x' y v"
  22.276 -apply (unfold is_lub_def is_ub_def)
  22.277 -apply (case_tac "r^** y x")
  22.278 - apply (case_tac "r^** y x'")
  22.279 -  apply blast
  22.280 - apply (blast elim: converse_rtranclpE dest: single_valuedD)
  22.281 -apply (rule exI)
  22.282 -apply (rule conjI)
  22.283 - apply (blast intro: converse_rtranclp_into_rtranclp dest: single_valuedD)
  22.284 -apply (blast intro: rtranclp.rtrancl_into_rtrancl converse_rtranclp_into_rtranclp
  22.285 -             elim: converse_rtranclpE dest: single_valuedD)
  22.286 -done
  22.287 -
  22.288 -lemma single_valued_has_lubs [rule_format]:
  22.289 -  "\<lbrakk> single_valuedP r; r^** x u \<rbrakk> \<Longrightarrow> (!y. r^** y u \<longrightarrow> 
  22.290 -  (EX z. is_lub (r^** ) x y z))"
  22.291 -apply (erule converse_rtranclp_induct)
  22.292 - apply clarify
  22.293 - apply (erule converse_rtranclp_induct)
  22.294 -  apply blast
  22.295 - apply (blast intro: converse_rtranclp_into_rtranclp)
  22.296 -apply (blast intro: extend_lub)
  22.297 -done
  22.298 -
  22.299 -lemma some_lub_conv:
  22.300 -  "\<lbrakk> acyclicP r; is_lub (r^** ) x y u \<rbrakk> \<Longrightarrow> some_lub (r^** ) x y = u"
  22.301 -apply (unfold some_lub_def is_lub_def)
  22.302 -apply (rule someI2)
  22.303 - apply assumption
  22.304 -apply (blast intro: antisymD dest!: acyclic_impl_antisym_rtrancl [to_pred])
  22.305 -done
  22.306 -
  22.307 -lemma is_lub_some_lub:
  22.308 -  "\<lbrakk> single_valuedP r; acyclicP r; r^** x u; r^** y u \<rbrakk> 
  22.309 -  \<Longrightarrow> is_lub (r^** ) x y (some_lub (r^** ) x y)";
  22.310 -  by (fastsimp dest: single_valued_has_lubs simp add: some_lub_conv)
  22.311 -
  22.312 -subsection{*An executable lub-finder*}
  22.313 -
  22.314 -constdefs
  22.315 - exec_lub :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> 'a binop"
  22.316 -"exec_lub r f x y == while (\<lambda>z. \<not> r\<^sup>*\<^sup>* x z) f y"
  22.317 -
  22.318 -
  22.319 -lemma acyclic_single_valued_finite:
  22.320 - "\<lbrakk>acyclicP r; single_valuedP r; r\<^sup>*\<^sup>* x y \<rbrakk>
  22.321 -  \<Longrightarrow> finite ({(x, y). r x y} \<inter> {a. r\<^sup>*\<^sup>* x a} \<times> {b. r\<^sup>*\<^sup>* b y})"
  22.322 -apply(erule converse_rtranclp_induct)
  22.323 - apply(rule_tac B = "{}" in finite_subset)
  22.324 -  apply(simp only:acyclic_def [to_pred])
  22.325 -  apply(blast intro:rtranclp_into_tranclp2 rtranclp_tranclp_tranclp)
  22.326 - apply simp
  22.327 -apply(rename_tac x x')
  22.328 -apply(subgoal_tac "{(x, y). r x y} \<inter> {a. r\<^sup>*\<^sup>* x a} \<times> {b. r\<^sup>*\<^sup>* b y} =
  22.329 -                   insert (x,x') ({(x, y). r x y} \<inter> {a. r\<^sup>*\<^sup>* x' a} \<times> {b. r\<^sup>*\<^sup>* b y})")
  22.330 - apply simp
  22.331 -apply(blast intro:converse_rtranclp_into_rtranclp
  22.332 -            elim:converse_rtranclpE dest:single_valuedD)
  22.333 -done
  22.334 -
  22.335 -
  22.336 -lemma exec_lub_conv:
  22.337 -  "\<lbrakk> acyclicP r; !x y. r x y \<longrightarrow> f x = y; is_lub (r\<^sup>*\<^sup>*) x y u \<rbrakk> \<Longrightarrow>
  22.338 -  exec_lub r f x y = u";
  22.339 -apply(unfold exec_lub_def)
  22.340 -apply(rule_tac P = "\<lambda>z. r\<^sup>*\<^sup>* y z \<and> r\<^sup>*\<^sup>* z u" and
  22.341 -               r = "({(x, y). r x y} \<inter> {(a,b). r\<^sup>*\<^sup>* y a \<and> r\<^sup>*\<^sup>* b u})^-1" in while_rule)
  22.342 -    apply(blast dest: is_lubD is_ubD)
  22.343 -   apply(erule conjE)
  22.344 -   apply(erule_tac z = u in converse_rtranclpE)
  22.345 -    apply(blast dest: is_lubD is_ubD)
  22.346 -   apply(blast dest: rtranclp.rtrancl_into_rtrancl)
  22.347 -  apply(rename_tac s)
  22.348 -  apply(subgoal_tac "is_ub (r\<^sup>*\<^sup>*) x y s")
  22.349 -   prefer 2; apply(simp add:is_ub_def)
  22.350 -  apply(subgoal_tac "r\<^sup>*\<^sup>* u s")
  22.351 -   prefer 2; apply(blast dest:is_lubD)
  22.352 -  apply(erule converse_rtranclpE)
  22.353 -   apply blast
  22.354 -  apply(simp only:acyclic_def [to_pred])
  22.355 -  apply(blast intro:rtranclp_into_tranclp2 rtranclp_tranclp_tranclp)
  22.356 - apply(rule finite_acyclic_wf)
  22.357 -  apply simp
  22.358 -  apply(erule acyclic_single_valued_finite)
  22.359 -   apply(blast intro:single_valuedI)
  22.360 -  apply(simp add:is_lub_def is_ub_def)
  22.361 - apply simp
  22.362 - apply(erule acyclic_subset)
  22.363 - apply blast
  22.364 -apply simp
  22.365 -apply(erule conjE)
  22.366 -apply(erule_tac z = u in converse_rtranclpE)
  22.367 - apply(blast dest: is_lubD is_ubD)
  22.368 -apply blast
  22.369 -done
  22.370 -
  22.371 -lemma is_lub_exec_lub:
  22.372 -  "\<lbrakk> single_valuedP r; acyclicP r; r^** x u; r^** y u; !x y. r x y \<longrightarrow> f x = y \<rbrakk>
  22.373 -  \<Longrightarrow> is_lub (r^** ) x y (exec_lub r f x y)"
  22.374 -  by (fastsimp dest: single_valued_has_lubs simp add: exec_lub_conv)
  22.375 -
  22.376 -end
    23.1 --- a/src/HOL/MicroJava/BV/SemilatAlg.thy	Wed Dec 02 12:04:07 2009 +0100
    23.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    23.3 @@ -1,188 +0,0 @@
    23.4 -(*  Title:      HOL/MicroJava/BV/SemilatAlg.thy
    23.5 -    ID:         $Id$
    23.6 -    Author:     Gerwin Klein
    23.7 -    Copyright   2002 Technische Universitaet Muenchen
    23.8 -*)
    23.9 -
   23.10 -header {* \isaheader{More on Semilattices} *}
   23.11 -
   23.12 -theory SemilatAlg
   23.13 -imports Typing_Framework Product
   23.14 -begin
   23.15 -
   23.16 -
   23.17 -constdefs 
   23.18 -  lesubstep_type :: "(nat \<times> 's) list \<Rightarrow> 's ord \<Rightarrow> (nat \<times> 's) list \<Rightarrow> bool"
   23.19 -                    ("(_ /<=|_| _)" [50, 0, 51] 50)
   23.20 -  "x <=|r| y \<equiv> \<forall>(p,s) \<in> set x. \<exists>s'. (p,s') \<in> set y \<and> s <=_r s'"
   23.21 -
   23.22 -consts
   23.23 - "@plusplussub" :: "'a list \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a" ("(_ /++'__ _)" [65, 1000, 66] 65)
   23.24 -primrec
   23.25 -  "[] ++_f y = y"
   23.26 -  "(x#xs) ++_f y = xs ++_f (x +_f y)"
   23.27 -
   23.28 -constdefs
   23.29 - bounded :: "'s step_type \<Rightarrow> nat \<Rightarrow> bool"
   23.30 -"bounded step n == !p<n. !s. !(q,t):set(step p s). q<n"  
   23.31 -
   23.32 - pres_type :: "'s step_type \<Rightarrow> nat \<Rightarrow> 's set \<Rightarrow> bool"
   23.33 -"pres_type step n A == \<forall>s\<in>A. \<forall>p<n. \<forall>(q,s')\<in>set (step p s). s' \<in> A"
   23.34 -
   23.35 - mono :: "'s ord \<Rightarrow> 's step_type \<Rightarrow> nat \<Rightarrow> 's set \<Rightarrow> bool"
   23.36 -"mono r step n A ==
   23.37 - \<forall>s p t. s \<in> A \<and> p < n \<and> s <=_r t \<longrightarrow> step p s <=|r| step p t"
   23.38 -
   23.39 -
   23.40 -lemma pres_typeD:
   23.41 -  "\<lbrakk> pres_type step n A; s\<in>A; p<n; (q,s')\<in>set (step p s) \<rbrakk> \<Longrightarrow> s' \<in> A"
   23.42 -  by (unfold pres_type_def, blast)
   23.43 -
   23.44 -lemma monoD:
   23.45 -  "\<lbrakk> mono r step n A; p < n; s\<in>A; s <=_r t \<rbrakk> \<Longrightarrow> step p s <=|r| step p t"
   23.46 -  by (unfold mono_def, blast)
   23.47 -
   23.48 -lemma boundedD: 
   23.49 -  "\<lbrakk> bounded step n; p < n; (q,t) : set (step p xs) \<rbrakk> \<Longrightarrow> q < n" 
   23.50 -  by (unfold bounded_def, blast)
   23.51 -
   23.52 -lemma lesubstep_type_refl [simp, intro]:
   23.53 -  "(\<And>x. x <=_r x) \<Longrightarrow> x <=|r| x"
   23.54 -  by (unfold lesubstep_type_def) auto
   23.55 -
   23.56 -lemma lesub_step_typeD:
   23.57 -  "a <=|r| b \<Longrightarrow> (x,y) \<in> set a \<Longrightarrow> \<exists>y'. (x, y') \<in> set b \<and> y <=_r y'"
   23.58 -  by (unfold lesubstep_type_def) blast
   23.59 -
   23.60 -
   23.61 -lemma list_update_le_listI [rule_format]:
   23.62 -  "set xs <= A \<longrightarrow> set ys <= A \<longrightarrow> xs <=[r] ys \<longrightarrow> p < size xs \<longrightarrow>  
   23.63 -   x <=_r ys!p \<longrightarrow> semilat(A,r,f) \<longrightarrow> x\<in>A \<longrightarrow> 
   23.64 -   xs[p := x +_f xs!p] <=[r] ys"
   23.65 -  apply (unfold Listn.le_def lesub_def semilat_def)
   23.66 -  apply (simp add: list_all2_conv_all_nth nth_list_update)
   23.67 -  done
   23.68 -
   23.69 -
   23.70 -lemma plusplus_closed: assumes "semilat (A, r, f)" shows
   23.71 -  "\<And>y. \<lbrakk> set x \<subseteq> A; y \<in> A\<rbrakk> \<Longrightarrow> x ++_f y \<in> A" (is "PROP ?P")
   23.72 -proof -
   23.73 -  interpret Semilat A r f using assms by (rule Semilat.intro)
   23.74 -  show "PROP ?P" proof (induct x)
   23.75 -    show "\<And>y. y \<in> A \<Longrightarrow> [] ++_f y \<in> A" by simp
   23.76 -    fix y x xs
   23.77 -    assume y: "y \<in> A" and xs: "set (x#xs) \<subseteq> A"
   23.78 -    assume IH: "\<And>y. \<lbrakk> set xs \<subseteq> A; y \<in> A\<rbrakk> \<Longrightarrow> xs ++_f y \<in> A"
   23.79 -    from xs obtain x: "x \<in> A" and xs': "set xs \<subseteq> A" by simp
   23.80 -    from x y have "(x +_f y) \<in> A" ..
   23.81 -    with xs' have "xs ++_f (x +_f y) \<in> A" by (rule IH)
   23.82 -    thus "(x#xs) ++_f y \<in> A" by simp
   23.83 -  qed
   23.84 -qed
   23.85 -
   23.86 -lemma (in Semilat) pp_ub2:
   23.87 - "\<And>y. \<lbrakk> set x \<subseteq> A; y \<in> A\<rbrakk> \<Longrightarrow> y <=_r x ++_f y"
   23.88 -proof (induct x)
   23.89 -  from semilat show "\<And>y. y <=_r [] ++_f y" by simp
   23.90 -  
   23.91 -  fix y a l
   23.92 -  assume y:  "y \<in> A"
   23.93 -  assume "set (a#l) \<subseteq> A"
   23.94 -  then obtain a: "a \<in> A" and x: "set l \<subseteq> A" by simp
   23.95 -  assume "\<And>y. \<lbrakk>set l \<subseteq> A; y \<in> A\<rbrakk> \<Longrightarrow> y <=_r l ++_f y"
   23.96 -  hence IH: "\<And>y. y \<in> A \<Longrightarrow> y <=_r l ++_f y" using x .
   23.97 -
   23.98 -  from a y have "y <=_r a +_f y" ..
   23.99 -  also from a y have "a +_f y \<in> A" ..
  23.100 -  hence "(a +_f y) <=_r l ++_f (a +_f y)" by (rule IH)
  23.101 -  finally have "y <=_r l ++_f (a +_f y)" .
  23.102 -  thus "y <=_r (a#l) ++_f y" by simp
  23.103 -qed
  23.104 -
  23.105 -
  23.106 -lemma (in Semilat) pp_ub1:
  23.107 -shows "\<And>y. \<lbrakk>set ls \<subseteq> A; y \<in> A; x \<in> set ls\<rbrakk> \<Longrightarrow> x <=_r ls ++_f y"
  23.108 -proof (induct ls)
  23.109 -  show "\<And>y. x \<in> set [] \<Longrightarrow> x <=_r [] ++_f y" by simp
  23.110 -
  23.111 -  fix y s ls
  23.112 -  assume "set (s#ls) \<subseteq> A"
  23.113 -  then obtain s: "s \<in> A" and ls: "set ls \<subseteq> A" by simp
  23.114 -  assume y: "y \<in> A" 
  23.115 -
  23.116 -  assume 
  23.117 -    "\<And>y. \<lbrakk>set ls \<subseteq> A; y \<in> A; x \<in> set ls\<rbrakk> \<Longrightarrow> x <=_r ls ++_f y"
  23.118 -  hence IH: "\<And>y. x \<in> set ls \<Longrightarrow> y \<in> A \<Longrightarrow> x <=_r ls ++_f y" using ls .
  23.119 -
  23.120 -  assume "x \<in> set (s#ls)"
  23.121 -  then obtain xls: "x = s \<or> x \<in> set ls" by simp
  23.122 -  moreover {
  23.123 -    assume xs: "x = s"
  23.124 -    from s y have "s <=_r s +_f y" ..
  23.125 -    also from s y have "s +_f y \<in> A" ..
  23.126 -    with ls have "(s +_f y) <=_r ls ++_f (s +_f y)" by (rule pp_ub2)
  23.127 -    finally have "s <=_r ls ++_f (s +_f y)" .
  23.128 -    with xs have "x <=_r ls ++_f (s +_f y)" by simp
  23.129 -  } 
  23.130 -  moreover {
  23.131 -    assume "x \<in> set ls"
  23.132 -    hence "\<And>y. y \<in> A \<Longrightarrow> x <=_r ls ++_f y" by (rule IH)
  23.133 -    moreover from s y have "s +_f y \<in> A" ..
  23.134 -    ultimately have "x <=_r ls ++_f (s +_f y)" .
  23.135 -  }
  23.136 -  ultimately 
  23.137 -  have "x <=_r ls ++_f (s +_f y)" by blast
  23.138 -  thus "x <=_r (s#ls) ++_f y" by simp
  23.139 -qed
  23.140 -
  23.141 -
  23.142 -lemma (in Semilat) pp_lub:
  23.143 -  assumes z: "z \<in> A"
  23.144 -  shows 
  23.145 -  "\<And>y. y \<in> A \<Longrightarrow> set xs \<subseteq> A \<Longrightarrow> \<forall>x \<in> set xs. x <=_r z \<Longrightarrow> y <=_r z \<Longrightarrow> xs ++_f y <=_r z"
  23.146 -proof (induct xs)
  23.147 -  fix y assume "y <=_r z" thus "[] ++_f y <=_r z" by simp
  23.148 -next
  23.149 -  fix y l ls assume y: "y \<in> A" and "set (l#ls) \<subseteq> A"
  23.150 -  then obtain l: "l \<in> A" and ls: "set ls \<subseteq> A" by auto
  23.151 -  assume "\<forall>x \<in> set (l#ls). x <=_r z"
  23.152 -  then obtain lz: "l <=_r z" and lsz: "\<forall>x \<in> set ls. x <=_r z" by auto
  23.153 -  assume "y <=_r z" with lz have "l +_f y <=_r z" using l y z ..
  23.154 -  moreover
  23.155 -  from l y have "l +_f y \<in> A" ..
  23.156 -  moreover
  23.157 -  assume "\<And>y. y \<in> A \<Longrightarrow> set ls \<subseteq> A \<Longrightarrow> \<forall>x \<in> set ls. x <=_r z \<Longrightarrow> y <=_r z
  23.158 -          \<Longrightarrow> ls ++_f y <=_r z"
  23.159 -  ultimately
  23.160 -  have "ls ++_f (l +_f y) <=_r z" using ls lsz by -
  23.161 -  thus "(l#ls) ++_f y <=_r z" by simp
  23.162 -qed
  23.163 -
  23.164 -
  23.165 -lemma ub1':
  23.166 -  assumes "semilat (A, r, f)"
  23.167 -  shows "\<lbrakk>\<forall>(p,s) \<in> set S. s \<in> A; y \<in> A; (a,b) \<in> set S\<rbrakk> 
  23.168 -  \<Longrightarrow> b <=_r map snd [(p', t')\<leftarrow>S. p' = a] ++_f y" 
  23.169 -proof -
  23.170 -  interpret Semilat A r f using assms by (rule Semilat.intro)
  23.171 -
  23.172 -  let "b <=_r ?map ++_f y" = ?thesis
  23.173 -
  23.174 -  assume "y \<in> A"
  23.175 -  moreover
  23.176 -  assume "\<forall>(p,s) \<in> set S. s \<in> A"
  23.177 -  hence "set ?map \<subseteq> A" by auto
  23.178 -  moreover
  23.179 -  assume "(a,b) \<in> set S"
  23.180 -  hence "b \<in> set ?map" by (induct S, auto)
  23.181 -  ultimately
  23.182 -  show ?thesis by - (rule pp_ub1)
  23.183 -qed
  23.184 -    
  23.185 -
  23.186 -lemma plusplus_empty:  
  23.187 -  "\<forall>s'. (q, s') \<in> set S \<longrightarrow> s' +_f ss ! q = ss ! q \<Longrightarrow>
  23.188 -   (map snd [(p', t') \<leftarrow> S. p' = q] ++_f ss ! q) = ss ! q"
  23.189 -  by (induct S) auto 
  23.190 -
  23.191 -end
    24.1 --- a/src/HOL/MicroJava/BV/Typing_Framework.thy	Wed Dec 02 12:04:07 2009 +0100
    24.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    24.3 @@ -1,37 +0,0 @@
    24.4 -(*  Title:      HOL/MicroJava/BV/Typing_Framework.thy
    24.5 -    ID:         $Id$
    24.6 -    Author:     Tobias Nipkow
    24.7 -    Copyright   2000 TUM
    24.8 -*)
    24.9 -
   24.10 -header {* \isaheader{Typing and Dataflow Analysis Framework} *}
   24.11 -
   24.12 -theory Typing_Framework
   24.13 -imports Listn
   24.14 -begin
   24.15 -
   24.16 -text {* 
   24.17 -  The relationship between dataflow analysis and a welltyped-instruction predicate. 
   24.18 -*}
   24.19 -types
   24.20 -  's step_type = "nat \<Rightarrow> 's \<Rightarrow> (nat \<times> 's) list"
   24.21 -
   24.22 -constdefs
   24.23 - stable :: "'s ord \<Rightarrow> 's step_type \<Rightarrow> 's list \<Rightarrow> nat \<Rightarrow> bool"
   24.24 -"stable r step ss p == !(q,s'):set(step p (ss!p)). s' <=_r ss!q"
   24.25 -
   24.26 - stables :: "'s ord \<Rightarrow> 's step_type \<Rightarrow> 's list \<Rightarrow> bool"
   24.27 -"stables r step ss == !p<size ss. stable r step ss p"
   24.28 -
   24.29 - wt_step ::
   24.30 -"'s ord \<Rightarrow> 's \<Rightarrow> 's step_type \<Rightarrow> 's list \<Rightarrow> bool"
   24.31 -"wt_step r T step ts ==
   24.32 - !p<size(ts). ts!p ~= T & stable r step ts p"
   24.33 -
   24.34 - is_bcv :: "'s ord \<Rightarrow> 's \<Rightarrow> 's step_type 
   24.35 -           \<Rightarrow> nat \<Rightarrow> 's set \<Rightarrow> ('s list \<Rightarrow> 's list) \<Rightarrow> bool"  
   24.36 -"is_bcv r T step n A bcv == !ss : list n A.
   24.37 -   (!p<n. (bcv ss)!p ~= T) =
   24.38 -   (? ts: list n A. ss <=[r] ts & wt_step r T step ts)"
   24.39 -
   24.40 -end
    25.1 --- a/src/HOL/MicroJava/BV/Typing_Framework_JVM.thy	Wed Dec 02 12:04:07 2009 +0100
    25.2 +++ b/src/HOL/MicroJava/BV/Typing_Framework_JVM.thy	Tue Nov 24 14:37:23 2009 +0100
    25.3 @@ -1,13 +1,13 @@
    25.4  (*  Title:      HOL/MicroJava/BV/JVM.thy
    25.5 -    ID:         $Id$
    25.6      Author:     Tobias Nipkow, Gerwin Klein
    25.7      Copyright   2000 TUM
    25.8  *)
    25.9  
   25.10  header {* \isaheader{The Typing Framework for the JVM}\label{sec:JVM} *}
   25.11  
   25.12 -theory Typing_Framework_JVM imports Typing_Framework_err JVMType EffectMono BVSpec begin
   25.13 -
   25.14 +theory Typing_Framework_JVM
   25.15 +imports "../DFA/Abstract_BV" JVMType EffectMono BVSpec
   25.16 +begin
   25.17  
   25.18  constdefs
   25.19    exec :: "jvm_prog \<Rightarrow> nat \<Rightarrow> ty \<Rightarrow> exception_table \<Rightarrow> instr list \<Rightarrow> JVMType.state step_type"
    26.1 --- a/src/HOL/MicroJava/BV/Typing_Framework_err.thy	Wed Dec 02 12:04:07 2009 +0100
    26.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    26.3 @@ -1,255 +0,0 @@
    26.4 -(*  Title:      HOL/MicroJava/BV/Typing_Framework_err.thy
    26.5 -    ID:         $Id$
    26.6 -    Author:     Gerwin Klein
    26.7 -    Copyright   2000 TUM
    26.8 -
    26.9 -*)
   26.10 -
   26.11 -header {* \isaheader{Lifting the Typing Framework to err, app, and eff} *}
   26.12 -
   26.13 -theory Typing_Framework_err
   26.14 -imports Typing_Framework SemilatAlg
   26.15 -begin
   26.16 -
   26.17 -constdefs
   26.18 -
   26.19 -wt_err_step :: "'s ord \<Rightarrow> 's err step_type \<Rightarrow> 's err list \<Rightarrow> bool"
   26.20 -"wt_err_step r step ts \<equiv> wt_step (Err.le r) Err step ts"
   26.21 -
   26.22 -wt_app_eff :: "'s ord \<Rightarrow> (nat \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> 's step_type \<Rightarrow> 's list \<Rightarrow> bool"
   26.23 -"wt_app_eff r app step ts \<equiv>
   26.24 -  \<forall>p < size ts. app p (ts!p) \<and> (\<forall>(q,t) \<in> set (step p (ts!p)). t <=_r ts!q)"
   26.25 -
   26.26 -map_snd :: "('b \<Rightarrow> 'c) \<Rightarrow> ('a \<times> 'b) list \<Rightarrow> ('a \<times> 'c) list"
   26.27 -"map_snd f \<equiv> map (\<lambda>(x,y). (x, f y))"
   26.28 -
   26.29 -error :: "nat \<Rightarrow> (nat \<times> 'a err) list"
   26.30 -"error n \<equiv> map (\<lambda>x. (x,Err)) [0..<n]"
   26.31 -
   26.32 -err_step :: "nat \<Rightarrow> (nat \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> 's step_type \<Rightarrow> 's err step_type"
   26.33 -"err_step n app step p t \<equiv> 
   26.34 -  case t of 
   26.35 -    Err   \<Rightarrow> error n
   26.36 -  | OK t' \<Rightarrow> if app p t' then map_snd OK (step p t') else error n"
   26.37 -
   26.38 -app_mono :: "'s ord \<Rightarrow> (nat \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> nat \<Rightarrow> 's set \<Rightarrow> bool"
   26.39 -"app_mono r app n A \<equiv>
   26.40 - \<forall>s p t. s \<in> A \<and> p < n \<and> s <=_r t \<longrightarrow> app p t \<longrightarrow> app p s"
   26.41 -
   26.42 -
   26.43 -lemmas err_step_defs = err_step_def map_snd_def error_def
   26.44 -
   26.45 -
   26.46 -lemma bounded_err_stepD:
   26.47 -  "bounded (err_step n app step) n \<Longrightarrow> 
   26.48 -  p < n \<Longrightarrow>  app p a \<Longrightarrow> (q,b) \<in> set (step p a) \<Longrightarrow> 
   26.49 -  q < n"
   26.50 -  apply (simp add: bounded_def err_step_def)
   26.51 -  apply (erule allE, erule impE, assumption)
   26.52 -  apply (erule_tac x = "OK a" in allE, drule bspec)
   26.53 -   apply (simp add: map_snd_def)
   26.54 -   apply fast
   26.55 -  apply simp
   26.56 -  done
   26.57 -
   26.58 -
   26.59 -lemma in_map_sndD: "(a,b) \<in> set (map_snd f xs) \<Longrightarrow> \<exists>b'. (a,b') \<in> set xs"
   26.60 -  apply (induct xs)
   26.61 -  apply (auto simp add: map_snd_def)
   26.62 -  done
   26.63 -
   26.64 -
   26.65 -lemma bounded_err_stepI:
   26.66 -  "\<forall>p. p < n \<longrightarrow> (\<forall>s. ap p s \<longrightarrow> (\<forall>(q,s') \<in> set (step p s). q < n))
   26.67 -  \<Longrightarrow> bounded (err_step n ap step) n"
   26.68 -apply (clarsimp simp: bounded_def err_step_def split: err.splits)
   26.69 -apply (simp add: error_def image_def)
   26.70 -apply (blast dest: in_map_sndD)
   26.71 -done
   26.72 -
   26.73 -
   26.74 -lemma bounded_lift:
   26.75 -  "bounded step n \<Longrightarrow> bounded (err_step n app step) n"
   26.76 -  apply (unfold bounded_def err_step_def error_def)
   26.77 -  apply clarify
   26.78 -  apply (erule allE, erule impE, assumption)
   26.79 -  apply (case_tac s)
   26.80 -  apply (auto simp add: map_snd_def split: split_if_asm)
   26.81 -  done
   26.82 -
   26.83 -
   26.84 -lemma le_list_map_OK [simp]:
   26.85 -  "\<And>b. map OK a <=[Err.le r] map OK b = (a <=[r] b)"
   26.86 -  apply (induct a)
   26.87 -   apply simp
   26.88 -  apply simp
   26.89 -  apply (case_tac b)
   26.90 -   apply simp
   26.91 -  apply simp
   26.92 -  done
   26.93 -
   26.94 -
   26.95 -lemma map_snd_lessI:
   26.96 -  "x <=|r| y \<Longrightarrow> map_snd OK x <=|Err.le r| map_snd OK y"
   26.97 -  apply (induct x)
   26.98 -  apply (unfold lesubstep_type_def map_snd_def)
   26.99 -  apply auto
  26.100 -  done
  26.101 -
  26.102 -
  26.103 -lemma mono_lift:
  26.104 -  "order r \<Longrightarrow> app_mono r app n A \<Longrightarrow> bounded (err_step n app step) n \<Longrightarrow>
  26.105 -  \<forall>s p t. s \<in> A \<and> p < n \<and> s <=_r t \<longrightarrow> app p t \<longrightarrow> step p s <=|r| step p t \<Longrightarrow>
  26.106 -  mono (Err.le r) (err_step n app step) n (err A)"
  26.107 -apply (unfold app_mono_def mono_def err_step_def)
  26.108 -apply clarify
  26.109 -apply (case_tac s)
  26.110 - apply simp 
  26.111 -apply simp
  26.112 -apply (case_tac t)
  26.113 - apply simp
  26.114 - apply clarify
  26.115 - apply (simp add: lesubstep_type_def error_def)
  26.116 - apply clarify
  26.117 - apply (drule in_map_sndD)
  26.118 - apply clarify
  26.119 - apply (drule bounded_err_stepD, assumption+)
  26.120 - apply (rule exI [of _ Err])
  26.121 - apply simp
  26.122 -apply simp
  26.123 -apply (erule allE, erule allE, erule allE, erule impE)
  26.124 - apply (rule conjI, assumption)
  26.125 - apply (rule conjI, assumption)
  26.126 - apply assumption
  26.127 -apply (rule conjI)
  26.128 -apply clarify
  26.129 -apply (erule allE, erule allE, erule allE, erule impE)
  26.130 - apply (rule conjI, assumption)
  26.131 - apply (rule conjI, assumption)
  26.132 - apply assumption
  26.133 -apply (erule impE, assumption)
  26.134 -apply (rule map_snd_lessI, assumption)
  26.135 -apply clarify
  26.136 -apply (simp add: lesubstep_type_def error_def)
  26.137 -apply clarify
  26.138 -apply (drule in_map_sndD)
  26.139 -apply clarify
  26.140 -apply (drule bounded_err_stepD, assumption+)
  26.141 -apply (rule exI [of _ Err])
  26.142 -apply simp
  26.143 -done
  26.144 - 
  26.145 -lemma in_errorD:
  26.146 -  "(x,y) \<in> set (error n) \<Longrightarrow> y = Err"
  26.147 -  by (auto simp add: error_def)
  26.148 -
  26.149 -lemma pres_type_lift:
  26.150 -  "\<forall>s\<in>A. \<forall>p. p < n \<longrightarrow> app p s \<longrightarrow> (\<forall>(q, s')\<in>set (step p s). s' \<in> A) 
  26.151 -  \<Longrightarrow> pres_type (err_step n app step) n (err A)"  
  26.152 -apply (unfold pres_type_def err_step_def)
  26.153 -apply clarify
  26.154 -apply (case_tac b)
  26.155 - apply simp
  26.156 -apply (case_tac s)
  26.157 - apply simp
  26.158 - apply (drule in_errorD)
  26.159 - apply simp
  26.160 -apply (simp add: map_snd_def split: split_if_asm)
  26.161 - apply fast
  26.162 -apply (drule in_errorD)
  26.163 -apply simp
  26.164 -done
  26.165 -
  26.166 -
  26.167 -
  26.168 -text {*
  26.169 -  There used to be a condition here that each instruction must have a
  26.170 -  successor. This is not needed any more, because the definition of
  26.171 -  @{term error} trivially ensures that there is a successor for
  26.172 -  the critical case where @{term app} does not hold. 
  26.173 -*}
  26.174 -lemma wt_err_imp_wt_app_eff:
  26.175 -  assumes wt: "wt_err_step r (err_step (size ts) app step) ts"
  26.176 -  assumes b:  "bounded (err_step (size ts) app step) (size ts)"
  26.177 -  shows "wt_app_eff r app step (map ok_val ts)"
  26.178 -proof (unfold wt_app_eff_def, intro strip, rule conjI)
  26.179 -  fix p assume "p < size (map ok_val ts)"
  26.180 -  hence lp: "p < size ts" by simp
  26.181 -  hence ts: "0 < size ts" by (cases p) auto
  26.182 -  hence err: "(0,Err) \<in> set (error (size ts))" by (simp add: error_def)
  26.183 -
  26.184 -  from wt lp
  26.185 -  have [intro?]: "\<And>p. p < size ts \<Longrightarrow> ts ! p \<noteq> Err" 
  26.186 -    by (unfold wt_err_step_def wt_step_def) simp
  26.187 -
  26.188 -  show app: "app p (map ok_val ts ! p)"
  26.189 -  proof (rule ccontr)
  26.190 -    from wt lp obtain s where
  26.191 -      OKp:  "ts ! p = OK s" and
  26.192 -      less: "\<forall>(q,t) \<in> set (err_step (size ts) app step p (ts!p)). t <=_(Err.le r) ts!q"
  26.193 -      by (unfold wt_err_step_def wt_step_def stable_def) 
  26.194 -         (auto iff: not_Err_eq)
  26.195 -    assume "\<not> app p (map ok_val ts ! p)"
  26.196 -    with OKp lp have "\<not> app p s" by simp
  26.197 -    with OKp have "err_step (size ts) app step p (ts!p) = error (size ts)" 
  26.198 -      by (simp add: err_step_def)    
  26.199 -    with err ts obtain q where 
  26.200 -      "(q,Err) \<in> set (err_step (size ts) app step p (ts!p))" and
  26.201 -      q: "q < size ts" by auto    
  26.202 -    with less have "ts!q = Err" by auto
  26.203 -    moreover from q have "ts!q \<noteq> Err" ..
  26.204 -    ultimately show False by blast
  26.205 -  qed
  26.206 -  
  26.207 -  show "\<forall>(q,t)\<in>set(step p (map ok_val ts ! p)). t <=_r map ok_val ts ! q" 
  26.208 -  proof clarify
  26.209 -    fix q t assume q: "(q,t) \<in> set (step p (map ok_val ts ! p))"
  26.210 -
  26.211 -    from wt lp q
  26.212 -    obtain s where
  26.213 -      OKp:  "ts ! p = OK s" and
  26.214 -      less: "\<forall>(q,t) \<in> set (err_step (size ts) app step p (ts!p)). t <=_(Err.le r) ts!q"
  26.215 -      by (unfold wt_err_step_def wt_step_def stable_def) 
  26.216 -         (auto iff: not_Err_eq)
  26.217 -
  26.218 -    from b lp app q have lq: "q < size ts" by (rule bounded_err_stepD)
  26.219 -    hence "ts!q \<noteq> Err" ..
  26.220 -    then obtain s' where OKq: "ts ! q = OK s'" by (auto iff: not_Err_eq)
  26.221 -
  26.222 -    from lp lq OKp OKq app less q
  26.223 -    show "t <=_r map ok_val ts ! q"
  26.224 -      by (auto simp add: err_step_def map_snd_def) 
  26.225 -  qed
  26.226 -qed
  26.227 -
  26.228 -
  26.229 -lemma wt_app_eff_imp_wt_err:
  26.230 -  assumes app_eff: "wt_app_eff r app step ts"
  26.231 -  assumes bounded: "bounded (err_step (size ts) app step) (size ts)"
  26.232 -  shows "wt_err_step r (err_step (size ts) app step) (map OK ts)"
  26.233 -proof (unfold wt_err_step_def wt_step_def, intro strip, rule conjI)
  26.234 -  fix p assume "p < size (map OK ts)" 
  26.235 -  hence p: "p < size ts" by simp
  26.236 -  thus "map OK ts ! p \<noteq> Err" by simp
  26.237 -  { fix q t
  26.238 -    assume q: "(q,t) \<in> set (err_step (size ts) app step p (map OK ts ! p))" 
  26.239 -    with p app_eff obtain 
  26.240 -      "app p (ts ! p)" "\<forall>(q,t) \<in> set (step p (ts!p)). t <=_r ts!q"
  26.241 -      by (unfold wt_app_eff_def) blast
  26.242 -    moreover
  26.243 -    from q p bounded have "q < size ts"
  26.244 -      by - (rule boundedD)
  26.245 -    hence "map OK ts ! q = OK (ts!q)" by simp
  26.246 -    moreover
  26.247 -    have "p < size ts" by (rule p)
  26.248 -    moreover note q
  26.249 -    ultimately     
  26.250 -    have "t <=_(Err.le r) map OK ts ! q" 
  26.251 -      by (auto simp add: err_step_def map_snd_def)
  26.252 -  }
  26.253 -  thus "stable (Err.le r) (err_step (size ts) app step) (map OK ts) p"
  26.254 -    by (unfold stable_def) blast
  26.255 -qed
  26.256 -
  26.257 -end
  26.258 -
    29.1 --- a/src/HOL/MicroJava/Comp/CorrCompTp.thy	Wed Dec 02 12:04:07 2009 +0100
    29.2 +++ b/src/HOL/MicroJava/Comp/CorrCompTp.thy	Tue Nov 24 14:37:23 2009 +0100
    29.3 @@ -1122,6 +1122,8 @@
    29.4  apply simp+
    29.5  done
    29.6  
    29.7 +declare not_Err_eq [iff del]
    29.8 +
    29.9  lemma bc_mt_corresp_Load: "\<lbrakk> i < length LT; LT ! i \<noteq> Err; mxr = length LT \<rbrakk>
   29.10    \<Longrightarrow> bc_mt_corresp [Load i] 
   29.11           (\<lambda>(ST, LT). pushST [ok_val (LT ! i)] (ST, LT)) (ST, LT) cG rT mxr (Suc 0)"
   29.12 @@ -1138,7 +1140,7 @@
   29.13    apply (frule listE_nth_in) apply assumption
   29.14  apply (subgoal_tac "LT ! i \<in> {x. \<exists>y\<in>types cG. x = OK y}")
   29.15  apply (drule CollectD) apply (erule bexE)
   29.16 -apply (simp (no_asm_simp) )
   29.17 +apply (simp (no_asm_simp))
   29.18  apply blast
   29.19  apply blast
   29.20  done
    32.1 --- a/src/HOL/MicroJava/Comp/LemmasComp.thy	Wed Dec 02 12:04:07 2009 +0100
    32.2 +++ b/src/HOL/MicroJava/Comp/LemmasComp.thy	Tue Nov 24 14:37:23 2009 +0100
    32.3 @@ -110,7 +110,7 @@
    32.4  by (case_tac "class G C", auto simp: is_class_def dest: comp_class_imp)
    32.5  
    32.6  lemma comp_subcls1: "subcls1 (comp G) = subcls1 G"
    32.7 -by (auto simp add: subcls1_def2 comp_classname comp_is_class expand_fun_eq)
    32.8 +by (auto simp add: subcls1_def2 comp_classname comp_is_class)
    32.9  
   32.10  lemma comp_widen: "widen (comp G) = widen G"
   32.11    apply (simp add: expand_fun_eq)
   32.12 @@ -183,17 +183,17 @@
   32.13  done
   32.14  
   32.15  
   32.16 -lemma comp_class_rec: " wfP ((subcls1 G)^--1) \<Longrightarrow> 
   32.17 +lemma comp_class_rec: " wf ((subcls1 G)^-1) \<Longrightarrow> 
   32.18  class_rec (comp G) C t f = 
   32.19    class_rec G C t (\<lambda> C' fs' ms' r'. f C' fs' (map (compMethod G C') ms') r')"
   32.20 -apply (rule_tac a = C in  wfP_induct) apply assumption
   32.21 -apply (subgoal_tac "wfP ((subcls1 (comp G))\<inverse>\<inverse>)")
   32.22 +apply (rule_tac a = C in  wf_induct) apply assumption
   32.23 +apply (subgoal_tac "wf ((subcls1 (comp G))^-1)")
   32.24  apply (subgoal_tac "(class G x = None) \<or> (\<exists> D fs ms. (class G x = Some (D, fs, ms)))")
   32.25  apply (erule disjE)
   32.26  
   32.27    (* case class G x = None *)
   32.28  apply (simp (no_asm_simp) add: class_rec_def comp_subcls1
   32.29 -  wfrec [to_pred, where r="(subcls1 G)^--1", simplified])
   32.30 +  wfrec [where r="(subcls1 G)^-1", simplified])
   32.31  apply (simp add: comp_class_None)
   32.32  
   32.33    (* case \<exists> D fs ms. (class G x = Some (D, fs, ms)) *)
   32.34 @@ -218,11 +218,11 @@
   32.35  apply (simp add: comp_subcls1)
   32.36  done
   32.37  
   32.38 -lemma comp_fields: "wfP ((subcls1 G)^--1) \<Longrightarrow> 
   32.39 +lemma comp_fields: "wf ((subcls1 G)^-1) \<Longrightarrow> 
   32.40    fields (comp G,C) = fields (G,C)" 
   32.41  by (simp add: fields_def comp_class_rec)
   32.42  
   32.43 -lemma comp_field: "wfP ((subcls1 G)^--1) \<Longrightarrow> 
   32.44 +lemma comp_field: "wf ((subcls1 G)^-1) \<Longrightarrow> 
   32.45    field (comp G,C) = field (G,C)" 
   32.46  by (simp add: TypeRel.field_def comp_fields)
   32.47  
   32.48 @@ -234,7 +234,7 @@
   32.49    \<Longrightarrow> ((class G C) \<noteq> None) \<longrightarrow> 
   32.50    R (class_rec G C t1 f1) (class_rec G C t2 f2)"
   32.51  apply (frule wf_subcls1) (* establish wf ((subcls1 G)^-1) *)
   32.52 -apply (rule_tac a = C in  wfP_induct) apply assumption
   32.53 +apply (rule_tac a = C in  wf_induct) apply assumption
   32.54  apply (intro strip)
   32.55  apply (subgoal_tac "(\<exists>D rT mb. class G x = Some (D, rT, mb))")
   32.56    apply (erule exE)+
    37.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    37.2 +++ b/src/HOL/MicroJava/DFA/Abstract_BV.thy	Tue Nov 24 14:37:23 2009 +0100
    37.3 @@ -0,0 +1,14 @@
    37.4 +(*  Title:      HOL/MicroJava/BV/Semilat.thy
    37.5 +    Author:     Gerwin Klein
    37.6 +    Copyright   2003 TUM
    37.7 +*)
    37.8 +
    37.9 +header {* Abstract Bytecode Verifier *}
   37.10 +
   37.11 +(*<*)
   37.12 +theory Abstract_BV
   37.13 +imports Typing_Framework_err Kildall LBVCorrect LBVComplete
   37.14 +begin
   37.15 +
   37.16 +end
   37.17 +(*>*)
   37.18 \ No newline at end of file
    38.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    38.2 +++ b/src/HOL/MicroJava/DFA/Err.thy	Tue Nov 24 14:37:23 2009 +0100
    38.3 @@ -0,0 +1,350 @@
    38.4 +(*  Title:      HOL/MicroJava/BV/Err.thy
    38.5 +    Author:     Tobias Nipkow
    38.6 +    Copyright   2000 TUM
    38.7 +*)
    38.8 +
    38.9 +header {* \isaheader{The Error Type} *}
   38.10 +
   38.11 +theory Err
   38.12 +imports Semilat
   38.13 +begin
   38.14 +
   38.15 +datatype 'a err = Err | OK 'a
   38.16 +
   38.17 +types 'a ebinop = "'a \<Rightarrow> 'a \<Rightarrow> 'a err"
   38.18 +      'a esl =    "'a set * 'a ord * 'a ebinop"
   38.19 +
   38.20 +consts
   38.21 +  ok_val :: "'a err \<Rightarrow> 'a"
   38.22 +primrec
   38.23 +  "ok_val (OK x) = x"
   38.24 +
   38.25 +constdefs
   38.26 + lift :: "('a \<Rightarrow> 'b err) \<Rightarrow> ('a err \<Rightarrow> 'b err)"
   38.27 +"lift f e == case e of Err \<Rightarrow> Err | OK x \<Rightarrow> f x"
   38.28 +
   38.29 + lift2 :: "('a \<Rightarrow> 'b \<Rightarrow> 'c err) \<Rightarrow> 'a err \<Rightarrow> 'b err \<Rightarrow> 'c err"
   38.30 +"lift2 f e1 e2 ==
   38.31 + case e1 of Err  \<Rightarrow> Err
   38.32 +          | OK x \<Rightarrow> (case e2 of Err \<Rightarrow> Err | OK y \<Rightarrow> f x y)"
   38.33 +
   38.34 + le :: "'a ord \<Rightarrow> 'a err ord"
   38.35 +"le r e1 e2 ==
   38.36 +        case e2 of Err \<Rightarrow> True |
   38.37 +                   OK y \<Rightarrow> (case e1 of Err \<Rightarrow> False | OK x \<Rightarrow> x <=_r y)"
   38.38 +
   38.39 + sup :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> ('a err \<Rightarrow> 'b err \<Rightarrow> 'c err)"
   38.40 +"sup f == lift2(%x y. OK(x +_f y))"
   38.41 +
   38.42 + err :: "'a set \<Rightarrow> 'a err set"
   38.43 +"err A == insert Err {x . ? y:A. x = OK y}"
   38.44 +
   38.45 + esl :: "'a sl \<Rightarrow> 'a esl"
   38.46 +"esl == %(A,r,f). (A,r, %x y. OK(f x y))"
   38.47 +
   38.48 + sl :: "'a esl \<Rightarrow> 'a err sl"
   38.49 +"sl == %(A,r,f). (err A, le r, lift2 f)"
   38.50 +
   38.51 +syntax
   38.52 + err_semilat :: "'a esl \<Rightarrow> bool"
   38.53 +translations
   38.54 +"err_semilat L" == "semilat(Err.sl L)"
   38.55 +
   38.56 +
   38.57 +consts
   38.58 +  strict  :: "('a \<Rightarrow> 'b err) \<Rightarrow> ('a err \<Rightarrow> 'b err)"
   38.59 +primrec
   38.60 +  "strict f Err    = Err"
   38.61 +  "strict f (OK x) = f x"
   38.62 +
   38.63 +lemma strict_Some [simp]: 
   38.64 +  "(strict f x = OK y) = (\<exists> z. x = OK z \<and> f z = OK y)"
   38.65 +  by (cases x, auto)
   38.66 +
   38.67 +lemma not_Err_eq:
   38.68 +  "(x \<noteq> Err) = (\<exists>a. x = OK a)" 
   38.69 +  by (cases x) auto
   38.70 +
   38.71 +lemma not_OK_eq:
   38.72 +  "(\<forall>y. x \<noteq> OK y) = (x = Err)"
   38.73 +  by (cases x) auto  
   38.74 +
   38.75 +lemma unfold_lesub_err:
   38.76 +  "e1 <=_(le r) e2 == le r e1 e2"
   38.77 +  by (simp add: lesub_def)
   38.78 +
   38.79 +lemma le_err_refl:
   38.80 +  "!x. x <=_r x \<Longrightarrow> e <=_(Err.le r) e"
   38.81 +apply (unfold lesub_def Err.le_def)
   38.82 +apply (simp split: err.split)
   38.83 +done 
   38.84 +
   38.85 +lemma le_err_trans [rule_format]:
   38.86 +  "order r \<Longrightarrow> e1 <=_(le r) e2 \<longrightarrow> e2 <=_(le r) e3 \<longrightarrow> e1 <=_(le r) e3"
   38.87 +apply (unfold unfold_lesub_err le_def)
   38.88 +apply (simp split: err.split)
   38.89 +apply (blast intro: order_trans)
   38.90 +done
   38.91 +
   38.92 +lemma le_err_antisym [rule_format]:
   38.93 +  "order r \<Longrightarrow> e1 <=_(le r) e2 \<longrightarrow> e2 <=_(le r) e1 \<longrightarrow> e1=e2"
   38.94 +apply (unfold unfold_lesub_err le_def)
   38.95 +apply (simp split: err.split)
   38.96 +apply (blast intro: order_antisym)
   38.97 +done 
   38.98 +
   38.99 +lemma OK_le_err_OK:
  38.100 +  "(OK x <=_(le r) OK y) = (x <=_r y)"
  38.101 +  by (simp add: unfold_lesub_err le_def)
  38.102 +
  38.103 +lemma order_le_err [iff]:
  38.104 +  "order(le r) = order r"
  38.105 +apply (rule iffI)
  38.106 + apply (subst Semilat.order_def)
  38.107 + apply (blast dest: order_antisym OK_le_err_OK [THEN iffD2]
  38.108 +              intro: order_trans OK_le_err_OK [THEN iffD1])
  38.109 +apply (subst Semilat.order_def)
  38.110 +apply (blast intro: le_err_refl le_err_trans le_err_antisym
  38.111 +             dest: order_refl)
  38.112 +done 
  38.113 +
  38.114 +lemma le_Err [iff]:  "e <=_(le r) Err"
  38.115 +  by (simp add: unfold_lesub_err le_def)
  38.116 +
  38.117 +lemma Err_le_conv [iff]:
  38.118 + "Err <=_(le r) e  = (e = Err)"
  38.119 +  by (simp add: unfold_lesub_err le_def  split: err.split)
  38.120 +
  38.121 +lemma le_OK_conv [iff]:
  38.122 +  "e <=_(le r) OK x  =  (? y. e = OK y & y <=_r x)"
  38.123 +  by (simp add: unfold_lesub_err le_def split: err.split)
  38.124 +
  38.125 +lemma OK_le_conv:
  38.126 + "OK x <=_(le r) e  =  (e = Err | (? y. e = OK y & x <=_r y))"
  38.127 +  by (simp add: unfold_lesub_err le_def split: err.split)
  38.128 +
  38.129 +lemma top_Err [iff]: "top (le r) Err";
  38.130 +  by (simp add: top_def)
  38.131 +
  38.132 +lemma OK_less_conv [rule_format, iff]:
  38.133 +  "OK x <_(le r) e = (e=Err | (? y. e = OK y & x <_r y))"
  38.134 +  by (simp add: lesssub_def lesub_def le_def split: err.split)
  38.135 +
  38.136 +lemma not_Err_less [rule_format, iff]:
  38.137 +  "~(Err <_(le r) x)"
  38.138 +  by (simp add: lesssub_def lesub_def le_def split: err.split)
  38.139 +
  38.140 +lemma semilat_errI [intro]:
  38.141 +  assumes semilat: "semilat (A, r, f)"
  38.142 +  shows "semilat(err A, Err.le r, lift2(%x y. OK(f x y)))"
  38.143 +  apply(insert semilat)
  38.144 +  apply (unfold semilat_Def closed_def plussub_def lesub_def 
  38.145 +    lift2_def Err.le_def err_def)
  38.146 +  apply (simp split: err.split)
  38.147 +  done
  38.148 +
  38.149 +lemma err_semilat_eslI_aux:
  38.150 +  assumes semilat: "semilat (A, r, f)"
  38.151 +  shows "err_semilat(esl(A,r,f))"
  38.152 +  apply (unfold sl_def esl_def)
  38.153 +  apply (simp add: semilat_errI[OF semilat])
  38.154 +  done
  38.155 +
  38.156 +lemma err_semilat_eslI [intro, simp]:
  38.157 + "\<And>L. semilat L \<Longrightarrow> err_semilat(esl L)"
  38.158 +by(simp add: err_semilat_eslI_aux split_tupled_all)
  38.159 +
  38.160 +lemma acc_err [simp, intro!]:  "acc r \<Longrightarrow> acc(le r)"
  38.161 +apply (unfold acc_def lesub_def le_def lesssub_def)
  38.162 +apply (simp add: wf_eq_minimal split: err.split)
  38.163 +apply clarify
  38.164 +apply (case_tac "Err : Q")
  38.165 + apply blast
  38.166 +apply (erule_tac x = "{a . OK a : Q}" in allE)
  38.167 +apply (case_tac "x")
  38.168 + apply fast
  38.169 +apply blast
  38.170 +done 
  38.171 +
  38.172 +lemma Err_in_err [iff]: "Err : err A"
  38.173 +  by (simp add: err_def)
  38.174 +
  38.175 +lemma Ok_in_err [iff]: "(OK x : err A) = (x:A)"
  38.176 +  by (auto simp add: err_def)
  38.177 +
  38.178 +section {* lift *}
  38.179 +
  38.180 +lemma lift_in_errI:
  38.181 +  "\<lbrakk> e : err S; !x:S. e = OK x \<longrightarrow> f x : err S \<rbrakk> \<Longrightarrow> lift f e : err S"
  38.182 +apply (unfold lift_def)
  38.183 +apply (simp split: err.split)
  38.184 +apply blast
  38.185 +done 
  38.186 +
  38.187 +lemma Err_lift2 [simp]: 
  38.188 +  "Err +_(lift2 f) x = Err"
  38.189 +  by (simp add: lift2_def plussub_def)
  38.190 +
  38.191 +lemma lift2_Err [simp]: 
  38.192 +  "x +_(lift2 f) Err = Err"
  38.193 +  by (simp add: lift2_def plussub_def split: err.split)
  38.194 +
  38.195 +lemma OK_lift2_OK [simp]:
  38.196 +  "OK x +_(lift2 f) OK y = x +_f y"
  38.197 +  by (simp add: lift2_def plussub_def split: err.split)
  38.198 +
  38.199 +
  38.200 +section {* sup *}
  38.201 +
  38.202 +lemma Err_sup_Err [simp]:
  38.203 +  "Err +_(Err.sup f) x = Err"
  38.204 +  by (simp add: plussub_def Err.sup_def Err.lift2_def)
  38.205 +
  38.206 +lemma Err_sup_Err2 [simp]:
  38.207 +  "x +_(Err.sup f) Err = Err"
  38.208 +  by (simp add: plussub_def Err.sup_def Err.lift2_def split: err.split)
  38.209 +
  38.210 +lemma Err_sup_OK [simp]:
  38.211 +  "OK x +_(Err.sup f) OK y = OK(x +_f y)"
  38.212 +  by (simp add: plussub_def Err.sup_def Err.lift2_def)
  38.213 +
  38.214 +lemma Err_sup_eq_OK_conv [iff]:
  38.215 +  "(Err.sup f ex ey = OK z) = (? x y. ex = OK x & ey = OK y & f x y = z)"
  38.216 +apply (unfold Err.sup_def lift2_def plussub_def)
  38.217 +apply (rule iffI)
  38.218 + apply (simp split: err.split_asm)
  38.219 +apply clarify
  38.220 +apply simp
  38.221 +done
  38.222 +
  38.223 +lemma Err_sup_eq_Err [iff]:
  38.224 +  "(Err.sup f ex ey = Err) = (ex=Err | ey=Err)"
  38.225 +apply (unfold Err.sup_def lift2_def plussub_def)
  38.226 +apply (simp split: err.split)
  38.227 +done 
  38.228 +
  38.229 +section {* semilat (err A) (le r) f *}
  38.230 +
  38.231 +lemma semilat_le_err_Err_plus [simp]:
  38.232 +  "\<lbrakk> x: err A; semilat(err A, le r, f) \<rbrakk> \<Longrightarrow> Err +_f x = Err"
  38.233 +  by (blast intro: Semilat.le_iff_plus_unchanged [OF Semilat.intro, THEN iffD1]
  38.234 +                   Semilat.le_iff_plus_unchanged2 [OF Semilat.intro, THEN iffD1])
  38.235 +
  38.236 +lemma semilat_le_err_plus_Err [simp]:
  38.237 +  "\<lbrakk> x: err A; semilat(err A, le r, f) \<rbrakk> \<Longrightarrow> x +_f Err = Err"
  38.238 +  by (blast intro: Semilat.le_iff_plus_unchanged [OF Semilat.intro, THEN iffD1]
  38.239 +                   Semilat.le_iff_plus_unchanged2 [OF Semilat.intro, THEN iffD1])
  38.240 +
  38.241 +lemma semilat_le_err_OK1:
  38.242 +  "\<lbrakk> x:A; y:A; semilat(err A, le r, f); OK x +_f OK y = OK z \<rbrakk> 
  38.243 +  \<Longrightarrow> x <=_r z";
  38.244 +apply (rule OK_le_err_OK [THEN iffD1])
  38.245 +apply (erule subst)
  38.246 +apply (simp add: Semilat.ub1 [OF Semilat.intro])
  38.247 +done
  38.248 +
  38.249 +lemma semilat_le_err_OK2:
  38.250 +  "\<lbrakk> x:A; y:A; semilat(err A, le r, f); OK x +_f OK y = OK z \<rbrakk> 
  38.251 +  \<Longrightarrow> y <=_r z"
  38.252 +apply (rule OK_le_err_OK [THEN iffD1])
  38.253 +apply (erule subst)
  38.254 +apply (simp add: Semilat.ub2 [OF Semilat.intro])
  38.255 +done
  38.256 +
  38.257 +lemma eq_order_le:
  38.258 +  "\<lbrakk> x=y; order r \<rbrakk> \<Longrightarrow> x <=_r y"
  38.259 +apply (unfold Semilat.order_def)
  38.260 +apply blast
  38.261 +done
  38.262 +
  38.263 +lemma OK_plus_OK_eq_Err_conv [simp]:
  38.264 +  assumes "x:A" and "y:A" and "semilat(err A, le r, fe)"
  38.265 +  shows "((OK x) +_fe (OK y) = Err) = (~(? z:A. x <=_r z & y <=_r z))"
  38.266 +proof -
  38.267 +  have plus_le_conv3: "\<And>A x y z f r. 
  38.268 +    \<lbrakk> semilat (A,r,f); x +_f y <=_r z; x:A; y:A; z:A \<rbrakk> 
  38.269 +    \<Longrightarrow> x <=_r z \<and> y <=_r z"
  38.270 +    by (rule Semilat.plus_le_conv [OF Semilat.intro, THEN iffD1])
  38.271 +  from prems show ?thesis
  38.272 +  apply (rule_tac iffI)
  38.273 +   apply clarify
  38.274 +   apply (drule OK_le_err_OK [THEN iffD2])
  38.275 +   apply (drule OK_le_err_OK [THEN iffD2])
  38.276 +   apply (drule Semilat.lub [OF Semilat.intro, of _ _ _ "OK x" _ "OK y"])
  38.277 +        apply assumption
  38.278 +       apply assumption
  38.279 +      apply simp
  38.280 +     apply simp
  38.281 +    apply simp
  38.282 +   apply simp
  38.283 +  apply (case_tac "(OK x) +_fe (OK y)")
  38.284 +   apply assumption
  38.285 +  apply (rename_tac z)
  38.286 +  apply (subgoal_tac "OK z: err A")
  38.287 +  apply (drule eq_order_le)
  38.288 +    apply (erule Semilat.orderI [OF Semilat.intro])
  38.289 +   apply (blast dest: plus_le_conv3) 
  38.290 +  apply (erule subst)
  38.291 +  apply (blast intro: Semilat.closedI [OF Semilat.intro] closedD)
  38.292 +  done 
  38.293 +qed
  38.294 +
  38.295 +section {* semilat (err(Union AS)) *}
  38.296 +
  38.297 +(* FIXME? *)
  38.298 +lemma all_bex_swap_lemma [iff]:
  38.299 +  "(!x. (? y:A. x = f y) \<longrightarrow> P x) = (!y:A. P(f y))"
  38.300 +  by blast
  38.301 +
  38.302 +lemma closed_err_Union_lift2I: 
  38.303 +  "\<lbrakk> !A:AS. closed (err A) (lift2 f); AS ~= {}; 
  38.304 +      !A:AS.!B:AS. A~=B \<longrightarrow> (!a:A.!b:B. a +_f b = Err) \<rbrakk> 
  38.305 +  \<Longrightarrow> closed (err(Union AS)) (lift2 f)"
  38.306 +apply (unfold closed_def err_def)
  38.307 +apply simp
  38.308 +apply clarify
  38.309 +apply simp
  38.310 +apply fast
  38.311 +done 
  38.312 +
  38.313 +text {* 
  38.314 +  If @{term "AS = {}"} the thm collapses to
  38.315 +  @{prop "order r & closed {Err} f & Err +_f Err = Err"}
  38.316 +  which may not hold 
  38.317 +*}
  38.318 +lemma err_semilat_UnionI:
  38.319 +  "\<lbrakk> !A:AS. err_semilat(A, r, f); AS ~= {}; 
  38.320 +      !A:AS.!B:AS. A~=B \<longrightarrow> (!a:A.!b:B. ~ a <=_r b & a +_f b = Err) \<rbrakk> 
  38.321 +  \<Longrightarrow> err_semilat(Union AS, r, f)"
  38.322 +apply (unfold semilat_def sl_def)
  38.323 +apply (simp add: closed_err_Union_lift2I)
  38.324 +apply (rule conjI)
  38.325 + apply blast
  38.326 +apply (simp add: err_def)
  38.327 +apply (rule conjI)
  38.328 + apply clarify
  38.329 + apply (rename_tac A a u B b)
  38.330 + apply (case_tac "A = B")
  38.331 +  apply simp
  38.332 + apply simp
  38.333 +apply (rule conjI)
  38.334 + apply clarify
  38.335 + apply (rename_tac A a u B b)
  38.336 + apply (case_tac "A = B")
  38.337 +  apply simp
  38.338 + apply simp
  38.339 +apply clarify
  38.340 +apply (rename_tac A ya yb B yd z C c a b)
  38.341 +apply (case_tac "A = B")
  38.342 + apply (case_tac "A = C")
  38.343 +  apply simp
  38.344 + apply (rotate_tac -1)
  38.345 + apply simp
  38.346 +apply (rotate_tac -1)
  38.347 +apply (case_tac "B = C")
  38.348 + apply simp
  38.349 +apply (rotate_tac -1)
  38.350 +apply simp
  38.351 +done 
  38.352 +
  38.353 +end
    39.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    39.2 +++ b/src/HOL/MicroJava/DFA/Kildall.thy	Tue Nov 24 14:37:23 2009 +0100
    39.3 @@ -0,0 +1,495 @@
    39.4 +(*  Title:      HOL/MicroJava/BV/Kildall.thy
    39.5 +    Author:     Tobias Nipkow, Gerwin Klein
    39.6 +    Copyright   2000 TUM
    39.7 +*)
    39.8 +
    39.9 +header {* \isaheader{Kildall's Algorithm}\label{sec:Kildall} *}
   39.10 +
   39.11 +theory Kildall
   39.12 +imports SemilatAlg While_Combinator
   39.13 +begin
   39.14 +
   39.15 +
   39.16 +consts
   39.17 + iter :: "'s binop \<Rightarrow> 's step_type \<Rightarrow>
   39.18 +          's list \<Rightarrow> nat set \<Rightarrow> 's list \<times> nat set"
   39.19 + propa :: "'s binop \<Rightarrow> (nat \<times> 's) list \<Rightarrow> 's list \<Rightarrow> nat set \<Rightarrow> 's list * nat set"
   39.20 +
   39.21 +primrec
   39.22 +"propa f []      ss w = (ss,w)"
   39.23 +"propa f (q'#qs) ss w = (let (q,t) = q';
   39.24 +                             u = t +_f ss!q;
   39.25 +                             w' = (if u = ss!q then w else insert q w)
   39.26 +                         in propa f qs (ss[q := u]) w')"
   39.27 +
   39.28 +defs iter_def:
   39.29 +"iter f step ss w ==
   39.30 + while (%(ss,w). w \<noteq> {})
   39.31 +       (%(ss,w). let p = SOME p. p \<in> w
   39.32 +                 in propa f (step p (ss!p)) ss (w-{p}))
   39.33 +       (ss,w)"
   39.34 +
   39.35 +constdefs
   39.36 + unstables :: "'s ord \<Rightarrow> 's step_type \<Rightarrow> 's list \<Rightarrow> nat set"
   39.37 +"unstables r step ss == {p. p < size ss \<and> \<not>stable r step ss p}"
   39.38 +
   39.39 + kildall :: "'s ord \<Rightarrow> 's binop \<Rightarrow> 's step_type \<Rightarrow> 's list \<Rightarrow> 's list"
   39.40 +"kildall r f step ss == fst(iter f step ss (unstables r step ss))"
   39.41 +
   39.42 +consts merges :: "'s binop \<Rightarrow> (nat \<times> 's) list \<Rightarrow> 's list \<Rightarrow> 's list"
   39.43 +primrec
   39.44 +"merges f []      ss = ss"
   39.45 +"merges f (p'#ps) ss = (let (p,s) = p' in merges f ps (ss[p := s +_f ss!p]))"
   39.46 +
   39.47 +
   39.48 +lemmas [simp] = Let_def Semilat.le_iff_plus_unchanged [OF Semilat.intro, symmetric]
   39.49 +
   39.50 +
   39.51 +lemma (in Semilat) nth_merges:
   39.52 + "\<And>ss. \<lbrakk>p < length ss; ss \<in> list n A; \<forall>(p,t)\<in>set ps. p<n \<and> t\<in>A \<rbrakk> \<Longrightarrow>
   39.53 +  (merges f ps ss)!p = map snd [(p',t') \<leftarrow> ps. p'=p] ++_f ss!p"
   39.54 +  (is "\<And>ss. \<lbrakk>_; _; ?steptype ps\<rbrakk> \<Longrightarrow> ?P ss ps")
   39.55 +proof (induct ps)
   39.56 +  show "\<And>ss. ?P ss []" by simp
   39.57 +
   39.58 +  fix ss p' ps'
   39.59 +  assume ss: "ss \<in> list n A"
   39.60 +  assume l:  "p < length ss"
   39.61 +  assume "?steptype (p'#ps')"
   39.62 +  then obtain a b where
   39.63 +    p': "p'=(a,b)" and ab: "a<n" "b\<in>A" and ps': "?steptype ps'"
   39.64 +    by (cases p') auto
   39.65 +  assume "\<And>ss. p< length ss \<Longrightarrow> ss \<in> list n A \<Longrightarrow> ?steptype ps' \<Longrightarrow> ?P ss ps'"
   39.66 +  from this [OF _ _ ps'] have IH: "\<And>ss. ss \<in> list n A \<Longrightarrow> p < length ss \<Longrightarrow> ?P ss ps'" .
   39.67 +
   39.68 +  from ss ab
   39.69 +  have "ss[a := b +_f ss!a] \<in> list n A" by (simp add: closedD)
   39.70 +  moreover
   39.71 +  from calculation l
   39.72 +  have "p < length (ss[a := b +_f ss!a])" by simp
   39.73 +  ultimately
   39.74 +  have "?P (ss[a := b +_f ss!a]) ps'" by (rule IH)
   39.75 +  with p' l
   39.76 +  show "?P ss (p'#ps')" by simp
   39.77 +qed
   39.78 +
   39.79 +
   39.80 +(** merges **)
   39.81 +
   39.82 +lemma length_merges [rule_format, simp]:
   39.83 +  "\<forall>ss. size(merges f ps ss) = size ss"
   39.84 +  by (induct_tac ps, auto)
   39.85 +
   39.86 +
   39.87 +lemma (in Semilat) merges_preserves_type_lemma:
   39.88 +shows "\<forall>xs. xs \<in> list n A \<longrightarrow> (\<forall>(p,x) \<in> set ps. p<n \<and> x\<in>A)
   39.89 +          \<longrightarrow> merges f ps xs \<in> list n A"
   39.90 +apply (insert closedI)
   39.91 +apply (unfold closed_def)
   39.92 +apply (induct_tac ps)
   39.93 + apply simp
   39.94 +apply clarsimp
   39.95 +done
   39.96 +
   39.97 +lemma (in Semilat) merges_preserves_type [simp]:
   39.98 + "\<lbrakk> xs \<in> list n A; \<forall>(p,x) \<in> set ps. p<n \<and> x\<in>A \<rbrakk>
   39.99 +  \<Longrightarrow> merges f ps xs \<in> list n A"
  39.100 +by (simp add: merges_preserves_type_lemma)
  39.101 +
  39.102 +lemma (in Semilat) merges_incr_lemma:
  39.103 + "\<forall>xs. xs \<in> list n A \<longrightarrow> (\<forall>(p,x)\<in>set ps. p<size xs \<and> x \<in> A) \<longrightarrow> xs <=[r] merges f ps xs"
  39.104 +apply (induct_tac ps)
  39.105 + apply simp
  39.106 +apply simp
  39.107 +apply clarify
  39.108 +apply (rule order_trans)
  39.109 +  apply simp
  39.110 + apply (erule list_update_incr)
  39.111 +  apply simp
  39.112 + apply simp
  39.113 +apply (blast intro!: listE_set intro: closedD listE_length [THEN nth_in])
  39.114 +done
  39.115 +
  39.116 +lemma (in Semilat) merges_incr:
  39.117 + "\<lbrakk> xs \<in> list n A; \<forall>(p,x)\<in>set ps. p<size xs \<and> x \<in> A \<rbrakk> 
  39.118 +  \<Longrightarrow> xs <=[r] merges f ps xs"
  39.119 +  by (simp add: merges_incr_lemma)
  39.120 +
  39.121 +
  39.122 +lemma (in Semilat) merges_same_conv [rule_format]:
  39.123 + "(\<forall>xs. xs \<in> list n A \<longrightarrow> (\<forall>(p,x)\<in>set ps. p<size xs \<and> x\<in>A) \<longrightarrow> 
  39.124 +     (merges f ps xs = xs) = (\<forall>(p,x)\<in>set ps. x <=_r xs!p))"
  39.125 +  apply (induct_tac ps)
  39.126 +   apply simp
  39.127 +  apply clarsimp
  39.128 +  apply (rename_tac p x ps xs)
  39.129 +  apply (rule iffI)
  39.130 +   apply (rule context_conjI)
  39.131 +    apply (subgoal_tac "xs[p := x +_f xs!p] <=[r] xs")
  39.132 +     apply (drule_tac p = p in le_listD)
  39.133 +      apply simp
  39.134 +     apply simp
  39.135 +    apply (erule subst, rule merges_incr)
  39.136 +       apply (blast intro!: listE_set intro: closedD listE_length [THEN nth_in])
  39.137 +      apply clarify
  39.138 +      apply (rule conjI)
  39.139 +       apply simp
  39.140 +       apply (blast dest: boundedD)
  39.141 +      apply blast
  39.142 +   apply clarify
  39.143 +   apply (erule allE)
  39.144 +   apply (erule impE)
  39.145 +    apply assumption
  39.146 +   apply (drule bspec)
  39.147 +    apply assumption
  39.148 +   apply (simp add: le_iff_plus_unchanged [THEN iffD1] list_update_same_conv [THEN iffD2])
  39.149 +   apply blast
  39.150 +  apply clarify 
  39.151 +  apply (simp add: le_iff_plus_unchanged [THEN iffD1] list_update_same_conv [THEN iffD2])
  39.152 +  done
  39.153 +
  39.154 +
  39.155 +lemma (in Semilat) list_update_le_listI [rule_format]:
  39.156 +  "set xs <= A \<longrightarrow> set ys <= A \<longrightarrow> xs <=[r] ys \<longrightarrow> p < size xs \<longrightarrow>  
  39.157 +   x <=_r ys!p \<longrightarrow> x\<in>A \<longrightarrow> xs[p := x +_f xs!p] <=[r] ys"
  39.158 +  apply(insert semilat)
  39.159 +  apply (unfold Listn.le_def lesub_def semilat_def)
  39.160 +  apply (simp add: list_all2_conv_all_nth nth_list_update)
  39.161 +  done
  39.162 +
  39.163 +lemma (in Semilat) merges_pres_le_ub:
  39.164 +  assumes "set ts <= A" and "set ss <= A"
  39.165 +    and "\<forall>(p,t)\<in>set ps. t <=_r ts!p \<and> t \<in> A \<and> p < size ts" and "ss <=[r] ts"
  39.166 +  shows "merges f ps ss <=[r] ts"
  39.167 +proof -
  39.168 +  { fix t ts ps
  39.169 +    have
  39.170 +    "\<And>qs. \<lbrakk>set ts <= A; \<forall>(p,t)\<in>set ps. t <=_r ts!p \<and> t \<in> A \<and> p< size ts \<rbrakk> \<Longrightarrow>
  39.171 +    set qs <= set ps  \<longrightarrow> 
  39.172 +    (\<forall>ss. set ss <= A \<longrightarrow> ss <=[r] ts \<longrightarrow> merges f qs ss <=[r] ts)"
  39.173 +    apply (induct_tac qs)
  39.174 +     apply simp
  39.175 +    apply (simp (no_asm_simp))
  39.176 +    apply clarify
  39.177 +    apply (rotate_tac -2)
  39.178 +    apply simp
  39.179 +    apply (erule allE, erule impE, erule_tac [2] mp)
  39.180 +     apply (drule bspec, assumption)
  39.181 +     apply (simp add: closedD)
  39.182 +    apply (drule bspec, assumption)
  39.183 +    apply (simp add: list_update_le_listI)
  39.184 +    done 
  39.185 +  } note this [dest]
  39.186 +  
  39.187 +  from prems show ?thesis by blast
  39.188 +qed
  39.189 +
  39.190 +
  39.191 +(** propa **)
  39.192 +
  39.193 +
  39.194 +lemma decomp_propa:
  39.195 +  "\<And>ss w. (\<forall>(q,t)\<in>set qs. q < size ss) \<Longrightarrow> 
  39.196 +   propa f qs ss w = 
  39.197 +   (merges f qs ss, {q. \<exists>t. (q,t)\<in>set qs \<and> t +_f ss!q \<noteq> ss!q} Un w)"
  39.198 +  apply (induct qs)
  39.199 +   apply simp   
  39.200 +  apply (simp (no_asm))
  39.201 +  apply clarify  
  39.202 +  apply simp
  39.203 +  apply (rule conjI) 
  39.204 +   apply blast
  39.205 +  apply (simp add: nth_list_update)
  39.206 +  apply blast
  39.207 +  done 
  39.208 +
  39.209 +(** iter **)
  39.210 +
  39.211 +lemma (in Semilat) stable_pres_lemma:
  39.212 +shows "\<lbrakk>pres_type step n A; bounded step n; 
  39.213 +     ss \<in> list n A; p \<in> w; \<forall>q\<in>w. q < n; 
  39.214 +     \<forall>q. q < n \<longrightarrow> q \<notin> w \<longrightarrow> stable r step ss q; q < n; 
  39.215 +     \<forall>s'. (q,s') \<in> set (step p (ss ! p)) \<longrightarrow> s' +_f ss ! q = ss ! q; 
  39.216 +     q \<notin> w \<or> q = p \<rbrakk> 
  39.217 +  \<Longrightarrow> stable r step (merges f (step p (ss!p)) ss) q"
  39.218 +  apply (unfold stable_def)
  39.219 +  apply (subgoal_tac "\<forall>s'. (q,s') \<in> set (step p (ss!p)) \<longrightarrow> s' : A")
  39.220 +   prefer 2
  39.221 +   apply clarify
  39.222 +   apply (erule pres_typeD)
  39.223 +    prefer 3 apply assumption
  39.224 +    apply (rule listE_nth_in)
  39.225 +     apply assumption
  39.226 +    apply simp
  39.227 +   apply simp
  39.228 +  apply simp
  39.229 +  apply clarify
  39.230 +  apply (subst nth_merges)
  39.231 +       apply simp
  39.232 +       apply (blast dest: boundedD)
  39.233 +      apply assumption
  39.234 +     apply clarify
  39.235 +     apply (rule conjI)
  39.236 +      apply (blast dest: boundedD)
  39.237 +     apply (erule pres_typeD)
  39.238 +       prefer 3 apply assumption
  39.239 +      apply simp
  39.240 +     apply simp
  39.241 +apply(subgoal_tac "q < length ss")
  39.242 +prefer 2 apply simp
  39.243 +  apply (frule nth_merges [of q _ _ "step p (ss!p)"]) (* fixme: why does method subst not work?? *)
  39.244 +apply assumption
  39.245 +  apply clarify
  39.246 +  apply (rule conjI)
  39.247 +   apply (blast dest: boundedD)
  39.248 +  apply (erule pres_typeD)
  39.249 +     prefer 3 apply assumption
  39.250 +    apply simp
  39.251 +   apply simp
  39.252 +  apply (drule_tac P = "\<lambda>x. (a, b) \<in> set (step q x)" in subst)
  39.253 +   apply assumption
  39.254 +
  39.255 + apply (simp add: plusplus_empty)
  39.256 + apply (cases "q \<in> w")
  39.257 +  apply simp
  39.258 +  apply (rule ub1')
  39.259 +     apply (rule semilat)
  39.260 +    apply clarify
  39.261 +    apply (rule pres_typeD)
  39.262 +       apply assumption
  39.263 +      prefer 3 apply assumption
  39.264 +     apply (blast intro: listE_nth_in dest: boundedD)
  39.265 +    apply (blast intro: pres_typeD dest: boundedD)
  39.266 +   apply (blast intro: listE_nth_in dest: boundedD)
  39.267 +  apply assumption
  39.268 +
  39.269 + apply simp
  39.270 + apply (erule allE, erule impE, assumption, erule impE, assumption)
  39.271 + apply (rule order_trans)
  39.272 +   apply simp
  39.273 +  defer
  39.274 + apply (rule pp_ub2)(*
  39.275 +    apply assumption*)
  39.276 +   apply simp
  39.277 +   apply clarify
  39.278 +   apply simp
  39.279 +   apply (rule pres_typeD)
  39.280 +      apply assumption
  39.281 +     prefer 3 apply assumption
  39.282 +    apply (blast intro: listE_nth_in dest: boundedD)
  39.283 +   apply (blast intro: pres_typeD dest: boundedD)
  39.284 +  apply (blast intro: listE_nth_in dest: boundedD)
  39.285 + apply blast
  39.286 + done
  39.287 +
  39.288 +
  39.289 +lemma (in Semilat) merges_bounded_lemma:
  39.290 + "\<lbrakk> mono r step n A; bounded step n; 
  39.291 +    \<forall>(p',s') \<in> set (step p (ss!p)). s' \<in> A; ss \<in> list n A; ts \<in> list n A; p < n; 
  39.292 +    ss <=[r] ts; \<forall>p. p < n \<longrightarrow> stable r step ts p \<rbrakk> 
  39.293 +  \<Longrightarrow> merges f (step p (ss!p)) ss <=[r] ts" 
  39.294 +  apply (unfold stable_def)
  39.295 +  apply (rule merges_pres_le_ub)
  39.296 +     apply simp
  39.297 +    apply simp
  39.298 +   prefer 2 apply assumption
  39.299 +
  39.300 +  apply clarsimp
  39.301 +  apply (drule boundedD, assumption+)
  39.302 +  apply (erule allE, erule impE, assumption)
  39.303 +  apply (drule bspec, assumption)
  39.304 +  apply simp
  39.305 +
  39.306 +  apply (drule monoD [of _ _ _ _ p "ss!p"  "ts!p"])
  39.307 +     apply assumption
  39.308 +    apply simp
  39.309 +   apply (simp add: le_listD)
  39.310 +  
  39.311 +  apply (drule lesub_step_typeD, assumption) 
  39.312 +  apply clarify
  39.313 +  apply (drule bspec, assumption)
  39.314 +  apply simp
  39.315 +  apply (blast intro: order_trans)
  39.316 +  done
  39.317 +
  39.318 +lemma termination_lemma:
  39.319 +  assumes semilat: "semilat (A, r, f)"
  39.320 +  shows "\<lbrakk> ss \<in> list n A; \<forall>(q,t)\<in>set qs. q<n \<and> t\<in>A; p\<in>w \<rbrakk> \<Longrightarrow> 
  39.321 +  ss <[r] merges f qs ss \<or> 
  39.322 +  merges f qs ss = ss \<and> {q. \<exists>t. (q,t)\<in>set qs \<and> t +_f ss!q \<noteq> ss!q} Un (w-{p}) < w" (is "PROP ?P")
  39.323 +proof -
  39.324 +  interpret Semilat A r f using assms by (rule Semilat.intro)
  39.325 +  show "PROP ?P" apply(insert semilat)
  39.326 +    apply (unfold lesssub_def)
  39.327 +    apply (simp (no_asm_simp) add: merges_incr)
  39.328 +    apply (rule impI)
  39.329 +    apply (rule merges_same_conv [THEN iffD1, elim_format]) 
  39.330 +    apply assumption+
  39.331 +    defer
  39.332 +    apply (rule sym, assumption)
  39.333 +    defer apply simp
  39.334 +    apply (subgoal_tac "\<forall>q t. \<not>((q, t) \<in> set qs \<and> t +_f ss ! q \<noteq> ss ! q)")
  39.335 +    apply (blast intro!: psubsetI elim: equalityE)
  39.336 +    apply clarsimp
  39.337 +    apply (drule bspec, assumption) 
  39.338 +    apply (drule bspec, assumption)
  39.339 +    apply clarsimp
  39.340 +    done
  39.341 +qed
  39.342 +
  39.343 +lemma iter_properties[rule_format]:
  39.344 +  assumes semilat: "semilat (A, r, f)"
  39.345 +  shows "\<lbrakk> acc r ; pres_type step n A; mono r step n A;
  39.346 +     bounded step n; \<forall>p\<in>w0. p < n; ss0 \<in> list n A;
  39.347 +     \<forall>p<n. p \<notin> w0 \<longrightarrow> stable r step ss0 p \<rbrakk> \<Longrightarrow>
  39.348 +   iter f step ss0 w0 = (ss',w')
  39.349 +   \<longrightarrow>
  39.350 +   ss' \<in> list n A \<and> stables r step ss' \<and> ss0 <=[r] ss' \<and>
  39.351 +   (\<forall>ts\<in>list n A. ss0 <=[r] ts \<and> stables r step ts \<longrightarrow> ss' <=[r] ts)"
  39.352 +  (is "PROP ?P")
  39.353 +proof -
  39.354 +  interpret Semilat A r f using assms by (rule Semilat.intro)
  39.355 +  show "PROP ?P" apply(insert semilat)
  39.356 +apply (unfold iter_def stables_def)
  39.357 +apply (rule_tac P = "%(ss,w).
  39.358 + ss \<in> list n A \<and> (\<forall>p<n. p \<notin> w \<longrightarrow> stable r step ss p) \<and> ss0 <=[r] ss \<and>
  39.359 + (\<forall>ts\<in>list n A. ss0 <=[r] ts \<and> stables r step ts \<longrightarrow> ss <=[r] ts) \<and>
  39.360 + (\<forall>p\<in>w. p < n)" and
  39.361 + r = "{(ss',ss) . ss <[r] ss'} <*lex*> finite_psubset"
  39.362 +       in while_rule)
  39.363 +
  39.364 +-- "Invariant holds initially:"
  39.365 +apply (simp add:stables_def)
  39.366 +
  39.367 +-- "Invariant is preserved:"
  39.368 +apply(simp add: stables_def split_paired_all)
  39.369 +apply(rename_tac ss w)
  39.370 +apply(subgoal_tac "(SOME p. p \<in> w) \<in> w")
  39.371 + prefer 2; apply (fast intro: someI)
  39.372 +apply(subgoal_tac "\<forall>(q,t) \<in> set (step (SOME p. p \<in> w) (ss ! (SOME p. p \<in> w))). q < length ss \<and> t \<in> A")
  39.373 + prefer 2
  39.374 + apply clarify
  39.375 + apply (rule conjI)
  39.376 +  apply(clarsimp, blast dest!: boundedD)
  39.377 + apply (erule pres_typeD)
  39.378 +  prefer 3
  39.379 +  apply assumption
  39.380 +  apply (erule listE_nth_in)
  39.381 +  apply simp
  39.382 + apply simp
  39.383 +apply (subst decomp_propa)
  39.384 + apply fast
  39.385 +apply simp
  39.386 +apply (rule conjI)
  39.387 + apply (rule merges_preserves_type)
  39.388 + apply blast
  39.389 + apply clarify
  39.390 + apply (rule conjI)
  39.391 +  apply(clarsimp, fast dest!: boundedD)
  39.392 + apply (erule pres_typeD)
  39.393 +  prefer 3
  39.394 +  apply assumption
  39.395 +  apply (erule listE_nth_in)
  39.396 +  apply blast
  39.397 + apply blast
  39.398 +apply (rule conjI)
  39.399 + apply clarify
  39.400 + apply (blast intro!: stable_pres_lemma)
  39.401 +apply (rule conjI)
  39.402 + apply (blast intro!: merges_incr intro: le_list_trans)
  39.403 +apply (rule conjI)
  39.404 + apply clarsimp
  39.405 + apply (blast intro!: merges_bounded_lemma)
  39.406 +apply (blast dest!: boundedD)
  39.407 +
  39.408 +
  39.409 +-- "Postcondition holds upon termination:"
  39.410 +apply(clarsimp simp add: stables_def split_paired_all)
  39.411 +
  39.412 +-- "Well-foundedness of the termination relation:"
  39.413 +apply (rule wf_lex_prod)
  39.414 + apply (insert orderI [THEN acc_le_listI])
  39.415 + apply (simp add: acc_def lesssub_def wfP_wf_eq [symmetric])
  39.416 +apply (rule wf_finite_psubset) 
  39.417 +
  39.418 +-- "Loop decreases along termination relation:"
  39.419 +apply(simp add: stables_def split_paired_all)
  39.420 +apply(rename_tac ss w)
  39.421 +apply(subgoal_tac "(SOME p. p \<in> w) \<in> w")
  39.422 + prefer 2; apply (fast intro: someI)
  39.423 +apply(subgoal_tac "\<forall>(q,t) \<in> set (step (SOME p. p \<in> w) (ss ! (SOME p. p \<in> w))). q < length ss \<and> t \<in> A")
  39.424 + prefer 2
  39.425 + apply clarify
  39.426 + apply (rule conjI)
  39.427 +  apply(clarsimp, blast dest!: boundedD)
  39.428 + apply (erule pres_typeD)
  39.429 +  prefer 3
  39.430 +  apply assumption
  39.431 +  apply (erule listE_nth_in)
  39.432 +  apply blast
  39.433 + apply blast
  39.434 +apply (subst decomp_propa)
  39.435 + apply blast
  39.436 +apply clarify
  39.437 +apply (simp del: listE_length
  39.438 +    add: lex_prod_def finite_psubset_def 
  39.439 +         bounded_nat_set_is_finite)
  39.440 +apply (rule termination_lemma)
  39.441 +apply assumption+
  39.442 +defer
  39.443 +apply assumption
  39.444 +apply clarsimp
  39.445 +done
  39.446 +
  39.447 +qed
  39.448 +
  39.449 +lemma kildall_properties:
  39.450 +assumes semilat: "semilat (A, r, f)"
  39.451 +shows "\<lbrakk> acc r; pres_type step n A; mono r step n A;
  39.452 +     bounded step n; ss0 \<in> list n A \<rbrakk> \<Longrightarrow>
  39.453 +  kildall r f step ss0 \<in> list n A \<and>
  39.454 +  stables r step (kildall r f step ss0) \<and>
  39.455 +  ss0 <=[r] kildall r f step ss0 \<and>
  39.456 +  (\<forall>ts\<in>list n A. ss0 <=[r] ts \<and> stables r step ts \<longrightarrow>
  39.457 +                 kildall r f step ss0 <=[r] ts)"
  39.458 +  (is "PROP ?P")
  39.459 +proof -
  39.460 +  interpret Semilat A r f using assms by (rule Semilat.intro)
  39.461 +  show "PROP ?P"
  39.462 +apply (unfold kildall_def)
  39.463 +apply(case_tac "iter f step ss0 (unstables r step ss0)")
  39.464 +apply(simp)
  39.465 +apply (rule iter_properties)
  39.466 +apply (simp_all add: unstables_def stable_def)
  39.467 +apply (rule semilat)
  39.468 +done
  39.469 +qed
  39.470 +
  39.471 +lemma is_bcv_kildall:
  39.472 +assumes semilat: "semilat (A, r, f)"
  39.473 +shows "\<lbrakk> acc r; top r T; pres_type step n A; bounded step n; mono r step n A \<rbrakk>
  39.474 +  \<Longrightarrow> is_bcv r T step n A (kildall r f step)"
  39.475 +  (is "PROP ?P")
  39.476 +proof -
  39.477 +  interpret Semilat A r f using assms by (rule Semilat.intro)
  39.478 +  show "PROP ?P"
  39.479 +apply(unfold is_bcv_def wt_step_def)
  39.480 +apply(insert semilat kildall_properties[of A])
  39.481 +apply(simp add:stables_def)
  39.482 +apply clarify
  39.483 +apply(subgoal_tac "kildall r f step ss \<in> list n A")
  39.484 + prefer 2 apply (simp(no_asm_simp))
  39.485 +apply (rule iffI)
  39.486 + apply (rule_tac x = "kildall r f step ss" in bexI) 
  39.487 +  apply (rule conjI)
  39.488 +   apply (blast)
  39.489 +  apply (simp  (no_asm_simp))
  39.490 + apply(assumption)
  39.491 +apply clarify
  39.492 +apply(subgoal_tac "kildall r f step ss!p <=_r ts!p")
  39.493 + apply simp
  39.494 +apply (blast intro!: le_listD less_lengthI)
  39.495 +done
  39.496 +qed
  39.497 +
  39.498 +end
    40.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    40.2 +++ b/src/HOL/MicroJava/DFA/LBVComplete.thy	Tue Nov 24 14:37:23 2009 +0100
    40.3 @@ -0,0 +1,378 @@
    40.4 +(*  Title:      HOL/MicroJava/BV/LBVComplete.thy
    40.5 +    Author:     Gerwin Klein
    40.6 +    Copyright   2000 Technische Universitaet Muenchen
    40.7 +*)
    40.8 +
    40.9 +header {* \isaheader{Completeness of the LBV} *}
   40.10 +
   40.11 +theory LBVComplete
   40.12 +imports LBVSpec Typing_Framework
   40.13 +begin
   40.14 +
   40.15 +constdefs
   40.16 +  is_target :: "['s step_type, 's list, nat] \<Rightarrow> bool" 
   40.17 +  "is_target step phi pc' \<equiv>
   40.18 +     \<exists>pc s'. pc' \<noteq> pc+1 \<and> pc < length phi \<and> (pc',s') \<in> set (step pc (phi!pc))"
   40.19 +
   40.20 +  make_cert :: "['s step_type, 's list, 's] \<Rightarrow> 's certificate"
   40.21 +  "make_cert step phi B \<equiv> 
   40.22 +     map (\<lambda>pc. if is_target step phi pc then phi!pc else B) [0..<length phi] @ [B]"
   40.23 +
   40.24 +lemma [code]:
   40.25 +  "is_target step phi pc' =
   40.26 +  list_ex (\<lambda>pc. pc' \<noteq> pc+1 \<and> pc' mem (map fst (step pc (phi!pc)))) [0..<length phi]"
   40.27 +by (force simp: list_ex_iff is_target_def mem_iff)
   40.28 +
   40.29 +
   40.30 +locale lbvc = lbv + 
   40.31 +  fixes phi :: "'a list" ("\<phi>")
   40.32 +  fixes c   :: "'a list" 
   40.33 +  defines cert_def: "c \<equiv> make_cert step \<phi> \<bottom>"
   40.34 +
   40.35 +  assumes mono: "mono r step (length \<phi>) A"
   40.36 +  assumes pres: "pres_type step (length \<phi>) A" 
   40.37 +  assumes phi:  "\<forall>pc < length \<phi>. \<phi>!pc \<in> A \<and> \<phi>!pc \<noteq> \<top>"
   40.38 +  assumes bounded: "bounded step (length \<phi>)"
   40.39 +
   40.40 +  assumes B_neq_T: "\<bottom> \<noteq> \<top>" 
   40.41 +
   40.42 +
   40.43 +lemma (in lbvc) cert: "cert_ok c (length \<phi>) \<top> \<bottom> A"
   40.44 +proof (unfold cert_ok_def, intro strip conjI)  
   40.45 +  note [simp] = make_cert_def cert_def nth_append 
   40.46 +
   40.47 +  show "c!length \<phi> = \<bottom>" by simp
   40.48 +
   40.49 +  fix pc assume pc: "pc < length \<phi>" 
   40.50 +  from pc phi B_A show "c!pc \<in> A" by simp
   40.51 +  from pc phi B_neq_T show "c!pc \<noteq> \<top>" by simp
   40.52 +qed
   40.53 +
   40.54 +lemmas [simp del] = split_paired_Ex
   40.55 +
   40.56 +
   40.57 +lemma (in lbvc) cert_target [intro?]:
   40.58 +  "\<lbrakk> (pc',s') \<in> set (step pc (\<phi>!pc));
   40.59 +      pc' \<noteq> pc+1; pc < length \<phi>; pc' < length \<phi> \<rbrakk>
   40.60 +  \<Longrightarrow> c!pc' = \<phi>!pc'"
   40.61 +  by (auto simp add: cert_def make_cert_def nth_append is_target_def)
   40.62 +
   40.63 +
   40.64 +lemma (in lbvc) cert_approx [intro?]:
   40.65 +  "\<lbrakk> pc < length \<phi>; c!pc \<noteq> \<bottom> \<rbrakk>
   40.66 +  \<Longrightarrow> c!pc = \<phi>!pc"
   40.67 +  by (auto simp add: cert_def make_cert_def nth_append)
   40.68 +
   40.69 +
   40.70 +lemma (in lbv) le_top [simp, intro]:
   40.71 +  "x <=_r \<top>"
   40.72 +  by (insert top) simp
   40.73 +  
   40.74 +
   40.75 +lemma (in lbv) merge_mono:
   40.76 +  assumes less:  "ss2 <=|r| ss1"
   40.77 +  assumes x:     "x \<in> A"
   40.78 +  assumes ss1:   "snd`set ss1 \<subseteq> A"
   40.79 +  assumes ss2:   "snd`set ss2 \<subseteq> A"
   40.80 +  shows "merge c pc ss2 x <=_r merge c pc ss1 x" (is "?s2 <=_r ?s1")
   40.81 +proof-
   40.82 +  have "?s1 = \<top> \<Longrightarrow> ?thesis" by simp
   40.83 +  moreover {
   40.84 +    assume merge: "?s1 \<noteq> T" 
   40.85 +    from x ss1 have "?s1 =
   40.86 +      (if \<forall>(pc', s')\<in>set ss1. pc' \<noteq> pc + 1 \<longrightarrow> s' <=_r c!pc'
   40.87 +      then (map snd [(p', t') \<leftarrow> ss1 . p'=pc+1]) ++_f x
   40.88 +      else \<top>)" 
   40.89 +      by (rule merge_def)  
   40.90 +    with merge obtain
   40.91 +      app: "\<forall>(pc',s')\<in>set ss1. pc' \<noteq> pc+1 \<longrightarrow> s' <=_r c!pc'" 
   40.92 +           (is "?app ss1") and
   40.93 +      sum: "(map snd [(p',t') \<leftarrow> ss1 . p' = pc+1] ++_f x) = ?s1" 
   40.94 +           (is "?map ss1 ++_f x = _" is "?sum ss1 = _")
   40.95 +      by (simp split: split_if_asm)
   40.96 +    from app less 
   40.97 +    have "?app ss2" by (blast dest: trans_r lesub_step_typeD)
   40.98 +    moreover {
   40.99 +      from ss1 have map1: "set (?map ss1) \<subseteq> A" by auto
  40.100 +      with x have "?sum ss1 \<in> A" by (auto intro!: plusplus_closed semilat)
  40.101 +      with sum have "?s1 \<in> A" by simp
  40.102 +      moreover    
  40.103 +      have mapD: "\<And>x ss. x \<in> set (?map ss) \<Longrightarrow> \<exists>p. (p,x) \<in> set ss \<and> p=pc+1" by auto
  40.104 +      from x map1 
  40.105 +      have "\<forall>x \<in> set (?map ss1). x <=_r ?sum ss1"
  40.106 +        by clarify (rule pp_ub1)
  40.107 +      with sum have "\<forall>x \<in> set (?map ss1). x <=_r ?s1" by simp
  40.108 +      with less have "\<forall>x \<in> set (?map ss2). x <=_r ?s1"
  40.109 +        by (fastsimp dest!: mapD lesub_step_typeD intro: trans_r)
  40.110 +      moreover 
  40.111 +      from map1 x have "x <=_r (?sum ss1)" by (rule pp_ub2)
  40.112 +      with sum have "x <=_r ?s1" by simp
  40.113 +      moreover 
  40.114 +      from ss2 have "set (?map ss2) \<subseteq> A" by auto
  40.115 +      ultimately
  40.116 +      have "?sum ss2 <=_r ?s1" using x by - (rule pp_lub)
  40.117 +    }
  40.118 +    moreover
  40.119 +    from x ss2 have 
  40.120 +      "?s2 =
  40.121 +      (if \<forall>(pc', s')\<in>set ss2. pc' \<noteq> pc + 1 \<longrightarrow> s' <=_r c!pc'
  40.122 +      then map snd [(p', t') \<leftarrow> ss2 . p' = pc + 1] ++_f x
  40.123 +      else \<top>)" 
  40.124 +      by (rule merge_def)
  40.125 +    ultimately have ?thesis by simp
  40.126 +  }
  40.127 +  ultimately show ?thesis by (cases "?s1 = \<top>") auto
  40.128 +qed
  40.129 +
  40.130 +
  40.131 +lemma (in lbvc) wti_mono:
  40.132 +  assumes less: "s2 <=_r s1"
  40.133 +  assumes pc:   "pc < length \<phi>" 
  40.134 +  assumes s1:   "s1 \<in> A"
  40.135 +  assumes s2:   "s2 \<in> A"
  40.136 +  shows "wti c pc s2 <=_r wti c pc s1" (is "?s2' <=_r ?s1'")
  40.137 +proof -
  40.138 +  from mono pc s2 less have "step pc s2 <=|r| step pc s1" by (rule monoD)
  40.139 +  moreover
  40.140 +  from cert B_A pc have "c!Suc pc \<in> A" by (rule cert_okD3)
  40.141 +  moreover 
  40.142 +  from pres s1 pc
  40.143 +  have "snd`set (step pc s1) \<subseteq> A" by (rule pres_typeD2)
  40.144 +  moreover
  40.145 +  from pres s2 pc
  40.146 +  have "snd`set (step pc s2) \<subseteq> A" by (rule pres_typeD2)
  40.147 +  ultimately
  40.148 +  show ?thesis by (simp add: wti merge_mono)
  40.149 +qed 
  40.150 +
  40.151 +lemma (in lbvc) wtc_mono:
  40.152 +  assumes less: "s2 <=_r s1"
  40.153 +  assumes pc:   "pc < length \<phi>" 
  40.154 +  assumes s1:   "s1 \<in> A"
  40.155 +  assumes s2:   "s2 \<in> A"
  40.156 +  shows "wtc c pc s2 <=_r wtc c pc s1" (is "?s2' <=_r ?s1'")
  40.157 +proof (cases "c!pc = \<bottom>")
  40.158 +  case True 
  40.159 +  moreover from less pc s1 s2 have "wti c pc s2 <=_r wti c pc s1" by (rule wti_mono)
  40.160 +  ultimately show ?thesis by (simp add: wtc)
  40.161 +next
  40.162 +  case False
  40.163 +  have "?s1' = \<top> \<Longrightarrow> ?thesis" by simp
  40.164 +  moreover {
  40.165 +    assume "?s1' \<noteq> \<top>" 
  40.166 +    with False have c: "s1 <=_r c!pc" by (simp add: wtc split: split_if_asm)
  40.167 +    with less have "s2 <=_r c!pc" ..
  40.168 +    with False c have ?thesis by (simp add: wtc)
  40.169 +  }
  40.170 +  ultimately show ?thesis by (cases "?s1' = \<top>") auto
  40.171 +qed
  40.172 +
  40.173 +
  40.174 +lemma (in lbv) top_le_conv [simp]:
  40.175 +  "\<top> <=_r x = (x = \<top>)"
  40.176 +  by (insert semilat) (simp add: top top_le_conv) 
  40.177 +
  40.178 +lemma (in lbv) neq_top [simp, elim]:
  40.179 +  "\<lbrakk> x <=_r y; y \<noteq> \<top> \<rbrakk> \<Longrightarrow> x \<noteq> \<top>"
  40.180 +  by (cases "x = T") auto
  40.181 +
  40.182 +
  40.183 +lemma (in lbvc) stable_wti:
  40.184 +  assumes stable:  "stable r step \<phi> pc"
  40.185 +  assumes pc:      "pc < length \<phi>"
  40.186 +  shows "wti c pc (\<phi>!pc) \<noteq> \<top>"
  40.187 +proof -
  40.188 +  let ?step = "step pc (\<phi>!pc)"
  40.189 +  from stable 
  40.190 +  have less: "\<forall>(q,s')\<in>set ?step. s' <=_r \<phi>!q" by (simp add: stable_def)
  40.191 +  
  40.192 +  from cert B_A pc 
  40.193 +  have cert_suc: "c!Suc pc \<in> A" by (rule cert_okD3)
  40.194 +  moreover  
  40.195 +  from phi pc have "\<phi>!pc \<in> A" by simp
  40.196 +  from pres this pc 
  40.197 +  have stepA: "snd`set ?step \<subseteq> A" by (rule pres_typeD2) 
  40.198 +  ultimately
  40.199 +  have "merge c pc ?step (c!Suc pc) =
  40.200 +    (if \<forall>(pc',s')\<in>set ?step. pc'\<noteq>pc+1 \<longrightarrow> s' <=_r c!pc'
  40.201 +    then map snd [(p',t') \<leftarrow> ?step.p'=pc+1] ++_f c!Suc pc
  40.202 +    else \<top>)" unfolding mrg_def by (rule lbv.merge_def [OF lbvc.axioms(1), OF lbvc_axioms])
  40.203 +  moreover {
  40.204 +    fix pc' s' assume s': "(pc', s') \<in> set ?step" and suc_pc: "pc' \<noteq> pc+1"
  40.205 +    with less have "s' <=_r \<phi>!pc'" by auto
  40.206 +    also 
  40.207 +    from bounded pc s' have "pc' < length \<phi>" by (rule boundedD)
  40.208 +    with s' suc_pc pc have "c!pc' = \<phi>!pc'" ..
  40.209 +    hence "\<phi>!pc' = c!pc'" ..
  40.210 +    finally have "s' <=_r c!pc'" .
  40.211 +  } hence "\<forall>(pc',s')\<in>set ?step. pc'\<noteq>pc+1 \<longrightarrow> s' <=_r c!pc'" by auto
  40.212 +  moreover
  40.213 +  from pc have "Suc pc = length \<phi> \<or> Suc pc < length \<phi>" by auto
  40.214 +  hence "map snd [(p',t') \<leftarrow> ?step.p'=pc+1] ++_f c!Suc pc \<noteq> \<top>" 
  40.215 +         (is "?map ++_f _ \<noteq> _")
  40.216 +  proof (rule disjE)
  40.217 +    assume pc': "Suc pc = length \<phi>"
  40.218 +    with cert have "c!Suc pc = \<bottom>" by (simp add: cert_okD2)
  40.219 +    moreover 
  40.220 +    from pc' bounded pc 
  40.221 +    have "\<forall>(p',t')\<in>set ?step. p'\<noteq>pc+1" by clarify (drule boundedD, auto)
  40.222 +    hence "[(p',t') \<leftarrow> ?step.p'=pc+1] = []" by (blast intro: filter_False) 
  40.223 +    hence "?map = []" by simp
  40.224 +    ultimately show ?thesis by (simp add: B_neq_T)  
  40.225 +  next
  40.226 +    assume pc': "Suc pc < length \<phi>"
  40.227 +    from pc' phi have "\<phi>!Suc pc \<in> A" by simp
  40.228 +    moreover note cert_suc
  40.229 +    moreover from stepA 
  40.230 +    have "set ?map \<subseteq> A" by auto
  40.231 +    moreover
  40.232 +    have "\<And>s. s \<in> set ?map \<Longrightarrow> \<exists>t. (Suc pc, t) \<in> set ?step" by auto
  40.233 +    with less have "\<forall>s' \<in> set ?map. s' <=_r \<phi>!Suc pc" by auto
  40.234 +    moreover
  40.235 +    from pc' have "c!Suc pc <=_r \<phi>!Suc pc" 
  40.236 +      by (cases "c!Suc pc = \<bottom>") (auto dest: cert_approx)
  40.237 +    ultimately
  40.238 +    have "?map ++_f c!Suc pc <=_r \<phi>!Suc pc" by (rule pp_lub)
  40.239 +    moreover
  40.240 +    from pc' phi have "\<phi>!Suc pc \<noteq> \<top>" by simp
  40.241 +    ultimately
  40.242 +    show ?thesis by auto
  40.243 +  qed
  40.244 +  ultimately
  40.245 +  have "merge c pc ?step (c!Suc pc) \<noteq> \<top>" by simp
  40.246 +  thus ?thesis by (simp add: wti)  
  40.247 +qed
  40.248 +
  40.249 +lemma (in lbvc) wti_less:
  40.250 +  assumes stable:  "stable r step \<phi> pc"
  40.251 +  assumes suc_pc:   "Suc pc < length \<phi>"
  40.252 +  shows "wti c pc (\<phi>!pc) <=_r \<phi>!Suc pc" (is "?wti <=_r _")
  40.253 +proof -
  40.254 +  let ?step = "step pc (\<phi>!pc)"
  40.255 +
  40.256 +  from stable 
  40.257 +  have less: "\<forall>(q,s')\<in>set ?step. s' <=_r \<phi>!q" by (simp add: stable_def)
  40.258 +   
  40.259 +  from suc_pc have pc: "pc < length \<phi>" by simp
  40.260 +  with cert B_A have cert_suc: "c!Suc pc \<in> A" by (rule cert_okD3)
  40.261 +  moreover  
  40.262 +  from phi pc have "\<phi>!pc \<in> A" by simp
  40.263 +  with pres pc have stepA: "snd`set ?step \<subseteq> A" by - (rule pres_typeD2)
  40.264 +  moreover
  40.265 +  from stable pc have "?wti \<noteq> \<top>" by (rule stable_wti)
  40.266 +  hence "merge c pc ?step (c!Suc pc) \<noteq> \<top>" by (simp add: wti)
  40.267 +  ultimately
  40.268 +  have "merge c pc ?step (c!Suc pc) =
  40.269 +    map snd [(p',t')\<leftarrow> ?step.p'=pc+1] ++_f c!Suc pc" by (rule merge_not_top_s) 
  40.270 +  hence "?wti = \<dots>" (is "_ = (?map ++_f _)" is "_ = ?sum") by (simp add: wti)
  40.271 +  also {
  40.272 +    from suc_pc phi have "\<phi>!Suc pc \<in> A" by simp
  40.273 +    moreover note cert_suc
  40.274 +    moreover from stepA have "set ?map \<subseteq> A" by auto
  40.275 +    moreover
  40.276 +    have "\<And>s. s \<in> set ?map \<Longrightarrow> \<exists>t. (Suc pc, t) \<in> set ?step" by auto
  40.277 +    with less have "\<forall>s' \<in> set ?map. s' <=_r \<phi>!Suc pc" by auto
  40.278 +    moreover
  40.279 +    from suc_pc have "c!Suc pc <=_r \<phi>!Suc pc"
  40.280 +      by (cases "c!Suc pc = \<bottom>") (auto dest: cert_approx)
  40.281 +    ultimately
  40.282 +    have "?sum <=_r \<phi>!Suc pc" by (rule pp_lub)
  40.283 +  }
  40.284 +  finally show ?thesis .
  40.285 +qed
  40.286 +
  40.287 +lemma (in lbvc) stable_wtc:
  40.288 +  assumes stable:  "stable r step phi pc"
  40.289 +  assumes pc:      "pc < length \<phi>"
  40.290 +  shows "wtc c pc (\<phi>!pc) \<noteq> \<top>"
  40.291 +proof -
  40.292 +  from stable pc have wti: "wti c pc (\<phi>!pc) \<noteq> \<top>" by (rule stable_wti)
  40.293 +  show ?thesis
  40.294 +  proof (cases "c!pc = \<bottom>")
  40.295 +    case True with wti show ?thesis by (simp add: wtc)
  40.296 +  next
  40.297 +    case False
  40.298 +    with pc have "c!pc = \<phi>!pc" ..    
  40.299 +    with False wti show ?thesis by (simp add: wtc)
  40.300 +  qed
  40.301 +qed
  40.302 +
  40.303 +lemma (in lbvc) wtc_less:
  40.304 +  assumes stable: "stable r step \<phi> pc"
  40.305 +  assumes suc_pc: "Suc pc < length \<phi>"
  40.306 +  shows "wtc c pc (\<phi>!pc) <=_r \<phi>!Suc pc" (is "?wtc <=_r _")
  40.307 +proof (cases "c!pc = \<bottom>")
  40.308 +  case True
  40.309 +  moreover from stable suc_pc have "wti c pc (\<phi>!pc) <=_r \<phi>!Suc pc"
  40.310 +    by (rule wti_less)
  40.311 +  ultimately show ?thesis by (simp add: wtc)
  40.312 +next
  40.313 +  case False
  40.314 +  from suc_pc have pc: "pc < length \<phi>" by simp
  40.315 +  with stable have "?wtc \<noteq> \<top>" by (rule stable_wtc)
  40.316 +  with False have "?wtc = wti c pc (c!pc)" 
  40.317 +    by (unfold wtc) (simp split: split_if_asm)
  40.318 +  also from pc False have "c!pc = \<phi>!pc" .. 
  40.319 +  finally have "?wtc = wti c pc (\<phi>!pc)" .
  40.320 +  also from stable suc_pc have "wti c pc (\<phi>!pc) <=_r \<phi>!Suc pc" by (rule wti_less)
  40.321 +  finally show ?thesis .
  40.322 +qed
  40.323 +
  40.324 +
  40.325 +lemma (in lbvc) wt_step_wtl_lemma:
  40.326 +  assumes wt_step: "wt_step r \<top> step \<phi>"
  40.327 +  shows "\<And>pc s. pc+length ls = length \<phi> \<Longrightarrow> s <=_r \<phi>!pc \<Longrightarrow> s \<in> A \<Longrightarrow> s\<noteq>\<top> \<Longrightarrow>
  40.328 +                wtl ls c pc s \<noteq> \<top>"
  40.329 +  (is "\<And>pc s. _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> ?wtl ls pc s \<noteq> _")
  40.330 +proof (induct ls)
  40.331 +  fix pc s assume "s\<noteq>\<top>" thus "?wtl [] pc s \<noteq> \<top>" by simp
  40.332 +next
  40.333 +  fix pc s i ls
  40.334 +  assume "\<And>pc s. pc+length ls=length \<phi> \<Longrightarrow> s <=_r \<phi>!pc \<Longrightarrow> s \<in> A \<Longrightarrow> s\<noteq>\<top> \<Longrightarrow> 
  40.335 +                  ?wtl ls pc s \<noteq> \<top>"
  40.336 +  moreover
  40.337 +  assume pc_l: "pc + length (i#ls) = length \<phi>"
  40.338 +  hence suc_pc_l: "Suc pc + length ls = length \<phi>" by simp
  40.339 +  ultimately
  40.340 +  have IH: "\<And>s. s <=_r \<phi>!Suc pc \<Longrightarrow> s \<in> A \<Longrightarrow> s \<noteq> \<top> \<Longrightarrow> ?wtl ls (Suc pc) s \<noteq> \<top>" .
  40.341 +
  40.342 +  from pc_l obtain pc: "pc < length \<phi>" by simp
  40.343 +  with wt_step have stable: "stable r step \<phi> pc" by (simp add: wt_step_def)
  40.344 +  from this pc have wt_phi: "wtc c pc (\<phi>!pc) \<noteq> \<top>" by (rule stable_wtc)
  40.345 +  assume s_phi: "s <=_r \<phi>!pc"
  40.346 +  from phi pc have phi_pc: "\<phi>!pc \<in> A" by simp
  40.347 +  assume s: "s \<in> A"
  40.348 +  with s_phi pc phi_pc have wt_s_phi: "wtc c pc s <=_r wtc c pc (\<phi>!pc)" by (rule wtc_mono)
  40.349 +  with wt_phi have wt_s: "wtc c pc s \<noteq> \<top>" by simp
  40.350 +  moreover
  40.351 +  assume s': "s \<noteq> \<top>" 
  40.352 +  ultimately
  40.353 +  have "ls = [] \<Longrightarrow> ?wtl (i#ls) pc s \<noteq> \<top>" by simp
  40.354 +  moreover {
  40.355 +    assume "ls \<noteq> []" 
  40.356 +    with pc_l have suc_pc: "Suc pc < length \<phi>" by (auto simp add: neq_Nil_conv)
  40.357 +    with stable have "wtc c pc (phi!pc) <=_r \<phi>!Suc pc" by (rule wtc_less)
  40.358 +    with wt_s_phi have "wtc c pc s <=_r \<phi>!Suc pc" by (rule trans_r)      
  40.359 +    moreover
  40.360 +    from cert suc_pc have "c!pc \<in> A" "c!(pc+1) \<in> A" 
  40.361 +      by (auto simp add: cert_ok_def)
  40.362 +    from pres this s pc have "wtc c pc s \<in> A" by (rule wtc_pres)
  40.363 +    ultimately
  40.364 +    have "?wtl ls (Suc pc) (wtc c pc s) \<noteq> \<top>" using IH wt_s by blast
  40.365 +    with s' wt_s have "?wtl (i#ls) pc s \<noteq> \<top>" by simp
  40.366 +  }
  40.367 +  ultimately show "?wtl (i#ls) pc s \<noteq> \<top>" by (cases ls) blast+
  40.368 +qed
  40.369 +
  40.370 +  
  40.371 +theorem (in lbvc) wtl_complete:
  40.372 +  assumes wt: "wt_step r \<top> step \<phi>"
  40.373 +    and s: "s <=_r \<phi>!0" "s \<in> A" "s \<noteq> \<top>"
  40.374 +    and len: "length ins = length phi"
  40.375 +  shows "wtl ins c 0 s \<noteq> \<top>"
  40.376 +proof -
  40.377 +  from len have "0+length ins = length phi" by simp
  40.378 +  from wt this s show ?thesis by (rule wt_step_wtl_lemma)
  40.379 +qed
  40.380 +
  40.381 +end
    41.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    41.2 +++ b/src/HOL/MicroJava/DFA/LBVCorrect.thy	Tue Nov 24 14:37:23 2009 +0100
    41.3 @@ -0,0 +1,221 @@
    41.4 +(*  Author:     Gerwin Klein
    41.5 +    Copyright   1999 Technische Universitaet Muenchen
    41.6 +*)
    41.7 +
    41.8 +header {* \isaheader{Correctness of the LBV} *}
    41.9 +
   41.10 +theory LBVCorrect
   41.11 +imports LBVSpec Typing_Framework
   41.12 +begin
   41.13 +
   41.14 +locale lbvs = lbv +
   41.15 +  fixes s0  :: 'a ("s\<^sub>0")
   41.16 +  fixes c   :: "'a list"
   41.17 +  fixes ins :: "'b list"
   41.18 +  fixes phi :: "'a list" ("\<phi>")
   41.19 +  defines phi_def:
   41.20 +  "\<phi> \<equiv> map (\<lambda>pc. if c!pc = \<bottom> then wtl (take pc ins) c 0 s0 else c!pc) 
   41.21 +       [0..<length ins]"
   41.22 +
   41.23 +  assumes bounded: "bounded step (length ins)"
   41.24 +  assumes cert: "cert_ok c (length ins) \<top> \<bottom> A"
   41.25 +  assumes pres: "pres_type step (length ins) A"
   41.26 +
   41.27 +
   41.28 +lemma (in lbvs) phi_None [intro?]:
   41.29 +  "\<lbrakk> pc < length ins; c!pc = \<bottom> \<rbrakk> \<Longrightarrow> \<phi> ! pc = wtl (take pc ins) c 0 s0"
   41.30 +  by (simp add: phi_def)
   41.31 +
   41.32 +lemma (in lbvs) phi_Some [intro?]:
   41.33 +  "\<lbrakk> pc < length ins; c!pc \<noteq> \<bottom> \<rbrakk> \<Longrightarrow> \<phi> ! pc = c ! pc"
   41.34 +  by (simp add: phi_def)
   41.35 +
   41.36 +lemma (in lbvs) phi_len [simp]:
   41.37 +  "length \<phi> = length ins"
   41.38 +  by (simp add: phi_def)
   41.39 +
   41.40 +
   41.41 +lemma (in lbvs) wtl_suc_pc:
   41.42 +  assumes all: "wtl ins c 0 s\<^sub>0 \<noteq> \<top>" 
   41.43 +  assumes pc:  "pc+1 < length ins"
   41.44 +  shows "wtl (take (pc+1) ins) c 0 s0 \<sqsubseteq>\<^sub>r \<phi>!(pc+1)"
   41.45 +proof -
   41.46 +  from all pc
   41.47 +  have "wtc c (pc+1) (wtl (take (pc+1) ins) c 0 s0) \<noteq> T" by (rule wtl_all)
   41.48 +  with pc show ?thesis by (simp add: phi_def wtc split: split_if_asm)
   41.49 +qed
   41.50 +
   41.51 +
   41.52 +lemma (in lbvs) wtl_stable:
   41.53 +  assumes wtl: "wtl ins c 0 s0 \<noteq> \<top>" 
   41.54 +  assumes s0:  "s0 \<in> A" 
   41.55 +  assumes pc:  "pc < length ins" 
   41.56 +  shows "stable r step \<phi> pc"
   41.57 +proof (unfold stable_def, clarify)
   41.58 +  fix pc' s' assume step: "(pc',s') \<in> set (step pc (\<phi> ! pc))" 
   41.59 +                      (is "(pc',s') \<in> set (?step pc)")
   41.60 +  
   41.61 +  from bounded pc step have pc': "pc' < length ins" by (rule boundedD)
   41.62 +
   41.63 +  from wtl have tkpc: "wtl (take pc ins) c 0 s0 \<noteq> \<top>" (is "?s1 \<noteq> _") by (rule wtl_take)
   41.64 +  from wtl have s2: "wtl (take (pc+1) ins) c 0 s0 \<noteq> \<top>" (is "?s2 \<noteq> _") by (rule wtl_take)
   41.65 +  
   41.66 +  from wtl pc have wt_s1: "wtc c pc ?s1 \<noteq> \<top>" by (rule wtl_all)
   41.67 +
   41.68 +  have c_Some: "\<forall>pc t. pc < length ins \<longrightarrow> c!pc \<noteq> \<bottom> \<longrightarrow> \<phi>!pc = c!pc" 
   41.69 +    by (simp add: phi_def)
   41.70 +  from pc have c_None: "c!pc = \<bottom> \<Longrightarrow> \<phi>!pc = ?s1" ..
   41.71 +
   41.72 +  from wt_s1 pc c_None c_Some
   41.73 +  have inst: "wtc c pc ?s1  = wti c pc (\<phi>!pc)"
   41.74 +    by (simp add: wtc split: split_if_asm)
   41.75 +
   41.76 +  from pres cert s0 wtl pc have "?s1 \<in> A" by (rule wtl_pres)
   41.77 +  with pc c_Some cert c_None
   41.78 +  have "\<phi>!pc \<in> A" by (cases "c!pc = \<bottom>") (auto dest: cert_okD1)
   41.79 +  with pc pres
   41.80 +  have step_in_A: "snd`set (?step pc) \<subseteq> A" by (auto dest: pres_typeD2)
   41.81 +
   41.82 +  show "s' <=_r \<phi>!pc'" 
   41.83 +  proof (cases "pc' = pc+1")
   41.84 +    case True
   41.85 +    with pc' cert
   41.86 +    have cert_in_A: "c!(pc+1) \<in> A" by (auto dest: cert_okD1)
   41.87 +    from True pc' have pc1: "pc+1 < length ins" by simp
   41.88 +    with tkpc have "?s2 = wtc c pc ?s1" by - (rule wtl_Suc)
   41.89 +    with inst 
   41.90 +    have merge: "?s2 = merge c pc (?step pc) (c!(pc+1))" by (simp add: wti)
   41.91 +    also    
   41.92 +    from s2 merge have "\<dots> \<noteq> \<top>" (is "?merge \<noteq> _") by simp
   41.93 +    with cert_in_A step_in_A
   41.94 +    have "?merge = (map snd [(p',t') \<leftarrow> ?step pc. p'=pc+1] ++_f (c!(pc+1)))"
   41.95 +      by (rule merge_not_top_s) 
   41.96 +    finally
   41.97 +    have "s' <=_r ?s2" using step_in_A cert_in_A True step 
   41.98 +      by (auto intro: pp_ub1')
   41.99 +    also 
  41.100 +    from wtl pc1 have "?s2 <=_r \<phi>!(pc+1)" by (rule wtl_suc_pc)
  41.101 +    also note True [symmetric]
  41.102 +    finally show ?thesis by simp    
  41.103 +  next
  41.104 +    case False
  41.105 +    from wt_s1 inst
  41.106 +    have "merge c pc (?step pc) (c!(pc+1)) \<noteq> \<top>" by (simp add: wti)
  41.107 +    with step_in_A
  41.108 +    have "\<forall>(pc', s')\<in>set (?step pc). pc'\<noteq>pc+1 \<longrightarrow> s' <=_r c!pc'" 
  41.109 +      by - (rule merge_not_top)
  41.110 +    with step False 
  41.111 +    have ok: "s' <=_r c!pc'" by blast
  41.112 +    moreover
  41.113 +    from ok
  41.114 +    have "c!pc' = \<bottom> \<Longrightarrow> s' = \<bottom>" by simp
  41.115 +    moreover
  41.116 +    from c_Some pc'
  41.117 +    have "c!pc' \<noteq> \<bottom> \<Longrightarrow> \<phi>!pc' = c!pc'" by auto
  41.118 +    ultimately
  41.119 +    show ?thesis by (cases "c!pc' = \<bottom>") auto 
  41.120 +  qed
  41.121 +qed
  41.122 +
  41.123 +  
  41.124 +lemma (in lbvs) phi_not_top:
  41.125 +  assumes wtl: "wtl ins c 0 s0 \<noteq> \<top>"
  41.126 +  assumes pc:  "pc < length ins"
  41.127 +  shows "\<phi>!pc \<noteq> \<top>"
  41.128 +proof (cases "c!pc = \<bottom>")
  41.129 +  case False with pc
  41.130 +  have "\<phi>!pc = c!pc" ..
  41.131 +  also from cert pc have "\<dots> \<noteq> \<top>" by (rule cert_okD4)
  41.132 +  finally show ?thesis .
  41.133 +next
  41.134 +  case True with pc
  41.135 +  have "\<phi>!pc = wtl (take pc ins) c 0 s0" ..
  41.136 +  also from wtl have "\<dots> \<noteq> \<top>" by (rule wtl_take)
  41.137 +  finally show ?thesis .
  41.138 +qed
  41.139 +
  41.140 +lemma (in lbvs) phi_in_A:
  41.141 +  assumes wtl: "wtl ins c 0 s0 \<noteq> \<top>"
  41.142 +  assumes s0:  "s0 \<in> A"
  41.143 +  shows "\<phi> \<in> list (length ins) A"
  41.144 +proof -
  41.145 +  { fix x assume "x \<in> set \<phi>"
  41.146 +    then obtain xs ys where "\<phi> = xs @ x # ys" 
  41.147 +      by (auto simp add: in_set_conv_decomp)
  41.148 +    then obtain pc where pc: "pc < length \<phi>" and x: "\<phi>!pc = x"
  41.149 +      by (simp add: that [of "length xs"] nth_append)
  41.150 +    
  41.151 +    from pres cert wtl s0 pc
  41.152 +    have "wtl (take pc ins) c 0 s0 \<in> A" by (auto intro!: wtl_pres)
  41.153 +    moreover
  41.154 +    from pc have "pc < length ins" by simp
  41.155 +    with cert have "c!pc \<in> A" ..
  41.156 +    ultimately
  41.157 +    have "\<phi>!pc \<in> A" using pc by (simp add: phi_def)
  41.158 +    hence "x \<in> A" using x by simp
  41.159 +  } 
  41.160 +  hence "set \<phi> \<subseteq> A" ..
  41.161 +  thus ?thesis by (unfold list_def) simp
  41.162 +qed
  41.163 +
  41.164 +
  41.165 +lemma (in lbvs) phi0:
  41.166 +  assumes wtl: "wtl ins c 0 s0 \<noteq> \<top>"
  41.167 +  assumes 0:   "0 < length ins"
  41.168 +  shows "s0 <=_r \<phi>!0"
  41.169 +proof (cases "c!0 = \<bottom>")
  41.170 +  case True
  41.171 +  with 0 have "\<phi>!0 = wtl (take 0 ins) c 0 s0" ..
  41.172 +  moreover have "wtl (take 0 ins) c 0 s0 = s0" by simp
  41.173 +  ultimately have "\<phi>!0 = s0" by simp
  41.174 +  thus ?thesis by simp
  41.175 +next
  41.176 +  case False
  41.177 +  with 0 have "phi!0 = c!0" ..
  41.178 +  moreover 
  41.179 +  from wtl have "wtl (take 1 ins) c 0 s0 \<noteq> \<top>"  by (rule wtl_take)
  41.180 +  with 0 False 
  41.181 +  have "s0 <=_r c!0" by (auto simp add: neq_Nil_conv wtc split: split_if_asm)
  41.182 +  ultimately
  41.183 +  show ?thesis by simp
  41.184 +qed
  41.185 +
  41.186 +
  41.187 +theorem (in lbvs) wtl_sound:
  41.188 +  assumes wtl: "wtl ins c 0 s0 \<noteq> \<top>" 
  41.189 +  assumes s0: "s0 \<in> A" 
  41.190 +  shows "\<exists>ts. wt_step r \<top> step ts"
  41.191 +proof -
  41.192 +  have "wt_step r \<top> step \<phi>"
  41.193 +  proof (unfold wt_step_def, intro strip conjI)
  41.194 +    fix pc assume "pc < length \<phi>"
  41.195 +    then have pc: "pc < length ins" by simp
  41.196 +    with wtl show "\<phi>!pc \<noteq> \<top>" by (rule phi_not_top)
  41.197 +    from wtl s0 pc show "stable r step \<phi> pc" by (rule wtl_stable)
  41.198 +  qed
  41.199 +  thus ?thesis ..
  41.200 +qed
  41.201 +
  41.202 +
  41.203 +theorem (in lbvs) wtl_sound_strong:
  41.204 +  assumes wtl: "wtl ins c 0 s0 \<noteq> \<top>" 
  41.205 +  assumes s0: "s0 \<in> A" 
  41.206 +  assumes nz: "0 < length ins"
  41.207 +  shows "\<exists>ts \<in> list (length ins) A. wt_step r \<top> step ts \<and> s0 <=_r ts!0"
  41.208 +proof -
  41.209 +  from wtl s0 have "\<phi> \<in> list (length ins) A" by (rule phi_in_A)
  41.210 +  moreover
  41.211 +  have "wt_step r \<top> step \<phi>"
  41.212 +  proof (unfold wt_step_def, intro strip conjI)
  41.213 +    fix pc assume "pc < length \<phi>"
  41.214 +    then have pc: "pc < length ins" by simp
  41.215 +    with wtl show "\<phi>!pc \<noteq> \<top>" by (rule phi_not_top)
  41.216 +    from wtl s0 pc show "stable r step \<phi> pc" by (rule wtl_stable)
  41.217 +  qed
  41.218 +  moreover
  41.219 +  from wtl nz have "s0 <=_r \<phi>!0" by (rule phi0)
  41.220 +  ultimately
  41.221 +  show ?thesis by fast
  41.222 +qed
  41.223 +
  41.224 +end
    42.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    42.2 +++ b/src/HOL/MicroJava/DFA/LBVSpec.thy	Tue Nov 24 14:37:23 2009 +0100
    42.3 @@ -0,0 +1,381 @@
    42.4 +(*  Title:      HOL/MicroJava/BV/LBVSpec.thy
    42.5 +    Author:     Gerwin Klein
    42.6 +    Copyright   1999 Technische Universitaet Muenchen
    42.7 +*)
    42.8 +
    42.9 +header {* \isaheader{The Lightweight Bytecode Verifier} *}
   42.10 +
   42.11 +theory LBVSpec
   42.12 +imports SemilatAlg Opt
   42.13 +begin
   42.14 +
   42.15 +types
   42.16 +  's certificate = "'s list"   
   42.17 +
   42.18 +consts
   42.19 +merge :: "'s certificate \<Rightarrow> 's binop \<Rightarrow> 's ord \<Rightarrow> 's \<Rightarrow> nat \<Rightarrow> (nat \<times> 's) list \<Rightarrow> 's \<Rightarrow> 's"
   42.20 +primrec
   42.21 +"merge cert f r T pc []     x = x"
   42.22 +"merge cert f r T pc (s#ss) x = merge cert f r T pc ss (let (pc',s') = s in 
   42.23 +                                  if pc'=pc+1 then s' +_f x
   42.24 +                                  else if s' <=_r (cert!pc') then x
   42.25 +                                  else T)"
   42.26 +
   42.27 +constdefs
   42.28 +wtl_inst :: "'s certificate \<Rightarrow> 's binop \<Rightarrow> 's ord \<Rightarrow> 's \<Rightarrow>
   42.29 +             's step_type \<Rightarrow> nat \<Rightarrow> 's \<Rightarrow> 's"
   42.30 +"wtl_inst cert f r T step pc s \<equiv> merge cert f r T pc (step pc s) (cert!(pc+1))"
   42.31 +
   42.32 +wtl_cert :: "'s certificate \<Rightarrow> 's binop \<Rightarrow> 's ord \<Rightarrow> 's \<Rightarrow> 's \<Rightarrow>
   42.33 +             's step_type \<Rightarrow> nat \<Rightarrow> 's \<Rightarrow> 's"
   42.34 +"wtl_cert cert f r T B step pc s \<equiv>
   42.35 +  if cert!pc = B then 
   42.36 +    wtl_inst cert f r T step pc s
   42.37 +  else
   42.38 +    if s <=_r (cert!pc) then wtl_inst cert f r T step pc (cert!pc) else T"
   42.39 +
   42.40 +consts 
   42.41 +wtl_inst_list :: "'a list \<Rightarrow> 's certificate \<Rightarrow> 's binop \<Rightarrow> 's ord \<Rightarrow> 's \<Rightarrow> 's \<Rightarrow>
   42.42 +                  's step_type \<Rightarrow> nat \<Rightarrow> 's \<Rightarrow> 's"
   42.43 +primrec
   42.44 +"wtl_inst_list []     cert f r T B step pc s = s"
   42.45 +"wtl_inst_list (i#is) cert f r T B step pc s = 
   42.46 +    (let s' = wtl_cert cert f r T B step pc s in
   42.47 +      if s' = T \<or> s = T then T else wtl_inst_list is cert f r T B step (pc+1) s')"
   42.48 +
   42.49 +constdefs
   42.50 +  cert_ok :: "'s certificate \<Rightarrow> nat \<Rightarrow> 's \<Rightarrow> 's \<Rightarrow> 's set \<Rightarrow> bool"
   42.51 +  "cert_ok cert n T B A \<equiv> (\<forall>i < n. cert!i \<in> A \<and> cert!i \<noteq> T) \<and> (cert!n = B)"
   42.52 +
   42.53 +constdefs
   42.54 +  bottom :: "'a ord \<Rightarrow> 'a \<Rightarrow> bool"
   42.55 +  "bottom r B \<equiv> \<forall>x. B <=_r x"
   42.56 +
   42.57 +
   42.58 +locale lbv = Semilat +
   42.59 +  fixes T :: "'a" ("\<top>") 
   42.60 +  fixes B :: "'a" ("\<bottom>") 
   42.61 +  fixes step :: "'a step_type" 
   42.62 +  assumes top: "top r \<top>"
   42.63 +  assumes T_A: "\<top> \<in> A"
   42.64 +  assumes bot: "bottom r \<bottom>" 
   42.65 +  assumes B_A: "\<bottom> \<in> A"
   42.66 +
   42.67 +  fixes merge :: "'a certificate \<Rightarrow> nat \<Rightarrow> (nat \<times> 'a) list \<Rightarrow> 'a \<Rightarrow> 'a"
   42.68 +  defines mrg_def: "merge cert \<equiv> LBVSpec.merge cert f r \<top>"
   42.69 +
   42.70 +  fixes wti :: "'a certificate \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a"
   42.71 +  defines wti_def: "wti cert \<equiv> wtl_inst cert f r \<top> step"
   42.72 + 
   42.73 +  fixes wtc :: "'a certificate \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a"
   42.74 +  defines wtc_def: "wtc cert \<equiv> wtl_cert cert f r \<top> \<bottom> step"
   42.75 +
   42.76 +  fixes wtl :: "'b list \<Rightarrow> 'a certificate \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a"
   42.77 +  defines wtl_def: "wtl ins cert \<equiv> wtl_inst_list ins cert f r \<top> \<bottom> step"
   42.78 +
   42.79 +
   42.80 +lemma (in lbv) wti:
   42.81 +  "wti c pc s \<equiv> merge c pc (step pc s) (c!(pc+1))"
   42.82 +  by (simp add: wti_def mrg_def wtl_inst_def)
   42.83 +
   42.84 +lemma (in lbv) wtc: 
   42.85 +  "wtc c pc s \<equiv> if c!pc = \<bottom> then wti c pc s else if s <=_r c!pc then wti c pc (c!pc) else \<top>"
   42.86 +  by (unfold wtc_def wti_def wtl_cert_def)
   42.87 +
   42.88 +
   42.89 +lemma cert_okD1 [intro?]:
   42.90 +  "cert_ok c n T B A \<Longrightarrow> pc < n \<Longrightarrow> c!pc \<in> A"
   42.91 +  by (unfold cert_ok_def) fast
   42.92 +
   42.93 +lemma cert_okD2 [intro?]:
   42.94 +  "cert_ok c n T B A \<Longrightarrow> c!n = B"
   42.95 +  by (simp add: cert_ok_def)
   42.96 +
   42.97 +lemma cert_okD3 [intro?]:
   42.98 +  "cert_ok c n T B A \<Longrightarrow> B \<in> A \<Longrightarrow> pc < n \<Longrightarrow> c!Suc pc \<in> A"
   42.99 +  by (drule Suc_leI) (auto simp add: le_eq_less_or_eq dest: cert_okD1 cert_okD2)
  42.100 +
  42.101 +lemma cert_okD4 [intro?]:
  42.102 +  "cert_ok c n T B A \<Longrightarrow> pc < n \<Longrightarrow> c!pc \<noteq> T"
  42.103 +  by (simp add: cert_ok_def)
  42.104 +
  42.105 +declare Let_def [simp]
  42.106 +
  42.107 +section "more semilattice lemmas"
  42.108 +
  42.109 +
  42.110 +lemma (in lbv) sup_top [simp, elim]:
  42.111 +  assumes x: "x \<in> A" 
  42.112 +  shows "x +_f \<top> = \<top>"
  42.113 +proof -
  42.114 +  from top have "x +_f \<top> <=_r \<top>" ..
  42.115 +  moreover from x T_A have "\<top> <=_r x +_f \<top>" ..
  42.116 +  ultimately show ?thesis ..
  42.117 +qed
  42.118 +  
  42.119 +lemma (in lbv) plusplussup_top [simp, elim]:
  42.120 +  "set xs \<subseteq> A \<Longrightarrow> xs ++_f \<top> = \<top>"
  42.121 +  by (induct xs) auto
  42.122 +
  42.123 +
  42.124 +
  42.125 +lemma (in Semilat) pp_ub1':
  42.126 +  assumes S: "snd`set S \<subseteq> A" 
  42.127 +  assumes y: "y \<in> A" and ab: "(a, b) \<in> set S" 
  42.128 +  shows "b <=_r map snd [(p', t') \<leftarrow> S . p' = a] ++_f y"
  42.129 +proof -
  42.130 +  from S have "\<forall>(x,y) \<in> set S. y \<in> A" by auto
  42.131 +  with semilat y ab show ?thesis by - (rule ub1')
  42.132 +qed 
  42.133 +
  42.134 +lemma (in lbv) bottom_le [simp, intro]:
  42.135 +  "\<bottom> <=_r x"
  42.136 +  by (insert bot) (simp add: bottom_def)
  42.137 +
  42.138 +lemma (in lbv) le_bottom [simp]:
  42.139 +  "x <=_r \<bottom> = (x = \<bottom>)"
  42.140 +  by (blast intro: antisym_r)
  42.141 +
  42.142 +
  42.143 +
  42.144 +section "merge"
  42.145 +
  42.146 +lemma (in lbv) merge_Nil [simp]:
  42.147 +  "merge c pc [] x = x" by (simp add: mrg_def)
  42.148 +
  42.149 +lemma (in lbv) merge_Cons [simp]:
  42.150 +  "merge c pc (l#ls) x = merge c pc ls (if fst l=pc+1 then snd l +_f x
  42.151 +                                        else if snd l <=_r (c!fst l) then x
  42.152 +                                        else \<top>)"
  42.153 +  by (simp add: mrg_def split_beta)
  42.154 +
  42.155 +lemma (in lbv) merge_Err [simp]:
  42.156 +  "snd`set ss \<subseteq> A \<Longrightarrow> merge c pc ss \<top> = \<top>"
  42.157 +  by (induct ss) auto
  42.158 +
  42.159 +lemma (in lbv) merge_not_top:
  42.160 +  "\<And>x. snd`set ss \<subseteq> A \<Longrightarrow> merge c pc ss x \<noteq> \<top> \<Longrightarrow> 
  42.161 +  \<forall>(pc',s') \<in> set ss. (pc' \<noteq> pc+1 \<longrightarrow> s' <=_r (c!pc'))"
  42.162 +  (is "\<And>x. ?set ss \<Longrightarrow> ?merge ss x \<Longrightarrow> ?P ss")
  42.163 +proof (induct ss)
  42.164 +  show "?P []" by simp
  42.165 +next
  42.166 +  fix x ls l
  42.167 +  assume "?set (l#ls)" then obtain set: "snd`set ls \<subseteq> A" by simp
  42.168 +  assume merge: "?merge (l#ls) x" 
  42.169 +  moreover
  42.170 +  obtain pc' s' where l: "l = (pc',s')" by (cases l)
  42.171 +  ultimately
  42.172 +  obtain x' where merge': "?merge ls x'" by simp 
  42.173 +  assume "\<And>x. ?set ls \<Longrightarrow> ?merge ls x \<Longrightarrow> ?P ls" hence "?P ls" using set merge' .
  42.174 +  moreover
  42.175 +  from merge set
  42.176 +  have "pc' \<noteq> pc+1 \<longrightarrow> s' <=_r (c!pc')" by (simp add: l split: split_if_asm)
  42.177 +  ultimately
  42.178 +  show "?P (l#ls)" by (simp add: l)
  42.179 +qed
  42.180 +
  42.181 +
  42.182 +lemma (in lbv) merge_def:
  42.183 +  shows 
  42.184 +  "\<And>x. x \<in> A \<Longrightarrow> snd`set ss \<subseteq> A \<Longrightarrow>
  42.185 +  merge c pc ss x = 
  42.186 +  (if \<forall>(pc',s') \<in> set ss. pc'\<noteq>pc+1 \<longrightarrow> s' <=_r c!pc' then
  42.187 +    map snd [(p',t') \<leftarrow> ss. p'=pc+1] ++_f x
  42.188 +  else \<top>)" 
  42.189 +  (is "\<And>x. _ \<Longrightarrow> _ \<Longrightarrow> ?merge ss x = ?if ss x" is "\<And>x. _ \<Longrightarrow> _ \<Longrightarrow> ?P ss x")
  42.190 +proof (induct ss)
  42.191 +  fix x show "?P [] x" by simp
  42.192 +next 
  42.193 +  fix x assume x: "x \<in> A" 
  42.194 +  fix l::"nat \<times> 'a" and ls  
  42.195 +  assume "snd`set (l#ls) \<subseteq> A"
  42.196 +  then obtain l: "snd l \<in> A" and ls: "snd`set ls \<subseteq> A" by auto
  42.197 +  assume "\<And>x. x \<in> A \<Longrightarrow> snd`set ls \<subseteq> A \<Longrightarrow> ?P ls x" 
  42.198 +  hence IH: "\<And>x. x \<in> A \<Longrightarrow> ?P ls x" using ls by iprover
  42.199 +  obtain pc' s' where [simp]: "l = (pc',s')" by (cases l)
  42.200 +  hence "?merge (l#ls) x = ?merge ls 
  42.201 +    (if pc'=pc+1 then s' +_f x else if s' <=_r c!pc' then x else \<top>)"
  42.202 +    (is "?merge (l#ls) x = ?merge ls ?if'")
  42.203 +    by simp 
  42.204 +  also have "\<dots> = ?if ls ?if'" 
  42.205 +  proof -
  42.206 +    from l have "s' \<in> A" by simp
  42.207 +    with x have "s' +_f x \<in> A" by simp
  42.208 +    with x T_A have "?if' \<in> A" by auto
  42.209 +    hence "?P ls ?if'" by (rule IH) thus ?thesis by simp
  42.210 +  qed
  42.211 +  also have "\<dots> = ?if (l#ls) x"
  42.212 +    proof (cases "\<forall>(pc', s')\<in>set (l#ls). pc'\<noteq>pc+1 \<longrightarrow> s' <=_r c!pc'")
  42.213 +      case True
  42.214 +      hence "\<forall>(pc', s')\<in>set ls. pc'\<noteq>pc+1 \<longrightarrow> s' <=_r c!pc'" by auto
  42.215 +      moreover
  42.216 +      from True have 
  42.217 +        "map snd [(p',t')\<leftarrow>ls . p'=pc+1] ++_f ?if' = 
  42.218 +        (map snd [(p',t')\<leftarrow>l#ls . p'=pc+1] ++_f x)"
  42.219 +        by simp
  42.220 +      ultimately
  42.221 +      show ?thesis using True by simp
  42.222 +    next
  42.223 +      case False 
  42.224 +      moreover
  42.225 +      from ls have "set (map snd [(p', t')\<leftarrow>ls . p' = Suc pc]) \<subseteq> A" by auto
  42.226 +      ultimately show ?thesis by auto
  42.227 +    qed
  42.228 +  finally show "?P (l#ls) x" .
  42.229 +qed
  42.230 +
  42.231 +lemma (in lbv) merge_not_top_s:
  42.232 +  assumes x:  "x \<in> A" and ss: "snd`set ss \<subseteq> A"
  42.233 +  assumes m:  "merge c pc ss x \<noteq> \<top>"
  42.234 +  shows "merge c pc ss x = (map snd [(p',t') \<leftarrow> ss. p'=pc+1] ++_f x)"
  42.235 +proof -
  42.236 +  from ss m have "\<forall>(pc',s') \<in> set ss. (pc' \<noteq> pc+1 \<longrightarrow> s' <=_r c!pc')" 
  42.237 +    by (rule merge_not_top)
  42.238 +  with x ss m show ?thesis by - (drule merge_def, auto split: split_if_asm)
  42.239 +qed
  42.240 +
  42.241 +section "wtl-inst-list"
  42.242 +
  42.243 +lemmas [iff] = not_Err_eq
  42.244 +
  42.245 +lemma (in lbv) wtl_Nil [simp]: "wtl [] c pc s = s" 
  42.246 +  by (simp add: wtl_def)
  42.247 +
  42.248 +lemma (in lbv) wtl_Cons [simp]: 
  42.249 +  "wtl (i#is) c pc s = 
  42.250 +  (let s' = wtc c pc s in if s' = \<top> \<or> s = \<top> then \<top> else wtl is c (pc+1) s')"
  42.251 +  by (simp add: wtl_def wtc_def)
  42.252 +
  42.253 +lemma (in lbv) wtl_Cons_not_top:
  42.254 +  "wtl (i#is) c pc s \<noteq> \<top> = 
  42.255 +  (wtc c pc s \<noteq> \<top> \<and> s \<noteq> T \<and> wtl is c (pc+1) (wtc c pc s) \<noteq> \<top>)"
  42.256 +  by (auto simp del: split_paired_Ex)
  42.257 +
  42.258 +lemma (in lbv) wtl_top [simp]:  "wtl ls c pc \<top> = \<top>"
  42.259 +  by (cases ls) auto
  42.260 +
  42.261 +lemma (in lbv) wtl_not_top:
  42.262 +  "wtl ls c pc s \<noteq> \<top> \<Longrightarrow> s \<noteq> \<top>"
  42.263 +  by (cases "s=\<top>") auto
  42.264 +
  42.265 +lemma (in lbv) wtl_append [simp]:
  42.266 +  "\<And>pc s. wtl (a@b) c pc s = wtl b c (pc+length a) (wtl a c pc s)"
  42.267 +  by (induct a) auto
  42.268 +
  42.269 +lemma (in lbv) wtl_take:
  42.270 +  "wtl is c pc s \<noteq> \<top> \<Longrightarrow> wtl (take pc' is) c pc s \<noteq> \<top>"
  42.271 +  (is "?wtl is \<noteq> _ \<Longrightarrow> _")
  42.272 +proof -
  42.273 +  assume "?wtl is \<noteq> \<top>"
  42.274 +  hence "?wtl (take pc' is @ drop pc' is) \<noteq> \<top>" by simp  
  42.275 +  thus ?thesis by (auto dest!: wtl_not_top simp del: append_take_drop_id)
  42.276 +qed
  42.277 +
  42.278 +lemma take_Suc:
  42.279 +  "\<forall>n. n < length l \<longrightarrow> take (Suc n) l = (take n l)@[l!n]" (is "?P l")
  42.280 +proof (induct l)
  42.281 +  show "?P []" by simp
  42.282 +next
  42.283 +  fix x xs assume IH: "?P xs"  
  42.284 +  show "?P (x#xs)"
  42.285 +  proof (intro strip)
  42.286 +    fix n assume "n < length (x#xs)"
  42.287 +    with IH show "take (Suc n) (x # xs) = take n (x # xs) @ [(x # xs) ! n]" 
  42.288 +      by (cases n, auto)
  42.289 +  qed
  42.290 +qed
  42.291 +
  42.292 +lemma (in lbv) wtl_Suc:
  42.293 +  assumes suc: "pc+1 < length is"
  42.294 +  assumes wtl: "wtl (take pc is) c 0 s \<noteq> \<top>"
  42.295 +  shows "wtl (take (pc+1) is) c 0 s = wtc c pc (wtl (take pc is) c 0 s)"
  42.296 +proof -
  42.297 +  from suc have "take (pc+1) is=(take pc is)@[is!pc]" by (simp add: take_Suc)
  42.298 +  with suc wtl show ?thesis by (simp add: min_max.inf_absorb2)
  42.299 +qed
  42.300 +
  42.301 +lemma (in lbv) wtl_all:
  42.302 +  assumes all: "wtl is c 0 s \<noteq> \<top>" (is "?wtl is \<noteq> _") 
  42.303 +  assumes pc:  "pc < length is"
  42.304 +  shows  "wtc c pc (wtl (take pc is) c 0 s) \<noteq> \<top>"
  42.305 +proof -
  42.306 +  from pc have "0 < length (drop pc is)" by simp
  42.307 +  then  obtain i r where Cons: "drop pc is = i#r" 
  42.308 +    by (auto simp add: neq_Nil_conv simp del: length_drop drop_eq_Nil)
  42.309 +  hence "i#r = drop pc is" ..
  42.310 +  with all have take: "?wtl (take pc is@i#r) \<noteq> \<top>" by simp 
  42.311 +  from pc have "is!pc = drop pc is ! 0" by simp
  42.312 +  with Cons have "is!pc = i" by simp
  42.313 +  with take pc show ?thesis by (auto simp add: min_max.inf_absorb2)
  42.314 +qed
  42.315 +
  42.316 +section "preserves-type"
  42.317 +
  42.318 +lemma (in lbv) merge_pres:
  42.319 +  assumes s0: "snd`set ss \<subseteq> A" and x: "x \<in> A"
  42.320 +  shows "merge c pc ss x \<in> A"
  42.321 +proof -
  42.322 +  from s0 have "set (map snd [(p', t')\<leftarrow>ss . p'=pc+1]) \<subseteq> A" by auto
  42.323 +  with x  have "(map snd [(p', t')\<leftarrow>ss . p'=pc+1] ++_f x) \<in> A"
  42.324 +    by (auto intro!: plusplus_closed semilat)
  42.325 +  with s0 x show ?thesis by (simp add: merge_def T_A)
  42.326 +qed
  42.327 +  
  42.328 +
  42.329 +lemma pres_typeD2:
  42.330 +  "pres_type step n A \<Longrightarrow> s \<in> A \<Longrightarrow> p < n \<Longrightarrow> snd`set (step p s) \<subseteq> A"
  42.331 +  by auto (drule pres_typeD)
  42.332 +
  42.333 +
  42.334 +lemma (in lbv) wti_pres [intro?]:
  42.335 +  assumes pres: "pres_type step n A" 
  42.336 +  assumes cert: "c!(pc+1) \<in> A"
  42.337 +  assumes s_pc: "s \<in> A" "pc < n"
  42.338 +  shows "wti c pc s \<in> A"
  42.339 +proof -
  42.340 +  from pres s_pc have "snd`set (step pc s) \<subseteq> A" by (rule pres_typeD2)
  42.341 +  with cert show ?thesis by (simp add: wti merge_pres)
  42.342 +qed
  42.343 +
  42.344 +
  42.345 +lemma (in lbv) wtc_pres:
  42.346 +  assumes pres: "pres_type step n A"
  42.347 +  assumes cert: "c!pc \<in> A" and cert': "c!(pc+1) \<in> A"
  42.348 +  assumes s: "s \<in> A" and pc: "pc < n"
  42.349 +  shows "wtc c pc s \<in> A"
  42.350 +proof -
  42.351 +  have "wti c pc s \<in> A" using pres cert' s pc ..
  42.352 +  moreover have "wti c pc (c!pc) \<in> A" using pres cert' cert pc ..
  42.353 +  ultimately show ?thesis using T_A by (simp add: wtc) 
  42.354 +qed
  42.355 +
  42.356 +
  42.357 +lemma (in lbv) wtl_pres:
  42.358 +  assumes pres: "pres_type step (length is) A"
  42.359 +  assumes cert: "cert_ok c (length is) \<top> \<bottom> A"
  42.360 +  assumes s:    "s \<in> A" 
  42.361 +  assumes all:  "wtl is c 0 s \<noteq> \<top>"
  42.362 +  shows "pc < length is \<Longrightarrow> wtl (take pc is) c 0 s \<in> A"
  42.363 +  (is "?len pc \<Longrightarrow> ?wtl pc \<in> A")
  42.364 +proof (induct pc)
  42.365 +  from s show "?wtl 0 \<in> A" by simp
  42.366 +next
  42.367 +  fix n assume IH: "Suc n < length is"
  42.368 +  then have n: "n < length is" by simp  
  42.369 +  from IH have n1: "n+1 < length is" by simp
  42.370 +  assume prem: "n < length is \<Longrightarrow> ?wtl n \<in> A"
  42.371 +  have "wtc c n (?wtl n) \<in> A"
  42.372 +  using pres _ _ _ n
  42.373 +  proof (rule wtc_pres)
  42.374 +    from prem n show "?wtl n \<in> A" .
  42.375 +    from cert n show "c!n \<in> A" by (rule cert_okD1)
  42.376 +    from cert n1 show "c!(n+1) \<in> A" by (rule cert_okD1)
  42.377 +  qed
  42.378 +  also
  42.379 +  from all n have "?wtl n \<noteq> \<top>" by - (rule wtl_take)
  42.380 +  with n1 have "wtc c n (?wtl n) = ?wtl (n+1)" by (rule wtl_Suc [symmetric])
  42.381 +  finally  show "?wtl (Suc n) \<in> A" by simp
  42.382 +qed
  42.383 +
  42.384 +end
    43.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    43.2 +++ b/src/HOL/MicroJava/DFA/Listn.thy	Tue Nov 24 14:37:23 2009 +0100
    43.3 @@ -0,0 +1,542 @@
    43.4 +(*  Title:      HOL/MicroJava/BV/Listn.thy
    43.5 +    Author:     Tobias Nipkow
    43.6 +    Copyright   2000 TUM
    43.7 +*)
    43.8 +
    43.9 +header {* \isaheader{Fixed Length Lists} *}
   43.10 +
   43.11 +theory Listn
   43.12 +imports Err
   43.13 +begin
   43.14 +
   43.15 +constdefs
   43.16 +
   43.17 + list :: "nat \<Rightarrow> 'a set \<Rightarrow> 'a list set"
   43.18 +"list n A == {xs. length xs = n & set xs <= A}"
   43.19 +
   43.20 + le :: "'a ord \<Rightarrow> ('a list)ord"
   43.21 +"le r == list_all2 (%x y. x <=_r y)"
   43.22 +
   43.23 +syntax "@lesublist" :: "'a list \<Rightarrow> 'a ord \<Rightarrow> 'a list \<Rightarrow> bool"
   43.24 +       ("(_ /<=[_] _)" [50, 0, 51] 50)
   43.25 +syntax "@lesssublist" :: "'a list \<Rightarrow> 'a ord \<Rightarrow> 'a list \<Rightarrow> bool"
   43.26 +       ("(_ /<[_] _)" [50, 0, 51] 50)
   43.27 +translations
   43.28 + "x <=[r] y" == "x <=_(Listn.le r) y"
   43.29 + "x <[r] y"  == "x <_(Listn.le r) y"
   43.30 +
   43.31 +constdefs
   43.32 + map2 :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'a list \<Rightarrow> 'b list \<Rightarrow> 'c list"
   43.33 +"map2 f == (%xs ys. map (split f) (zip xs ys))"
   43.34 +
   43.35 +syntax "@plussublist" :: "'a list \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'b list \<Rightarrow> 'c list"
   43.36 +       ("(_ /+[_] _)" [65, 0, 66] 65)
   43.37 +translations  "x +[f] y" == "x +_(map2 f) y"
   43.38 +
   43.39 +consts coalesce :: "'a err list \<Rightarrow> 'a list err"
   43.40 +primrec
   43.41 +"coalesce [] = OK[]"
   43.42 +"coalesce (ex#exs) = Err.sup (op #) ex (coalesce exs)"
   43.43 +
   43.44 +constdefs
   43.45 + sl :: "nat \<Rightarrow> 'a sl \<Rightarrow> 'a list sl"
   43.46 +"sl n == %(A,r,f). (list n A, le r, map2 f)"
   43.47 +
   43.48 + sup :: "('a \<Rightarrow> 'b \<Rightarrow> 'c err) \<Rightarrow> 'a list \<Rightarrow> 'b list \<Rightarrow> 'c list err"
   43.49 +"sup f == %xs ys. if size xs = size ys then coalesce(xs +[f] ys) else Err"
   43.50 +
   43.51 + upto_esl :: "nat \<Rightarrow> 'a esl \<Rightarrow> 'a list esl"
   43.52 +"upto_esl m == %(A,r,f). (Union{list n A |n. n <= m}, le r, sup f)"
   43.53 +
   43.54 +lemmas [simp] = set_update_subsetI
   43.55 +
   43.56 +lemma unfold_lesub_list:
   43.57 +  "xs <=[r] ys == Listn.le r xs ys"
   43.58 +  by (simp add: lesub_def)
   43.59 +
   43.60 +lemma Nil_le_conv [iff]:
   43.61 +  "([] <=[r] ys) = (ys = [])"
   43.62 +apply (unfold lesub_def Listn.le_def)
   43.63 +apply simp
   43.64 +done
   43.65 +
   43.66 +lemma Cons_notle_Nil [iff]: 
   43.67 +  "~ x#xs <=[r] []"
   43.68 +apply (unfold lesub_def Listn.le_def)
   43.69 +apply simp
   43.70 +done
   43.71 +
   43.72 +
   43.73 +lemma Cons_le_Cons [iff]:
   43.74 +  "x#xs <=[r] y#ys = (x <=_r y & xs <=[r] ys)"
   43.75 +apply (unfold lesub_def Listn.le_def)
   43.76 +apply simp
   43.77 +done
   43.78 +
   43.79 +lemma Cons_less_Conss [simp]:
   43.80 +  "order r \<Longrightarrow> 
   43.81 +  x#xs <_(Listn.le r) y#ys = 
   43.82 +  (x <_r y & xs <=[r] ys  |  x = y & xs <_(Listn.le r) ys)"
   43.83 +apply (unfold lesssub_def)
   43.84 +apply blast
   43.85 +done  
   43.86 +
   43.87 +lemma list_update_le_cong:
   43.88 +  "\<lbrakk> i<size xs; xs <=[r] ys; x <=_r y \<rbrakk> \<Longrightarrow> xs[i:=x] <=[r] ys[i:=y]";
   43.89 +apply (unfold unfold_lesub_list)
   43.90 +apply (unfold Listn.le_def)
   43.91 +apply (simp add: list_all2_conv_all_nth nth_list_update)
   43.92 +done
   43.93 +
   43.94 +
   43.95 +lemma le_listD:
   43.96 +  "\<lbrakk> xs <=[r] ys; p < size xs \<rbrakk> \<Longrightarrow> xs!p <=_r ys!p"
   43.97 +apply (unfold Listn.le_def lesub_def)
   43.98 +apply (simp add: list_all2_conv_all_nth)
   43.99 +done
  43.100 +
  43.101 +lemma le_list_refl:
  43.102 +  "!x. x <=_r x \<Longrightarrow> xs <=[r] xs"
  43.103 +apply (unfold unfold_lesub_list)
  43.104 +apply (simp add: Listn.le_def list_all2_conv_all_nth)
  43.105 +done
  43.106 +
  43.107 +lemma le_list_trans:
  43.108 +  "\<lbrakk> order r; xs <=[r] ys; ys <=[r] zs \<rbrakk> \<Longrightarrow> xs <=[r] zs"
  43.109 +apply (unfold unfold_lesub_list)
  43.110 +apply (simp add: Listn.le_def list_all2_conv_all_nth)
  43.111 +apply clarify
  43.112 +apply simp
  43.113 +apply (blast intro: order_trans)
  43.114 +done
  43.115 +
  43.116 +lemma le_list_antisym:
  43.117 +  "\<lbrakk> order r; xs <=[r] ys; ys <=[r] xs \<rbrakk> \<Longrightarrow> xs = ys"
  43.118 +apply (unfold unfold_lesub_list)
  43.119 +apply (simp add: Listn.le_def list_all2_conv_all_nth)
  43.120 +apply (rule nth_equalityI)
  43.121 + apply blast
  43.122 +apply clarify
  43.123 +apply simp
  43.124 +apply (blast intro: order_antisym)
  43.125 +done
  43.126 +
  43.127 +lemma order_listI [simp, intro!]:
  43.128 +  "order r \<Longrightarrow> order(Listn.le r)"
  43.129 +apply (subst Semilat.order_def)
  43.130 +apply (blast intro: le_list_refl le_list_trans le_list_antisym
  43.131 +             dest: order_refl)
  43.132 +done
  43.133 +
  43.134 +
  43.135 +lemma lesub_list_impl_same_size [simp]:
  43.136 +  "xs <=[r] ys \<Longrightarrow> size ys = size xs"  
  43.137 +apply (unfold Listn.le_def lesub_def)
  43.138 +apply (simp add: list_all2_conv_all_nth)
  43.139 +done 
  43.140 +
  43.141 +lemma lesssub_list_impl_same_size:
  43.142 +  "xs <_(Listn.le r) ys \<Longrightarrow> size ys = size xs"
  43.143 +apply (unfold lesssub_def)
  43.144 +apply auto
  43.145 +done  
  43.146 +
  43.147 +lemma le_list_appendI:
  43.148 +  "\<And>b c d. a <=[r] b \<Longrightarrow> c <=[r] d \<Longrightarrow> a@c <=[r] b@d"
  43.149 +apply (induct a)
  43.150 + apply simp
  43.151 +apply (case_tac b)
  43.152 +apply auto
  43.153 +done
  43.154 +
  43.155 +lemma le_listI:
  43.156 +  "length a = length b \<Longrightarrow> (\<And>n. n < length a \<Longrightarrow> a!n <=_r b!n) \<Longrightarrow> a <=[r] b"
  43.157 +  apply (unfold lesub_def Listn.le_def)
  43.158 +  apply (simp add: list_all2_conv_all_nth)
  43.159 +  done
  43.160 +
  43.161 +lemma listI:
  43.162 +  "\<lbrakk> length xs = n; set xs <= A \<rbrakk> \<Longrightarrow> xs : list n A"
  43.163 +apply (unfold list_def)
  43.164 +apply blast
  43.165 +done
  43.166 +
  43.167 +lemma listE_length [simp]:
  43.168 +   "xs : list n A \<Longrightarrow> length xs = n"
  43.169 +apply (unfold list_def)
  43.170 +apply blast
  43.171 +done 
  43.172 +
  43.173 +lemma less_lengthI:
  43.174 +  "\<lbrakk> xs : list n A; p < n \<rbrakk> \<Longrightarrow> p < length xs"
  43.175 +  by simp
  43.176 +
  43.177 +lemma listE_set [simp]:
  43.178 +  "xs : list n A \<Longrightarrow> set xs <= A"
  43.179 +apply (unfold list_def)
  43.180 +apply blast
  43.181 +done 
  43.182 +
  43.183 +lemma list_0 [simp]:
  43.184 +  "list 0 A = {[]}"
  43.185 +apply (unfold list_def)
  43.186 +apply auto
  43.187 +done 
  43.188 +
  43.189 +lemma in_list_Suc_iff: 
  43.190 +  "(xs : list (Suc n) A) = (\<exists>y\<in> A. \<exists>ys\<in> list n A. xs = y#ys)"
  43.191 +apply (unfold list_def)
  43.192 +apply (case_tac "xs")
  43.193 +apply auto
  43.194 +done 
  43.195 +
  43.196 +lemma Cons_in_list_Suc [iff]:
  43.197 +  "(x#xs : list (Suc n) A) = (x\<in> A & xs : list n A)";
  43.198 +apply (simp add: in_list_Suc_iff)
  43.199 +done 
  43.200 +
  43.201 +lemma list_not_empty:
  43.202 +  "\<exists>a. a\<in> A \<Longrightarrow> \<exists>xs. xs : list n A";
  43.203 +apply (induct "n")
  43.204 + apply simp
  43.205 +apply (simp add: in_list_Suc_iff)
  43.206 +apply blast
  43.207 +done
  43.208 +
  43.209 +
  43.210 +lemma nth_in [rule_format, simp]:
  43.211 +  "!i n. length xs = n \<longrightarrow> set xs <= A \<longrightarrow> i < n \<longrightarrow> (xs!i) : A"
  43.212 +apply (induct "xs")
  43.213 + apply simp
  43.214 +apply (simp add: nth_Cons split: nat.split)
  43.215 +done
  43.216 +
  43.217 +lemma listE_nth_in:
  43.218 +  "\<lbrakk> xs : list n A; i < n \<rbrakk> \<Longrightarrow> (xs!i) : A"
  43.219 +  by auto
  43.220 +
  43.221 +
  43.222 +lemma listn_Cons_Suc [elim!]:
  43.223 +  "l#xs \<in> list n A \<Longrightarrow> (\<And>n'. n = Suc n' \<Longrightarrow> l \<in> A \<Longrightarrow> xs \<in> list n' A \<Longrightarrow> P) \<Longrightarrow> P"
  43.224 +  by (cases n) auto
  43.225 +
  43.226 +lemma listn_appendE [elim!]:
  43.227 +  "a@b \<in> list n A \<Longrightarrow> (\<And>n1 n2. n=n1+n2 \<Longrightarrow> a \<in> list n1 A \<Longrightarrow> b \<in> list n2 A \<Longrightarrow> P) \<Longrightarrow> P" 
  43.228 +proof -
  43.229 +  have "\<And>n. a@b \<in> list n A \<Longrightarrow> \<exists>n1 n2. n=n1+n2 \<and> a \<in> list n1 A \<and> b \<in> list n2 A"
  43.230 +    (is "\<And>n. ?list a n \<Longrightarrow> \<exists>n1 n2. ?P a n n1 n2")
  43.231 +  proof (induct a)
  43.232 +    fix n assume "?list [] n"
  43.233 +    hence "?P [] n 0 n" by simp
  43.234 +    thus "\<exists>n1 n2. ?P [] n n1 n2" by fast
  43.235 +  next
  43.236 +    fix n l ls
  43.237 +    assume "?list (l#ls) n"
  43.238 +    then obtain n' where n: "n = Suc n'" "l \<in> A" and list_n': "ls@b \<in> list n' A" by fastsimp
  43.239 +    assume "\<And>n. ls @ b \<in> list n A \<Longrightarrow> \<exists>n1 n2. n = n1 + n2 \<and> ls \<in> list n1 A \<and> b \<in> list n2 A"
  43.240 +    hence "\<exists>n1 n2. n' = n1 + n2 \<and> ls \<in> list n1 A \<and> b \<in> list n2 A" by this (rule list_n')
  43.241 +    then obtain n1 n2 where "n' = n1 + n2" "ls \<in> list n1 A" "b \<in> list n2 A" by fast
  43.242 +    with n have "?P (l#ls) n (n1+1) n2" by simp
  43.243 +    thus "\<exists>n1 n2. ?P (l#ls) n n1 n2" by fastsimp
  43.244 +  qed
  43.245 +  moreover
  43.246 +  assume "a@b \<in> list n A" "\<And>n1 n2. n=n1+n2 \<Longrightarrow> a \<in> list n1 A \<Longrightarrow> b \<in> list n2 A \<Longrightarrow> P"
  43.247 +  ultimately
  43.248 +  show ?thesis by blast
  43.249 +qed
  43.250 +
  43.251 +
  43.252 +lemma listt_update_in_list [simp, intro!]:
  43.253 +  "\<lbrakk> xs : list n A; x\<in> A \<rbrakk> \<Longrightarrow> xs[i := x] : list n A"
  43.254 +apply (unfold list_def)
  43.255 +apply simp
  43.256 +done 
  43.257 +
  43.258 +lemma plus_list_Nil [simp]:
  43.259 +  "[] +[f] xs = []"
  43.260 +apply (unfold plussub_def map2_def)
  43.261 +apply simp
  43.262 +done 
  43.263 +
  43.264 +lemma plus_list_Cons [simp]:
  43.265 +  "(x#xs) +[f] ys = (case ys of [] \<Rightarrow> [] | y#ys \<Rightarrow> (x +_f y)#(xs +[f] ys))"
  43.266 +  by (simp add: plussub_def map2_def split: list.split)
  43.267 +
  43.268 +lemma length_plus_list [rule_format, simp]:
  43.269 +  "!ys. length(xs +[f] ys) = min(length xs) (length ys)"
  43.270 +apply (induct xs)
  43.271 + apply simp
  43.272 +apply clarify
  43.273 +apply (simp (no_asm_simp) split: list.split)
  43.274 +done
  43.275 +
  43.276 +lemma nth_plus_list [rule_format, simp]:
  43.277 +  "!xs ys i. length xs = n \<longrightarrow> length ys = n \<longrightarrow> i<n \<longrightarrow> 
  43.278 +  (xs +[f] ys)!i = (xs!i) +_f (ys!i)"
  43.279 +apply (induct n)
  43.280 + apply simp
  43.281 +apply clarify
  43.282 +apply (case_tac xs)
  43.283 + apply simp
  43.284 +apply (force simp add: nth_Cons split: list.split nat.split)
  43.285 +done
  43.286 +
  43.287 +
  43.288 +lemma (in Semilat) plus_list_ub1 [rule_format]:
  43.289 + "\<lbrakk> set xs <= A; set ys <= A; size xs = size ys \<rbrakk> 
  43.290 +  \<Longrightarrow> xs <=[r] xs +[f] ys"
  43.291 +apply (unfold unfold_lesub_list)
  43.292 +apply (simp add: Listn.le_def list_all2_conv_all_nth)
  43.293 +done
  43.294 +
  43.295 +lemma (in Semilat) plus_list_ub2:
  43.296 + "\<lbrakk>set xs <= A; set ys <= A; size xs = size ys \<rbrakk>
  43.297 +  \<Longrightarrow> ys <=[r] xs +[f] ys"
  43.298 +apply (unfold unfold_lesub_list)
  43.299 +apply (simp add: Listn.le_def list_all2_conv_all_nth)
  43.300 +done
  43.301 +
  43.302 +lemma (in Semilat) plus_list_lub [rule_format]:
  43.303 +shows "!xs ys zs. set xs <= A \<longrightarrow> set ys <= A \<longrightarrow> set zs <= A 
  43.304 +  \<longrightarrow> size xs = n & size ys = n \<longrightarrow> 
  43.305 +  xs <=[r] zs & ys <=[r] zs \<longrightarrow> xs +[f] ys <=[r] zs"
  43.306 +apply (unfold unfold_lesub_list)
  43.307 +apply (simp add: Listn.le_def list_all2_conv_all_nth)
  43.308 +done
  43.309 +
  43.310 +lemma (in Semilat) list_update_incr [rule_format]:
  43.311 + "x\<in> A \<Longrightarrow> set xs <= A \<longrightarrow> 
  43.312 +  (!i. i<size xs \<longrightarrow> xs <=[r] xs[i := x +_f xs!i])"
  43.313 +apply (unfold unfold_lesub_list)
  43.314 +apply (simp add: Listn.le_def list_all2_conv_all_nth)
  43.315 +apply (induct xs)
  43.316 + apply simp
  43.317 +apply (simp add: in_list_Suc_iff)
  43.318 +apply clarify
  43.319 +apply (simp add: nth_Cons split: nat.split)
  43.320 +done
  43.321 +
  43.322 +lemma equals0I_aux:
  43.323 +  "(\<And>y. A y \<Longrightarrow> False) \<Longrightarrow> A = bot_class.bot"
  43.324 +  by (rule equals0I) (auto simp add: mem_def)
  43.325 +
  43.326 +lemma acc_le_listI [intro!]:
  43.327 +  "\<lbrakk> order r; acc r \<rbrakk> \<Longrightarrow> acc(Listn.le r)"
  43.328 +apply (unfold acc_def)
  43.329 +apply (subgoal_tac
  43.330 + "wf(UN n. {(ys,xs). size xs = n \<and> size ys = n \<and> xs <_(Listn.le r) ys})")
  43.331 + apply (erule wf_subset)
  43.332 + apply (blast intro: lesssub_list_impl_same_size)
  43.333 +apply (rule wf_UN)
  43.334 + prefer 2
  43.335 + apply clarify
  43.336 + apply (rename_tac m n)
  43.337 + apply (case_tac "m=n")
  43.338 +  apply simp
  43.339 + apply (fast intro!: equals0I dest: not_sym)
  43.340 +apply clarify
  43.341 +apply (rename_tac n)
  43.342 +apply (induct_tac n)
  43.343 + apply (simp add: lesssub_def cong: conj_cong)
  43.344 +apply (rename_tac k)
  43.345 +apply (simp add: wf_eq_minimal)
  43.346 +apply (simp (no_asm) add: length_Suc_conv cong: conj_cong)
  43.347 +apply clarify
  43.348 +apply (rename_tac M m)
  43.349 +apply (case_tac "\<exists>x xs. size xs = k \<and> x#xs \<in> M")
  43.350 + prefer 2
  43.351 + apply (erule thin_rl)
  43.352 + apply (erule thin_rl)
  43.353 + apply blast
  43.354 +apply (erule_tac x = "{a. \<exists>xs. size xs = k \<and> a#xs:M}" in allE)
  43.355 +apply (erule impE)
  43.356 + apply blast
  43.357 +apply (thin_tac "\<exists>x xs. ?P x xs")
  43.358 +apply clarify
  43.359 +apply (rename_tac maxA xs)
  43.360 +apply (erule_tac x = "{ys. size ys = size xs \<and> maxA#ys \<in> M}" in allE)
  43.361 +apply (erule impE)
  43.362 + apply blast
  43.363 +apply clarify
  43.364 +apply (thin_tac "m \<in> M")
  43.365 +apply (thin_tac "maxA#xs \<in> M")
  43.366 +apply (rule bexI)
  43.367 + prefer 2
  43.368 + apply assumption
  43.369 +apply clarify
  43.370 +apply simp
  43.371 +apply blast
  43.372 +done
  43.373 +
  43.374 +lemma closed_listI:
  43.375 +  "closed S f \<Longrightarrow> closed (list n S) (map2 f)"
  43.376 +apply (unfold closed_def)
  43.377 +apply (induct n)
  43.378 + apply simp
  43.379 +apply clarify
  43.380 +apply (simp add: in_list_Suc_iff)
  43.381 +apply clarify
  43.382 +apply simp
  43.383 +done
  43.384 +
  43.385 +
  43.386 +lemma Listn_sl_aux:
  43.387 +assumes "semilat (A, r, f)" shows "semilat (Listn.sl n (A,r,f))"
  43.388 +proof -
  43.389 +  interpret Semilat A r f using assms by (rule Semilat.intro)
  43.390 +show ?thesis
  43.391 +apply (unfold Listn.sl_def)
  43.392 +apply (simp (no_asm) only: semilat_Def split_conv)
  43.393 +apply (rule conjI)
  43.394 + apply simp
  43.395 +apply (rule conjI)
  43.396 + apply (simp only: closedI closed_listI)
  43.397 +apply (simp (no_asm) only: list_def)
  43.398 +apply (simp (no_asm_simp) add: plus_list_ub1 plus_list_ub2 plus_list_lub)
  43.399 +done
  43.400 +qed
  43.401 +
  43.402 +lemma Listn_sl: "\<And>L. semilat L \<Longrightarrow> semilat (Listn.sl n L)"
  43.403 + by(simp add: Listn_sl_aux split_tupled_all)
  43.404 +
  43.405 +lemma coalesce_in_err_list [rule_format]:
  43.406 +  "!xes. xes : list n (err A) \<longrightarrow> coalesce xes : err(list n A)"
  43.407 +apply (induct n)
  43.408 + apply simp
  43.409 +apply clarify
  43.410 +apply (simp add: in_list_Suc_iff)
  43.411 +apply clarify
  43.412 +apply (simp (no_asm) add: plussub_def Err.sup_def lift2_def split: err.split)
  43.413 +apply force
  43.414 +done 
  43.415 +
  43.416 +lemma lem: "\<And>x xs. x +_(op #) xs = x#xs"
  43.417 +  by (simp add: plussub_def)
  43.418 +
  43.419 +lemma coalesce_eq_OK1_D [rule_format]:
  43.420 +  "semilat(err A, Err.le r, lift2 f) \<Longrightarrow> 
  43.421 +  !xs. xs : list n A \<longrightarrow> (!ys. ys : list n A \<longrightarrow> 
  43.422 +  (!zs. coalesce (xs +[f] ys) = OK zs \<longrightarrow> xs <=[r] zs))"
  43.423 +apply (induct n)
  43.424 +  apply simp
  43.425 +apply clarify
  43.426 +apply (simp add: in_list_Suc_iff)
  43.427 +apply clarify
  43.428 +apply (simp split: err.split_asm add: lem Err.sup_def lift2_def)
  43.429 +apply (force simp add: semilat_le_err_OK1)
  43.430 +done
  43.431 +
  43.432 +lemma coalesce_eq_OK2_D [rule_format]:
  43.433 +  "semilat(err A, Err.le r, lift2 f) \<Longrightarrow> 
  43.434 +  !xs. xs : list n A \<longrightarrow> (!ys. ys : list n A \<longrightarrow> 
  43.435 +  (!zs. coalesce (xs +[f] ys) = OK zs \<longrightarrow> ys <=[r] zs))"
  43.436 +apply (induct n)
  43.437 + apply simp
  43.438 +apply clarify
  43.439 +apply (simp add: in_list_Suc_iff)
  43.440 +apply clarify
  43.441 +apply (simp split: err.split_asm add: lem Err.sup_def lift2_def)
  43.442 +apply (force simp add: semilat_le_err_OK2)
  43.443 +done 
  43.444 +
  43.445 +lemma lift2_le_ub:
  43.446 +  "\<lbrakk> semilat(err A, Err.le r, lift2 f); x\<in> A; y\<in> A; x +_f y = OK z; 
  43.447 +      u\<in> A; x <=_r u; y <=_r u \<rbrakk> \<Longrightarrow> z <=_r u"
  43.448 +apply (unfold semilat_Def plussub_def err_def)
  43.449 +apply (simp add: lift2_def)
  43.450 +apply clarify
  43.451 +apply (rotate_tac -3)
  43.452 +apply (erule thin_rl)
  43.453 +apply (erule thin_rl)
  43.454 +apply force
  43.455 +done
  43.456 +
  43.457 +lemma coalesce_eq_OK_ub_D [rule_format]:
  43.458 +  "semilat(err A, Err.le r, lift2 f) \<Longrightarrow> 
  43.459 +  !xs. xs : list n A \<longrightarrow> (!ys. ys : list n A \<longrightarrow> 
  43.460 +  (!zs us. coalesce (xs +[f] ys) = OK zs & xs <=[r] us & ys <=[r] us 
  43.461 +           & us : list n A \<longrightarrow> zs <=[r] us))"
  43.462 +apply (induct n)
  43.463 + apply simp
  43.464 +apply clarify
  43.465 +apply (simp add: in_list_Suc_iff)
  43.466 +apply clarify
  43.467 +apply (simp (no_asm_use) split: err.split_asm add: lem Err.sup_def lift2_def)
  43.468 +apply clarify
  43.469 +apply (rule conjI)
  43.470 + apply (blast intro: lift2_le_ub)
  43.471 +apply blast
  43.472 +done 
  43.473 +
  43.474 +lemma lift2_eq_ErrD:
  43.475 +  "\<lbrakk> x +_f y = Err; semilat(err A, Err.le r, lift2 f); x\<in> A; y\<in> A \<rbrakk> 
  43.476 +  \<Longrightarrow> ~(\<exists>u\<in> A. x <=_r u & y <=_r u)"
  43.477 +  by (simp add: OK_plus_OK_eq_Err_conv [THEN iffD1])
  43.478 +
  43.479 +
  43.480 +lemma coalesce_eq_Err_D [rule_format]:
  43.481 +  "\<lbrakk> semilat(err A, Err.le r, lift2 f) \<rbrakk> 
  43.482 +  \<Longrightarrow> !xs. xs\<in> list n A \<longrightarrow> (!ys. ys\<in> list n A \<longrightarrow> 
  43.483 +      coalesce (xs +[f] ys) = Err \<longrightarrow> 
  43.484 +      ~(\<exists>zs\<in> list n A. xs <=[r] zs & ys <=[r] zs))"
  43.485 +apply (induct n)
  43.486 + apply simp
  43.487 +apply clarify
  43.488 +apply (simp add: in_list_Suc_iff)
  43.489 +apply clarify
  43.490 +apply (simp split: err.split_asm add: lem Err.sup_def lift2_def)
  43.491 + apply (blast dest: lift2_eq_ErrD)
  43.492 +done 
  43.493 +
  43.494 +lemma closed_err_lift2_conv:
  43.495 +  "closed (err A) (lift2 f) = (\<forall>x\<in> A. \<forall>y\<in> A. x +_f y : err A)"
  43.496 +apply (unfold closed_def)
  43.497 +apply (simp add: err_def)
  43.498 +done 
  43.499 +
  43.500 +lemma closed_map2_list [rule_format]:
  43.501 +  "closed (err A) (lift2 f) \<Longrightarrow> 
  43.502 +  \<forall>xs. xs : list n A \<longrightarrow> (\<forall>ys. ys : list n A \<longrightarrow> 
  43.503 +  map2 f xs ys : list n (err A))"
  43.504 +apply (unfold map2_def)
  43.505 +apply (induct n)
  43.506 + apply simp
  43.507 +apply clarify
  43.508 +apply (simp add: in_list_Suc_iff)
  43.509 +apply clarify
  43.510 +apply (simp add: plussub_def closed_err_lift2_conv)
  43.511 +done
  43.512 +
  43.513 +lemma closed_lift2_sup:
  43.514 +  "closed (err A) (lift2 f) \<Longrightarrow> 
  43.515 +  closed (err (list n A)) (lift2 (sup f))"
  43.516 +  by (fastsimp  simp add: closed_def plussub_def sup_def lift2_def
  43.517 +                          coalesce_in_err_list closed_map2_list
  43.518 +                split: err.split)
  43.519 +
  43.520 +lemma err_semilat_sup:
  43.521 +  "err_semilat (A,r,f) \<Longrightarrow> 
  43.522 +  err_semilat (list n A, Listn.le r, sup f)"
  43.523 +apply (unfold Err.sl_def)
  43.524 +apply (simp only: split_conv)
  43.525 +apply (simp (no_asm) only: semilat_Def plussub_def)
  43.526 +apply (simp (no_asm_simp) only: Semilat.closedI [OF Semilat.intro] closed_lift2_sup)
  43.527 +apply (rule conjI)
  43.528 + apply (drule Semilat.orderI [OF Semilat.intro])
  43.529 + apply simp
  43.530 +apply (simp (no_asm) only: unfold_lesub_err Err.le_def err_def sup_def lift2_def)
  43.531 +apply (simp (no_asm_simp) add: coalesce_eq_OK1_D coalesce_eq_OK2_D split: err.split)
  43.532 +apply (blast intro: coalesce_eq_OK_ub_D dest: coalesce_eq_Err_D)
  43.533 +done 
  43.534 +
  43.535 +lemma err_semilat_upto_esl:
  43.536 +  "\<And>L. err_semilat L \<Longrightarrow> err_semilat(upto_esl m L)"
  43.537 +apply (unfold Listn.upto_esl_def)
  43.538 +apply (simp (no_asm_simp) only: split_tupled_all)
  43.539 +apply simp
  43.540 +apply (fastsimp intro!: err_semilat_UnionI err_semilat_sup
  43.541 +                dest: lesub_list_impl_same_size 
  43.542 +                simp add: plussub_def Listn.sup_def)
  43.543 +done
  43.544 +
  43.545 +end
    44.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    44.2 +++ b/src/HOL/MicroJava/DFA/Opt.thy	Tue Nov 24 14:37:23 2009 +0100
    44.3 @@ -0,0 +1,292 @@
    44.4 +(*  Title:      HOL/MicroJava/BV/Opt.thy
    44.5 +    Author:     Tobias Nipkow
    44.6 +    Copyright   2000 TUM
    44.7 +*)
    44.8 +
    44.9 +header {* \isaheader{More about Options} *}
   44.10 +
   44.11 +theory Opt
   44.12 +imports Err
   44.13 +begin
   44.14 +
   44.15 +constdefs
   44.16 + le :: "'a ord \<Rightarrow> 'a option ord"
   44.17 +"le r o1 o2 == case o2 of None \<Rightarrow> o1=None |
   44.18 +                              Some y \<Rightarrow> (case o1 of None \<Rightarrow> True
   44.19 +                                                  | Some x \<Rightarrow> x <=_r y)"
   44.20 +
   44.21 + opt :: "'a set \<Rightarrow> 'a option set"
   44.22 +"opt A == insert None {x . ? y:A. x = Some y}"
   44.23 +
   44.24 + sup :: "'a ebinop \<Rightarrow> 'a option ebinop"
   44.25 +"sup f o1 o2 ==  
   44.26 + case o1 of None \<Rightarrow> OK o2 | Some x \<Rightarrow> (case o2 of None \<Rightarrow> OK o1
   44.27 +     | Some y \<Rightarrow> (case f x y of Err \<Rightarrow> Err | OK z \<Rightarrow> OK (Some z)))"
   44.28 +
   44.29 + esl :: "'a esl \<Rightarrow> 'a option esl"
   44.30 +"esl == %(A,r,f). (opt A, le r, sup f)"
   44.31 +
   44.32 +lemma unfold_le_opt:
   44.33 +  "o1 <=_(le r) o2 = 
   44.34 +  (case o2 of None \<Rightarrow> o1=None | 
   44.35 +              Some y \<Rightarrow> (case o1 of None \<Rightarrow> True | Some x \<Rightarrow> x <=_r y))"
   44.36 +apply (unfold lesub_def le_def)
   44.37 +apply (rule refl)
   44.38 +done
   44.39 +
   44.40 +lemma le_opt_refl:
   44.41 +  "order r \<Longrightarrow> o1 <=_(le r) o1"
   44.42 +by (simp add: unfold_le_opt split: option.split)
   44.43 +
   44.44 +lemma le_opt_trans [rule_format]:
   44.45 +  "order r \<Longrightarrow> 
   44.46 +   o1 <=_(le r) o2 \<longrightarrow> o2 <=_(le r) o3 \<longrightarrow> o1 <=_(le r) o3"
   44.47 +apply (simp add: unfold_le_opt split: option.split)
   44.48 +apply (blast intro: order_trans)
   44.49 +done
   44.50 +
   44.51 +lemma le_opt_antisym [rule_format]:
   44.52 +  "order r \<Longrightarrow> o1 <=_(le r) o2 \<longrightarrow> o2 <=_(le r) o1 \<longrightarrow> o1=o2"
   44.53 +apply (simp add: unfold_le_opt split: option.split)
   44.54 +apply (blast intro: order_antisym)
   44.55 +done
   44.56 +
   44.57 +lemma order_le_opt [intro!,simp]:
   44.58 +  "order r \<Longrightarrow> order(le r)"
   44.59 +apply (subst Semilat.order_def)
   44.60 +apply (blast intro: le_opt_refl le_opt_trans le_opt_antisym)
   44.61 +done 
   44.62 +
   44.63 +lemma None_bot [iff]: 
   44.64 +  "None <=_(le r) ox"
   44.65 +apply (unfold lesub_def le_def)
   44.66 +apply (simp split: option.split)
   44.67 +done 
   44.68 +
   44.69 +lemma Some_le [iff]:
   44.70 +  "(Some x <=_(le r) ox) = (? y. ox = Some y & x <=_r y)"
   44.71 +apply (unfold lesub_def le_def)
   44.72 +apply (simp split: option.split)
   44.73 +done 
   44.74 +
   44.75 +lemma le_None [iff]:
   44.76 +  "(ox <=_(le r) None) = (ox = None)";
   44.77 +apply (unfold lesub_def le_def)
   44.78 +apply (simp split: option.split)
   44.79 +done 
   44.80 +
   44.81 +
   44.82 +lemma OK_None_bot [iff]:
   44.83 +  "OK None <=_(Err.le (le r)) x"
   44.84 +  by (simp add: lesub_def Err.le_def le_def split: option.split err.split)
   44.85 +
   44.86 +lemma sup_None1 [iff]:
   44.87 +  "x +_(sup f) None = OK x"
   44.88 +  by (simp add: plussub_def sup_def split: option.split)
   44.89 +
   44.90 +lemma sup_None2 [iff]:
   44.91 +  "None +_(sup f) x = OK x"
   44.92 +  by (simp add: plussub_def sup_def split: option.split)
   44.93 +
   44.94 +
   44.95 +lemma None_in_opt [iff]:
   44.96 +  "None : opt A"
   44.97 +by (simp add: opt_def)
   44.98 +
   44.99 +lemma Some_in_opt [iff]:
  44.100 +  "(Some x : opt A) = (x:A)"
  44.101 +apply (unfold opt_def)
  44.102 +apply auto
  44.103 +done 
  44.104 +
  44.105 +
  44.106 +lemma semilat_opt [intro, simp]:
  44.107 +  "\<And>L. err_semilat L \<Longrightarrow> err_semilat (Opt.esl L)"
  44.108 +proof (unfold Opt.esl_def Err.sl_def, simp add: split_tupled_all)
  44.109 +  
  44.110 +  fix A r f
  44.111 +  assume s: "semilat (err A, Err.le r, lift2 f)"
  44.112 + 
  44.113 +  let ?A0 = "err A"
  44.114 +  let ?r0 = "Err.le r"
  44.115 +  let ?f0 = "lift2 f"
  44.116 +
  44.117 +  from s
  44.118 +  obtain
  44.119 +    ord: "order ?r0" and
  44.120 +    clo: "closed ?A0 ?f0" and
  44.121 +    ub1: "\<forall>x\<in>?A0. \<forall>y\<in>?A0. x <=_?r0 x +_?f0 y" and
  44.122 +    ub2: "\<forall>x\<in>?A0. \<forall>y\<in>?A0. y <=_?r0 x +_?f0 y" and
  44.123 +    lub: "\<forall>x\<in>?A0. \<forall>y\<in>?A0. \<forall>z\<in>?A0. x <=_?r0 z \<and> y <=_?r0 z \<longrightarrow> x +_?f0 y <=_?r0 z"
  44.124 +    by (unfold semilat_def) simp
  44.125 +
  44.126 +  let ?A = "err (opt A)" 
  44.127 +  let ?r = "Err.le (Opt.le r)"
  44.128 +  let ?f = "lift2 (Opt.sup f)"
  44.129 +
  44.130 +  from ord
  44.131 +  have "order ?r"
  44.132 +    by simp
  44.133 +
  44.134 +  moreover
  44.135 +
  44.136 +  have "closed ?A ?f"
  44.137 +  proof (unfold closed_def, intro strip)
  44.138 +    fix x y    
  44.139 +    assume x: "x : ?A" 
  44.140 +    assume y: "y : ?A" 
  44.141 +
  44.142 +    { fix a b
  44.143 +      assume ab: "x = OK a" "y = OK b"
  44.144 +      
  44.145 +      with x 
  44.146 +      have a: "\<And>c. a = Some c \<Longrightarrow> c : A"
  44.147 +        by (clarsimp simp add: opt_def)
  44.148 +
  44.149 +      from ab y
  44.150 +      have b: "\<And>d. b = Some d \<Longrightarrow> d : A"
  44.151 +        by (clarsimp simp add: opt_def)
  44.152 +      
  44.153 +      { fix c d assume "a = Some c" "b = Some d"
  44.154 +        with ab x y
  44.155 +        have "c:A & d:A"
  44.156 +          by (simp add: err_def opt_def Bex_def)
  44.157 +        with clo
  44.158 +        have "f c d : err A"
  44.159 +          by (simp add: closed_def plussub_def err_def lift2_def)
  44.160 +        moreover
  44.161 +        fix z assume "f c d = OK z"
  44.162 +        ultimately
  44.163 +        have "z : A" by simp
  44.164 +      } note f_closed = this    
  44.165 +
  44.166 +      have "sup f a b : ?A"
  44.167 +      proof (cases a)
  44.168 +        case None
  44.169 +        thus ?thesis
  44.170 +          by (simp add: sup_def opt_def) (cases b, simp, simp add: b Bex_def)
  44.171 +      next
  44.172 +        case Some
  44.173 +        thus ?thesis
  44.174 +          by (auto simp add: sup_def opt_def Bex_def a b f_closed split: err.split option.split)
  44.175 +      qed
  44.176 +    }
  44.177 +
  44.178 +    thus "x +_?f y : ?A"
  44.179 +      by (simp add: plussub_def lift2_def split: err.split)
  44.180 +  qed
  44.181 +    
  44.182 +  moreover
  44.183 +
  44.184 +  { fix a b c 
  44.185 +    assume "a \<in> opt A" "b \<in> opt A" "a +_(sup f) b = OK c" 
  44.186 +    moreover
  44.187 +    from ord have "order r" by simp
  44.188 +    moreover
  44.189 +    { fix x y z
  44.190 +      assume "x \<in> A" "y \<in> A" 
  44.191 +      hence "OK x \<in> err A \<and> OK y \<in> err A" by simp
  44.192 +      with ub1 ub2
  44.193 +      have "(OK x) <=_(Err.le r) (OK x) +_(lift2 f) (OK y) \<and>
  44.194 +            (OK y) <=_(Err.le r) (OK x) +_(lift2 f) (OK y)"
  44.195 +        by blast
  44.196 +      moreover
  44.197 +      assume "x +_f y = OK z"
  44.198 +      ultimately
  44.199 +      have "x <=_r z \<and> y <=_r z"
  44.200 +        by (auto simp add: plussub_def lift2_def Err.le_def lesub_def)
  44.201 +    }
  44.202 +    ultimately
  44.203 +    have "a <=_(le r) c \<and> b <=_(le r) c"
  44.204 +      by (auto simp add: sup_def le_def lesub_def plussub_def 
  44.205 +               dest: order_refl split: option.splits err.splits)
  44.206 +  }
  44.207 +     
  44.208 +  hence "(\<forall>x\<in>?A. \<forall>y\<in>?A. x <=_?r x +_?f y) \<and> (\<forall>x\<in>?A. \<forall>y\<in>?A. y <=_?r x +_?f y)"
  44.209 +    by (auto simp add: lesub_def plussub_def Err.le_def lift2_def split: err.split)
  44.210 +
  44.211 +  moreover
  44.212 +
  44.213 +  have "\<forall>x\<in>?A. \<forall>y\<in>?A. \<forall>z\<in>?A. x <=_?r z \<and> y <=_?r z \<longrightarrow> x +_?f y <=_?r z"
  44.214 +  proof (intro strip, elim conjE)
  44.215 +    fix x y z
  44.216 +    assume xyz: "x : ?A" "y : ?A" "z : ?A"
  44.217 +    assume xz: "x <=_?r z"
  44.218 +    assume yz: "y <=_?r z"
  44.219 +
  44.220 +    { fix a b c
  44.221 +      assume ok: "x = OK a" "y = OK b" "z = OK c"
  44.222 +
  44.223 +      { fix d e g
  44.224 +        assume some: "a = Some d" "b = Some e" "c = Some g"
  44.225 +        
  44.226 +        with ok xyz
  44.227 +        obtain "OK d:err A" "OK e:err A" "OK g:err A"
  44.228 +          by simp
  44.229 +        with lub
  44.230 +        have "\<lbrakk> (OK d) <=_(Err.le r) (OK g); (OK e) <=_(Err.le r) (OK g) \<rbrakk>
  44.231 +          \<Longrightarrow> (OK d) +_(lift2 f) (OK e) <=_(Err.le r) (OK g)"
  44.232 +          by blast
  44.233 +        hence "\<lbrakk> d <=_r g; e <=_r g \<rbrakk> \<Longrightarrow> \<exists>y. d +_f e = OK y \<and> y <=_r g"
  44.234 +          by simp
  44.235 +
  44.236 +        with ok some xyz xz yz
  44.237 +        have "x +_?f y <=_?r z"
  44.238 +          by (auto simp add: sup_def le_def lesub_def lift2_def plussub_def Err.le_def)
  44.239 +      } note this [intro!]
  44.240 +
  44.241 +      from ok xyz xz yz
  44.242 +      have "x +_?f y <=_?r z"
  44.243 +        by - (cases a, simp, cases b, simp, cases c, simp, blast)
  44.244 +    }
  44.245 +    
  44.246 +    with xyz xz yz
  44.247 +    show "x +_?f y <=_?r z"
  44.248 +      by - (cases x, simp, cases y, simp, cases z, simp+)
  44.249 +  qed
  44.250 +
  44.251 +  ultimately
  44.252 +
  44.253 +  show "semilat (?A,?r,?f)"
  44.254 +    by (unfold semilat_def) simp
  44.255 +qed 
  44.256 +
  44.257 +lemma top_le_opt_Some [iff]: 
  44.258 +  "top (le r) (Some T) = top r T"
  44.259 +apply (unfold top_def)
  44.260 +apply (rule iffI)
  44.261 + apply blast
  44.262 +apply (rule allI)
  44.263 +apply (case_tac "x")
  44.264 +apply simp+
  44.265 +done 
  44.266 +
  44.267 +lemma Top_le_conv:
  44.268 +  "\<lbrakk> order r; top r T \<rbrakk> \<Longrightarrow> (T <=_r x) = (x = T)"
  44.269 +apply (unfold top_def)
  44.270 +apply (blast intro: order_antisym)
  44.271 +done 
  44.272 +
  44.273 +
  44.274 +lemma acc_le_optI [intro!]:
  44.275 +  "acc r \<Longrightarrow> acc(le r)"
  44.276 +apply (unfold acc_def lesub_def le_def lesssub_def)
  44.277 +apply (simp add: wf_eq_minimal split: option.split)
  44.278 +apply clarify
  44.279 +apply (case_tac "? a. Some a : Q")
  44.280 + apply (erule_tac x = "{a . Some a : Q}" in allE)
  44.281 + apply blast
  44.282 +apply (case_tac "x")
  44.283 + apply blast
  44.284 +apply blast
  44.285 +done 
  44.286 +
  44.287 +lemma option_map_in_optionI:
  44.288 +  "\<lbrakk> ox : opt S; !x:S. ox = Some x \<longrightarrow> f x : S \<rbrakk> 
  44.289 +  \<Longrightarrow> Option.map f ox : opt S";
  44.290 +apply (unfold Option.map_def)
  44.291 +apply (simp split: option.split)
  44.292 +apply blast
  44.293 +done 
  44.294 +
  44.295 +end
    45.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    45.2 +++ b/src/HOL/MicroJava/DFA/Product.thy	Tue Nov 24 14:37:23 2009 +0100
    45.3 @@ -0,0 +1,141 @@
    45.4 +(*  Title:      HOL/MicroJava/BV/Product.thy
    45.5 +    Author:     Tobias Nipkow
    45.6 +    Copyright   2000 TUM
    45.7 +*)
    45.8 +
    45.9 +header {* \isaheader{Products as Semilattices} *}
   45.10 +
   45.11 +theory Product
   45.12 +imports Err
   45.13 +begin
   45.14 +
   45.15 +constdefs
   45.16 + le :: "'a ord \<Rightarrow> 'b ord \<Rightarrow> ('a * 'b) ord"
   45.17 +"le rA rB == %(a,b) (a',b'). a <=_rA a' & b <=_rB b'"
   45.18 +
   45.19 + sup :: "'a ebinop \<Rightarrow> 'b ebinop \<Rightarrow> ('a * 'b)ebinop"
   45.20 +"sup f g == %(a1,b1)(a2,b2). Err.sup Pair (a1 +_f a2) (b1 +_g b2)"
   45.21 +
   45.22 + esl :: "'a esl \<Rightarrow> 'b esl \<Rightarrow> ('a * 'b ) esl"
   45.23 +"esl == %(A,rA,fA) (B,rB,fB). (A <*> B, le rA rB, sup fA fB)"
   45.24 +
   45.25 +syntax "@lesubprod" :: "'a*'b \<Rightarrow> 'a ord \<Rightarrow> 'b ord \<Rightarrow> 'b \<Rightarrow> bool"
   45.26 +       ("(_ /<='(_,_') _)" [50, 0, 0, 51] 50)
   45.27 +translations "p <=(rA,rB) q" == "p <=_(Product.le rA rB) q"
   45.28 +
   45.29 +lemma unfold_lesub_prod:
   45.30 +  "p <=(rA,rB) q == le rA rB p q"
   45.31 +  by (simp add: lesub_def)
   45.32 +
   45.33 +lemma le_prod_Pair_conv [iff]:
   45.34 +  "((a1,b1) <=(rA,rB) (a2,b2)) = (a1 <=_rA a2 & b1 <=_rB b2)"
   45.35 +  by (simp add: lesub_def le_def)
   45.36 +
   45.37 +lemma less_prod_Pair_conv:
   45.38 +  "((a1,b1) <_(Product.le rA rB) (a2,b2)) = 
   45.39 +  (a1 <_rA a2 & b1 <=_rB b2 | a1 <=_rA a2 & b1 <_rB b2)"
   45.40 +apply (unfold lesssub_def)
   45.41 +apply simp
   45.42 +apply blast
   45.43 +done
   45.44 +
   45.45 +lemma order_le_prod [iff]:
   45.46 +  "order(Product.le rA rB) = (order rA & order rB)"
   45.47 +apply (unfold Semilat.order_def)
   45.48 +apply simp
   45.49 +apply blast
   45.50 +done 
   45.51 +
   45.52 +lemma acc_le_prodI [intro!]:
   45.53 +  "\<lbrakk> acc r\<^isub>A; acc r\<^isub>B \<rbrakk> \<Longrightarrow> acc(Product.le r\<^isub>A r\<^isub>B)"
   45.54 +apply (unfold acc_def)
   45.55 +apply (rule wf_subset)
   45.56 + apply (erule wf_lex_prod)
   45.57 + apply assumption
   45.58 +apply (auto simp add: lesssub_def less_prod_Pair_conv lex_prod_def)
   45.59 +done
   45.60 +
   45.61 +lemma closed_lift2_sup:
   45.62 +  "\<lbrakk> closed (err A) (lift2 f); closed (err B) (lift2 g) \<rbrakk> \<Longrightarrow> 
   45.63 +  closed (err(A<*>B)) (lift2(sup f g))";
   45.64 +apply (unfold closed_def plussub_def lift2_def err_def sup_def)
   45.65 +apply (simp split: err.split)
   45.66 +apply blast
   45.67 +done 
   45.68 +
   45.69 +lemma unfold_plussub_lift2:
   45.70 +  "e1 +_(lift2 f) e2 == lift2 f e1 e2"
   45.71 +  by (simp add: plussub_def)
   45.72 +
   45.73 +
   45.74 +lemma plus_eq_Err_conv [simp]:
   45.75 +  assumes "x:A" and "y:A"
   45.76 +    and "semilat(err A, Err.le r, lift2 f)"
   45.77 +  shows "(x +_f y = Err) = (~(? z:A. x <=_r z & y <=_r z))"
   45.78 +proof -
   45.79 +  have plus_le_conv2:
   45.80 +    "\<And>r f z. \<lbrakk> z : err A; semilat (err A, r, f); OK x : err A; OK y : err A;
   45.81 +                 OK x +_f OK y <=_r z\<rbrakk> \<Longrightarrow> OK x <=_r z \<and> OK y <=_r z"
   45.82 +    by (rule Semilat.plus_le_conv [OF Semilat.intro, THEN iffD1])
   45.83 +  from prems show ?thesis
   45.84 +  apply (rule_tac iffI)
   45.85 +   apply clarify
   45.86 +   apply (drule OK_le_err_OK [THEN iffD2])
   45.87 +   apply (drule OK_le_err_OK [THEN iffD2])
   45.88 +   apply (drule Semilat.lub [OF Semilat.intro, of _ _ _ "OK x" _ "OK y"])
   45.89 +        apply assumption
   45.90 +       apply assumption
   45.91 +      apply simp
   45.92 +     apply simp
   45.93 +    apply simp
   45.94 +   apply simp
   45.95 +  apply (case_tac "x +_f y")
   45.96 +   apply assumption
   45.97 +  apply (rename_tac "z")
   45.98 +  apply (subgoal_tac "OK z: err A")
   45.99 +  apply (frule plus_le_conv2)
  45.100 +       apply assumption
  45.101 +      apply simp
  45.102 +      apply blast
  45.103 +     apply simp
  45.104 +    apply (blast dest: Semilat.orderI [OF Semilat.intro] order_refl)
  45.105 +   apply blast
  45.106 +  apply (erule subst)
  45.107 +  apply (unfold semilat_def err_def closed_def)
  45.108 +  apply simp
  45.109 +  done
  45.110 +qed
  45.111 +
  45.112 +lemma err_semilat_Product_esl:
  45.113 +  "\<And>L1 L2. \<lbrakk> err_semilat L1; err_semilat L2 \<rbrakk> \<Longrightarrow> err_semilat(Product.esl L1 L2)"
  45.114 +apply (unfold esl_def Err.sl_def)
  45.115 +apply (simp (no_asm_simp) only: split_tupled_all)
  45.116 +apply simp
  45.117 +apply (simp (no_asm) only: semilat_Def)
  45.118 +apply (simp (no_asm_simp) only: Semilat.closedI [OF Semilat.intro] closed_lift2_sup)
  45.119 +apply (simp (no_asm) only: unfold_lesub_err Err.le_def unfold_plussub_lift2 sup_def)
  45.120 +apply (auto elim: semilat_le_err_OK1 semilat_le_err_OK2
  45.121 +            simp add: lift2_def  split: err.split)
  45.122 +apply (blast dest: Semilat.orderI [OF Semilat.intro])
  45.123 +apply (blast dest: Semilat.orderI [OF Semilat.intro])
  45.124 +
  45.125 +apply (rule OK_le_err_OK [THEN iffD1])
  45.126 +apply (erule subst, subst OK_lift2_OK [symmetric], rule Semilat.lub [OF Semilat.intro])
  45.127 +apply simp
  45.128 +apply simp
  45.129 +apply simp
  45.130 +apply simp
  45.131 +apply simp
  45.132 +apply simp
  45.133 +
  45.134 +apply (rule OK_le_err_OK [THEN iffD1])
  45.135 +apply (erule subst, subst OK_lift2_OK [symmetric], rule Semilat.lub [OF Semilat.intro])
  45.136 +apply simp
  45.137 +apply simp
  45.138 +apply simp
  45.139 +apply simp
  45.140 +apply simp
  45.141 +apply simp
  45.142 +done 
  45.143 +
  45.144 +end
    46.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    46.2 +++ b/src/HOL/MicroJava/DFA/Semilat.thy	Tue Nov 24 14:37:23 2009 +0100
    46.3 @@ -0,0 +1,374 @@
    46.4 +(*  Title:      HOL/MicroJava/BV/Semilat.thy
    46.5 +    Author:     Tobias Nipkow
    46.6 +    Copyright   2000 TUM
    46.7 +*)
    46.8 +
    46.9 +header {* 
   46.10 +  \chapter{Bytecode Verifier}\label{cha:bv}
   46.11 +  \isaheader{Semilattices} 
   46.12 +*}
   46.13 +
   46.14 +theory Semilat
   46.15 +imports Main While_Combinator
   46.16 +begin
   46.17 +
   46.18 +types 
   46.19 +  'a ord    = "'a \<Rightarrow> 'a \<Rightarrow> bool"
   46.20 +  'a binop  = "'a \<Rightarrow> 'a \<Rightarrow> 'a"
   46.21 +  'a sl     = "'a set \<times> 'a ord \<times> 'a binop"
   46.22 +
   46.23 +consts
   46.24 +  "lesub" :: "'a \<Rightarrow> 'a ord \<Rightarrow> 'a \<Rightarrow> bool"
   46.25 +  "lesssub" :: "'a \<Rightarrow> 'a ord \<Rightarrow> 'a \<Rightarrow> bool"
   46.26 +  "plussub" :: "'a \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'b \<Rightarrow> 'c" 
   46.27 +(*<*)
   46.28 +syntax 
   46.29 +  "lesub"   :: "'a \<Rightarrow> 'a ord \<Rightarrow> 'a \<Rightarrow> bool" ("(_ /<='__ _)" [50, 1000, 51] 50)
   46.30 +  "lesssub" :: "'a \<Rightarrow> 'a ord \<Rightarrow> 'a \<Rightarrow> bool" ("(_ /<'__ _)" [50, 1000, 51] 50)
   46.31 +  "plussub" :: "'a \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'b \<Rightarrow> 'c" ("(_ /+'__ _)" [65, 1000, 66] 65)
   46.32 +(*>*)
   46.33 +syntax (xsymbols)
   46.34 +  "lesub" :: "'a \<Rightarrow> 'a ord \<Rightarrow> 'a \<Rightarrow> bool" ("(_ /\<sqsubseteq>\<^bsub>_\<^esub> _)" [50, 0, 51] 50)
   46.35 +  "lesssub" :: "'a \<Rightarrow> 'a ord \<Rightarrow> 'a \<Rightarrow> bool" ("(_ /\<sqsubset>\<^bsub>_\<^esub> _)" [50, 0, 51] 50)
   46.36 +  "plussub" :: "'a \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'b \<Rightarrow> 'c" ("(_ /\<squnion>\<^bsub>_\<^esub> _)" [65, 0, 66] 65)
   46.37 +(*<*)
   46.38 + (* allow \<sub> instead of \<bsub>..\<esub> *)  
   46.39 +  "@lesub" :: "'a \<Rightarrow> 'a ord \<Rightarrow> 'a \<Rightarrow> bool" ("(_ /\<sqsubseteq>\<^sub>_ _)" [50, 1000, 51] 50)
   46.40 +  "@lesssub" :: "'a \<Rightarrow> 'a ord \<Rightarrow> 'a \<Rightarrow> bool" ("(_ /\<sqsubset>\<^sub>_ _)" [50, 1000, 51] 50)
   46.41 +  "@plussub" :: "'a \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'b \<Rightarrow> 'c" ("(_ /\<squnion>\<^sub>_ _)" [65, 1000, 66] 65)
   46.42 +
   46.43 +translations
   46.44 +  "x \<sqsubseteq>\<^sub>r y" => "x \<sqsubseteq>\<^bsub>r\<^esub> y"
   46.45 +  "x \<sqsubset>\<^sub>r y" => "x \<sqsubset>\<^bsub>r\<^esub> y" 
   46.46 +  "x \<squnion>\<^sub>f y" => "x \<squnion>\<^bsub>f\<^esub> y" 
   46.47 +(*>*)
   46.48 +
   46.49 +defs
   46.50 +  lesub_def:   "x \<sqsubseteq>\<^sub>r y \<equiv> r x y"
   46.51 +  lesssub_def: "x \<sqsubset>\<^sub>r y \<equiv> x \<sqsubseteq>\<^sub>r y \<and> x \<noteq> y"
   46.52 +  plussub_def: "x \<squnion>\<^sub>f y \<equiv> f x y"
   46.53 +
   46.54 +constdefs
   46.55 +  ord :: "('a \<times> 'a) set \<Rightarrow> 'a ord"
   46.56 +  "ord r \<equiv> \<lambda>x y. (x,y) \<in> r"
   46.57 +
   46.58 +  order :: "'a ord \<Rightarrow> bool"
   46.59 +  "order r \<equiv> (\<forall>x. x \<sqsubseteq>\<^sub>r x) \<and> (\<forall>x y. x \<sqsubseteq>\<^sub>r y \<and> y \<sqsubseteq>\<^sub>r x \<longrightarrow> x=y) \<and> (\<forall>x y z. x \<sqsubseteq>\<^sub>r y \<and> y \<sqsubseteq>\<^sub>r z \<longrightarrow> x \<sqsubseteq>\<^sub>r z)"
   46.60 +
   46.61 +  top :: "'a ord \<Rightarrow> 'a \<Rightarrow> bool"
   46.62 +  "top r T \<equiv> \<forall>x. x \<sqsubseteq>\<^sub>r T"
   46.63 +  
   46.64 +  acc :: "'a ord \<Rightarrow> bool"
   46.65 +  "acc r \<equiv> wf {(y,x). x \<sqsubset>\<^sub>r y}"
   46.66 +
   46.67 +  closed :: "'a set \<Rightarrow> 'a binop \<Rightarrow> bool"
   46.68 +  "closed A f \<equiv> \<forall>x\<in>A. \<forall>y\<in>A. x \<squnion>\<^sub>f y \<in> A"
   46.69 +
   46.70 +  semilat :: "'a sl \<Rightarrow> bool"
   46.71 +  "semilat \<equiv> \<lambda>(A,r,f). order r \<and> closed A f \<and> 
   46.72 +                       (\<forall>x\<in>A. \<forall>y\<in>A. x \<sqsubseteq>\<^sub>r x \<squnion>\<^sub>f y) \<and>
   46.73 +                       (\<forall>x\<in>A. \<forall>y\<in>A. y \<sqsubseteq>\<^sub>r x \<squnion>\<^sub>f y) \<and>
   46.74 +                       (\<forall>x\<in>A. \<forall>y\<in>A. \<forall>z\<in>A. x \<sqsubseteq>\<^sub>r z \<and> y \<sqsubseteq>\<^sub>r z \<longrightarrow> x \<squnion>\<^sub>f y \<sqsubseteq>\<^sub>r z)"
   46.75 +
   46.76 +
   46.77 +  is_ub :: "('a \<times> 'a) set \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool"
   46.78 +  "is_ub r x y u \<equiv> (x,u)\<in>r \<and> (y,u)\<in>r"
   46.79 +
   46.80 +  is_lub :: "('a \<times> 'a) set \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool"
   46.81 +  "is_lub r x y u \<equiv> is_ub r x y u \<and> (\<forall>z. is_ub r x y z \<longrightarrow> (u,z)\<in>r)"
   46.82 +
   46.83 +  some_lub :: "('a \<times> 'a) set \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a"
   46.84 +  "some_lub r x y \<equiv> SOME z. is_lub r x y z"
   46.85 +
   46.86 +locale Semilat =
   46.87 +  fixes A :: "'a set"
   46.88 +  fixes r :: "'a ord"
   46.89 +  fixes f :: "'a binop"
   46.90 +  assumes semilat: "semilat (A, r, f)"
   46.91 +
   46.92 +lemma order_refl [simp, intro]: "order r \<Longrightarrow> x \<sqsubseteq>\<^sub>r x"
   46.93 +  (*<*) by (unfold order_def) (simp (no_asm_simp)) (*>*)
   46.94 +
   46.95 +lemma order_antisym: "\<lbrakk> order r; x \<sqsubseteq>\<^sub>r y; y \<sqsubseteq>\<^sub>r x \<rbrakk> \<Longrightarrow> x = y"
   46.96 +  (*<*) by (unfold order_def) (simp (no_asm_simp)) (*>*)
   46.97 +
   46.98 +lemma order_trans: "\<lbrakk> order r; x \<sqsubseteq>\<^sub>r y; y \<sqsubseteq>\<^sub>r z \<rbrakk> \<Longrightarrow> x \<sqsubseteq>\<^sub>r z"
   46.99 +  (*<*) by (unfold order_def) blast (*>*)
  46.100 +
  46.101 +lemma order_less_irrefl [intro, simp]: "order r \<Longrightarrow> \<not> x \<sqsubset>\<^sub>r x"
  46.102 +  (*<*) by (unfold order_def lesssub_def) blast (*>*)
  46.103 +
  46.104 +lemma order_less_trans: "\<lbrakk> order r; x \<sqsubset>\<^sub>r y; y \<sqsubset>\<^sub>r z \<rbrakk> \<Longrightarrow> x \<sqsubset>\<^sub>r z"
  46.105 +  (*<*) by (unfold order_def lesssub_def) blast (*>*)
  46.106 +
  46.107 +lemma topD [simp, intro]: "top r T \<Longrightarrow> x \<sqsubseteq>\<^sub>r T"
  46.108 +  (*<*) by (simp add: top_def) (*>*)
  46.109 +
  46.110 +lemma top_le_conv [simp]: "\<lbrakk> order r; top r T \<rbrakk> \<Longrightarrow> (T \<sqsubseteq>\<^sub>r x) = (x = T)"
  46.111 +  (*<*) by (blast intro: order_antisym) (*>*)
  46.112 +
  46.113 +lemma semilat_Def:
  46.114 +"semilat(A,r,f) \<equiv> order r \<and> closed A f \<and> 
  46.115 +                 (\<forall>x\<in>A. \<forall>y\<in>A. x \<sqsubseteq>\<^sub>r x \<squnion>\<^sub>f y) \<and> 
  46.116 +                 (\<forall>x\<in>A. \<forall>y\<in>A. y \<sqsubseteq>\<^sub>r x \<squnion>\<^sub>f y) \<and> 
  46.117 +                 (\<forall>x\<in>A. \<forall>y\<in>A. \<forall>z\<in>A. x \<sqsubseteq>\<^sub>r z \<and> y \<sqsubseteq>\<^sub>r z \<longrightarrow> x \<squnion>\<^sub>f y \<sqsubseteq>\<^sub>r z)"
  46.118 +  (*<*) by (unfold semilat_def) clarsimp (*>*)
  46.119 +
  46.120 +lemma (in Semilat) orderI [simp, intro]: "order r"
  46.121 +  (*<*) using semilat by (simp add: semilat_Def) (*>*)
  46.122 +
  46.123 +lemma (in Semilat) closedI [simp, intro]: "closed A f"
  46.124 +  (*<*) using semilat by (simp add: semilat_Def) (*>*)
  46.125 +
  46.126 +lemma closedD: "\<lbrakk> closed A f; x\<in>A; y\<in>A \<rbrakk> \<Longrightarrow> x \<squnion>\<^sub>f y \<in> A"
  46.127 +  (*<*) by (unfold closed_def) blast (*>*)
  46.128 +
  46.129 +lemma closed_UNIV [simp]: "closed UNIV f"
  46.130 +  (*<*) by (simp add: closed_def) (*>*)
  46.131 +
  46.132 +lemma (in Semilat) closed_f [simp, intro]: "\<lbrakk>x \<in> A; y \<in> A\<rbrakk>  \<Longrightarrow> x \<squnion>\<^sub>f y \<in> A"
  46.133 +  (*<*) by (simp add: closedD [OF closedI]) (*>*)
  46.134 +
  46.135 +lemma (in Semilat) refl_r [intro, simp]: "x \<sqsubseteq>\<^sub>r x" by simp
  46.136 +
  46.137 +lemma (in Semilat) antisym_r [intro?]: "\<lbrakk> x \<sqsubseteq>\<^sub>r y; y \<sqsubseteq>\<^sub>r x \<rbrakk> \<Longrightarrow> x = y"
  46.138 +  (*<*) by (rule order_antisym) auto (*>*)
  46.139 +  
  46.140 +lemma (in Semilat) trans_r [trans, intro?]: "\<lbrakk>x \<sqsubseteq>\<^sub>r y; y \<sqsubseteq>\<^sub>r z\<rbrakk> \<Longrightarrow> x \<sqsubseteq>\<^sub>r z"
  46.141 +  (*<*) by (auto intro: order_trans) (*>*)
  46.142 +  
  46.143 +lemma (in Semilat) ub1 [simp, intro?]: "\<lbrakk> x \<in> A; y \<in> A \<rbrakk> \<Longrightarrow> x \<sqsubseteq>\<^sub>r x \<squnion>\<^sub>f y"
  46.144 +  (*<*) by (insert semilat) (unfold semilat_Def, simp) (*>*)
  46.145 +
  46.146 +lemma (in Semilat) ub2 [simp, intro?]: "\<lbrakk> x \<in> A; y \<in> A \<rbrakk> \<Longrightarrow> y \<sqsubseteq>\<^sub>r x \<squnion>\<^sub>f y"
  46.147 +  (*<*) by (insert semilat) (unfold semilat_Def, simp) (*>*)
  46.148 +
  46.149 +lemma (in Semilat) lub [simp, intro?]:
  46.150 +  "\<lbrakk> x \<sqsubseteq>\<^sub>r z; y \<sqsubseteq>\<^sub>r z; x \<in> A; y \<in> A; z \<in> A \<rbrakk> \<Longrightarrow> x \<squnion>\<^sub>f y \<sqsubseteq>\<^sub>r z";
  46.151 +  (*<*) by (insert semilat) (unfold semilat_Def, simp) (*>*)
  46.152 +
  46.153 +lemma (in Semilat) plus_le_conv [simp]:
  46.154 +  "\<lbrakk> x \<in> A; y \<in> A; z \<in> A \<rbrakk> \<Longrightarrow> (x \<squnion>\<^sub>f y \<sqsubseteq>\<^sub>r z) = (x \<sqsubseteq>\<^sub>r z \<and> y \<sqsubseteq>\<^sub>r z)"
  46.155 +  (*<*) by (blast intro: ub1 ub2 lub order_trans) (*>*)
  46.156 +
  46.157 +lemma (in Semilat) le_iff_plus_unchanged: "\<lbrakk> x \<in> A; y \<in> A \<rbrakk> \<Longrightarrow> (x \<sqsubseteq>\<^sub>r y) = (x \<squnion>\<^sub>f y = y)"
  46.158 +(*<*)
  46.159 +apply (rule iffI)
  46.160 + apply (blast intro: antisym_r refl_r lub ub2)
  46.161 +apply (erule subst)
  46.162 +apply simp
  46.163 +done
  46.164 +(*>*)
  46.165 +
  46.166 +lemma (in Semilat) le_iff_plus_unchanged2: "\<lbrakk> x \<in> A; y \<in> A \<rbrakk> \<Longrightarrow> (x \<sqsubseteq>\<^sub>r y) = (y \<squnion>\<^sub>f x = y)"
  46.167 +(*<*)
  46.168 +apply (rule iffI)
  46.169 + apply (blast intro: order_antisym lub order_refl ub1)
  46.170 +apply (erule subst)
  46.171 +apply simp
  46.172 +done 
  46.173 +(*>*)
  46.174 +
  46.175 +
  46.176 +lemma (in Semilat) plus_assoc [simp]:
  46.177 +  assumes a: "a \<in> A" and b: "b \<in> A" and c: "c \<in> A"
  46.178 +  shows "a \<squnion>\<^sub>f (b \<squnion>\<^sub>f c) = a \<squnion>\<^sub>f b \<squnion>\<^sub>f c"
  46.179 +(*<*)
  46.180 +proof -
  46.181 +  from a b have ab: "a \<squnion>\<^sub>f b \<in> A" ..
  46.182 +  from this c have abc: "(a \<squnion>\<^sub>f b) \<squnion>\<^sub>f c \<in> A" ..
  46.183 +  from b c have bc: "b \<squnion>\<^sub>f c \<in> A" ..
  46.184 +  from a this have abc': "a \<squnion>\<^sub>f (b \<squnion>\<^sub>f c) \<in> A" ..
  46.185 +
  46.186 +  show ?thesis
  46.187 +  proof    
  46.188 +    show "a \<squnion>\<^sub>f (b \<squnion>\<^sub>f c) \<sqsubseteq>\<^sub>r (a \<squnion>\<^sub>f b) \<squnion>\<^sub>f c"
  46.189 +    proof -
  46.190 +      from a b have "a \<sqsubseteq>\<^sub>r a \<squnion>\<^sub>f b" .. 
  46.191 +      also from ab c have "\<dots> \<sqsubseteq>\<^sub>r \<dots> \<squnion>\<^sub>f c" ..
  46.192 +      finally have "a<": "a \<sqsubseteq>\<^sub>r (a \<squnion>\<^sub>f b) \<squnion>\<^sub>f c" .
  46.193 +      from a b have "b \<sqsubseteq>\<^sub>r a \<squnion>\<^sub>f b" ..
  46.194 +      also from ab c have "\<dots> \<sqsubseteq>\<^sub>r \<dots> \<squnion>\<^sub>f c" ..
  46.195 +      finally have "b<": "b \<sqsubseteq>\<^sub>r (a \<squnion>\<^sub>f b) \<squnion>\<^sub>f c" .
  46.196 +      from ab c have "c<": "c \<sqsubseteq>\<^sub>r (a \<squnion>\<^sub>f b) \<squnion>\<^sub>f c" ..    
  46.197 +      from "b<" "c<" b c abc have "b \<squnion>\<^sub>f c \<sqsubseteq>\<^sub>r (a \<squnion>\<^sub>f b) \<squnion>\<^sub>f c" ..
  46.198 +      from "a<" this a bc abc show ?thesis ..
  46.199 +    qed
  46.200 +    show "(a \<squnion>\<^sub>f b) \<squnion>\<^sub>f c \<sqsubseteq>\<^sub>r a \<squnion>\<^sub>f (b \<squnion>\<^sub>f c)" 
  46.201 +    proof -
  46.202 +      from b c have "b \<sqsubseteq>\<^sub>r b \<squnion>\<^sub>f c" .. 
  46.203 +      also from a bc have "\<dots> \<sqsubseteq>\<^sub>r a \<squnion>\<^sub>f \<dots>" ..
  46.204 +      finally have "b<": "b \<sqsubseteq>\<^sub>r a \<squnion>\<^sub>f (b \<squnion>\<^sub>f c)" .
  46.205 +      from b c have "c \<sqsubseteq>\<^sub>r b \<squnion>\<^sub>f c" ..
  46.206 +      also from a bc have "\<dots> \<sqsubseteq>\<^sub>r a \<squnion>\<^sub>f \<dots>" ..
  46.207 +      finally have "c<": "c \<sqsubseteq>\<^sub>r a \<squnion>\<^sub>f (b \<squnion>\<^sub>f c)" .
  46.208 +      from a bc have "a<": "a \<sqsubseteq>\<^sub>r a \<squnion>\<^sub>f (b \<squnion>\<^sub>f c)" ..
  46.209 +      from "a<" "b<" a b abc' have "a \<squnion>\<^sub>f b \<sqsubseteq>\<^sub>r a \<squnion>\<^sub>f (b \<squnion>\<^sub>f c)" ..
  46.210 +      from this "c<" ab c abc' show ?thesis ..
  46.211 +    qed
  46.212 +  qed
  46.213 +qed
  46.214 +(*>*)
  46.215 +
  46.216 +lemma (in Semilat) plus_com_lemma:
  46.217 +  "\<lbrakk>a \<in> A; b \<in> A\<rbrakk> \<Longrightarrow> a \<squnion>\<^sub>f b \<sqsubseteq>\<^sub>r b \<squnion>\<^sub>f a"
  46.218 +(*<*)
  46.219 +proof -
  46.220 +  assume a: "a \<in> A" and b: "b \<in> A"  
  46.221 +  from b a have "a \<sqsubseteq>\<^sub>r b \<squnion>\<^sub>f a" .. 
  46.222 +  moreover from b a have "b \<sqsubseteq>\<^sub>r b \<squnion>\<^sub>f a" ..
  46.223 +  moreover note a b
  46.224 +  moreover from b a have "b \<squnion>\<^sub>f a \<in> A" ..
  46.225 +  ultimately show ?thesis ..
  46.226 +qed
  46.227 +(*>*)
  46.228 +
  46.229 +lemma (in Semilat) plus_commutative:
  46.230 +  "\<lbrakk>a \<in> A; b \<in> A\<rbrakk> \<Longrightarrow> a \<squnion>\<^sub>f b = b \<squnion>\<^sub>f a"
  46.231 +  (*<*) by(blast intro: order_antisym plus_com_lemma) (*>*)
  46.232 +
  46.233 +lemma is_lubD:
  46.234 +  "is_lub r x y u \<Longrightarrow> is_ub r x y u \<and> (\<forall>z. is_ub r x y z \<longrightarrow> (u,z) \<in> r)"
  46.235 +  (*<*) by (simp add: is_lub_def) (*>*)
  46.236 +
  46.237 +lemma is_ubI:
  46.238 +  "\<lbrakk> (x,u) \<in> r; (y,u) \<in> r \<rbrakk> \<Longrightarrow> is_ub r x y u"
  46.239 +  (*<*) by (simp add: is_ub_def) (*>*)
  46.240 +
  46.241 +lemma is_ubD:
  46.242 +  "is_ub r x y u \<Longrightarrow> (x,u) \<in> r \<and> (y,u) \<in> r"
  46.243 +  (*<*) by (simp add: is_ub_def) (*>*)
  46.244 +
  46.245 +
  46.246 +lemma is_lub_bigger1 [iff]:  
  46.247 +  "is_lub (r^* ) x y y = ((x,y)\<in>r^* )"
  46.248 +(*<*)
  46.249 +apply (unfold is_lub_def is_ub_def)
  46.250 +apply blast
  46.251 +done
  46.252 +(*>*)
  46.253 +
  46.254 +lemma is_lub_bigger2 [iff]:
  46.255 +  "is_lub (r^* ) x y x = ((y,x)\<in>r^* )"
  46.256 +(*<*)
  46.257 +apply (unfold is_lub_def is_ub_def)
  46.258 +apply blast 
  46.259 +done
  46.260 +(*>*)
  46.261 +
  46.262 +lemma extend_lub:
  46.263 +  "\<lbrakk> single_valued r; is_lub (r^* ) x y u; (x',x) \<in> r \<rbrakk> 
  46.264 +  \<Longrightarrow> EX v. is_lub (r^* ) x' y v"
  46.265 +(*<*)
  46.266 +apply (unfold is_lub_def is_ub_def)
  46.267 +apply (case_tac "(y,x) \<in> r^*")
  46.268 + apply (case_tac "(y,x') \<in> r^*")
  46.269 +  apply blast
  46.270 + apply (blast elim: converse_rtranclE dest: single_valuedD)
  46.271 +apply (rule exI)
  46.272 +apply (rule conjI)
  46.273 + apply (blast intro: converse_rtrancl_into_rtrancl dest: single_valuedD)
  46.274 +apply (blast intro: rtrancl_into_rtrancl converse_rtrancl_into_rtrancl 
  46.275 +             elim: converse_rtranclE dest: single_valuedD)
  46.276 +done
  46.277 +(*>*)
  46.278 +
  46.279 +lemma single_valued_has_lubs [rule_format]:
  46.280 +  "\<lbrakk> single_valued r; (x,u) \<in> r^* \<rbrakk> \<Longrightarrow> (\<forall>y. (y,u) \<in> r^* \<longrightarrow> 
  46.281 +  (EX z. is_lub (r^* ) x y z))"
  46.282 +(*<*)
  46.283 +apply (erule converse_rtrancl_induct)
  46.284 + apply clarify
  46.285 + apply (erule converse_rtrancl_induct)
  46.286 +  apply blast
  46.287 + apply (blast intro: converse_rtrancl_into_rtrancl)
  46.288 +apply (blast intro: extend_lub)
  46.289 +done
  46.290 +(*>*)
  46.291 +
  46.292 +lemma some_lub_conv:
  46.293 +  "\<lbrakk> acyclic r; is_lub (r^* ) x y u \<rbrakk> \<Longrightarrow> some_lub (r^* ) x y = u"
  46.294 +(*<*)
  46.295 +apply (unfold some_lub_def is_lub_def)
  46.296 +apply (rule someI2)
  46.297 + apply assumption
  46.298 +apply (blast intro: antisymD dest!: acyclic_impl_antisym_rtrancl)
  46.299 +done
  46.300 +(*>*)
  46.301 +
  46.302 +lemma is_lub_some_lub:
  46.303 +  "\<lbrakk> single_valued r; acyclic r; (x,u)\<in>r^*; (y,u)\<in>r^