generate ATP dependencies
authorblanchet
Wed, 11 Jul 2012 21:43:19 +0200
changeset 48245 854a47677335
parent 48244 b88c3e0b752e
child 48246 fb11c09d7729
generate ATP dependencies
src/HOL/TPTP/MaSh_Export.thy
src/HOL/TPTP/MaSh_Import.thy
src/HOL/TPTP/mash_export.ML
src/HOL/TPTP/mash_import.ML
--- a/src/HOL/TPTP/MaSh_Export.thy	Wed Jul 11 13:59:39 2012 +0200
+++ b/src/HOL/TPTP/MaSh_Export.thy	Wed Jul 11 21:43:19 2012 +0200
@@ -9,40 +9,66 @@
 uses "mash_export.ML"
 begin
 
-sledgehammer_params [provers = e, max_relevant = 500]
+sledgehammer_params
+  [provers = e, max_relevant = 40, strict, dont_slice, type_enc = poly_guards??,
+   lam_trans = combs_and_lifting, timeout = 5, dont_preplay, minimize]
 
 ML {*
 open MaSh_Export
 *}
 
 ML {*
-val do_it = false (* switch to "true" to generate the files *);
-val thy = @{theory List}
+if do_it then
+  generate_atp_dependencies @{context} thy false "/tmp/mash_atp_dependencies"
+else
+  ()
+*}
+
+ML {*
+val do_it = true (* switch to "true" to generate the files *);
+val thy = @{theory Nat}
 *}
 
 ML {*
-if do_it then generate_meng_paulson_suggestions @{context} thy "/tmp/mash_meng_paulson_suggestions"
-else ()
+if do_it then
+  generate_features thy false "/tmp/mash_features"
+else
+  ()
 *}
 
 ML {*
-if do_it then generate_mash_commands thy "/tmp/mash_commands"
-else ()
+if do_it then
+  generate_accessibility thy false "/tmp/mash_accessibility"
+else
+  ()
 *}
 
 ML {*
-if do_it then generate_mash_features thy false "/tmp/mash_features"
-else ()
+if do_it then
+  generate_isa_dependencies thy false "/tmp/mash_isa_dependencies"
+else
+  ()
+*}
+
+ML {*
+if do_it then
+  generate_atp_dependencies @{context} thy false "/tmp/mash_atp_dependencies"
+else
+  ()
 *}
 
 ML {*
-if do_it then generate_mash_accessibility thy false "/tmp/mash_accessibility"
-else ()
+if do_it then
+  generate_commands thy "/tmp/mash_commands"
+else
+  ()
 *}
 
 ML {*
-if do_it then generate_mash_dependencies thy false "/tmp/mash_dependencies"
-else ()
+if do_it then
+  generate_meng_paulson_suggestions @{context} thy 500 "/tmp/mash_meng_paulson_suggestions"
+else
+  ()
 *}
 
 end
--- a/src/HOL/TPTP/MaSh_Import.thy	Wed Jul 11 13:59:39 2012 +0200
+++ b/src/HOL/TPTP/MaSh_Import.thy	Wed Jul 11 21:43:19 2012 +0200
@@ -21,11 +21,11 @@
 
 ML {*
 val do_it = false (* switch to "true" to generate the files *);
-val thy = @{theory Nat}
+val thy = @{theory List}
 *}
 
 ML {*
-if do_it then import_and_evaluate_mash_suggestions @{context} thy "/tmp/mash_suggestions"
+if do_it then import_and_evaluate_mash_suggestions @{context} thy "/tmp/mash_suggestions_list"
 else ()
 *}
 
--- a/src/HOL/TPTP/mash_export.ML	Wed Jul 11 13:59:39 2012 +0200
+++ b/src/HOL/TPTP/mash_export.ML	Wed Jul 11 21:43:19 2012 +0200
@@ -8,6 +8,7 @@
 signature MASH_EXPORT =
 sig
   type stature = ATP_Problem_Generate.stature
