thys3/Blexer.thy
changeset 598 2c9a3aba8ebc
parent 583 4aabb0629e4b
child 642 6c13f76c070b
equal deleted inserted replaced
597:19d304554ae1 598:2c9a3aba8ebc
     1 
     1 
     2 theory Blexer
     2 theory Blexer
     3   imports "Lexer" "PDerivs"
     3   imports "Lexer"
     4 begin
     4 begin
     5 
     5 
     6 section \<open>Bit-Encodings\<close>
     6 section \<open>Bit-Encodings\<close>
     7 
     7 
     8 datatype bit = Z | S
     8 datatype bit = Z | S
    15 | "code (Right v) = S # (code v)"
    15 | "code (Right v) = S # (code v)"
    16 | "code (Seq v1 v2) = (code v1) @ (code v2)"
    16 | "code (Seq v1 v2) = (code v1) @ (code v2)"
    17 | "code (Stars []) = [S]"
    17 | "code (Stars []) = [S]"
    18 | "code (Stars (v # vs)) =  (Z # code v) @ code (Stars vs)"
    18 | "code (Stars (v # vs)) =  (Z # code v) @ code (Stars vs)"
    19 
    19 
       
    20 fun sz where
       
    21   "sz ZERO = 0"
       
    22 | "sz ONE = 0"
       
    23 | "sz (CH _) = 0"
       
    24 | "sz (SEQ r1 r2) = 1 + sz r1 + sz r2"
       
    25 | "sz (ALT r1 r2) = 1 + sz r1 + sz r2"
       
    26 | "sz (STAR r) = 1 + sz r"
       
    27 | "sz (NTIMES r n) = 1 + (n + 1) + sz r"
       
    28 
    20 
    29 
    21 fun 
    30 fun 
    22   Stars_add :: "val \<Rightarrow> val \<Rightarrow> val"
    31   Stars_add :: "val \<Rightarrow> val \<Rightarrow> val"
    23 where
    32 where
    24   "Stars_add v (Stars vs) = Stars (v # vs)"
    33   "Stars_add v (Stars vs) = Stars (v # vs)"
    25 
    34 
    26 function
    35 function (sequential)
    27   decode' :: "bit list \<Rightarrow> rexp \<Rightarrow> (val * bit list)"
    36   decode' :: "bit list \<Rightarrow> rexp \<Rightarrow> (val * bit list)"
    28 where
    37 where
    29   "decode' bs ZERO = (undefined, bs)"
    38   "decode' bs ZERO = (undefined, bs)"
    30 | "decode' bs ONE = (Void, bs)"
    39 | "decode' bs ONE = (Void, bs)"
    31 | "decode' bs (CH d) = (Char d, bs)"
    40 | "decode' bs (CH d) = (Char d, bs)"
    37 | "decode' [] (STAR r) = (Void, [])"
    46 | "decode' [] (STAR r) = (Void, [])"
    38 | "decode' (S # bs) (STAR r) = (Stars [], bs)"
    47 | "decode' (S # bs) (STAR r) = (Stars [], bs)"
    39 | "decode' (Z # bs) (STAR r) = (let (v, bs') = decode' bs r in
    48 | "decode' (Z # bs) (STAR r) = (let (v, bs') = decode' bs r in
    40                                     let (vs, bs'') = decode' bs' (STAR r) 
    49                                     let (vs, bs'') = decode' bs' (STAR r) 
    41                                     in (Stars_add v vs, bs''))"
    50                                     in (Stars_add v vs, bs''))"
       
    51 | "decode' bs (NTIMES r n) = decode' bs (STAR r)"
    42 by pat_completeness auto
    52 by pat_completeness auto
    43 
    53 
    44 lemma decode'_smaller:
    54 lemma decode'_smaller:
    45   assumes "decode'_dom (bs, r)"
    55   assumes "decode'_dom (bs, r)"
    46   shows "length (snd (decode' bs r)) \<le> length bs"
    56   shows "length (snd (decode' bs r)) \<le> length bs"
    47 using assms
    57 using assms
    48 apply(induct bs r)
    58 apply(induct bs r)
    49 apply(auto simp add: decode'.psimps split: prod.split)
    59 apply(auto simp add: decode'.psimps split: prod.split)
    50 using dual_order.trans apply blast
    60 using dual_order.trans apply blast
    51 by (meson dual_order.trans le_SucI)
    61 apply (meson dual_order.trans le_SucI)
       
    62   done
    52 
    63 
    53 termination "decode'"  
    64 termination "decode'"  
    54 apply(relation "inv_image (measure(%cs. size cs) <*lex*> measure(%s. size s)) (%(ds,r). (r,ds))") 
    65 apply(relation "inv_image (measure(%cs. sz cs) <*lex*> measure(%s. size s)) (%(ds,r). (r,ds))") 
    55 apply(auto dest!: decode'_smaller)
    66 apply(auto dest!: decode'_smaller)
    56 by (metis less_Suc_eq_le snd_conv)
    67    apply (metis less_Suc_eq_le snd_conv)
       
    68   done
    57 
    69 
    58 definition
    70 definition
    59   decode :: "bit list \<Rightarrow> rexp \<Rightarrow> val option"
    71   decode :: "bit list \<Rightarrow> rexp \<Rightarrow> val option"
    60 where
    72 where
    61   "decode ds r \<equiv> (let (v, ds') = decode' ds r 
    73   "decode ds r \<equiv> (let (v, ds') = decode' ds r 
    66   shows "decode' (code (Stars vs) @ ds) (STAR r) = (Stars vs, ds)"
    78   shows "decode' (code (Stars vs) @ ds) (STAR r) = (Stars vs, ds)"
    67   using assms
    79   using assms
    68   apply(induct vs)
    80   apply(induct vs)
    69   apply(auto)
    81   apply(auto)
    70   done
    82   done
       
    83 
       
    84 lemma decode'_code_NTIMES:
       
    85   assumes "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> (\<forall>x. decode' (code v @ x) r = (v, x))" 
       
    86   shows "decode' (code (Stars vs) @ ds) (NTIMES r n) = (Stars vs, ds)"
       
    87   using assms
       
    88   apply(induct vs arbitrary: n r ds)
       
    89    apply(auto)
       
    90   done
       
    91 
    71 
    92 
    72 lemma decode'_code:
    93 lemma decode'_code:
    73   assumes "\<Turnstile> v : r"
    94   assumes "\<Turnstile> v : r"
    74   shows "decode' ((code v) @ ds) r = (v, ds)"
    95   shows "decode' ((code v) @ ds) r = (v, ds)"
    75 using assms
    96 using assms
    76   apply(induct v r arbitrary: ds) 
    97   apply(induct v r arbitrary: ds rule: Prf.induct) 
    77   apply(auto)
    98   apply(auto)[6]
    78   using decode'_code_Stars by blast
    99   using decode'_code_Stars apply blast
       
   100   apply(rule decode'_code_NTIMES)
       
   101   apply(simp)
       
   102   apply(auto)
       
   103   done
    79 
   104 
    80 lemma decode_code:
   105 lemma decode_code:
    81   assumes "\<Turnstile> v : r"
   106   assumes "\<Turnstile> v : r"
    82   shows "decode (code v) r = Some v"
   107   shows "decode (code v) r = Some v"
    83   using assms unfolding decode_def
   108   using assms unfolding decode_def
    91 | AONE "bit list"
   116 | AONE "bit list"
    92 | ACHAR "bit list" char
   117 | ACHAR "bit list" char
    93 | ASEQ "bit list" arexp arexp
   118 | ASEQ "bit list" arexp arexp
    94 | AALTs "bit list" "arexp list"
   119 | AALTs "bit list" "arexp list"
    95 | ASTAR "bit list" arexp
   120 | ASTAR "bit list" arexp
       
   121 | ANTIMES "bit list" arexp nat
    96 
   122 
    97 abbreviation
   123 abbreviation
    98   "AALT bs r1 r2 \<equiv> AALTs bs [r1, r2]"
   124   "AALT bs r1 r2 \<equiv> AALTs bs [r1, r2]"
    99 
   125 
   100 fun asize :: "arexp \<Rightarrow> nat" where
   126 fun asize :: "arexp \<Rightarrow> nat" where
   102 | "asize (AONE cs) = 1" 
   128 | "asize (AONE cs) = 1" 
   103 | "asize (ACHAR cs c) = 1"
   129 | "asize (ACHAR cs c) = 1"
   104 | "asize (AALTs cs rs) = Suc (sum_list (map asize rs))"
   130 | "asize (AALTs cs rs) = Suc (sum_list (map asize rs))"
   105 | "asize (ASEQ cs r1 r2) = Suc (asize r1 + asize r2)"
   131 | "asize (ASEQ cs r1 r2) = Suc (asize r1 + asize r2)"
   106 | "asize (ASTAR cs r) = Suc (asize r)"
   132 | "asize (ASTAR cs r) = Suc (asize r)"
       
   133 | "asize (ANTIMES cs r n) = Suc (asize r) + n"
   107 
   134 
   108 fun 
   135 fun 
   109   erase :: "arexp \<Rightarrow> rexp"
   136   erase :: "arexp \<Rightarrow> rexp"
   110 where
   137 where
   111   "erase AZERO = ZERO"
   138   "erase AZERO = ZERO"
   114 | "erase (AALTs _ []) = ZERO"
   141 | "erase (AALTs _ []) = ZERO"
   115 | "erase (AALTs _ [r]) = (erase r)"
   142 | "erase (AALTs _ [r]) = (erase r)"
   116 | "erase (AALTs bs (r#rs)) = ALT (erase r) (erase (AALTs bs rs))"
   143 | "erase (AALTs bs (r#rs)) = ALT (erase r) (erase (AALTs bs rs))"
   117 | "erase (ASEQ _ r1 r2) = SEQ (erase r1) (erase r2)"
   144 | "erase (ASEQ _ r1 r2) = SEQ (erase r1) (erase r2)"
   118 | "erase (ASTAR _ r) = STAR (erase r)"
   145 | "erase (ASTAR _ r) = STAR (erase r)"
       
   146 | "erase (ANTIMES _ r n) = NTIMES (erase r) n"
   119 
   147 
   120 
   148 
   121 fun fuse :: "bit list \<Rightarrow> arexp \<Rightarrow> arexp" where
   149 fun fuse :: "bit list \<Rightarrow> arexp \<Rightarrow> arexp" where
   122   "fuse bs AZERO = AZERO"
   150   "fuse bs AZERO = AZERO"
   123 | "fuse bs (AONE cs) = AONE (bs @ cs)" 
   151 | "fuse bs (AONE cs) = AONE (bs @ cs)" 
   124 | "fuse bs (ACHAR cs c) = ACHAR (bs @ cs) c"
   152 | "fuse bs (ACHAR cs c) = ACHAR (bs @ cs) c"
   125 | "fuse bs (AALTs cs rs) = AALTs (bs @ cs) rs"
   153 | "fuse bs (AALTs cs rs) = AALTs (bs @ cs) rs"
   126 | "fuse bs (ASEQ cs r1 r2) = ASEQ (bs @ cs) r1 r2"
   154 | "fuse bs (ASEQ cs r1 r2) = ASEQ (bs @ cs) r1 r2"
   127 | "fuse bs (ASTAR cs r) = ASTAR (bs @ cs) r"
   155 | "fuse bs (ASTAR cs r) = ASTAR (bs @ cs) r"
       
   156 | "fuse bs (ANTIMES cs r n) = ANTIMES (bs @ cs) r n"
   128 
   157 
   129 lemma fuse_append:
   158 lemma fuse_append:
   130   shows "fuse (bs1 @ bs2) r = fuse bs1 (fuse bs2 r)"
   159   shows "fuse (bs1 @ bs2) r = fuse bs1 (fuse bs2 r)"
   131   apply(induct r)
   160   apply(induct r)
   132   apply(auto)
   161   apply(auto)
   139 | "intern (CH c) = ACHAR [] c"
   168 | "intern (CH c) = ACHAR [] c"
   140 | "intern (ALT r1 r2) = AALT [] (fuse [Z] (intern r1)) 
   169 | "intern (ALT r1 r2) = AALT [] (fuse [Z] (intern r1)) 
   141                                 (fuse [S]  (intern r2))"
   170                                 (fuse [S]  (intern r2))"
   142 | "intern (SEQ r1 r2) = ASEQ [] (intern r1) (intern r2)"
   171 | "intern (SEQ r1 r2) = ASEQ [] (intern r1) (intern r2)"
   143 | "intern (STAR r) = ASTAR [] (intern r)"
   172 | "intern (STAR r) = ASTAR [] (intern r)"
       
   173 | "intern (NTIMES r n) = ANTIMES [] (intern r) n"
   144 
   174 
   145 
   175 
   146 fun retrieve :: "arexp \<Rightarrow> val \<Rightarrow> bit list" where
   176 fun retrieve :: "arexp \<Rightarrow> val \<Rightarrow> bit list" where
   147   "retrieve (AONE bs) Void = bs"
   177   "retrieve (AONE bs) Void = bs"
   148 | "retrieve (ACHAR bs c) (Char d) = bs"
   178 | "retrieve (ACHAR bs c) (Char d) = bs"
   151 | "retrieve (AALTs bs (r#rs)) (Right v) = bs @ retrieve (AALTs [] rs) v"
   181 | "retrieve (AALTs bs (r#rs)) (Right v) = bs @ retrieve (AALTs [] rs) v"
   152 | "retrieve (ASEQ bs r1 r2) (Seq v1 v2) = bs @ retrieve r1 v1 @ retrieve r2 v2"
   182 | "retrieve (ASEQ bs r1 r2) (Seq v1 v2) = bs @ retrieve r1 v1 @ retrieve r2 v2"
   153 | "retrieve (ASTAR bs r) (Stars []) = bs @ [S]"
   183 | "retrieve (ASTAR bs r) (Stars []) = bs @ [S]"
   154 | "retrieve (ASTAR bs r) (Stars (v#vs)) = 
   184 | "retrieve (ASTAR bs r) (Stars (v#vs)) = 
   155      bs @ [Z] @ retrieve r v @ retrieve (ASTAR [] r) (Stars vs)"
   185      bs @ [Z] @ retrieve r v @ retrieve (ASTAR [] r) (Stars vs)"
   156 
   186 | "retrieve (ANTIMES bs r 0) (Stars []) = bs @ [S]"
       
   187 | "retrieve (ANTIMES bs r (Suc n)) (Stars (v#vs)) = 
       
   188      bs @ [Z] @ retrieve r v @ retrieve (ANTIMES [] r n) (Stars vs)"
   157 
   189 
   158 
   190 
   159 fun
   191 fun
   160  bnullable :: "arexp \<Rightarrow> bool"
   192  bnullable :: "arexp \<Rightarrow> bool"
   161 where
   193 where
   163 | "bnullable (AONE bs) = True"
   195 | "bnullable (AONE bs) = True"
   164 | "bnullable (ACHAR bs c) = False"
   196 | "bnullable (ACHAR bs c) = False"
   165 | "bnullable (AALTs bs rs) = (\<exists>r \<in> set rs. bnullable r)"
   197 | "bnullable (AALTs bs rs) = (\<exists>r \<in> set rs. bnullable r)"
   166 | "bnullable (ASEQ bs r1 r2) = (bnullable r1 \<and> bnullable r2)"
   198 | "bnullable (ASEQ bs r1 r2) = (bnullable r1 \<and> bnullable r2)"
   167 | "bnullable (ASTAR bs r) = True"
   199 | "bnullable (ASTAR bs r) = True"
       
   200 | "bnullable (ANTIMES bs r n) = (if n  = 0 then True else bnullable r)"
   168 
   201 
   169 abbreviation
   202 abbreviation
   170   bnullables :: "arexp list \<Rightarrow> bool"
   203   bnullables :: "arexp list \<Rightarrow> bool"
   171 where
   204 where
   172   "bnullables rs \<equiv> (\<exists>r \<in> set rs. bnullable r)"
   205   "bnullables rs \<equiv> (\<exists>r \<in> set rs. bnullable r)"
   173 
   206 
   174 fun 
   207 function (sequential)
   175   bmkeps :: "arexp \<Rightarrow> bit list" and
   208   bmkeps :: "arexp \<Rightarrow> bit list" 
   176   bmkepss :: "arexp list \<Rightarrow> bit list"
       
   177 where
   209 where
   178   "bmkeps(AONE bs) = bs"
   210   "bmkeps(AONE bs) = bs"
   179 | "bmkeps(ASEQ bs r1 r2) = bs @ (bmkeps r1) @ (bmkeps r2)"
   211 | "bmkeps(ASEQ bs r1 r2) = bs @ (bmkeps r1) @ (bmkeps r2)"
   180 | "bmkeps(AALTs bs rs) = bs @ (bmkepss rs)"
   212 | "bmkeps(AALTs bs (r#rs)) = 
       
   213     (if bnullable(r) then (bs @ bmkeps r) else (bmkeps (AALTs bs rs)))"
   181 | "bmkeps(ASTAR bs r) = bs @ [S]"
   214 | "bmkeps(ASTAR bs r) = bs @ [S]"
   182 | "bmkepss (r # rs) = (if bnullable(r) then (bmkeps r) else (bmkepss rs))"
   215 | "bmkeps(ANTIMES bs r n) = 
       
   216     (if n = 0 then bs @ [S] else bs @ [Z] @ (bmkeps r) @ bmkeps(ANTIMES [] r (n - 1)))"
       
   217 apply(pat_completeness)
       
   218 apply(auto)
       
   219 done
       
   220 
       
   221 termination "bmkeps"  
       
   222 apply(relation "measure asize") 
       
   223         apply(auto)
       
   224   using asize.elims by force
       
   225 
       
   226 fun
       
   227    bmkepss :: "arexp list \<Rightarrow> bit list"
       
   228 where
       
   229   "bmkepss (r # rs) = (if bnullable(r) then (bmkeps r) else (bmkepss rs))"
       
   230 
   183 
   231 
   184 lemma bmkepss1:
   232 lemma bmkepss1:
   185   assumes "\<not> bnullables rs1"
   233   assumes "\<not> bnullables rs1"
   186   shows "bmkepss (rs1 @ rs2) = bmkepss rs2"
   234   shows "bmkepss (rs1 @ rs2) = bmkepss rs2"
   187   using assms
   235   using assms
   188   by (induct rs1) (auto)
   236   by(induct rs1) (auto)
       
   237   
   189 
   238 
   190 lemma bmkepss2:
   239 lemma bmkepss2:
   191   assumes "bnullables rs1"
   240   assumes "bnullables rs1"
   192   shows "bmkepss (rs1 @ rs2) = bmkepss rs1"
   241   shows "bmkepss (rs1 @ rs2) = bmkepss rs1"
   193   using assms
   242   using assms
   204 | "bder c (ASEQ bs r1 r2) = 
   253 | "bder c (ASEQ bs r1 r2) = 
   205      (if bnullable r1
   254      (if bnullable r1
   206       then AALT bs (ASEQ [] (bder c r1) r2) (fuse (bmkeps r1) (bder c r2))
   255       then AALT bs (ASEQ [] (bder c r1) r2) (fuse (bmkeps r1) (bder c r2))
   207       else ASEQ bs (bder c r1) r2)"
   256       else ASEQ bs (bder c r1) r2)"
   208 | "bder c (ASTAR bs r) = ASEQ (bs @ [Z]) (bder c r) (ASTAR [] r)"
   257 | "bder c (ASTAR bs r) = ASEQ (bs @ [Z]) (bder c r) (ASTAR [] r)"
   209 
   258 | "bder c (ANTIMES bs r n) = (if n = 0 then AZERO else ASEQ (bs @ [Z]) (bder c r) (ANTIMES [] r (n - 1)))"
   210 
   259 
   211 fun 
   260 fun 
   212   bders :: "arexp \<Rightarrow> string \<Rightarrow> arexp"
   261   bders :: "arexp \<Rightarrow> string \<Rightarrow> arexp"
   213 where
   262 where
   214   "bders r [] = r"
   263   "bders r [] = r"
   262   using assms
   311   using assms
   263   apply(induct vs)
   312   apply(induct vs)
   264   apply(simp_all)
   313   apply(simp_all)
   265   done
   314   done
   266 
   315 
   267 lemma retrieve_codestars2:
   316 lemma retrieve_encode_NTIMES:
   268   assumes "\<forall>v \<in> set vs. \<Turnstile> v : r \<and> code v = retrieve (intern r) v"
   317   assumes "\<forall>v\<in>set vs. \<Turnstile> v : r \<and> code v = retrieve (intern r) v" "length vs = n"
   269   shows "retrieve (ASTAR bs (intern r)) (Stars []) = bs @ [S]"
   318   shows "code (Stars vs) = retrieve (ANTIMES [] (intern r) n) (Stars vs)"
   270   apply simp
   319   using assms
   271   done
   320   apply(induct vs arbitrary: n)
       
   321    apply(simp_all)
       
   322   by force
   272 
   323 
   273 
   324 
   274 lemma retrieve_fuse2:
   325 lemma retrieve_fuse2:
   275   assumes "\<Turnstile> v : (erase r)"
   326   assumes "\<Turnstile> v : (erase r)"
   276   shows "retrieve (fuse bs r) v = bs @ retrieve r v"
   327   shows "retrieve (fuse bs r) v = bs @ retrieve r v"
   290   apply(simp)
   341   apply(simp)
   291   using retrieve_encode_STARS
   342   using retrieve_encode_STARS
   292   apply(auto elim!: Prf_elims)[1]
   343   apply(auto elim!: Prf_elims)[1]
   293   apply(case_tac vs)
   344   apply(case_tac vs)
   294   apply(simp)
   345   apply(simp)
   295   apply(simp)
   346    apply(simp)
       
   347   (* NTIMES *)
       
   348   apply(auto elim!: Prf_elims)[1]
       
   349   apply(case_tac vs1)
       
   350    apply(simp_all)
       
   351   apply(case_tac vs2)
       
   352    apply(simp_all)
   296   done
   353   done
   297 
   354 
   298 lemma retrieve_fuse:
   355 lemma retrieve_fuse:
   299   assumes "\<Turnstile> v : r"
   356   assumes "\<Turnstile> v : r"
   300   shows "retrieve (fuse bs (intern r)) v = bs @ retrieve (intern r) v"
   357   shows "retrieve (fuse bs (intern r)) v = bs @ retrieve (intern r) v"
   305 lemma retrieve_code:
   362 lemma retrieve_code:
   306   assumes "\<Turnstile> v : r"
   363   assumes "\<Turnstile> v : r"
   307   shows "code v = retrieve (intern r) v"
   364   shows "code v = retrieve (intern r) v"
   308   using assms
   365   using assms
   309   apply(induct v r )
   366   apply(induct v r )
   310   apply(simp_all add: retrieve_fuse retrieve_encode_STARS)
   367         apply(simp_all add: retrieve_fuse retrieve_encode_STARS)
   311   done
   368   apply(subst retrieve_encode_NTIMES)
       
   369     apply(auto)
       
   370   done 
       
   371  
   312 
   372 
   313 
   373 
   314 lemma retrieve_AALTs_bnullable1:
   374 lemma retrieve_AALTs_bnullable1:
   315   assumes "bnullable r"
   375   assumes "bnullable r"
   316   shows "retrieve (AALTs bs (r # rs)) (mkeps (erase (AALTs bs (r # rs))))
   376   shows "retrieve (AALTs bs (r # rs)) (mkeps (erase (AALTs bs (r # rs))))
   345   using retrieve_AALTs_bnullable1 apply presburger
   405   using retrieve_AALTs_bnullable1 apply presburger
   346   apply (metis retrieve_AALTs_bnullable2)
   406   apply (metis retrieve_AALTs_bnullable2)
   347   apply (simp add: retrieve_AALTs_bnullable1)
   407   apply (simp add: retrieve_AALTs_bnullable1)
   348   by (metis retrieve_AALTs_bnullable2)
   408   by (metis retrieve_AALTs_bnullable2)
   349 
   409 
   350     
   410 lemma bmkeps_retrieve_ANTIMES: 
       
   411   assumes "if n = 0 then True else bmkeps r = retrieve r (mkeps (erase r))" 
       
   412   and     "bnullable (ANTIMES bs r n)"
       
   413   shows "bmkeps (ANTIMES bs r n) = retrieve (ANTIMES bs r n) (Stars (replicate n (mkeps (erase r))))"
       
   414  using assms
       
   415   apply(induct n arbitrary: r bs)
       
   416   apply(auto)[1]
       
   417   apply(simp)
       
   418   done
       
   419 
   351 lemma bmkeps_retrieve:
   420 lemma bmkeps_retrieve:
   352   assumes "bnullable r"
   421   assumes "bnullable r"
   353   shows "bmkeps r = retrieve r (mkeps (erase r))"
   422   shows "bmkeps r = retrieve r (mkeps (erase r))"
   354   using assms
   423   using assms
   355   apply(induct r)
   424   apply(induct r rule: bmkeps.induct)
   356   apply(auto)  
   425         apply(auto)
   357   using bmkeps_retrieve_AALTs by auto
   426   apply (simp add: retrieve_AALTs_bnullable1)
       
   427   using retrieve_AALTs_bnullable1 apply force
       
   428   apply(metis retrieve_AALTs_bnullable2)
       
   429   by (metis Cons_eq_appendI One_nat_def Suc_diff_1 eq_Nil_appendI replicate_Suc retrieve.simps(10))  
       
   430   
   358 
   431 
   359 lemma bder_retrieve:
   432 lemma bder_retrieve:
   360   assumes "\<Turnstile> v : der c (erase r)"
   433   assumes "\<Turnstile> v : der c (erase r)"
   361   shows "retrieve (bder c r) v = retrieve r (injval (erase r) c v)"
   434   shows "retrieve (bder c r) v = retrieve r (injval (erase r) c v)"
   362   using assms  
   435   using assms  
   393   apply(simp)  
   466   apply(simp)  
   394   apply(erule Prf_elims)
   467   apply(erule Prf_elims)
   395   apply(clarify)
   468   apply(clarify)
   396   apply(erule Prf_elims)
   469   apply(erule Prf_elims)
   397   apply(clarify)
   470   apply(clarify)
   398   by (simp add: retrieve_fuse2)
   471    apply (simp add: retrieve_fuse2)
       
   472   (* ANTIMES case *)
       
   473   apply(auto)  
       
   474   apply(erule Prf_elims)
       
   475   apply(erule Prf_elims)
       
   476   apply(clarify)
       
   477   apply(erule Prf_elims)
       
   478   apply(clarify)
       
   479   by (metis (full_types) Suc_pred append_assoc injval.simps(8) retrieve.simps(10) retrieve.simps(6))
   399 
   480 
   400 
   481 
   401 lemma MAIN_decode:
   482 lemma MAIN_decode:
   402   assumes "\<Turnstile> v : ders s r"
   483   assumes "\<Turnstile> v : ders s r"
   403   shows "Some (flex r id s v) = decode (retrieve (bders (intern r) s) v) r"
   484   shows "Some (flex r id s v) = decode (retrieve (bders (intern r) s) v) r"