print_context;
authorwenzelm
Fri, 20 Aug 1999 15:44:29 +0200
changeset 7308 e01aab03a2a1
parent 7307 c065073cdb34
child 7309 838a7bc92d81
print_context;
src/Pure/Isar/isar_cmd.ML
src/Pure/Isar/isar_syn.ML
src/Pure/Isar/toplevel.ML
--- a/src/Pure/Isar/isar_cmd.ML	Fri Aug 20 15:43:25 1999 +0200
+++ b/src/Pure/Isar/isar_cmd.ML	Fri Aug 20 15:44:29 1999 +0200
@@ -32,6 +32,7 @@
   val update_thy: string -> Toplevel.transition -> Toplevel.transition
   val update_thy_only: string -> Toplevel.transition -> Toplevel.transition
   val pretty_setmargin: int -> Toplevel.transition -> Toplevel.transition
+  val print_context: Toplevel.transition -> Toplevel.transition
   val print_theory: Toplevel.transition -> Toplevel.transition
   val print_syntax: Toplevel.transition -> Toplevel.transition
   val print_theorems: Toplevel.transition -> Toplevel.transition
@@ -127,8 +128,9 @@
 fun pretty_setmargin n = Toplevel.imperative (fn () => Pretty.setmargin n);
 
 
-(* print theory contents *)
+(* print theory *)
 
+val print_context = Toplevel.keep Toplevel.print_state_context;
 val print_theory = Toplevel.keep (PureThy.print_theory o Toplevel.theory_of);
 val print_syntax = Toplevel.keep (Display.print_syntax o Toplevel.theory_of);
 val print_theorems = Toplevel.keep (PureThy.print_theorems o Toplevel.theory_of);
--- a/src/Pure/Isar/isar_syn.ML	Fri Aug 20 15:43:25 1999 +0200
+++ b/src/Pure/Isar/isar_syn.ML	Fri Aug 20 15:44:29 1999 +0200
@@ -440,6 +440,10 @@
   OuterSyntax.improper_command "help" "print outer syntax (global)" K.diag
     (Scan.succeed (Toplevel.imperative OuterSyntax.print_outer_syntax));
 
+val print_contextP =
+  OuterSyntax.improper_command "print_context" "print theory context name" K.diag
+    (Scan.succeed IsarCmd.print_context);
+
 val print_theoryP =
   OuterSyntax.improper_command "print_theory" "print logical theory contents (verbose!)" K.diag
     (Scan.succeed IsarCmd.print_theory);
@@ -587,9 +591,10 @@
   skip_proofP, applyP, then_applyP, proofP, alsoP, finallyP, backP,
   cannot_undoP, clear_undoP, redoP, undos_proofP, kill_proofP, undoP,
   (*diagnostic commands*)
-  pretty_setmarginP, print_commandsP, print_theoryP, print_syntaxP,
-  print_attributesP, print_methodsP, print_theoremsP, print_bindsP,
-  print_lthmsP, print_thmsP, print_propP, print_termP, print_typeP,
+  pretty_setmarginP, print_commandsP, print_contextP, print_theoryP,
+  print_syntaxP, print_attributesP, print_methodsP, print_theoremsP,
+  print_bindsP, print_lthmsP, print_thmsP, print_propP, print_termP,
+  print_typeP,
   (*system commands*)
   cdP, pwdP, use_thyP, use_thy_onlyP, update_thyP, update_thy_onlyP,
   touch_thyP, touch_all_thysP, remove_thyP, prP, disable_prP,
--- a/src/Pure/Isar/toplevel.ML	Fri Aug 20 15:43:25 1999 +0200
+++ b/src/Pure/Isar/toplevel.ML	Fri Aug 20 15:44:29 1999 +0200
@@ -12,6 +12,7 @@
   val toplevel: state
   val prompt_state_default: state -> string
   val prompt_state_fn: (state -> string) ref
+  val print_state_context: state -> unit
   val print_state_default: state -> unit
   val print_state_fn: (state -> unit) ref
   val print_state: state -> unit
@@ -74,10 +75,16 @@
 fun str_of_node (Theory _) = "in theory mode"
   | str_of_node (Proof _) = "in proof mode";
 
-fun print_node (Theory thy) = Pretty.writeln (Pretty.block
-      [Pretty.str "Theory:", Pretty.brk 1, Pretty.str (PureThy.get_name thy),
-        Pretty.str " =", Pretty.brk 1, Display.pretty_theory thy])
-  | print_node (Proof prf) = Proof.print_state (ProofHistory.position prf) (ProofHistory.current prf);
+fun print_ctxt thy = Pretty.writeln (Pretty.block
+  [Pretty.str "Theory:", Pretty.brk 1, Pretty.str (PureThy.get_name thy),
+    Pretty.str " =", Pretty.brk 1, Display.pretty_theory thy]);
+
+fun print_node_ctxt (Theory thy) = print_ctxt thy
+  | print_node_ctxt (Proof prf) = print_ctxt (Proof.theory_of (ProofHistory.current prf));
+
+fun print_node (Theory thy) = print_ctxt thy
+  | print_node (Proof prf) = Proof.print_state (ProofHistory.position prf)
+      (ProofHistory.current prf);
 
 
 (* datatype state *)
@@ -100,15 +107,17 @@
 fun prompt_state state = ! prompt_state_fn state;
 
 
-(* print_state hook *)
+(* print state *)
 
-fun print_topnode (State []) = ()
-  | print_topnode (State ((node, _) :: _)) = print_node (History.current node);
+fun print_topnode _ (State []) = ()
+  | print_topnode prt (State ((node, _) :: _)) = prt (History.current node);
+
+val print_state_context = print_topnode print_node_ctxt;
 
 fun print_state_default state =
   let val ref (begin_state, end_state, _) = Goals.current_goals_markers in
     if begin_state = "" then () else writeln begin_state;
-    print_topnode state;
+    print_topnode print_node state;
     if end_state = "" then () else writeln end_state
   end;