src/Tools/solve_direct.ML
changeset 40375 0843888de43e
parent 40360 9ed3711366c8
child 40376 db6e84082695
     1.1 --- a/src/Tools/solve_direct.ML	Mon Oct 25 16:18:00 2010 +0200
     1.2 +++ b/src/Tools/solve_direct.ML	Mon Oct 25 16:41:23 2010 +0200
     1.3 @@ -18,7 +18,8 @@
     1.4  structure Solve_Direct : SOLVE_DIRECT =
     1.5  struct
     1.6  
     1.7 -val solve_directN = "solve_direct"
     1.8 +val solve_directN = "solve_direct";
     1.9 +
    1.10  
    1.11  (* preferences *)
    1.12  
    1.13 @@ -32,12 +33,16 @@
    1.14        ("Auto " ^ solve_directN)
    1.15        ("Run " ^ quote solve_directN ^ " automatically.")) ());
    1.16  
    1.17 +
    1.18 +(* solve_direct command *)
    1.19 +
    1.20  fun solve_direct auto state =
    1.21    let
    1.22      val ctxt = Proof.context_of state;
    1.23  
    1.24      val crits = [(true, Find_Theorems.Solves)];
    1.25 -    fun find g = snd (Find_Theorems.find_theorems ctxt (SOME g) (SOME (! max_solutions)) false crits);
    1.26 +    fun find g =
    1.27 +      snd (Find_Theorems.find_theorems ctxt (SOME g) (SOME (! max_solutions)) false crits);
    1.28  
    1.29      fun prt_result (goal, results) =
    1.30        let
    1.31 @@ -64,34 +69,37 @@
    1.32                else map (fn sg => (SOME sg, find (Goal.init sg))) subgoals;
    1.33              val results = filter_out (null o snd) rs;
    1.34            in if null results then NONE else SOME results end);
    1.35 -    fun message results = separate (Pretty.brk 0) (map prt_result results)
    1.36 +    fun message results = separate (Pretty.brk 0) (map prt_result results);
    1.37    in
    1.38      (case try seek_against_goal () of
    1.39        SOME (SOME results) =>
    1.40 -      (true, state |> (if auto then
    1.41 -                         Proof.goal_message
    1.42 -                           (fn () => Pretty.chunks
    1.43 -                              [Pretty.str "",
    1.44 -                               Pretty.markup Markup.hilite (message results)])
    1.45 -                       else
    1.46 -                         tap (fn _ => priority (Pretty.string_of
    1.47 -                                (Pretty.chunks (message results))))))
    1.48 +        (true,
    1.49 +          state |>
    1.50 +           (if auto then
    1.51 +             Proof.goal_message
    1.52 +               (fn () =>
    1.53 +                 Pretty.chunks
    1.54 +                  [Pretty.str "",
    1.55 +                   Pretty.markup Markup.hilite (message results)])
    1.56 +            else
    1.57 +              tap (fn _ =>
    1.58 +                priority (Pretty.string_of (Pretty.chunks (message results))))))
    1.59      | _ => (false, state))
    1.60    end;
    1.61  
    1.62 -val invoke_solve_direct = fst o solve_direct false
    1.63 +val invoke_solve_direct = fst o solve_direct false;
    1.64  
    1.65  val _ =
    1.66    Outer_Syntax.improper_command solve_directN
    1.67 -      "try to solve conjectures directly with existing theorems" Keyword.diag
    1.68 -      (Scan.succeed (Toplevel.keep (K () o invoke_solve_direct
    1.69 -                                    o Toplevel.proof_of)))
    1.70 +    "try to solve conjectures directly with existing theorems" Keyword.diag
    1.71 +    (Scan.succeed (Toplevel.keep (K () o invoke_solve_direct o Toplevel.proof_of)));
    1.72 +
    1.73  
    1.74  (* hook *)
    1.75  
    1.76  fun auto_solve_direct state =
    1.77 -  if not (!auto) then (false, state) else solve_direct true state
    1.78 +  if not (! auto) then (false, state) else solve_direct true state;
    1.79  
    1.80 -val setup = Auto_Tools.register_tool (solve_directN, auto_solve_direct)
    1.81 +val setup = Auto_Tools.register_tool (solve_directN, auto_solve_direct);
    1.82  
    1.83  end;