merged
authorwenzelm
Thu, 26 Jul 2012 19:59:06 +0200
changeset 48536 4e2ee88276d2
parent 48535 619531d87ce4 (diff)
parent 48528 784c6f63d79c (current diff)
child 48537 ba0dd46b9214
merged
doc-src/TutorialI/Advanced/ROOT.ML
doc-src/TutorialI/Advanced/document/Partial.tex
doc-src/TutorialI/Advanced/document/WFrec.tex
doc-src/TutorialI/Advanced/document/simp2.tex
doc-src/TutorialI/CTL/ROOT.ML
doc-src/TutorialI/CTL/document/Base.tex
doc-src/TutorialI/CTL/document/CTL.tex
doc-src/TutorialI/CTL/document/CTLind.tex
doc-src/TutorialI/CTL/document/PDL.tex
doc-src/TutorialI/CodeGen/ROOT.ML
doc-src/TutorialI/CodeGen/document/CodeGen.tex
doc-src/TutorialI/Datatype/ROOT.ML
doc-src/TutorialI/Datatype/document/ABexpr.tex
doc-src/TutorialI/Datatype/document/Fundata.tex
doc-src/TutorialI/Datatype/document/Nested.tex
doc-src/TutorialI/Datatype/document/unfoldnested.tex
doc-src/TutorialI/Documents/ROOT.ML
doc-src/TutorialI/Documents/document/Documents.tex
doc-src/TutorialI/Documents/documents.tex
doc-src/TutorialI/Fun/ROOT.ML
doc-src/TutorialI/Fun/document/fun0.tex
doc-src/TutorialI/Ifexpr/ROOT.ML
doc-src/TutorialI/Ifexpr/document/Ifexpr.tex
doc-src/TutorialI/Inductive/ROOT.ML
doc-src/TutorialI/Inductive/document/AB.tex
doc-src/TutorialI/Inductive/document/Advanced.tex
doc-src/TutorialI/Inductive/document/Even.tex
doc-src/TutorialI/Inductive/document/Mutual.tex
doc-src/TutorialI/Inductive/document/Star.tex
doc-src/TutorialI/Misc/ROOT.ML
doc-src/TutorialI/Misc/document/AdvancedInd.tex
doc-src/TutorialI/Misc/document/Itrev.tex
doc-src/TutorialI/Misc/document/Option2.tex
doc-src/TutorialI/Misc/document/Plus.tex
doc-src/TutorialI/Misc/document/Tree.tex
doc-src/TutorialI/Misc/document/Tree2.tex
doc-src/TutorialI/Misc/document/appendix.tex
doc-src/TutorialI/Misc/document/case_exprs.tex
doc-src/TutorialI/Misc/document/fakenat.tex
doc-src/TutorialI/Misc/document/natsum.tex
doc-src/TutorialI/Misc/document/pairs.tex
doc-src/TutorialI/Misc/document/prime_def.tex
doc-src/TutorialI/Misc/document/simp.tex
doc-src/TutorialI/Misc/document/types.tex
doc-src/TutorialI/Misc/pairs.thy
doc-src/TutorialI/Protocol/ROOT.ML
doc-src/TutorialI/Protocol/document/Event.tex
doc-src/TutorialI/Protocol/document/Message.tex
doc-src/TutorialI/Protocol/document/NS_Public.tex
doc-src/TutorialI/Protocol/document/Public.tex
doc-src/TutorialI/Recdef/ROOT.ML
doc-src/TutorialI/Rules/ROOT.ML
doc-src/TutorialI/Rules/document/find2.tex
doc-src/TutorialI/Sets/ROOT.ML
doc-src/TutorialI/ToyList/ROOT.ML
doc-src/TutorialI/ToyList/document/ToyList.tex
doc-src/TutorialI/Trie/ROOT.ML
doc-src/TutorialI/Trie/document/Trie.tex
doc-src/TutorialI/Types/ROOT.ML
doc-src/TutorialI/Types/document/Axioms.tex
doc-src/TutorialI/Types/document/Numbers.tex
doc-src/TutorialI/Types/document/Overloading.tex
doc-src/TutorialI/Types/document/Pairs.tex
doc-src/TutorialI/Types/document/Records.tex
doc-src/TutorialI/Types/document/Typedefs.tex
doc-src/TutorialI/settings.ML
--- a/src/HOL/TPTP/MaSh_Export.thy	Thu Jul 26 19:57:33 2012 +0200
+++ b/src/HOL/TPTP/MaSh_Export.thy	Thu Jul 26 19:59:06 2012 +0200
@@ -26,7 +26,7 @@
 
 ML {*
 if do_it then
-  generate_accessibility thy false "/tmp/mash_accessibility"
+  generate_accessibility @{context} thy false "/tmp/mash_accessibility"
 else
   ()
 *}
