summaryrefslogtreecommitdiff
path: root/checker/univ.ml
diff options
context:
space:
mode:
Diffstat (limited to 'checker/univ.ml')
-rw-r--r--checker/univ.ml43
1 files changed, 26 insertions, 17 deletions
diff --git a/checker/univ.ml b/checker/univ.ml
index 5fed6dcd..3bcb3bc9 100644
--- a/checker/univ.ml
+++ b/checker/univ.ml
@@ -174,6 +174,16 @@ struct
| _, Level _ -> 1
| Var n, Var m -> Int.compare n m
+ let hequal x y =
+ x == y ||
+ match x, y with
+ | Prop, Prop -> true
+ | Set, Set -> true
+ | Level (n,d), Level (n',d') ->
+ n == n' && d == d'
+ | Var n, Var n' -> n == n'
+ | _ -> false
+
let hcons = function
| Prop as x -> x
| Set as x -> x
@@ -211,27 +221,26 @@ module Level = struct
let hash x = x.hash
- let hcons x =
- let data' = RawLevel.hcons x.data in
- if data' == x.data then x
- else { x with data = data' }
-
let data x = x.data
(** Hashcons on levels + their hash *)
- let make =
- let module Self = struct
- type _t = t
- type t = _t
- let equal = equal
- let hash = hash
- end in
- let module WH = Weak.Make(Self) in
- let pool = WH.create 4910 in fun x ->
- let x = { hash = RawLevel.hash x; data = x } in
- try WH.find pool x
- with Not_found -> WH.add pool x; x
+ module Self = struct
+ type _t = t
+ type t = _t
+ type u = unit
+ let equal x y = x.hash == y.hash && RawLevel.hequal x.data y.data
+ let hash x = x.hash
+ let hashcons () x =
+ let data' = RawLevel.hcons x.data in
+ if x.data == data' then x else { x with data = data' }
+ end
+
+ let hcons =
+ let module H = Hashcons.Make(Self) in
+ Hashcons.simple_hcons H.generate H.hcons ()
+
+ let make l = hcons { hash = RawLevel.hash l; data = l }
let set = make Set
let prop = make Prop