+  type prover_result = Sledgehammer_Provers.prover_result
 
   val non_tautological_facts_of :
     theory -> (((unit -> string) * stature) * thm) list
@@ -16,15 +17,18 @@
   val dependencies_of : string list -> thm -> string list
   val goal_of_thm : thm -> thm
   val meng_paulson_facts :
-    Proof.context -> string -> int -> real * real -> thm -> int
-    -> (((unit -> string) * stature) * thm) list
+    Proof.context -> int -> thm -> (((unit -> string) * stature) * thm) list
     -> ((string * stature) * thm) list
-  val generate_mash_accessibility : theory -> bool -> string -> unit
-  val generate_mash_features : theory -> bool -> string -> unit
-  val generate_mash_dependencies : theory -> bool -> string -> unit
-  val generate_mash_commands : theory -> string -> unit
+  val run_sledgehammer :
+    Proof.context -> ((string * stature) * thm) list -> thm -> prover_result
+  val generate_accessibility : theory -> bool -> string -> unit
+  val generate_features : theory -> bool -> string -> unit
+  val generate_isa_dependencies : theory -> bool -> string -> unit
+  val generate_atp_dependencies :
+    Proof.context -> theory -> bool -> string -> unit
+  val generate_commands : theory -> string -> unit
   val generate_meng_paulson_suggestions :
-    Proof.context -> theory -> string -> unit
+    Proof.context -> theory -> int -> string -> unit
 end;
 
 structure MaSh_Export : MASH_EXPORT =
@@ -33,6 +37,8 @@
 open ATP_Problem_Generate
 open ATP_Util
 
+type prover_result = Sledgehammer_Provers.prover_result
+
 fun stringN_of_int 0 _ = ""
   | stringN_of_int k n =
     stringN_of_int (k - 1) (n div 10) ^ string_of_int (n mod 10)
@@ -105,13 +111,11 @@
   let
     val bad_types = [@{type_name prop}, @{type_name bool}, @{type_name fun}]
     val bad_consts = atp_widely_irrelevant_consts
-    val add_classes =
-      subtract (op =) @{sort type} #> map class_name_of #> union (op =)
     fun do_add_type (Type (s, Ts)) =
         (not (member (op =) bad_types s) ? insert (op =) (type_name_of s))
         #> fold do_add_type Ts
-      | do_add_type (TFree (_, S)) = add_classes S
-      | do_add_type (TVar (_, S)) = add_classes S
+      | do_add_type (TFree (_, S)) = union (op =) (map class_name_of S)
+      | do_add_type (TVar (_, S)) = union (op =) (map class_name_of S)
     fun add_type T = type_max_depth >= 0 ? do_add_type T
     fun mk_app s args =
       if member (op <>) args "" then s ^ "(" ^ space_implode "," args ^ ")"
@@ -211,10 +215,12 @@
 
 val goal_of_thm = prop_of #> freeze #> cterm_of thy #> Goal.init
 
-fun meng_paulson_facts ctxt prover_name max_relevant relevance_thresholds
-                       goal i =
+fun meng_paulson_facts ctxt max_relevant goal =
   let
-    val (_, hyp_ts, concl_t) = ATP_Util.strip_subgoal ctxt goal i
+    val {provers, relevance_thresholds, ...} =
+      Sledgehammer_Isar.default_params ctxt []
+    val prover_name = hd provers
+    val (_, hyp_ts, concl_t) = ATP_Util.strip_subgoal ctxt goal 1
     val is_built_in_const =
       Sledgehammer_Provers.is_built_in_const_for_prover ctxt prover_name
     val relevance_fudge =
@@ -226,7 +232,18 @@
         hyp_ts concl_t
   end
 