@@ -40,14 +40,14 @@
 
 ML {*
 if do_it then
-  generate_isar_dependencies thy false "/tmp/mash_dependencies"
+  generate_isar_dependencies @{context} thy false "/tmp/mash_dependencies"
 else
   ()
 *}
 
 ML {*
 if do_it then
-  generate_commands @{context} prover thy "/tmp/mash_commands"
+  generate_commands @{context} params thy "/tmp/mash_commands"
 else
   ()
 *}
--- a/src/HOL/TPTP/atp_theory_export.ML	Thu Jul 26 19:57:33 2012 +0200
+++ b/src/HOL/TPTP/atp_theory_export.ML	Thu Jul 26 19:59:06 2012 +0200
@@ -123,7 +123,8 @@
     val path = file_name |> Path.explode
     val _ = File.write path ""
     val facts =
-      Sledgehammer_Fact.all_facts_of (Proof_Context.init_global thy) css_table
+      Sledgehammer_Fact.all_facts (Proof_Context.init_global thy) false
+                                  Symtab.empty [] [] css_table
     val atp_problem =
       facts
       |> map (fn ((_, loc), th) =>
--- a/src/HOL/TPTP/mash_eval.ML	Thu Jul 26 19:57:33 2012 +0200
+++ b/src/HOL/TPTP/mash_eval.ML	Thu Jul 26 19:59:06 2012 +0200
@@ -36,8 +36,9 @@
     val slack_max_facts = max_facts_slack * the max_facts
     val path = file_name |> Path.explode
     val lines = path |> File.read_lines
-    val css_table = Sledgehammer_Fact.clasimpset_rule_table_of ctxt
-    val facts = all_facts_of (Proof_Context.init_global thy) css_table
+    val css = Sledgehammer_Fact.clasimpset_rule_table_of ctxt
+    val facts =
+      all_facts (Proof_Context.init_global thy) false Symtab.empty [] [] css
     val all_names = all_names (facts |> map snd)
     val mepo_ok = Unsynchronized.ref 0
     val mash_ok = Unsynchronized.ref 0
@@ -70,7 +71,7 @@
         val th =
           case find_first (fn (_, th) => nickname_of th = name) facts of
             SOME (_, th) => th
-          | NONE => error ("No fact called \"" ^ name ^ "\"")
+          | NONE => error ("No fact called \"" ^ name ^ "\".")
         val goal = goal_of_thm thy th
         val (_, hyp_ts, concl_t) = ATP_Util.strip_subgoal ctxt goal 1
         val isar_deps = isar_dependencies_of all_names th |> these
--- a/src/HOL/TPTP/mash_export.ML	Thu Jul 26 19:57:33 2012 +0200
+++ b/src/HOL/TPTP/mash_export.ML	Thu Jul 26 19:59:06 2012 +0200
@@ -9,14 +9,14 @@
 sig
   type params = Sledgehammer_Provers.params
 
-  val generate_accessibility : theory -> bool -> string -> unit
+  val generate_accessibility : Proof.context -> theory -> bool -> string -> unit
   val generate_features :
     Proof.context -> string -> theory -> bool -> string -> unit
   val generate_isar_dependencies :
-    theory -> bool -> string -> unit
+    Proof.context -> theory -> bool -> string -> unit
   val generate_atp_dependencies :
     Proof.context -> params -> theory -> bool -> string -> unit
-  val generate_commands : Proof.context -> string -> theory -> string -> unit
+  val generate_commands : Proof.context -> params -> theory -> string -> unit
   val generate_mepo_suggestions :
     Proof.context -> params -> theory -> int -> string -> unit
 end;
@@ -37,6 +37,12 @@
 fun has_thy thy th =
   Context.theory_name thy = Context.theory_name (theory_of_thm th)
 
+fun all_non_technical_facts ctxt thy =
+  let val css = Sledgehammer_Fact.clasimpset_rule_table_of ctxt in
+    all_facts (Proof_Context.init_global thy) false Symtab.empty [] [] css
+    |> filter_out (is_thm_technical o snd)
+  end
+
 fun parent_facts thy thy_map =
   let
     fun add_last thy =
@@ -51,7 +57,12 @@
 
 val all_names = map (rpair () o nickname_of) #> Symtab.make
 
-fun generate_accessibility thy include_thy file_name =
+fun smart_dependencies_of ctxt params prover facts all_names th =
+  case atp_dependencies_of ctxt params prover 0 facts all_names th of
+    SOME deps => deps
+  | NONE => isar_dependencies_of all_names th |> these
+
+fun generate_accessibility ctxt thy include_thy file_name =
   let
     val path = file_name |> Path.explode
     val _ = File.write path ""
@@ -61,23 +72,22 @@
         val _ = File.append path s
       in [fact] end
     val thy_map =
-      all_facts_of (Proof_Context.init_global thy) Termtab.empty
+      all_non_technical_facts ctxt thy
       |> not include_thy ? filter_out (has_thy thy o snd)
       |> thy_map_from_facts
     fun do_thy facts =
       let
         val thy = thy_of_fact thy (hd facts)
         val parents = parent_facts thy thy_map
-      in fold do_fact facts parents; () end
+      in fold_rev do_fact facts parents; () end
   in fold_rev (fn (_, facts) => fn () => do_thy facts) thy_map () end
 
 fun generate_features ctxt prover thy include_thy file_name =
   let
     val path = file_name |> Path.explode
     val _ = File.write path ""
-    val css_table = clasimpset_rule_table_of ctxt
     val facts =
-      all_facts_of (Proof_Context.init_global thy) css_table
+      all_non_technical_facts ctxt thy
       |> not include_thy ? filter_out (has_thy thy o snd)
     fun do_fact ((_, stature), th) =
       let
@@ -88,12 +98,12 @@
       in File.append path s end
   in List.app do_fact facts end
 
-fun generate_isar_dependencies thy include_thy file_name =
+fun generate_isar_dependencies ctxt thy include_thy file_name =
   let
     val path = file_name |> Path.explode
     val _ = File.write path ""
     val ths =
-      all_facts_of (Proof_Context.init_global thy) Termtab.empty
+      all_non_technical_facts ctxt thy
       |> not include_thy ? filter_out (has_thy thy o snd)
       |> map snd
     val all_names = all_names ths
@@ -112,27 +122,24 @@
     val _ = File.write path ""
     val prover = hd provers
     val facts =
-      all_facts_of (Proof_Context.init_global thy) Termtab.empty
+      all_non_technical_facts ctxt thy
       |> not include_thy ? filter_out (has_thy thy o snd)
     val ths = facts |> map snd
     val all_names = all_names ths
     fun do_thm th =
       let
         val name = nickname_of th
-        val deps =
-          case atp_dependencies_of ctxt params prover 0 facts all_names th of
-            SOME deps => deps
-          | NONE => isar_dependencies_of all_names th |> these
+        val deps = smart_dependencies_of ctxt params prover facts all_names th
         val s = escape_meta name ^ ": " ^ escape_metas deps ^ "\n"
       in File.append path s end
   in List.app do_thm ths end
 
-fun generate_commands ctxt prover thy file_name =
+fun generate_commands ctxt (params as {provers, ...}) thy file_name =
   let
     val path = file_name |> Path.explode
     val _ = File.write path ""
-    val css_table = Sledgehammer_Fact.clasimpset_rule_table_of ctxt
-    val facts = all_facts_of (Proof_Context.init_global thy) css_table
+    val prover = hd provers
+    val facts = all_non_technical_facts ctxt thy
     val (new_facts, old_facts) =
       facts |> List.partition (has_thy thy o snd)
             |>> sort (thm_ord o pairself snd)
@@ -142,13 +149,13 @@
       let
         val name = nickname_of th
         val feats = features_of ctxt prover thy stature [prop_of th]
-        val deps = isar_dependencies_of all_names th |> these
+        val deps = smart_dependencies_of ctxt params prover facts all_names th
         val kind = Thm.legacy_get_kind th
-        val core = escape_metas prevs ^ "; " ^ escape_metas feats
+        val core =
+          escape_meta name ^ ": " ^ escape_metas prevs ^ "; " ^
+          escape_metas feats
         val query = if kind <> "" then "? " ^ core ^ "\n" else ""
-        val update =
-          "! " ^ escape_meta name ^ ": " ^ core ^ "; " ^
-          escape_metas deps ^ "\n"
+        val update = "! " ^ core ^ "; " ^ escape_metas deps ^ "\n"
         val _ = File.append path (query ^ update)
       in [name] end
     val thy_map = old_facts |> thy_map_from_facts
@@ -161,8 +168,7 @@
     val path = file_name |> Path.explode
     val _ = File.write path ""
     val prover = hd provers
-    val css_table = Sledgehammer_Fact.clasimpset_rule_table_of ctxt
-    val facts = all_facts_of (Proof_Context.init_global thy) css_table
+    val facts = all_non_technical_facts ctxt thy
     val (new_facts, old_facts) =
       facts |> List.partition (has_thy thy o snd)
             |>> sort (thm_ord o pairself snd)
--- a/src/HOL/Tools/SMT/smt_solver.ML	Thu Jul 26 19:57:33 2012 +0200
+++ b/src/HOL/Tools/SMT/smt_solver.ML	Thu Jul 26 19:59:06 2012 +0200
@@ -52,8 +52,8 @@
 local
 
 fun make_cmd command options problem_path proof_path = space_implode " " (
-  map File.shell_quote (command () @ options) @
-  [File.shell_path problem_path, "2>&1", ">", File.shell_path proof_path])
+  "(exec 2>&1;" :: map File.shell_quote (command () @ options) @
+  [File.shell_path problem_path, ")", ">", File.shell_path proof_path])
 
 fun trace_and ctxt msg f x =
   let val _ = SMT_Config.trace_msg ctxt (fn () => msg) ()
