abstract exn_id based on getExnId in polyml/basis/FinalPolyML.sml (NB: the mutable machine word cannot be inspected in ML, e.g. toplevel pp dumps core);
authorwenzelm
Mon, 17 Aug 2015 15:19:25 +0200
changeset 60954 eeee8349e9eb
parent 60953 87f0f707a5f8
child 60955 65149ae760a0
abstract exn_id based on getExnId in polyml/basis/FinalPolyML.sml (NB: the mutable machine word cannot be inspected in ML, e.g. toplevel pp dumps core);
src/Pure/ML-Systems/ml_debugger.ML
src/Pure/ML-Systems/ml_debugger_polyml-5.5.3.ML
src/Pure/ML-Systems/polyml.ML
--- a/src/Pure/ML-Systems/ml_debugger.ML	Sun Aug 16 23:14:27 2015 +0200
+++ b/src/Pure/ML-Systems/ml_debugger.ML	Mon Aug 17 15:19:25 2015 +0200
@@ -6,6 +6,10 @@
 
 signature ML_DEBUGGER =
 sig
+  type exn_id
+  val exn_id: exn -> exn_id
+  val print_exn_id: exn_id -> string
+  val eq_exn_id: exn_id * exn_id -> bool
   val on_entry: (string * 'location -> unit) option -> unit
   val on_exit: (string * 'location -> unit) option -> unit
   val on_exit_exception: (string * 'location -> exn -> unit) option -> unit
@@ -22,6 +26,18 @@
 structure ML_Debugger: ML_DEBUGGER =
 struct
 
+(* exceptions *)
+
+abstype exn_id = Exn_Id of string
+with
+
+fun exn_id exn = Exn_Id (General.exnName exn);
+fun print_exn_id (Exn_Id name) = name;
+fun eq_exn_id (Exn_Id name1, Exn_Id name2) = name1 = name2;  (*over-approximation*)
+
+end;
+
+
 (* hooks *)
 
 fun on_entry _ = ();
--- a/src/Pure/ML-Systems/ml_debugger_polyml-5.5.3.ML	Sun Aug 16 23:14:27 2015 +0200
+++ b/src/Pure/ML-Systems/ml_debugger_polyml-5.5.3.ML	Mon Aug 17 15:19:25 2015 +0200
@@ -6,6 +6,10 @@
 
 signature ML_DEBUGGER =
 sig
+  type exn_id
+  val exn_id: exn -> exn_id
+  val print_exn_id: exn_id -> string
+  val eq_exn_id: exn_id * exn_id -> bool
   type location
   val on_entry: (string * location -> unit) option -> unit
   val on_exit: (string * location -> unit) option -> unit
@@ -23,6 +27,25 @@
 structure ML_Debugger: ML_DEBUGGER =
 struct
 
+(* exceptions *)
+
+abstype exn_id = Exn_Id of string * int Unsynchronized.ref
+with
+
+fun exn_id exn =
+  Exn_Id (General.exnName exn, RunCall.run_call2 RuntimeCalls.POLY_SYS_load_word (exn, 0));
+
+fun print_exn_id (Exn_Id (name, _)) = name;
+fun eq_exn_id (Exn_Id (_, id1), Exn_Id (_, id2)) = PolyML.pointerEq (id1, id2);
+
+end;
+
+val _ =
+  PolyML.addPrettyPrinter (fn _ => fn _ => fn exn_id =>
+    let val s = print_exn_id exn_id
+    in ml_pretty (ML_Pretty.String (s, size s)) end);
+
+
 (* hooks *)
 
 type location = PolyML.location;
--- a/src/Pure/ML-Systems/polyml.ML	Sun Aug 16 23:14:27 2015 +0200
+++ b/src/Pure/ML-Systems/polyml.ML	Mon Aug 17 15:19:25 2015 +0200
@@ -206,5 +206,6 @@
 
 (* ML debugger *)
 
-use "ML-Systems/ml_debugger.ML";
-if ML_System.name = "polyml-5.5.3" then use "ML-Systems/ml_debugger_polyml-5.5.3.ML" else ();
+if ML_System.name = "polyml-5.5.3"
+then use "ML-Systems/ml_debugger_polyml-5.5.3.ML"
+else use "ML-Systems/ml_debugger.ML";