distinguish raw and non-raw facts, using raw for 10 000s of facts and non-raw after selection of some hundreds
authorblanchet
Thu Jan 31 17:54:05 2013 +0100 (2013-01-31 ago)
changeset 510045f2788c38127
parent 51003 198cb05fb35b
child 51005 ce4290c33d73
distinguish raw and non-raw facts, using raw for 10 000s of facts and non-raw after selection of some hundreds
src/HOL/Mirabelle/Tools/mirabelle_sledgehammer.ML
src/HOL/Mirabelle/Tools/mirabelle_sledgehammer_filter.ML
src/HOL/TPTP/mash_eval.ML
src/HOL/TPTP/sledgehammer_tactics.ML
src/HOL/Tools/Sledgehammer/sledgehammer_fact.ML
src/HOL/Tools/Sledgehammer/sledgehammer_mash.ML
src/HOL/Tools/Sledgehammer/sledgehammer_mepo.ML
src/HOL/Tools/Sledgehammer/sledgehammer_run.ML
     1.1 --- a/src/HOL/Mirabelle/Tools/mirabelle_sledgehammer.ML	Thu Jan 31 17:54:05 2013 +0100
     1.2 +++ b/src/HOL/Mirabelle/Tools/mirabelle_sledgehammer.ML	Thu Jan 31 17:54:05 2013 +0100
     1.3 @@ -478,7 +478,6 @@
     1.4                   (the_default default_max_facts max_facts)
     1.5                   Sledgehammer_Fact.no_fact_override hyp_ts concl_t
     1.6            |> #1 (*###*)
     1.7 -          |> map (apfst (apfst (fn name => name ())))
     1.8            |> tap (fn facts =>
     1.9                       "Line " ^ str0 (Position.line_of pos) ^ ": " ^
    1.10                       (if null facts then
     2.1 --- a/src/HOL/Mirabelle/Tools/mirabelle_sledgehammer_filter.ML	Thu Jan 31 17:54:05 2013 +0100
     2.2 +++ b/src/HOL/Mirabelle/Tools/mirabelle_sledgehammer_filter.ML	Thu Jan 31 17:54:05 2013 +0100
     2.3 @@ -136,7 +136,7 @@
     2.4             |> Sledgehammer_MePo.mepo_suggested_facts ctxt params
     2.5                    default_prover (the_default default_max_facts max_facts)
     2.6                    (SOME relevance_fudge) hyp_ts concl_t
     2.7 -            |> map ((fn name => name ()) o fst o fst)
     2.8 +            |> map (fst o fst)
     2.9           val (found_facts, lost_facts) =
    2.10             flat proofs |> sort_distinct string_ord
    2.11             |> map (fn fact => (find_index (curry (op =) fact) facts, fact))
     3.1 --- a/src/HOL/TPTP/mash_eval.ML	Thu Jan 31 17:54:05 2013 +0100
     3.2 +++ b/src/HOL/TPTP/mash_eval.ML	Thu Jan 31 17:54:05 2013 +0100
     3.3 @@ -71,7 +71,7 @@
     3.4      val str_of_method = enclose "  " ": "
     3.5      fun str_of_result method facts ({outcome, run_time, used_facts, ...}
     3.6                                       : prover_result) =
     3.7 -      let val facts = facts |> map (fn ((name, _), _) => name ()) in
     3.8 +      let val facts = facts |> map (fst o fst) in
     3.9          str_of_method method ^
    3.10          (if is_none outcome then
    3.11             "Success (" ^ ATP_Util.string_from_time run_time ^ "): " ^
    3.12 @@ -111,7 +111,7 @@
    3.13            val (_, hyp_ts, concl_t) = ATP_Util.strip_subgoal ctxt goal 1
    3.14            val isar_deps = isar_dependencies_of name_tabs th
    3.15            val facts = facts |> filter (fn (_, th') => thm_ord (th', th) = LESS)
    3.16 -          val find_suggs = find_suggested_facts facts
    3.17 +          val find_suggs = find_suggested_facts facts #> map fact_of_raw_fact
    3.18            fun get_facts [] compute = compute facts
    3.19              | get_facts suggs _ = find_suggs suggs
    3.20            val mepo_facts =
    3.21 @@ -121,7 +121,8 @@
    3.22              |> weight_mepo_facts
    3.23            fun mash_of suggs =
    3.24              get_facts suggs (fn _ =>
    3.25 -                find_mash_suggestions slack_max_facts suggs facts [] [] |> fst)
    3.26 +                find_mash_suggestions slack_max_facts suggs facts [] []
    3.27 +                |> fst |> map fact_of_raw_fact)
    3.28              |> weight_mash_facts
    3.29            val mash_isar_facts = mash_of mash_isar_suggs
    3.30            val mash_prover_facts = mash_of mash_prover_suggs
    3.31 @@ -160,6 +161,7 @@
    3.32                    |> map (get #> nickify)
    3.33                    |> maybe_instantiate_inducts ctxt hyp_ts concl_t
    3.34                    |> take (the max_facts)
    3.35 +                  |> map fact_of_raw_fact
    3.36                  val ctxt = ctxt |> set_file_name method prob_dir_name
    3.37                  val res as {outcome, ...} =
    3.38                    run_prover_for_mash ctxt params prover facts goal
     4.1 --- a/src/HOL/TPTP/sledgehammer_tactics.ML	Thu Jan 31 17:54:05 2013 +0100
     4.2 +++ b/src/HOL/TPTP/sledgehammer_tactics.ML	Thu Jan 31 17:54:05 2013 +0100
     4.3 @@ -45,8 +45,7 @@
     4.4        |> #1
     4.5      val problem =
     4.6        {state = Proof.init ctxt, goal = goal, subgoal = i, subgoal_count = n,
     4.7 -       facts = facts |> map (apfst (apfst (fn name => name ())))
     4.8 -                     |> map Untranslated_Fact}
     4.9 +       facts = facts |> map Untranslated_Fact}
    4.10    in
    4.11      (case prover params (K (K (K ""))) problem of
    4.12        {outcome = NONE, used_facts, ...} => used_facts |> map fst |> SOME
     5.1 --- a/src/HOL/Tools/Sledgehammer/sledgehammer_fact.ML	Thu Jan 31 17:54:05 2013 +0100
     5.2 +++ b/src/HOL/Tools/Sledgehammer/sledgehammer_fact.ML	Thu Jan 31 17:54:05 2013 +0100
     5.3 @@ -10,7 +10,8 @@
     5.4    type status = ATP_Problem_Generate.status
     5.5    type stature = ATP_Problem_Generate.stature
     5.6  
     5.7 -  type fact = ((unit -> string) * stature) * thm
     5.8 +  type raw_fact = ((unit -> string) * stature) * thm
     5.9 +  type fact = (string * stature) * thm
    5.10  
    5.11    type fact_override =
    5.12      {add : (Facts.ref * Attrib.src list) list,
    5.13 @@ -33,12 +34,13 @@
    5.14      Proof.context -> term list -> term -> (((unit -> string) * 'a) * thm) list
    5.15      -> (((unit -> string) * 'a) * thm) list
    5.16    val maybe_filter_no_atps : Proof.context -> ('a * thm) list -> ('a * thm) list
    5.17 +  val fact_of_raw_fact : raw_fact -> fact
    5.18    val all_facts :
    5.19      Proof.context -> bool -> bool -> unit Symtab.table -> thm list -> thm list
    5.20 -    -> status Termtab.table -> fact list
    5.21 +    -> status Termtab.table -> raw_fact list
    5.22    val nearly_all_facts :
    5.23      Proof.context -> bool -> fact_override -> unit Symtab.table
    5.24 -    -> status Termtab.table -> thm list -> term list -> term -> fact list
    5.25 +    -> status Termtab.table -> thm list -> term list -> term -> raw_fact list
    5.26  end;
    5.27  
    5.28  structure Sledgehammer_Fact : SLEDGEHAMMER_FACT =
    5.29 @@ -49,7 +51,8 @@
    5.30  open Metis_Tactic
    5.31  open Sledgehammer_Util
    5.32  
    5.33 -type fact = ((unit -> string) * stature) * thm
    5.34 +type raw_fact = ((unit -> string) * stature) * thm
    5.35 +type fact = (string * stature) * thm
    5.36  
    5.37  type fact_override =
    5.38    {add : (Facts.ref * Attrib.src list) list,
    5.39 @@ -419,6 +422,8 @@
    5.40  fun maybe_filter_no_atps ctxt =
    5.41    not (Config.get ctxt ignore_no_atp) ? filter_out (No_ATPs.member ctxt o snd)
    5.42  
    5.43 +fun fact_of_raw_fact ((name, stature), th) = ((name (), stature), th)
    5.44 +
    5.45  fun all_facts ctxt generous ho_atp reserved add_ths chained css =
    5.46    let
    5.47      val thy = Proof_Context.theory_of ctxt
     6.1 --- a/src/HOL/Tools/Sledgehammer/sledgehammer_mash.ML	Thu Jan 31 17:54:05 2013 +0100
     6.2 +++ b/src/HOL/Tools/Sledgehammer/sledgehammer_mash.ML	Thu Jan 31 17:54:05 2013 +0100
     6.3 @@ -7,6 +7,7 @@
     6.4  signature SLEDGEHAMMER_MASH =
     6.5  sig
     6.6    type stature = ATP_Problem_Generate.stature
     6.7 +  type raw_fact = Sledgehammer_Fact.raw_fact
     6.8    type fact = Sledgehammer_Fact.fact
     6.9    type fact_override = Sledgehammer_Fact.fact_override
    6.10    type params = Sledgehammer_Provers.params
    6.11 @@ -62,7 +63,7 @@
    6.12    val isar_dependencies_of :
    6.13      string Symtab.table * string Symtab.table -> thm -> string list
    6.14    val prover_dependencies_of :
    6.15 -    Proof.context -> params -> string -> int -> fact list
    6.16 +    Proof.context -> params -> string -> int -> raw_fact list
    6.17      -> string Symtab.table * string Symtab.table -> thm
    6.18      -> bool * string list
    6.19    val weight_mepo_facts : 'a list -> ('a * real) list
    6.20 @@ -71,8 +72,8 @@
    6.21      int -> string list -> ('b * thm) list -> ('b * thm) list -> ('b * thm) list
    6.22      -> ('b * thm) list * ('b * thm) list
    6.23    val mash_suggested_facts :
    6.24 -    Proof.context -> params -> string -> int -> term list -> term -> fact list
    6.25 -    -> fact list * fact list
    6.26 +    Proof.context -> params -> string -> int -> term list -> term
    6.27 +    -> raw_fact list -> fact list * fact list
    6.28    val mash_learn_proof :
    6.29      Proof.context -> params -> string -> term -> ('a * thm) list -> thm list
    6.30      -> unit
    6.31 @@ -85,7 +86,7 @@
    6.32    val mash_weight : real
    6.33    val relevant_facts :
    6.34      Proof.context -> params -> string -> int -> fact_override -> term list
    6.35 -    -> term -> fact list -> fact list * fact list * fact list
    6.36 +    -> term -> raw_fact list -> fact list * fact list * fact list
    6.37    val kill_learners : unit -> unit
    6.38    val running_learners : unit -> unit
    6.39  end;
    6.40 @@ -531,8 +532,7 @@
    6.41    let
    6.42      val problem =
    6.43        {state = Proof.init ctxt, goal = goal, subgoal = 1, subgoal_count = 1,
    6.44 -       facts = facts |> map (apfst (apfst (fn name => name ())))
    6.45 -                     |> map Untranslated_Fact}
    6.46 +       facts = facts |> map Untranslated_Fact}
    6.47    in
    6.48      get_minimizing_isar_prover ctxt MaSh (K (K ())) prover params (K (K (K "")))
    6.49                                 problem
    6.50 @@ -687,14 +687,13 @@
    6.51        val goal = goal_of_thm thy th
    6.52        val (_, hyp_ts, concl_t) = ATP_Util.strip_subgoal ctxt goal 1
    6.53        val facts = facts |> filter (fn (_, th') => thm_ord (th', th) = LESS)
    6.54 -      fun nickify ((_, stature), th) =
    6.55 -        ((fn () => nickname_of_thm th, stature), th)
    6.56 +      fun nickify ((_, stature), th) = ((nickname_of_thm th, stature), th)
    6.57        fun is_dep dep (_, th) = nickname_of_thm th = dep
    6.58        fun add_isar_dep facts dep accum =
    6.59          if exists (is_dep dep) accum then
    6.60            accum
    6.61          else case find_first (is_dep dep) facts of
    6.62 -          SOME ((name, status), th) => accum @ [((name, status), th)]
    6.63 +          SOME ((_, status), th) => accum @ [(("", status), th)]
    6.64          | NONE => accum (* shouldn't happen *)
    6.65        val facts =
    6.66          facts
    6.67 @@ -825,7 +824,10 @@
    6.68                                      (parents, feats, hints))
    6.69              end)
    6.70      val unknown = facts |> filter_out (is_fact_in_graph access_G snd)
    6.71 -  in find_mash_suggestions max_facts suggs facts chained unknown end
    6.72 +  in
    6.73 +    find_mash_suggestions max_facts suggs facts chained unknown
    6.74 +    |> pairself (map fact_of_raw_fact)
    6.75 +  end
    6.76  
    6.77  fun learn_wrt_access_graph ctxt (name, parents, feats, deps) (learns, graph) =
    6.78    let
    6.79 @@ -1099,7 +1101,9 @@
    6.80    if not (subset (op =) (the_list fact_filter, fact_filters)) then
    6.81      error ("Unknown fact filter: " ^ quote (the fact_filter) ^ ".")
    6.82    else if only then
    6.83 -    (facts, facts, facts)
    6.84 +    let val facts = facts |> map fact_of_raw_fact in
    6.85 +      (facts, facts, facts)
    6.86 +    end
    6.87    else if max_facts <= 0 orelse null facts then
    6.88      ([], [], [])
    6.89    else
    6.90 @@ -1129,11 +1133,12 @@
    6.91            else
    6.92              mepoN
    6.93        val add_ths = Attrib.eval_thms ctxt add
    6.94 -      val in_add = member Thm.eq_thm_prop add_ths o snd
    6.95 +      fun in_add (_, th) = member Thm.eq_thm_prop add_ths th
    6.96        fun add_and_take accepts =
    6.97          (case add_ths of
    6.98             [] => accepts
    6.99 -         | _ => (facts |> filter in_add) @ (accepts |> filter_out in_add))
   6.100 +         | _ => (facts |> filter in_add |> map fact_of_raw_fact) @
   6.101 +                (accepts |> filter_out in_add))
   6.102          |> take max_facts
   6.103        fun mepo () =
   6.104          mepo_suggested_facts ctxt params prover max_facts NONE hyp_ts concl_t
     7.1 --- a/src/HOL/Tools/Sledgehammer/sledgehammer_mepo.ML	Thu Jan 31 17:54:05 2013 +0100
     7.2 +++ b/src/HOL/Tools/Sledgehammer/sledgehammer_mepo.ML	Thu Jan 31 17:54:05 2013 +0100
     7.3 @@ -8,6 +8,7 @@
     7.4  signature SLEDGEHAMMER_MEPO =
     7.5  sig
     7.6    type stature = ATP_Problem_Generate.stature
     7.7 +  type raw_fact = Sledgehammer_Fact.raw_fact
     7.8    type fact = Sledgehammer_Fact.fact
     7.9    type params = Sledgehammer_Provers.params
    7.10    type relevance_fudge = Sledgehammer_Provers.relevance_fudge
    7.11 @@ -20,7 +21,7 @@
    7.12      -> string list
    7.13    val mepo_suggested_facts :
    7.14      Proof.context -> params -> string -> int -> relevance_fudge option
    7.15 -    -> term list -> term -> fact list -> fact list
    7.16 +    -> term list -> term -> raw_fact list -> fact list
    7.17  end;
    7.18  
    7.19  structure Sledgehammer_MePo : SLEDGEHAMMER_MEPO =
    7.20 @@ -337,7 +338,7 @@
    7.21  
    7.22  fun take_most_relevant ctxt max_facts remaining_max
    7.23          ({max_imperfect, max_imperfect_exp, ...} : relevance_fudge)
    7.24 -        (candidates : ((fact * (string * ptype) list) * real) list) =
    7.25 +        (candidates : ((raw_fact * (string * ptype) list) * real) list) =
    7.26    let
    7.27      val max_imperfect =
    7.28        Real.ceil (Math.pow (max_imperfect,
    7.29 @@ -533,6 +534,7 @@
    7.30         relevance_filter ctxt thres0 decay max_facts is_built_in_const fudge
    7.31             facts hyp_ts
    7.32             (concl_t |> theory_constify fudge (Context.theory_name thy)))
    7.33 +    |> map fact_of_raw_fact
    7.34    end
    7.35  
    7.36  end;
     8.1 --- a/src/HOL/Tools/Sledgehammer/sledgehammer_run.ML	Thu Jan 31 17:54:05 2013 +0100
     8.2 +++ b/src/HOL/Tools/Sledgehammer/sledgehammer_run.ML	Thu Jan 31 17:54:05 2013 +0100
     8.3 @@ -237,7 +237,6 @@
     8.4            |> relevant_facts ctxt params (hd provers) max_max_facts fact_override
     8.5                              hyp_ts concl_t
     8.6            |> #1 (*###*)
     8.7 -          |> map (apfst (apfst (fn name => name ())))
     8.8            |> tap (fn facts =>
     8.9                       if verbose then
    8.10                         label ^ plural_s (length provers) ^ ": " ^