eliminated obsolete Proof.goal_message -- print outcome more directly;
authorwenzelm
Mon, 03 Nov 2014 14:31:15 +0100
changeset 58892 20aa19ecf2cc
parent 58891 81a1295c69ad
child 58893 9e0ecb66d6a7
eliminated obsolete Proof.goal_message -- print outcome more directly;
src/HOL/Tools/Nitpick/nitpick.ML
src/HOL/Tools/Nitpick/nitpick_commands.ML
src/HOL/Tools/Sledgehammer/sledgehammer.ML
src/HOL/Tools/try0.ML
src/Pure/Isar/proof.ML
src/Tools/quickcheck.ML
src/Tools/solve_direct.ML
src/Tools/try.ML
--- a/src/HOL/Tools/Nitpick/nitpick.ML	Mon Nov 03 09:25:23 2014 +0100
+++ b/src/HOL/Tools/Nitpick/nitpick.ML	Mon Nov 03 14:31:15 2014 +0100
@@ -72,9 +72,9 @@
   val unregister_term_postprocessor : typ -> theory -> theory
   val pick_nits_in_term :
     Proof.state -> params -> mode -> int -> int -> int -> (term * term) list
-    -> term list -> term list -> term -> string * Proof.state
+    -> term list -> term list -> term -> string * string list
   val pick_nits_in_subgoal :
-    Proof.state -> params -> mode -> int -> int -> string * Proof.state
+    Proof.state -> params -> mode -> int -> int -> string * string list
 end;
 
 structure Nitpick : NITPICK =
@@ -234,13 +234,13 @@
          kodkod_sym_break, tac_timeout, max_threads, show_types, show_skolems,
          show_consts, evals, formats, atomss, max_potential, max_genuine,
          check_potential, check_genuine, batch_size, ...} = params
-    val state_ref = Unsynchronized.ref state
-    fun pprint print =
+    val outcome = Synchronized.var "Nitpick.outcome" (Queue.empty: string Queue.T)
+    fun pprint print prt =
       if mode = Auto_Try then
-        Unsynchronized.change state_ref o Proof.goal_message o K
-        o Pretty.mark Markup.information
+        Synchronized.change outcome
+          (Queue.enqueue (Pretty.string_of (Pretty.mark Markup.information prt)))
       else
-        print o Pretty.string_of
+        print (Pretty.string_of prt)
     val pprint_a = pprint writeln
     fun pprint_nt f = () |> is_mode_nt mode ? pprint writeln o f
     fun pprint_v f = () |> verbose ? pprint writeln o f
@@ -1007,7 +1007,7 @@
                 "Total time: " ^ string_of_time (Timer.checkRealTimer timer) ^
                 ".")
     val _ = spying spy (fn () => (state, i, "outcome: " ^ outcome_code))
-  in (outcome_code, !state_ref) end
+  in (outcome_code, Queue.content (Synchronized.value outcome)) end
 
 (* Give the inner timeout a chance. *)
 val timeout_bonus = seconds 1.0
@@ -1022,10 +1022,10 @@
       (* The "expect" argument is deliberately ignored if Kodkodi is missing so
          that the "Nitpick_Examples" can be processed on any machine. *)
       (print_nt (Pretty.string_of (plazy (K kodkodi_not_installed_message)));
-       ("no_kodkodi", state))
+       ("no_kodkodi", []))
     else
       let
-        val unknown_outcome = (unknownN, state)
+        val unknown_outcome = (unknownN, [])
         val deadline = Time.+ (Time.now (), timeout)
         val outcome as (outcome_code, _) =
           TimeLimit.timeLimit (Time.+ (timeout, timeout_bonus))
@@ -1068,7 +1068,7 @@
     val t = state |> Proof.raw_goal |> #goal |> prop_of
   in
     case Logic.count_prems t of
-      0 => (writeln "No subgoal!"; (noneN, state))
+      0 => (writeln "No subgoal!"; (noneN, []))
     | n =>
       let
         val t = Logic.goal_params t i |> fst
--- a/src/HOL/Tools/Nitpick/nitpick_commands.ML	Mon Nov 03 09:25:23 2014 +0100
+++ b/src/HOL/Tools/Nitpick/nitpick_commands.ML	Mon Nov 03 14:31:15 2014 +0100
@@ -350,12 +350,12 @@
     val params as {blocking, debug, ...} =
       extract_params ctxt mode (default_raw_params thy) override_params
     fun go () =
