src/Pure/Tools/find_theorems.ML
changeset 59095 3100a7b1c092
parent 59083 88b0b1f28adc
child 59096 15f7ebb29d38
equal deleted inserted replaced
59094:9ced35b4a2a9 59095:3100a7b1c092
   237 
   237 
   238 (* filter_pattern *)
   238 (* filter_pattern *)
   239 
   239 
   240 fun get_names t = Term.add_const_names t (Term.add_free_names t []);
   240 fun get_names t = Term.add_const_names t (Term.add_free_names t []);
   241 
   241 
       
   242 (* Does pat match a subterm of obj? *)
       
   243 fun matches_subterm thy (pat, obj) =
       
   244   let
       
   245     fun msub bounds obj = Pattern.matches thy (pat, obj) orelse
       
   246       (case obj of
       
   247         Abs (x, T, t) => msub (bounds + 1) (snd (Term.dest_abs (Name.bound bounds, T, t)))
       
   248       | t $ u => msub bounds t orelse msub bounds u
       
   249       | _ => false)
       
   250   in msub 0 obj end;
       
   251 
   242 (*Including all constants and frees is only sound because matching
   252 (*Including all constants and frees is only sound because matching
   243   uses higher-order patterns. If full matching were used, then
   253   uses higher-order patterns. If full matching were used, then
   244   constants that may be subject to beta-reduction after substitution
   254   constants that may be subject to beta-reduction after substitution
   245   of frees should not be included for LHS set because they could be
   255   of frees should not be included for LHS set because they could be
   246   thrown away by the substituted function.  E.g. for (?F 1 2) do not
   256   thrown away by the substituted function.  E.g. for (?F 1 2) do not
   252     val pat_consts = get_names pat;
   262     val pat_consts = get_names pat;
   253 
   263 
   254     fun check ((x, thm), NONE) = check ((x, thm), SOME (get_names (Thm.full_prop_of thm)))
   264     fun check ((x, thm), NONE) = check ((x, thm), SOME (get_names (Thm.full_prop_of thm)))
   255       | check ((_, thm), c as SOME thm_consts) =
   265       | check ((_, thm), c as SOME thm_consts) =
   256          (if subset (op =) (pat_consts, thm_consts) andalso
   266          (if subset (op =) (pat_consts, thm_consts) andalso
   257             Pattern.matches_subterm (Proof_Context.theory_of ctxt) (pat, Thm.full_prop_of thm)
   267             matches_subterm (Proof_Context.theory_of ctxt) (pat, Thm.full_prop_of thm)
   258           then SOME (size_of_term (Thm.prop_of thm), Thm.nprems_of thm, 0) else NONE, c);
   268           then SOME (size_of_term (Thm.prop_of thm), Thm.nprems_of thm, 0) else NONE, c);
   259   in check end;
   269   in check end;
   260 
   270 
   261 
   271 
   262 (* interpret criteria as filters *)
   272 (* interpret criteria as filters *)