diff options
| -rw-r--r-- | checker/check.mllib | 1 | ||||
| -rw-r--r-- | dev/printers.mllib | 2 | ||||
| -rw-r--r-- | grammar/grammar.mllib | 1 | ||||
| -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 |
7 files changed, 19 insertions, 26 deletions
diff --git a/checker/check.mllib b/checker/check.mllib index 246fe64dee..a029b0245c 100644 --- a/checker/check.mllib +++ b/checker/check.mllib @@ -8,6 +8,7 @@ Hashcons CSet CMap Int +Dyn HMap Option Store diff --git a/dev/printers.mllib b/dev/printers.mllib index 1a2819feb2..b498c2659d 100644 --- a/dev/printers.mllib +++ b/dev/printers.mllib @@ -8,6 +8,7 @@ Hashcons CSet CMap Int +Dyn HMap Option Store @@ -36,7 +37,6 @@ Util Ppstyle Errors Bigint -Dyn CUnix System Envars diff --git a/grammar/grammar.mllib b/grammar/grammar.mllib index 7e4eea641b..b167643d3f 100644 --- a/grammar/grammar.mllib +++ b/grammar/grammar.mllib @@ -8,6 +8,7 @@ Hashcons CSet CMap Int +Dyn HMap Option Store 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 @@ -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 |