Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Page
Library
Module
Module type
Parameter
Class
Class type
Source
equivalence.ml1 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 70 71 72 73 74 75 76open Containers (* module IntMap = Map.Make (Int) *) module IntMap = Hashtbl.Make (Int) module IntSet = CCHashSet.Make (Int) module Make = functor () -> struct type elem = | Root of int | Link of elem_ref and elem_ref = int and store = { mutable limit: int; content: elem IntMap.t } type t = elem_ref let repr v = v let (.@[]) store rf = IntMap.find store.content rf let (.@[]<-) store rf vl = IntMap.replace store.content rf vl let create_store () = {limit=0; content=IntMap.create 100} let hash = Int.hash let rref (store: store) vl = let x = store.limit in store.limit <- x + 1; IntMap.replace store.content x vl; x let make_raw = let id = ref 0 in fun () -> incr id; (Root !id) let make store () = rref store @@ make_raw () let rec find store x = match store.@[x] with | Root _ -> x | Link y -> let z = find store y in if not @@ Equal.physical z y then store.@[x] <- Link z; z let equal store t1 t2 = let t1 = find store t1 in let t2 = find store t2 in Equal.physical t1 t2 let link store x y = if Equal.physical x y then x else match[@warning "-8"] store.@[x], store.@[y] with | Root _, Root _ -> store.@[y] <- Link x; x (* if vx < vy then (store.@[x] <- Link y; y) * else if vy > vx then (store.@[y] <- Link x; x) * else (store.@[y] <- Link x; * store.@[x] <- make_raw (); * x) *) let union store x y = let x = find store x in let y = find store y in link store x y module Map = IntMap module Set = IntSet end