-fun generate_mash_accessibility thy include_thy file_name =
+fun run_sledgehammer ctxt facts goal =
+  let
+    val params as {provers, ...} = Sledgehammer_Isar.default_params ctxt []
+    val problem =
+      {state = Proof.init ctxt, goal = goal, subgoal = 1, subgoal_count = 1,
+       facts = facts |> map Sledgehammer_Provers.Untranslated_Fact}
+    val prover =
+      Sledgehammer_Run.get_minimizing_prover ctxt
+          Sledgehammer_Provers.Normal (hd provers)
+  in prover params (K (K (K ""))) problem end
+
+fun generate_accessibility thy include_thy file_name =
   let
     val path = file_name |> Path.explode
     val _ = File.write path ""
@@ -247,7 +264,7 @@
       in fold do_thm ths parents; () end
   in List.app (do_thy o snd) thy_ths end
 
-fun generate_mash_features thy include_thy file_name =
+fun generate_features thy include_thy file_name =
   let
     val path = file_name |> Path.explode
     val _ = File.write path ""
@@ -262,7 +279,7 @@
       in File.append path s end
   in List.app do_fact facts end
 
-fun generate_mash_dependencies thy include_thy file_name =
+fun generate_isa_dependencies thy include_thy file_name =
   let
     val path = file_name |> Path.explode
     val _ = File.write path ""
@@ -279,7 +296,35 @@
       in File.append path s end
   in List.app do_thm ths end
 
-fun generate_mash_commands thy file_name =
+fun generate_atp_dependencies ctxt thy include_thy file_name =
+  let
+    val {max_relevant, ...} = Sledgehammer_Isar.default_params ctxt []
+    val path = file_name |> Path.explode
+    val _ = File.write path ""
+    val facts =
+      non_tautological_facts_of thy
+      |> not include_thy ? filter_out (has_thy thy o snd)
+    val ths = facts |> map snd
+    val all_names = ths |> map Thm.get_name_hint
+    fun do_thm th =
+      let
+        val name = Thm.get_name_hint th
+        val goal = goal_of_thm th
+        val facts =
+          facts |> filter (fn (_, th') => thm_ord (th', th) = LESS)
+                |> meng_paulson_facts ctxt (the max_relevant) goal
+                |> map (fn ((_, stature), th) =>
+                           ((th |> Thm.get_name_hint |> fact_name_of, stature),
+                            th))
+        val deps =
+          case run_sledgehammer ctxt facts goal of
+            {outcome = NONE, used_facts, ...} => used_facts |> map fst
+          | _ => dependencies_of all_names th
+        val s = fact_name_of name ^ ": " ^ space_implode " " deps ^ "\n"
+      in File.append path s end
+  in List.app do_thm ths end
+
+fun generate_commands thy file_name =
   let
     val path = file_name |> Path.explode
     val _ = File.write path ""
@@ -306,18 +351,14 @@
     val parents = parent_thms thy_ths thy
   in fold do_fact new_facts parents; () end
 
-fun generate_meng_paulson_suggestions ctxt thy file_name =
+fun generate_meng_paulson_suggestions ctxt thy max_relevant file_name =
   let
-    val {provers, max_relevant, relevance_thresholds, ...} =
-      Sledgehammer_Isar.default_params ctxt []
-    val prover_name = hd provers
     val path = file_name |> Path.explode
     val _ = File.write path ""
     val facts = non_tautological_facts_of thy
     val (new_facts, old_facts) =
       facts |> List.partition (has_thy thy o snd)
             |>> sort (thm_ord o pairself snd)
-    val i = 1
     fun do_fact (fact as (_, th)) old_facts =
       let
         val name = Thm.get_name_hint th
@@ -327,10 +368,8 @@
           if kind <> "" then
             let
               val suggs =
-                old_facts
-                |> meng_paulson_facts ctxt prover_name (the max_relevant)
-                                      relevance_thresholds goal i
-                |> map (fact_name_of o Thm.get_name_hint o snd)
+                old_facts |> meng_paulson_facts ctxt max_relevant goal
+                          |> map (fact_name_of o fst o fst)
               val s = fact_name_of name ^ ": " ^ space_implode " " suggs ^ "\n"
             in File.append path s end
           else
