INCLUDE "utils.ml" module type S = sig type elt type 'a node = Nil | Cons of elt * 'a type t val hash : t -> int val uid : t -> int val equal : t -> t -> bool val nil : t val node : t -> t node val cons : elt -> t -> t val hd : t -> elt val tl : t -> t val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a val map : (elt -> elt) -> t -> t val iter : (elt -> 'a) -> t -> unit val rev : t -> t val rev_map : (elt -> elt) -> t -> t val length : t -> int end module Make ( H : Hcons.S ) : S with type elt = H.t = struct type elt = H.t type 'a node = Nil | Cons of elt * 'a module rec HNode : Hcons.S with type data = Node.t = Hcons.Make (Node) and Node : Hashtbl.HashedType with type t = HNode.t node = struct type t = HNode.t node let equal x y = match x,y with | Nil,Nil -> true | Cons (a,aa), Cons(b,bb) -> (H.equal a b) && (HNode.equal aa bb) | _ -> false let hash = function | Nil -> 0 | Cons(a,aa) -> HASHINT3(PRIME3,H.uid a, HNode.uid aa) end ;; type t = HNode.t let node = HNode.node let hash = HNode.hash let equal = HNode.equal let uid = HNode.uid let nil = HNode.make Nil let cons a b = HNode.make (Cons(a,b)) let hd a = match HNode.node a with | Nil -> failwith "hd" | Cons(a,_) -> a let tl a = match HNode.node a with | Nil -> failwith "tl" | Cons(_,a) -> a let fold f l acc = let rec loop acc l = match HNode.node l with | Nil -> acc | Cons(a,aa) -> loop (f a acc) aa in loop acc l let map f l = let rec loop l = match HNode.node l with | Nil -> nil | Cons(a,aa) -> cons (f a) (loop aa) in loop l let iter f l = let rec loop l = match HNode.node l with | Nil -> () | Cons(a,aa) -> (f a);(loop aa) in loop l let rev l = fold cons l nil let rev_map f l = fold (fun x acc -> cons (f x) acc) l nil let length l = fold (fun _ c -> c+1) l 0 end