src/Pure/Tools/debugger.ML
changeset 60897 7aad4be8a48e
parent 60891 89b7c84b0480
child 60904 e0fab97c989f
--- a/src/Pure/Tools/debugger.ML	Tue Aug 11 18:42:29 2015 +0200
+++ b/src/Pure/Tools/debugger.ML	Tue Aug 11 20:05:27 2015 +0200
@@ -134,25 +134,22 @@
       writeln = writeln_message, warning = warning_message}
     Position.none;
 
-in
-
-fun eval thread_name index SML txt1 txt2 =
+fun eval_context thread_name index SML toks =
   let
-    val (toks1, toks2) = apply2 (ML_Lex.read_source SML o Input.string) (txt1, txt2);
-
-    val evaluate_verbose = evaluate {SML = SML, verbose = true};
-    val context1 = ML_Context.the_generic_context ()
+    val context1 =
+      ML_Context.the_generic_context ()
       |> Context_Position.set_visible_generic false
       |> Config.put_generic ML_Options.debugger false
       |> ML_Env.add_name_space {SML = SML}
           (ML_Debugger.debug_name_space (the_debug_state thread_name index));
     val context2 =
-      if SML orelse forall (fn Antiquote.Text tok => ML_Lex.is_improper tok | _ => false) toks1
+      if SML orelse forall (fn Antiquote.Text tok => ML_Lex.is_improper tok | _ => false) toks
       then context1
       else
         let
           val context' = context1
-            |> ML_Context.exec (fn () => evaluate_verbose (ML_Lex.read "val ML_context = " @ toks1));
+            |> ML_Context.exec (fn () =>
+                evaluate {SML = SML, verbose = true} (ML_Lex.read "val ML_context = " @ toks));
           fun try_exec toks =
             try (ML_Context.exec (fn () => evaluate {SML = false, verbose = false} toks)) context';
         in
@@ -160,7 +157,28 @@
             SOME context2 => context2
           | NONE => error "Malformed context: expected type theory, Proof.context, Context.generic")
         end;
-  in Context.setmp_thread_data (SOME context2) evaluate_verbose toks2 end;
+  in context2 end;
+
+in
+
+fun eval thread_name index SML txt1 txt2 =
+  let
+    val (toks1, toks2) = apply2 (ML_Lex.read_source SML o Input.string) (txt1, txt2);
+    val context = eval_context thread_name index SML toks1;
+  in Context.setmp_thread_data (SOME context) evaluate {SML = SML, verbose = true} toks2 end;
+
+fun print_vals thread_name index SML txt =
+  let
+    val context = eval_context thread_name index SML (ML_Lex.read_source SML (Input.string txt));
+    val space = ML_Debugger.debug_name_space (the_debug_state thread_name index);
+
+    fun print x =
+      Pretty.from_ML (ML_Name_Space.display_val (x, ML_Options.get_print_depth (), space));
+    fun print_all () =
+      #allVal (ML_Debugger.debug_name_space (the_debug_state thread_name index)) ()
+      |> sort_wrt #1 |> map (Pretty.item o single o print o #2)
+      |> Pretty.chunks |> Pretty.string_of |> writeln_message;
+  in Context.setmp_thread_data (SOME context) print_all () end;
 
 end;
 
@@ -189,6 +207,9 @@
   | ["eval", index, SML, txt1, txt2] =>
      (error_wrapper (fn () =>
         eval thread_name (Markup.parse_int index) (Markup.parse_bool SML) txt1 txt2); true)
+  | ["print_vals", index, SML, txt] =>
+     (error_wrapper (fn () =>
+        print_vals thread_name (Markup.parse_int index) (Markup.parse_bool SML) txt); true)
   | bad =>
      (Output.system_message
         ("Debugger: bad input " ^ ML_Syntax.print_list ML_Syntax.print_string bad); true));