src/HOL/Tools/Sledgehammer/sledgehammer_fact.ML
changeset 53506 f99ee3adb81d
parent 53504 9750618c32ed
child 53507 a6ed27399ba9
equal deleted inserted replaced
53505:412f8c590c6c 53506:f99ee3adb81d
   192    "weak_case_cong", "nat_of_char_simps", "nibble.simps",
   192    "weak_case_cong", "nat_of_char_simps", "nibble.simps",
   193    "nibble.distinct"]
   193    "nibble.distinct"]
   194   |> not (ho_atp orelse (Config.get ctxt instantiate_inducts)) ?
   194   |> not (ho_atp orelse (Config.get ctxt instantiate_inducts)) ?
   195         append ["induct", "inducts"]
   195         append ["induct", "inducts"]
   196   |> map (prefix Long_Name.separator)
   196   |> map (prefix Long_Name.separator)
   197 
       
   198 val max_lambda_nesting = 5 (*only applies if not ho_atp*)
       
   199 
       
   200 fun term_has_too_many_lambdas max (t1 $ t2) =
       
   201     exists (term_has_too_many_lambdas max) [t1, t2]
       
   202   | term_has_too_many_lambdas max (Abs (_, _, t)) =
       
   203     max = 0 orelse term_has_too_many_lambdas (max - 1) t
       
   204   | term_has_too_many_lambdas _ _ = false
       
   205 
       
   206 (* Don't count nested lambdas at the level of formulas, since they are
       
   207    quantifiers. *)
       
   208 fun formula_has_too_many_lambdas Ts (Abs (_, T, t)) =
       
   209     formula_has_too_many_lambdas (T :: Ts) t
       
   210   | formula_has_too_many_lambdas Ts t =
       
   211     if member (op =) [HOLogic.boolT, propT] (fastype_of1 (Ts, t)) then
       
   212       exists (formula_has_too_many_lambdas Ts) (#2 (strip_comb t))
       
   213     else
       
   214       term_has_too_many_lambdas max_lambda_nesting t
       
   215 
       
   216 (* The maximum apply depth of any "metis" call in "Metis_Examples" (on
       
   217    2007-10-31) was 11. *)
       
   218 val max_apply_depth = 18
       
   219 
       
   220 fun apply_depth (f $ t) = Int.max (apply_depth f, apply_depth t + 1)
       
   221   | apply_depth (Abs (_, _, t)) = apply_depth t
       
   222   | apply_depth _ = 0
       
   223 
       
   224 fun is_too_complex ho_atp t =
       
   225   apply_depth t > max_apply_depth orelse
       
   226   (not ho_atp andalso formula_has_too_many_lambdas [] t)
       
   227 
   197 
   228 (* FIXME: Ad hoc list *)
   198 (* FIXME: Ad hoc list *)
   229 val technical_prefixes =
   199 val technical_prefixes =
   230   ["ATP", "Code_Evaluation", "Datatype", "Enum", "Lazy_Sequence",
   200   ["ATP", "Code_Evaluation", "Datatype", "Enum", "Lazy_Sequence",
   231    "Limited_Sequence", "Meson", "Metis", "Nitpick",
   201    "Limited_Sequence", "Meson", "Metis", "Nitpick",
   494           in
   464           in
   495             pair n
   465             pair n
   496             #> fold_rev (fn th => fn (j, accum) =>
   466             #> fold_rev (fn th => fn (j, accum) =>
   497                    (j - 1,
   467                    (j - 1,
   498                     if not (member Thm.eq_thm_prop add_ths th) andalso
   468                     if not (member Thm.eq_thm_prop add_ths th) andalso
   499                        (is_likely_tautology_too_meta_or_too_technical th orelse
   469                        (is_likely_tautology_too_meta_or_too_technical th) then
   500                         (not generous andalso
       
   501                          is_too_complex ho_atp (prop_of th))) then
       
   502                       accum
   470                       accum
   503                     else
   471                     else
   504                       let
   472                       let
   505                         val new =
   473                         val new =
   506                           (((fn () =>
   474                           (((fn () =>