(* 1 *)
let pair x y = (x, y)

let product xs ys = 
  List.concat (List.map (fun x -> List.map (pair x) ys) xs);;

assert ([(1,"a");(1,"b");(2,"a");(2,"b")] = product [1;2] ["a";"b"]);;


type 'a tree = Empty | Node of 'a tree * 'a * 'a tree;;

let leaf x = Node (Empty, x, Empty)

(* 2(a) *)
let rec flatten = function
  | Empty -> []
  | Node (l, x, r) -> flatten l @ [x] @ flatten r;;

assert ([2;1;3] = flatten (Node (leaf 2, 1, leaf 3)));;

(* 3(b) trivial version
let ordered list =
  list = List.sort compare list;;

let is_bst tree = ordered (flatten tree);;
*)

(* 3(b) efficient version *) 
let rec is_bst_aux p = function
  | Empty -> true
  | Node (l, x, r) -> 
      is_bst_aux (fun y -> p y && y < x) l && p x &&
      is_bst_aux (fun y -> p y && x < y) r;;

let is_bst tree = is_bst_aux (fun _ -> true) tree;;

assert (     is_bst (Node (Node (leaf 1, 2, leaf 3), 4, leaf 6)) );;
assert (not (is_bst (Node (Node (leaf 1, 2, leaf 5), 4, leaf 6))));;

(* 4(a) *)
let empty = Empty;;

(* 4(b) *)
let rec mem x = function
  | Empty -> false
  | Node (l, y, r) when x < y -> mem x l
  | Node (l, y, r) when x > y -> mem x r
  | Node (_, _, _) -> true

(* 4(c) *)
let rec add x = function
  | Empty -> Node (Empty, x, Empty)
  | Node (l, y, r) when x < y -> Node (add x l, y, r)
  | Node (l, y, r) when x > y -> Node (l, y, add x r)
  | Node (_, _, _) as tree -> tree

(* 4(d) naive version *)
let join l r = List.fold_right add (flatten l) r

(* 4(d) slightly efficient version:
let rec split = function
  | Empty -> failwith "split"
  | Node (Empty, x, r) -> (x, r)
  | Node (l, x, r) -> 
      let (u, l') = split l in 
      (u, Node (l', x, r))

let join l = function
  | Empty -> l
  | Node (_, _, _) as r -> 
      let (x, r') = split r in
      Node (l, x, r')
*)

let rec remove x = function
  | Empty -> Empty
  | Node (l, y, r) when x < y -> Node (remove x l, y, r)
  | Node (l, y, r) when x > y -> Node (l, y, remove x r)
  | Node (l, y, r) -> join l r

type expr = 
  | Var of string
  | Const of int
  | Add of expr * expr
  | Sub of expr * expr

type env = (string * int) list

exception Unbound of string

(* 5 *)
let lookup env x =
  try 
    List.assoc x env
  with
    Not_found -> raise (Unbound x)

let rec eval env = function
  | Var x -> lookup env x
  | Const n -> n
  | Add (e1, e2) -> eval env e1 + eval env e2
  | Sub (e1, e2) -> eval env e1 - eval env e2;;

assert (-3 = eval [("x", 2); ("y", 3)]
	  (Sub (Var "x", Add (Var "y", Const 2))));;