added "try" command, to launch Solve Direct, Quickcheck, Nitpick, Sledgehammer, and Try Methods
authorblanchet
Fri, 27 May 2011 10:30:08 +0200
changeset 43020 abb5d1f907e4
parent 43019 619f16bf2150
child 43021 5910dd009d0e
added "try" command, to launch Solve Direct, Quickcheck, Nitpick, Sledgehammer, and Try Methods
etc/isar-keywords.el
src/HOL/Mirabelle/Tools/mirabelle_sledgehammer.ML
src/HOL/Tools/Nitpick/nitpick.ML
src/HOL/Tools/Nitpick/nitpick_isar.ML
src/HOL/Tools/Nitpick/nitrox.ML
src/HOL/Tools/Sledgehammer/sledgehammer_isar.ML
src/HOL/Tools/Sledgehammer/sledgehammer_run.ML
src/HOL/Tools/try_methods.ML
src/Tools/quickcheck.ML
src/Tools/solve_direct.ML
src/Tools/try.ML
--- a/etc/isar-keywords.el	Fri May 27 10:30:08 2011 +0200
+++ b/etc/isar-keywords.el	Fri May 27 10:30:08 2011 +0200
@@ -253,6 +253,7 @@
     "thy_deps"
     "translations"
     "try"
+    "try_methods"
     "txt"
     "txt_raw"
     "typ"
@@ -411,6 +412,7 @@
     "thm_deps"
     "thy_deps"
     "try"
+    "try_methods"
     "typ"
     "unused_thms"
     "value"
--- a/src/HOL/Mirabelle/Tools/mirabelle_sledgehammer.ML	Fri May 27 10:30:08 2011 +0200
+++ b/src/HOL/Mirabelle/Tools/mirabelle_sledgehammer.ML	Fri May 27 10:30:08 2011 +0200
@@ -582,7 +582,8 @@
         Unsynchronized.ref (NONE : ((string * locality) * thm list) list option)
       val minimize = AList.defined (op =) args minimizeK
       val metis_ft = AList.defined (op =) args metis_ftK
-      val trivial = Try.invoke_try (SOME try_timeout) ([], [], [], []) pre
+      val trivial =
+        Try_Methods.try_methods (SOME try_timeout) ([], [], [], []) pre
         handle TimeLimit.TimeOut => false
       fun apply_reconstructor m1 m2 =
         if metis_ft
--- a/src/HOL/Tools/Nitpick/nitpick.ML	Fri May 27 10:30:08 2011 +0200
+++ b/src/HOL/Tools/Nitpick/nitpick.ML	Fri May 27 10:30:08 2011 +0200
@@ -55,6 +55,11 @@
      batch_size: int,
      expect: string}
 
+  val genuineN : string
+  val quasi_genuineN : string
+  val potentialN : string
+  val noneN : string
+  val unknownN : string
   val register_frac_type : string -> (string * string) list -> theory -> theory
   val unregister_frac_type : string -> theory -> theory
   val register_codatatype : typ -> string -> styp list -> theory -> theory
@@ -131,6 +136,12 @@
    batch_size: int,
    expect: string}
 
+val genuineN = "genuine"
+val quasi_genuineN = "quasi_genuine"
+val potentialN = "potential"
+val noneN = "none"
+val unknownN = "unknown"
+
 (* TODO: eliminate these historical aliases *)
 val register_frac_type = Nitpick_HOL.register_frac_type_global
 val unregister_frac_type = Nitpick_HOL.unregister_frac_type_global
@@ -973,7 +984,7 @@
     fun run_batches _ _ []
                     (found_really_genuine, max_potential, max_genuine, donno) =
         if donno > 0 andalso max_genuine > 0 then
-          (print_m (fn () => excipit "checked"); "unknown")
+          (print_m (fn () => excipit "checked"); unknownN)
         else if max_genuine = original_max_genuine then
           if max_potential = original_max_potential then
             (print_m (fn () =>
@@ -982,7 +993,7 @@
                     " This suggests that the induction hypothesis might be \
                     \general enough to prove this subgoal."
                   else
-                    "")); if skipped > 0 then "unknown" else "none")
+                    "")); if skipped > 0 then unknownN else noneN)
           else
             (print_m (fn () =>
                  excipit ("could not find a" ^
@@ -991,11 +1002,11 @@
                            else
                              "ny better " ^ das_wort_model ^ "s.") ^
                           " It checked"));
