src/Tools/auto_solve.ML
 changeset 30240 5b25fee0362c parent 29858 c8cee17d7e50 child 30242 aea5d7fa7ef5
```--- a/src/Tools/auto_solve.ML	Wed Mar 04 10:43:39 2009 +0100
+++ b/src/Tools/auto_solve.ML	Wed Mar 04 10:45:52 2009 +0100
@@ -1,89 +1,91 @@
-(*  Title:      auto_solve.ML
+(*  Title:      Pure/Tools/auto_solve.ML
Author:     Timothy Bourke and Gerwin Klein, NICTA

-    Check whether a newly stated theorem can be solved directly
-    by an existing theorem. Duplicate lemmas can be detected in
-    this way.
+Check whether a newly stated theorem can be solved directly by an
+existing theorem. Duplicate lemmas can be detected in this way.

-    The implemenation is based in part on Berghofer and
-    Haftmann's Pure/codegen.ML. It relies critically on
-    the FindTheorems solves feature.
+The implemenation is based in part on Berghofer and Haftmann's
+Pure/codegen.ML. It relies critically on the FindTheorems solves
+feature.
*)

signature AUTO_SOLVE =
sig
-  val auto : bool ref;
-  val auto_time_limit : int ref;
+  val auto : bool ref
+  val auto_time_limit : int ref

-  val seek_solution : bool -> Proof.state -> Proof.state;
+  val seek_solution : bool -> Proof.state -> Proof.state
end;

structure AutoSolve : AUTO_SOLVE =
struct
-  structure FT = FindTheorems;

-  val auto = ref false;
-  val auto_time_limit = ref 5000;
+val auto = ref false;
+val auto_time_limit = ref 2500;

-  fun seek_solution int state = let
-      val ctxt = Proof.context_of state;
+fun seek_solution int state =
+  let
+    val ctxt = Proof.context_of state;

-      fun conj_to_list [] = []
-        | conj_to_list (t::ts) =
-          (Conjunction.dest_conjunction t
-           |> (fn (t1, t2) => conj_to_list (t1::t2::ts)))
-          handle TERM _ => t::conj_to_list ts;
+    fun conj_to_list [] = []
+      | conj_to_list (t::ts) =
+        (Conjunction.dest_conjunction t
+         |> (fn (t1, t2) => conj_to_list (t1::t2::ts)))
+        handle TERM _ => t::conj_to_list ts;

-      val crits = [(true, FT.Solves)];
-      fun find g = (NONE, FT.find_theorems ctxt g true crits);
-      fun find_cterm g = (SOME g, FT.find_theorems ctxt
-                                    (SOME (Goal.init g)) true crits);
+    val crits = [(true, FindTheorems.Solves)];
+    fun find g = (NONE, FindTheorems.find_theorems ctxt g true crits);
+    fun find_cterm g = (SOME g, FindTheorems.find_theorems ctxt
+                                  (SOME (Goal.init g)) true crits);

-      fun prt_result (goal, results) = let
-          val msg = case goal of
-                      NONE => "The current goal"
-                    | SOME g => Syntax.string_of_term ctxt (term_of g);
-        in
-          Pretty.big_list (msg ^ " could be solved directly with:")
-                          (map Display.pretty_fact results)
-        end;
+    fun prt_result (goal, results) =
+      let
+        val msg = case goal of
+                    NONE => "The current goal"
+                  | SOME g => Syntax.string_of_term ctxt (term_of g);
+      in
+        Pretty.big_list (msg ^ " could be solved directly with:")
+                        (map (FindTheorems.pretty_thm ctxt) results)
+      end;

-      fun seek_against_goal () = let
-          val goal = try Proof.get_goal state
-                     |> Option.map (#2 o #2);
+    fun seek_against_goal () =
+      let
+        val goal = try Proof.get_goal state
+                   |> Option.map (#2 o #2);

-          val goals = goal
-                      |> Option.map (fn g => cprem_of g 1)
-                      |> the_list
-                      |> conj_to_list;
+        val goals = goal
+                    |> Option.map (fn g => cprem_of g 1)
+                    |> the_list
+                    |> conj_to_list;

-          val rs = if length goals = 1
-                   then [find goal]
-                   else map find_cterm goals;
-          val frs = filter_out (null o snd) rs;
+        val rs = if length goals = 1
+                 then [find goal]
+                 else map find_cterm goals;
+        val frs = filter_out (null o snd) rs;

-        in if null frs then NONE else SOME frs end;
+      in if null frs then NONE else SOME frs end;

-      fun go () = let
-          val res = TimeLimit.timeLimit
-                      (Time.fromMilliseconds (!auto_time_limit))
-                      (try seek_against_goal) ();
-        in
-          case Option.join res of
-            NONE => state
-          | SOME results => (Proof.goal_message
-                              (fn () => Pretty.chunks [Pretty.str "",
-                                Pretty.markup Markup.hilite
-                                (Library.separate (Pretty.brk 0)
-                                                  (map prt_result results))])
-                                state)
-        end handle TimeLimit.TimeOut => (warning "AutoSolve: timeout."; state);
-    in
-      if int andalso !auto andalso not (!Toplevel.quiet)
-      then go ()
-      else state
-    end;
-
+    fun go () =
+      let
+        val res = TimeLimit.timeLimit
+                    (Time.fromMilliseconds (! auto_time_limit))
+                    (try seek_against_goal) ();
+      in
+        case Option.join res of
+          NONE => state
+        | SOME results => (Proof.goal_message
+                            (fn () => Pretty.chunks [Pretty.str "",
+                              Pretty.markup Markup.hilite
+                              (Library.separate (Pretty.brk 0)
+                                                (map prt_result results))])
+                              state)
+      end handle TimeLimit.TimeOut => (warning "AutoSolve: timeout."; state);
+  in
+    if int andalso ! auto andalso not (! Toplevel.quiet)
+    then go ()
+    else state
+  end;
+
end;

val _ = Context.>> (Specification.add_theorem_hook AutoSolve.seek_solution);```