Added answers to exam questions.

funclang-taddeus/exam.ml

+(* Assignment 2 *)
+let rec duplicate (l : char list) = match l with
+	| [] | [_] -> l
+	| a::(b::t) -> [a;b;b] @ (duplicate t)
+
+(* Assignment 3 *)
+let histogram (l : int list) =
+    (* Add an item to the memory.
+     * 'a -> ('a * int) list -> ('a * int) list *)
+	let rec add n = function
+		| [] -> [(n, 1)]
+		| (nb, c)::t when nb = n -> (n, c + 1)::t
+		| h::t -> h::(add n t)
+    (* Fill the memory with the given integer list.
+     * ('a * int) list -> 'a list -> ('a * int) list *)
+	in let rec hist mem = function
+		| [] -> mem
+		| h::t -> hist (add h mem) t
+	in hist [] l
+
+(* Assignment 4 *)
+module type DictSig = sig
+	type 'a dict
+	val empty : 'a dict
+	val add   : 'a dict -> (int * 'a) -> 'a dict
+	val get   : 'a dict -> int -> 'a option
+	val rem   : 'a dict -> int -> 'a dict
+	val size  : 'a dict -> int
+	val cat   : 'a dict -> 'a list
+end
+
+module DictTree : DictSig = struct
+	type 'a dict = Empty | Node of int * 'a * 'a dict * 'a dict
+
+	let empty = Empty
+
+	let rec add d (k, v) = match d with
+		| Empty -> Node (k, v, Empty, Empty)
+		| Node (kb, _, l, r) when kb = k -> Node (k, v, l, r)
+		| Node (kb, vb, l, r) when kb > k -> Node (kb, vb, add l (k, v), r)
+		| Node (kb, vb, l, r) -> Node (kb, vb, l, add r (k, v))
+
+	let rec get d k = match d with
+		| Empty -> None
+		| Node (kb, v, _, _) when kb = k -> Some v
+		| Node (kb, _, l, _) when kb > k -> get l k
+		| Node (_, _, _, r) -> get r k
+
+	let rec rem d k =
+        (* Merge two dictionaries into a single one.
+         * 'a dict * 'a dict -> 'a dict *)
+		let rec merge = function
+			| (Empty, n) | (n, Empty) -> n
+			| (Node (kb, v, l, r), n) -> Node (kb, v, l, merge (r, n))
+		in match d with
+		| Empty -> Empty
+		| Node (kb, _, l, r) when kb = k -> merge (l, r)
+		| Node (kb, v, l, r) when kb > k -> Node (kb, v, rem l k, r)
+		| Node (kb, v, l, r) -> Node (kb, v, l, rem r k)
+
+	let rec size = function
+		| Empty -> 0
+		| Node (_, _, l, r) -> 1 + (size l) + (size r)
+
+	let rec cat = function
+		| Empty -> []
+		| Node (_, v, l, r) -> (cat l) @ (v::(cat r))
+end