--- a/src/HOL/TPTP/mash_import.ML	Wed Jul 11 13:59:39 2012 +0200
+++ b/src/HOL/TPTP/mash_import.ML	Wed Jul 11 21:43:19 2012 +0200
@@ -39,15 +39,13 @@
 
 fun import_and_evaluate_mash_suggestions ctxt thy file_name =
   let
-    val params as {provers, max_relevant, relevance_thresholds,
-                   slice, type_enc, lam_trans, timeout, ...} =
+    val {provers, max_relevant, slice, type_enc, lam_trans, timeout, ...} =
       Sledgehammer_Isar.default_params ctxt []
     val prover_name = hd provers
     val path = file_name |> Path.explode
     val lines = path |> File.read_lines
     val facts = non_tautological_facts_of thy
     val all_names = facts |> map (Thm.get_name_hint o snd)
-    val i = 1
     val meng_ok = Unsynchronized.ref 0
     val mash_ok = Unsynchronized.ref 0
     val meng_mash_ok = Unsynchronized.ref 0
@@ -90,19 +88,14 @@
        else
          "Failure: " ^
          (facts |> map (fst o fst)
+                |> take (the max_relevant)
                 |> tag_list 1
                 |> map index_string
                 |> space_implode " "))
     fun run_sh ok heading facts goal =
       let
-        val problem =
-          {state = Proof.init ctxt, goal = goal, subgoal = i, subgoal_count = 1,
-           facts = facts |> take (the max_relevant)
-                         |> map Sledgehammer_Provers.Untranslated_Fact}
-        val prover =
-          Sledgehammer_Run.get_minimizing_prover ctxt
-              Sledgehammer_Provers.Normal prover_name
-        val res as {outcome, ...} = prover params (K (K (K ""))) problem
+        val facts = facts |> take (the max_relevant)
+        val res as {outcome, ...} = run_sledgehammer ctxt facts goal
         val _ = if is_none outcome then ok := !ok + 1 else ()
       in str_of_res heading facts res end
     fun solve_goal j name suggs =
@@ -114,13 +107,12 @@
           | NONE => error ("No fact called \"" ^ name ^ "\"")
         val deps = dependencies_of all_names th
         val goal = goal_of_thm th
-        val (_, hyp_ts, concl_t) = ATP_Util.strip_subgoal ctxt goal i
+        val (_, hyp_ts, concl_t) = ATP_Util.strip_subgoal ctxt goal 1
         val facts = facts |> filter (fn (_, th') => thm_ord (th', th) = LESS)
         val deps_facts = sugg_facts hyp_ts concl_t facts deps
         val meng_facts =
-          meng_paulson_facts ctxt prover_name
-              (max_relevant_slack * the max_relevant) relevance_thresholds goal
-              i facts
+          meng_paulson_facts ctxt (max_relevant_slack * the max_relevant) goal
+                             facts
         val mash_facts = sugg_facts hyp_ts concl_t facts suggs
         val meng_mash_facts = meng_mash_facts meng_facts mash_facts
         val meng_s = run_sh meng_ok mengN meng_facts goal
@@ -142,7 +134,7 @@
       Real.fmt (StringCvt.FIX (SOME 1))
                (100.0 * Real.fromInt (!ok) / Real.fromInt n) ^ "%)"
     val inst_inducts = Config.get ctxt Sledgehammer_Filter.instantiate_inducts
-    val params =
+    val options =
       [prover_name, string_of_int (the max_relevant) ^ " facts",
        "slice" |> not slice ? prefix "dont_", the_default "smart" type_enc,
        the_default "smart" lam_trans, ATP_Util.string_from_time timeout,
@@ -150,7 +142,7 @@
     val n = length lines
   in
     tracing " * * *";
-    tracing ("Options: " ^ commas params);
+    tracing ("Options: " ^ commas options);
     List.app do_line (tag_list 1 lines);
     ["Successes (of " ^ string_of_int n ^ " goals)",
      total_of mengN meng_ok n,