1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
(**************************************************************************)
(* The CDuce compiler *)
(* Alain Frisch <Alain.Frisch@inria.fr> and the CDuce team *)
(* Copyright CNRS,INRIA, 2003,2004,2005,2006,2007 (see LICENSE for details) *)
(**************************************************************************)
type 'a typed_int = int
external int: 'a typed_int -> int = "%identity"
module type S = sig
type token
type value
include Custom.T with type t = token typed_int
exception Not_unique of value * value
val dummy: t
val min: t -> t -> t
val mk: value -> t
val value: t -> value
val extract: unit -> value array
val intract: value array -> unit
val from_int: int -> t
end
module HInt = Hashtbl.Make(struct type t = int
let hash x = x
let equal x y = x==y end)
module Make(X : Custom.T) = struct
type token
type value = X.t
type t = token typed_int
let min = min
exception Not_unique of value * value
let compare (x:int) y = if (x=y) then 0 else if (x < y) then (-1) else 1
let hash x = x
let equal x y = x==y
let pool = HInt.create 1024
let dummy = max_int
let mk v =
let h = X.hash v in
if (h == dummy) then raise (Not_unique (v,v));
(try
let v' = HInt.find pool h in
if not (X.equal v v') then raise (Not_unique (v,v'));
with Not_found -> HInt.add pool h v);
h
(* let value h =
assert (h != dummy);
try HInt.find pool h
with Not_found -> assert false *)
let value h = HInt.find pool h
let extract () = Array.of_list (HInt.fold (fun _ v accu -> v::accu) pool [])
let intract = Array.iter (fun v -> ignore (mk v))
let check _ = ()
let dump ppf _ = ()
let from_int i = i
end
|