first commit

test/test.ml

@@ -0,0 +1,59 @@
+open Hc
+
+type hidden = view hash_consed
+
+and view =
+  | Leaf of int
+  | Node of int * hidden * hidden
+
+module H = struct
+  type t = view
+
+  let equal x y =
+    match (x, y) with
+    | Leaf m, Leaf n -> m = n
+    | Node (m, l1, r1), Node (n, l2, r2) -> m = n && l1 == l2 && r1 == r2
+    | _ -> false
+
+  let hash = function
+    | Leaf n -> n
+    | Node (n, l, r) -> (19 * ((19 * n) + l.tag)) + r.tag + 2
+end
+
+module HTree = Make (H)
+
+let leaf n = HTree.hashcons (Leaf n)
+
+let node v l h = HTree.hashcons (Node (v, l, h))
+
+let extract x = match x.node with Leaf x | Node (x, _, _) -> x
+
+let rec get_fibo n =
+  if n < 0 then failwith "get_fibo";
+  if n < 2 then leaf n
+  else
+    let a = get_fibo (n - 1) in
+    let b = get_fibo (n - 2) in
+    node (extract a + extract b) a b
+
+let () =
+  (* 1 *)
+  let n1 = leaf 1 in
+  let n2 = leaf 2 in
+  let n3 = node 3 n1 n2 in
+  let n3' = node 3 n1 n2 in
+  assert (n3 == n3');
+  let n4 = node 4 n3 n3' in
+  let n4' = node 4 n3' n3 in
+  assert (n4 == n4');
+  let s = HTree.stats () in
+  assert (s.num_bindings = 4);
+  (* 2 *)
+  HTree.clear ();
+  let n = 30 in
+  let g = get_fibo n in
+  let s = HTree.stats () in
+  assert (s.num_bindings = n + 1);
+  let res = extract g in
+  assert (res = 832040);
+  Format.printf "Tests are OK !@."