-             "potential")
+             potentialN)
         else if found_really_genuine then
-          "genuine"
+          genuineN
         else
-          "quasi_genuine"
+          quasi_genuineN
       | run_batches j n (batch :: batches) z =
         let val (z as (_, _, max_genuine, _)) = run_batch j n batch z in
           run_batches (j + 1) n (if max_genuine > 0 then batches else []) z
@@ -1007,7 +1018,7 @@
                   (false, max_potential, max_genuine, 0)
       handle TimeLimit.TimeOut =>
              (print_m (fn () => excipit "ran out of time after checking");
-              if !met_potential > 0 then "potential" else "unknown")
+              if !met_potential > 0 then potentialN else unknownN)
     val _ = print_v (fn () =>
                 "Total time: " ^ string_from_time (Timer.checkRealTimer timer) ^
                 ".")
@@ -1026,7 +1037,7 @@
        ("no_kodkodi", state))
     else
       let
-        val unknown_outcome = ("unknown", state)
+        val unknown_outcome = (unknownN, state)
         val deadline = Option.map (curry Time.+ (Time.now ())) timeout
         val outcome as (outcome_code, _) =
           time_limit (if debug orelse is_none timeout then NONE
@@ -1065,7 +1076,7 @@
     val t = state |> Proof.raw_goal |> #goal |> prop_of
   in
     case Logic.count_prems t of
-      0 => (Output.urgent_message "No subgoal!"; ("none", state))
+      0 => (Output.urgent_message "No subgoal!"; (noneN, state))
     | n =>
       let
         val t = Logic.goal_params t i |> fst
--- a/src/HOL/Tools/Nitpick/nitpick_isar.ML	Fri May 27 10:30:08 2011 +0200
+++ b/src/HOL/Tools/Nitpick/nitpick_isar.ML	Fri May 27 10:30:08 2011 +0200
@@ -10,6 +10,8 @@
 sig
   type params = Nitpick.params
 
+  val nitpickN : string
+  val nitpick_paramsN : string
   val auto : bool Unsynchronized.ref
   val default_params : theory -> (string * string) list -> params
   val setup : theory -> theory
@@ -24,6 +26,9 @@
 open Nitpick_Nut
 open Nitpick
 
+val nitpickN = "nitpick"
+val nitpick_paramsN = "nitpick_params"
+
 val auto = Unsynchronized.ref false
 
 (* Maximum number of scopes for Auto Nitpick. Be frugal since it has to share
@@ -356,18 +361,18 @@
     val params as {blocking, debug, ...} =
       extract_params ctxt auto (default_raw_params thy) override_params
     fun go () =
-      (false, state)
+      (unknownN, state)
       |> (if auto then perhaps o try
           else if debug then fn f => fn x => f x
           else handle_exceptions ctxt)
-         (fn (_, state) => pick_nits_in_subgoal state params auto i step
-                           |>> curry (op =) "genuine")
-  in if blocking then go () else Future.fork (tap go) |> K (false, state) end
+         (fn (_, state) => pick_nits_in_subgoal state params auto i step)
+  in if blocking then go () else Future.fork (tap go) |> K (unknownN, state) end
+  |> `(fn (outcome_code, _) => outcome_code = genuineN)
 
 fun nitpick_trans (params, i) =
-  Toplevel.keep (fn st =>
-      (pick_nits params false i (Toplevel.proof_position_of st)
-                 (Toplevel.proof_of st); ()))
+  Toplevel.keep (fn state =>
+      pick_nits params false i (Toplevel.proof_position_of state)
+                (Toplevel.proof_of state) |> K ())
 
 fun string_for_raw_param (name, value) =
   name ^ " = " ^ stringify_raw_param_value value
@@ -388,15 +393,15 @@
   (parse_params -- Scan.optional Parse.nat 1) #>> nitpick_trans
 val parse_nitpick_params_command = parse_params #>> nitpick_params_trans
 
-val _ = Outer_Syntax.improper_command "nitpick"
+val _ = Outer_Syntax.improper_command nitpickN
             "try to find a counterexample for a given subgoal using Nitpick"
             Keyword.diag parse_nitpick_command
-val _ = Outer_Syntax.command "nitpick_params"
+val _ = Outer_Syntax.command nitpick_paramsN
             "set and display the default parameters for Nitpick"
             Keyword.thy_decl parse_nitpick_params_command
 
-val auto_nitpick = pick_nits [] true 1 0
+fun try_nitpick auto = pick_nits [] auto 1 0
 
-val setup = Try.register_tool (auto, auto_nitpick)
+val setup = Try.register_tool (nitpickN, (auto, try_nitpick))
 
 end;
--- a/src/HOL/Tools/Nitpick/nitrox.ML	Fri May 27 10:30:08 2011 +0200
+++ b/src/HOL/Tools/Nitpick/nitrox.ML	Fri May 27 10:30:08 2011 +0200
@@ -124,7 +124,7 @@
          ("format", "1000"),
          ("max_potential", "0"),
          (* ("timeout", "240 s"), *)
-         ("expect", "genuine")]
+         ("expect", Nitpick.genuineN)]
         |> Nitpick_Isar.default_params @{theory}
       val auto = false
       val i = 1
--- a/src/HOL/Tools/Sledgehammer/sledgehammer_isar.ML	Fri May 27 10:30:08 2011 +0200
+++ b/src/HOL/Tools/Sledgehammer/sledgehammer_isar.ML	Fri May 27 10:30:08 2011 +0200
@@ -8,6 +8,7 @@
 sig
   type params = Sledgehammer_Provers.params
 
+  val sledgehammerN : string
   val auto : bool Unsynchronized.ref
   val provers : string Unsynchronized.ref
   val timeout : int Unsynchronized.ref
@@ -26,6 +27,17 @@
 open Sledgehammer_Minimize
 open Sledgehammer_Run
 
+val sledgehammerN = "sledgehammer"
+val sledgehammer_paramsN = "sledgehammer_params"
+
+val runN = "run"
+val minN = "min"
+val messagesN = "messages"
+val supported_proversN = "supported_provers"
+val running_proversN = "running_provers"
+val kill_proversN = "kill_provers"
+val refresh_tptpN = "refresh_tptp"
+
 val auto = Unsynchronized.ref false
 
 val _ =
@@ -296,17 +308,6 @@
 
 (* Sledgehammer the given subgoal *)
 
-val sledgehammerN = "sledgehammer"
-val sledgehammer_paramsN = "sledgehammer_params"
-
-val runN = "run"
-val minN = "min"
-val messagesN = "messages"
-val supported_proversN = "supported_provers"
-val running_proversN = "running_provers"
-val kill_proversN = "kill_provers"
-val refresh_tptpN = "refresh_tptp"
-
 val is_raw_param_relevant_for_minimize =
   member (op =) params_for_minimize o fst o unalias_raw_param
 fun string_for_raw_param (key, values) =
@@ -402,12 +403,15 @@
       "set and display the default parameters for Sledgehammer" Keyword.thy_decl
       parse_sledgehammer_params_command
 
-fun auto_sledgehammer state =
-  let val ctxt = Proof.context_of state in
-    run_sledgehammer (get_params true ctxt []) true 1 no_relevance_override
-                     (minimize_command [] 1) state
+fun try_sledgehammer auto state =
+  let
+    val ctxt = Proof.context_of state
+    val i = 1
+  in
+    run_sledgehammer (get_params auto ctxt []) auto i no_relevance_override
+                     (minimize_command [] i) state
   end
 
-val setup = Try.register_tool (auto, auto_sledgehammer)
+val setup = Try.register_tool (sledgehammerN, (auto, try_sledgehammer))
 
 end;
--- a/src/HOL/Tools/Sledgehammer/sledgehammer_run.ML	Fri May 27 10:30:08 2011 +0200
+++ b/src/HOL/Tools/Sledgehammer/sledgehammer_run.ML	Fri May 27 10:30:08 2011 +0200
@@ -13,11 +13,15 @@
   type params = Sledgehammer_Provers.params
   type prover = Sledgehammer_Provers.prover
 
+  val someN : string
+  val noneN : string
+  val timeoutN : string
+  val unknownN : string
   val auto_minimize_min_facts : int Config.T
   val get_minimizing_prover : Proof.context -> bool -> string -> prover
   val run_sledgehammer :
     params -> bool -> int -> relevance_override -> (string -> minimize_command)
-    -> Proof.state -> bool * Proof.state
+    -> Proof.state -> bool * (string * Proof.state)
 end;
 
 structure Sledgehammer_Run : SLEDGEHAMMER_RUN =
@@ -29,6 +33,22 @@
 open Sledgehammer_Provers
 open Sledgehammer_Minimize
 
+val someN = "some"
+val noneN = "none"
+val timeoutN = "timeout"
+val unknownN = "unknown"
+
+val ordered_outcome_codes = [someN, unknownN, timeoutN, noneN]
+
+fun max_outcome_code codes =
+  NONE
+  |> fold (fn candidate =>
+              fn accum as SOME _ => accum
+               | NONE => if member (op =) codes candidate then SOME candidate
+                         else NONE)
+          ordered_outcome_codes
+  |> the_default unknownN
+
 fun prover_description ctxt ({verbose, blocking, ...} : params) name num_facts i
                        n goal =
   (name,
@@ -86,11 +106,6 @@
              | NONE => result
            end)
 
-val someN = "some"
-val noneN = "none"
-val timeoutN = "timeout"
-val unknownN = "unknown"
-
 fun launch_prover (params as {debug, blocking, max_relevant, slicing, timeout,
                               expect, ...})
         auto minimize_command only
@@ -190,7 +205,7 @@
   if null provers then
     error "No prover is set."
   else case subgoal_count state of
-    0 => (Output.urgent_message "No subgoal!"; (false, state))
+    0 => (Output.urgent_message "No subgoal!"; (false, (noneN, state)))
   | n =>
     let
       val _ = Proof.assert_backward state
@@ -219,18 +234,19 @@
              facts = facts,
              smt_filter = maybe_smt_filter
                   (fn () => map_filter (try dest_SMT_Weighted_Fact) facts) i}
-          fun launch problem =
-            launch_prover params auto minimize_command only problem
-            #>> curry (op =) someN
+          val launch = launch_prover params auto minimize_command only
         in
           if auto then
-            fold (fn prover => fn (true, state) => (true, state)
-                                | (false, _) => launch problem prover)
-                 provers (false, state)
+            (unknownN, state)
+            |> fold (fn prover => fn accum as (outcome_code, state) =>
+                        if outcome_code = someN then accum
+                        else launch problem prover)
+                    provers
           else
             provers
-            |> (if blocking then smart_par_list_map else map) (launch problem)
-            |> exists fst |> rpair state
+            |> (if blocking then smart_par_list_map else map)
+                   (launch problem #> fst)
+            |> max_outcome_code |> rpair state
         end
       fun get_facts label is_appropriate_prop relevance_fudge provers =
         let
@@ -290,24 +306,26 @@
           in
             smts |> map (`(class_of_smt_solver ctxt))
                  |> AList.group (op =)
-                 |> map (launch_provers state (K facts) weight smt_filter o snd)
-                 |> exists fst |> rpair state
+                 |> map (snd #> launch_provers state (K facts) weight smt_filter
+                             #> fst)
+                 |> max_outcome_code |> rpair state
           end
       val launch_full_atps = launch_atps "ATP" (K true) full_atps
       val launch_ueq_atps =
         launch_atps "Unit equational provers" is_unit_equality ueq_atps
       fun launch_atps_and_smt_solvers () =
         [launch_full_atps, launch_ueq_atps, launch_smts]
-        |> smart_par_list_map (fn f => f (false, state) |> K ())
+        |> smart_par_list_map (fn f => f (unknownN, state) |> K ())
         handle ERROR msg => (print ("Error: " ^ msg); error msg)
     in
-      (false, state)
+      (unknownN, state)
       |> (if blocking then
             launch_full_atps #> not auto ? (launch_ueq_atps #> launch_smts)
           else
             (fn p => Future.fork (tap launch_atps_and_smt_solvers) |> K p))
       handle TimeLimit.TimeOut =>
-             (print "Sledgehammer ran out of time."; (false, state))
+             (print "Sledgehammer ran out of time."; (unknownN, state))
     end
+    |> `(fn (outcome_code, _) => outcome_code = someN)
 
 end;
--- a/src/HOL/Tools/try_methods.ML	Fri May 27 10:30:08 2011 +0200
+++ b/src/HOL/Tools/try_methods.ML	Fri May 27 10:30:08 2011 +0200
@@ -6,6 +6,8 @@
 
 signature TRY_METHODS =
 sig
+  val try_methodsN : string
+  val noneN : string
   val auto : bool Unsynchronized.ref
   val try_methods :
     Time.time option -> string list * string list * string list * string list
@@ -16,6 +18,10 @@
 structure Try_Methods : TRY_METHODS =
 struct
 
+val try_methodsN = "try_methods"
+
+val noneN = "none"
+
 val auto = Unsynchronized.ref false
 
 val _ =
@@ -109,7 +115,8 @@
   in
     case do_methods |> Par_List.map (fn f => f auto timeout_opt quad st)
                     |> map_filter I |> sort (int_ord o pairself snd) of
-      [] => (if auto then () else writeln "No proof found."; (false, st))
+      [] => (if auto then () else writeln "No proof found.";
+             (false, (noneN, st)))
     | xs as (s, _) :: _ =>
       let
         val xs = xs |> map (fn (s, n) => (n, hd (space_explode " " s)))
@@ -124,20 +131,18 @@
                 else "apply") ^ " " ^ (s |> need_parens ? enclose "(" ")")) ^
           "\n(" ^ space_implode "; " (map time_string xs) ^ ").\n"
       in
-        (true, st |> (if auto then
-                        Proof.goal_message
-                            (fn () => Pretty.chunks [Pretty.str "",
-                                      Pretty.markup Markup.hilite
-                                                    [Pretty.str message]])
-                      else
-                        tap (fn _ => Output.urgent_message message)))
+        (true, (s, st |> (if auto then
+                            Proof.goal_message
+                                (fn () => Pretty.chunks [Pretty.str "",
+                                          Pretty.markup Markup.hilite
+                                                        [Pretty.str message]])
+                          else
+                            tap (fn _ => Output.urgent_message message))))
       end
   end
 
 fun try_methods timeout_opt = fst oo do_try_methods false timeout_opt
 
-val try_methodsN = "try_methods"
-
 fun try_methods_trans quad =
   Toplevel.keep (K () o do_try_methods false (SOME default_timeout) quad
                  o Toplevel.proof_of)
@@ -175,8 +180,8 @@
       "try a combination of proof methods" Keyword.diag
       parse_try_methods_command
 
-val auto_try_methods = do_try_methods true NONE ([], [], [], [])
+fun try_try_methods auto = do_try_methods auto NONE ([], [], [], [])
 
-val setup = Try.register_tool (auto, auto_try_methods)
+val setup = Try.register_tool (try_methodsN, (auto, try_try_methods))
 
 end;
--- a/src/Tools/quickcheck.ML	Fri May 27 10:30:08 2011 +0200
+++ b/src/Tools/quickcheck.ML	Fri May 27 10:30:08 2011 +0200
@@ -6,6 +6,10 @@
 
 signature QUICKCHECK =
 sig
+  val quickcheckN: string
+  val genuineN: string
+  val noneN: string
+  val unknownN: string
   val setup: theory -> theory
   (* configuration *)
   val auto: bool Unsynchronized.ref
@@ -61,6 +65,13 @@
 structure Quickcheck : QUICKCHECK =
 struct
 
+val quickcheckN = "quickcheck"
+val quickcheck_paramsN = "quickcheck_params"
+
+val genuineN = "genuine"
+val noneN = "none"
+val unknownN = "unknown"
+
 (* preferences *)
 
 val auto = Unsynchronized.ref false;
@@ -472,10 +483,11 @@
       Pretty.chunks ((Pretty.str (tool_name auto ^ " found a counterexample:\n") ::
         map (fn (s, t) =>
           Pretty.block [Pretty.str (s ^ " ="), Pretty.brk 1, Syntax.pretty_term ctxt t]) (rev cex))
-        @ (Pretty.str ("Evaluated terms:\n") ::
-        map (fn (t, u) =>
-          Pretty.block [Syntax.pretty_term ctxt t, Pretty.str " =", Pretty.brk 1, Syntax.pretty_term ctxt u])
-          (rev eval_terms)));
+        @ (if null eval_terms then []
+           else (Pretty.str ("Evaluated terms:\n") ::
+             map (fn (t, u) =>
+               Pretty.block [Syntax.pretty_term ctxt t, Pretty.str " =", Pretty.brk 1, Syntax.pretty_term ctxt u])
+               (rev eval_terms))));
 
 fun pretty_report (Report {iterations = iterations, raised_match_errors = raised_match_errors,
     satisfied_assms = satisfied_assms, positive_concl_tests = positive_concl_tests}) =
@@ -511,27 +523,6 @@
       (* map (pretty_reports ctxt) (reports_of result) :: *)
       (if Config.get ctxt timing then cons (pretty_timings (timings_of result)) else I) [])
 
-(* automatic testing *)
-
-fun auto_quickcheck state =
-  let
-    val ctxt = Proof.context_of state;
-    val res =
-      state
-      |> Proof.map_context (Config.put report false #> Config.put quiet true)
-      |> try (test_goal (false, false) ([], []) 1);
-  in
-    case res of
-      NONE => (false, state)
-    | SOME (result :: _) => if found_counterexample result then
-        (true, Proof.goal_message (K (Pretty.chunks [Pretty.str "",
-          Pretty.mark Markup.hilite (pretty_counterex ctxt true (response_of result))])) state)
-      else
-        (false, state)
-  end
-
-val setup = Try.register_tool (auto, auto_quickcheck)
-
 (* Isar commands *)
 
 fun read_nat s = case (Library.read_int o Symbol.explode) s
@@ -610,7 +601,8 @@
 
 fun quickcheck_cmd args i state =
   gen_quickcheck args i (Toplevel.proof_of state)
-  |> Pretty.writeln o pretty_counterex_and_reports (Toplevel.context_of state) false;
+  |> Output.urgent_message o Pretty.string_of
+     o pretty_counterex_and_reports (Toplevel.context_of state) false;
 
 val parse_arg =
   Parse.name --
@@ -622,15 +614,47 @@
   Parse.$$$ "[" |-- Parse.list1 parse_arg --| Parse.$$$ "]" || Scan.succeed [];
 
 val _ =
-  Outer_Syntax.command "quickcheck_params" "set parameters for random testing" Keyword.thy_decl
+  Outer_Syntax.command quickcheck_paramsN "set parameters for random testing" Keyword.thy_decl
     (parse_args >> (fn args => Toplevel.theory (quickcheck_params_cmd args)));
 
 val _ =
-  Outer_Syntax.improper_command "quickcheck" "try to find counterexample for subgoal" Keyword.diag
+  Outer_Syntax.improper_command quickcheckN "try to find counterexample for subgoal" Keyword.diag
     (parse_args -- Scan.optional Parse.nat 1
       >> (fn (args, i) => Toplevel.no_timing o Toplevel.keep (quickcheck_cmd args i)));
 
+(* automatic testing *)
+
+fun try_quickcheck auto state =
+  let
+    val ctxt = Proof.context_of state;
+    val i = 1;
+    val res =
+      state
+      |> Proof.map_context (Config.put report false #> Config.put quiet true)
+      |> try (test_goal (false, false) ([], []) i);
+  in
+    case res of
+      NONE => (unknownN, state)
+    | SOME results =>
+        let
+          val msg = pretty_counterex_and_reports ctxt auto results
+                    |> not auto ? tap (Output.urgent_message o Pretty.string_of)
+        in
+          if exists found_counterexample results then
+            (genuineN,
+             state |> (if auto then
+                         Proof.goal_message (K (Pretty.chunks [Pretty.str "",
+                             Pretty.mark Markup.hilite msg]))
+                       else
+                         I))
+          else
+            (noneN, state)
+        end
+  end
+  |> `(fn (outcome_code, _) => outcome_code = genuineN)
+
+val setup = Try.register_tool (quickcheckN, (auto, try_quickcheck))
+
 end;
 
-
 val auto_quickcheck = Quickcheck.auto;
--- a/src/Tools/solve_direct.ML	Fri May 27 10:30:08 2011 +0200
+++ b/src/Tools/solve_direct.ML	Fri May 27 10:30:08 2011 +0200
@@ -10,9 +10,13 @@
 
 signature SOLVE_DIRECT =
 sig
+  val solve_directN: string
+  val someN: string
+  val noneN: string
+  val unknownN: string
   val auto: bool Unsynchronized.ref
   val max_solutions: int Unsynchronized.ref
-  val solve_direct: bool -> Proof.state -> bool * Proof.state
+  val solve_direct: bool -> Proof.state -> bool * (string * Proof.state)
   val setup: theory -> theory
 end;
 
@@ -21,6 +25,9 @@
 
 val solve_directN = "solve_direct";
 
+val someN = "some";
+val noneN = "none";
+val unknownN = "none";
 
 (* preferences *)
 
@@ -74,7 +81,7 @@
   in
     (case try seek_against_goal () of
       SOME (SOME results) =>
-        (true,
+        (someN,
           state |>
            (if auto then
              Proof.goal_message
@@ -85,8 +92,10 @@
             else
               tap (fn _ =>
                 Output.urgent_message (Pretty.string_of (Pretty.chunks (message results))))))
-    | _ => (false, state))
-  end;
+    | SOME NONE => (noneN, state)
+    | NONE => (unknownN, state))
+  end
+  |> `(fn (outcome_code, _) => outcome_code = someN);
 
 val _ =
   Outer_Syntax.improper_command solve_directN
@@ -97,8 +106,6 @@
 
 (* hook *)
 
-val auto_solve_direct = solve_direct true;
-
-val setup = Try.register_tool (auto, auto_solve_direct);
+val setup = Try.register_tool (solve_directN, (auto, solve_direct));
 
 end;
--- a/src/Tools/try.ML	Fri May 27 10:30:08 2011 +0200
+++ b/src/Tools/try.ML	Fri May 27 10:30:08 2011 +0200
@@ -6,16 +6,28 @@
 
 signature TRY =
 sig
+  type tool =
+    string * (bool Unsynchronized.ref
+              * (bool -> Proof.state -> bool * (string * Proof.state)))
+
+  val tryN : string
   val auto_time_limit: real Unsynchronized.ref
 
-  val register_tool :
-    bool Unsynchronized.ref * (Proof.state -> bool * Proof.state) -> theory
-    -> theory
+  val register_tool : tool -> theory -> theory
+  val get_tools : theory -> tool list
+  val try_tools : Proof.state -> (string * string) option
 end;
 
 structure Try : TRY =
 struct
 
+type tool =
+  string * (bool Unsynchronized.ref
+            * (bool -> Proof.state -> bool * (string * Proof.state)))
+
+val tryN = "try"
+
+
 (* preferences *)
 
 val auto_time_limit = Unsynchronized.ref 4.0
@@ -31,24 +43,42 @@
 
 structure Data = Theory_Data
 (
-  type T = (bool Unsynchronized.ref * (Proof.state -> bool * Proof.state)) list
+  type T = tool list
   val empty = []
   val extend = I
   fun merge data : T = AList.merge (op =) (K true) data
 )
 
+val get_tools = Data.get
+
 val register_tool = Data.map o AList.update (op =)
 
+(* try command *)
+
+fun try_tools state =
+  get_tools (Proof.theory_of state)
+  |> Par_List.get_some
+         (fn (name, (_, tool)) =>
+             case try (tool false) state of
+               SOME (true, (outcome_code, _)) => SOME (name, outcome_code)
+             | _ => NONE)
+
+val _ =
+  Outer_Syntax.improper_command tryN
+      "try a combination of automatic proving and disproving tools" Keyword.diag
+      (Scan.succeed (Toplevel.keep (ignore o try_tools o Toplevel.proof_of)))
+
 
-(* automatic testing *)
+(* automatic try *)
 
-fun run_tools tools state =
-  tools |> map_filter (fn (auto, tool) => if !auto then SOME tool else NONE)
-        |> Par_List.get_some (fn tool =>
-                                 case try tool state of
-                                   SOME (true, state) => SOME state
-                                 | _ => NONE)
-        |> the_default state
+fun auto_try state =
+  get_tools (Proof.theory_of state)
+  |> map_filter (fn (_, (auto, tool)) => if !auto then SOME tool else NONE)
+  |> Par_List.get_some (fn tool =>
+                           case try (tool true) state of
+                             SOME (true, (_, state)) => SOME state
+                           | _ => NONE)
+  |> the_default state
 
 (* Too large values are understood as milliseconds, ensuring compatibility with
    old setting files. No users can possibly in their right mind want the user
@@ -62,8 +92,7 @@
 
 val _ = Context.>> (Specification.add_theorem_hook (fn interact => fn state =>
   if interact andalso not (!Toplevel.quiet) andalso !auto_time_limit > 0.0 then
-    TimeLimit.timeLimit (smart_seconds (!auto_time_limit))
-        (run_tools (Data.get (Proof.theory_of state))) state
+    TimeLimit.timeLimit (smart_seconds (!auto_time_limit)) auto_try state
     handle TimeLimit.TimeOut => state
   else
     state))