-      (unknownN, state)
+      (unknownN, [])
       |> (if mode = Auto_Try 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 mode i step)
-  in if blocking then go () else Future.fork (tap go) |> K (unknownN, state) end
+         (fn _ => pick_nits_in_subgoal state params mode i step)
+  in if blocking then go () else Future.fork (tap go) |> K (unknownN, []) end
   |> `(fn (outcome_code, _) => outcome_code = genuineN)
 
 fun string_for_raw_param (name, value) =
--- a/src/HOL/Tools/Sledgehammer/sledgehammer.ML	Mon Nov 03 09:25:23 2014 +0100
+++ b/src/HOL/Tools/Sledgehammer/sledgehammer.ML	Mon Nov 03 14:31:15 2014 +0100
@@ -24,7 +24,7 @@
     proof_method * proof_method list list -> (string * 'a) list * (proof_method * play_outcome)
   val string_of_factss : (string * fact list) list -> string
   val run_sledgehammer : params -> mode -> (string -> unit) option -> int -> fact_override ->
-    Proof.state -> bool * (string * Proof.state)
+    Proof.state -> bool * (string * string list)
 end;
 
 structure Sledgehammer : SLEDGEHAMMER =
@@ -214,10 +214,8 @@
     if mode = Auto_Try then
       let val (outcome_code, message) = TimeLimit.timeLimit timeout go () in
         (outcome_code,
-         state
-         |> outcome_code = someN
-            ? Proof.goal_message (fn () =>
-                  Pretty.mark Markup.information (Pretty.str (message ()))))
+          if outcome_code = someN then [Markup.markup Markup.information (message ())]
+          else [])
       end
     else if blocking then
       let
@@ -231,12 +229,12 @@
             outcome
             |> Async_Manager.break_into_chunks
             |> List.app writeln
-      in (outcome_code, state) end
+      in (outcome_code, []) end
     else
       (Async_Manager.thread SledgehammerN birth_time death_time
          (prover_description verbose name num_facts)
          ((fn (outcome_code, message) => (verbose orelse outcome_code = someN, message ())) o go);
-       (unknownN, state))
+       (unknownN, []))
   end
 
 val auto_try_max_facts_divisor = 2 (* FUDGE *)
@@ -259,7 +257,7 @@
   else
     (case subgoal_count state of
       0 =>
-      ((if blocking then error else writeln) "No subgoal!"; (false, (noneN, state)))
+      ((if blocking then error else writeln) "No subgoal!"; (false, (noneN, [])))
     | n =>
       let
         val _ = Proof.assert_backward state
@@ -303,7 +301,7 @@
               (state, i, "All", "Selected facts: " ^ spying_str_of_factss factss)))
           end
 
-        fun launch_provers state =
+        fun launch_provers () =
           let
             val factss = get_factss provers
             val problem =
@@ -313,7 +311,7 @@
             val launch = launch_prover params mode output_result only learn
           in
             if mode = Auto_Try then
-              (unknownN, state)
+              (unknownN, [])
               |> fold (fn prover => fn accum as (outcome_code, _) =>
                   if outcome_code = someN then accum else launch problem prover)
                 provers
@@ -321,12 +319,12 @@
               (learn chained;
                provers
                |> (if blocking then Par_List.map else map) (launch problem #> fst)
-               |> max_outcome_code |> rpair state)
+               |> max_outcome_code |> rpair [])
           end
       in
-        (if blocking then launch_provers state
-         else (Future.fork (tap (fn () => launch_provers state)); (unknownN, state)))
-        handle TimeLimit.TimeOut => (print "Sledgehammer ran out of time."; (unknownN, state))
+        (if blocking then launch_provers ()
+         else (Future.fork launch_provers; (unknownN, [])))
+        handle TimeLimit.TimeOut => (print "Sledgehammer ran out of time."; (unknownN, []))
       end
       |> `(fn (outcome_code, _) => outcome_code = someN))
 
--- a/src/HOL/Tools/try0.ML	Mon Nov 03 09:25:23 2014 +0100
+++ b/src/HOL/Tools/try0.ML	Mon Nov 03 14:31:15 2014 +0100
@@ -129,7 +129,7 @@
       ();
     (case par_map (fn f => f mode timeout_opt quad st) apply_methods of
       [] =>
-      (if mode = Normal then writeln "No proof found." else (); (false, (noneN, st)))
+      (if mode = Normal then writeln "No proof found." else (); (false, (noneN, [])))
     | xs as (name, command, _) :: _ =>
       let
         val xs = xs |> map (fn (name, _, n) => (n, name))
@@ -147,12 +147,10 @@
             [(_, ms)] => " (" ^ time_string ms ^ ")."
           | xs => "\n(" ^ space_implode "; " (map tool_time_string xs) ^ ").")
       in
