thys/UF.thy
changeset 240 696081f445c2
parent 239 ac3309722536
child 248 aea02b5a58d2
equal deleted inserted replaced
239:ac3309722536 240:696081f445c2
   151              (Cn (Suc vl) rec_add [id (Suc vl) vl, 
   151              (Cn (Suc vl) rec_add [id (Suc vl) vl, 
   152                     Cn (Suc vl) rf (get_fstn_args (Suc vl) (vl - 1) 
   152                     Cn (Suc vl) rf (get_fstn_args (Suc vl) (vl - 1) 
   153                         @ [Cn (Suc vl) s [id (Suc vl) (vl - 1)]])]))"
   153                         @ [Cn (Suc vl) s [id (Suc vl) (vl - 1)]])]))"
   154 
   154 
   155 
   155 
   156 declare rec_exec.simps[simp del] constn.simps[simp del]
   156 declare rec_eval.simps[simp del] constn.simps[simp del]
   157 
   157 
   158 
   158 
   159 section {* Correctness of various recursive functions *}
   159 section {* Correctness of various recursive functions *}
   160 
   160 
   161 
   161 
   162 lemma add_lemma: "rec_exec rec_add [x, y] =  x + y"
   162 lemma add_lemma: "rec_eval rec_add [x, y] =  x + y"
   163 by(induct_tac y, auto simp: rec_add_def rec_exec.simps)
   163 by(induct_tac y, auto simp: rec_add_def rec_eval.simps)
   164 
   164 
   165 lemma mult_lemma: "rec_exec rec_mult [x, y] = x * y"
   165 lemma mult_lemma: "rec_eval rec_mult [x, y] = x * y"
   166 by(induct_tac y, auto simp: rec_mult_def rec_exec.simps add_lemma)
   166 by(induct_tac y, auto simp: rec_mult_def rec_eval.simps add_lemma)
   167 
   167 
   168 lemma pred_lemma: "rec_exec rec_pred [x] =  x - 1"
   168 lemma pred_lemma: "rec_eval rec_pred [x] =  x - 1"
   169 by(induct_tac x, auto simp: rec_pred_def rec_exec.simps)
   169 by(induct_tac x, auto simp: rec_pred_def rec_eval.simps)
   170 
   170 
   171 lemma minus_lemma: "rec_exec rec_minus [x, y] = x - y"
   171 lemma minus_lemma: "rec_eval rec_minus [x, y] = x - y"
   172 by(induct_tac y, auto simp: rec_exec.simps rec_minus_def pred_lemma)
   172 by(induct_tac y, auto simp: rec_eval.simps rec_minus_def pred_lemma)
   173 
   173 
   174 lemma sg_lemma: "rec_exec rec_sg [x] = (if x = 0 then 0 else 1)"
   174 lemma sg_lemma: "rec_eval rec_sg [x] = (if x = 0 then 0 else 1)"
   175 by(auto simp: rec_sg_def minus_lemma rec_exec.simps constn.simps)
   175 by(auto simp: rec_sg_def minus_lemma rec_eval.simps constn.simps)
   176 
   176 
   177 lemma constn_lemma: "rec_exec (constn n) [x] = n"
   177 lemma constn_lemma: "rec_eval (constn n) [x] = n"
   178 by(induct n, auto simp: rec_exec.simps constn.simps)
   178 by(induct n, auto simp: rec_eval.simps constn.simps)
   179 
   179 
   180 lemma less_lemma: "rec_exec rec_less [x, y] = (if x < y then 1 else 0)"
   180 lemma less_lemma: "rec_eval rec_less [x, y] = (if x < y then 1 else 0)"
   181 by(induct_tac y, auto simp: rec_exec.simps 
   181 by(induct_tac y, auto simp: rec_eval.simps 
   182   rec_less_def minus_lemma sg_lemma)
   182   rec_less_def minus_lemma sg_lemma)
   183 
   183 
   184 lemma not_lemma: "rec_exec rec_not [x] = (if x = 0 then 1 else 0)"
   184 lemma not_lemma: "rec_eval rec_not [x] = (if x = 0 then 1 else 0)"
   185 by(induct_tac x, auto simp: rec_exec.simps rec_not_def
   185 by(induct_tac x, auto simp: rec_eval.simps rec_not_def
   186   constn_lemma minus_lemma)
   186   constn_lemma minus_lemma)
   187 
   187 
   188 lemma eq_lemma: "rec_exec rec_eq [x, y] = (if x = y then 1 else 0)"
   188 lemma eq_lemma: "rec_eval rec_eq [x, y] = (if x = y then 1 else 0)"
   189 by(induct_tac y, auto simp: rec_exec.simps rec_eq_def constn_lemma add_lemma minus_lemma)
   189 by(induct_tac y, auto simp: rec_eval.simps rec_eq_def constn_lemma add_lemma minus_lemma)
   190 
   190 
   191 lemma conj_lemma: "rec_exec rec_conj [x, y] = (if x = 0 \<or> y = 0 then 0 else 1)"
   191 lemma conj_lemma: "rec_eval rec_conj [x, y] = (if x = 0 \<or> y = 0 then 0 else 1)"
   192 by(induct_tac y, auto simp: rec_exec.simps sg_lemma rec_conj_def mult_lemma)
   192 by(induct_tac y, auto simp: rec_eval.simps sg_lemma rec_conj_def mult_lemma)
   193 
   193 
   194 lemma disj_lemma: "rec_exec rec_disj [x, y] = (if x = 0 \<and> y = 0 then 0 else 1)"
   194 lemma disj_lemma: "rec_eval rec_disj [x, y] = (if x = 0 \<and> y = 0 then 0 else 1)"
   195 by(induct_tac y, auto simp: rec_disj_def sg_lemma add_lemma rec_exec.simps)
   195 by(induct_tac y, auto simp: rec_disj_def sg_lemma add_lemma rec_eval.simps)
   196 
   196 
   197 declare mult_lemma[simp] add_lemma[simp] pred_lemma[simp] 
   197 declare mult_lemma[simp] add_lemma[simp] pred_lemma[simp] 
   198         minus_lemma[simp] sg_lemma[simp] constn_lemma[simp] 
   198         minus_lemma[simp] sg_lemma[simp] constn_lemma[simp] 
   199         less_lemma[simp] not_lemma[simp] eq_lemma[simp]
   199         less_lemma[simp] not_lemma[simp] eq_lemma[simp]
   200         conj_lemma[simp] disj_lemma[simp]
   200         conj_lemma[simp] disj_lemma[simp]
   244   assume "last (xs::nat list) \<noteq> 0"
   244   assume "last (xs::nat list) \<noteq> 0"
   245   thus "((g, butlast xs @ [last xs - 1]), g, xs) \<in> measure (\<lambda>(f, xs). last xs)"
   245   thus "((g, butlast xs @ [last xs - 1]), g, xs) \<in> measure (\<lambda>(f, xs). last xs)"
   246     by auto
   246     by auto
   247 qed
   247 qed
   248 
   248 
   249 declare rec_exec.simps[simp del] get_fstn_args.simps[simp del]
   249 declare rec_eval.simps[simp del] get_fstn_args.simps[simp del]
   250         arity.simps[simp del] Sigma.simps[simp del]
   250         arity.simps[simp del] Sigma.simps[simp del]
   251         rec_sigma.simps[simp del]
   251         rec_sigma.simps[simp del]
   252 
   252 
   253 lemma [simp]: "arity z = 1"
   253 lemma [simp]: "arity z = 1"
   254   by(simp add: arity.simps)
   254   by(simp add: arity.simps)
   255 
   255 
   256 lemma rec_pr_0_simp_rewrite: "
   256 lemma rec_pr_0_simp_rewrite: "
   257   rec_exec (Pr n f g) (xs @ [0]) = rec_exec f xs"
   257   rec_eval (Pr n f g) (xs @ [0]) = rec_eval f xs"
   258   by(simp add: rec_exec.simps)
   258   by(simp add: rec_eval.simps)
   259 
   259 
   260 lemma rec_pr_0_simp_rewrite_single_param: "
   260 lemma rec_pr_0_simp_rewrite_single_param: "
   261   rec_exec (Pr n f g) [0] = rec_exec f []"
   261   rec_eval (Pr n f g) [0] = rec_eval f []"
   262   by(simp add: rec_exec.simps)
   262   by(simp add: rec_eval.simps)
   263 
   263 
   264 lemma rec_pr_Suc_simp_rewrite: 
   264 lemma rec_pr_Suc_simp_rewrite: 
   265   "rec_exec (Pr n f g) (xs @ [Suc x]) = rec_exec g (xs @ [x] @ [rec_exec (Pr n f g) (xs @ [x])])"
   265   "rec_eval (Pr n f g) (xs @ [Suc x]) = rec_eval g (xs @ [x] @ [rec_eval (Pr n f g) (xs @ [x])])"
   266 by(simp add: rec_exec.simps)
   266 by(simp add: rec_eval.simps)
   267 
   267 
   268 lemma rec_pr_Suc_simp_rewrite_single_param: 
   268 lemma rec_pr_Suc_simp_rewrite_single_param: 
   269   "rec_exec (Pr n f g) ([Suc x]) = rec_exec g ([x] @ [rec_exec (Pr n f g) ([x])])"
   269   "rec_eval (Pr n f g) ([Suc x]) = rec_eval g ([x] @ [rec_eval (Pr n f g) ([x])])"
   270 by(simp add: rec_exec.simps)
   270 by(simp add: rec_eval.simps)
   271 
   271 
   272 lemma Sigma_0_simp_rewrite_single_param:
   272 lemma Sigma_0_simp_rewrite_single_param:
   273   "Sigma f [0] = f [0]"
   273   "Sigma f [0] = f [0]"
   274 by(simp add: Sigma.simps)
   274 by(simp add: Sigma.simps)
   275 
   275 
   287 
   287 
   288 lemma  [simp]: "(xs @ ys) ! (Suc (length xs)) = ys ! 1"
   288 lemma  [simp]: "(xs @ ys) ! (Suc (length xs)) = ys ! 1"
   289 by(simp add: nth_append)
   289 by(simp add: nth_append)
   290   
   290   
   291 lemma get_fstn_args_take: "\<lbrakk>length xs = m; n \<le> m\<rbrakk> \<Longrightarrow> 
   291 lemma get_fstn_args_take: "\<lbrakk>length xs = m; n \<le> m\<rbrakk> \<Longrightarrow> 
   292   map (\<lambda> f. rec_exec f xs) (get_fstn_args m n)= take n xs"
   292   map (\<lambda> f. rec_eval f xs) (get_fstn_args m n)= take n xs"
   293 proof(induct n)
   293 proof(induct n)
   294   case 0 thus "?case"
   294   case 0 thus "?case"
   295     by(simp add: get_fstn_args.simps)
   295     by(simp add: get_fstn_args.simps)
   296 next
   296 next
   297   case (Suc n) thus "?case"
   297   case (Suc n) thus "?case"
   298     by(simp add: get_fstn_args.simps rec_exec.simps 
   298     by(simp add: get_fstn_args.simps rec_eval.simps 
   299              take_Suc_conv_app_nth)
   299              take_Suc_conv_app_nth)
   300 qed
   300 qed
   301     
   301     
   302 lemma [simp]: "primerec f n \<Longrightarrow> arity f = n"
   302 lemma [simp]: "primerec f n \<Longrightarrow> arity f = n"
   303   apply(case_tac f)
   303   apply(case_tac f)
   305   apply(erule_tac prime_mn_reverse)
   305   apply(erule_tac prime_mn_reverse)
   306   done
   306   done
   307 
   307 
   308 lemma rec_sigma_Suc_simp_rewrite: 
   308 lemma rec_sigma_Suc_simp_rewrite: 
   309   "primerec f (Suc (length xs))
   309   "primerec f (Suc (length xs))
   310     \<Longrightarrow> rec_exec (rec_sigma f) (xs @ [Suc x]) = 
   310     \<Longrightarrow> rec_eval (rec_sigma f) (xs @ [Suc x]) = 
   311     rec_exec (rec_sigma f) (xs @ [x]) + rec_exec f (xs @ [Suc x])"
   311     rec_eval (rec_sigma f) (xs @ [x]) + rec_eval f (xs @ [Suc x])"
   312   apply(induct x)
   312   apply(induct x)
   313   apply(auto simp: rec_sigma.simps Let_def rec_pr_Suc_simp_rewrite
   313   apply(auto simp: rec_sigma.simps Let_def rec_pr_Suc_simp_rewrite
   314                    rec_exec.simps get_fstn_args_take)
   314                    rec_eval.simps get_fstn_args_take)
   315   done      
   315   done      
   316 
   316 
   317 text {*
   317 text {*
   318   The correctness of @{text "rec_sigma"} with respect to its specification.
   318   The correctness of @{text "rec_sigma"} with respect to its specification.
   319   *}
   319   *}
   320 lemma sigma_lemma: 
   320 lemma sigma_lemma: 
   321   "primerec rg (Suc (length xs))
   321   "primerec rg (Suc (length xs))
   322      \<Longrightarrow> rec_exec (rec_sigma rg) (xs @ [x]) = Sigma (rec_exec rg) (xs @ [x])"
   322      \<Longrightarrow> rec_eval (rec_sigma rg) (xs @ [x]) = Sigma (rec_eval rg) (xs @ [x])"
   323 apply(induct x)
   323 apply(induct x)
   324 apply(auto simp: rec_exec.simps rec_sigma.simps Let_def 
   324 apply(auto simp: rec_eval.simps rec_sigma.simps Let_def 
   325          get_fstn_args_take Sigma_0_simp_rewrite
   325          get_fstn_args_take Sigma_0_simp_rewrite
   326          Sigma_Suc_simp_rewrite) 
   326          Sigma_Suc_simp_rewrite) 
   327 done
   327 done
   328 
   328 
   329 text {*
   329 text {*
   364     by auto
   364     by auto
   365 qed
   365 qed
   366 
   366 
   367 lemma rec_accum_Suc_simp_rewrite: 
   367 lemma rec_accum_Suc_simp_rewrite: 
   368   "primerec f (Suc (length xs))
   368   "primerec f (Suc (length xs))
   369     \<Longrightarrow> rec_exec (rec_accum f) (xs @ [Suc x]) = 
   369     \<Longrightarrow> rec_eval (rec_accum f) (xs @ [Suc x]) = 
   370     rec_exec (rec_accum f) (xs @ [x]) * rec_exec f (xs @ [Suc x])"
   370     rec_eval (rec_accum f) (xs @ [x]) * rec_eval f (xs @ [Suc x])"
   371   apply(induct x)
   371   apply(induct x)
   372   apply(auto simp: rec_sigma.simps Let_def rec_pr_Suc_simp_rewrite
   372   apply(auto simp: rec_sigma.simps Let_def rec_pr_Suc_simp_rewrite
   373                    rec_exec.simps get_fstn_args_take)
   373                    rec_eval.simps get_fstn_args_take)
   374   done  
   374   done  
   375 
   375 
   376 text {*
   376 text {*
   377   The correctness of @{text "rec_accum"} with respect to its specification.
   377   The correctness of @{text "rec_accum"} with respect to its specification.
   378 *}
   378 *}
   379 lemma accum_lemma :
   379 lemma accum_lemma :
   380   "primerec rg (Suc (length xs))
   380   "primerec rg (Suc (length xs))
   381      \<Longrightarrow> rec_exec (rec_accum rg) (xs @ [x]) = Accum (rec_exec rg) (xs @ [x])"
   381      \<Longrightarrow> rec_eval (rec_accum rg) (xs @ [x]) = Accum (rec_eval rg) (xs @ [x])"
   382 apply(induct x)
   382 apply(induct x)
   383 apply(auto simp: rec_exec.simps rec_sigma.simps Let_def 
   383 apply(auto simp: rec_eval.simps rec_sigma.simps Let_def 
   384                      get_fstn_args_take)
   384                      get_fstn_args_take)
   385 done
   385 done
   386 
   386 
   387 declare rec_accum.simps [simp del]
   387 declare rec_accum.simps [simp del]
   388 
   388 
   397     (let vl = arity rf in
   397     (let vl = arity rf in
   398        Cn (vl - 1) rec_sg [Cn (vl - 1) (rec_accum rf) 
   398        Cn (vl - 1) rec_sg [Cn (vl - 1) (rec_accum rf) 
   399                  (get_fstn_args (vl - 1) (vl - 1) @ [rt])])"
   399                  (get_fstn_args (vl - 1) (vl - 1) @ [rt])])"
   400 
   400 
   401 lemma rec_accum_ex: "primerec rf (Suc (length xs)) \<Longrightarrow>
   401 lemma rec_accum_ex: "primerec rf (Suc (length xs)) \<Longrightarrow>
   402      (rec_exec (rec_accum rf) (xs @ [x]) = 0) = 
   402      (rec_eval (rec_accum rf) (xs @ [x]) = 0) = 
   403       (\<exists> t \<le> x. rec_exec rf (xs @ [t]) = 0)"
   403       (\<exists> t \<le> x. rec_eval rf (xs @ [t]) = 0)"
   404 apply(induct x, simp_all add: rec_accum_Suc_simp_rewrite)
   404 apply(induct x, simp_all add: rec_accum_Suc_simp_rewrite)
   405 apply(simp add: rec_exec.simps rec_accum.simps get_fstn_args_take, 
   405 apply(simp add: rec_eval.simps rec_accum.simps get_fstn_args_take, 
   406       auto)
   406       auto)
   407 apply(rule_tac x = ta in exI, simp)
   407 apply(rule_tac x = ta in exI, simp)
   408 apply(case_tac "t = Suc x", simp_all)
   408 apply(case_tac "t = Suc x", simp_all)
   409 apply(rule_tac x = t in exI, simp)
   409 apply(rule_tac x = t in exI, simp)
   410 done
   410 done
   413   The correctness of @{text "rec_all"}.
   413   The correctness of @{text "rec_all"}.
   414   *}
   414   *}
   415 lemma all_lemma: 
   415 lemma all_lemma: 
   416   "\<lbrakk>primerec rf (Suc (length xs));
   416   "\<lbrakk>primerec rf (Suc (length xs));
   417     primerec rt (length xs)\<rbrakk>
   417     primerec rt (length xs)\<rbrakk>
   418   \<Longrightarrow> rec_exec (rec_all rt rf) xs = (if (\<forall> x \<le> (rec_exec rt xs). 0 < rec_exec rf (xs @ [x])) then 1
   418   \<Longrightarrow> rec_eval (rec_all rt rf) xs = (if (\<forall> x \<le> (rec_eval rt xs). 0 < rec_eval rf (xs @ [x])) then 1
   419                                                                                               else 0)"
   419                                                                                               else 0)"
   420 apply(auto simp: rec_all.simps)
   420 apply(auto simp: rec_all.simps)
   421 apply(simp add: rec_exec.simps map_append get_fstn_args_take split: if_splits)
   421 apply(simp add: rec_eval.simps map_append get_fstn_args_take split: if_splits)
   422 apply(drule_tac x = "rec_exec rt xs" in rec_accum_ex)
   422 apply(drule_tac x = "rec_eval rt xs" in rec_accum_ex)
   423 apply(case_tac "rec_exec (rec_accum rf) (xs @ [rec_exec rt xs]) = 0", simp_all)
   423 apply(case_tac "rec_eval (rec_accum rf) (xs @ [rec_eval rt xs]) = 0", simp_all)
   424 apply(erule_tac exE, erule_tac x = t in allE, simp)
   424 apply(erule_tac exE, erule_tac x = t in allE, simp)
   425 apply(simp add: rec_exec.simps map_append get_fstn_args_take)
   425 apply(simp add: rec_eval.simps map_append get_fstn_args_take)
   426 apply(drule_tac x = "rec_exec rt xs" in rec_accum_ex)
   426 apply(drule_tac x = "rec_eval rt xs" in rec_accum_ex)
   427 apply(case_tac "rec_exec (rec_accum rf) (xs @ [rec_exec rt xs]) = 0", simp, simp)
   427 apply(case_tac "rec_eval (rec_accum rf) (xs @ [rec_eval rt xs]) = 0", simp, simp)
   428 apply(erule_tac x = x in allE, simp)
   428 apply(erule_tac x = x in allE, simp)
   429 done
   429 done
   430 
   430 
   431 text {*
   431 text {*
   432   @{text "rec_ex t f (x1, x2, \<dots>, xn)"} 
   432   @{text "rec_ex t f (x1, x2, \<dots>, xn)"} 
   439        (let vl = arity rf in 
   439        (let vl = arity rf in 
   440          Cn (vl - 1) rec_sg [Cn (vl - 1) (rec_sigma rf) 
   440          Cn (vl - 1) rec_sg [Cn (vl - 1) (rec_sigma rf) 
   441                   (get_fstn_args (vl - 1) (vl - 1) @ [rt])])"
   441                   (get_fstn_args (vl - 1) (vl - 1) @ [rt])])"
   442 
   442 
   443 lemma rec_sigma_ex: "primerec rf (Suc (length xs))
   443 lemma rec_sigma_ex: "primerec rf (Suc (length xs))
   444           \<Longrightarrow> (rec_exec (rec_sigma rf) (xs @ [x]) = 0) = 
   444           \<Longrightarrow> (rec_eval (rec_sigma rf) (xs @ [x]) = 0) = 
   445                           (\<forall> t \<le> x. rec_exec rf (xs @ [t]) = 0)"
   445                           (\<forall> t \<le> x. rec_eval rf (xs @ [t]) = 0)"
   446 apply(induct x, simp_all add: rec_sigma_Suc_simp_rewrite)
   446 apply(induct x, simp_all add: rec_sigma_Suc_simp_rewrite)
   447 apply(simp add: rec_exec.simps rec_sigma.simps 
   447 apply(simp add: rec_eval.simps rec_sigma.simps 
   448                 get_fstn_args_take, auto)
   448                 get_fstn_args_take, auto)
   449 apply(case_tac "t = Suc x", simp_all)
   449 apply(case_tac "t = Suc x", simp_all)
   450 done
   450 done
   451 
   451 
   452 text {*
   452 text {*
   453   The correctness of @{text "ex_lemma"}.
   453   The correctness of @{text "ex_lemma"}.
   454   *}
   454   *}
   455 lemma ex_lemma:"
   455 lemma ex_lemma:"
   456   \<lbrakk>primerec rf (Suc (length xs));
   456   \<lbrakk>primerec rf (Suc (length xs));
   457    primerec rt (length xs)\<rbrakk>
   457    primerec rt (length xs)\<rbrakk>
   458 \<Longrightarrow> (rec_exec (rec_ex rt rf) xs =
   458 \<Longrightarrow> (rec_eval (rec_ex rt rf) xs =
   459     (if (\<exists> x \<le> (rec_exec rt xs). 0 <rec_exec rf (xs @ [x])) then 1
   459     (if (\<exists> x \<le> (rec_eval rt xs). 0 <rec_eval rf (xs @ [x])) then 1
   460      else 0))"
   460      else 0))"
   461 apply(auto simp: rec_ex.simps rec_exec.simps map_append get_fstn_args_take 
   461 apply(auto simp: rec_ex.simps rec_eval.simps map_append get_fstn_args_take 
   462             split: if_splits)
   462             split: if_splits)
   463 apply(drule_tac x = "rec_exec rt xs" in rec_sigma_ex, simp)
   463 apply(drule_tac x = "rec_eval rt xs" in rec_sigma_ex, simp)
   464 apply(drule_tac x = "rec_exec rt xs" in rec_sigma_ex, simp)
   464 apply(drule_tac x = "rec_eval rt xs" in rec_sigma_ex, simp)
   465 done
   465 done
   466 
   466 
   467 text {*
   467 text {*
   468   Definition of @{text "Min[R]"} on page 77 of Boolos's book.
   468   Definition of @{text "Min[R]"} on page 77 of Boolos's book.
   469 *}
   469 *}
   521        else if (Rr (xs @ [Suc w])) then (Suc w)
   521        else if (Rr (xs @ [Suc w])) then (Suc w)
   522        else Suc (Suc w))"
   522        else Suc (Suc w))"
   523 by(insert Minr_range[of Rr xs w], auto)
   523 by(insert Minr_range[of Rr xs w], auto)
   524 
   524 
   525 text {* 
   525 text {* 
   526   @{text "rec_Minr"} is the recursive function 
   526   @{text "rec_Minmr"} is the recursive function 
   527   used to implement @{text "Minr"}:
   527   used to implement @{text "Minr"}:
   528   if @{text "Rr"} is implemented by a recursive function @{text "recf"},
   528   if @{text "Rr"} is implemented by a recursive function @{text "recf"},
   529   then @{text "rec_Minr recf"} is the recursive function used to 
   529   then @{text "rec_Minr recf"} is the recursive function used to 
   530   implement @{text "Minr Rr"}
   530   implement @{text "Minr Rr"}
   531  *}
   531  *}
   635 apply(simp add: rec_not_def)
   635 apply(simp add: rec_not_def)
   636 apply(rule prime_cn, auto)
   636 apply(rule prime_cn, auto)
   637 apply(case_tac i, auto intro: prime_id)
   637 apply(case_tac i, auto intro: prime_id)
   638 done
   638 done
   639 
   639 
   640 lemma Min_false1[simp]: "\<lbrakk>\<not> Min {uu. uu \<le> w \<and> 0 < rec_exec rf (xs @ [uu])} \<le> w;
   640 lemma Min_false1[simp]: "\<lbrakk>\<not> Min {uu. uu \<le> w \<and> 0 < rec_eval rf (xs @ [uu])} \<le> w;
   641        x \<le> w; 0 < rec_exec rf (xs @ [x])\<rbrakk>
   641        x \<le> w; 0 < rec_eval rf (xs @ [x])\<rbrakk>
   642       \<Longrightarrow>  False"
   642       \<Longrightarrow>  False"
   643 apply(subgoal_tac "finite {uu. uu \<le> w \<and> 0 < rec_exec rf (xs @ [uu])}")
   643 apply(subgoal_tac "finite {uu. uu \<le> w \<and> 0 < rec_eval rf (xs @ [uu])}")
   644 apply(subgoal_tac "{uu. uu \<le> w \<and> 0 < rec_exec rf (xs @ [uu])} \<noteq> {}")
   644 apply(subgoal_tac "{uu. uu \<le> w \<and> 0 < rec_eval rf (xs @ [uu])} \<noteq> {}")
   645 apply(simp add: Min_le_iff, simp)
   645 apply(simp add: Min_le_iff, simp)
   646 apply(rule_tac x = x in exI, simp)
   646 apply(rule_tac x = x in exI, simp)
   647 apply(simp)
   647 apply(simp)
   648 done
   648 done
   649 
   649 
   650 lemma sigma_minr_lemma: 
   650 lemma sigma_minr_lemma: 
   651   assumes prrf:  "primerec rf (Suc (length xs))"
   651   assumes prrf:  "primerec rf (Suc (length xs))"
   652   shows "UF.Sigma (rec_exec (rec_all (recf.id (Suc (length xs)) (length xs))
   652   shows "UF.Sigma (rec_eval (rec_all (recf.id (Suc (length xs)) (length xs))
   653      (Cn (Suc (Suc (length xs))) rec_not
   653      (Cn (Suc (Suc (length xs))) rec_not
   654       [Cn (Suc (Suc (length xs))) rf (get_fstn_args (Suc (Suc (length xs))) 
   654       [Cn (Suc (Suc (length xs))) rf (get_fstn_args (Suc (Suc (length xs))) 
   655        (length xs) @ [recf.id (Suc (Suc (length xs))) (Suc (length xs))])])))
   655        (length xs) @ [recf.id (Suc (Suc (length xs))) (Suc (length xs))])])))
   656       (xs @ [w]) =
   656       (xs @ [w]) =
   657        Minr (\<lambda>args. 0 < rec_exec rf args) xs w"
   657        Minr (\<lambda>args. 0 < rec_eval rf args) xs w"
   658 proof(induct w)
   658 proof(induct w)
   659   let ?rt = "(recf.id (Suc (length xs)) ((length xs)))"
   659   let ?rt = "(recf.id (Suc (length xs)) ((length xs)))"
   660   let ?rf = "(Cn (Suc (Suc (length xs))) 
   660   let ?rf = "(Cn (Suc (Suc (length xs))) 
   661     rec_not [Cn (Suc (Suc (length xs))) rf 
   661     rec_not [Cn (Suc (Suc (length xs))) rf 
   662     (get_fstn_args (Suc (Suc (length xs))) (length xs) @ 
   662     (get_fstn_args (Suc (Suc (length xs))) (length xs) @ 
   665   let ?rq = "(rec_all ?rt ?rf)"
   665   let ?rq = "(rec_all ?rt ?rf)"
   666   have prrf: "primerec ?rf (Suc (length (xs @ [0]))) \<and>
   666   have prrf: "primerec ?rf (Suc (length (xs @ [0]))) \<and>
   667         primerec ?rt (length (xs @ [0]))"
   667         primerec ?rt (length (xs @ [0]))"
   668     apply(auto simp: prrf nth_append)+
   668     apply(auto simp: prrf nth_append)+
   669     done
   669     done
   670   show "Sigma (rec_exec (rec_all ?rt ?rf)) (xs @ [0])
   670   show "Sigma (rec_eval (rec_all ?rt ?rf)) (xs @ [0])
   671        = Minr (\<lambda>args. 0 < rec_exec rf args) xs 0"
   671        = Minr (\<lambda>args. 0 < rec_eval rf args) xs 0"
   672     apply(simp add: Sigma.simps)
   672     apply(simp add: Sigma.simps)
   673     apply(simp only: prrf all_lemma,  
   673     apply(simp only: prrf all_lemma,  
   674           auto simp: rec_exec.simps get_fstn_args_take Minr.simps)
   674           auto simp: rec_eval.simps get_fstn_args_take Minr.simps)
   675     apply(rule_tac Min_eqI, auto)
   675     apply(rule_tac Min_eqI, auto)
   676     done
   676     done
   677 next
   677 next
   678   fix w
   678   fix w
   679   let ?rt = "(recf.id (Suc (length xs)) ((length xs)))"
   679   let ?rt = "(recf.id (Suc (length xs)) ((length xs)))"
   682     (get_fstn_args (Suc (Suc (length xs))) (length xs) @ 
   682     (get_fstn_args (Suc (Suc (length xs))) (length xs) @ 
   683                 [recf.id (Suc (Suc (length xs))) 
   683                 [recf.id (Suc (Suc (length xs))) 
   684     (Suc ((length xs)))])])"
   684     (Suc ((length xs)))])])"
   685   let ?rq = "(rec_all ?rt ?rf)"
   685   let ?rq = "(rec_all ?rt ?rf)"
   686   assume ind:
   686   assume ind:
   687     "Sigma (rec_exec (rec_all ?rt ?rf)) (xs @ [w]) = Minr (\<lambda>args. 0 < rec_exec rf args) xs w"
   687     "Sigma (rec_eval (rec_all ?rt ?rf)) (xs @ [w]) = Minr (\<lambda>args. 0 < rec_eval rf args) xs w"
   688   have prrf: "primerec ?rf (Suc (length (xs @ [Suc w]))) \<and>
   688   have prrf: "primerec ?rf (Suc (length (xs @ [Suc w]))) \<and>
   689         primerec ?rt (length (xs @ [Suc w]))"
   689         primerec ?rt (length (xs @ [Suc w]))"
   690     apply(auto simp: prrf nth_append)+
   690     apply(auto simp: prrf nth_append)+
   691     done
   691     done
   692   show "UF.Sigma (rec_exec (rec_all ?rt ?rf))
   692   show "UF.Sigma (rec_eval (rec_all ?rt ?rf))
   693          (xs @ [Suc w]) =
   693          (xs @ [Suc w]) =
   694         Minr (\<lambda>args. 0 < rec_exec rf args) xs (Suc w)"
   694         Minr (\<lambda>args. 0 < rec_eval rf args) xs (Suc w)"
   695     apply(auto simp: Sigma_Suc_simp_rewrite ind Minr_Suc_simp)
   695     apply(auto simp: Sigma_Suc_simp_rewrite ind Minr_Suc_simp)
   696     apply(simp_all only: prrf all_lemma)
   696     apply(simp_all only: prrf all_lemma)
   697     apply(auto simp: rec_exec.simps get_fstn_args_take Let_def Minr.simps split: if_splits)
   697     apply(auto simp: rec_eval.simps get_fstn_args_take Let_def Minr.simps split: if_splits)
   698     apply(drule_tac Min_false1, simp, simp, simp)
   698     apply(drule_tac Min_false1, simp, simp, simp)
   699     apply(case_tac "x = Suc w", simp, simp)
   699     apply(case_tac "x = Suc w", simp, simp)
   700     apply(drule_tac Min_false1, simp, simp, simp)
   700     apply(drule_tac Min_false1, simp, simp, simp)
   701     apply(drule_tac Min_false1, simp, simp, simp)
   701     apply(drule_tac Min_false1, simp, simp, simp)
   702     done
   702     done
   705 text {*
   705 text {*
   706   The correctness of @{text "rec_Minr"}.
   706   The correctness of @{text "rec_Minr"}.
   707   *}
   707   *}
   708 lemma Minr_lemma: 
   708 lemma Minr_lemma: 
   709   assumes h: "primerec rf (Suc (length xs))" 
   709   assumes h: "primerec rf (Suc (length xs))" 
   710   shows "rec_exec (rec_Minr rf) (xs @ [w]) = Minr (\<lambda> args. (0 < rec_exec rf args)) xs w"
   710   shows "rec_eval (rec_Minr rf) (xs @ [w]) = Minr (\<lambda> args. (0 < rec_eval rf args)) xs w"
   711 proof -
   711 proof -
   712   let ?rt = "(recf.id (Suc (length xs)) ((length xs)))"
   712   let ?rt = "(recf.id (Suc (length xs)) ((length xs)))"
   713   let ?rf = "(Cn (Suc (Suc (length xs))) 
   713   let ?rf = "(Cn (Suc (Suc (length xs))) 
   714     rec_not [Cn (Suc (Suc (length xs))) rf 
   714     rec_not [Cn (Suc (Suc (length xs))) rf 
   715     (get_fstn_args (Suc (Suc (length xs))) (length xs) @ 
   715     (get_fstn_args (Suc (Suc (length xs))) (length xs) @ 
   720     apply(rule_tac primerec_all_iff)
   720     apply(rule_tac primerec_all_iff)
   721     apply(auto simp: h nth_append)+
   721     apply(auto simp: h nth_append)+
   722     done
   722     done
   723   moreover have "arity rf = Suc (length xs)"
   723   moreover have "arity rf = Suc (length xs)"
   724     using h by auto
   724     using h by auto
   725   ultimately show "rec_exec (rec_Minr rf) (xs @ [w]) = Minr (\<lambda> args. (0 < rec_exec rf args)) xs w"
   725   ultimately show "rec_eval (rec_Minr rf) (xs @ [w]) = Minr (\<lambda> args. (0 < rec_eval rf args)) xs w"
   726     apply(simp add: rec_exec.simps rec_Minr.simps arity.simps Let_def 
   726     apply(simp add: rec_eval.simps rec_Minr.simps arity.simps Let_def 
   727                     sigma_lemma all_lemma)
   727                     sigma_lemma all_lemma)
   728     apply(rule_tac  sigma_minr_lemma)
   728     apply(rule_tac  sigma_minr_lemma)
   729     apply(simp add: h)
   729     apply(simp add: h)
   730     done
   730     done
   731 qed
   731 qed
   741 
   741 
   742 text {*
   742 text {*
   743   The correctness of @{text "rec_le"}.
   743   The correctness of @{text "rec_le"}.
   744   *}
   744   *}
   745 lemma le_lemma: 
   745 lemma le_lemma: 
   746   "rec_exec rec_le [x, y] = (if (x \<le> y) then 1 else 0)"
   746   "rec_eval rec_le [x, y] = (if (x \<le> y) then 1 else 0)"
   747 by(auto simp: rec_le_def rec_exec.simps)
   747 by(auto simp: rec_le_def rec_eval.simps)
   748 
   748 
   749 text {*
   749 text {*
   750   Definition of @{text "Max[Rr]"} on page 77 of Boolos's book.
   750   Definition of @{text "Max[Rr]"} on page 77 of Boolos's book.
   751 *}
   751 *}
   752 
   752 
   845 apply(case_tac "ma = Suc w", auto)
   845 apply(case_tac "ma = Suc w", auto)
   846 done
   846 done
   847 
   847 
   848 lemma Sigma_Max_lemma: 
   848 lemma Sigma_Max_lemma: 
   849   assumes prrf: "primerec rf (Suc (length xs))"
   849   assumes prrf: "primerec rf (Suc (length xs))"
   850   shows "UF.Sigma (rec_exec (Cn (Suc (Suc (length xs))) rec_not
   850   shows "UF.Sigma (rec_eval (Cn (Suc (Suc (length xs))) rec_not
   851   [rec_all (recf.id (Suc (Suc (length xs))) (length xs))
   851   [rec_all (recf.id (Suc (Suc (length xs))) (length xs))
   852   (Cn (Suc (Suc (Suc (length xs)))) rec_disj
   852   (Cn (Suc (Suc (Suc (length xs)))) rec_disj
   853   [Cn (Suc (Suc (Suc (length xs)))) rec_le
   853   [Cn (Suc (Suc (Suc (length xs)))) rec_le
   854   [recf.id (Suc (Suc (Suc (length xs)))) (Suc (Suc (length xs))), 
   854   [recf.id (Suc (Suc (Suc (length xs)))) (Suc (Suc (length xs))), 
   855   recf.id (Suc (Suc (Suc (length xs)))) (Suc (length xs))],
   855   recf.id (Suc (Suc (Suc (length xs)))) (Suc (length xs))],
   856   Cn (Suc (Suc (Suc (length xs)))) rec_not
   856   Cn (Suc (Suc (Suc (length xs)))) rec_not
   857   [Cn (Suc (Suc (Suc (length xs)))) rf
   857   [Cn (Suc (Suc (Suc (length xs)))) rf
   858   (get_fstn_args (Suc (Suc (Suc (length xs)))) (length xs) @ 
   858   (get_fstn_args (Suc (Suc (Suc (length xs)))) (length xs) @ 
   859   [recf.id (Suc (Suc (Suc (length xs)))) (Suc (Suc (length xs)))])]])]))
   859   [recf.id (Suc (Suc (Suc (length xs)))) (Suc (Suc (length xs)))])]])]))
   860   ((xs @ [w]) @ [w]) =
   860   ((xs @ [w]) @ [w]) =
   861        Maxr (\<lambda>args. 0 < rec_exec rf args) xs w"
   861        Maxr (\<lambda>args. 0 < rec_eval rf args) xs w"
   862 proof -
   862 proof -
   863   let ?rt = "(recf.id (Suc (Suc (length xs))) ((length xs)))"
   863   let ?rt = "(recf.id (Suc (Suc (length xs))) ((length xs)))"
   864   let ?rf1 = "Cn (Suc (Suc (Suc (length xs))))
   864   let ?rf1 = "Cn (Suc (Suc (Suc (length xs))))
   865     rec_le [recf.id (Suc (Suc (Suc (length xs)))) 
   865     rec_le [recf.id (Suc (Suc (Suc (length xs)))) 
   866     ((Suc (Suc (length xs)))), recf.id 
   866     ((Suc (Suc (length xs)))), recf.id 
   874   let ?rf = "Cn (Suc (Suc (Suc (length xs)))) rec_disj [?rf1, ?rf3]"
   874   let ?rf = "Cn (Suc (Suc (Suc (length xs)))) rec_disj [?rf1, ?rf3]"
   875   let ?rq = "rec_all ?rt ?rf"
   875   let ?rq = "rec_all ?rt ?rf"
   876   let ?notrq = "Cn (Suc (Suc (length xs))) rec_not [?rq]"
   876   let ?notrq = "Cn (Suc (Suc (length xs))) rec_not [?rq]"
   877   show "?thesis"
   877   show "?thesis"
   878   proof(auto simp: Maxr.simps)
   878   proof(auto simp: Maxr.simps)
   879     assume h: "\<forall>x\<le>w. rec_exec rf (xs @ [x]) = 0"
   879     assume h: "\<forall>x\<le>w. rec_eval rf (xs @ [x]) = 0"
   880     have "primerec ?rf (Suc (length (xs @ [w, i]))) \<and> 
   880     have "primerec ?rf (Suc (length (xs @ [w, i]))) \<and> 
   881           primerec ?rt (length (xs @ [w, i]))"
   881           primerec ?rt (length (xs @ [w, i]))"
   882       using prrf
   882       using prrf
   883       apply(auto)
   883       apply(auto)
   884       apply(case_tac i, auto)
   884       apply(case_tac i, auto)
   885       apply(case_tac ia, auto simp: h nth_append)
   885       apply(case_tac ia, auto simp: h nth_append)
   886       done
   886       done
   887     hence "Sigma (rec_exec ?notrq) ((xs@[w])@[w]) = 0"
   887     hence "Sigma (rec_eval ?notrq) ((xs@[w])@[w]) = 0"
   888       apply(rule_tac Sigma_0)
   888       apply(rule_tac Sigma_0)
   889       apply(auto simp: rec_exec.simps all_lemma
   889       apply(auto simp: rec_eval.simps all_lemma
   890                        get_fstn_args_take nth_append h)
   890                        get_fstn_args_take nth_append h)
   891       done
   891       done
   892     thus "UF.Sigma (rec_exec ?notrq)
   892     thus "UF.Sigma (rec_eval ?notrq)
   893       (xs @ [w, w]) = 0"
   893       (xs @ [w, w]) = 0"
   894       by simp
   894       by simp
   895   next
   895   next
   896     fix x
   896     fix x
   897     assume h: "x \<le> w" "0 < rec_exec rf (xs @ [x])"
   897     assume h: "x \<le> w" "0 < rec_eval rf (xs @ [x])"
   898     hence "\<exists> ma. Max {y. y \<le> w \<and> 0 < rec_exec rf (xs @ [y])} = ma"
   898     hence "\<exists> ma. Max {y. y \<le> w \<and> 0 < rec_eval rf (xs @ [y])} = ma"
   899       by auto
   899       by auto
   900     from this obtain ma where k1: 
   900     from this obtain ma where k1: 
   901       "Max {y. y \<le> w \<and> 0 < rec_exec rf (xs @ [y])} = ma" ..
   901       "Max {y. y \<le> w \<and> 0 < rec_eval rf (xs @ [y])} = ma" ..
   902     hence k2: "ma \<le> w \<and> 0 < rec_exec rf (xs @ [ma])"
   902     hence k2: "ma \<le> w \<and> 0 < rec_eval rf (xs @ [ma])"
   903       using h
   903       using h
   904       apply(subgoal_tac
   904       apply(subgoal_tac
   905         "Max {y. y \<le> w \<and> 0 < rec_exec rf (xs @ [y])} \<in>  {y. y \<le> w \<and> 0 < rec_exec rf (xs @ [y])}")
   905         "Max {y. y \<le> w \<and> 0 < rec_eval rf (xs @ [y])} \<in>  {y. y \<le> w \<and> 0 < rec_eval rf (xs @ [y])}")
   906       apply(erule_tac CollectE, simp)
   906       apply(erule_tac CollectE, simp)
   907       apply(rule_tac Max_in, auto)
   907       apply(rule_tac Max_in, auto)
   908       done
   908       done
   909     hence k3: "\<forall> k < ma. (rec_exec ?notrq (xs @ [w, k]) = 1)"
   909     hence k3: "\<forall> k < ma. (rec_eval ?notrq (xs @ [w, k]) = 1)"
   910       apply(auto simp: nth_append)
   910       apply(auto simp: nth_append)
   911       apply(subgoal_tac "primerec ?rf (Suc (length (xs @ [w, k]))) \<and> 
   911       apply(subgoal_tac "primerec ?rf (Suc (length (xs @ [w, k]))) \<and> 
   912         primerec ?rt (length (xs @ [w, k]))")
   912         primerec ?rt (length (xs @ [w, k]))")
   913       apply(auto simp: rec_exec.simps all_lemma get_fstn_args_take nth_append)
   913       apply(auto simp: rec_eval.simps all_lemma get_fstn_args_take nth_append)
   914       using prrf
   914       using prrf
   915       apply(case_tac i, auto)
   915       apply(case_tac i, auto)
   916       apply(case_tac ia, auto simp: h nth_append)
   916       apply(case_tac ia, auto simp: h nth_append)
   917       done    
   917       done    
   918     have k4: "\<forall> k \<ge> ma. (rec_exec ?notrq (xs @ [w, k]) = 0)"
   918     have k4: "\<forall> k \<ge> ma. (rec_eval ?notrq (xs @ [w, k]) = 0)"
   919       apply(auto)
   919       apply(auto)
   920       apply(subgoal_tac "primerec ?rf (Suc (length (xs @ [w, k]))) \<and> 
   920       apply(subgoal_tac "primerec ?rf (Suc (length (xs @ [w, k]))) \<and> 
   921         primerec ?rt (length (xs @ [w, k]))")
   921         primerec ?rt (length (xs @ [w, k]))")
   922       apply(auto simp: rec_exec.simps all_lemma get_fstn_args_take nth_append)
   922       apply(auto simp: rec_eval.simps all_lemma get_fstn_args_take nth_append)
   923       apply(subgoal_tac "x \<le> Max {y. y \<le> w \<and> 0 < rec_exec rf (xs @ [y])}",
   923       apply(subgoal_tac "x \<le> Max {y. y \<le> w \<and> 0 < rec_eval rf (xs @ [y])}",
   924         simp add: k1)
   924         simp add: k1)
   925       apply(rule_tac Max_ge, auto)
   925       apply(rule_tac Max_ge, auto)
   926       using prrf
   926       using prrf
   927       apply(case_tac i, auto)
   927       apply(case_tac i, auto)
   928       apply(case_tac ia, auto simp: h nth_append)
   928       apply(case_tac ia, auto simp: h nth_append)
   929       done 
   929       done 
   930     from k3 k4 k1 have "Sigma (rec_exec ?notrq) ((xs @ [w]) @ [w]) = ma"
   930     from k3 k4 k1 have "Sigma (rec_eval ?notrq) ((xs @ [w]) @ [w]) = ma"
   931       apply(rule_tac Sigma_max_point, simp, simp, simp add: k2)
   931       apply(rule_tac Sigma_max_point, simp, simp, simp add: k2)
   932       done
   932       done
   933     from k1 and this show "Sigma (rec_exec ?notrq) (xs @ [w, w]) =
   933     from k1 and this show "Sigma (rec_eval ?notrq) (xs @ [w, w]) =
   934       Max {y. y \<le> w \<and> 0 < rec_exec rf (xs @ [y])}"
   934       Max {y. y \<le> w \<and> 0 < rec_eval rf (xs @ [y])}"
   935       by simp
   935       by simp
   936   qed  
   936   qed  
   937 qed
   937 qed
   938 
   938 
   939 text {*
   939 text {*
   940   The correctness of @{text "rec_maxr"}.
   940   The correctness of @{text "rec_maxr"}.
   941   *}
   941   *}
   942 lemma Maxr_lemma:
   942 lemma Maxr_lemma:
   943  assumes h: "primerec rf (Suc (length xs))"
   943  assumes h: "primerec rf (Suc (length xs))"
   944  shows   "rec_exec (rec_maxr rf) (xs @ [w]) = 
   944  shows   "rec_eval (rec_maxr rf) (xs @ [w]) = 
   945             Maxr (\<lambda> args. 0 < rec_exec rf args) xs w"
   945             Maxr (\<lambda> args. 0 < rec_eval rf args) xs w"
   946 proof -
   946 proof -
   947   from h have "arity rf = Suc (length xs)"
   947   from h have "arity rf = Suc (length xs)"
   948     by auto
   948     by auto
   949   thus "?thesis"
   949   thus "?thesis"
   950   proof(simp add: rec_exec.simps rec_maxr.simps nth_append get_fstn_args_take)
   950   proof(simp add: rec_eval.simps rec_maxr.simps nth_append get_fstn_args_take)
   951     let ?rt = "(recf.id (Suc (Suc (length xs))) ((length xs)))"
   951     let ?rt = "(recf.id (Suc (Suc (length xs))) ((length xs)))"
   952     let ?rf1 = "Cn (Suc (Suc (Suc (length xs))))
   952     let ?rf1 = "Cn (Suc (Suc (Suc (length xs))))
   953                      rec_le [recf.id (Suc (Suc (Suc (length xs)))) 
   953                      rec_le [recf.id (Suc (Suc (Suc (length xs)))) 
   954               ((Suc (Suc (length xs)))), recf.id 
   954               ((Suc (Suc (length xs)))), recf.id 
   955              (Suc (Suc (Suc (length xs)))) ((Suc (length xs)))]"
   955              (Suc (Suc (Suc (length xs)))) ((Suc (length xs)))]"
   974     from prt and prrf have prrq: "primerec ?rq 
   974     from prt and prrf have prrq: "primerec ?rq 
   975                                        (Suc (Suc (length xs)))"
   975                                        (Suc (Suc (length xs)))"
   976       by(erule_tac primerec_all_iff, auto)
   976       by(erule_tac primerec_all_iff, auto)
   977     hence prnotrp: "primerec ?notrq (Suc (length ((xs @ [w]))))"
   977     hence prnotrp: "primerec ?notrq (Suc (length ((xs @ [w]))))"
   978       by(rule_tac prime_cn, auto)
   978       by(rule_tac prime_cn, auto)
   979     have g1: "rec_exec (rec_sigma ?notrq) ((xs @ [w]) @ [w]) 
   979     have g1: "rec_eval (rec_sigma ?notrq) ((xs @ [w]) @ [w]) 
   980       = Maxr (\<lambda>args. 0 < rec_exec rf args) xs w"
   980       = Maxr (\<lambda>args. 0 < rec_eval rf args) xs w"
   981       using prnotrp
   981       using prnotrp
   982       using sigma_lemma
   982       using sigma_lemma
   983       apply(simp only: sigma_lemma)
   983       apply(simp only: sigma_lemma)
   984       apply(rule_tac Sigma_Max_lemma)
   984       apply(rule_tac Sigma_Max_lemma)
   985       apply(simp add: h)
   985       apply(simp add: h)
   986       done
   986       done
   987     thus "rec_exec (rec_sigma ?notrq)
   987     thus "rec_eval (rec_sigma ?notrq)
   988      (xs @ [w, w]) =
   988      (xs @ [w, w]) =
   989     Maxr (\<lambda>args. 0 < rec_exec rf args) xs w"
   989     Maxr (\<lambda>args. 0 < rec_eval rf args) xs w"
   990       apply(simp)
   990       apply(simp)
   991       done
   991       done
   992   qed
   992   qed
   993 qed
   993 qed
   994       
   994       
  1040 
  1040 
  1041 text {*
  1041 text {*
  1042   The correctness of @{text "rec_noteq"}.
  1042   The correctness of @{text "rec_noteq"}.
  1043   *}
  1043   *}
  1044 lemma noteq_lemma: 
  1044 lemma noteq_lemma: 
  1045   "rec_exec rec_noteq [x, y] = (if x \<noteq> y then 1 else 0)"
  1045   "rec_eval rec_noteq [x, y] = (if x \<noteq> y then 1 else 0)"
  1046 by(simp add: rec_exec.simps rec_noteq_def)
  1046 by(simp add: rec_eval.simps rec_noteq_def)
  1047 
  1047 
  1048 declare noteq_lemma[simp]
  1048 declare noteq_lemma[simp]
  1049 
  1049 
  1050 text {*
  1050 text {*
  1051   @{text "rec_quo"} is the recursive function used to implement @{text "quo"}
  1051   @{text "rec_quo"} is the recursive function used to implement @{text "quo"}
  1077 apply(rule_tac prime_cn, auto)+
  1077 apply(rule_tac prime_cn, auto)+
  1078 apply(case_tac i, auto intro: prime_id)
  1078 apply(case_tac i, auto intro: prime_id)
  1079 done
  1079 done
  1080 
  1080 
  1081 
  1081 
  1082 lemma quo_lemma1: "rec_exec rec_quo [x, y] = quo [x, y]"
  1082 lemma quo_lemma1: "rec_eval rec_quo [x, y] = quo [x, y]"
  1083 proof(simp add: rec_exec.simps rec_quo_def)
  1083 proof(simp add: rec_eval.simps rec_quo_def)
  1084   let ?rR = "(Cn (Suc (Suc (Suc 0))) rec_conj
  1084   let ?rR = "(Cn (Suc (Suc (Suc 0))) rec_conj
  1085                [Cn (Suc (Suc (Suc 0))) rec_le
  1085                [Cn (Suc (Suc (Suc 0))) rec_le
  1086                    [Cn (Suc (Suc (Suc 0))) rec_mult 
  1086                    [Cn (Suc (Suc (Suc 0))) rec_mult 
  1087                [recf.id (Suc (Suc (Suc 0))) (Suc (0)), 
  1087                [recf.id (Suc (Suc (Suc 0))) (Suc (0)), 
  1088                 recf.id (Suc (Suc (Suc 0))) (Suc (Suc (0)))],
  1088                 recf.id (Suc (Suc (Suc 0))) (Suc (Suc (0)))],
  1089                  recf.id (Suc (Suc (Suc 0))) (0)],  
  1089                  recf.id (Suc (Suc (Suc 0))) (0)],  
  1090           Cn (Suc (Suc (Suc 0))) rec_noteq 
  1090           Cn (Suc (Suc (Suc 0))) rec_noteq 
  1091                               [recf.id (Suc (Suc (Suc 0))) 
  1091                               [recf.id (Suc (Suc (Suc 0))) 
  1092              (Suc (0)), Cn (Suc (Suc (Suc 0))) (constn 0) 
  1092              (Suc (0)), Cn (Suc (Suc (Suc 0))) (constn 0) 
  1093                       [recf.id (Suc (Suc (Suc 0))) (0)]]])"
  1093                       [recf.id (Suc (Suc (Suc 0))) (0)]]])"
  1094   have "rec_exec (rec_maxr ?rR) ([x, y]@ [ x]) = Maxr (\<lambda> args. 0 < rec_exec ?rR args) [x, y] x"
  1094   have "rec_eval (rec_maxr ?rR) ([x, y]@ [ x]) = Maxr (\<lambda> args. 0 < rec_eval ?rR args) [x, y] x"
  1095   proof(rule_tac Maxr_lemma, simp)
  1095   proof(rule_tac Maxr_lemma, simp)
  1096     show "primerec ?rR (Suc (Suc (Suc 0)))"
  1096     show "primerec ?rR (Suc (Suc (Suc 0)))"
  1097       apply(auto)
  1097       apply(auto)
  1098       apply(case_tac i, auto)
  1098       apply(case_tac i, auto)
  1099       apply(case_tac [!] ia, auto)
  1099       apply(case_tac [!] ia, auto)
  1100       apply(case_tac i, auto)
  1100       apply(case_tac i, auto)
  1101       done
  1101       done
  1102   qed
  1102   qed
  1103   hence g1: "rec_exec (rec_maxr ?rR) ([x, y,  x]) =
  1103   hence g1: "rec_eval (rec_maxr ?rR) ([x, y,  x]) =
  1104              Maxr (\<lambda> args. if rec_exec ?rR args = 0 then False
  1104              Maxr (\<lambda> args. if rec_eval ?rR args = 0 then False
  1105                            else True) [x, y] x" 
  1105                            else True) [x, y] x" 
  1106     by simp
  1106     by simp
  1107   have g2: "Maxr (\<lambda> args. if rec_exec ?rR args = 0 then False
  1107   have g2: "Maxr (\<lambda> args. if rec_eval ?rR args = 0 then False
  1108                            else True) [x, y] x = quo [x, y]"
  1108                            else True) [x, y] x = quo [x, y]"
  1109     apply(simp add: rec_exec.simps)
  1109     apply(simp add: rec_eval.simps)
  1110     apply(simp add: Maxr.simps quo.simps, auto)
  1110     apply(simp add: Maxr.simps quo.simps, auto)
  1111     done
  1111     done
  1112   from g1 and g2 show 
  1112   from g1 and g2 show 
  1113     "rec_exec (rec_maxr ?rR) ([x, y,  x]) = quo [x, y]"
  1113     "rec_eval (rec_maxr ?rR) ([x, y,  x]) = quo [x, y]"
  1114     by simp
  1114     by simp
  1115 qed
  1115 qed
  1116 
  1116 
  1117 text {*
  1117 text {*
  1118   The correctness of @{text "quo"}.
  1118   The correctness of @{text "quo"}.
  1119   *}
  1119   *}
  1120 lemma quo_lemma2: "rec_exec rec_quo [x, y] = x div y"
  1120 lemma quo_lemma2: "rec_eval rec_quo [x, y] = x div y"
  1121   using quo_lemma1[of x y] quo_div[of x y]
  1121   using quo_lemma1[of x y] quo_div[of x y]
  1122   by simp
  1122   by simp
  1123  
  1123  
  1124 text {* 
  1124 text {* 
  1125   @{text "rec_mod"} is the recursive function used to implement 
  1125   @{text "rec_mod"} is the recursive function used to implement 
  1132                                                      (Suc (0))]]"
  1132                                                      (Suc (0))]]"
  1133 
  1133 
  1134 text {*
  1134 text {*
  1135   The correctness of @{text "rec_mod"}:
  1135   The correctness of @{text "rec_mod"}:
  1136   *}
  1136   *}
  1137 lemma mod_lemma: "rec_exec rec_mod [x, y] = (x mod y)"
  1137 lemma mod_lemma: "rec_eval rec_mod [x, y] = (x mod y)"
  1138 proof(simp add: rec_exec.simps rec_mod_def quo_lemma2)
  1138 proof(simp add: rec_eval.simps rec_mod_def quo_lemma2)
  1139   fix x y
  1139   fix x y
  1140   show "x - x div y * y = x mod (y::nat)"
  1140   show "x - x div y * y = x mod (y::nat)"
  1141     using mod_div_equality2[of y x]
  1141     using mod_div_equality2[of y x]
  1142     apply(subgoal_tac "y * (x div y) = (x div y ) * y", arith, simp)
  1142     apply(subgoal_tac "y * (x div y) = (x div y ) * y", arith, simp)
  1143     done
  1143     done
  1176           rec_embranch' ((rg, rc) # rgcs) vl)"
  1176           rec_embranch' ((rg, rc) # rgcs) vl)"
  1177 
  1177 
  1178 declare Embranch.simps[simp del] rec_embranch.simps[simp del]
  1178 declare Embranch.simps[simp del] rec_embranch.simps[simp del]
  1179 
  1179 
  1180 lemma embranch_all0: 
  1180 lemma embranch_all0: 
  1181   "\<lbrakk>\<forall> j < length rcs. rec_exec (rcs ! j) xs = 0;
  1181   "\<lbrakk>\<forall> j < length rcs. rec_eval (rcs ! j) xs = 0;
  1182     length rgs = length rcs;  
  1182     length rgs = length rcs;  
  1183   rcs \<noteq> []; 
  1183   rcs \<noteq> []; 
  1184   list_all (\<lambda> rf. primerec rf (length xs)) (rgs @ rcs)\<rbrakk>  \<Longrightarrow> 
  1184   list_all (\<lambda> rf. primerec rf (length xs)) (rgs @ rcs)\<rbrakk>  \<Longrightarrow> 
  1185   rec_exec (rec_embranch (zip rgs rcs)) xs = 0"
  1185   rec_eval (rec_embranch (zip rgs rcs)) xs = 0"
  1186 proof(induct rcs arbitrary: rgs, simp, case_tac rgs, simp)
  1186 proof(induct rcs arbitrary: rgs, simp, case_tac rgs, simp)
  1187   fix a rcs rgs aa list
  1187   fix a rcs rgs aa list
  1188   assume ind: 
  1188   assume ind: 
  1189     "\<And>rgs. \<lbrakk>\<forall>j<length rcs. rec_exec (rcs ! j) xs = 0; 
  1189     "\<And>rgs. \<lbrakk>\<forall>j<length rcs. rec_eval (rcs ! j) xs = 0; 
  1190              length rgs = length rcs; rcs \<noteq> []; 
  1190              length rgs = length rcs; rcs \<noteq> []; 
  1191             list_all (\<lambda>rf. primerec rf (length xs)) (rgs @ rcs)\<rbrakk> \<Longrightarrow> 
  1191             list_all (\<lambda>rf. primerec rf (length xs)) (rgs @ rcs)\<rbrakk> \<Longrightarrow> 
  1192                       rec_exec (rec_embranch (zip rgs rcs)) xs = 0"
  1192                       rec_eval (rec_embranch (zip rgs rcs)) xs = 0"
  1193   and h:  "\<forall>j<length (a # rcs). rec_exec ((a # rcs) ! j) xs = 0"
  1193   and h:  "\<forall>j<length (a # rcs). rec_eval ((a # rcs) ! j) xs = 0"
  1194   "length rgs = length (a # rcs)" 
  1194   "length rgs = length (a # rcs)" 
  1195     "a # rcs \<noteq> []" 
  1195     "a # rcs \<noteq> []" 
  1196     "list_all (\<lambda>rf. primerec rf (length xs)) (rgs @ a # rcs)"
  1196     "list_all (\<lambda>rf. primerec rf (length xs)) (rgs @ a # rcs)"
  1197     "rgs = aa # list"
  1197     "rgs = aa # list"
  1198   have g: "rcs \<noteq> [] \<Longrightarrow> rec_exec (rec_embranch (zip list rcs)) xs = 0"
  1198   have g: "rcs \<noteq> [] \<Longrightarrow> rec_eval (rec_embranch (zip list rcs)) xs = 0"
  1199     using h
  1199     using h
  1200     by(rule_tac ind, auto)
  1200     by(rule_tac ind, auto)
  1201   show "rec_exec (rec_embranch (zip rgs (a # rcs))) xs = 0"
  1201   show "rec_eval (rec_embranch (zip rgs (a # rcs))) xs = 0"
  1202   proof(case_tac "rcs = []", simp)
  1202   proof(case_tac "rcs = []", simp)
  1203     show "rec_exec (rec_embranch (zip rgs [a])) xs = 0"
  1203     show "rec_eval (rec_embranch (zip rgs [a])) xs = 0"
  1204       using h
  1204       using h
  1205       apply(simp add: rec_embranch.simps rec_exec.simps)
  1205       apply(simp add: rec_embranch.simps rec_eval.simps)
  1206       apply(erule_tac x = 0 in allE, simp)
  1206       apply(erule_tac x = 0 in allE, simp)
  1207       done
  1207       done
  1208   next
  1208   next
  1209     assume "rcs \<noteq> []"
  1209     assume "rcs \<noteq> []"
  1210     hence "rec_exec (rec_embranch (zip list rcs)) xs = 0"
  1210     hence "rec_eval (rec_embranch (zip list rcs)) xs = 0"
  1211       using g by simp
  1211       using g by simp
  1212     thus "rec_exec (rec_embranch (zip rgs (a # rcs))) xs = 0"
  1212     thus "rec_eval (rec_embranch (zip rgs (a # rcs))) xs = 0"
  1213       using h
  1213       using h
  1214       apply(simp add: rec_embranch.simps rec_exec.simps)
  1214       apply(simp add: rec_embranch.simps rec_eval.simps)
  1215       apply(case_tac rcs,
  1215       apply(case_tac rcs,
  1216         auto simp: rec_exec.simps rec_embranch.simps)
  1216         auto simp: rec_eval.simps rec_embranch.simps)
  1217       apply(case_tac list,
  1217       apply(case_tac list,
  1218         auto simp: rec_exec.simps rec_embranch.simps)
  1218         auto simp: rec_eval.simps rec_embranch.simps)
  1219       done
  1219       done
  1220   qed
  1220   qed
  1221 qed     
  1221 qed     
  1222  
  1222  
  1223 
  1223 
  1224 lemma embranch_exec_0: "\<lbrakk>rec_exec aa xs = 0; zip rgs list \<noteq> []; 
  1224 lemma embranch_exec_0: "\<lbrakk>rec_eval aa xs = 0; zip rgs list \<noteq> []; 
  1225        list_all (\<lambda> rf. primerec rf (length xs)) ([a, aa] @ rgs @ list)\<rbrakk>
  1225        list_all (\<lambda> rf. primerec rf (length xs)) ([a, aa] @ rgs @ list)\<rbrakk>
  1226        \<Longrightarrow> rec_exec (rec_embranch ((a, aa) # zip rgs list)) xs
  1226        \<Longrightarrow> rec_eval (rec_embranch ((a, aa) # zip rgs list)) xs
  1227          = rec_exec (rec_embranch (zip rgs list)) xs"
  1227          = rec_eval (rec_embranch (zip rgs list)) xs"
  1228 apply(simp add: rec_exec.simps rec_embranch.simps)
  1228 apply(simp add: rec_eval.simps rec_embranch.simps)
  1229 apply(case_tac "zip rgs list", simp, case_tac ab, 
  1229 apply(case_tac "zip rgs list", simp, case_tac ab, 
  1230   simp add: rec_embranch.simps rec_exec.simps)
  1230   simp add: rec_embranch.simps rec_eval.simps)
  1231 apply(subgoal_tac "arity a = length xs", auto)
  1231 apply(subgoal_tac "arity a = length xs", auto)
  1232 apply(subgoal_tac "arity aaa = length xs", auto)
  1232 apply(subgoal_tac "arity aaa = length xs", auto)
  1233 apply(case_tac rgs, simp, case_tac list, simp, simp)
  1233 apply(case_tac rgs, simp, case_tac list, simp, simp)
  1234 done
  1234 done
  1235 
  1235 
  1242 apply(case_tac xs, simp, simp)
  1242 apply(case_tac xs, simp, simp)
  1243 done
  1243 done
  1244 
  1244 
  1245 lemma Embranch_0:  
  1245 lemma Embranch_0:  
  1246   "\<lbrakk>length rgs = k; length rcs = k; k > 0; 
  1246   "\<lbrakk>length rgs = k; length rcs = k; k > 0; 
  1247   \<forall> j < k. rec_exec (rcs ! j) xs = 0\<rbrakk> \<Longrightarrow>
  1247   \<forall> j < k. rec_eval (rcs ! j) xs = 0\<rbrakk> \<Longrightarrow>
  1248   Embranch (zip (map rec_exec rgs) (map (\<lambda>r args. 0 < rec_exec r args) rcs)) xs = 0"
  1248   Embranch (zip (map rec_eval rgs) (map (\<lambda>r args. 0 < rec_eval r args) rcs)) xs = 0"
  1249 proof(induct rgs arbitrary: rcs k, simp, simp)
  1249 proof(induct rgs arbitrary: rcs k, simp, simp)
  1250   fix a rgs rcs k
  1250   fix a rgs rcs k
  1251   assume ind: 
  1251   assume ind: 
  1252     "\<And>rcs k. \<lbrakk>length rgs = k; length rcs = k; 0 < k; \<forall>j<k. rec_exec (rcs ! j) xs = 0\<rbrakk> 
  1252     "\<And>rcs k. \<lbrakk>length rgs = k; length rcs = k; 0 < k; \<forall>j<k. rec_eval (rcs ! j) xs = 0\<rbrakk> 
  1253     \<Longrightarrow> Embranch (zip (map rec_exec rgs) (map (\<lambda>r args. 0 < rec_exec r args) rcs)) xs = 0"
  1253     \<Longrightarrow> Embranch (zip (map rec_eval rgs) (map (\<lambda>r args. 0 < rec_eval r args) rcs)) xs = 0"
  1254   and h: "Suc (length rgs) = k" "length rcs = k"
  1254   and h: "Suc (length rgs) = k" "length rcs = k"
  1255     "\<forall>j<k. rec_exec (rcs ! j) xs = 0"
  1255     "\<forall>j<k. rec_eval (rcs ! j) xs = 0"
  1256   from h show  
  1256   from h show  
  1257     "Embranch (zip (rec_exec a # map rec_exec rgs) 
  1257     "Embranch (zip (rec_eval a # map rec_eval rgs) 
  1258            (map (\<lambda>r args. 0 < rec_exec r args) rcs)) xs = 0"
  1258            (map (\<lambda>r args. 0 < rec_eval r args) rcs)) xs = 0"
  1259     apply(case_tac rcs, simp, case_tac "rgs = []", simp)
  1259     apply(case_tac rcs, simp, case_tac "rgs = []", simp)
  1260     apply(simp add: Embranch.simps)
  1260     apply(simp add: Embranch.simps)
  1261     apply(erule_tac x = 0 in allE, simp)
  1261     apply(erule_tac x = 0 in allE, simp)
  1262     apply(simp add: Embranch.simps)
  1262     apply(simp add: Embranch.simps)
  1263     apply(erule_tac x = 0 in all_dupE, simp)
  1263     apply(erule_tac x = 0 in all_dupE, simp)
  1271   *}
  1271   *}
  1272 lemma embranch_lemma:
  1272 lemma embranch_lemma:
  1273   assumes branch_num:
  1273   assumes branch_num:
  1274   "length rgs = n" "length rcs = n" "n > 0"
  1274   "length rgs = n" "length rcs = n" "n > 0"
  1275   and partition: 
  1275   and partition: 
  1276   "(\<exists> i < n. (rec_exec (rcs ! i) xs = 1 \<and> (\<forall> j < n. j \<noteq> i \<longrightarrow> 
  1276   "(\<exists> i < n. (rec_eval (rcs ! i) xs = 1 \<and> (\<forall> j < n. j \<noteq> i \<longrightarrow> 
  1277                                       rec_exec (rcs ! j) xs = 0)))"
  1277                                       rec_eval (rcs ! j) xs = 0)))"
  1278   and prime_all: "list_all (\<lambda> rf. primerec rf (length xs)) (rgs @ rcs)"
  1278   and prime_all: "list_all (\<lambda> rf. primerec rf (length xs)) (rgs @ rcs)"
  1279   shows "rec_exec (rec_embranch (zip rgs rcs)) xs =
  1279   shows "rec_eval (rec_embranch (zip rgs rcs)) xs =
  1280                   Embranch (zip (map rec_exec rgs) 
  1280                   Embranch (zip (map rec_eval rgs) 
  1281                      (map (\<lambda> r args. 0 < rec_exec r args) rcs)) xs"
  1281                      (map (\<lambda> r args. 0 < rec_eval r args) rcs)) xs"
  1282   using branch_num partition prime_all
  1282   using branch_num partition prime_all
  1283 proof(induct rgs arbitrary: rcs n, simp)
  1283 proof(induct rgs arbitrary: rcs n, simp)
  1284   fix a rgs rcs n
  1284   fix a rgs rcs n
  1285   assume ind: 
  1285   assume ind: 
  1286     "\<And>rcs n. \<lbrakk>length rgs = n; length rcs = n; 0 < n;
  1286     "\<And>rcs n. \<lbrakk>length rgs = n; length rcs = n; 0 < n;
  1287     \<exists>i<n. rec_exec (rcs ! i) xs = 1 \<and> (\<forall>j<n. j \<noteq> i \<longrightarrow> rec_exec (rcs ! j) xs = 0);
  1287     \<exists>i<n. rec_eval (rcs ! i) xs = 1 \<and> (\<forall>j<n. j \<noteq> i \<longrightarrow> rec_eval (rcs ! j) xs = 0);
  1288     list_all (\<lambda>rf. primerec rf (length xs)) (rgs @ rcs)\<rbrakk>
  1288     list_all (\<lambda>rf. primerec rf (length xs)) (rgs @ rcs)\<rbrakk>
  1289     \<Longrightarrow> rec_exec (rec_embranch (zip rgs rcs)) xs =
  1289     \<Longrightarrow> rec_eval (rec_embranch (zip rgs rcs)) xs =
  1290     Embranch (zip (map rec_exec rgs) (map (\<lambda>r args. 0 < rec_exec r args) rcs)) xs"
  1290     Embranch (zip (map rec_eval rgs) (map (\<lambda>r args. 0 < rec_eval r args) rcs)) xs"
  1291   and h: "length (a # rgs) = n" "length (rcs::recf list) = n" "0 < n"
  1291   and h: "length (a # rgs) = n" "length (rcs::recf list) = n" "0 < n"
  1292          " \<exists>i<n. rec_exec (rcs ! i) xs = 1 \<and> 
  1292          " \<exists>i<n. rec_eval (rcs ! i) xs = 1 \<and> 
  1293          (\<forall>j<n. j \<noteq> i \<longrightarrow> rec_exec (rcs ! j) xs = 0)" 
  1293          (\<forall>j<n. j \<noteq> i \<longrightarrow> rec_eval (rcs ! j) xs = 0)" 
  1294     "list_all (\<lambda>rf. primerec rf (length xs)) ((a # rgs) @ rcs)"
  1294     "list_all (\<lambda>rf. primerec rf (length xs)) ((a # rgs) @ rcs)"
  1295   from h show "rec_exec (rec_embranch (zip (a # rgs) rcs)) xs =
  1295   from h show "rec_eval (rec_embranch (zip (a # rgs) rcs)) xs =
  1296     Embranch (zip (map rec_exec (a # rgs)) (map (\<lambda>r args. 
  1296     Embranch (zip (map rec_eval (a # rgs)) (map (\<lambda>r args. 
  1297                 0 < rec_exec r args) rcs)) xs"
  1297                 0 < rec_eval r args) rcs)) xs"
  1298     apply(case_tac rcs, simp, simp)
  1298     apply(case_tac rcs, simp, simp)
  1299     apply(case_tac "rec_exec aa xs = 0")
  1299     apply(case_tac "rec_eval aa xs = 0")
  1300     apply(case_tac [!] "zip rgs list = []", simp)
  1300     apply(case_tac [!] "zip rgs list = []", simp)
  1301     apply(subgoal_tac "rgs = [] \<and> list = []", simp add: Embranch.simps rec_exec.simps rec_embranch.simps)
  1301     apply(subgoal_tac "rgs = [] \<and> list = []", simp add: Embranch.simps rec_eval.simps rec_embranch.simps)
  1302     apply(rule_tac  zip_null_iff, simp, simp, simp)
  1302     apply(rule_tac  zip_null_iff, simp, simp, simp)
  1303   proof -
  1303   proof -
  1304     fix aa list
  1304     fix aa list
  1305     assume g:
  1305     assume g:
  1306       "Suc (length rgs) = n" "Suc (length list) = n" 
  1306       "Suc (length rgs) = n" "Suc (length list) = n" 
  1307       "\<exists>i<n. rec_exec ((aa # list) ! i) xs = Suc 0 \<and> 
  1307       "\<exists>i<n. rec_eval ((aa # list) ! i) xs = Suc 0 \<and> 
  1308           (\<forall>j<n. j \<noteq> i \<longrightarrow> rec_exec ((aa # list) ! j) xs = 0)"
  1308           (\<forall>j<n. j \<noteq> i \<longrightarrow> rec_eval ((aa # list) ! j) xs = 0)"
  1309       "primerec a (length xs) \<and> 
  1309       "primerec a (length xs) \<and> 
  1310       list_all (\<lambda>rf. primerec rf (length xs)) rgs \<and>
  1310       list_all (\<lambda>rf. primerec rf (length xs)) rgs \<and>
  1311       primerec aa (length xs) \<and> 
  1311       primerec aa (length xs) \<and> 
  1312       list_all (\<lambda>rf. primerec rf (length xs)) list"
  1312       list_all (\<lambda>rf. primerec rf (length xs)) list"
  1313       "rec_exec aa xs = 0" "rcs = aa # list" "zip rgs list \<noteq> []"
  1313       "rec_eval aa xs = 0" "rcs = aa # list" "zip rgs list \<noteq> []"
  1314     have "rec_exec (rec_embranch ((a, aa) # zip rgs list)) xs
  1314     have "rec_eval (rec_embranch ((a, aa) # zip rgs list)) xs
  1315         = rec_exec (rec_embranch (zip rgs list)) xs"
  1315         = rec_eval (rec_embranch (zip rgs list)) xs"
  1316       apply(rule embranch_exec_0, simp_all add: g)
  1316       apply(rule embranch_exec_0, simp_all add: g)
  1317       done
  1317       done
  1318     from g and this show "rec_exec (rec_embranch ((a, aa) # zip rgs list)) xs =
  1318     from g and this show "rec_eval (rec_embranch ((a, aa) # zip rgs list)) xs =
  1319          Embranch ((rec_exec a, \<lambda>args. 0 < rec_exec aa args) # 
  1319          Embranch ((rec_eval a, \<lambda>args. 0 < rec_eval aa args) # 
  1320            zip (map rec_exec rgs) (map (\<lambda>r args. 0 < rec_exec r args) list)) xs"
  1320            zip (map rec_eval rgs) (map (\<lambda>r args. 0 < rec_eval r args) list)) xs"
  1321       apply(simp add: Embranch.simps)
  1321       apply(simp add: Embranch.simps)
  1322       apply(rule_tac n = "n - Suc 0" in ind)
  1322       apply(rule_tac n = "n - Suc 0" in ind)
  1323       apply(case_tac n, simp, simp)
  1323       apply(case_tac n, simp, simp)
  1324       apply(case_tac n, simp, simp)
  1324       apply(case_tac n, simp, simp)
  1325       apply(case_tac n, simp, simp add: zip_null_gr )
  1325       apply(case_tac n, simp, simp add: zip_null_gr )
  1329       apply(rule_tac allI, erule_tac x = "Suc j" in allE, simp)
  1329       apply(rule_tac allI, erule_tac x = "Suc j" in allE, simp)
  1330       done
  1330       done
  1331   next
  1331   next
  1332     fix aa list
  1332     fix aa list
  1333     assume g: "Suc (length rgs) = n" "Suc (length list) = n"
  1333     assume g: "Suc (length rgs) = n" "Suc (length list) = n"
  1334       "\<exists>i<n. rec_exec ((aa # list) ! i) xs = Suc 0 \<and> 
  1334       "\<exists>i<n. rec_eval ((aa # list) ! i) xs = Suc 0 \<and> 
  1335       (\<forall>j<n. j \<noteq> i \<longrightarrow> rec_exec ((aa # list) ! j) xs = 0)"
  1335       (\<forall>j<n. j \<noteq> i \<longrightarrow> rec_eval ((aa # list) ! j) xs = 0)"
  1336       "primerec a (length xs) \<and> list_all (\<lambda>rf. primerec rf (length xs)) rgs \<and>
  1336       "primerec a (length xs) \<and> list_all (\<lambda>rf. primerec rf (length xs)) rgs \<and>
  1337       primerec aa (length xs) \<and> list_all (\<lambda>rf. primerec rf (length xs)) list"
  1337       primerec aa (length xs) \<and> list_all (\<lambda>rf. primerec rf (length xs)) list"
  1338     "rcs = aa # list" "rec_exec aa xs \<noteq> 0" "zip rgs list = []"
  1338     "rcs = aa # list" "rec_eval aa xs \<noteq> 0" "zip rgs list = []"
  1339     thus "rec_exec (rec_embranch ((a, aa) # zip rgs list)) xs = 
  1339     thus "rec_eval (rec_embranch ((a, aa) # zip rgs list)) xs = 
  1340         Embranch ((rec_exec a, \<lambda>args. 0 < rec_exec aa args) # 
  1340         Embranch ((rec_eval a, \<lambda>args. 0 < rec_eval aa args) # 
  1341        zip (map rec_exec rgs) (map (\<lambda>r args. 0 < rec_exec r args) list)) xs"
  1341        zip (map rec_eval rgs) (map (\<lambda>r args. 0 < rec_eval r args) list)) xs"
  1342       apply(subgoal_tac "rgs = [] \<and> list = []", simp)
  1342       apply(subgoal_tac "rgs = [] \<and> list = []", simp)
  1343       prefer 2
  1343       prefer 2
  1344       apply(rule_tac zip_null_iff, simp, simp, simp)
  1344       apply(rule_tac zip_null_iff, simp, simp, simp)
  1345       apply(simp add: rec_exec.simps rec_embranch.simps Embranch.simps, auto)
  1345       apply(simp add: rec_eval.simps rec_embranch.simps Embranch.simps, auto)
  1346       done
  1346       done
  1347   next
  1347   next
  1348     fix aa list
  1348     fix aa list
  1349     assume g: "Suc (length rgs) = n" "Suc (length list) = n"
  1349     assume g: "Suc (length rgs) = n" "Suc (length list) = n"
  1350       "\<exists>i<n. rec_exec ((aa # list) ! i) xs = Suc 0 \<and>  
  1350       "\<exists>i<n. rec_eval ((aa # list) ! i) xs = Suc 0 \<and>  
  1351            (\<forall>j<n. j \<noteq> i \<longrightarrow> rec_exec ((aa # list) ! j) xs = 0)"
  1351            (\<forall>j<n. j \<noteq> i \<longrightarrow> rec_eval ((aa # list) ! j) xs = 0)"
  1352       "primerec a (length xs) \<and> list_all (\<lambda>rf. primerec rf (length xs)) rgs
  1352       "primerec a (length xs) \<and> list_all (\<lambda>rf. primerec rf (length xs)) rgs
  1353       \<and> primerec aa (length xs) \<and> list_all (\<lambda>rf. primerec rf (length xs)) list"
  1353       \<and> primerec aa (length xs) \<and> list_all (\<lambda>rf. primerec rf (length xs)) list"
  1354       "rcs = aa # list" "rec_exec aa xs \<noteq> 0" "zip rgs list \<noteq> []"
  1354       "rcs = aa # list" "rec_eval aa xs \<noteq> 0" "zip rgs list \<noteq> []"
  1355     have "rec_exec aa xs =  Suc 0"
  1355     have "rec_eval aa xs =  Suc 0"
  1356       using g
  1356       using g
  1357       apply(case_tac "rec_exec aa xs", simp, auto)
  1357       apply(case_tac "rec_eval aa xs", simp, auto)
  1358       done      
  1358       done      
  1359     moreover have "rec_exec (rec_embranch' (zip rgs list) (length xs)) xs = 0"
  1359     moreover have "rec_eval (rec_embranch' (zip rgs list) (length xs)) xs = 0"
  1360     proof -
  1360     proof -
  1361       have "rec_embranch' (zip rgs list) (length xs) = rec_embranch (zip rgs list)"
  1361       have "rec_embranch' (zip rgs list) (length xs) = rec_embranch (zip rgs list)"
  1362         using g
  1362         using g
  1363         apply(case_tac "zip rgs list", simp, case_tac ab)
  1363         apply(case_tac "zip rgs list", simp, case_tac ab)
  1364         apply(simp add: rec_embranch.simps)
  1364         apply(simp add: rec_embranch.simps)
  1365         apply(subgoal_tac "arity aaa = length xs", simp, auto)
  1365         apply(subgoal_tac "arity aaa = length xs", simp, auto)
  1366         apply(case_tac rgs, simp, simp, case_tac list, simp, simp)
  1366         apply(case_tac rgs, simp, simp, case_tac list, simp, simp)
  1367         done
  1367         done
  1368       moreover have "rec_exec (rec_embranch (zip rgs list)) xs = 0"
  1368       moreover have "rec_eval (rec_embranch (zip rgs list)) xs = 0"
  1369       proof(rule embranch_all0)
  1369       proof(rule embranch_all0)
  1370         show " \<forall>j<length list. rec_exec (list ! j) xs = 0"
  1370         show " \<forall>j<length list. rec_eval (list ! j) xs = 0"
  1371           using g
  1371           using g
  1372           apply(auto)
  1372           apply(auto)
  1373           apply(case_tac i, simp)
  1373           apply(case_tac i, simp)
  1374           apply(erule_tac x = "Suc j" in allE, simp)
  1374           apply(erule_tac x = "Suc j" in allE, simp)
  1375           apply(simp)
  1375           apply(simp)
  1389         show "list_all (\<lambda>rf. primerec rf (length xs)) (rgs @ list)"
  1389         show "list_all (\<lambda>rf. primerec rf (length xs)) (rgs @ list)"
  1390           using g
  1390           using g
  1391           apply auto
  1391           apply auto
  1392           done
  1392           done
  1393       qed
  1393       qed
  1394       ultimately show "rec_exec (rec_embranch' (zip rgs list) (length xs)) xs = 0"
  1394       ultimately show "rec_eval (rec_embranch' (zip rgs list) (length xs)) xs = 0"
  1395         by simp
  1395         by simp
  1396     qed
  1396     qed
  1397     moreover have 
  1397     moreover have 
  1398       "Embranch (zip (map rec_exec rgs) 
  1398       "Embranch (zip (map rec_eval rgs) 
  1399           (map (\<lambda>r args. 0 < rec_exec r args) list)) xs = 0"
  1399           (map (\<lambda>r args. 0 < rec_eval r args) list)) xs = 0"
  1400       using g
  1400       using g
  1401       apply(rule_tac k = "length rgs" in Embranch_0)
  1401       apply(rule_tac k = "length rgs" in Embranch_0)
  1402       apply(simp, case_tac n, simp, simp)
  1402       apply(simp, case_tac n, simp, simp)
  1403       apply(case_tac rgs, simp, simp)
  1403       apply(case_tac rgs, simp, simp)
  1404       apply(auto)
  1404       apply(auto)
  1409       done
  1409       done
  1410     moreover have "arity a = length xs"
  1410     moreover have "arity a = length xs"
  1411       using g
  1411       using g
  1412       apply(auto)
  1412       apply(auto)
  1413       done
  1413       done
  1414     ultimately show "rec_exec (rec_embranch ((a, aa) # zip rgs list)) xs = 
  1414     ultimately show "rec_eval (rec_embranch ((a, aa) # zip rgs list)) xs = 
  1415       Embranch ((rec_exec a, \<lambda>args. 0 < rec_exec aa args) #
  1415       Embranch ((rec_eval a, \<lambda>args. 0 < rec_eval aa args) #
  1416            zip (map rec_exec rgs) (map (\<lambda>r args. 0 < rec_exec r args) list)) xs"
  1416            zip (map rec_eval rgs) (map (\<lambda>r args. 0 < rec_eval r args) list)) xs"
  1417       apply(simp add: rec_exec.simps rec_embranch.simps Embranch.simps)
  1417       apply(simp add: rec_eval.simps rec_embranch.simps Embranch.simps)
  1418       done
  1418       done
  1419   qed
  1419   qed
  1420 qed
  1420 qed
  1421 
  1421 
  1422 
  1422 
  1442        [Cn 3 rec_mult [id 3 1, id 3 2], id 3 0]))]"
  1442        [Cn 3 rec_mult [id 3 1, id 3 2], id 3 0]))]"
  1443 
  1443 
  1444 declare numeral_2_eq_2[simp del] numeral_3_eq_3[simp del]
  1444 declare numeral_2_eq_2[simp del] numeral_3_eq_3[simp del]
  1445 
  1445 
  1446 lemma exec_tmp: 
  1446 lemma exec_tmp: 
  1447   "rec_exec (rec_all (Cn 2 rec_minus [recf.id 2 0, Cn 2 (constn (Suc 0)) [recf.id 2 0]]) 
  1447   "rec_eval (rec_all (Cn 2 rec_minus [recf.id 2 0, Cn 2 (constn (Suc 0)) [recf.id 2 0]]) 
  1448   (Cn 3 rec_noteq [Cn 3 rec_mult [recf.id 3 (Suc 0), recf.id 3 2], recf.id 3 0]))  [x, k] = 
  1448   (Cn 3 rec_noteq [Cn 3 rec_mult [recf.id 3 (Suc 0), recf.id 3 2], recf.id 3 0]))  [x, k] = 
  1449   ((if (\<forall>w\<le>rec_exec (Cn 2 rec_minus [recf.id 2 0, Cn 2 (constn (Suc 0)) [recf.id 2 0]]) ([x, k]). 
  1449   ((if (\<forall>w\<le>rec_eval (Cn 2 rec_minus [recf.id 2 0, Cn 2 (constn (Suc 0)) [recf.id 2 0]]) ([x, k]). 
  1450   0 < rec_exec (Cn 3 rec_noteq [Cn 3 rec_mult [recf.id 3 (Suc 0), recf.id 3 2], recf.id 3 0])
  1450   0 < rec_eval (Cn 3 rec_noteq [Cn 3 rec_mult [recf.id 3 (Suc 0), recf.id 3 2], recf.id 3 0])
  1451   ([x, k] @ [w])) then 1 else 0))"
  1451   ([x, k] @ [w])) then 1 else 0))"
  1452 apply(rule_tac all_lemma)
  1452 apply(rule_tac all_lemma)
  1453 apply(auto)
  1453 apply(auto)
  1454 apply(case_tac [!] i, auto)
  1454 apply(case_tac [!] i, auto)
  1455 apply(case_tac ia, auto simp: numeral_3_eq_3 numeral_2_eq_2)
  1455 apply(case_tac ia, auto simp: numeral_3_eq_3 numeral_2_eq_2)
  1456 done
  1456 done
  1457 
  1457 
  1458 text {*
  1458 text {*
  1459   The correctness of @{text "Prime"}.
  1459   The correctness of @{text "Prime"}.
  1460   *}
  1460   *}
  1461 lemma prime_lemma: "rec_exec rec_prime [x] = (if prime x then 1 else 0)"
  1461 lemma prime_lemma: "rec_eval rec_prime [x] = (if prime x then 1 else 0)"
  1462 proof(simp add: rec_exec.simps rec_prime_def)
  1462 proof(simp add: rec_eval.simps rec_prime_def)
  1463   let ?rt1 = "(Cn 2 rec_minus [recf.id 2 0, 
  1463   let ?rt1 = "(Cn 2 rec_minus [recf.id 2 0, 
  1464     Cn 2 (constn (Suc 0)) [recf.id 2 0]])"
  1464     Cn 2 (constn (Suc 0)) [recf.id 2 0]])"
  1465   let ?rf1 = "(Cn 3 rec_noteq [Cn 3 rec_mult 
  1465   let ?rf1 = "(Cn 3 rec_noteq [Cn 3 rec_mult 
  1466     [recf.id 3 (Suc 0), recf.id 3 2], recf.id 3 (0)])"
  1466     [recf.id 3 (Suc 0), recf.id 3 2], recf.id 3 (0)])"
  1467   let ?rt2 = "(Cn (Suc 0) rec_minus 
  1467   let ?rt2 = "(Cn (Suc 0) rec_minus 
  1468     [recf.id (Suc 0) 0, constn (Suc 0)])"
  1468     [recf.id (Suc 0) 0, constn (Suc 0)])"
  1469   let ?rf2 = "rec_all ?rt1 ?rf1"
  1469   let ?rf2 = "rec_all ?rt1 ?rf1"
  1470   have h1: "rec_exec (rec_all ?rt2 ?rf2) ([x]) = 
  1470   have h1: "rec_eval (rec_all ?rt2 ?rf2) ([x]) = 
  1471         (if (\<forall>k\<le>rec_exec ?rt2 ([x]). 0 < rec_exec ?rf2 ([x] @ [k])) then 1 else 0)"
  1471         (if (\<forall>k\<le>rec_eval ?rt2 ([x]). 0 < rec_eval ?rf2 ([x] @ [k])) then 1 else 0)"
  1472   proof(rule_tac all_lemma, simp_all)
  1472   proof(rule_tac all_lemma, simp_all)
  1473     show "primerec ?rf2 (Suc (Suc 0))"
  1473     show "primerec ?rf2 (Suc (Suc 0))"
  1474       apply(rule_tac primerec_all_iff)
  1474       apply(rule_tac primerec_all_iff)
  1475       apply(auto)
  1475       apply(auto)
  1476       apply(case_tac [!] i, auto simp: numeral_2_eq_2)
  1476       apply(case_tac [!] i, auto simp: numeral_2_eq_2)
  1482       apply(auto)
  1482       apply(auto)
  1483       apply(case_tac i, auto)
  1483       apply(case_tac i, auto)
  1484       done
  1484       done
  1485   qed
  1485   qed
  1486   from h1 show 
  1486   from h1 show 
  1487    "(Suc 0 < x \<longrightarrow>  (rec_exec (rec_all ?rt2 ?rf2) [x] = 0 \<longrightarrow> 
  1487    "(Suc 0 < x \<longrightarrow>  (rec_eval (rec_all ?rt2 ?rf2) [x] = 0 \<longrightarrow> 
  1488     \<not> prime x) \<and>
  1488     \<not> prime x) \<and>
  1489      (0 < rec_exec (rec_all ?rt2 ?rf2) [x] \<longrightarrow> prime x)) \<and>
  1489      (0 < rec_eval (rec_all ?rt2 ?rf2) [x] \<longrightarrow> prime x)) \<and>
  1490     (\<not> Suc 0 < x \<longrightarrow> \<not> prime x \<and> (rec_exec (rec_all ?rt2 ?rf2) [x] = 0
  1490     (\<not> Suc 0 < x \<longrightarrow> \<not> prime x \<and> (rec_eval (rec_all ?rt2 ?rf2) [x] = 0
  1491     \<longrightarrow> \<not> prime x))"
  1491     \<longrightarrow> \<not> prime x))"
  1492     apply(auto simp:rec_exec.simps)
  1492     apply(auto simp:rec_eval.simps)
  1493     apply(simp add: exec_tmp rec_exec.simps)
  1493     apply(simp add: exec_tmp rec_eval.simps)
  1494   proof -
  1494   proof -
  1495     assume "\<forall>k\<le>x - Suc 0. (0::nat) < (if \<forall>w\<le>x - Suc 0. 
  1495     assume "\<forall>k\<le>x - Suc 0. (0::nat) < (if \<forall>w\<le>x - Suc 0. 
  1496            0 < (if k * w \<noteq> x then 1 else (0 :: nat)) then 1 else 0)" "Suc 0 < x"
  1496            0 < (if k * w \<noteq> x then 1 else (0 :: nat)) then 1 else 0)" "Suc 0 < x"
  1497     thus "prime x"
  1497     thus "prime x"
  1498       apply(simp add: rec_exec.simps split: if_splits)
  1498       apply(simp add: rec_eval.simps split: if_splits)
  1499       apply(simp add: prime_nat_def dvd_def, auto)
  1499       apply(simp add: prime_nat_def dvd_def, auto)
  1500       apply(erule_tac x = m in allE, auto)
  1500       apply(erule_tac x = m in allE, auto)
  1501       apply(case_tac m, simp, case_tac nat, simp, simp)
  1501       apply(case_tac m, simp, case_tac nat, simp, simp)
  1502       apply(case_tac k, simp, case_tac nat, simp, simp)
  1502       apply(case_tac k, simp, case_tac nat, simp, simp)
  1503       done
  1503       done
  1505     assume "\<not> Suc 0 < x" "prime x"
  1505     assume "\<not> Suc 0 < x" "prime x"
  1506     thus "False"
  1506     thus "False"
  1507       by (simp add: prime_nat_def)
  1507       by (simp add: prime_nat_def)
  1508   next
  1508   next
  1509     fix k
  1509     fix k
  1510     assume "rec_exec (rec_all ?rt1 ?rf1)
  1510     assume "rec_eval (rec_all ?rt1 ?rf1)
  1511       [x, k] = 0" "k \<le> x - Suc 0" "prime x"
  1511       [x, k] = 0" "k \<le> x - Suc 0" "prime x"
  1512     thus "False"
  1512     thus "False"
  1513       by (auto simp add: exec_tmp rec_exec.simps prime_nat_def dvd_def split: if_splits)
  1513       by (auto simp add: exec_tmp rec_eval.simps prime_nat_def dvd_def split: if_splits)
  1514   next
  1514   next
  1515     fix k
  1515     fix k
  1516     assume "rec_exec (rec_all ?rt1 ?rf1)
  1516     assume "rec_eval (rec_all ?rt1 ?rf1)
  1517       [x, k] = 0" "k \<le> x - Suc 0" "prime x"
  1517       [x, k] = 0" "k \<le> x - Suc 0" "prime x"
  1518     thus "False"
  1518     thus "False"
  1519       by(auto simp add: exec_tmp rec_exec.simps prime_nat_def dvd_def split: if_splits)
  1519       by(auto simp add: exec_tmp rec_eval.simps prime_nat_def dvd_def split: if_splits)
  1520   qed
  1520   qed
  1521 qed
  1521 qed
  1522 
  1522 
  1523 definition rec_dummyfac :: "recf"
  1523 definition rec_dummyfac :: "recf"
  1524   where
  1524   where
  1537 fun fac :: "nat \<Rightarrow> nat"  ("_!" [100] 99)
  1537 fun fac :: "nat \<Rightarrow> nat"  ("_!" [100] 99)
  1538   where
  1538   where
  1539   "fac 0 = 1" |
  1539   "fac 0 = 1" |
  1540   "fac (Suc x) = (Suc x) * fac x"
  1540   "fac (Suc x) = (Suc x) * fac x"
  1541 
  1541 
  1542 lemma [simp]: "rec_exec rec_dummyfac [0, 0] = Suc 0"
  1542 lemma [simp]: "rec_eval rec_dummyfac [0, 0] = Suc 0"
  1543 by(simp add: rec_dummyfac_def rec_exec.simps)
  1543 by(simp add: rec_dummyfac_def rec_eval.simps)
  1544 
  1544 
  1545 lemma rec_cn_simp: 
  1545 lemma rec_cn_simp: 
  1546   "rec_exec (Cn n f gs) xs = (let rgs = map (\<lambda> g. rec_exec g xs) gs in rec_exec f rgs)"
  1546   "rec_eval (Cn n f gs) xs = (let rgs = map (\<lambda> g. rec_eval g xs) gs in rec_eval f rgs)"
  1547 by(simp add: rec_exec.simps)
  1547 by(simp add: rec_eval.simps)
  1548 
  1548 
  1549 lemma rec_id_simp: "rec_exec (id m n) xs = xs ! n" 
  1549 lemma rec_id_simp: "rec_eval (id m n) xs = xs ! n" 
  1550   by(simp add: rec_exec.simps)
  1550   by(simp add: rec_eval.simps)
  1551 
  1551 
  1552 lemma fac_dummy: "rec_exec rec_dummyfac [x, y] = y !"
  1552 lemma fac_dummy: "rec_eval rec_dummyfac [x, y] = y !"
  1553 apply(induct y)
  1553 apply(induct y)
  1554 apply(auto simp: rec_dummyfac_def rec_exec.simps)
  1554 apply(auto simp: rec_dummyfac_def rec_eval.simps)
  1555 done
  1555 done
  1556 
  1556 
  1557 text {*
  1557 text {*
  1558   The correctness of @{text "rec_fac"}.
  1558   The correctness of @{text "rec_fac"}.
  1559   *}
  1559   *}
  1560 lemma fac_lemma: "rec_exec rec_fac [x] =  x!"
  1560 lemma fac_lemma: "rec_eval rec_fac [x] =  x!"
  1561 apply(simp add: rec_fac_def rec_exec.simps fac_dummy)
  1561 apply(simp add: rec_fac_def rec_eval.simps fac_dummy)
  1562 done
  1562 done
  1563 
  1563 
  1564 declare fac.simps[simp del]
  1564 declare fac.simps[simp del]
  1565 
  1565 
  1566 text {*
  1566 text {*
  1684 done
  1684 done
  1685 
  1685 
  1686 text {*
  1686 text {*
  1687   The correctness of @{text "rec_np"}.
  1687   The correctness of @{text "rec_np"}.
  1688   *}
  1688   *}
  1689 lemma np_lemma: "rec_exec rec_np [x] = Np x"
  1689 lemma np_lemma: "rec_eval rec_np [x] = Np x"
  1690 proof(auto simp: rec_np_def rec_exec.simps Let_def fac_lemma)
  1690 proof(auto simp: rec_np_def rec_eval.simps Let_def fac_lemma)
  1691   let ?rr = "(Cn 2 rec_conj [Cn 2 rec_less [recf.id 2 0,
  1691   let ?rr = "(Cn 2 rec_conj [Cn 2 rec_less [recf.id 2 0,
  1692     recf.id 2 (Suc 0)], Cn 2 rec_prime [recf.id 2 (Suc 0)]])"
  1692     recf.id 2 (Suc 0)], Cn 2 rec_prime [recf.id 2 (Suc 0)]])"
  1693   let ?R = "\<lambda> zs. zs ! 0 < zs ! 1 \<and> prime (zs ! 1)"
  1693   let ?R = "\<lambda> zs. zs ! 0 < zs ! 1 \<and> prime (zs ! 1)"
  1694   have g1: "rec_exec (rec_Minr ?rr) ([x] @ [Suc (x!)]) = 
  1694   have g1: "rec_eval (rec_Minr ?rr) ([x] @ [Suc (x!)]) = 
  1695     Minr (\<lambda> args. 0 < rec_exec ?rr args) [x] (Suc (x!))"
  1695     Minr (\<lambda> args. 0 < rec_eval ?rr args) [x] (Suc (x!))"
  1696     by(rule_tac Minr_lemma, auto simp: rec_exec.simps
  1696     by(rule_tac Minr_lemma, auto simp: rec_eval.simps
  1697       prime_lemma, auto simp:  numeral_2_eq_2 numeral_3_eq_3)
  1697       prime_lemma, auto simp:  numeral_2_eq_2 numeral_3_eq_3)
  1698   have g2: "Minr (\<lambda> args. 0 < rec_exec ?rr args) [x] (Suc (x!)) = Np x"
  1698   have g2: "Minr (\<lambda> args. 0 < rec_eval ?rr args) [x] (Suc (x!)) = Np x"
  1699     using prime_ex[of x]
  1699     using prime_ex[of x]
  1700     apply(auto simp: Minr.simps Np.simps rec_exec.simps)
  1700     apply(auto simp: Minr.simps Np.simps rec_eval.simps)
  1701     apply(erule_tac x = p in allE, simp add: prime_lemma)
  1701     apply(erule_tac x = p in allE, simp add: prime_lemma)
  1702     apply(simp add: prime_lemma split: if_splits)
  1702     apply(simp add: prime_lemma split: if_splits)
  1703     apply(subgoal_tac
  1703     apply(subgoal_tac
  1704    "{uu. (prime uu \<longrightarrow> (x < uu \<longrightarrow> uu \<le> Suc (x!)) \<and> x < uu) \<and> prime uu}
  1704    "{uu. (prime uu \<longrightarrow> (x < uu \<longrightarrow> uu \<le> Suc (x!)) \<and> x < uu) \<and> prime uu}
  1705     = {y. y \<le> Suc (x!) \<and> x < y \<and> prime y}", auto)
  1705     = {y. y \<le> Suc (x!) \<and> x < y \<and> prime y}", auto)
  1706     done
  1706     done
  1707   from g1 and g2 show "rec_exec (rec_Minr ?rr) ([x, Suc (x!)]) = Np x"
  1707   from g1 and g2 show "rec_eval (rec_Minr ?rr) ([x, Suc (x!)]) = Np x"
  1708     by simp
  1708     by simp
  1709 qed
  1709 qed
  1710 
  1710 
  1711 text {*
  1711 text {*
  1712   @{text "rec_power"} is the recursive function used to implement
  1712   @{text "rec_power"} is the recursive function used to implement
  1717   "rec_power = Pr 1 (constn 1) (Cn 3 rec_mult [id 3 0, id 3 2])"
  1717   "rec_power = Pr 1 (constn 1) (Cn 3 rec_mult [id 3 0, id 3 2])"
  1718 
  1718 
  1719 text {*
  1719 text {*
  1720   The correctness of @{text "rec_power"}.
  1720   The correctness of @{text "rec_power"}.
  1721   *}
  1721   *}
  1722 lemma power_lemma: "rec_exec rec_power [x, y] = x^y"
  1722 lemma power_lemma: "rec_eval rec_power [x, y] = x^y"
  1723   by(induct y, auto simp: rec_exec.simps rec_power_def)
  1723   by(induct y, auto simp: rec_eval.simps rec_power_def)
  1724 
  1724 
  1725 text{*
  1725 text{*
  1726   @{text "Pi k"} returns the @{text "k"}-th prime number.
  1726   @{text "Pi k"} returns the @{text "k"}-th prime number.
  1727   *}
  1727   *}
  1728 fun Pi :: "nat \<Rightarrow> nat"
  1728 fun Pi :: "nat \<Rightarrow> nat"
  1740   *}
  1740   *}
  1741 definition rec_pi :: "recf"
  1741 definition rec_pi :: "recf"
  1742   where
  1742   where
  1743   "rec_pi = Cn 1 rec_dummy_pi [id 1 0, id 1 0]"
  1743   "rec_pi = Cn 1 rec_dummy_pi [id 1 0, id 1 0]"
  1744 
  1744 
  1745 lemma pi_dummy_lemma: "rec_exec rec_dummy_pi [x, y] = Pi y"
  1745 lemma pi_dummy_lemma: "rec_eval rec_dummy_pi [x, y] = Pi y"
  1746 apply(induct y)
  1746 apply(induct y)
  1747 by(auto simp: rec_exec.simps rec_dummy_pi_def Pi.simps np_lemma)
  1747 by(auto simp: rec_eval.simps rec_dummy_pi_def Pi.simps np_lemma)
  1748 
  1748 
  1749 text {*
  1749 text {*
  1750   The correctness of @{text "rec_pi"}.
  1750   The correctness of @{text "rec_pi"}.
  1751   *}
  1751   *}
  1752 lemma pi_lemma: "rec_exec rec_pi [x] = Pi x"
  1752 lemma pi_lemma: "rec_eval rec_pi [x] = Pi x"
  1753 apply(simp add: rec_pi_def rec_exec.simps pi_dummy_lemma)
  1753 apply(simp add: rec_pi_def rec_eval.simps pi_dummy_lemma)
  1754 done
  1754 done
  1755 
  1755 
  1756 fun loR :: "nat list \<Rightarrow> bool"
  1756 fun loR :: "nat list \<Rightarrow> bool"
  1757   where
  1757   where
  1758   "loR [x, y, u] = (x mod (y^u) = 0)"
  1758   "loR [x, y, u] = (x mod (y^u) = 0)"
  1831              in Cn 2 rec_add [Cn 2 rec_mult [rb, rcond], 
  1831              in Cn 2 rec_add [Cn 2 rec_mult [rb, rcond], 
  1832                   Cn 2 rec_mult [Cn 2 (constn 0) [id 2 0], rcond2]])"
  1832                   Cn 2 rec_mult [Cn 2 (constn 0) [id 2 0], rcond2]])"
  1833 
  1833 
  1834 lemma rec_lo_Maxr_lor:
  1834 lemma rec_lo_Maxr_lor:
  1835   "\<lbrakk>Suc 0 < x; Suc 0 < y\<rbrakk> \<Longrightarrow>  
  1835   "\<lbrakk>Suc 0 < x; Suc 0 < y\<rbrakk> \<Longrightarrow>  
  1836         rec_exec rec_lo [x, y] = Maxr loR [x, y] x"
  1836         rec_eval rec_lo [x, y] = Maxr loR [x, y] x"
  1837 proof(auto simp: rec_exec.simps rec_lo_def Let_def 
  1837 proof(auto simp: rec_eval.simps rec_lo_def Let_def 
  1838     numeral_2_eq_2 numeral_3_eq_3)
  1838     numeral_2_eq_2 numeral_3_eq_3)
  1839   let ?rR = "(Cn (Suc (Suc (Suc 0))) rec_eq
  1839   let ?rR = "(Cn (Suc (Suc (Suc 0))) rec_eq
  1840      [Cn (Suc (Suc (Suc 0))) rec_mod [recf.id (Suc (Suc (Suc 0))) 0,
  1840      [Cn (Suc (Suc (Suc 0))) rec_mod [recf.id (Suc (Suc (Suc 0))) 0,
  1841      Cn (Suc (Suc (Suc 0))) rec_power [recf.id (Suc (Suc (Suc 0)))
  1841      Cn (Suc (Suc (Suc 0))) rec_power [recf.id (Suc (Suc (Suc 0)))
  1842      (Suc 0), recf.id (Suc (Suc (Suc 0))) (Suc (Suc 0))]],
  1842      (Suc 0), recf.id (Suc (Suc (Suc 0))) (Suc (Suc 0))]],
  1843      Cn (Suc (Suc (Suc 0))) (constn 0) [recf.id (Suc (Suc (Suc 0))) (Suc 0)]])"
  1843      Cn (Suc (Suc (Suc 0))) (constn 0) [recf.id (Suc (Suc (Suc 0))) (Suc 0)]])"
  1844   have h: "rec_exec (rec_maxr ?rR) ([x, y] @ [x]) =
  1844   have h: "rec_eval (rec_maxr ?rR) ([x, y] @ [x]) =
  1845     Maxr (\<lambda> args. 0 < rec_exec ?rR args) [x, y] x"
  1845     Maxr (\<lambda> args. 0 < rec_eval ?rR args) [x, y] x"
  1846     by(rule_tac Maxr_lemma, auto simp: rec_exec.simps
  1846     by(rule_tac Maxr_lemma, auto simp: rec_eval.simps
  1847       mod_lemma power_lemma, auto simp: numeral_2_eq_2 numeral_3_eq_3)
  1847       mod_lemma power_lemma, auto simp: numeral_2_eq_2 numeral_3_eq_3)
  1848   have "Maxr loR [x, y] x =  Maxr (\<lambda> args. 0 < rec_exec ?rR args) [x, y] x"
  1848   have "Maxr loR [x, y] x =  Maxr (\<lambda> args. 0 < rec_eval ?rR args) [x, y] x"
  1849     apply(simp add: rec_exec.simps mod_lemma power_lemma)
  1849     apply(simp add: rec_eval.simps mod_lemma power_lemma)
  1850     apply(simp add: Maxr.simps loR.simps)
  1850     apply(simp add: Maxr.simps loR.simps)
  1851     done
  1851     done
  1852   from h and this show "rec_exec (rec_maxr ?rR) [x, y, x] = 
  1852   from h and this show "rec_eval (rec_maxr ?rR) [x, y, x] = 
  1853     Maxr loR [x, y] x"
  1853     Maxr loR [x, y] x"
  1854     apply(simp)
  1854     apply(simp)
  1855     done
  1855     done
  1856 qed
  1856 qed
  1857 
  1857 
  1899 apply(simp add: Maxr.simps lo.simps, auto)
  1899 apply(simp add: Maxr.simps lo.simps, auto)
  1900 apply(erule_tac x = xa in allE, simp, simp add: uplimit_loR)
  1900 apply(erule_tac x = xa in allE, simp, simp add: uplimit_loR)
  1901 done
  1901 done
  1902 
  1902 
  1903 lemma lo_lemma': "\<lbrakk>Suc 0 < x; Suc 0 < y\<rbrakk> \<Longrightarrow> 
  1903 lemma lo_lemma': "\<lbrakk>Suc 0 < x; Suc 0 < y\<rbrakk> \<Longrightarrow> 
  1904   rec_exec rec_lo [x, y] = lo x y"
  1904   rec_eval rec_lo [x, y] = lo x y"
  1905 by(simp add: Maxr_lo  rec_lo_Maxr_lor)
  1905 by(simp add: Maxr_lo  rec_lo_Maxr_lor)
  1906 
  1906 
  1907 lemma lo_lemma'': "\<lbrakk>\<not> Suc 0 < x\<rbrakk> \<Longrightarrow> rec_exec rec_lo [x, y] = lo x y"
  1907 lemma lo_lemma'': "\<lbrakk>\<not> Suc 0 < x\<rbrakk> \<Longrightarrow> rec_eval rec_lo [x, y] = lo x y"
  1908 apply(case_tac x, auto simp: rec_exec.simps rec_lo_def 
  1908 apply(case_tac x, auto simp: rec_eval.simps rec_lo_def 
  1909   Let_def lo.simps)
  1909   Let_def lo.simps)
  1910 done
  1910 done
  1911   
  1911   
  1912 lemma lo_lemma''': "\<lbrakk>\<not> Suc 0 < y\<rbrakk> \<Longrightarrow> rec_exec rec_lo [x, y] = lo x y"
  1912 lemma lo_lemma''': "\<lbrakk>\<not> Suc 0 < y\<rbrakk> \<Longrightarrow> rec_eval rec_lo [x, y] = lo x y"
  1913 apply(case_tac y, auto simp: rec_exec.simps rec_lo_def 
  1913 apply(case_tac y, auto simp: rec_eval.simps rec_lo_def 
  1914   Let_def lo.simps)
  1914   Let_def lo.simps)
  1915 done
  1915 done
  1916 
  1916 
  1917 text {*
  1917 text {*
  1918   The correctness of @{text "rec_lo"}:
  1918   The correctness of @{text "rec_lo"}:
  1919 *}
  1919 *}
  1920 lemma lo_lemma: "rec_exec rec_lo [x, y] = lo x y" 
  1920 lemma lo_lemma: "rec_eval rec_lo [x, y] = lo x y" 
  1921 apply(case_tac "Suc 0 < x \<and> Suc 0 < y")
  1921 apply(case_tac "Suc 0 < x \<and> Suc 0 < y")
  1922 apply(auto simp: lo_lemma' lo_lemma'' lo_lemma''')
  1922 apply(auto simp: lo_lemma' lo_lemma'' lo_lemma''')
  1923 done
  1923 done
  1924 
  1924 
  1925 fun lgR :: "nat list \<Rightarrow> bool"
  1925 fun lgR :: "nat list \<Rightarrow> bool"
  1952       Cn 2 rec_add [Cn 2 rec_mult [conR1, Cn 2 (rec_maxr rec_lgR)
  1952       Cn 2 rec_add [Cn 2 rec_mult [conR1, Cn 2 (rec_maxr rec_lgR)
  1953                                                [id 2 0, id 2 1, id 2 0]], 
  1953                                                [id 2 0, id 2 1, id 2 0]], 
  1954                     Cn 2 rec_mult [conR2, Cn 2 (constn 0) [id 2 0]]])"
  1954                     Cn 2 rec_mult [conR2, Cn 2 (constn 0) [id 2 0]]])"
  1955 
  1955 
  1956 lemma lg_maxr: "\<lbrakk>Suc 0 < x; Suc 0 < y\<rbrakk> \<Longrightarrow> 
  1956 lemma lg_maxr: "\<lbrakk>Suc 0 < x; Suc 0 < y\<rbrakk> \<Longrightarrow> 
  1957                       rec_exec rec_lg [x, y] = Maxr lgR [x, y] x"
  1957                       rec_eval rec_lg [x, y] = Maxr lgR [x, y] x"
  1958 proof(simp add: rec_exec.simps rec_lg_def Let_def)
  1958 proof(simp add: rec_eval.simps rec_lg_def Let_def)
  1959   assume h: "Suc 0 < x" "Suc 0 < y"
  1959   assume h: "Suc 0 < x" "Suc 0 < y"
  1960   let ?rR = "(Cn 3 rec_le [Cn 3 rec_power
  1960   let ?rR = "(Cn 3 rec_le [Cn 3 rec_power
  1961                [recf.id 3 (Suc 0), recf.id 3 2], recf.id 3 0])"
  1961                [recf.id 3 (Suc 0), recf.id 3 2], recf.id 3 0])"
  1962   have "rec_exec (rec_maxr ?rR) ([x, y] @ [x])
  1962   have "rec_eval (rec_maxr ?rR) ([x, y] @ [x])
  1963               = Maxr ((\<lambda> args. 0 < rec_exec ?rR args)) [x, y] x" 
  1963               = Maxr ((\<lambda> args. 0 < rec_eval ?rR args)) [x, y] x" 
  1964   proof(rule Maxr_lemma)
  1964   proof(rule Maxr_lemma)
  1965     show "primerec (Cn 3 rec_le [Cn 3 rec_power 
  1965     show "primerec (Cn 3 rec_le [Cn 3 rec_power 
  1966               [recf.id 3 (Suc 0), recf.id 3 2], recf.id 3 0]) (Suc (length [x, y]))"
  1966               [recf.id 3 (Suc 0), recf.id 3 2], recf.id 3 0]) (Suc (length [x, y]))"
  1967       apply(auto simp: numeral_3_eq_3)+
  1967       apply(auto simp: numeral_3_eq_3)+
  1968       done
  1968       done
  1969   qed
  1969   qed
  1970   moreover have "Maxr lgR [x, y] x = Maxr ((\<lambda> args. 0 < rec_exec ?rR args)) [x, y] x"
  1970   moreover have "Maxr lgR [x, y] x = Maxr ((\<lambda> args. 0 < rec_eval ?rR args)) [x, y] x"
  1971     apply(simp add: rec_exec.simps power_lemma)
  1971     apply(simp add: rec_eval.simps power_lemma)
  1972     apply(simp add: Maxr.simps lgR.simps)
  1972     apply(simp add: Maxr.simps lgR.simps)
  1973     done 
  1973     done 
  1974   ultimately show "rec_exec (rec_maxr ?rR) [x, y, x] = Maxr lgR [x, y] x"
  1974   ultimately show "rec_eval (rec_maxr ?rR) [x, y, x] = Maxr lgR [x, y] x"
  1975     by simp
  1975     by simp
  1976 qed
  1976 qed
  1977 
  1977 
  1978 lemma [simp]: "\<lbrakk>Suc 0 < y; lgR [x, y, xa]\<rbrakk> \<Longrightarrow> xa \<le> x"
  1978 lemma [simp]: "\<lbrakk>Suc 0 < y; lgR [x, y, xa]\<rbrakk> \<Longrightarrow> xa \<le> x"
  1979 apply(simp add: lgR.simps)
  1979 apply(simp add: lgR.simps)
  1989 lemma maxr_lg: "\<lbrakk>Suc 0 < x; Suc 0 < y\<rbrakk> \<Longrightarrow> Maxr lgR [x, y] x = lg x y"
  1989 lemma maxr_lg: "\<lbrakk>Suc 0 < x; Suc 0 < y\<rbrakk> \<Longrightarrow> Maxr lgR [x, y] x = lg x y"
  1990 apply(simp add: lg.simps Maxr.simps, auto)
  1990 apply(simp add: lg.simps Maxr.simps, auto)
  1991 apply(erule_tac x = xa in allE, simp)
  1991 apply(erule_tac x = xa in allE, simp)
  1992 done
  1992 done
  1993 
  1993 
  1994 lemma lg_lemma': "\<lbrakk>Suc 0 < x; Suc 0 < y\<rbrakk> \<Longrightarrow> rec_exec rec_lg [x, y] = lg x y"
  1994 lemma lg_lemma': "\<lbrakk>Suc 0 < x; Suc 0 < y\<rbrakk> \<Longrightarrow> rec_eval rec_lg [x, y] = lg x y"
  1995 apply(simp add: maxr_lg lg_maxr)
  1995 apply(simp add: maxr_lg lg_maxr)
  1996 done
  1996 done
  1997 
  1997 
  1998 lemma lg_lemma'': "\<not> Suc 0 < x \<Longrightarrow> rec_exec rec_lg [x, y] = lg x y"
  1998 lemma lg_lemma'': "\<not> Suc 0 < x \<Longrightarrow> rec_eval rec_lg [x, y] = lg x y"
  1999 apply(simp add: rec_exec.simps rec_lg_def Let_def lg.simps)
  1999 apply(simp add: rec_eval.simps rec_lg_def Let_def lg.simps)
  2000 done
  2000 done
  2001 
  2001 
  2002 lemma lg_lemma''': "\<not> Suc 0 < y \<Longrightarrow> rec_exec rec_lg [x, y] = lg x y"
  2002 lemma lg_lemma''': "\<not> Suc 0 < y \<Longrightarrow> rec_eval rec_lg [x, y] = lg x y"
  2003 apply(simp add: rec_exec.simps rec_lg_def Let_def lg.simps)
  2003 apply(simp add: rec_eval.simps rec_lg_def Let_def lg.simps)
  2004 done
  2004 done
  2005 
  2005 
  2006 text {*
  2006 text {*
  2007   The correctness of @{text "rec_lg"}.
  2007   The correctness of @{text "rec_lg"}.
  2008   *}
  2008   *}
  2009 lemma lg_lemma: "rec_exec rec_lg [x, y] = lg x y"
  2009 lemma lg_lemma: "rec_eval rec_lg [x, y] = lg x y"
  2010 apply(case_tac "Suc 0 < x \<and> Suc 0 < y", auto simp: 
  2010 apply(case_tac "Suc 0 < x \<and> Suc 0 < y", auto simp: 
  2011                             lg_lemma' lg_lemma'' lg_lemma''')
  2011                             lg_lemma' lg_lemma'' lg_lemma''')
  2012 done
  2012 done
  2013 
  2013 
  2014 text {*
  2014 text {*
  2030 declare Pi.simps[simp del]
  2030 declare Pi.simps[simp del]
  2031 
  2031 
  2032 text {*
  2032 text {*
  2033   The correctness of @{text "rec_entry"}.
  2033   The correctness of @{text "rec_entry"}.
  2034   *}
  2034   *}
  2035 lemma entry_lemma: "rec_exec rec_entry [str, i] = Entry str i"
  2035 lemma entry_lemma: "rec_eval rec_entry [str, i] = Entry str i"
  2036   by(simp add: rec_entry_def  rec_exec.simps lo_lemma pi_lemma)
  2036   by(simp add: rec_entry_def  rec_eval.simps lo_lemma pi_lemma)
  2037 
  2037 
  2038 
  2038 
  2039 subsection {* The construction of F *}
  2039 subsection {* The construction of F *}
  2040 
  2040 
  2041 text {*
  2041 text {*
  2055 | "rec_listsum2 vl (Suc n) = Cn vl rec_add [rec_listsum2 vl n, id vl n]"
  2055 | "rec_listsum2 vl (Suc n) = Cn vl rec_add [rec_listsum2 vl n, id vl n]"
  2056 
  2056 
  2057 declare listsum2.simps[simp del] rec_listsum2.simps[simp del]
  2057 declare listsum2.simps[simp del] rec_listsum2.simps[simp del]
  2058 
  2058 
  2059 lemma listsum2_lemma: "\<lbrakk>length xs = vl; n \<le> vl\<rbrakk> \<Longrightarrow> 
  2059 lemma listsum2_lemma: "\<lbrakk>length xs = vl; n \<le> vl\<rbrakk> \<Longrightarrow> 
  2060       rec_exec (rec_listsum2 vl n) xs = listsum2 xs n"
  2060       rec_eval (rec_listsum2 vl n) xs = listsum2 xs n"
  2061 apply(induct n, simp_all)
  2061 apply(induct n, simp_all)
  2062 apply(simp_all add: rec_exec.simps rec_listsum2.simps listsum2.simps)
  2062 apply(simp_all add: rec_eval.simps rec_listsum2.simps listsum2.simps)
  2063 done
  2063 done
  2064 
  2064 
  2065 fun strt' :: "nat list \<Rightarrow> nat \<Rightarrow> nat"
  2065 fun strt' :: "nat list \<Rightarrow> nat \<Rightarrow> nat"
  2066   where
  2066   where
  2067   "strt' xs 0 = 0"
  2067   "strt' xs 0 = 0"
  2079   Cn vl rec_power [Cn vl (constn 2) [id vl 0], rec_dbound]]])"
  2079   Cn vl rec_power [Cn vl (constn 2) [id vl 0], rec_dbound]]])"
  2080 
  2080 
  2081 declare strt'.simps[simp del] rec_strt'.simps[simp del]
  2081 declare strt'.simps[simp del] rec_strt'.simps[simp del]
  2082 
  2082 
  2083 lemma strt'_lemma: "\<lbrakk>length xs = vl; n \<le> vl\<rbrakk> \<Longrightarrow> 
  2083 lemma strt'_lemma: "\<lbrakk>length xs = vl; n \<le> vl\<rbrakk> \<Longrightarrow> 
  2084   rec_exec (rec_strt' vl n) xs = strt' xs n"
  2084   rec_eval (rec_strt' vl n) xs = strt' xs n"
  2085 apply(induct n)
  2085 apply(induct n)
  2086 apply(simp_all add: rec_exec.simps rec_strt'.simps strt'.simps
  2086 apply(simp_all add: rec_eval.simps rec_strt'.simps strt'.simps
  2087   Let_def power_lemma listsum2_lemma)
  2087   Let_def power_lemma listsum2_lemma)
  2088 done
  2088 done
  2089 
  2089 
  2090 text {*
  2090 text {*
  2091   @{text "strt"} corresponds to the @{text "strt"} function on page 90 of B book, but 
  2091   @{text "strt"} corresponds to the @{text "strt"} function on page 90 of B book, but 
  2106 fun rec_strt :: "nat \<Rightarrow> recf"
  2106 fun rec_strt :: "nat \<Rightarrow> recf"
  2107   where
  2107   where
  2108   "rec_strt vl = Cn vl (rec_strt' vl vl) (rec_map s vl)"
  2108   "rec_strt vl = Cn vl (rec_strt' vl vl) (rec_map s vl)"
  2109 
  2109 
  2110 lemma map_s_lemma: "length xs = vl \<Longrightarrow> 
  2110 lemma map_s_lemma: "length xs = vl \<Longrightarrow> 
  2111   map ((\<lambda>a. rec_exec a xs) \<circ> (\<lambda>i. Cn vl s [recf.id vl i]))
  2111   map ((\<lambda>a. rec_eval a xs) \<circ> (\<lambda>i. Cn vl s [recf.id vl i]))
  2112   [0..<vl]
  2112   [0..<vl]
  2113         = map Suc xs"
  2113         = map Suc xs"
  2114 apply(induct vl arbitrary: xs, simp, auto simp: rec_exec.simps)
  2114 apply(induct vl arbitrary: xs, simp, auto simp: rec_eval.simps)
  2115 apply(subgoal_tac "\<exists> ys y. xs = ys @ [y]", auto)
  2115 apply(subgoal_tac "\<exists> ys y. xs = ys @ [y]", auto)
  2116 proof -
  2116 proof -
  2117   fix ys y
  2117   fix ys y
  2118   assume ind: "\<And>xs. length xs = length (ys::nat list) \<Longrightarrow>
  2118   assume ind: "\<And>xs. length xs = length (ys::nat list) \<Longrightarrow>
  2119       map ((\<lambda>a. rec_exec a xs) \<circ> (\<lambda>i. Cn (length ys) s 
  2119       map ((\<lambda>a. rec_eval a xs) \<circ> (\<lambda>i. Cn (length ys) s 
  2120         [recf.id (length ys) (i)])) [0..<length ys] = map Suc xs"
  2120         [recf.id (length ys) (i)])) [0..<length ys] = map Suc xs"
  2121   show
  2121   show
  2122     "map ((\<lambda>a. rec_exec a (ys @ [y])) \<circ> (\<lambda>i. Cn (Suc (length ys)) s 
  2122     "map ((\<lambda>a. rec_eval a (ys @ [y])) \<circ> (\<lambda>i. Cn (Suc (length ys)) s 
  2123   [recf.id (Suc (length ys)) (i)])) [0..<length ys] = map Suc ys"
  2123   [recf.id (Suc (length ys)) (i)])) [0..<length ys] = map Suc ys"
  2124   proof -
  2124   proof -
  2125     have "map ((\<lambda>a. rec_exec a ys) \<circ> (\<lambda>i. Cn (length ys) s
  2125     have "map ((\<lambda>a. rec_eval a ys) \<circ> (\<lambda>i. Cn (length ys) s
  2126         [recf.id (length ys) (i)])) [0..<length ys] = map Suc ys"
  2126         [recf.id (length ys) (i)])) [0..<length ys] = map Suc ys"
  2127       apply(rule_tac ind, simp)
  2127       apply(rule_tac ind, simp)
  2128       done
  2128       done
  2129     moreover have
  2129     moreover have
  2130       "map ((\<lambda>a. rec_exec a (ys @ [y])) \<circ> (\<lambda>i. Cn (Suc (length ys)) s
  2130       "map ((\<lambda>a. rec_eval a (ys @ [y])) \<circ> (\<lambda>i. Cn (Suc (length ys)) s
  2131            [recf.id (Suc (length ys)) (i)])) [0..<length ys]
  2131            [recf.id (Suc (length ys)) (i)])) [0..<length ys]
  2132          = map ((\<lambda>a. rec_exec a ys) \<circ> (\<lambda>i. Cn (length ys) s 
  2132          = map ((\<lambda>a. rec_eval a ys) \<circ> (\<lambda>i. Cn (length ys) s 
  2133                  [recf.id (length ys) (i)])) [0..<length ys]"
  2133                  [recf.id (length ys) (i)])) [0..<length ys]"
  2134       apply(rule_tac map_ext, auto simp: rec_exec.simps nth_append)
  2134       apply(rule_tac map_ext, auto simp: rec_eval.simps nth_append)
  2135       done
  2135       done
  2136     ultimately show "?thesis"
  2136     ultimately show "?thesis"
  2137       by simp
  2137       by simp
  2138   qed
  2138   qed
  2139 next
  2139 next
  2147 
  2147 
  2148 text {*
  2148 text {*
  2149   The correctness of @{text "rec_strt"}.
  2149   The correctness of @{text "rec_strt"}.
  2150   *}
  2150   *}
  2151 lemma strt_lemma: "length xs = vl \<Longrightarrow> 
  2151 lemma strt_lemma: "length xs = vl \<Longrightarrow> 
  2152   rec_exec (rec_strt vl) xs = strt xs"
  2152   rec_eval (rec_strt vl) xs = strt xs"
  2153 apply(simp add: strt.simps rec_exec.simps strt'_lemma)
  2153 apply(simp add: strt.simps rec_eval.simps strt'_lemma)
  2154 apply(subgoal_tac "(map ((\<lambda>a. rec_exec a xs) \<circ> (\<lambda>i. Cn vl s [recf.id vl (i)])) [0..<vl])
  2154 apply(subgoal_tac "(map ((\<lambda>a. rec_eval a xs) \<circ> (\<lambda>i. Cn vl s [recf.id vl (i)])) [0..<vl])
  2155                   = map Suc xs", auto)
  2155                   = map Suc xs", auto)
  2156 apply(rule map_s_lemma, simp)
  2156 apply(rule map_s_lemma, simp)
  2157 done
  2157 done
  2158 
  2158 
  2159 text {*
  2159 text {*
  2170   where "rec_scan = Cn 1 rec_mod [id 1 0, constn 2]"
  2170   where "rec_scan = Cn 1 rec_mod [id 1 0, constn 2]"
  2171 
  2171 
  2172 text {*
  2172 text {*
  2173   The correctness of @{text "scan"}.
  2173   The correctness of @{text "scan"}.
  2174   *}
  2174   *}
  2175 lemma scan_lemma: "rec_exec rec_scan [r] = r mod 2"
  2175 lemma scan_lemma: "rec_eval rec_scan [r] = r mod 2"
  2176   by(simp add: rec_exec.simps rec_scan_def mod_lemma)
  2176   by(simp add: rec_eval.simps rec_scan_def mod_lemma)
  2177 
  2177 
  2178 fun newleft0 :: "nat list \<Rightarrow> nat"
  2178 fun newleft0 :: "nat list \<Rightarrow> nat"
  2179   where
  2179   where
  2180   "newleft0 [p, r] = p"
  2180   "newleft0 [p, r] = p"
  2181 
  2181 
  2293 
  2293 
  2294 text {*
  2294 text {*
  2295   The correctness of @{text "rec_newleft"}.
  2295   The correctness of @{text "rec_newleft"}.
  2296   *}
  2296   *}
  2297 lemma newleft_lemma: 
  2297 lemma newleft_lemma: 
  2298   "rec_exec rec_newleft [p, r, a] = newleft p r a"
  2298   "rec_eval rec_newleft [p, r, a] = newleft p r a"
  2299 proof(simp only: rec_newleft_def Let_def)
  2299 proof(simp only: rec_newleft_def Let_def)
  2300   let ?rgs = "[Cn 3 rec_newleft0 [recf.id 3 0, recf.id 3 1], Cn 3 rec_newleft2 
  2300   let ?rgs = "[Cn 3 rec_newleft0 [recf.id 3 0, recf.id 3 1], Cn 3 rec_newleft2 
  2301        [recf.id 3 0, recf.id 3 1], Cn 3 rec_newleft3 [recf.id 3 0, recf.id 3 1], recf.id 3 0]"
  2301        [recf.id 3 0, recf.id 3 1], Cn 3 rec_newleft3 [recf.id 3 0, recf.id 3 1], recf.id 3 0]"
  2302   let ?rrs = 
  2302   let ?rrs = 
  2303     "[Cn 3 rec_disj [Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 0) 
  2303     "[Cn 3 rec_disj [Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 0) 
  2304      [recf.id 3 0]], Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 1) [recf.id 3 0]]], 
  2304      [recf.id 3 0]], Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 1) [recf.id 3 0]]], 
  2305      Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 2) [recf.id 3 0]],
  2305      Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 2) [recf.id 3 0]],
  2306      Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 3) [recf.id 3 0]],
  2306      Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 3) [recf.id 3 0]],
  2307      Cn 3 rec_less [Cn 3 (constn 3) [recf.id 3 0], recf.id 3 2]]"
  2307      Cn 3 rec_less [Cn 3 (constn 3) [recf.id 3 0], recf.id 3 2]]"
  2308   have k1: "rec_exec (rec_embranch (zip ?rgs ?rrs)) [p, r, a]
  2308   have k1: "rec_eval (rec_embranch (zip ?rgs ?rrs)) [p, r, a]
  2309                          = Embranch (zip (map rec_exec ?rgs) (map (\<lambda>r args. 0 < rec_exec r args) ?rrs)) [p, r, a]"
  2309                          = Embranch (zip (map rec_eval ?rgs) (map (\<lambda>r args. 0 < rec_eval r args) ?rrs)) [p, r, a]"
  2310     apply(rule_tac embranch_lemma )
  2310     apply(rule_tac embranch_lemma )
  2311     apply(auto simp: numeral_3_eq_3 numeral_2_eq_2 rec_newleft0_def 
  2311     apply(auto simp: numeral_3_eq_3 numeral_2_eq_2 rec_newleft0_def 
  2312              rec_newleft1_def rec_newleft2_def rec_newleft3_def)+
  2312              rec_newleft1_def rec_newleft2_def rec_newleft3_def)+
  2313     apply(case_tac "a = 0 \<or> a = 1", rule_tac x = 0 in exI)
  2313     apply(case_tac "a = 0 \<or> a = 1", rule_tac x = 0 in exI)
  2314     prefer 2
  2314     prefer 2
  2315     apply(case_tac "a = 2", rule_tac x = "Suc 0" in exI)
  2315     apply(case_tac "a = 2", rule_tac x = "Suc 0" in exI)
  2316     prefer 2
  2316     prefer 2
  2317     apply(case_tac "a = 3", rule_tac x = "2" in exI)
  2317     apply(case_tac "a = 3", rule_tac x = "2" in exI)
  2318     prefer 2
  2318     prefer 2
  2319     apply(case_tac "a > 3", rule_tac x = "3" in exI, auto)
  2319     apply(case_tac "a > 3", rule_tac x = "3" in exI, auto)
  2320     apply(auto simp: rec_exec.simps)
  2320     apply(auto simp: rec_eval.simps)
  2321     apply(erule_tac [!] Suc_Suc_Suc_Suc_induct, auto simp: rec_exec.simps)
  2321     apply(erule_tac [!] Suc_Suc_Suc_Suc_induct, auto simp: rec_eval.simps)
  2322     done
  2322     done
  2323   have k2: "Embranch (zip (map rec_exec ?rgs) (map (\<lambda>r args. 0 < rec_exec r args) ?rrs)) [p, r, a] = newleft p r a"
  2323   have k2: "Embranch (zip (map rec_eval ?rgs) (map (\<lambda>r args. 0 < rec_eval r args) ?rrs)) [p, r, a] = newleft p r a"
  2324     apply(simp add: Embranch.simps)
  2324     apply(simp add: Embranch.simps)
  2325     apply(simp add: rec_exec.simps)
  2325     apply(simp add: rec_eval.simps)
  2326     apply(auto simp: newleft.simps rec_newleft0_def rec_exec.simps
  2326     apply(auto simp: newleft.simps rec_newleft0_def rec_eval.simps
  2327                      rec_newleft1_def rec_newleft2_def rec_newleft3_def)
  2327                      rec_newleft1_def rec_newleft2_def rec_newleft3_def)
  2328     done
  2328     done
  2329   from k1 and k2 show 
  2329   from k1 and k2 show 
  2330    "rec_exec (rec_embranch (zip ?rgs ?rrs)) [p, r, a] = newleft p r a"
  2330    "rec_eval (rec_embranch (zip ?rgs ?rrs)) [p, r, a] = newleft p r a"
  2331     by simp
  2331     by simp
  2332 qed
  2332 qed
  2333 
  2333 
  2334 text {* 
  2334 text {* 
  2335   The @{text "newrght"} function is one similar to @{text "newleft"}, but used to 
  2335   The @{text "newrght"} function is one similar to @{text "newleft"}, but used to 
  2382 done
  2382 done
  2383 
  2383 
  2384 text {*
  2384 text {*
  2385   The correctness of @{text "rec_newrght"}.
  2385   The correctness of @{text "rec_newrght"}.
  2386   *}
  2386   *}
  2387 lemma newrght_lemma: "rec_exec rec_newrght [p, r, a] = newrght p r a"
  2387 lemma newrght_lemma: "rec_eval rec_newrght [p, r, a] = newrght p r a"
  2388 proof(simp only: rec_newrght_def Let_def)
  2388 proof(simp only: rec_newrght_def Let_def)
  2389   let ?gs' = "[newrgt0, newrgt1, newrgt2, newrgt3, \<lambda> zs. zs ! 1]"
  2389   let ?gs' = "[newrgt0, newrgt1, newrgt2, newrgt3, \<lambda> zs. zs ! 1]"
  2390   let ?r0 = "\<lambda> zs. zs ! 2 = 0"
  2390   let ?r0 = "\<lambda> zs. zs ! 2 = 0"
  2391   let ?r1 = "\<lambda> zs. zs ! 2 = 1"
  2391   let ?r1 = "\<lambda> zs. zs ! 2 = 1"
  2392   let ?r2 = "\<lambda> zs. zs ! 2 = 2"
  2392   let ?r2 = "\<lambda> zs. zs ! 2 = 2"
  2403  "[Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 0) [recf.id 3 0]], Cn 3 rec_eq [recf.id 3 2, 
  2403  "[Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 0) [recf.id 3 0]], Cn 3 rec_eq [recf.id 3 2, 
  2404     Cn 3 (constn 1) [recf.id 3 0]], Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 2) [recf.id 3 0]],
  2404     Cn 3 (constn 1) [recf.id 3 0]], Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 2) [recf.id 3 0]],
  2405      Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 3) [recf.id 3 0]], 
  2405      Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 3) [recf.id 3 0]], 
  2406        Cn 3 rec_less [Cn 3 (constn 3) [recf.id 3 0], recf.id 3 2]]"
  2406        Cn 3 rec_less [Cn 3 (constn 3) [recf.id 3 0], recf.id 3 2]]"
  2407     
  2407     
  2408   have k1: "rec_exec (rec_embranch (zip ?rgs ?rrs)) [p, r, a]
  2408   have k1: "rec_eval (rec_embranch (zip ?rgs ?rrs)) [p, r, a]
  2409     = Embranch (zip (map rec_exec ?rgs) (map (\<lambda>r args. 0 < rec_exec r args) ?rrs)) [p, r, a]"
  2409     = Embranch (zip (map rec_eval ?rgs) (map (\<lambda>r args. 0 < rec_eval r args) ?rrs)) [p, r, a]"
  2410     apply(rule_tac embranch_lemma)
  2410     apply(rule_tac embranch_lemma)
  2411     apply(auto simp: numeral_3_eq_3 numeral_2_eq_2 rec_newrgt0_def 
  2411     apply(auto simp: numeral_3_eq_3 numeral_2_eq_2 rec_newrgt0_def 
  2412              rec_newrgt1_def rec_newrgt2_def rec_newrgt3_def)+
  2412              rec_newrgt1_def rec_newrgt2_def rec_newrgt3_def)+
  2413     apply(case_tac "a = 0", rule_tac x = 0 in exI)
  2413     apply(case_tac "a = 0", rule_tac x = 0 in exI)
  2414     prefer 2
  2414     prefer 2
  2416     prefer 2
  2416     prefer 2
  2417     apply(case_tac "a = 2", rule_tac x = "2" in exI)
  2417     apply(case_tac "a = 2", rule_tac x = "2" in exI)
  2418     prefer 2
  2418     prefer 2
  2419     apply(case_tac "a = 3", rule_tac x = "3" in exI)
  2419     apply(case_tac "a = 3", rule_tac x = "3" in exI)
  2420     prefer 2
  2420     prefer 2
  2421     apply(case_tac "a > 3", rule_tac x = "4" in exI, auto simp: rec_exec.simps)
  2421     apply(case_tac "a > 3", rule_tac x = "4" in exI, auto simp: rec_eval.simps)
  2422     apply(erule_tac [!] Suc_5_induct, auto simp: rec_exec.simps)
  2422     apply(erule_tac [!] Suc_5_induct, auto simp: rec_eval.simps)
  2423     done
  2423     done
  2424   have k2: "Embranch (zip (map rec_exec ?rgs)
  2424   have k2: "Embranch (zip (map rec_eval ?rgs)
  2425     (map (\<lambda>r args. 0 < rec_exec r args) ?rrs)) [p, r, a] = newrght p r a"
  2425     (map (\<lambda>r args. 0 < rec_eval r args) ?rrs)) [p, r, a] = newrght p r a"
  2426     apply(auto simp:Embranch.simps rec_exec.simps)
  2426     apply(auto simp:Embranch.simps rec_eval.simps)
  2427     apply(auto simp: newrght.simps rec_newrgt3_def rec_newrgt2_def
  2427     apply(auto simp: newrght.simps rec_newrgt3_def rec_newrgt2_def
  2428                      rec_newrgt1_def rec_newrgt0_def rec_exec.simps
  2428                      rec_newrgt1_def rec_newrgt0_def rec_eval.simps
  2429                      scan_lemma)
  2429                      scan_lemma)
  2430     done
  2430     done
  2431   from k1 and k2 show 
  2431   from k1 and k2 show 
  2432     "rec_exec (rec_embranch (zip ?rgs ?rrs)) [p, r, a] =      
  2432     "rec_eval (rec_embranch (zip ?rgs ?rrs)) [p, r, a] =      
  2433                                     newrght p r a" by simp
  2433                                     newrght p r a" by simp
  2434 qed
  2434 qed
  2435 
  2435 
  2436 declare Entry.simps[simp del]
  2436 declare Entry.simps[simp del]
  2437 
  2437 
  2464              Cn 3 rec_eq [id 3 1, Cn 3 (constn 0) [id 3 0]]]] "
  2464              Cn 3 rec_eq [id 3 1, Cn 3 (constn 0) [id 3 0]]]] "
  2465 
  2465 
  2466 text {*
  2466 text {*
  2467   The correctness of @{text "actn"}.
  2467   The correctness of @{text "actn"}.
  2468   *}
  2468   *}
  2469 lemma actn_lemma: "rec_exec rec_actn [m, q, r] = actn m q r"
  2469 lemma actn_lemma: "rec_eval rec_actn [m, q, r] = actn m q r"
  2470   by(auto simp: rec_actn_def rec_exec.simps entry_lemma scan_lemma)
  2470   by(auto simp: rec_actn_def rec_eval.simps entry_lemma scan_lemma)
  2471 
  2471 
  2472 fun newstat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
  2472 fun newstat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
  2473   where
  2473   where
  2474   "newstat m q r = (if q \<noteq> 0 then Entry m (4*(q - 1) + 2*scan r + 1)
  2474   "newstat m q r = (if q \<noteq> 0 then Entry m (4*(q - 1) + 2*scan r + 1)
  2475                     else 0)"
  2475                     else 0)"
  2484            Cn 3 rec_scan [id 3 2]], Cn 3 (constn 1) [id 3 0]]]], 
  2484            Cn 3 rec_scan [id 3 2]], Cn 3 (constn 1) [id 3 0]]]], 
  2485            Cn 3 rec_noteq [id 3 1, Cn 3 (constn 0) [id 3 0]]], 
  2485            Cn 3 rec_noteq [id 3 1, Cn 3 (constn 0) [id 3 0]]], 
  2486            Cn 3 rec_mult [Cn 3 (constn 0) [id 3 0], 
  2486            Cn 3 rec_mult [Cn 3 (constn 0) [id 3 0], 
  2487            Cn 3 rec_eq [id 3 1, Cn 3 (constn 0) [id 3 0]]]] "
  2487            Cn 3 rec_eq [id 3 1, Cn 3 (constn 0) [id 3 0]]]] "
  2488 
  2488 
  2489 lemma newstat_lemma: "rec_exec rec_newstat [m, q, r] = newstat m q r"
  2489 lemma newstat_lemma: "rec_eval rec_newstat [m, q, r] = newstat m q r"
  2490 by(auto simp:  rec_exec.simps entry_lemma scan_lemma rec_newstat_def)
  2490 by(auto simp:  rec_eval.simps entry_lemma scan_lemma rec_newstat_def)
  2491 
  2491 
  2492 declare newstat.simps[simp del] actn.simps[simp del]
  2492 declare newstat.simps[simp del] actn.simps[simp del]
  2493 
  2493 
  2494 text{*code the configuration*}
  2494 text{*code the configuration*}
  2495 
  2495 
  2502   "rec_trpl = Cn 3 rec_mult [Cn 3 rec_mult 
  2502   "rec_trpl = Cn 3 rec_mult [Cn 3 rec_mult 
  2503        [Cn 3 rec_power [Cn 3 (constn (Pi 0)) [id 3 0], id 3 0], 
  2503        [Cn 3 rec_power [Cn 3 (constn (Pi 0)) [id 3 0], id 3 0], 
  2504         Cn 3 rec_power [Cn 3 (constn (Pi 1)) [id 3 0], id 3 1]],
  2504         Cn 3 rec_power [Cn 3 (constn (Pi 1)) [id 3 0], id 3 1]],
  2505         Cn 3 rec_power [Cn 3 (constn (Pi 2)) [id 3 0], id 3 2]]"
  2505         Cn 3 rec_power [Cn 3 (constn (Pi 2)) [id 3 0], id 3 2]]"
  2506 declare trpl.simps[simp del]
  2506 declare trpl.simps[simp del]
  2507 lemma trpl_lemma: "rec_exec rec_trpl [p, q, r] = trpl p q r"
  2507 lemma trpl_lemma: "rec_eval rec_trpl [p, q, r] = trpl p q r"
  2508 by(auto simp: rec_trpl_def rec_exec.simps power_lemma trpl.simps)
  2508 by(auto simp: rec_trpl_def rec_eval.simps power_lemma trpl.simps)
  2509 
  2509 
  2510 text{*left, stat, rght: decode func*}
  2510 text{*left, stat, rght: decode func*}
  2511 fun left :: "nat \<Rightarrow> nat"
  2511 fun left :: "nat \<Rightarrow> nat"
  2512   where
  2512   where
  2513   "left c = lo c (Pi 0)"
  2513   "left c = lo c (Pi 0)"
  2553                   [Cn vl (constn 0) [id vl 0], 
  2553                   [Cn vl (constn 0) [id vl 0], 
  2554                    Cn vl (constn 1) [id vl 0], 
  2554                    Cn vl (constn 1) [id vl 0], 
  2555                    Cn vl (rec_strt (vl - 1)) 
  2555                    Cn vl (rec_strt (vl - 1)) 
  2556                         (map (\<lambda> i. id vl (i)) [1..<vl])]"
  2556                         (map (\<lambda> i. id vl (i)) [1..<vl])]"
  2557 
  2557 
  2558 lemma left_lemma: "rec_exec rec_left [c] = left c"
  2558 lemma left_lemma: "rec_eval rec_left [c] = left c"
  2559 by(simp add: rec_exec.simps rec_left_def left.simps lo_lemma)
  2559 by(simp add: rec_eval.simps rec_left_def left.simps lo_lemma)
  2560       
  2560       
  2561 lemma right_lemma: "rec_exec rec_right [c] = rght c"
  2561 lemma right_lemma: "rec_eval rec_right [c] = rght c"
  2562 by(simp add: rec_exec.simps rec_right_def rght.simps lo_lemma)
  2562 by(simp add: rec_eval.simps rec_right_def rght.simps lo_lemma)
  2563 
  2563 
  2564 lemma stat_lemma: "rec_exec rec_stat [c] = stat c"
  2564 lemma stat_lemma: "rec_eval rec_stat [c] = stat c"
  2565 by(simp add: rec_exec.simps rec_stat_def stat.simps lo_lemma)
  2565 by(simp add: rec_eval.simps rec_stat_def stat.simps lo_lemma)
  2566  
  2566  
  2567 declare rec_strt.simps[simp del] strt.simps[simp del]
  2567 declare rec_strt.simps[simp del] strt.simps[simp del]
  2568 
  2568 
  2569 lemma map_cons_eq: 
  2569 lemma map_cons_eq: 
  2570   "(map ((\<lambda>a. rec_exec a (m # xs)) \<circ> 
  2570   "(map ((\<lambda>a. rec_eval a (m # xs)) \<circ> 
  2571     (\<lambda>i. recf.id (Suc (length xs)) (i))) 
  2571     (\<lambda>i. recf.id (Suc (length xs)) (i))) 
  2572           [Suc 0..<Suc (length xs)])
  2572           [Suc 0..<Suc (length xs)])
  2573         = map (\<lambda> i. xs ! (i - 1)) [Suc 0..<Suc (length xs)]"
  2573         = map (\<lambda> i. xs ! (i - 1)) [Suc 0..<Suc (length xs)]"
  2574 apply(rule map_ext, auto)
  2574 apply(rule map_ext, auto)
  2575 apply(auto simp: rec_exec.simps nth_append nth_Cons split: nat.split)
  2575 apply(auto simp: rec_eval.simps nth_append nth_Cons split: nat.split)
  2576 done
  2576 done
  2577 
  2577 
  2578 lemma list_map_eq: 
  2578 lemma list_map_eq: 
  2579   "vl = length (xs::nat list) \<Longrightarrow> map (\<lambda> i. xs ! (i - 1))
  2579   "vl = length (xs::nat list) \<Longrightarrow> map (\<lambda> i. xs ! (i - 1))
  2580                                           [Suc 0..<Suc vl] = xs"
  2580                                           [Suc 0..<Suc vl] = xs"
  2614     done
  2614     done
  2615 qed
  2615 qed
  2616 
  2616 
  2617 lemma [elim]: 
  2617 lemma [elim]: 
  2618   "Suc 0 \<le> length xs \<Longrightarrow> 
  2618   "Suc 0 \<le> length xs \<Longrightarrow> 
  2619      (map ((\<lambda>a. rec_exec a (m # xs)) \<circ> 
  2619      (map ((\<lambda>a. rec_eval a (m # xs)) \<circ> 
  2620          (\<lambda>i. recf.id (Suc (length xs)) (i))) 
  2620          (\<lambda>i. recf.id (Suc (length xs)) (i))) 
  2621              [Suc 0..<length xs] @ [(m # xs) ! length xs]) = xs"
  2621              [Suc 0..<length xs] @ [(m # xs) ! length xs]) = xs"
  2622 using map_cons_eq[of m xs]
  2622 using map_cons_eq[of m xs]
  2623 apply(simp del: map_eq_conv add: rec_exec.simps)
  2623 apply(simp del: map_eq_conv add: rec_eval.simps)
  2624 using list_map_eq[of "length xs" xs]
  2624 using list_map_eq[of "length xs" xs]
  2625 apply(simp)
  2625 apply(simp)
  2626 done
  2626 done
  2627 
  2627 
  2628     
  2628     
  2629 lemma inpt_lemma:
  2629 lemma inpt_lemma:
  2630   "\<lbrakk>Suc (length xs) = vl\<rbrakk> \<Longrightarrow> 
  2630   "\<lbrakk>Suc (length xs) = vl\<rbrakk> \<Longrightarrow> 
  2631             rec_exec (rec_inpt vl) (m # xs) = inpt m xs"
  2631             rec_eval (rec_inpt vl) (m # xs) = inpt m xs"
  2632 apply(auto simp: rec_exec.simps rec_inpt_def 
  2632 apply(auto simp: rec_eval.simps rec_inpt_def 
  2633                  trpl_lemma inpt.simps strt_lemma)
  2633                  trpl_lemma inpt.simps strt_lemma)
  2634 apply(subgoal_tac
  2634 apply(subgoal_tac
  2635   "(map ((\<lambda>a. rec_exec a (m # xs)) \<circ> 
  2635   "(map ((\<lambda>a. rec_eval a (m # xs)) \<circ> 
  2636           (\<lambda>i. recf.id (Suc (length xs)) (i))) 
  2636           (\<lambda>i. recf.id (Suc (length xs)) (i))) 
  2637             [Suc 0..<length xs] @ [(m # xs) ! length xs]) = xs", simp)
  2637             [Suc 0..<length xs] @ [(m # xs) ! length xs]) = xs", simp)
  2638 apply(auto, case_tac xs, auto)
  2638 apply(auto, case_tac xs, auto)
  2639 done
  2639 done
  2640 
  2640 
  2654                              Cn 2 rec_right [id 2 1], 
  2654                              Cn 2 rec_right [id 2 1], 
  2655                              Cn 2 rec_actn [id 2 0, 
  2655                              Cn 2 rec_actn [id 2 0, 
  2656                                    Cn 2 rec_stat [id 2 1], 
  2656                                    Cn 2 rec_stat [id 2 1], 
  2657                              Cn 2 rec_right [id 2 1]]]]"
  2657                              Cn 2 rec_right [id 2 1]]]]"
  2658 
  2658 
  2659 lemma newconf_lemma: "rec_exec rec_newconf [m ,c] = newconf m c"
  2659 lemma newconf_lemma: "rec_eval rec_newconf [m ,c] = newconf m c"
  2660 by(auto simp: rec_newconf_def rec_exec.simps 
  2660 by(auto simp: rec_newconf_def rec_eval.simps 
  2661               trpl_lemma newleft_lemma left_lemma
  2661               trpl_lemma newleft_lemma left_lemma
  2662               right_lemma stat_lemma newrght_lemma actn_lemma 
  2662               right_lemma stat_lemma newrght_lemma actn_lemma 
  2663                newstat_lemma stat_lemma newconf.simps)
  2663                newstat_lemma stat_lemma newconf.simps)
  2664 
  2664 
  2665 declare newconf_lemma[simp]
  2665 declare newconf_lemma[simp]
  2683   where
  2683   where
  2684   "rec_conf = Pr 2 (Cn 2 rec_trpl [Cn 2 (constn 0) [id 2 0], Cn 2 (constn (Suc 0)) [id 2 0], id 2 1])
  2684   "rec_conf = Pr 2 (Cn 2 rec_trpl [Cn 2 (constn 0) [id 2 0], Cn 2 (constn (Suc 0)) [id 2 0], id 2 1])
  2685                   (Cn 4 rec_newconf [id 4 0, id 4 3])"
  2685                   (Cn 4 rec_newconf [id 4 0, id 4 3])"
  2686 
  2686 
  2687 lemma conf_step: 
  2687 lemma conf_step: 
  2688   "rec_exec rec_conf [m, r, Suc t] =
  2688   "rec_eval rec_conf [m, r, Suc t] =
  2689          rec_exec rec_newconf [m, rec_exec rec_conf [m, r, t]]"
  2689          rec_eval rec_newconf [m, rec_eval rec_conf [m, r, t]]"
  2690 proof -
  2690 proof -
  2691   have "rec_exec rec_conf ([m, r] @ [Suc t]) = 
  2691   have "rec_eval rec_conf ([m, r] @ [Suc t]) = 
  2692           rec_exec rec_newconf [m, rec_exec rec_conf [m, r, t]]"
  2692           rec_eval rec_newconf [m, rec_eval rec_conf [m, r, t]]"
  2693     by(simp only: rec_conf_def rec_pr_Suc_simp_rewrite,
  2693     by(simp only: rec_conf_def rec_pr_Suc_simp_rewrite,
  2694         simp add: rec_exec.simps)
  2694         simp add: rec_eval.simps)
  2695   thus "rec_exec rec_conf [m, r, Suc t] =
  2695   thus "rec_eval rec_conf [m, r, Suc t] =
  2696                 rec_exec rec_newconf [m, rec_exec rec_conf [m, r, t]]"
  2696                 rec_eval rec_newconf [m, rec_eval rec_conf [m, r, t]]"
  2697     by simp
  2697     by simp
  2698 qed
  2698 qed
  2699 
  2699 
  2700 text {*
  2700 text {*
  2701   The correctness of @{text "rec_conf"}.
  2701   The correctness of @{text "rec_conf"}.
  2702   *}
  2702   *}
  2703 lemma conf_lemma: 
  2703 lemma conf_lemma: 
  2704   "rec_exec rec_conf [m, r, t] = conf m r t"
  2704   "rec_eval rec_conf [m, r, t] = conf m r t"
  2705 apply(induct t)
  2705 apply(induct t)
  2706 apply(simp add: rec_conf_def rec_exec.simps conf.simps inpt_lemma trpl_lemma)
  2706 apply(simp add: rec_conf_def rec_eval.simps conf.simps inpt_lemma trpl_lemma)
  2707 apply(simp add: conf_step conf.simps)
  2707 apply(simp add: conf_step conf.simps)
  2708 done
  2708 done
  2709 
  2709 
  2710 text {*
  2710 text {*
  2711   @{text "NSTD c"} returns true if the configureation coded by @{text "c"} is no a stardard
  2711   @{text "NSTD c"} returns true if the configureation coded by @{text "c"} is no a stardard
  2733                                     [Cn 1 rec_add        
  2733                                     [Cn 1 rec_add        
  2734                                      [rec_right, constn 1], 
  2734                                      [rec_right, constn 1], 
  2735                                             constn 2]], constn 1]]],
  2735                                             constn 2]], constn 1]]],
  2736                Cn 1 rec_eq [rec_right, constn 0]]"
  2736                Cn 1 rec_eq [rec_right, constn 0]]"
  2737 
  2737 
  2738 lemma NSTD_lemma1: "rec_exec rec_NSTD [c] = Suc 0 \<or>
  2738 lemma NSTD_lemma1: "rec_eval rec_NSTD [c] = Suc 0 \<or>
  2739                    rec_exec rec_NSTD [c] = 0"
  2739                    rec_eval rec_NSTD [c] = 0"
  2740 by(simp add: rec_exec.simps rec_NSTD_def)
  2740 by(simp add: rec_eval.simps rec_NSTD_def)
  2741 
  2741 
  2742 declare NSTD.simps[simp del]
  2742 declare NSTD.simps[simp del]
  2743 lemma NSTD_lemma2': "(rec_exec rec_NSTD [c] = Suc 0) \<Longrightarrow> NSTD c"
  2743 lemma NSTD_lemma2': "(rec_eval rec_NSTD [c] = Suc 0) \<Longrightarrow> NSTD c"
  2744 apply(simp add: rec_exec.simps rec_NSTD_def stat_lemma left_lemma 
  2744 apply(simp add: rec_eval.simps rec_NSTD_def stat_lemma left_lemma 
  2745                 lg_lemma right_lemma power_lemma NSTD.simps eq_lemma)
  2745                 lg_lemma right_lemma power_lemma NSTD.simps eq_lemma)
  2746 apply(auto)
  2746 apply(auto)
  2747 apply(case_tac "0 < left c", simp, simp)
  2747 apply(case_tac "0 < left c", simp, simp)
  2748 done
  2748 done
  2749 
  2749 
  2750 lemma NSTD_lemma2'': 
  2750 lemma NSTD_lemma2'': 
  2751   "NSTD c \<Longrightarrow> (rec_exec rec_NSTD [c] = Suc 0)"
  2751   "NSTD c \<Longrightarrow> (rec_eval rec_NSTD [c] = Suc 0)"
  2752 apply(simp add: rec_exec.simps rec_NSTD_def stat_lemma 
  2752 apply(simp add: rec_eval.simps rec_NSTD_def stat_lemma 
  2753          left_lemma lg_lemma right_lemma power_lemma NSTD.simps)
  2753          left_lemma lg_lemma right_lemma power_lemma NSTD.simps)
  2754 apply(auto split: if_splits)
  2754 apply(auto split: if_splits)
  2755 done
  2755 done
  2756 
  2756 
  2757 text {*
  2757 text {*
  2758   The correctness of @{text "NSTD"}.
  2758   The correctness of @{text "NSTD"}.
  2759   *}
  2759   *}
  2760 lemma NSTD_lemma2: "(rec_exec rec_NSTD [c] = Suc 0) = NSTD c"
  2760 lemma NSTD_lemma2: "(rec_eval rec_NSTD [c] = Suc 0) = NSTD c"
  2761 using NSTD_lemma1
  2761 using NSTD_lemma1
  2762 apply(auto intro: NSTD_lemma2' NSTD_lemma2'')
  2762 apply(auto intro: NSTD_lemma2' NSTD_lemma2'')
  2763 done
  2763 done
  2764 
  2764 
  2765 fun nstd :: "nat \<Rightarrow> nat"
  2765 fun nstd :: "nat \<Rightarrow> nat"
  2766   where
  2766   where
  2767   "nstd c = (if NSTD c then 1 else 0)"
  2767   "nstd c = (if NSTD c then 1 else 0)"
  2768 
  2768 
  2769 lemma nstd_lemma: "rec_exec rec_NSTD [c] = nstd c"
  2769 lemma nstd_lemma: "rec_eval rec_NSTD [c] = nstd c"
  2770 using NSTD_lemma1
  2770 using NSTD_lemma1
  2771 apply(simp add: NSTD_lemma2, auto)
  2771 apply(simp add: NSTD_lemma2, auto)
  2772 done
  2772 done
  2773 
  2773 
  2774 text{* 
  2774 text{* 
  2788 
  2788 
  2789 text {*
  2789 text {*
  2790   The correctness of @{text "rec_nonstop"}.
  2790   The correctness of @{text "rec_nonstop"}.
  2791   *}
  2791   *}
  2792 lemma nonstop_lemma: 
  2792 lemma nonstop_lemma: 
  2793   "rec_exec rec_nonstop [m, r, t] = nonstop m r t"
  2793   "rec_eval rec_nonstop [m, r, t] = nonstop m r t"
  2794 apply(simp add: rec_exec.simps rec_nonstop_def nstd_lemma conf_lemma)
  2794 apply(simp add: rec_eval.simps rec_nonstop_def nstd_lemma conf_lemma)
  2795 done
  2795 done
  2796 
  2796 
  2797 text{*
  2797 text{*
  2798   @{text "rec_halt"} is the recursive function calculating the steps a TM needs to execute before
  2798   @{text "rec_halt"} is the recursive function calculating the steps a TM needs to execute before
  2799   to reach a stardard final configuration. This recursive function is the only one
  2799   to reach a stardard final configuration. This recursive function is the only one
  2983      rec_newstat_def)
  2983      rec_newstat_def)
  2984 apply(tactic {* resolve_tac [@{thm prime_cn}, 
  2984 apply(tactic {* resolve_tac [@{thm prime_cn}, 
  2985     @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)+
  2985     @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)+
  2986 done
  2986 done
  2987 
  2987 
  2988 lemma primerec_terminate: 
  2988 lemma primerec_terminates: 
  2989   "\<lbrakk>primerec f x; length xs = x\<rbrakk> \<Longrightarrow> terminate f xs"
  2989   "\<lbrakk>primerec f x; length xs = x\<rbrakk> \<Longrightarrow> terminates f xs"
  2990 proof(induct arbitrary: xs rule: primerec.induct)
  2990 proof(induct arbitrary: xs rule: primerec.induct)
  2991   fix xs
  2991   fix xs
  2992   assume "length (xs::nat list) = Suc 0"  thus "terminate z xs"
  2992   assume "length (xs::nat list) = Suc 0"  thus "terminates z xs"
  2993     by(case_tac xs, auto intro: termi_z)
  2993     by(case_tac xs, auto intro: termi_z)
  2994 next
  2994 next
  2995   fix xs
  2995   fix xs
  2996   assume "length (xs::nat list) = Suc 0" thus "terminate s xs"
  2996   assume "length (xs::nat list) = Suc 0" thus "terminates s xs"
  2997     by(case_tac xs, auto intro: termi_s)
  2997     by(case_tac xs, auto intro: termi_s)
  2998 next
  2998 next
  2999   fix n m xs
  2999   fix n m xs
  3000   assume "n < m" "length (xs::nat list) = m"  thus "terminate (id m n) xs"
  3000   assume "n < m" "length (xs::nat list) = m"  thus "terminates (id m n) xs"
  3001     by(erule_tac termi_id, simp)
  3001     by(erule_tac termi_id, simp)
  3002 next
  3002 next
  3003   fix f k gs m n xs
  3003   fix f k gs m n xs
  3004   assume ind: "\<forall>i<length gs. primerec (gs ! i) m \<and> (\<forall>x. length x = m \<longrightarrow> terminate (gs ! i) x)"
  3004   assume ind: "\<forall>i<length gs. primerec (gs ! i) m \<and> (\<forall>x. length x = m \<longrightarrow> terminates (gs ! i) x)"
  3005   and ind2: "\<And> xs. length xs = k \<Longrightarrow> terminate f xs"
  3005   and ind2: "\<And> xs. length xs = k \<Longrightarrow> terminates f xs"
  3006   and h: "primerec f k"  "length gs = k" "m = n" "length (xs::nat list) = m"
  3006   and h: "primerec f k"  "length gs = k" "m = n" "length (xs::nat list) = m"
  3007   have "terminate f (map (\<lambda>g. rec_exec g xs) gs)"
  3007   have "terminates f (map (\<lambda>g. rec_eval g xs) gs)"
  3008     using ind2[of "(map (\<lambda>g. rec_exec g xs) gs)"] h
  3008     using ind2[of "(map (\<lambda>g. rec_eval g xs) gs)"] h
  3009     by simp
  3009     by simp
  3010   moreover have "\<forall>g\<in>set gs. terminate g xs"
  3010   moreover have "\<forall>g\<in>set gs. terminates g xs"
  3011     using ind h
  3011     using ind h
  3012     by(auto simp: set_conv_nth)
  3012     by(auto simp: set_conv_nth)
  3013   ultimately show "terminate (Cn n f gs) xs"
  3013   ultimately show "terminates (Cn n f gs) xs"
  3014     using h
  3014     using h
  3015     by(rule_tac termi_cn, auto)
  3015     by(rule_tac termi_cn, auto)
  3016 next
  3016 next
  3017   fix f n g m xs
  3017   fix f n g m xs
  3018   assume ind1: "\<And>xs. length xs = n \<Longrightarrow> terminate f xs"
  3018   assume ind1: "\<And>xs. length xs = n \<Longrightarrow> terminates f xs"
  3019   and ind2: "\<And>xs. length xs = Suc (Suc n) \<Longrightarrow> terminate g xs"
  3019   and ind2: "\<And>xs. length xs = Suc (Suc n) \<Longrightarrow> terminates g xs"
  3020   and h: "primerec f n" " primerec g (Suc (Suc n))" " m = Suc n" "length (xs::nat list) = m"
  3020   and h: "primerec f n" " primerec g (Suc (Suc n))" " m = Suc n" "length (xs::nat list) = m"
  3021   have "\<forall>y<last xs. terminate g (butlast xs @ [y, rec_exec (Pr n f g) (butlast xs @ [y])])"
  3021   have "\<forall>y<last xs. terminates g (butlast xs @ [y, rec_eval (Pr n f g) (butlast xs @ [y])])"
  3022     using h
  3022     using h
  3023     apply(auto) 
  3023     apply(auto) 
  3024     by(rule_tac ind2, simp)
  3024     by(rule_tac ind2, simp)
  3025   moreover have "terminate f (butlast xs)"
  3025   moreover have "terminates f (butlast xs)"
  3026     using ind1[of "butlast xs"] h
  3026     using ind1[of "butlast xs"] h
  3027     by simp
  3027     by simp
  3028  moreover have "length (butlast xs) = n"
  3028  moreover have "length (butlast xs) = n"
  3029    using h by simp
  3029    using h by simp
  3030  ultimately have "terminate (Pr n f g) (butlast xs @ [last xs])"
  3030  ultimately have "terminates (Pr n f g) (butlast xs @ [last xs])"
  3031    by(rule_tac termi_pr, simp_all)
  3031    by(rule_tac termi_pr, simp_all)
  3032  thus "terminate (Pr n f g) xs"
  3032  thus "terminates (Pr n f g) xs"
  3033    using h
  3033    using h
  3034    by(case_tac "xs = []", auto)
  3034    by(case_tac "xs = []", auto)
  3035 qed
  3035 qed
  3036 
  3036 
  3037 text {*
  3037 text {*
  3059   "rec_valu = Cn 1 rec_minus [Cn 1 rec_lg [s, constn 2], constn 1]"
  3059   "rec_valu = Cn 1 rec_minus [Cn 1 rec_lg [s, constn 2], constn 1]"
  3060 
  3060 
  3061 text {*
  3061 text {*
  3062   The correctness of @{text "rec_valu"}.
  3062   The correctness of @{text "rec_valu"}.
  3063 *}
  3063 *}
  3064 lemma value_lemma: "rec_exec rec_valu [r] = valu r"
  3064 lemma value_lemma: "rec_eval rec_valu [r] = valu r"
  3065 apply(simp add: rec_exec.simps rec_valu_def lg_lemma)
  3065 apply(simp add: rec_eval.simps rec_valu_def lg_lemma)
  3066 done
  3066 done
  3067 
  3067 
  3068 lemma [intro]: "primerec rec_valu (Suc 0)"
  3068 lemma [intro]: "primerec rec_valu (Suc 0)"
  3069 apply(simp add: rec_valu_def)
  3069 apply(simp add: rec_valu_def)
  3070 apply(rule_tac k = "Suc (Suc 0)" in prime_cn)
  3070 apply(rule_tac k = "Suc (Suc 0)" in prime_cn)
  3099   k < length ys\<rbrakk> \<Longrightarrow>
  3099   k < length ys\<rbrakk> \<Longrightarrow>
  3100   (get_fstn_args (length ys) (length ys) ! k) = 
  3100   (get_fstn_args (length ys) (length ys) ! k) = 
  3101                                   id (length ys) (k)"
  3101                                   id (length ys) (k)"
  3102 by(erule_tac get_fstn_args_nth)
  3102 by(erule_tac get_fstn_args_nth)
  3103 
  3103 
  3104 lemma terminate_halt_lemma: 
  3104 lemma terminates_halt_lemma: 
  3105   "\<lbrakk>rec_exec rec_nonstop ([m, r] @ [t]) = 0; 
  3105   "\<lbrakk>rec_eval rec_nonstop ([m, r] @ [t]) = 0; 
  3106      \<forall>i<t. 0 < rec_exec rec_nonstop ([m, r] @ [i])\<rbrakk> \<Longrightarrow> terminate rec_halt [m, r]"
  3106      \<forall>i<t. 0 < rec_eval rec_nonstop ([m, r] @ [i])\<rbrakk> \<Longrightarrow> terminates rec_halt [m, r]"
  3107 apply(simp add: rec_halt_def)
  3107 apply(simp add: rec_halt_def)
  3108 apply(rule_tac termi_mn, auto)
  3108 apply(rule_tac termi_mn, auto)
  3109 apply(rule_tac [!] primerec_terminate, auto)
  3109 apply(rule_tac [!] primerec_terminates, auto)
  3110 done
  3110 done
  3111 
  3111 
  3112 
  3112 
  3113 text {*
  3113 text {*
  3114   The correctness of @{text "rec_F"}, halt case.
  3114   The correctness of @{text "rec_F"}, halt case.
  3115   *}
  3115   *}
  3116 
  3116 
  3117 lemma F_lemma: "rec_exec rec_halt [m, r] = t \<Longrightarrow> rec_exec rec_F [m, r] = (valu (rght (conf m r t)))"
  3117 lemma F_lemma: "rec_eval rec_halt [m, r] = t \<Longrightarrow> rec_eval rec_F [m, r] = (valu (rght (conf m r t)))"
  3118 by(simp add: rec_F_def rec_exec.simps value_lemma right_lemma conf_lemma halt_lemma)
  3118 by(simp add: rec_F_def rec_eval.simps value_lemma right_lemma conf_lemma halt_lemma)
  3119 
  3119 
  3120 lemma terminate_F_lemma: "terminate rec_halt [m, r] \<Longrightarrow> terminate rec_F [m, r]"
  3120 lemma terminates_F_lemma: "terminates rec_halt [m, r] \<Longrightarrow> terminates rec_F [m, r]"
  3121 apply(simp add: rec_F_def)
  3121 apply(simp add: rec_F_def)
  3122 apply(rule_tac termi_cn, auto)
  3122 apply(rule_tac termi_cn, auto)
  3123 apply(rule_tac primerec_terminate, auto)
  3123 apply(rule_tac primerec_terminates, auto)
  3124 apply(rule_tac termi_cn, auto)
  3124 apply(rule_tac termi_cn, auto)
  3125 apply(rule_tac primerec_terminate, auto)
  3125 apply(rule_tac primerec_terminates, auto)
  3126 apply(rule_tac termi_cn, auto)
  3126 apply(rule_tac termi_cn, auto)
  3127 apply(rule_tac primerec_terminate, auto)
  3127 apply(rule_tac primerec_terminates, auto)
  3128 apply(rule_tac [!] termi_id, auto)
  3128 apply(rule_tac [!] termi_id, auto)
  3129 done
  3129 done
  3130 
  3130 
  3131 text {*
  3131 text {*
  3132   The correctness of @{text "rec_F"}, nonhalt case.
  3132   The correctness of @{text "rec_F"}, nonhalt case.
  3999   The lemma relates the one step execution of TMs with the interpreter function @{text "rec_newconf"}.
  3999   The lemma relates the one step execution of TMs with the interpreter function @{text "rec_newconf"}.
  4000   *}
  4000   *}
  4001 lemma rec_t_eq_step: 
  4001 lemma rec_t_eq_step: 
  4002   "(\<lambda> (s, l, r). s \<le> length tp div 2) c \<Longrightarrow>
  4002   "(\<lambda> (s, l, r). s \<le> length tp div 2) c \<Longrightarrow>
  4003   trpl_code (step0 c tp) = 
  4003   trpl_code (step0 c tp) = 
  4004   rec_exec rec_newconf [code tp, trpl_code c]"
  4004   rec_eval rec_newconf [code tp, trpl_code c]"
  4005   apply(cases c, simp)
  4005   apply(cases c, simp)
  4006 proof(case_tac "fetch tp a (read ca)",
  4006 proof(case_tac "fetch tp a (read ca)",
  4007     simp add: newconf.simps trpl_code.simps step.simps)
  4007     simp add: newconf.simps trpl_code.simps step.simps)
  4008   fix a b ca aa ba
  4008   fix a b ca aa ba
  4009   assume h: "(a::nat) \<le> length tp div 2" 
  4009   assume h: "(a::nat) \<le> length tp div 2" 
  4161   apply(simp)
  4161   apply(simp)
  4162   done
  4162   done
  4163 
  4163 
  4164 lemma [simp]:
  4164 lemma [simp]:
  4165  "trpl_code (steps0 (Suc 0, Bk\<up>l, <lm>) tp 0) = 
  4165  "trpl_code (steps0 (Suc 0, Bk\<up>l, <lm>) tp 0) = 
  4166     rec_exec rec_conf [code tp, bl2wc (<lm>), 0]"
  4166     rec_eval rec_conf [code tp, bl2wc (<lm>), 0]"
  4167 apply(simp add: steps.simps rec_exec.simps conf_lemma  conf.simps 
  4167 apply(simp add: steps.simps rec_eval.simps conf_lemma  conf.simps 
  4168                 inpt.simps trpl_code.simps bl2wc.simps)
  4168                 inpt.simps trpl_code.simps bl2wc.simps)
  4169 done
  4169 done
  4170 
  4170 
  4171 text {*
  4171 text {*
  4172   The following lemma relates the multi-step interpreter function @{text "rec_conf"}
  4172   The following lemma relates the multi-step interpreter function @{text "rec_conf"}
  4210 qed
  4210 qed
  4211 
  4211 
  4212 lemma rec_t_eq_steps:
  4212 lemma rec_t_eq_steps:
  4213   "tm_wf (tp,0) \<Longrightarrow>
  4213   "tm_wf (tp,0) \<Longrightarrow>
  4214   trpl_code (steps0 (Suc 0, Bk\<up>l, <lm>) tp stp) = 
  4214   trpl_code (steps0 (Suc 0, Bk\<up>l, <lm>) tp stp) = 
  4215   rec_exec rec_conf [code tp, bl2wc (<lm>), stp]"
  4215   rec_eval rec_conf [code tp, bl2wc (<lm>), stp]"
  4216 proof(induct stp)
  4216 proof(induct stp)
  4217   case 0 thus "?case" by(simp)
  4217   case 0 thus "?case" by(simp)
  4218 next
  4218 next
  4219   case (Suc n) thus "?case"
  4219   case (Suc n) thus "?case"
  4220   proof -
  4220   proof -
  4221     assume ind: 
  4221     assume ind: 
  4222       "tm_wf (tp,0) \<Longrightarrow> trpl_code (steps0 (Suc 0, Bk\<up> l, <lm>) tp n) 
  4222       "tm_wf (tp,0) \<Longrightarrow> trpl_code (steps0 (Suc 0, Bk\<up> l, <lm>) tp n) 
  4223       = rec_exec rec_conf [code tp, bl2wc (<lm>), n]"
  4223       = rec_eval rec_conf [code tp, bl2wc (<lm>), n]"
  4224       and h: "tm_wf (tp, 0)"
  4224       and h: "tm_wf (tp, 0)"
  4225     show 
  4225     show 
  4226       "trpl_code (steps0 (Suc 0, Bk\<up> l, <lm>) tp (Suc n)) =
  4226       "trpl_code (steps0 (Suc 0, Bk\<up> l, <lm>) tp (Suc n)) =
  4227       rec_exec rec_conf [code tp, bl2wc (<lm>), Suc n]"
  4227       rec_eval rec_conf [code tp, bl2wc (<lm>), Suc n]"
  4228     proof(case_tac "steps0 (Suc 0, Bk\<up> l, <lm>) tp  n", 
  4228     proof(case_tac "steps0 (Suc 0, Bk\<up> l, <lm>) tp  n", 
  4229         simp only: step_red conf_lemma conf.simps)
  4229         simp only: step_red conf_lemma conf.simps)
  4230       fix a b c
  4230       fix a b c
  4231       assume g: "steps0 (Suc 0, Bk\<up> l, <lm>) tp n = (a, b, c) "
  4231       assume g: "steps0 (Suc 0, Bk\<up> l, <lm>) tp n = (a, b, c) "
  4232       hence "conf (code tp) (bl2wc (<lm>)) n= trpl_code (a, b, c)"
  4232       hence "conf (code tp) (bl2wc (<lm>)) n= trpl_code (a, b, c)"
  4233         using ind h
  4233         using ind h
  4234         apply(simp add: conf_lemma)
  4234         apply(simp add: conf_lemma)
  4235         done
  4235         done
  4236       moreover hence 
  4236       moreover hence 
  4237         "trpl_code (step0 (a, b, c) tp) = 
  4237         "trpl_code (step0 (a, b, c) tp) = 
  4238         rec_exec rec_newconf [code tp, trpl_code (a, b, c)]"
  4238         rec_eval rec_newconf [code tp, trpl_code (a, b, c)]"
  4239         apply(rule_tac rec_t_eq_step)
  4239         apply(rule_tac rec_t_eq_step)
  4240         using h g
  4240         using h g
  4241         apply(simp add: state_in_range)
  4241         apply(simp add: state_in_range)
  4242         done
  4242         done
  4243       ultimately show 
  4243       ultimately show 
  4291 
  4291 
  4292 lemma nonstop_t_eq: 
  4292 lemma nonstop_t_eq: 
  4293   "\<lbrakk>steps0 (Suc 0, Bk\<up>l, <lm>) tp stp = (0, Bk\<up> m, Oc\<up> rs @ Bk\<up> n); 
  4293   "\<lbrakk>steps0 (Suc 0, Bk\<up>l, <lm>) tp stp = (0, Bk\<up> m, Oc\<up> rs @ Bk\<up> n); 
  4294    tm_wf (tp, 0); 
  4294    tm_wf (tp, 0); 
  4295   rs > 0\<rbrakk> 
  4295   rs > 0\<rbrakk> 
  4296   \<Longrightarrow> rec_exec rec_nonstop [code tp, bl2wc (<lm>), stp] = 0"
  4296   \<Longrightarrow> rec_eval rec_nonstop [code tp, bl2wc (<lm>), stp] = 0"
  4297 proof(simp add: nonstop_lemma nonstop.simps nstd.simps)
  4297 proof(simp add: nonstop_lemma nonstop.simps nstd.simps)
  4298   assume h: "steps0 (Suc 0, Bk\<up>l, <lm>) tp stp = (0, Bk\<up> m, Oc\<up> rs @ Bk\<up> n)"
  4298   assume h: "steps0 (Suc 0, Bk\<up>l, <lm>) tp stp = (0, Bk\<up> m, Oc\<up> rs @ Bk\<up> n)"
  4299   and tc_t: "tm_wf (tp, 0)" "rs > 0"
  4299   and tc_t: "tm_wf (tp, 0)" "rs > 0"
  4300   have g: "rec_exec rec_conf [code tp,  bl2wc (<lm>), stp] =
  4300   have g: "rec_eval rec_conf [code tp,  bl2wc (<lm>), stp] =
  4301                                         trpl_code (0, Bk\<up> m, Oc\<up> rs@Bk\<up> n)"
  4301                                         trpl_code (0, Bk\<up> m, Oc\<up> rs@Bk\<up> n)"
  4302     using rec_t_eq_steps[of tp l lm stp] tc_t h
  4302     using rec_t_eq_steps[of tp l lm stp] tc_t h
  4303     by(simp)
  4303     by(simp)
  4304   thus "\<not> NSTD (conf (code tp) (bl2wc (<lm>)) stp)" 
  4304   thus "\<not> NSTD (conf (code tp) (bl2wc (<lm>)) stp)" 
  4305   proof(auto simp: NSTD.simps)
  4305   proof(auto simp: NSTD.simps)
  4485 text {*
  4485 text {*
  4486   The correntess of @{text "rec_F"} which relates the interpreter function @{text "rec_F"} with the
  4486   The correntess of @{text "rec_F"} which relates the interpreter function @{text "rec_F"} with the
  4487   execution of of TMs.
  4487   execution of of TMs.
  4488   *}
  4488   *}
  4489 
  4489 
  4490 lemma terminate_halt: 
  4490 lemma terminates_halt: 
  4491   "\<lbrakk>steps0 (Suc 0, Bk\<up>l, <lm>) tp stp = (0, Bk\<up>m, Oc\<up>rs@Bk\<up>n); 
  4491   "\<lbrakk>steps0 (Suc 0, Bk\<up>l, <lm>) tp stp = (0, Bk\<up>m, Oc\<up>rs@Bk\<up>n); 
  4492     tm_wf (tp,0); 0<rs\<rbrakk> \<Longrightarrow> terminate rec_halt [code tp, (bl2wc (<lm>))]"
  4492     tm_wf (tp,0); 0<rs\<rbrakk> \<Longrightarrow> terminates rec_halt [code tp, (bl2wc (<lm>))]"
  4493 apply(frule_tac halt_least_step, auto)
  4493 apply(frule_tac halt_least_step, auto)
  4494 thm terminate_halt_lemma
  4494 thm terminates_halt_lemma
  4495 apply(rule_tac t = stpa in terminate_halt_lemma)
  4495 apply(rule_tac t = stpa in terminates_halt_lemma)
  4496 apply(simp_all add: nonstop_lemma, auto)
  4496 apply(simp_all add: nonstop_lemma, auto)
  4497 done
  4497 done
  4498 
  4498 
  4499 lemma terminate_F: 
  4499 lemma terminates_F: 
  4500   "\<lbrakk>steps0 (Suc 0, Bk\<up>l, <lm>) tp stp = (0, Bk\<up>m, Oc\<up>rs@Bk\<up>n); 
  4500   "\<lbrakk>steps0 (Suc 0, Bk\<up>l, <lm>) tp stp = (0, Bk\<up>m, Oc\<up>rs@Bk\<up>n); 
  4501     tm_wf (tp,0); 0<rs\<rbrakk> \<Longrightarrow> terminate rec_F [code tp, (bl2wc (<lm>))]"
  4501     tm_wf (tp,0); 0<rs\<rbrakk> \<Longrightarrow> terminates rec_F [code tp, (bl2wc (<lm>))]"
  4502 apply(drule_tac terminate_halt, simp_all)
  4502 apply(drule_tac terminates_halt, simp_all)
  4503 apply(erule_tac terminate_F_lemma)
  4503 apply(erule_tac terminates_F_lemma)
  4504 done
  4504 done
  4505 
  4505 
  4506 lemma F_correct: 
  4506 lemma F_correct: 
  4507   "\<lbrakk>steps0 (Suc 0, Bk\<up>l, <lm>) tp stp = (0, Bk\<up>m, Oc\<up>rs@Bk\<up>n); 
  4507   "\<lbrakk>steps0 (Suc 0, Bk\<up>l, <lm>) tp stp = (0, Bk\<up>m, Oc\<up>rs@Bk\<up>n); 
  4508     tm_wf (tp,0); 0<rs\<rbrakk>
  4508     tm_wf (tp,0); 0<rs\<rbrakk>
  4509    \<Longrightarrow> rec_exec rec_F [code tp, (bl2wc (<lm>))] = (rs - Suc 0)"
  4509    \<Longrightarrow> rec_eval rec_F [code tp, (bl2wc (<lm>))] = (rs - Suc 0)"
  4510 apply(frule_tac halt_least_step, auto)
  4510 apply(frule_tac halt_least_step, auto)
  4511 apply(frule_tac  nonstop_t_eq, auto simp: nonstop_lemma)
  4511 apply(frule_tac  nonstop_t_eq, auto simp: nonstop_lemma)
  4512 using rec_t_eq_steps[of tp l lm stp]
  4512 using rec_t_eq_steps[of tp l lm stp]
  4513 apply(simp add: conf_lemma)
  4513 apply(simp add: conf_lemma)
  4514 proof -
  4514 proof -
  4521     "steps0 (Suc 0, Bk\<up> l, <lm>) tp stp = (0, Bk\<up> m, Oc\<up> rs @ Bk\<up> n)"
  4521     "steps0 (Suc 0, Bk\<up> l, <lm>) tp stp = (0, Bk\<up> m, Oc\<up> rs @ Bk\<up> n)"
  4522   hence g1: "conf (code tp) (bl2wc (<lm>)) stpa = trpl_code (0, Bk\<up> m, Oc\<up> rs @ Bk\<up>n)"
  4522   hence g1: "conf (code tp) (bl2wc (<lm>)) stpa = trpl_code (0, Bk\<up> m, Oc\<up> rs @ Bk\<up>n)"
  4523     using halt_state_keep[of "code tp" lm stpa stp]
  4523     using halt_state_keep[of "code tp" lm stpa stp]
  4524     by(simp)
  4524     by(simp)
  4525   moreover have g2:
  4525   moreover have g2:
  4526     "rec_exec rec_halt [code tp, (bl2wc (<lm>))] = stpa"
  4526     "rec_eval rec_halt [code tp, (bl2wc (<lm>))] = stpa"
  4527     using h
  4527     using h
  4528     by(auto simp: rec_exec.simps rec_halt_def nonstop_lemma intro!: Least_equality)
  4528     by(auto simp: rec_eval.simps rec_halt_def nonstop_lemma intro!: Least_equality)
  4529   show  
  4529   show  
  4530     "rec_exec rec_F [code tp, (bl2wc (<lm>))] = (rs - Suc 0)"
  4530     "rec_eval rec_F [code tp, (bl2wc (<lm>))] = (rs - Suc 0)"
  4531   proof -
  4531   proof -
  4532     have 
  4532     have 
  4533       "valu (rght (conf (code tp) (bl2wc (<lm>)) stpa)) = rs - Suc 0" 
  4533       "valu (rght (conf (code tp) (bl2wc (<lm>)) stpa)) = rs - Suc 0" 
  4534       using g1 
  4534       using g1 
  4535       apply(simp add: valu.simps trpl_code.simps 
  4535       apply(simp add: valu.simps trpl_code.simps 
  4536         bl2wc.simps  bl2nat_append lg_power)
  4536         bl2wc.simps  bl2nat_append lg_power)
  4537       done
  4537       done
  4538     thus "?thesis" 
  4538     thus "?thesis" 
  4539       by(simp add: rec_exec.simps F_lemma g2)
  4539       by(simp add: rec_eval.simps F_lemma g2)
  4540   qed
  4540   qed
  4541 qed
  4541 qed
  4542 
  4542 
  4543 end
  4543 end