thys/UF.thy
changeset 237 06a6db387cd2
parent 229 d8e6f0798e23
child 238 6ea1062da89a
equal deleted inserted replaced
236:6b6d71d14e75 237:06a6db387cd2
   150                     [Cn (vl - 1) (constn 0) [id (vl - 1) 0]])) 
   150                     [Cn (vl - 1) (constn 0) [id (vl - 1) 0]])) 
   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 text {*
       
   156   @{text "rec_exec"} is the interpreter function for
       
   157   reursive functions. The function is defined such that 
       
   158   it always returns meaningful results for primitive recursive 
       
   159   functions.
       
   160   *}
       
   161 
   155 
   162 declare rec_exec.simps[simp del] constn.simps[simp del]
   156 declare rec_exec.simps[simp del] constn.simps[simp del]
   163 
   157 
   164 text {*
   158 
   165   Correctness of @{text "rec_add"}.
   159 section {* Correctness of various recursive functions *}
   166   *}
   160 
   167 lemma add_lemma: "\<And> x y. rec_exec rec_add [x, y] =  x + y"
   161 
       
   162 lemma add_lemma: "rec_exec rec_add [x, y] =  x + y"
   168 by(induct_tac y, auto simp: rec_add_def rec_exec.simps)
   163 by(induct_tac y, auto simp: rec_add_def rec_exec.simps)
   169 
   164 
   170 text {*
   165 lemma mult_lemma: "rec_exec rec_mult [x, y] = x * y"
   171   Correctness of @{text "rec_mult"}.
       
   172   *}
       
   173 lemma mult_lemma: "\<And> x y. rec_exec rec_mult [x, y] = x * y"
       
   174 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_exec.simps add_lemma)
   175 
   167 
   176 text {*
   168 lemma pred_lemma: "rec_exec rec_pred [x] =  x - 1"
   177   Correctness of @{text "rec_pred"}.
       
   178   *}
       
   179 lemma pred_lemma: "\<And> x. rec_exec rec_pred [x] =  x - 1"
       
   180 by(induct_tac x, auto simp: rec_pred_def rec_exec.simps)
   169 by(induct_tac x, auto simp: rec_pred_def rec_exec.simps)
   181 
   170 
   182 text {*
   171 lemma minus_lemma: "rec_exec rec_minus [x, y] = x - y"
   183   Correctness of @{text "rec_minus"}.
       
   184   *}
       
   185 lemma minus_lemma: "\<And> x y. rec_exec rec_minus [x, y] = x - y"
       
   186 by(induct_tac y, auto simp: rec_exec.simps rec_minus_def pred_lemma)
   172 by(induct_tac y, auto simp: rec_exec.simps rec_minus_def pred_lemma)
   187 
   173 
   188 text {*
   174 lemma sg_lemma: "rec_exec rec_sg [x] = (if x = 0 then 0 else 1)"
   189   Correctness of @{text "rec_sg"}.
       
   190   *}
       
   191 lemma sg_lemma: "\<And> x. rec_exec rec_sg [x] = (if x = 0 then 0 else 1)"
       
   192 by(auto simp: rec_sg_def minus_lemma rec_exec.simps constn.simps)
   175 by(auto simp: rec_sg_def minus_lemma rec_exec.simps constn.simps)
   193 
   176 
   194 text {*
       
   195   Correctness of @{text "constn"}.
       
   196   *}
       
   197 lemma constn_lemma: "rec_exec (constn n) [x] = n"
   177 lemma constn_lemma: "rec_exec (constn n) [x] = n"
   198 by(induct n, auto simp: rec_exec.simps constn.simps)
   178 by(induct n, auto simp: rec_exec.simps constn.simps)
   199 
   179 
   200 text {*
   180 lemma less_lemma: "rec_exec rec_less [x, y] = (if x < y then 1 else 0)"
   201   Correctness of @{text "rec_less"}.
       
   202   *}
       
   203 lemma less_lemma: "\<And> x y. rec_exec rec_less [x, y] = 
       
   204   (if x < y then 1 else 0)"
       
   205 by(induct_tac y, auto simp: rec_exec.simps 
   181 by(induct_tac y, auto simp: rec_exec.simps 
   206   rec_less_def minus_lemma sg_lemma)
   182   rec_less_def minus_lemma sg_lemma)
   207 
   183 
   208 text {*
   184 lemma not_lemma: "rec_exec rec_not [x] = (if x = 0 then 1 else 0)"
   209   Correctness of @{text "rec_not"}.
       
   210   *}
       
   211 lemma not_lemma: 
       
   212   "\<And> x. rec_exec rec_not [x] = (if x = 0 then 1 else 0)"
       
   213 by(induct_tac x, auto simp: rec_exec.simps rec_not_def
   185 by(induct_tac x, auto simp: rec_exec.simps rec_not_def
   214   constn_lemma minus_lemma)
   186   constn_lemma minus_lemma)
   215 
   187 
   216 text {*
   188 lemma eq_lemma: "rec_exec rec_eq [x, y] = (if x = y then 1 else 0)"
   217   Correctness of @{text "rec_eq"}.
       
   218   *}
       
   219 lemma eq_lemma: "\<And> x y. rec_exec rec_eq [x, y] = (if x = y then 1 else 0)"
       
   220 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_exec.simps rec_eq_def constn_lemma add_lemma minus_lemma)
   221 
   190 
   222 text {*
   191 lemma conj_lemma: "rec_exec rec_conj [x, y] = (if x = 0 \<or> y = 0 then 0 else 1)"
   223   Correctness of @{text "rec_conj"}.
       
   224   *}
       
   225 lemma conj_lemma: "\<And> x y. rec_exec rec_conj [x, y] = (if x = 0 \<or> y = 0 then 0 
       
   226                                                        else 1)"
       
   227 by(induct_tac y, auto simp: rec_exec.simps sg_lemma rec_conj_def mult_lemma)
   192 by(induct_tac y, auto simp: rec_exec.simps sg_lemma rec_conj_def mult_lemma)
   228 
   193 
   229 text {*
   194 lemma disj_lemma: "rec_exec rec_disj [x, y] = (if x = 0 \<and> y = 0 then 0 else 1)"
   230   Correctness of @{text "rec_disj"}.
       
   231   *}
       
   232 lemma disj_lemma: "\<And> x y. rec_exec rec_disj [x, y] = (if x = 0 \<and> y = 0 then 0
       
   233                                                      else 1)"
       
   234 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_exec.simps)
   235 
   196 
   236 
   197 declare mult_lemma[simp] add_lemma[simp] pred_lemma[simp] 
   237 text {*
   198         minus_lemma[simp] sg_lemma[simp] constn_lemma[simp] 
   238   @{text "primrec recf n"} is true iff 
   199         less_lemma[simp] not_lemma[simp] eq_lemma[simp]
   239   @{text "recf"} is a primitive recursive function 
   200         conj_lemma[simp] disj_lemma[simp]
   240   with arity @{text "n"}.
   201 
   241   *}
   202 text {*
       
   203   @{text "primrec recf n"} is true iff @{text "recf"} is a primitive
       
   204   recursive function with arity @{text "n"}.
       
   205   *}
       
   206 
   242 inductive primerec :: "recf \<Rightarrow> nat \<Rightarrow> bool"
   207 inductive primerec :: "recf \<Rightarrow> nat \<Rightarrow> bool"
   243   where
   208   where
   244 prime_z[intro]:  "primerec z (Suc 0)" |
   209 prime_z[intro]:  "primerec z (Suc 0)" |
   245 prime_s[intro]:  "primerec s (Suc 0)" |
   210 prime_s[intro]:  "primerec s (Suc 0)" |
   246 prime_id[intro!]: "\<lbrakk>n < m\<rbrakk> \<Longrightarrow> primerec (id m n) m" |
   211 prime_id[intro!]: "\<lbrakk>n < m\<rbrakk> \<Longrightarrow> primerec (id m n) m" |
   257 inductive_cases prime_s_reverse[elim]: "primerec s n"
   222 inductive_cases prime_s_reverse[elim]: "primerec s n"
   258 inductive_cases prime_id_reverse[elim]: "primerec (id m n) k"
   223 inductive_cases prime_id_reverse[elim]: "primerec (id m n) k"
   259 inductive_cases prime_cn_reverse[elim]: "primerec (Cn n f gs) m"
   224 inductive_cases prime_cn_reverse[elim]: "primerec (Cn n f gs) m"
   260 inductive_cases prime_pr_reverse[elim]: "primerec (Pr n f g) m"
   225 inductive_cases prime_pr_reverse[elim]: "primerec (Pr n f g) m"
   261 
   226 
   262 declare mult_lemma[simp] add_lemma[simp] pred_lemma[simp] 
   227 
   263         minus_lemma[simp] sg_lemma[simp] constn_lemma[simp] 
       
   264         less_lemma[simp] not_lemma[simp] eq_lemma[simp]
       
   265         conj_lemma[simp] disj_lemma[simp]
       
   266 
   228 
   267 text {*
   229 text {*
   268   @{text "Sigma"} is the logical specification of 
   230   @{text "Sigma"} is the logical specification of 
   269   the recursive function @{text "rec_sigma"}.
   231   the recursive function @{text "rec_sigma"}.
   270   *}
   232   *}
   271 function Sigma :: "(nat list \<Rightarrow> nat) \<Rightarrow> nat list \<Rightarrow> nat"
   233 function Sigma :: "(nat list \<Rightarrow> nat) \<Rightarrow> nat list \<Rightarrow> nat"
   272   where
   234   where
   273   "Sigma g xs = (if last xs = 0 then g xs
   235   "Sigma g xs = (if last xs = 0 then g xs
   274                  else (Sigma g (butlast xs @ [last xs - 1]) +
   236                  else (Sigma g (butlast xs @ [last xs - 1]) + g xs)) "
   275                        g xs)) "
       
   276 by pat_completeness auto
   237 by pat_completeness auto
       
   238 
   277 termination
   239 termination
   278 proof
   240 proof
   279   show "wf (measure (\<lambda> (f, xs). last xs))" by auto
   241   show "wf (measure (\<lambda> (f, xs). last xs))" by auto
   280 next
   242 next
   281   fix g xs
   243   fix g xs
   282   assume "last (xs::nat list) \<noteq> 0"
   244   assume "last (xs::nat list) \<noteq> 0"
   283   thus "((g, butlast xs @ [last xs - 1]), g, xs)  
   245   thus "((g, butlast xs @ [last xs - 1]), g, xs) \<in> measure (\<lambda>(f, xs). last xs)"
   284                    \<in> measure (\<lambda>(f, xs). last xs)"
       
   285     by auto
   246     by auto
   286 qed
   247 qed
   287 
   248 
   288 declare rec_exec.simps[simp del] get_fstn_args.simps[simp del]
   249 declare rec_exec.simps[simp del] get_fstn_args.simps[simp del]
   289         arity.simps[simp del] Sigma.simps[simp del]
   250         arity.simps[simp del] Sigma.simps[simp del]
   290         rec_sigma.simps[simp del]
   251         rec_sigma.simps[simp del]
   291 
   252 
   292 lemma [simp]: "arity z = 1"
   253 lemma [simp]: "arity z = 1"
   293  by(simp add: arity.simps)
   254   by(simp add: arity.simps)
   294 
   255 
   295 lemma rec_pr_0_simp_rewrite: "
   256 lemma rec_pr_0_simp_rewrite: "
   296   rec_exec (Pr n f g) (xs @ [0]) = rec_exec f xs"
   257   rec_exec (Pr n f g) (xs @ [0]) = rec_exec f xs"
   297 by(simp add: rec_exec.simps)
   258   by(simp add: rec_exec.simps)
   298 
   259 
   299 lemma rec_pr_0_simp_rewrite_single_param: "
   260 lemma rec_pr_0_simp_rewrite_single_param: "
   300   rec_exec (Pr n f g) [0] = rec_exec f []"
   261   rec_exec (Pr n f g) [0] = rec_exec f []"
       
   262   by(simp add: rec_exec.simps)
       
   263 
       
   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])])"
   301 by(simp add: rec_exec.simps)
   266 by(simp add: rec_exec.simps)
   302 
   267 
   303 lemma rec_pr_Suc_simp_rewrite: 
       
   304   "rec_exec (Pr n f g) (xs @ [Suc x]) =
       
   305                        rec_exec g (xs @ [x] @ 
       
   306                         [rec_exec (Pr n f g) (xs @ [x])])"
       
   307 by(simp add: rec_exec.simps)
       
   308 
       
   309 lemma rec_pr_Suc_simp_rewrite_single_param: 
   268 lemma rec_pr_Suc_simp_rewrite_single_param: 
   310   "rec_exec (Pr n f g) ([Suc x]) =
   269   "rec_exec (Pr n f g) ([Suc x]) = rec_exec g ([x] @ [rec_exec (Pr n f g) ([x])])"
   311            rec_exec g ([x] @ [rec_exec (Pr n f g) ([x])])"
       
   312 by(simp add: rec_exec.simps)
   270 by(simp add: rec_exec.simps)
   313 
   271 
   314 lemma Sigma_0_simp_rewrite_single_param:
   272 lemma Sigma_0_simp_rewrite_single_param:
   315   "Sigma f [0] = f [0]"
   273   "Sigma f [0] = f [0]"
   316 by(simp add: Sigma.simps)
   274 by(simp add: Sigma.simps)
   746 qed
   704 qed
   747 
   705 
   748 text {*
   706 text {*
   749   The correctness of @{text "rec_Minr"}.
   707   The correctness of @{text "rec_Minr"}.
   750   *}
   708   *}
   751 lemma Minr_lemma: "
   709 lemma Minr_lemma: 
   752   \<lbrakk>primerec rf (Suc (length xs))\<rbrakk> 
   710   assumes h: "primerec rf (Suc (length xs))" 
   753      \<Longrightarrow> rec_exec (rec_Minr rf) (xs @ [w]) = 
   711   shows "rec_exec (rec_Minr rf) (xs @ [w]) = Minr (\<lambda> args. (0 < rec_exec rf args)) xs w"
   754             Minr (\<lambda> args. (0 < rec_exec rf args)) xs w"
       
   755 proof -
   712 proof -
   756   let ?rt = "(recf.id (Suc (length xs)) ((length xs)))"
   713   let ?rt = "(recf.id (Suc (length xs)) ((length xs)))"
   757   let ?rf = "(Cn (Suc (Suc (length xs))) 
   714   let ?rf = "(Cn (Suc (Suc (length xs))) 
   758     rec_not [Cn (Suc (Suc (length xs))) rf 
   715     rec_not [Cn (Suc (Suc (length xs))) rf 
   759     (get_fstn_args (Suc (Suc (length xs))) (length xs) @ 
   716     (get_fstn_args (Suc (Suc (length xs))) (length xs) @ 
   760                 [recf.id (Suc (Suc (length xs))) 
   717                 [recf.id (Suc (Suc (length xs))) 
   761     (Suc ((length xs)))])])"
   718     (Suc ((length xs)))])])"
   762   let ?rq = "(rec_all ?rt ?rf)"
   719   let ?rq = "(rec_all ?rt ?rf)"
   763   assume h: "primerec rf (Suc (length xs))"
       
   764   have h1: "primerec ?rq (Suc (length xs))"
   720   have h1: "primerec ?rq (Suc (length xs))"
   765     apply(rule_tac primerec_all_iff)
   721     apply(rule_tac primerec_all_iff)
   766     apply(auto simp: h nth_append)+
   722     apply(auto simp: h nth_append)+
   767     done
   723     done
   768   moreover have "arity rf = Suc (length xs)"
   724   moreover have "arity rf = Suc (length xs)"
   769     using h by auto
   725     using h by auto
   770   ultimately show "rec_exec (rec_Minr rf) (xs @ [w]) = 
   726   ultimately show "rec_exec (rec_Minr rf) (xs @ [w]) = Minr (\<lambda> args. (0 < rec_exec rf args)) xs w"
   771     Minr (\<lambda> args. (0 < rec_exec rf args)) xs w"
       
   772     apply(simp add: rec_exec.simps rec_Minr.simps arity.simps Let_def 
   727     apply(simp add: rec_exec.simps rec_Minr.simps arity.simps Let_def 
   773                     sigma_lemma all_lemma)
   728                     sigma_lemma all_lemma)
   774     apply(rule_tac  sigma_minr_lemma)
   729     apply(rule_tac  sigma_minr_lemma)
   775     apply(simp add: h)
   730     apply(simp add: h)
   776     done
   731     done
   787 
   742 
   788 text {*
   743 text {*
   789   The correctness of @{text "rec_le"}.
   744   The correctness of @{text "rec_le"}.
   790   *}
   745   *}
   791 lemma le_lemma: 
   746 lemma le_lemma: 
   792   "\<And>x y. rec_exec rec_le [x, y] = (if (x \<le> y) then 1 else 0)"
   747   "rec_exec rec_le [x, y] = (if (x \<le> y) then 1 else 0)"
   793 by(auto simp: rec_le_def rec_exec.simps)
   748 by(auto simp: rec_le_def rec_exec.simps)
   794 
   749 
   795 text {*
   750 text {*
   796   Definition of @{text "Max[Rr]"} on page 77 of Boolos's book.
   751   Definition of @{text "Max[Rr]"} on page 77 of Boolos's book.
   797 *}
   752 *}
   855   apply(rule_tac prime_cn, auto)
   810   apply(rule_tac prime_cn, auto)
   856   apply(case_tac i, auto)
   811   apply(case_tac i, auto)
   857   done
   812   done
   858 
   813 
   859 lemma [simp]:  
   814 lemma [simp]:  
   860   "length ys = Suc n \<Longrightarrow> (take n ys @ [ys ! n, ys ! n]) =  
   815   "length ys = Suc n \<Longrightarrow> (take n ys @ [ys ! n, ys ! n]) = ys @ [ys ! n]"
   861                                                   ys @ [ys ! n]"
       
   862 apply(simp)
   816 apply(simp)
   863 apply(subgoal_tac "\<exists> xs y. ys = xs @ [y]", auto)
   817 apply(subgoal_tac "\<exists> xs y. ys = xs @ [y]", auto)
   864 apply(rule_tac x = "butlast ys" in exI, rule_tac x = "last ys" in exI)
   818 apply(rule_tac x = "butlast ys" in exI, rule_tac x = "last ys" in exI)
   865 apply(case_tac "ys = []", simp_all)
   819 apply(case_tac "ys = []", simp_all)
   866 done
   820 done