-        (true, (name,
-           st
-           |> (if mode = Auto_Try then
-                 Proof.goal_message (fn () => Pretty.markup Markup.information [Pretty.str message])
-               else
-                 tap (fn _ => writeln message))))
+        (true,
+          (name,
+            if mode = Auto_Try then [Markup.markup Markup.information message]
+            else (writeln message; [])))
       end)
   end;
 
--- a/src/Pure/Isar/proof.ML	Mon Nov 03 09:25:23 2014 +0100
+++ b/src/Pure/Isar/proof.ML	Mon Nov 03 14:31:15 2014 +0100
@@ -32,8 +32,6 @@
   val assert_no_chain: state -> state
   val enter_forward: state -> state
   val has_bottom_goal: state -> bool
-  val goal_message: (unit -> Pretty.T) -> state -> state
-  val pretty_goal_messages: state -> Pretty.T list
   val pretty_state: int -> state -> Pretty.T list
   val refine: Method.text -> state -> state Seq.seq
   val refine_end: Method.text -> state -> state Seq.seq
@@ -151,7 +149,6 @@
   Goal of
    {statement: (string * Position.T) * term list list * term,
       (*goal kind and statement (starting with vars), initial proposition*)
-    messages: (unit -> Pretty.T) list,    (*persistent messages (hints etc.)*)
     using: thm list,                      (*goal facts*)
     goal: thm,                            (*subgoals ==> statement*)
     before_qed: Method.text option,
@@ -159,8 +156,8 @@
       (thm list list -> state -> state) *
       (thm list list -> context -> context)};
 
-fun make_goal (statement, messages, using, goal, before_qed, after_qed) =
-  Goal {statement = statement, messages = messages, using = using, goal = goal,
+fun make_goal (statement, using, goal, before_qed, after_qed) =
+  Goal {statement = statement, using = using, goal = goal,
     before_qed = before_qed, after_qed = after_qed};
 
 fun make_node (context, facts, mode, goal) =
@@ -318,8 +315,8 @@
   (case Stack.dest stack of
     (Node {context, facts, mode, goal = SOME goal}, node :: nodes) =>
       let
-        val Goal {statement, messages, using, goal, before_qed, after_qed} = goal;
-        val goal' = make_goal (g (statement, messages, using, goal, before_qed, after_qed));
+        val Goal {statement, using, goal, before_qed, after_qed} = goal;
+        val goal' = make_goal (g (statement, using, goal, before_qed, after_qed));
         val node' = map_node_context h node;
         val stack' = Stack.make (make_node (f context, facts, mode, SOME goal')) (node' :: nodes);
       in State stack' end
@@ -331,14 +328,11 @@
       in State (Stack.make nd' (node' :: nodes')) end
   | _ => State stack);
 
-fun provide_goal goal = map_goal I (fn (statement, _, using, _, before_qed, after_qed) =>
-  (statement, [], using, goal, before_qed, after_qed)) I;
+fun provide_goal goal = map_goal I (fn (statement, using, _, before_qed, after_qed) =>
+  (statement, using, goal, before_qed, after_qed)) I;
 
-fun goal_message msg = map_goal I (fn (statement, messages, using, goal, before_qed, after_qed) =>
-  (statement, msg :: messages, using, goal, before_qed, after_qed)) I;
-
-fun using_facts using = map_goal I (fn (statement, _, _, goal, before_qed, after_qed) =>
-  (statement, [], using, goal, before_qed, after_qed)) I;
+fun using_facts using = map_goal I (fn (statement, _, goal, before_qed, after_qed) =>
+  (statement, using, goal, before_qed, after_qed)) I;
 
 local
   fun find i state =
@@ -355,11 +349,6 @@
 
 (** pretty_state **)
 
-fun pretty_goal_messages state =
-  (case try find_goal state of
-    SOME (_, (_, {messages, ...})) => map (fn msg => msg ()) (rev messages)
-  | NONE => []);
-
 fun pretty_facts _ _ NONE = []
   | pretty_facts ctxt s (SOME ths) = [Proof_Display.pretty_goal_facts ctxt s ths, Pretty.str ""];
 
@@ -369,11 +358,10 @@
     val verbose = Config.get ctxt Proof_Context.verbose;
 
     fun prt_goal (SOME (_, (_,
-      {statement = ((_, pos), _, _), messages, using, goal, before_qed = _, after_qed = _}))) =
+      {statement = ((_, pos), _, _), using, goal, before_qed = _, after_qed = _}))) =
           pretty_facts ctxt "using"
             (if mode <> Backward orelse null using then NONE else SOME using) @
