module type BINTREE = sig 
  type 'a bintree = Leaf | Node of 'a bintree * 'a * 'a bintree
  val int_tree : int bintree
  val string_tree : string bintree
  val map : ('a -> 'b) -> 'a bintree -> 'b bintree 
  val fold : ('a -> 'b -> 'a -> 'a) -> 'a -> 'b bintree -> 'a 
  val nodes : 'a bintree -> int 
  val height : 'a bintree -> int 
  val sum : int bintree -> int 
  val prelist : 'a bintree -> 'a list
  val inlist : 'a bintree -> 'a list 
  val postlist : 'a bintree -> 'a list 
  val toString : ('a -> string) -> 'a bintree -> string 
  val toSexp1 : ('a -> Sexp.sexp) -> 'a bintree -> Sexp.sexp
  val toSexp2 : ('a -> Sexp.sexp) -> 'a bintree -> Sexp.sexp
  val toSexp3 : ('a -> Sexp.sexp) -> 'a bintree -> Sexp.sexp
end

module Bintree : BINTREE = struct 

  open Sexp

  (* Binary tree datatype abstracted over type of node value *)
  type 'a bintree = 
      Leaf
    | Node of 'a bintree * 'a * 'a bintree (* left subtree, value, right subtree *)

  (* Sample tree of integers *)
  let int_tree = 
      Node(Node(Leaf, 2, Leaf), 
           4, 
           Node(Node(Leaf, 1, Node(Leaf, 5, Leaf)),
                6,
                Node(Leaf, 3, Leaf)));;

  (* Sample tree of strings *) 
  let string_tree = 
      Node(Node(Leaf, "like", Leaf), 
           "green", 
           Node(Node(Leaf, "eggs", Leaf),
                "and",
                Node(Leaf, "ham", Leaf)));;

  (* Map a function over every value in a tree *)
  let rec map f tr = 
    match tr with 
      Leaf -> Leaf
    | Node(l,v,r) -> Node(map f l, f v, map f r)

  (* Divide/conquer/glue on trees *)
  let rec fold glue lfval tr = 
    match tr with 
      Leaf -> lfval 
    | Node(l,v,r) -> glue (fold glue lfval l) v (fold glue lfval r)

  let nodes tr = fold (fun l v r -> 1 + l + r) 0 tr

  let height tr = fold (fun l v r -> 1 + (max l r)) 0 tr 

  let sum tr = fold (fun l v r -> l + v + r) 0 tr

  let prelist tr = fold (fun l v r -> v :: l @ r) [] tr

  let inlist tr = fold (fun l v r -> l @ [v] @ r) [] tr

  let postlist tr = fold (fun l v r -> l @ r @ [v]) [] tr

  let toString valToString tr = 
    fold (fun l v r -> "(" ^ l ^ " " ^ (valToString v) ^ " " ^ r ^ ")") "*" tr

  let rec toSexp1 eltToSexp tr = 
    match tr with 
      Leaf -> Seq [Sym "Leaf"]
    | Node(l,v,r) -> Seq [Sym "Node"; 
			  toSexp1 eltToSexp l; 
			  eltToSexp v;
			  toSexp1 eltToSexp r]

  let rec toSexp2 eltToSexp tr = 
    match tr with 
      Leaf -> Sym "Leaf"
    | Node(l,v,r) -> Seq [Sym "Node"; 
			  toSexp2 eltToSexp l; 
			  eltToSexp v;
			  toSexp2 eltToSexp r]

  let rec toSexp3 eltToSexp tr = 
    match tr with 
      Leaf -> Sym "*"
    | Node(l,v,r) -> Seq [toSexp3 eltToSexp l; 
			  eltToSexp v;
			  toSexp3 eltToSexp r]

end