src/HOL/MicroJava/BV/Listn.thy
changeset 13006 51c5f3f11d16
parent 12911 704713ca07ea
child 13066 b57d926d1de2
equal deleted inserted replaced
13005:42a54d6cec15 13006:51c5f3f11d16
    10 
    10 
    11 theory Listn = Err:
    11 theory Listn = Err:
    12 
    12 
    13 constdefs
    13 constdefs
    14 
    14 
    15  list :: "nat => 'a set => 'a list set"
    15  list :: "nat \<Rightarrow> 'a set \<Rightarrow> 'a list set"
    16 "list n A == {xs. length xs = n & set xs <= A}"
    16 "list n A == {xs. length xs = n & set xs <= A}"
    17 
    17 
    18  le :: "'a ord => ('a list)ord"
    18  le :: "'a ord \<Rightarrow> ('a list)ord"
    19 "le r == list_all2 (%x y. x <=_r y)"
    19 "le r == list_all2 (%x y. x <=_r y)"
    20 
    20 
    21 syntax "@lesublist" :: "'a list => 'a ord => 'a list => bool"
    21 syntax "@lesublist" :: "'a list \<Rightarrow> 'a ord \<Rightarrow> 'a list \<Rightarrow> bool"
    22        ("(_ /<=[_] _)" [50, 0, 51] 50)
    22        ("(_ /<=[_] _)" [50, 0, 51] 50)
    23 syntax "@lesssublist" :: "'a list => 'a ord => 'a list => bool"
    23 syntax "@lesssublist" :: "'a list \<Rightarrow> 'a ord \<Rightarrow> 'a list \<Rightarrow> bool"
    24        ("(_ /<[_] _)" [50, 0, 51] 50)
    24        ("(_ /<[_] _)" [50, 0, 51] 50)
    25 translations
    25 translations
    26  "x <=[r] y" == "x <=_(Listn.le r) y"
    26  "x <=[r] y" == "x <=_(Listn.le r) y"
    27  "x <[r] y"  == "x <_(Listn.le r) y"
    27  "x <[r] y"  == "x <_(Listn.le r) y"
    28 
    28 
    29 constdefs
    29 constdefs
    30  map2 :: "('a => 'b => 'c) => 'a list => 'b list => 'c list"
    30  map2 :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'a list \<Rightarrow> 'b list \<Rightarrow> 'c list"
    31 "map2 f == (%xs ys. map (split f) (zip xs ys))"
    31 "map2 f == (%xs ys. map (split f) (zip xs ys))"
    32 
    32 
    33 syntax "@plussublist" :: "'a list => ('a => 'b => 'c) => 'b list => 'c list"
    33 syntax "@plussublist" :: "'a list \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'b list \<Rightarrow> 'c list"
    34        ("(_ /+[_] _)" [65, 0, 66] 65)
    34        ("(_ /+[_] _)" [65, 0, 66] 65)
    35 translations  "x +[f] y" == "x +_(map2 f) y"
    35 translations  "x +[f] y" == "x +_(map2 f) y"
    36 
    36 
    37 consts coalesce :: "'a err list => 'a list err"
    37 consts coalesce :: "'a err list \<Rightarrow> 'a list err"
    38 primrec
    38 primrec
    39 "coalesce [] = OK[]"
    39 "coalesce [] = OK[]"
    40 "coalesce (ex#exs) = Err.sup (op #) ex (coalesce exs)"
    40 "coalesce (ex#exs) = Err.sup (op #) ex (coalesce exs)"
    41 
    41 
    42 constdefs
    42 constdefs
    43  sl :: "nat => 'a sl => 'a list sl"
    43  sl :: "nat \<Rightarrow> 'a sl \<Rightarrow> 'a list sl"
    44 "sl n == %(A,r,f). (list n A, le r, map2 f)"
    44 "sl n == %(A,r,f). (list n A, le r, map2 f)"
    45 
    45 
    46  sup :: "('a => 'b => 'c err) => 'a list => 'b list => 'c list err"
    46  sup :: "('a \<Rightarrow> 'b \<Rightarrow> 'c err) \<Rightarrow> 'a list \<Rightarrow> 'b list \<Rightarrow> 'c list err"
    47 "sup f == %xs ys. if size xs = size ys then coalesce(xs +[f] ys) else Err"
    47 "sup f == %xs ys. if size xs = size ys then coalesce(xs +[f] ys) else Err"
    48 
    48 
    49  upto_esl :: "nat => 'a esl => 'a list esl"
    49  upto_esl :: "nat \<Rightarrow> 'a esl \<Rightarrow> 'a list esl"
    50 "upto_esl m == %(A,r,f). (Union{list n A |n. n <= m}, le r, sup f)"
    50 "upto_esl m == %(A,r,f). (Union{list n A |n. n <= m}, le r, sup f)"
    51 
    51 
    52 lemmas [simp] = set_update_subsetI
    52 lemmas [simp] = set_update_subsetI
    53 
    53 
    54 lemma unfold_lesub_list:
    54 lemma unfold_lesub_list:
    73 apply (unfold lesub_def Listn.le_def)
    73 apply (unfold lesub_def Listn.le_def)
    74 apply simp
    74 apply simp
    75 done
    75 done
    76 
    76 
    77 lemma Cons_less_Conss [simp]:
    77 lemma Cons_less_Conss [simp]:
    78   "order r ==> 
    78   "order r \<Longrightarrow> 
    79   x#xs <_(Listn.le r) y#ys = 
    79   x#xs <_(Listn.le r) y#ys = 
    80   (x <_r y & xs <=[r] ys  |  x = y & xs <_(Listn.le r) ys)"
    80   (x <_r y & xs <=[r] ys  |  x = y & xs <_(Listn.le r) ys)"
    81 apply (unfold lesssub_def)
    81 apply (unfold lesssub_def)
    82 apply blast
    82 apply blast
    83 done  
    83 done  
    84 
    84 
    85 lemma list_update_le_cong:
    85 lemma list_update_le_cong:
    86   "[| i<size xs; xs <=[r] ys; x <=_r y |] ==> xs[i:=x] <=[r] ys[i:=y]";
    86   "\<lbrakk> i<size xs; xs <=[r] ys; x <=_r y \<rbrakk> \<Longrightarrow> xs[i:=x] <=[r] ys[i:=y]";
    87 apply (unfold unfold_lesub_list)
    87 apply (unfold unfold_lesub_list)
    88 apply (unfold Listn.le_def)
    88 apply (unfold Listn.le_def)
    89 apply (simp add: list_all2_conv_all_nth nth_list_update)
    89 apply (simp add: list_all2_conv_all_nth nth_list_update)
    90 done
    90 done
    91 
    91 
    92 
    92 
    93 lemma le_listD:
    93 lemma le_listD:
    94   "[| xs <=[r] ys; p < size xs |] ==> xs!p <=_r ys!p"
    94   "\<lbrakk> xs <=[r] ys; p < size xs \<rbrakk> \<Longrightarrow> xs!p <=_r ys!p"
    95 apply (unfold Listn.le_def lesub_def)
    95 apply (unfold Listn.le_def lesub_def)
    96 apply (simp add: list_all2_conv_all_nth)
    96 apply (simp add: list_all2_conv_all_nth)
    97 done
    97 done
    98 
    98 
    99 lemma le_list_refl:
    99 lemma le_list_refl:
   100   "!x. x <=_r x ==> xs <=[r] xs"
   100   "!x. x <=_r x \<Longrightarrow> xs <=[r] xs"
   101 apply (unfold unfold_lesub_list)
   101 apply (unfold unfold_lesub_list)
   102 apply (simp add: Listn.le_def list_all2_conv_all_nth)
   102 apply (simp add: Listn.le_def list_all2_conv_all_nth)
   103 done
   103 done
   104 
   104 
   105 lemma le_list_trans:
   105 lemma le_list_trans:
   106   "[| order r; xs <=[r] ys; ys <=[r] zs |] ==> xs <=[r] zs"
   106   "\<lbrakk> order r; xs <=[r] ys; ys <=[r] zs \<rbrakk> \<Longrightarrow> xs <=[r] zs"
   107 apply (unfold unfold_lesub_list)
   107 apply (unfold unfold_lesub_list)
   108 apply (simp add: Listn.le_def list_all2_conv_all_nth)
   108 apply (simp add: Listn.le_def list_all2_conv_all_nth)
   109 apply clarify
   109 apply clarify
   110 apply simp
   110 apply simp
   111 apply (blast intro: order_trans)
   111 apply (blast intro: order_trans)
   112 done
   112 done
   113 
   113 
   114 lemma le_list_antisym:
   114 lemma le_list_antisym:
   115   "[| order r; xs <=[r] ys; ys <=[r] xs |] ==> xs = ys"
   115   "\<lbrakk> order r; xs <=[r] ys; ys <=[r] xs \<rbrakk> \<Longrightarrow> xs = ys"
   116 apply (unfold unfold_lesub_list)
   116 apply (unfold unfold_lesub_list)
   117 apply (simp add: Listn.le_def list_all2_conv_all_nth)
   117 apply (simp add: Listn.le_def list_all2_conv_all_nth)
   118 apply (rule nth_equalityI)
   118 apply (rule nth_equalityI)
   119  apply blast
   119  apply blast
   120 apply clarify
   120 apply clarify
   121 apply simp
   121 apply simp
   122 apply (blast intro: order_antisym)
   122 apply (blast intro: order_antisym)
   123 done
   123 done
   124 
   124 
   125 lemma order_listI [simp, intro!]:
   125 lemma order_listI [simp, intro!]:
   126   "order r ==> order(Listn.le r)"
   126   "order r \<Longrightarrow> order(Listn.le r)"
   127 apply (subst order_def)
   127 apply (subst order_def)
   128 apply (blast intro: le_list_refl le_list_trans le_list_antisym
   128 apply (blast intro: le_list_refl le_list_trans le_list_antisym
   129              dest: order_refl)
   129              dest: order_refl)
   130 done
   130 done
   131 
   131 
   132 
   132 
   133 lemma lesub_list_impl_same_size [simp]:
   133 lemma lesub_list_impl_same_size [simp]:
   134   "xs <=[r] ys ==> size ys = size xs"  
   134   "xs <=[r] ys \<Longrightarrow> size ys = size xs"  
   135 apply (unfold Listn.le_def lesub_def)
   135 apply (unfold Listn.le_def lesub_def)
   136 apply (simp add: list_all2_conv_all_nth)
   136 apply (simp add: list_all2_conv_all_nth)
   137 done 
   137 done 
   138 
   138 
   139 lemma lesssub_list_impl_same_size:
   139 lemma lesssub_list_impl_same_size:
   140   "xs <_(Listn.le r) ys ==> size ys = size xs"
   140   "xs <_(Listn.le r) ys \<Longrightarrow> size ys = size xs"
   141 apply (unfold lesssub_def)
   141 apply (unfold lesssub_def)
   142 apply auto
   142 apply auto
   143 done  
   143 done  
   144 
   144 
   145 lemma listI:
   145 lemma listI:
   146   "[| length xs = n; set xs <= A |] ==> xs : list n A"
   146   "\<lbrakk> length xs = n; set xs <= A \<rbrakk> \<Longrightarrow> xs : list n A"
   147 apply (unfold list_def)
   147 apply (unfold list_def)
   148 apply blast
   148 apply blast
   149 done
   149 done
   150 
   150 
   151 lemma listE_length [simp]:
   151 lemma listE_length [simp]:
   152    "xs : list n A ==> length xs = n"
   152    "xs : list n A \<Longrightarrow> length xs = n"
   153 apply (unfold list_def)
   153 apply (unfold list_def)
   154 apply blast
   154 apply blast
   155 done 
   155 done 
   156 
   156 
   157 lemma less_lengthI:
   157 lemma less_lengthI:
   158   "[| xs : list n A; p < n |] ==> p < length xs"
   158   "\<lbrakk> xs : list n A; p < n \<rbrakk> \<Longrightarrow> p < length xs"
   159   by simp
   159   by simp
   160 
   160 
   161 lemma listE_set [simp]:
   161 lemma listE_set [simp]:
   162   "xs : list n A ==> set xs <= A"
   162   "xs : list n A \<Longrightarrow> set xs <= A"
   163 apply (unfold list_def)
   163 apply (unfold list_def)
   164 apply blast
   164 apply blast
   165 done 
   165 done 
   166 
   166 
   167 lemma list_0 [simp]:
   167 lemma list_0 [simp]:
   181   "(x#xs : list (Suc n) A) = (x:A & xs : list n A)";
   181   "(x#xs : list (Suc n) A) = (x:A & xs : list n A)";
   182 apply (simp add: in_list_Suc_iff)
   182 apply (simp add: in_list_Suc_iff)
   183 done 
   183 done 
   184 
   184 
   185 lemma list_not_empty:
   185 lemma list_not_empty:
   186   "? a. a:A ==> ? xs. xs : list n A";
   186   "? a. a:A \<Longrightarrow> ? xs. xs : list n A";
   187 apply (induct "n")
   187 apply (induct "n")
   188  apply simp
   188  apply simp
   189 apply (simp add: in_list_Suc_iff)
   189 apply (simp add: in_list_Suc_iff)
   190 apply blast
   190 apply blast
   191 done
   191 done
   192 
   192 
   193 
   193 
   194 lemma nth_in [rule_format, simp]:
   194 lemma nth_in [rule_format, simp]:
   195   "!i n. length xs = n --> set xs <= A --> i < n --> (xs!i) : A"
   195   "!i n. length xs = n \<longrightarrow> set xs <= A \<longrightarrow> i < n \<longrightarrow> (xs!i) : A"
   196 apply (induct "xs")
   196 apply (induct "xs")
   197  apply simp
   197  apply simp
   198 apply (simp add: nth_Cons split: nat.split)
   198 apply (simp add: nth_Cons split: nat.split)
   199 done
   199 done
   200 
   200 
   201 lemma listE_nth_in:
   201 lemma listE_nth_in:
   202   "[| xs : list n A; i < n |] ==> (xs!i) : A"
   202   "\<lbrakk> xs : list n A; i < n \<rbrakk> \<Longrightarrow> (xs!i) : A"
   203   by auto
   203   by auto
   204 
   204 
   205 lemma listt_update_in_list [simp, intro!]:
   205 lemma listt_update_in_list [simp, intro!]:
   206   "[| xs : list n A; x:A |] ==> xs[i := x] : list n A"
   206   "\<lbrakk> xs : list n A; x:A \<rbrakk> \<Longrightarrow> xs[i := x] : list n A"
   207 apply (unfold list_def)
   207 apply (unfold list_def)
   208 apply simp
   208 apply simp
   209 done 
   209 done 
   210 
   210 
   211 lemma plus_list_Nil [simp]:
   211 lemma plus_list_Nil [simp]:
   213 apply (unfold plussub_def map2_def)
   213 apply (unfold plussub_def map2_def)
   214 apply simp
   214 apply simp
   215 done 
   215 done 
   216 
   216 
   217 lemma plus_list_Cons [simp]:
   217 lemma plus_list_Cons [simp]:
   218   "(x#xs) +[f] ys = (case ys of [] => [] | y#ys => (x +_f y)#(xs +[f] ys))"
   218   "(x#xs) +[f] ys = (case ys of [] \<Rightarrow> [] | y#ys \<Rightarrow> (x +_f y)#(xs +[f] ys))"
   219   by (simp add: plussub_def map2_def split: list.split)
   219   by (simp add: plussub_def map2_def split: list.split)
   220 
   220 
   221 lemma length_plus_list [rule_format, simp]:
   221 lemma length_plus_list [rule_format, simp]:
   222   "!ys. length(xs +[f] ys) = min(length xs) (length ys)"
   222   "!ys. length(xs +[f] ys) = min(length xs) (length ys)"
   223 apply (induct xs)
   223 apply (induct xs)
   225 apply clarify
   225 apply clarify
   226 apply (simp (no_asm_simp) split: list.split)
   226 apply (simp (no_asm_simp) split: list.split)
   227 done
   227 done
   228 
   228 
   229 lemma nth_plus_list [rule_format, simp]:
   229 lemma nth_plus_list [rule_format, simp]:
   230   "!xs ys i. length xs = n --> length ys = n --> i<n --> 
   230   "!xs ys i. length xs = n \<longrightarrow> length ys = n \<longrightarrow> i<n \<longrightarrow> 
   231   (xs +[f] ys)!i = (xs!i) +_f (ys!i)"
   231   (xs +[f] ys)!i = (xs!i) +_f (ys!i)"
   232 apply (induct n)
   232 apply (induct n)
   233  apply simp
   233  apply simp
   234 apply clarify
   234 apply clarify
   235 apply (case_tac xs)
   235 apply (case_tac xs)
   237 apply (force simp add: nth_Cons split: list.split nat.split)
   237 apply (force simp add: nth_Cons split: list.split nat.split)
   238 done
   238 done
   239 
   239 
   240 
   240 
   241 lemma plus_list_ub1 [rule_format]:
   241 lemma plus_list_ub1 [rule_format]:
   242   "[| semilat(A,r,f); set xs <= A; set ys <= A; size xs = size ys |] 
   242   "\<lbrakk> semilat(A,r,f); set xs <= A; set ys <= A; size xs = size ys \<rbrakk> 
   243   ==> xs <=[r] xs +[f] ys"
   243   \<Longrightarrow> xs <=[r] xs +[f] ys"
   244 apply (unfold unfold_lesub_list)
   244 apply (unfold unfold_lesub_list)
   245 apply (simp add: Listn.le_def list_all2_conv_all_nth)
   245 apply (simp add: Listn.le_def list_all2_conv_all_nth)
   246 done
   246 done
   247 
   247 
   248 lemma plus_list_ub2:
   248 lemma plus_list_ub2:
   249   "[| semilat(A,r,f); set xs <= A; set ys <= A; size xs = size ys |]
   249   "\<lbrakk> semilat(A,r,f); set xs <= A; set ys <= A; size xs = size ys \<rbrakk>
   250   ==> ys <=[r] xs +[f] ys"
   250   \<Longrightarrow> ys <=[r] xs +[f] ys"
   251 apply (unfold unfold_lesub_list)
   251 apply (unfold unfold_lesub_list)
   252 apply (simp add: Listn.le_def list_all2_conv_all_nth)
   252 apply (simp add: Listn.le_def list_all2_conv_all_nth)
   253 done 
   253 done 
   254 
   254 
   255 lemma plus_list_lub [rule_format]:
   255 lemma plus_list_lub [rule_format]:
   256   "semilat(A,r,f) ==> !xs ys zs. set xs <= A --> set ys <= A --> set zs <= A 
   256   "semilat(A,r,f) \<Longrightarrow> !xs ys zs. set xs <= A \<longrightarrow> set ys <= A \<longrightarrow> set zs <= A 
   257   --> size xs = n & size ys = n --> 
   257   \<longrightarrow> size xs = n & size ys = n \<longrightarrow> 
   258   xs <=[r] zs & ys <=[r] zs --> xs +[f] ys <=[r] zs"
   258   xs <=[r] zs & ys <=[r] zs \<longrightarrow> xs +[f] ys <=[r] zs"
   259 apply (unfold unfold_lesub_list)
   259 apply (unfold unfold_lesub_list)
   260 apply (simp add: Listn.le_def list_all2_conv_all_nth)
   260 apply (simp add: Listn.le_def list_all2_conv_all_nth)
   261 done 
   261 done 
   262 
   262 
   263 lemma list_update_incr [rule_format]:
   263 lemma list_update_incr [rule_format]:
   264   "[| semilat(A,r,f); x:A |] ==> set xs <= A --> 
   264   "\<lbrakk> semilat(A,r,f); x:A \<rbrakk> \<Longrightarrow> set xs <= A \<longrightarrow> 
   265   (!i. i<size xs --> xs <=[r] xs[i := x +_f xs!i])"
   265   (!i. i<size xs \<longrightarrow> xs <=[r] xs[i := x +_f xs!i])"
   266 apply (unfold unfold_lesub_list)
   266 apply (unfold unfold_lesub_list)
   267 apply (simp add: Listn.le_def list_all2_conv_all_nth)
   267 apply (simp add: Listn.le_def list_all2_conv_all_nth)
   268 apply (induct xs)
   268 apply (induct xs)
   269  apply simp
   269  apply simp
   270 apply (simp add: in_list_Suc_iff)
   270 apply (simp add: in_list_Suc_iff)
   271 apply clarify
   271 apply clarify
   272 apply (simp add: nth_Cons split: nat.split)
   272 apply (simp add: nth_Cons split: nat.split)
   273 done 
   273 done 
   274 
   274 
   275 lemma acc_le_listI [intro!]:
   275 lemma acc_le_listI [intro!]:
   276   "[| order r; acc r |] ==> acc(Listn.le r)"
   276   "\<lbrakk> order r; acc r \<rbrakk> \<Longrightarrow> acc(Listn.le r)"
   277 apply (unfold acc_def)
   277 apply (unfold acc_def)
   278 apply (subgoal_tac
   278 apply (subgoal_tac
   279  "wf(UN n. {(ys,xs). size xs = n & size ys = n & xs <_(Listn.le r) ys})")
   279  "wf(UN n. {(ys,xs). size xs = n & size ys = n & xs <_(Listn.le r) ys})")
   280  apply (erule wf_subset)
   280  apply (erule wf_subset)
   281  apply (blast intro: lesssub_list_impl_same_size)
   281  apply (blast intro: lesssub_list_impl_same_size)
   321 apply simp
   321 apply simp
   322 apply blast
   322 apply blast
   323 done 
   323 done 
   324 
   324 
   325 lemma closed_listI:
   325 lemma closed_listI:
   326   "closed S f ==> closed (list n S) (map2 f)"
   326   "closed S f \<Longrightarrow> closed (list n S) (map2 f)"
   327 apply (unfold closed_def)
   327 apply (unfold closed_def)
   328 apply (induct n)
   328 apply (induct n)
   329  apply simp
   329  apply simp
   330 apply clarify
   330 apply clarify
   331 apply (simp add: in_list_Suc_iff)
   331 apply (simp add: in_list_Suc_iff)
   333 apply simp
   333 apply simp
   334 done 
   334 done 
   335 
   335 
   336 
   336 
   337 lemma semilat_Listn_sl:
   337 lemma semilat_Listn_sl:
   338   "!!L. semilat L ==> semilat (Listn.sl n L)"
   338   "\<And>L. semilat L \<Longrightarrow> semilat (Listn.sl n L)"
   339 apply (unfold Listn.sl_def)
   339 apply (unfold Listn.sl_def)
   340 apply (simp (no_asm_simp) only: split_tupled_all)
   340 apply (simp (no_asm_simp) only: split_tupled_all)
   341 apply (simp (no_asm) only: semilat_Def split_conv)
   341 apply (simp (no_asm) only: semilat_Def split_conv)
   342 apply (rule conjI)
   342 apply (rule conjI)
   343  apply simp
   343  apply simp
   347 apply (simp (no_asm_simp) add: plus_list_ub1 plus_list_ub2 plus_list_lub)
   347 apply (simp (no_asm_simp) add: plus_list_ub1 plus_list_ub2 plus_list_lub)
   348 done  
   348 done  
   349 
   349 
   350 
   350 
   351 lemma coalesce_in_err_list [rule_format]:
   351 lemma coalesce_in_err_list [rule_format]:
   352   "!xes. xes : list n (err A) --> coalesce xes : err(list n A)"
   352   "!xes. xes : list n (err A) \<longrightarrow> coalesce xes : err(list n A)"
   353 apply (induct n)
   353 apply (induct n)
   354  apply simp
   354  apply simp
   355 apply clarify
   355 apply clarify
   356 apply (simp add: in_list_Suc_iff)
   356 apply (simp add: in_list_Suc_iff)
   357 apply clarify
   357 apply clarify
   358 apply (simp (no_asm) add: plussub_def Err.sup_def lift2_def split: err.split)
   358 apply (simp (no_asm) add: plussub_def Err.sup_def lift2_def split: err.split)
   359 apply force
   359 apply force
   360 done 
   360 done 
   361 
   361 
   362 lemma lem: "!!x xs. x +_(op #) xs = x#xs"
   362 lemma lem: "\<And>x xs. x +_(op #) xs = x#xs"
   363   by (simp add: plussub_def)
   363   by (simp add: plussub_def)
   364 
   364 
   365 lemma coalesce_eq_OK1_D [rule_format]:
   365 lemma coalesce_eq_OK1_D [rule_format]:
   366   "semilat(err A, Err.le r, lift2 f) ==> 
   366   "semilat(err A, Err.le r, lift2 f) \<Longrightarrow> 
   367   !xs. xs : list n A --> (!ys. ys : list n A --> 
   367   !xs. xs : list n A \<longrightarrow> (!ys. ys : list n A \<longrightarrow> 
   368   (!zs. coalesce (xs +[f] ys) = OK zs --> xs <=[r] zs))"
   368   (!zs. coalesce (xs +[f] ys) = OK zs \<longrightarrow> xs <=[r] zs))"
   369 apply (induct n)
   369 apply (induct n)
   370   apply simp
   370   apply simp
   371 apply clarify
   371 apply clarify
   372 apply (simp add: in_list_Suc_iff)
   372 apply (simp add: in_list_Suc_iff)
   373 apply clarify
   373 apply clarify
   374 apply (simp split: err.split_asm add: lem Err.sup_def lift2_def)
   374 apply (simp split: err.split_asm add: lem Err.sup_def lift2_def)
   375 apply (force simp add: semilat_le_err_OK1)
   375 apply (force simp add: semilat_le_err_OK1)
   376 done
   376 done
   377 
   377 
   378 lemma coalesce_eq_OK2_D [rule_format]:
   378 lemma coalesce_eq_OK2_D [rule_format]:
   379   "semilat(err A, Err.le r, lift2 f) ==> 
   379   "semilat(err A, Err.le r, lift2 f) \<Longrightarrow> 
   380   !xs. xs : list n A --> (!ys. ys : list n A --> 
   380   !xs. xs : list n A \<longrightarrow> (!ys. ys : list n A \<longrightarrow> 
   381   (!zs. coalesce (xs +[f] ys) = OK zs --> ys <=[r] zs))"
   381   (!zs. coalesce (xs +[f] ys) = OK zs \<longrightarrow> ys <=[r] zs))"
   382 apply (induct n)
   382 apply (induct n)
   383  apply simp
   383  apply simp
   384 apply clarify
   384 apply clarify
   385 apply (simp add: in_list_Suc_iff)
   385 apply (simp add: in_list_Suc_iff)
   386 apply clarify
   386 apply clarify
   387 apply (simp split: err.split_asm add: lem Err.sup_def lift2_def)
   387 apply (simp split: err.split_asm add: lem Err.sup_def lift2_def)
   388 apply (force simp add: semilat_le_err_OK2)
   388 apply (force simp add: semilat_le_err_OK2)
   389 done 
   389 done 
   390 
   390 
   391 lemma lift2_le_ub:
   391 lemma lift2_le_ub:
   392   "[| semilat(err A, Err.le r, lift2 f); x:A; y:A; x +_f y = OK z; 
   392   "\<lbrakk> semilat(err A, Err.le r, lift2 f); x:A; y:A; x +_f y = OK z; 
   393       u:A; x <=_r u; y <=_r u |] ==> z <=_r u"
   393       u:A; x <=_r u; y <=_r u \<rbrakk> \<Longrightarrow> z <=_r u"
   394 apply (unfold semilat_Def plussub_def err_def)
   394 apply (unfold semilat_Def plussub_def err_def)
   395 apply (simp add: lift2_def)
   395 apply (simp add: lift2_def)
   396 apply clarify
   396 apply clarify
   397 apply (rotate_tac -3)
   397 apply (rotate_tac -3)
   398 apply (erule thin_rl)
   398 apply (erule thin_rl)
   399 apply (erule thin_rl)
   399 apply (erule thin_rl)
   400 apply force
   400 apply force
   401 done 
   401 done 
   402 
   402 
   403 lemma coalesce_eq_OK_ub_D [rule_format]:
   403 lemma coalesce_eq_OK_ub_D [rule_format]:
   404   "semilat(err A, Err.le r, lift2 f) ==> 
   404   "semilat(err A, Err.le r, lift2 f) \<Longrightarrow> 
   405   !xs. xs : list n A --> (!ys. ys : list n A --> 
   405   !xs. xs : list n A \<longrightarrow> (!ys. ys : list n A \<longrightarrow> 
   406   (!zs us. coalesce (xs +[f] ys) = OK zs & xs <=[r] us & ys <=[r] us 
   406   (!zs us. coalesce (xs +[f] ys) = OK zs & xs <=[r] us & ys <=[r] us 
   407            & us : list n A --> zs <=[r] us))"
   407            & us : list n A \<longrightarrow> zs <=[r] us))"
   408 apply (induct n)
   408 apply (induct n)
   409  apply simp
   409  apply simp
   410 apply clarify
   410 apply clarify
   411 apply (simp add: in_list_Suc_iff)
   411 apply (simp add: in_list_Suc_iff)
   412 apply clarify
   412 apply clarify
   416  apply (blast intro: lift2_le_ub)
   416  apply (blast intro: lift2_le_ub)
   417 apply blast
   417 apply blast
   418 done 
   418 done 
   419 
   419 
   420 lemma lift2_eq_ErrD:
   420 lemma lift2_eq_ErrD:
   421   "[| x +_f y = Err; semilat(err A, Err.le r, lift2 f); x:A; y:A |] 
   421   "\<lbrakk> x +_f y = Err; semilat(err A, Err.le r, lift2 f); x:A; y:A \<rbrakk> 
   422   ==> ~(? u:A. x <=_r u & y <=_r u)"
   422   \<Longrightarrow> ~(? u:A. x <=_r u & y <=_r u)"
   423   by (simp add: OK_plus_OK_eq_Err_conv [THEN iffD1])
   423   by (simp add: OK_plus_OK_eq_Err_conv [THEN iffD1])
   424 
   424 
   425 
   425 
   426 lemma coalesce_eq_Err_D [rule_format]:
   426 lemma coalesce_eq_Err_D [rule_format]:
   427   "[| semilat(err A, Err.le r, lift2 f) |] 
   427   "\<lbrakk> semilat(err A, Err.le r, lift2 f) \<rbrakk> 
   428   ==> !xs. xs:list n A --> (!ys. ys:list n A --> 
   428   \<Longrightarrow> !xs. xs:list n A \<longrightarrow> (!ys. ys:list n A \<longrightarrow> 
   429       coalesce (xs +[f] ys) = Err --> 
   429       coalesce (xs +[f] ys) = Err \<longrightarrow> 
   430       ~(? zs:list n A. xs <=[r] zs & ys <=[r] zs))"
   430       ~(? zs:list n A. xs <=[r] zs & ys <=[r] zs))"
   431 apply (induct n)
   431 apply (induct n)
   432  apply simp
   432  apply simp
   433 apply clarify
   433 apply clarify
   434 apply (simp add: in_list_Suc_iff)
   434 apply (simp add: in_list_Suc_iff)
   443 apply (unfold closed_def)
   443 apply (unfold closed_def)
   444 apply (simp add: err_def)
   444 apply (simp add: err_def)
   445 done 
   445 done 
   446 
   446 
   447 lemma closed_map2_list [rule_format]:
   447 lemma closed_map2_list [rule_format]:
   448   "closed (err A) (lift2 f) ==> 
   448   "closed (err A) (lift2 f) \<Longrightarrow> 
   449   !xs. xs : list n A --> (!ys. ys : list n A --> 
   449   !xs. xs : list n A \<longrightarrow> (!ys. ys : list n A \<longrightarrow> 
   450   map2 f xs ys : list n (err A))"
   450   map2 f xs ys : list n (err A))"
   451 apply (unfold map2_def)
   451 apply (unfold map2_def)
   452 apply (induct n)
   452 apply (induct n)
   453  apply simp
   453  apply simp
   454 apply clarify
   454 apply clarify
   456 apply clarify
   456 apply clarify
   457 apply (simp add: plussub_def closed_err_lift2_conv)
   457 apply (simp add: plussub_def closed_err_lift2_conv)
   458 done 
   458 done 
   459 
   459 
   460 lemma closed_lift2_sup:
   460 lemma closed_lift2_sup:
   461   "closed (err A) (lift2 f) ==> 
   461   "closed (err A) (lift2 f) \<Longrightarrow> 
   462   closed (err (list n A)) (lift2 (sup f))"
   462   closed (err (list n A)) (lift2 (sup f))"
   463   by (fastsimp  simp add: closed_def plussub_def sup_def lift2_def
   463   by (fastsimp  simp add: closed_def plussub_def sup_def lift2_def
   464                           coalesce_in_err_list closed_map2_list
   464                           coalesce_in_err_list closed_map2_list
   465                 split: err.split)
   465                 split: err.split)
   466 
   466 
   467 lemma err_semilat_sup:
   467 lemma err_semilat_sup:
   468   "err_semilat (A,r,f) ==> 
   468   "err_semilat (A,r,f) \<Longrightarrow> 
   469   err_semilat (list n A, Listn.le r, sup f)"
   469   err_semilat (list n A, Listn.le r, sup f)"
   470 apply (unfold Err.sl_def)
   470 apply (unfold Err.sl_def)
   471 apply (simp only: split_conv)
   471 apply (simp only: split_conv)
   472 apply (simp (no_asm) only: semilat_Def plussub_def)
   472 apply (simp (no_asm) only: semilat_Def plussub_def)
   473 apply (simp (no_asm_simp) only: semilatDclosedI closed_lift2_sup)
   473 apply (simp (no_asm_simp) only: semilatDclosedI closed_lift2_sup)
   478 apply (simp (no_asm_simp) add: coalesce_eq_OK1_D coalesce_eq_OK2_D split: err.split)
   478 apply (simp (no_asm_simp) add: coalesce_eq_OK1_D coalesce_eq_OK2_D split: err.split)
   479 apply (blast intro: coalesce_eq_OK_ub_D dest: coalesce_eq_Err_D)
   479 apply (blast intro: coalesce_eq_OK_ub_D dest: coalesce_eq_Err_D)
   480 done 
   480 done 
   481 
   481 
   482 lemma err_semilat_upto_esl:
   482 lemma err_semilat_upto_esl:
   483   "!!L. err_semilat L ==> err_semilat(upto_esl m L)"
   483   "\<And>L. err_semilat L \<Longrightarrow> err_semilat(upto_esl m L)"
   484 apply (unfold Listn.upto_esl_def)
   484 apply (unfold Listn.upto_esl_def)
   485 apply (simp (no_asm_simp) only: split_tupled_all)
   485 apply (simp (no_asm_simp) only: split_tupled_all)
   486 apply simp
   486 apply simp
   487 apply (fastsimp intro!: err_semilat_UnionI err_semilat_sup
   487 apply (fastsimp intro!: err_semilat_UnionI err_semilat_sup
   488                 dest: lesub_list_impl_same_size 
   488                 dest: lesub_list_impl_same_size