ProgTutorial/Package/Ind_Code.thy
changeset 190 ca0ac2e75f6d
parent 189 069d525f8f1d
child 192 2fff636e1fa0
equal deleted inserted replaced
189:069d525f8f1d 190:ca0ac2e75f6d
    31   expanding the defs, gives 
    31   expanding the defs, gives 
    32   
    32   
    33   @{text [display]
    33   @{text [display]
    34   "\<forall>xs. As \<longrightarrow> (\<forall>ys. Bs \<longrightarrow> (\<forall>preds. orules \<longrightarrow> pred ss))\<^isup>* \<longrightarrow>  (\<forall>preds. orules \<longrightarrow> pred ts"}
    34   "\<forall>xs. As \<longrightarrow> (\<forall>ys. Bs \<longrightarrow> (\<forall>preds. orules \<longrightarrow> pred ss))\<^isup>* \<longrightarrow>  (\<forall>preds. orules \<longrightarrow> pred ts"}
    35   
    35   
    36   applying as many allI and impI as possible
    36   By applying as many allI and impI as possible, we have
    37   
    37   
    38   so we have @{text "As"}, @{text "(\<forall>ys. Bs \<longrightarrow> (\<forall>preds. orules \<longrightarrow> pred ss))\<^isup>*"},
    38   @{text "As"}, @{text "(\<forall>ys. Bs \<longrightarrow> (\<forall>preds. orules \<longrightarrow> pred ss))\<^isup>*"},
    39   @{text "orules"}; and have to show @{text "pred ts"}
    39   @{text "orules"}; and have to show @{text "pred ts"}
    40 
    40 
    41   the $i$th @{text "orule"} is of the 
    41   the $i$th @{text "orule"} is of the 
    42   form @{text "\<forall>xs. As \<longrightarrow> (\<forall>ys. Bs \<longrightarrow> pred ss)\<^isup>* \<longrightarrow> pred ts"}.
    42   form @{text "\<forall>xs. As \<longrightarrow> (\<forall>ys. Bs \<longrightarrow> pred ss)\<^isup>* \<longrightarrow> pred ts"}.
    43   
    43   
    44   using the @{text "As"} we ????
    44   So we apply the $i$th @{text "orule"}, but we have to show the @{text "As"} (by assumption)
    45 *}
    45   and all @{text "(\<forall>ys. Bs \<longrightarrow> pred ss)\<^isup>*"}. For the latter we use the assumptions
    46 
    46   @{text "(\<forall>ys. Bs \<longrightarrow> (\<forall>preds. orules \<longrightarrow> pred ss))\<^isup>*"} and @{text "orules"}.
    47 
    47 
    48 text {*
    48 *}
    49   First we have to produce for each predicate its definitions of the form
    49 
       
    50 
       
    51 text {*
       
    52   First we have to produce for each predicate the definition of the form
    50 
    53 
    51   @{text [display] "pred \<equiv> \<lambda>zs. \<forall>preds. orules \<longrightarrow> pred zs"}
    54   @{text [display] "pred \<equiv> \<lambda>zs. \<forall>preds. orules \<longrightarrow> pred zs"}
    52 
    55 
    53   In order to make definitions, we use the following wrapper for 
    56   and then ``register'' the definitions with Isabelle. 
       
    57   To do the latter, we use the following wrapper for 
    54   @{ML LocalTheory.define}. The wrapper takes a predicate name, a syntax
    58   @{ML LocalTheory.define}. The wrapper takes a predicate name, a syntax
    55   annotation and a term representing the right-hand side of the definition.
    59   annotation and a term representing the right-hand side of the definition.
    56 *}
    60 *}
    57 
    61 
    58 ML %linenosgray{*fun make_defs ((predname, syn), trm) lthy =
    62 ML %linenosgray{*fun make_defs ((predname, syn), trm) lthy =
    90   \begin{isabelle}
    94   \begin{isabelle}
    91   \isacommand{thm}~@{text "MyTrue_def"}\\
    95   \isacommand{thm}~@{text "MyTrue_def"}\\
    92   @{text "> MyTrue \<equiv> True"}
    96   @{text "> MyTrue \<equiv> True"}
    93   \end{isabelle}
    97   \end{isabelle}
    94 
    98 
    95   The next two functions construct the terms we need for the definitions for
    99   The next two functions construct the right-hand sides of the definitions, which
    96   our \isacommand{simple\_inductive} command. These 
   100   are of the form 
    97   terms are of the form 
   101 
    98 
   102   @{text [display] "\<lambda>zs. \<forall>preds. orules \<longrightarrow> pred zs"}
    99   @{text [display] "\<lambda>\<^raw:$zs$>. \<forall>preds. orules \<longrightarrow> pred \<^raw:$zs$>"}
   103 
   100 
   104   The variables @{text "zs"} need to be chosen so that they do not occur
   101   The variables @{text "\<^raw:$zs$>"} need to be chosen so that they do not occur
       
   102   in the @{text orules} and also be distinct from the @{text "preds"}. 
   105   in the @{text orules} and also be distinct from the @{text "preds"}. 
   103 
   106 
   104   The first function constructs the term for one particular predicate, say
   107   The first function constructs the term for one particular predicate, say
   105   @{text "pred"}; the number of arguments of this predicate is
   108   @{text "pred"}; the number of arguments of this predicate is
   106   determined by the number of argument types of @{text "arg_tys"}. 
   109   determined by the number of argument types given in @{text "arg_tys"}. 
   107   So it takes these two parameters as arguments. The other arguments are
   110   The other arguments are all @{text "preds"} and the @{text "orules"}.
   108   all the @{text "preds"} and the @{text "orules"}.
       
   109 *}
   111 *}
   110 
   112 
   111 ML %linenosgray{*fun defs_aux lthy orules preds (pred, arg_tys) =
   113 ML %linenosgray{*fun defs_aux lthy orules preds (pred, arg_tys) =
   112 let 
   114 let 
   113   fun mk_all x P = HOLogic.all_const (fastype_of x) $ lambda x P
   115   fun mk_all x P = HOLogic.all_const (fastype_of x) $ lambda x P
   125 end*}
   127 end*}
   126 
   128 
   127 text {*
   129 text {*
   128   The function in Line 3 is just a helper function for constructing universal
   130   The function in Line 3 is just a helper function for constructing universal
   129   quantifications. The code in Lines 5 to 9 produces the fresh @{text
   131   quantifications. The code in Lines 5 to 9 produces the fresh @{text
   130   "\<^raw:$zs$>"}. For this it pairs every argument type with the string
   132   "zs"}. For this it pairs every argument type with the string
   131   @{text [quotes] "z"} (Line 7); then generates variants for all these strings
   133   @{text [quotes] "z"} (Line 7); then generates variants for all these strings
   132   so that they are unique w.r.t.~to the @{text "orules"} and the predicates;
   134   so that they are unique w.r.t.~to the predicates and @{text "orules"} (Line 8);
   133   in Line 9 it generates the corresponding variable terms for the unique
   135   in Line 9 it generates the corresponding variable terms for the unique
   134   strings.
   136   strings.
   135 
   137 
   136   The unique free variables are applied to the predicate (Line 11) using the
   138   The unique free variables are applied to the predicate (Line 11) using the
   137   function @{ML list_comb}; then the @{text orules} are prefixed (Line 12); in
   139   function @{ML list_comb}; then the @{text orules} are prefixed (Line 12); in
   138   Line 13 we quantify over all predicates; and in line 14 we just abstract
   140   Line 13 we quantify over all predicates; and in line 14 we just abstract
   139   over all the @{text "\<^raw:$zs$>"}, i.e.~the fresh arguments of the
   141   over all the @{text "zs"}, i.e.~the fresh arguments of the
   140   predicate.
   142   predicate. A testcase for this function is
   141 
       
   142   A testcase for this function is
       
   143 *}
   143 *}
   144 
   144 
   145 local_setup %gray{* fn lthy =>
   145 local_setup %gray{* fn lthy =>
   146 let
   146 let
   147   val orules = [@{prop "even 0"},
   147   val orules = [@{prop "even 0"},
   148                 @{prop "\<forall>n::nat. odd n \<longrightarrow> even (Suc n)"},
   148                 @{prop "\<forall>n::nat. odd n \<longrightarrow> even (Suc n)"},
   149                 @{prop "\<forall>n::nat. even n \<longrightarrow> odd (Suc n)"}] 
   149                 @{prop "\<forall>n::nat. even n \<longrightarrow> odd (Suc n)"}] 
   150   val preds = [@{term "even::nat\<Rightarrow>bool"}, @{term "odd::nat\<Rightarrow>bool"}, @{term "z::nat"}]
   150   val preds = [@{term "even::nat\<Rightarrow>bool"}, @{term "odd::nat\<Rightarrow>bool"}]
   151   val pred = @{term "even::nat\<Rightarrow>bool"}
   151   val pred = @{term "even::nat\<Rightarrow>bool"}
   152   val arg_tys = [@{typ "nat"}]
   152   val arg_tys = [@{typ "nat"}]
   153   val def = defs_aux lthy orules preds (pred, arg_tys)
   153   val def = defs_aux lthy orules preds (pred, arg_tys)
   154 in
   154 in
   155   warning (Syntax.string_of_term lthy def); lthy
   155   warning (Syntax.string_of_term lthy def); lthy
   156 end *}
   156 end *}
   157 
   157 
   158 text {*
   158 text {*
   159   It constructs the left-hand side for the definition of @{text "even"}. So we obtain 
   159   It calls @{ML defs_aux} for the definition of @{text "even"} and prints
   160   as printout the term
   160   out the definition. So we obtain as printout 
   161 
   161 
   162   @{text [display] 
   162   @{text [display] 
   163 "\<lambda>z. \<forall>even odd. (even 0) \<longrightarrow> (\<forall>n. odd n \<longrightarrow> even (Suc n)) 
   163 "\<lambda>z. \<forall>even odd. (even 0) \<longrightarrow> (\<forall>n. odd n \<longrightarrow> even (Suc n)) 
   164                          \<longrightarrow> (\<forall>n. even n \<longrightarrow> odd (Suc n)) \<longrightarrow> even z"}
   164                          \<longrightarrow> (\<forall>n. even n \<longrightarrow> odd (Suc n)) \<longrightarrow> even z"}
   165 
   165 
   166   The main function for the definitions now has to just iterate the function
   166   The second function for the definitions has to just iterate the function
   167   @{ML defs_aux} over all predicates. The argument @{text "preds"} is again
   167   @{ML defs_aux} over all predicates. The argument @{text "preds"} is again
   168   the the list of predicates as @{ML_type term}s; the argument @{text
   168   the the list of predicates as @{ML_type term}s; the argument @{text
   169   "prednames"} is the list of names of the predicates; @{text "arg_tyss"} is
   169   "prednames"} is the list of names of the predicates; @{text "arg_tyss"} is
   170   the list of argument-type-lists for each predicate.
   170   the list of argument-type-lists for each predicate.
   171 *}
   171 *}
   186   meta-connectives). To do this transformation we have to obtain the theory
   186   meta-connectives). To do this transformation we have to obtain the theory
   187   behind the local theory (Line 3); with this theory we can use the function
   187   behind the local theory (Line 3); with this theory we can use the function
   188   @{ML ObjectLogic.atomize_term} to make the transformation (Line 4). The call
   188   @{ML ObjectLogic.atomize_term} to make the transformation (Line 4). The call
   189   to @{ML defs_aux} in Line 5 produces all left-hand sides of the
   189   to @{ML defs_aux} in Line 5 produces all left-hand sides of the
   190   definitions. The actual definitions are then made in Line 7.  The result
   190   definitions. The actual definitions are then made in Line 7.  The result
   191   of the function is a list of theorems and a local theory.
   191   of the function is a list of theorems and a local theory. A testcase for 
   192 
   192   this function is 
   193 
       
   194   A testcase for this function is 
       
   195 *}
   193 *}
   196 
   194 
   197 local_setup %gray {* fn lthy =>
   195 local_setup %gray {* fn lthy =>
   198 let
   196 let
   199   val rules = [@{prop "even 0"},
   197   val rules = [@{prop "even 0"},
   238 apply(drule spec[where x=Q])
   236 apply(drule spec[where x=Q])
   239 apply(assumption)
   237 apply(assumption)
   240 done
   238 done
   241 
   239 
   242 text {* 
   240 text {* 
   243   The code for such induction principles has to accomplish two tasks: 
   241   The code for automating such induction principles has to accomplish two tasks: 
   244   constructing the induction principles from the given introduction
   242   constructing the induction principles from the given introduction
   245   rules and then automatically generating a proof of them using a tactic. 
   243   rules and then automatically generating proofs for them using a tactic. 
   246   
   244   
   247   The tactic will use the following helper function for instantiating universal 
   245   The tactic will use the following helper function for instantiating universal 
   248   quantifiers. 
   246   quantifiers. 
   249 *}
   247 *}
   250 
   248 
   258 
   256 
   259 ML{*fun inst_spec_tac ctrms = 
   257 ML{*fun inst_spec_tac ctrms = 
   260   EVERY' (map (dtac o inst_spec) ctrms)*}
   258   EVERY' (map (dtac o inst_spec) ctrms)*}
   261 
   259 
   262 text {*
   260 text {*
   263   we can use @{ML inst_spec} in the following proof to instantiate the 
   261   we can use @{ML inst_spec_tac} in the following proof to instantiate the 
   264   three quantifiers in the assumption. 
   262   three quantifiers in the assumption. 
   265 *}
   263 *}
   266 
   264 
   267 lemma 
   265 lemma 
   268   fixes P::"nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool"
   266   fixes P::"nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool"
   288           K (rewrite_goals_tac defs),
   286           K (rewrite_goals_tac defs),
   289           inst_spec_tac insts,
   287           inst_spec_tac insts,
   290           assume_tac]*}
   288           assume_tac]*}
   291 
   289 
   292 text {*
   290 text {*
   293   We only have to give it as arguments the definitions, the premise 
   291   We only have to give it the definitions, the premise (like @{text "even n"})
   294   (like @{text "even n"}) 
   292   and the instantiations as arguments. Compare this with the manual proof
   295   and the instantiations. Compare this with the manual proof given for the
   293   given for the lemma @{thm [source] man_ind_principle}: there is almos a
   296   lemma @{thm [source] man_ind_principle}.  
   294   one-to-one correspondence between the \isacommand{apply}-script and the
   297   A testcase for this tactic is the function
   295   @{ML induction_tac}. A testcase for this tactic is the function
   298 *}
   296 *}
   299 
   297 
   300 ML{*fun test_tac prems = 
   298 ML{*fun test_tac prems = 
   301 let
   299 let
   302   val defs = [@{thm even_def}, @{thm odd_def}]
   300   val defs = [@{thm even_def}, @{thm odd_def}]
   307 
   305 
   308 text {*
   306 text {*
   309   which indeed proves the induction principle: 
   307   which indeed proves the induction principle: 
   310 *}
   308 *}
   311 
   309 
   312 lemma 
   310 lemma auto_ind_principle:
   313 assumes prems: "even n"
   311 assumes prems: "even n"
   314 shows "P 0 \<Longrightarrow> (\<And>m. Q m \<Longrightarrow> P (Suc m)) \<Longrightarrow> (\<And>m. P m \<Longrightarrow> Q (Suc m)) \<Longrightarrow> P n"
   312 shows "P 0 \<Longrightarrow> (\<And>m. Q m \<Longrightarrow> P (Suc m)) \<Longrightarrow> (\<And>m. P m \<Longrightarrow> Q (Suc m)) \<Longrightarrow> P n"
   315 apply(tactic {* test_tac @{thms prems} *})
   313 apply(tactic {* test_tac @{thms prems} *})
   316 done
   314 done
   317 
   315 
   320   it is a bit harder to construct the goals from the introduction 
   318   it is a bit harder to construct the goals from the introduction 
   321   rules the user provides. In general we have to construct for each predicate 
   319   rules the user provides. In general we have to construct for each predicate 
   322   @{text "pred"} a goal of the form
   320   @{text "pred"} a goal of the form
   323 
   321 
   324   @{text [display] 
   322   @{text [display] 
   325   "\<And>\<^raw:$zs$>. pred \<^raw:$zs$> \<Longrightarrow> rules[preds := \<^raw:$Ps$>] \<Longrightarrow> \<^raw:$P$> \<^raw:$zs$>"}
   323   "pred ?zs \<Longrightarrow> rules[preds := ?Ps] \<Longrightarrow> ?P$ ?zs"}
   326 
   324 
   327   where the given predicates @{text preds} are replaced in the introduction 
   325   where the predicates @{text preds} are replaced in the introduction 
   328   rules by new distinct variables written @{text "\<^raw:$Ps$>"}. 
   326   rules by new distinct variables written @{text "Ps"}.
   329   We also need to generate fresh arguments for the predicate @{text "pred"} in
   327   We also need to generate fresh arguments for the predicate @{text "pred"} in
   330   the premise and the @{text "\<^raw:$P$>"} in the conclusion. We achieve
   328   the premise and the @{text "?P"} in the conclusion. Note 
       
   329   that the  @{text "?Ps"}  and @{text "?zs"} need to be
       
   330   schematic variables that can be instantiated. This corresponds to what the
       
   331   @{thm [source] auto_ind_principle} looks like:
       
   332 
       
   333   \begin{isabelle}
       
   334   \isacommand{thm}~@{thm [source] auto_ind_principle}\\
       
   335   @{text "> \<lbrakk>even ?n; ?P 0; \<And>m. ?Q m \<Longrightarrow> ?P (Suc m); \<And>m. ?P m \<Longrightarrow> ?Q (Suc m)\<rbrakk> \<Longrightarrow> ?P ?n"}
       
   336   \end{isabelle}
       
   337 
       
   338   We achieve
   331   that in two steps. 
   339   that in two steps. 
   332 
   340 
   333   The function below expects that the introduction rules are already appropriately
   341   The function below expects that the introduction rules are already appropriately
   334   substituted. The argument @{text "srules"} stands for these substituted
   342   substituted. The argument @{text "srules"} stands for these substituted
   335    rules; @{text cnewpreds} are the certified terms coresponding
   343    rules; @{text cnewpreds} are the certified terms coresponding
   336   to the variables @{text "\<^raw:$Ps$>"}; @{text "pred"} is the predicate for
   344   to the variables @{text "Ps"}; @{text "pred"} is the predicate for
   337   which we prove the introduction principle; @{text "newpred"} is its
   345   which we prove the introduction principle; @{text "newpred"} is its
   338   replacement and @{text "tys"} are the argument types of this predicate.
   346   replacement and @{text "tys"} are the argument types of this predicate.
   339 *}
   347 *}
   340 
   348 
   341 ML %linenosgray{*fun prove_induction lthy defs srules cnewpreds ((pred, newpred), tys)  =
   349 ML %linenosgray{*fun prove_induction lthy defs srules cnewpreds ((pred, newpred), arg_tys)  =
   342 let
   350 let
   343   val zs = replicate (length tys) "z"
   351   val zs = replicate (length arg_tys) "z"
   344   val (newargnames, lthy') = Variable.variant_fixes zs lthy;
   352   val (newargnames, lthy') = Variable.variant_fixes zs lthy;
   345   val newargs = map Free (newargnames ~~ tys)
   353   val newargs = map Free (newargnames ~~ arg_tys)
   346   
   354   
   347   val prem = HOLogic.mk_Trueprop (list_comb (pred, newargs))
   355   val prem = HOLogic.mk_Trueprop (list_comb (pred, newargs))
   348   val goal = Logic.list_implies 
   356   val goal = Logic.list_implies 
   349          (srules, HOLogic.mk_Trueprop (list_comb (newpred, newargs)))
   357          (srules, HOLogic.mk_Trueprop (list_comb (newpred, newargs)))
   350 in
   358 in
   352   (fn {prems, ...} => induction_tac defs prems cnewpreds)
   360   (fn {prems, ...} => induction_tac defs prems cnewpreds)
   353   |> singleton (ProofContext.export lthy' lthy)
   361   |> singleton (ProofContext.export lthy' lthy)
   354 end *}
   362 end *}
   355 
   363 
   356 text {* 
   364 text {* 
   357   In Line 3 we produce names @{text "\<^raw:$zs$>"} for each type in the 
   365   In Line 3 we produce names @{text "zs"} for each type in the 
   358   argument type list. Line 4 makes these names unique and declares them as 
   366   argument type list. Line 4 makes these names unique and declares them as 
   359   \emph{free} (but fixed) variables in the local theory @{text "lthy'"}. In 
   367   \emph{free} (but fixed) variables in the local theory @{text "lthy'"}. In 
   360   Line 5 we just construct the terms corresponding to these variables. 
   368   Line 5 we just construct the terms corresponding to these variables. 
   361   The term variables are applied to the predicate in Line 7 (this corresponds
   369   The term variables are applied to the predicate in Line 7 (this corresponds
   362   to the first premise @{text "pred \<^raw:$zs$>"} of the induction principle). 
   370   to the first premise @{text "pred zs"} of the induction principle). 
   363   In Line 8 and 9, we first construct the term  @{text "\<^raw:$P$>\<^raw:$zs$>"} 
   371   In Line 8 and 9, we first construct the term  @{text "P zs"} 
   364   and then add the (substituded) introduction rules as premises. In case that
   372   and then add the (substituded) introduction rules as premises. In case that
   365   no introduction rules are given, the conclusion of this implication needs
   373   no introduction rules are given, the conclusion of this implication needs
   366   to be wrapped inside a @{term Trueprop}, otherwise the Isabelle's goal
   374   to be wrapped inside a @{term Trueprop}, otherwise the Isabelle's goal
   367   mechanism will fail. 
   375   mechanism will fail. 
   368 
   376 
   369   In Line 11 we set up the goal to be proved; in the next line call the tactic
   377   In Line 11 we set up the goal to be proved; in the next line we call the tactic
   370   for proving the induction principle. This tactic expects definitions, the
   378   for proving the induction principle. This tactic expects the definitions, the
   371   premise and the (certified) predicates with which the introduction rules
   379   premise and the (certified) predicates with which the introduction rules
   372   have been substituted. This will return a theorem. However, it is a theorem
   380   have been substituted. The code in these two lines will return a theorem. 
       
   381   However, it is a theorem
   373   proved inside the local theory @{text "lthy'"}, where the variables @{text
   382   proved inside the local theory @{text "lthy'"}, where the variables @{text
   374   "\<^raw:$zs$>"} are fixed, but free. By exporting this theorem from @{text
   383   "zs"} are fixed, but free. By exporting this theorem from @{text
   375   "lthy'"} (which contains the @{text "\<^raw:$zs$>"} as free) to @{text
   384   "lthy'"} (which contains the @{text "zs"} as free) to @{text
   376   "lthy"} (which does not), we obtain the desired quantifications @{text
   385   "lthy"} (which does not), we obtain the desired schematic variables.
   377   "\<And>\<^raw:$zs$>"}.
   386 *}
   378 
   387 
   379   (FIXME testcase)
   388 local_setup %gray{* fn lthy =>
   380 
   389 let
   381 
   390   val defs = [@{thm even_def}, @{thm odd_def}]
   382   Now it is left to produce the new predicates with which the introduction
   391   val srules = [@{prop "P (0::nat)"},
   383   rules are substituted. 
   392                 @{prop "\<And>n::nat. Q n \<Longrightarrow> P (Suc n)"},
       
   393                 @{prop "\<And>n::nat. P n \<Longrightarrow> Q (Suc n)"}] 
       
   394   val cnewpreds = [@{cterm "P::nat\<Rightarrow>bool"}, @{cterm "Q::nat\<Rightarrow>bool"}]
       
   395   val pred = @{term "even::nat\<Rightarrow>bool"}
       
   396   val newpred = @{term "P::nat\<Rightarrow>bool"}
       
   397   val arg_tys = [@{typ "nat"}]
       
   398   val intro = 
       
   399     prove_induction lthy defs srules cnewpreds ((pred, newpred), arg_tys)
       
   400 in
       
   401   warning (str_of_thm_raw lthy intro); lthy
       
   402 end *} 
       
   403 
       
   404 text {*
       
   405   This prints out:
       
   406 
       
   407   @{text [display]
       
   408   " \<lbrakk>even ?z; P 0; \<And>n. Q n \<Longrightarrow> P (Suc n); \<And>n. P n \<Longrightarrow> Q (Suc n)\<rbrakk> \<Longrightarrow> P ?z"}
       
   409 
       
   410   Note that the export from @{text lthy'} to @{text lthy} in Line 13 above 
       
   411   has turned the free, but fixed, @{text "z"} into a schematic 
       
   412   variable @{text "?z"}.
       
   413 
       
   414   We still have to produce the new predicates with which the introduction
       
   415   rules are substituted and iterate @{ML prove_induction} over all
       
   416   predicates. This is what the next function does. 
   384 *}
   417 *}
   385 
   418 
   386 ML %linenosgray{*fun inductions rules defs preds arg_tyss lthy  =
   419 ML %linenosgray{*fun inductions rules defs preds arg_tyss lthy  =
   387 let
   420 let
   388   val Ps = replicate (length preds) "P"
   421   val Ps = replicate (length preds) "P"
   402 end*}
   435 end*}
   403 
   436 
   404 text {*
   437 text {*
   405   In Line 3 we generate a string @{text [quotes] "P"} for each predicate. 
   438   In Line 3 we generate a string @{text [quotes] "P"} for each predicate. 
   406   In Line 4, we use the same trick as in the previous function, that is making the 
   439   In Line 4, we use the same trick as in the previous function, that is making the 
   407   @{text "\<^raw:$Ps$>"} fresh and declaring them as fixed but free in
   440   @{text "Ps"} fresh and declaring them as fixed, but free, in
   408   the new local theory @{text "lthy'"}. From the local theory we extract
   441   the new local theory @{text "lthy'"}. From the local theory we extract
   409   the ambient theory in Line 6. We need this theory in order to certify 
   442   the ambient theory in Line 6. We need this theory in order to certify 
   410   the new predicates. In Line 8 we calculate the types of these new predicates
   443   the new predicates. In Line 8 we calculate the types of these new predicates
   411   using the argument types. Next we turn them into terms and subsequently
   444   using the given argument types. Next we turn them into terms and subsequently
   412   certify them. We can now produce the substituted introduction rules 
   445   certify them (Line 9 and 10). We can now produce the substituted introduction rules 
   413   (Line 11). Line 14 and 15 just iterate the proofs for all predicates.
   446   (Line 11) using the function @{ML subst_free}. Line 14 and 15 just iterate 
       
   447   the proofs for all predicates.
   414   From this we obtain a list of theorems. Finally we need to export the 
   448   From this we obtain a list of theorems. Finally we need to export the 
   415   fixed variables @{text "\<^raw:$Ps$>"} to obtain the correct quantification 
   449   fixed variables @{text "Ps"} to obtain the schematic variables 
   416   (Line 16).
   450   (Line 16).
   417 
   451 
   418   A testcase for this function is
   452   A testcase for this function is
   419 *}
   453 *}
   420 
   454 
   426   val defs = [@{thm even_def}, @{thm odd_def}]
   460   val defs = [@{thm even_def}, @{thm odd_def}]
   427   val preds = [@{term "even::nat\<Rightarrow>bool"}, @{term "odd::nat\<Rightarrow>bool"}]
   461   val preds = [@{term "even::nat\<Rightarrow>bool"}, @{term "odd::nat\<Rightarrow>bool"}]
   428   val tyss = [[@{typ "nat"}], [@{typ "nat"}]]
   462   val tyss = [[@{typ "nat"}], [@{typ "nat"}]]
   429   val ind_thms = inductions rules defs preds tyss lthy
   463   val ind_thms = inductions rules defs preds tyss lthy
   430 in
   464 in
   431   warning (str_of_thms lthy ind_thms); lthy
   465   warning (str_of_thms_raw lthy ind_thms); lthy
   432 end  
   466 end *}
   433 *}
       
   434 
   467 
   435 
   468 
   436 text {*
   469 text {*
   437   which prints out
   470   which prints out
   438 
   471 
   439 @{text [display]
   472 @{text [display]
   440 "> even z \<Longrightarrow> 
   473 "> even ?z \<Longrightarrow> ?P1 0 \<Longrightarrow> 
   441 >  P 0 \<Longrightarrow> (\<And>m. Pa m \<Longrightarrow> P (Suc m)) \<Longrightarrow> (\<And>m. P m \<Longrightarrow> Pa (Suc m)) \<Longrightarrow> P z,
   474 > (\<And>m. ?Pa1 m \<Longrightarrow> ?P1 (Suc m)) \<Longrightarrow> (\<And>m. ?P1 m \<Longrightarrow> ?Pa1 (Suc m)) \<Longrightarrow> ?P1 ?z,
   442 > odd z \<Longrightarrow> 
   475 > odd ?z \<Longrightarrow> ?P1 0 
   443 >  P 0 \<Longrightarrow> (\<And>m. Pa m \<Longrightarrow> P (Suc m)) \<Longrightarrow> (\<And>m. P m \<Longrightarrow> Pa (Suc m)) \<Longrightarrow> Pa z"}
   476 > \<Longrightarrow> (\<And>m. ?Pa1 m \<Longrightarrow> ?P1 (Suc m)) \<Longrightarrow> (\<And>m. ?P1 m \<Longrightarrow> ?Pa1 (Suc m)) \<Longrightarrow> ?Pa1 ?z"}
   444 
   477 
   445 
   478 
   446   This completes the code for the induction principles. Finally we can 
   479   Note that now both, the @{text "Ps"} and the @{text "zs"}, are schematic
   447   prove the introduction rules. 
   480   variables. The numbers have been introduced by the pretty-printer and are 
   448 
   481   not significant.
   449 *}
   482 
   450 
   483   This completes the code for the induction principles.  Finally we can prove the 
   451 ML {* ObjectLogic.rulify  *}
   484   introduction rules. Their proofs are quite a bit more involved. To ease them 
   452 
   485   somewhat we  use the following two helper function.
       
   486 *}
   453 
   487 
   454 ML{*val all_elims = fold (fn ct => fn th => th RS inst_spec ct)
   488 ML{*val all_elims = fold (fn ct => fn th => th RS inst_spec ct)
   455 val imp_elims = fold (fn th => fn th' => [th', th] MRS @{thm mp})*}
   489 val imp_elims = fold (fn th => fn th' => [th', th] MRS @{thm mp})*}
       
   490 
       
   491 text {* 
       
   492   To see what they do, let us suppose whe have the follwoing three
       
   493   theorems. 
       
   494 *}
       
   495 
       
   496 lemma all_elims_test:
       
   497   fixes P::"nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool"
       
   498   shows "\<forall>x y z. P x y z" sorry
       
   499 
       
   500 lemma imp_elims_test:
       
   501   fixes A B C::"bool"
       
   502   shows "A \<longrightarrow> B \<longrightarrow> C" sorry
       
   503 
       
   504 lemma imp_elims_test':
       
   505   fixes A::"bool"
       
   506   shows "A" "B" sorry
       
   507 
       
   508 text {*
       
   509   The function @{ML all_elims} takes a list of (certified) terms and instantiates
       
   510   theorems of the form @{thm [source] all_elims_test}. For example we can instantiate
       
   511   the quantifiers in this theorem with @{term a}, @{term b} and @{term c} as follows
       
   512 
       
   513   @{ML_response_fake [display, gray]
       
   514 "let
       
   515   val ctrms = [@{cterm \"a::nat\"}, @{cterm \"b::nat\"}, @{cterm \"c::nat\"}]
       
   516   val new_thm = all_elims ctrms @{thm all_elims_test}
       
   517 in
       
   518   warning (str_of_thm @{context} new_thm)
       
   519 end"
       
   520   "P a b c"}
       
   521 
       
   522   Similarly, the function @{ML imp_elims} eliminates preconditions from implications. 
       
   523   For example 
       
   524 
       
   525   @{ML_response_fake [display, gray]
       
   526 "warning (str_of_thm @{context} 
       
   527             (imp_elims @{thms imp_elims_test'} @{thm imp_elims_test}))"
       
   528   "C"}
       
   529 *}
       
   530 
       
   531 ML {* prems_of *}
       
   532 ML {* Logic.strip_params *}
       
   533 ML {* Logic.strip_assums_hyp *}
       
   534 
       
   535 ML {*
       
   536 fun chop_print_tac ctxt thm =
       
   537 let
       
   538   val [trm] = prems_of thm
       
   539   val params = map fst (Logic.strip_params trm)
       
   540   val prems  = Logic.strip_assums_hyp trm
       
   541   val (prems1, prems2) = chop (length prems - 3) prems;
       
   542   val (params1, params2) = chop (length params - 2) params;
       
   543   val _ = warning (Syntax.string_of_term ctxt trm)
       
   544   val _ = warning (commas params)
       
   545   val _ = warning (commas (map (Syntax.string_of_term ctxt) prems))
       
   546   val _ = warning ((commas params1) ^ " | " ^ (commas params2))
       
   547   val _ = warning ((commas (map (Syntax.string_of_term ctxt) prems1)) ^ " | " ^
       
   548                    (commas (map (Syntax.string_of_term ctxt) prems2)))
       
   549 in
       
   550    Seq.single thm
       
   551 end
       
   552 *}
       
   553 
       
   554 
       
   555 lemma intro1:
       
   556   shows "\<And>m. odd m \<Longrightarrow> even (Suc m)"
       
   557 apply(tactic {* ObjectLogic.rulify_tac 1 *})
       
   558 apply(tactic {* rewrite_goals_tac [@{thm even_def}, @{thm odd_def}] *})
       
   559 apply(tactic {* REPEAT (resolve_tac [@{thm allI}, @{thm impI}] 1) *})
       
   560 apply(tactic {* chop_print_tac @{context} *})
       
   561 oops
   456 
   562 
   457 ML{*fun subproof2 prem params2 prems2 =  
   563 ML{*fun subproof2 prem params2 prems2 =  
   458  SUBPROOF (fn {prems, ...} =>
   564  SUBPROOF (fn {prems, ...} =>
   459    let
   565    let
   460      val prem' = prems MRS prem;
   566      val prem' = prems MRS prem;
   466          | _ => prem';
   572          | _ => prem';
   467    in 
   573    in 
   468      rtac prem'' 1 
   574      rtac prem'' 1 
   469    end)*}
   575    end)*}
   470 
   576 
   471 ML{*fun subproof1 rules preds i = 
   577 text {*
       
   578 
       
   579 *}
       
   580 
       
   581 
       
   582 ML %linenosgray{*fun subproof1 rules preds i = 
   472  SUBPROOF (fn {params, prems, context = ctxt', ...} =>
   583  SUBPROOF (fn {params, prems, context = ctxt', ...} =>
   473    let
   584    let
   474      val (prems1, prems2) = chop (length prems - length rules) prems;
   585      val (prems1, prems2) = chop (length prems - length rules) prems;
   475      val (params1, params2) = chop (length params - length preds) params;
   586      val (params1, params2) = chop (length params - length preds) params;
   476    in
   587    in
   477      rtac (ObjectLogic.rulify (all_elims params1 (nth prems2 i))) 1 
   588      rtac (ObjectLogic.rulify (all_elims params1 (nth prems2 i))) 1 
       
   589      (* applicateion of the i-ith intro rule *)
   478      THEN
   590      THEN
   479      EVERY1 (map (fn prem => subproof2 prem params2 prems2 ctxt') prems1)
   591      EVERY1 (map (fn prem => subproof2 prem params2 prems2 ctxt') prems1)
   480    end)*}
   592    end)*}
   481 
   593 
       
   594 text {*
       
   595   @{text "params1"} are the variables of the rules; @{text "params2"} is
       
   596   the variables corresponding to the @{text "preds"}.
       
   597 
       
   598   @{text "prems1"} are the assumption corresponding to the rules;
       
   599   @{text "prems2"} are the assumptions coming from the allIs/impIs
       
   600 
       
   601   you instantiate the parameters i-th introduction rule with the parameters
       
   602   that come from the rule; and you apply it to the goal
       
   603 
       
   604   this now generates subgoals corresponding to the premisses of this
       
   605   intro rule 
       
   606 *}
       
   607 
   482 ML{*
   608 ML{*
   483 fun introductions_tac defs rules preds i ctxt =
   609 fun intros_tac defs rules preds i ctxt =
   484   EVERY1 [ObjectLogic.rulify_tac,
   610   EVERY1 [ObjectLogic.rulify_tac,
   485           K (rewrite_goals_tac defs),
   611           K (rewrite_goals_tac defs),
   486           REPEAT o (resolve_tac [@{thm allI}, @{thm impI}]),
   612           REPEAT o (resolve_tac [@{thm allI}, @{thm impI}]),
   487           subproof1 rules preds i ctxt]*}
   613           subproof1 rules preds i ctxt]*}
   488 
   614 
   489 lemma evenS: 
   615 text {*
   490   shows "odd m \<Longrightarrow> even (Suc m)"
   616   A test case
   491 apply(tactic {* 
   617 *}
       
   618 
       
   619 ML{*fun intros_tac_test ctxt i =
   492 let
   620 let
   493   val rules = [@{prop "even (0::nat)"},
   621   val rules = [@{prop "even (0::nat)"},
   494                  @{prop "\<And>n::nat. odd n \<Longrightarrow> even (Suc n)"},
   622                @{prop "\<And>n::nat. odd n \<Longrightarrow> even (Suc n)"},
   495                  @{prop "\<And>n::nat. even n \<Longrightarrow> odd (Suc n)"}] 
   623                @{prop "\<And>n::nat. even n \<Longrightarrow> odd (Suc n)"}] 
   496   val defs = [@{thm even_def}, @{thm odd_def}]
   624   val defs = [@{thm even_def}, @{thm odd_def}]
   497   val preds = [@{term "even::nat\<Rightarrow>bool"}, @{term "odd::nat\<Rightarrow>bool"}]
   625   val preds = [@{term "even::nat\<Rightarrow>bool"}, @{term "odd::nat\<Rightarrow>bool"}]
   498 in
   626 in
   499   introductions_tac defs rules preds 1 @{context}
   627   intros_tac defs rules preds i ctxt
   500 end *})
   628 end*}
       
   629 
       
   630 lemma intro0:
       
   631   shows "even 0"
       
   632 apply(tactic {* intros_tac_test @{context} 0 *})
       
   633 done
       
   634 
       
   635 lemma intro1:
       
   636   shows "\<And>m. odd m \<Longrightarrow> even (Suc m)"
       
   637 apply(tactic {* intros_tac_test @{context} 1 *})
       
   638 done
       
   639 
       
   640 lemma intro2:
       
   641   shows "\<And>m. even m \<Longrightarrow> odd (Suc m)"
       
   642 apply(tactic {* intros_tac_test @{context} 2 *})
   501 done
   643 done
   502 
   644 
   503 ML{*fun introductions rules preds defs lthy = 
   645 ML{*fun introductions rules preds defs lthy = 
   504 let
   646 let
   505   fun prove_intro (i, goal) =
   647   fun prove_intro (i, goal) =
   506     Goal.prove lthy [] [] goal
   648     Goal.prove lthy [] [] goal
   507       (fn {context, ...} => introductions_tac defs rules preds i context)
   649       (fn {context, ...} => intros_tac defs rules preds i context)
   508 in
   650 in
   509   map_index prove_intro rules
   651   map_index prove_intro rules
   510 end*}
   652 end*}
   511 
   653 
   512 text {* main internal function *}
   654 text {* main internal function *}