diff options
author | Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr> | 2015-12-05 13:43:07 +0100 |
---|---|---|
committer | Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr> | 2015-12-05 13:52:18 +0100 |
commit | 126a3c998c62bfd9f9b570f12b2e29576dd94cdd (patch) | |
tree | ab612a3f64d22162f2a7836cf99d963888923bff /lib | |
parent | 895d34a264d9d90adfe4f0618c3bb0663dc01615 (diff) |
Factorizing unsafe code by relying on the new Dyn module.
Diffstat (limited to 'lib')
-rw-r--r-- | lib/clib.mllib | 1 | ||||
-rw-r--r-- | lib/dyn.ml | 10 | ||||
-rw-r--r-- | lib/lib.mllib | 1 | ||||
-rw-r--r-- | lib/pp.ml | 29 |
4 files changed, 16 insertions, 25 deletions
diff --git a/lib/clib.mllib b/lib/clib.mllib index 7ff1d2935..1770df199 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 0571f3b5d..826cfaf8d 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 f3f6ad8fc..a9181c51c 100644 --- a/lib/lib.mllib +++ b/lib/lib.mllib @@ -1,6 +1,5 @@ Errors Bigint -Dyn Segmenttree Unicodetable Unicode @@ -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 |