funclang series4: Successfully implemented lookup and matches in ass9.

funclang-taddeus/series4/ass9.ml

+open List
 
+(* A Node has a key, value and list of children *)
+type ('a, 'b) trie = Empty | Node of 'a list * 'b * ('a, 'b) trie list
+
+let rec starts_with l s =
+    (length s) <= (length l) && match s with
+    | [] -> true
+    | h::t -> h = (hd l) && starts_with (tl l) t
+;;
+
+let rec insert trie key value =
+    match trie with
+    | Empty -> Node (key, value, []) (* Root *)
+    | Node (k, v, children) ->
+        if starts_with key k then
+            (* Check all children for a longer prefix *)
+            if (length k) = (length key) - 1 then
+                (* Direct child *)
+                Node (k, v, children @ [Node (key, value, [])])
+            else
+                (* Add another nde between the matched node and the child,
+                 * with the length of the matched node plus one *)
+                Empty
+        else
+            raise (Failure "Inserted key does not start with node key")
+;;
+
+(**)
+let rec lookup trie key =
+    match trie with
+    | Empty -> None (* Trie is empty, so no result *)
+    | Node (k, value, children) ->
+        if k = key then
+            (* Keys are equal, return value *)
+            Some value
+        else if starts_with key k then
+            (* The node's key prefixes the given key, so the value can only
+             * be in one of the children. *)
+            let rec walk_nodes = function
+                | [] -> None
+                | child::rest -> match lookup child key with
+                    | None -> walk_nodes rest
+                    | result -> result
+            in
+            walk_nodes children
+        else
+            (* Not found *)
+            None
+;;
+
+let rec matches trie key =
+    match trie with
+    | Empty -> []
+    | Node (k, value, children) ->
+        let rec match_nodes = function
+            | [] -> []
+            | node::rest -> (matches node key) @ (match_nodes rest)
+        in
+        (if starts_with k key then [(k, value)] else [])
+        @ match_nodes children
+;;
+
+let a = Node ([1;2;3], "a", []);;
+let b = Node ([1;3], "b", [a]);;
+let c = Node ([3;4], "c", [b]);;