-          [Proof_Display.pretty_goal_header goal] @ Goal_Display.pretty_goals ctxt goal @
-          (map (fn msg => Position.setmp_thread_data pos msg ()) (rev messages))
+          [Proof_Display.pretty_goal_header goal] @ Goal_Display.pretty_goals ctxt goal
       | prt_goal NONE = [];
 
     val prt_ctxt =
@@ -412,15 +400,14 @@
     (Thm.theory_of_thm st, Thm.prop_of st) (map (rpair [] o rpair []) (goals st));
 
 fun apply_method text ctxt state =
-  #2 (#2 (find_goal state))
-  |> (fn {statement, messages = _, using, goal, before_qed, after_qed} =>
+  #2 (#2 (find_goal state)) |> (fn {statement, using, goal, before_qed, after_qed} =>
     Method.evaluate text ctxt using goal
     |> Seq.map (fn (meth_cases, goal') =>
       state
       |> map_goal
           (Proof_Context.update_cases false (no_goal_cases goal @ goal_cases goal') #>
            Proof_Context.update_cases true meth_cases)
-          (K (statement, [], using, goal', before_qed, after_qed)) I));
+          (K (statement, using, goal', before_qed, after_qed)) I));
 
 in
 
@@ -716,11 +703,11 @@
     (fn ctxt => ctxt |> Proof_Context.note_thmss ""
       (Attrib.map_facts_refs (map (prep_att ctxt)) (prep_fact ctxt) (no_binding args)))
   |> (fn (named_facts, state') =>
-    state' |> map_goal I (fn (statement, _, using, goal, before_qed, after_qed) =>
+    state' |> map_goal I (fn (statement, using, goal, before_qed, after_qed) =>
       let
         val ctxt = context_of state';
         val ths = maps snd named_facts;
-      in (statement, [], f ctxt ths using, g ctxt ths goal, before_qed, after_qed) end) I);
+      in (statement, f ctxt ths using, g ctxt ths goal, before_qed, after_qed) end) I);
 
 fun append_using _ ths using = using @ filter_out Thm.is_dummy ths;
 fun unfold_using ctxt ths = map (Local_Defs.unfold ctxt ths);
@@ -918,7 +905,7 @@
   in
     goal_state
     |> map_context (init_context #> Variable.set_body true)
-    |> set_goal (make_goal (statement, [], [], Goal.init goal, before_qed, after_qed'))
+    |> set_goal (make_goal (statement, [], Goal.init goal, before_qed, after_qed'))
     |> map_context (Proof_Context.auto_bind_goal props)
     |> chaining ? (`the_facts #-> using_facts)
     |> reset_facts
@@ -1130,7 +1117,7 @@
   let
     val _ = assert_backward state;
     val (goal_ctxt, (_, goal)) = find_goal state;
-    val {statement as (kind, _, prop), messages, using, goal, before_qed, after_qed} = goal;
+    val {statement as (kind, _, prop), using, goal, before_qed, after_qed} = goal;
     val goal_tfrees =
       fold Term.add_tfrees
         (prop :: map Thm.term_of (Assumption.all_assms_of goal_ctxt)) [];
@@ -1145,7 +1132,7 @@
     val result_ctxt =
       state
       |> map_context reset_result
-      |> map_goal I (K (statement', messages, using, goal', before_qed, after_qed'))
+      |> map_goal I (K (statement', using, goal', before_qed, after_qed'))
         (fold (Variable.declare_typ o TFree) goal_tfrees)
       |> fork_proof;
 
@@ -1153,7 +1140,7 @@
     val finished_goal = Goal.future_result goal_ctxt future_thm prop';
     val state' =
       state
-      |> map_goal I (K (statement, messages, using, finished_goal, NONE, after_qed)) I;
+      |> map_goal I (K (statement, using, finished_goal, NONE, after_qed)) I;
   in (Future.map fst result_ctxt, state') end;
 
 end;
--- a/src/Tools/quickcheck.ML	Mon Nov 03 09:25:23 2014 +0100
+++ b/src/Tools/quickcheck.ML	Mon Nov 03 14:31:15 2014 +0100
@@ -552,20 +552,16 @@
       |> try (test_goal (false, false) ([], []) i);
   in
     (case res of
-      NONE => (unknownN, state)
+      NONE => (unknownN, [])
     | SOME results =>
         let
           val msg = pretty_counterex ctxt auto (Option.map (the o get_first response_of) results)
         in
           if is_some results then
             (genuineN,
-             state
-             |> (if auto then
-                   Proof.goal_message (K (Pretty.mark Markup.information msg))
-                 else
-                   tap (fn _ => writeln (Pretty.string_of msg))))
-          else
-            (noneN, state)
+              if auto then [Pretty.string_of (Pretty.mark Markup.information msg)]
+              else (writeln (Pretty.string_of msg); []))
+          else (noneN, [])
         end)
   end
   |> `(fn (outcome_code, _) => outcome_code = genuineN);
--- a/src/Tools/solve_direct.ML	Mon Nov 03 09:25:23 2014 +0100
+++ b/src/Tools/solve_direct.ML	Mon Nov 03 14:31:15 2014 +0100
@@ -15,7 +15,7 @@
   val noneN: string
   val unknownN: string
   val max_solutions: int Unsynchronized.ref
-  val solve_direct: Proof.state -> bool * (string * Proof.state)
+  val solve_direct: Proof.state -> bool * (string * string list)
 end;
 
 structure Solve_Direct: SOLVE_DIRECT =
@@ -76,22 +76,17 @@
     (case try seek_against_goal () of
       SOME (SOME results) =>
         (someN,
-          state |>
-            (if mode = Auto_Try then
-               Proof.goal_message
-                 (fn () =>
-                   Pretty.markup Markup.information (message results))
-             else
-               tap (fn _ =>
-                 writeln (Pretty.string_of (Pretty.chunks (message results))))))
+          if mode = Auto_Try then
+            [Pretty.string_of (Pretty.markup Markup.information (message results))]
+          else (writeln (Pretty.string_of (Pretty.chunks (message results))); []))
     | SOME NONE =>
         (if mode = Normal then writeln "No proof found."
          else ();
-         (noneN, state))
+         (noneN, []))
     | NONE =>
         (if mode = Normal then writeln "An error occurred."
          else ();
-         (unknownN, state)))
+         (unknownN, [])))
   end
   |> `(fn (outcome_code, _) => outcome_code = someN);
 
--- a/src/Tools/try.ML	Mon Nov 03 09:25:23 2014 +0100
+++ b/src/Tools/try.ML	Mon Nov 03 14:31:15 2014 +0100
@@ -7,7 +7,7 @@
 signature TRY =
 sig
   type tool =
-    string * (int * string * (bool -> Proof.state -> bool * (string * Proof.state)))
+    string * (int * string * (bool -> Proof.state -> bool * (string * string list)))
 
   val tryN : string
 
@@ -22,7 +22,7 @@
 struct
 
 type tool =
-  string * (int * string * (bool -> Proof.state -> bool * (string * Proof.state)))
+  string * (int * string * (bool -> Proof.state -> bool * (string * string list)))
 
 val tryN = "try"
 
@@ -87,9 +87,9 @@
   |> map_filter (fn (_, (_, auto, tool)) => if Options.default_bool auto then SOME tool else NONE)
   |> Par_List.get_some (fn tool =>
                            case try (tool true) state of
-                             SOME (true, (_, state)) => SOME state
+                             SOME (true, (_, outcome)) => SOME outcome
                            | _ => NONE)
-  |> the_default state
+  |> the_default []
 
 
 (* asynchronous print function (PIDE) *)
@@ -111,8 +111,7 @@
             in
               if auto_time_limit > 0.0 then
                 (case TimeLimit.timeLimit (seconds auto_time_limit) (fn () => tool true state) () of
-                  (true, (_, state')) =>
-                    List.app Pretty.writeln (Proof.pretty_goal_messages state')
+                  (true, (_, outcome)) => List.app writeln outcome
                 | _ => ())
               else ()
             end handle exn => if Exn.is_interrupt exn then reraise exn else ()}