From 126a3c998c62bfd9f9b570f12b2e29576dd94cdd Mon Sep 17 00:00:00 2001
From: Pierre-Marie Pédrot
Date: Sat, 5 Dec 2015 13:43:07 +0100
Subject: Factorizing unsafe code by relying on the new Dyn module.

---
 lib/clib.mllib |  1 +
 lib/dyn.ml     | 10 ++++------
 lib/lib.mllib  |  1 -
 lib/pp.ml      | 29 +++++++++++------------------
 4 files changed, 16 insertions(+), 25 deletions(-)

(limited to 'lib')

diff --git a/lib/clib.mllib b/lib/clib.mllib
index 7ff1d29359..1770df1993 100644
--- a/lib/clib.mllib
+++ b/lib/clib.mllib
@@ -8,6 +8,7 @@ Hashcons
 CSet
 CMap
 Int
+Dyn
 HMap
 Option
 Store
diff --git a/lib/dyn.ml b/lib/dyn.ml
index 0571f3b5d6..826cfaf8db 100644
--- a/lib/dyn.ml
+++ b/lib/dyn.ml
@@ -6,9 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Errors
-open Pp
-
 module type S =
 sig
 type 'a tag
@@ -39,8 +36,8 @@ let create (s : string) =
   let () =
     if Int.Map.mem hash !dyntab then
       let old = Int.Map.find hash !dyntab in
-      let msg = str "Dynamic tag collision: " ++ str s ++ str " vs. " ++ str old in
-      anomaly ~label:"Dyn.create" msg
+      let () = Printf.eprintf "Dynamic tag collision: %s vs. %s\n%!" s old in
+      assert false
   in
   let () = dyntab := Int.Map.add hash s !dyntab in
   hash
@@ -51,7 +48,8 @@ let eq : 'a 'b. 'a tag -> 'b tag -> ('a, 'b) CSig.eq option =
 let repr s =
   try Int.Map.find s !dyntab
   with Not_found ->
-    anomaly (str "Unknown dynamic tag " ++ int s)
+    let () = Printf.eprintf "Unknown dynamic tag %i\n%!" s in
+    assert false
 
 let dump () = Int.Map.bindings !dyntab
 
diff --git a/lib/lib.mllib b/lib/lib.mllib
index f3f6ad8fc7..a9181c51c1 100644
--- a/lib/lib.mllib
+++ b/lib/lib.mllib
@@ -1,6 +1,5 @@
 Errors
 Bigint
-Dyn
 Segmenttree
 Unicodetable
 Unicode
diff --git a/lib/pp.ml b/lib/pp.ml
index 146d3562dd..a1913c98f7 100644
--- a/lib/pp.ml
+++ b/lib/pp.ml
@@ -51,25 +51,18 @@ sig
   val prj : t -> 'a key -> 'a option
 end =
 struct
-  (** See module {Dyn} for more details. *)
 
-  type t = int * Obj.t
-
-  type 'a key = int
-
-  let dyntab = ref (Int.Map.empty : string Int.Map.t)
-
-  let create (s : string) =
-    let hash = Hashtbl.hash s in
-    let () = assert (not (Int.Map.mem hash !dyntab)) in
-    let () = dyntab := Int.Map.add hash s !dyntab in
-    hash
-
-  let inj x h = (h, Obj.repr x)
-
-  let prj (nh, rv) h =
-    if Int.equal h nh then Some (Obj.magic rv)
-    else None
+module Dyn = Dyn.Make(struct end)
+
+type t = Dyn.t
+type 'a key = 'a Dyn.tag
+let create = Dyn.create
+let inj x k = Dyn.Dyn (k, x)
+let prj : type a. t -> a key -> a option = fun dyn k ->
+  let Dyn.Dyn (k', x) = dyn in
+  match Dyn.eq k k' with
+  | None -> None
+  | Some CSig.Refl -> Some x
 
 end
 
-- 
cgit v1.2.3