@@ -99,7 +99,7 @@
     val ls = rev (snd (chop_while (equal "") (rev res)))
     val _ = SMT_Config.trace_msg ctxt (pretty "Result:") ls
 
-    val _ = null ls andalso return_code <> 0 andalso
+    val _ = return_code <> 0 andalso
       raise SMT_Failure.SMT (SMT_Failure.Abnormal_Termination return_code)
   in ls end
 
--- a/src/HOL/Tools/Sledgehammer/sledgehammer_fact.ML	Thu Jul 26 19:57:33 2012 +0200
+++ b/src/HOL/Tools/Sledgehammer/sledgehammer_fact.ML	Thu Jul 26 19:59:06 2012 +0200
@@ -29,7 +29,9 @@
     Proof.context -> term list -> term -> (((unit -> string) * 'a) * thm) list
     -> (((unit -> string) * 'a) * thm) list
   val maybe_filter_no_atps : Proof.context -> ('a * thm) list -> ('a * thm) list
-  val all_facts_of : Proof.context -> status Termtab.table -> fact list
+  val all_facts :
+    Proof.context -> bool -> unit Symtab.table -> thm list -> thm list
+    -> status Termtab.table -> fact list
   val nearly_all_facts :
     Proof.context -> bool -> fact_override -> unit Symtab.table
     -> status Termtab.table -> thm list -> term list -> term -> fact list
@@ -436,10 +438,6 @@
              |> op @
   end
 
-fun all_facts_of ctxt css =
-  all_facts ctxt false Symtab.empty [] [] css
-  |> rev (* partly restore the original order of facts, for MaSh *)
-
 fun nearly_all_facts ctxt ho_atp {add, del, only} reserved css chained hyp_ts
                      concl_t =
   if only andalso null add then
--- a/src/HOL/Tools/Sledgehammer/sledgehammer_isar.ML	Thu Jul 26 19:57:33 2012 +0200
+++ b/src/HOL/Tools/Sledgehammer/sledgehammer_isar.ML	Thu Jul 26 19:59:06 2012 +0200
@@ -162,21 +162,22 @@
   #> (fn (name, value) =>
          if is_known_raw_param name then
            (name, value)
-         else if is_prover_list ctxt name andalso null value then
-           ("provers", [name])
-         else if can (type_enc_from_string Strict) name andalso null value then
-           ("type_enc", [name])
-         else if can (trans_lams_from_string ctxt any_type_enc) name andalso
-                 null value then
-           ("lam_trans", [name])
-         else if member (op =) fact_filters name then
-           ("fact_filter", [name])
-         else if can Int.fromString name then
-           ("max_facts", [name])
+         else if null value then
+           if is_prover_list ctxt name then
+             ("provers", [name])
+           else if can (type_enc_from_string Strict) name then
+             ("type_enc", [name])
+           else if can (trans_lams_from_string ctxt any_type_enc) name then
+             ("lam_trans", [name])
+           else if member (op =) fact_filters name then
+             ("fact_filter", [name])
+           else if is_some (Int.fromString name) then
+             ("max_facts", [name])
+           else
+             error ("Unknown parameter: " ^ quote name ^ ".")
          else
            error ("Unknown parameter: " ^ quote name ^ "."))
 
-
 (* Ensures that type encodings such as "mono_native?" and "poly_guards!!" are
    read correctly. *)
 val implode_param = strip_spaces_except_between_idents o space_implode " "
--- a/src/HOL/Tools/Sledgehammer/sledgehammer_mash.ML	Thu Jul 26 19:57:33 2012 +0200
+++ b/src/HOL/Tools/Sledgehammer/sledgehammer_mash.ML	Thu Jul 26 19:59:06 2012 +0200
@@ -45,6 +45,7 @@
   val atp_dependencies_of :
     Proof.context -> params -> string -> int -> fact list -> unit Symtab.table
     -> thm -> string list option
+  val is_thm_technical : thm -> bool
   val mash_CLEAR : Proof.context -> unit
   val mash_ADD :
     Proof.context -> bool
@@ -399,6 +400,14 @@
       | _ => NONE
     end
 
+val technical_theories =
+  ["Code_Evaluation", "DSequence", "Enum", "Lazy_Sequence", "Nitpick",
+   "New_DSequence", "New_Random_Sequence", "Quickcheck",
+   "Quickcheck_Exhaustive", "Quickcheck_Narrowing", "Random_Sequence", "SMT"]
+
+val is_thm_technical =
+  member (op =) technical_theories o Context.theory_name o theory_of_thm
+
 
 (*** Low-level communication with MaSh ***)
 
@@ -700,14 +709,6 @@
           (true, "")
         end)
 
-val evil_theories =
-  ["Code_Evaluation", "DSequence", "Enum", "Lazy_Sequence", "Nitpick",
-   "New_DSequence", "New_Random_Sequence", "Quickcheck",
-   "Quickcheck_Exhaustive", "Quickcheck_Narrowing", "Random_Sequence", "SMT"]
-
-fun fact_has_evil_theory (_, th) =
-  member (op =) evil_theories (Context.theory_name (theory_of_thm th))
-
 fun sendback sub =
   Markup.markup Isabelle_Markup.sendback (sledgehammerN ^ " " ^ sub)
 
@@ -722,7 +723,7 @@
       Time.+ (Timer.checkRealTimer timer, commit_timeout)
     val {fact_G} = mash_get ctxt
     val (old_facts, new_facts) =
-      facts |> filter_out fact_has_evil_theory
+      facts |> filter_out (is_thm_technical o snd)
             |> List.partition (is_fact_in_graph fact_G)
             ||> sort (thm_ord o pairself snd)
   in
--- a/src/HOL/Tools/Sledgehammer/sledgehammer_provers.ML	Thu Jul 26 19:57:33 2012 +0200
+++ b/src/HOL/Tools/Sledgehammer/sledgehammer_provers.ML	Thu Jul 26 19:59:06 2012 +0200
@@ -775,9 +775,9 @@
             val args = arguments ctxt full_proof extra slice_timeout
                                  (ord, ord_info, sel_weights)
             val command =
-              File.shell_path command0 ^ " " ^ args ^ " " ^
-              File.shell_path prob_file
-              |> enclose "TIMEFORMAT='%3R'; { time " " ; } 2>&1"
+              "(exec 2>&1; " ^ File.shell_path command0 ^ " " ^ args ^ " " ^
+              File.shell_path prob_file ^ ")"
+              |> enclose "TIMEFORMAT='%3R'; { time " " ; }"
             val _ =
               atp_problem
               |> lines_for_atp_problem format ord ord_info
--- a/src/HOL/Tools/try0.ML	Thu Jul 26 19:57:33 2012 +0200
+++ b/src/HOL/Tools/try0.ML	Thu Jul 26 19:59:06 2012 +0200
@@ -77,12 +77,13 @@
   if mode <> Auto_Try orelse run_if_auto_try then
     let val attrs = attrs_text attrs quad in
       do_generic timeout_opt
-                 (name ^ (if all_goals andalso
-                             nprems_of (#goal (Proof.goal st)) > 1 then
-                            "[1]"
-                          else
-                            "") ^
-                  attrs) I (#goal o Proof.goal)
+                 (name ^ attrs ^
+                  (if all_goals andalso
+                      nprems_of (#goal (Proof.goal st)) > 1 then
+                     " [1]"
+                   else
+                     ""))
+                 I (#goal o Proof.goal)
                  (apply_named_method_on_first_goal (name ^ attrs)
                                                    (Proof.theory_of st)) st
     end