src/Pure/Isar/find_theorems.ML
changeset 17106 2bd6c20cdda1
parent 16964 6a25e42eaff5
child 17205 8994750ae33c
equal deleted inserted replaced
17105:1b07a176a880 17106:2bd6c20cdda1
    62 
    62 
    63 (** search criterion filters **)
    63 (** search criterion filters **)
    64 
    64 
    65 (*generated filters are to be of the form
    65 (*generated filters are to be of the form
    66   input: (PureThy.thmref * Thm.thm)
    66   input: (PureThy.thmref * Thm.thm)
    67   output: (p::int, s::int) option, where
    67   output: (p:int, s:int) option, where
    68     NONE indicates no match
    68     NONE indicates no match
    69     p is the primary sorting criterion 
    69     p is the primary sorting criterion
    70       (eg. number of assumptions in the theorem)
    70       (eg. number of assumptions in the theorem)
    71     s is the secondary sorting criterion
    71     s is the secondary sorting criterion
    72       (eg. size of the substitution for intro, elim and dest)
    72       (eg. size of the substitution for intro, elim and dest)
    73   when applying a set of filters to a thm, fold results in:
    73   when applying a set of filters to a thm, fold results in:
    74     (biggest p, sum of all s)
    74     (biggest p, sum of all s)
    75   currently p and s only matter for intro, elim, dest and simp filters, 
    75   currently p and s only matter for intro, elim, dest and simp filters,
    76   otherwise the default ordering ("by package") is used.
    76   otherwise the default ordering is used.
    77 *)
    77 *)
    78 
    78 
    79 
    79 
    80 (* matching theorems *)
    80 (* matching theorems *)
    81     
    81 
    82 fun is_nontrivial sg = is_Const o head_of o ObjectLogic.drop_judgment sg;
    82 fun is_nontrivial thy = is_Const o head_of o ObjectLogic.drop_judgment thy;
    83 
    83 
    84 (*extract terms from term_src, refine them to the parts that concern us,
    84 (*extract terms from term_src, refine them to the parts that concern us,
    85   if po try match them against obj else vice versa.
    85   if po try match them against obj else vice versa.
    86   trivial matches are ignored.
    86   trivial matches are ignored.
    87   returns: smallest substitution size*)
    87   returns: smallest substitution size*)
    88 fun is_matching_thm (extract_terms, refine_term) ctxt po obj term_src =
    88 fun is_matching_thm (extract_terms, refine_term) ctxt po obj term_src =
    89   let
    89   let
    90     val sg = ProofContext.sign_of ctxt;
    90     val thy = ProofContext.theory_of ctxt;
    91     val tsig = Sign.tsig_of sg;
    91     val tsig = Sign.tsig_of thy;
    92 
    92 
    93     fun matches pat =
    93     fun matches pat =
    94       is_nontrivial sg pat andalso
    94       is_nontrivial thy pat andalso
    95       Pattern.matches tsig (if po then (pat,obj) else (obj,pat));
    95       Pattern.matches tsig (if po then (pat,obj) else (obj,pat));
    96 
    96 
    97     fun substsize pat =
    97     fun substsize pat =
    98       let 
    98       let
    99         val (_,subst) = Pattern.match tsig (if po then (pat,obj) else (obj,pat))
    99         val (_,subst) = Pattern.match tsig (if po then (pat,obj) else (obj,pat))
   100       in Vartab.foldl (op + o apsnd (size_of_term o snd o snd)) (0, subst)
   100       in Vartab.foldl (op + o apsnd (size_of_term o snd o snd)) (0, subst)
   101       end;
   101       end;
   102 
   102 
   103     fun bestmatch [] = NONE
   103     fun bestmatch [] = NONE
   104      |  bestmatch (x :: xs) = SOME (foldl Int.min x xs);
   104      |  bestmatch (x :: xs) = SOME (foldl Int.min x xs);
   105 
   105 
   106     val match_thm = matches o refine_term;
   106     val match_thm = matches o refine_term;
   107   in
   107   in
   108     map (substsize o refine_term) 
   108     map (substsize o refine_term)
   109         (List.filter match_thm (extract_terms term_src)) |> bestmatch
   109         (List.filter match_thm (extract_terms term_src)) |> bestmatch
   110   end;
   110   end;
   111 
   111 
   112 
   112 
   113 (* filter_name *)
   113 (* filter_name *)
   118   else if String.substring (str, 0, String.size pat) = pat then true
   118   else if String.substring (str, 0, String.size pat) = pat then true
   119   else is_substring pat (String.extract (str, 1, NONE));
   119   else is_substring pat (String.extract (str, 1, NONE));
   120 
   120 
   121 (*filter that just looks for a string in the name,
   121 (*filter that just looks for a string in the name,
   122   substring match only (no regexps are performed)*)
   122   substring match only (no regexps are performed)*)
   123 fun filter_name str_pat (thmref, _) = 
   123 fun filter_name str_pat (thmref, _) =
   124   if is_substring str_pat (PureThy.name_of_thmref thmref) 
   124   if is_substring str_pat (PureThy.name_of_thmref thmref)
   125   then SOME (0,0) else NONE;
   125   then SOME (0,0) else NONE;
   126 
   126 
   127 
   127 
   128 (* filter intro/elim/dest rules *)
   128 (* filter intro/elim/dest rules *)
   129 
   129 
   133      (fn thm => if Thm.no_prems thm then [] else [prop_of thm],
   133      (fn thm => if Thm.no_prems thm then [] else [prop_of thm],
   134       hd o Logic.strip_imp_prems);
   134       hd o Logic.strip_imp_prems);
   135     val prems = Logic.prems_of_goal goal 1;
   135     val prems = Logic.prems_of_goal goal 1;
   136 
   136 
   137     fun try_subst prem = is_matching_thm extract_dest ctxt true prem thm;
   137     fun try_subst prem = is_matching_thm extract_dest ctxt true prem thm;
   138     
   138 
   139     (*keep successful substitutions*)
   139     (*keep successful substitutions*)
   140     val ss = prems |> List.map try_subst 
   140     val ss = prems |> List.map try_subst
   141              |> List.filter isSome 
   141              |> List.filter isSome
   142              |> List.map valOf;
   142              |> List.map valOf;
   143   in
   143   in
   144     (*if possible, keep best substitution (one with smallest size)*)
   144     (*if possible, keep best substitution (one with smallest size)*)
   145     (*dest rules always have assumptions, so a dest with one 
   145     (*dest rules always have assumptions, so a dest with one
   146       assumption is as good as an intro rule with none*)
   146       assumption is as good as an intro rule with none*)
   147     if not (null ss) 
   147     if not (null ss)
   148     then SOME (nprems_of thm - 1, foldl Int.min (hd ss) (tl ss)) else NONE
   148     then SOME (nprems_of thm - 1, foldl Int.min (hd ss) (tl ss)) else NONE
   149   end;
   149   end;
   150 
   150 
   151 fun filter_intro ctxt goal (_,thm) =
   151 fun filter_intro ctxt goal (_,thm) =
   152   let
   152   let
   166       val rule_mp = (hd o Logic.strip_imp_prems) rule;
   166       val rule_mp = (hd o Logic.strip_imp_prems) rule;
   167       val rule_concl = Logic.strip_imp_concl rule;
   167       val rule_concl = Logic.strip_imp_concl rule;
   168       fun combine t1 t2 = Const ("combine", dummyT --> dummyT) $ (t1 $ t2);
   168       fun combine t1 t2 = Const ("combine", dummyT --> dummyT) $ (t1 $ t2);
   169       val rule_tree = combine rule_mp rule_concl;
   169       val rule_tree = combine rule_mp rule_concl;
   170       fun goal_tree prem = (combine prem goal_concl);
   170       fun goal_tree prem = (combine prem goal_concl);
   171       fun try_subst prem = 
   171       fun try_subst prem =
   172         is_matching_thm (single, I) ctxt true (goal_tree prem) rule_tree;
   172         is_matching_thm (single, I) ctxt true (goal_tree prem) rule_tree;
   173       (*keep successful substitutions*)
   173       (*keep successful substitutions*)
   174       val ss = prems |> List.map try_subst 
   174       val ss = prems |> List.map try_subst
   175                |> List.filter isSome 
   175                |> List.filter isSome
   176                |> List.map valOf; 
   176                |> List.map valOf;
   177     in
   177     in
   178     (*elim rules always have assumptions, so an elim with one 
   178     (*elim rules always have assumptions, so an elim with one
   179       assumption is as good as an intro rule with none*)
   179       assumption is as good as an intro rule with none*)
   180       if is_nontrivial (ProofContext.sign_of ctxt) (Thm.major_prem_of thm) 
   180       if is_nontrivial (ProofContext.theory_of ctxt) (Thm.major_prem_of thm)
   181         andalso not (null ss)
   181         andalso not (null ss)
   182       then SOME (nprems_of thm - 1, foldl Int.min (hd ss) (tl ss)) else NONE
   182       then SOME (nprems_of thm - 1, foldl Int.min (hd ss) (tl ss)) else NONE
   183     end
   183     end
   184   else NONE
   184   else NONE
   185 
   185 
   188 
   188 
   189 fun filter_simp ctxt t (_,thm) =
   189 fun filter_simp ctxt t (_,thm) =
   190   let
   190   let
   191     val (_, {mk_rews = {mk, ...}, ...}) =
   191     val (_, {mk_rews = {mk, ...}, ...}) =
   192       MetaSimplifier.rep_ss (Simplifier.local_simpset_of ctxt);
   192       MetaSimplifier.rep_ss (Simplifier.local_simpset_of ctxt);
   193     val extract_simp = 
   193     val extract_simp =
   194       ((List.map prop_of) o mk, #1 o Logic.dest_equals o Logic.strip_imp_concl);
   194       ((List.map prop_of) o mk, #1 o Logic.dest_equals o Logic.strip_imp_concl);
   195     val ss = is_matching_thm extract_simp ctxt false t thm
   195     val ss = is_matching_thm extract_simp ctxt false t thm
   196   in 
   196   in
   197     if is_some ss then SOME (nprems_of thm, valOf ss) else NONE 
   197     if is_some ss then SOME (nprems_of thm, valOf ss) else NONE
   198   end;
   198   end;
   199 
   199 
   200 
   200 
   201 (* filter_pattern *)
   201 (* filter_pattern *)
   202 
   202 
   203 fun filter_pattern ctxt pat (_, thm) =
   203 fun filter_pattern ctxt pat (_, thm) =
   204   let val tsig = Sign.tsig_of (ProofContext.sign_of ctxt)
   204   let val tsig = Sign.tsig_of (ProofContext.theory_of ctxt)
   205   in if Pattern.matches_subterm tsig (pat, Thm.prop_of thm) then SOME (0,0) 
   205   in if Pattern.matches_subterm tsig (pat, Thm.prop_of thm) then SOME (0,0)
   206      else NONE end;
   206      else NONE end;
   207 
   207 
   208 (* interpret criteria as filters *)
   208 (* interpret criteria as filters *)
   209 
   209 
   210 local
   210 local