funclang series4: There, I fixed it.

funclang-taddeus/series4/ass9.ml

@@ -5,55 +5,41 @@ type ('a, 'b) trie = Empty | Node of 'a list * 'b * ('a, 'b) trie list
 
 (* Helper function, checks if a list l start with a sublist s *)
 let rec starts_with l s = match s with
-    | [] -> true
+    [] -> true
     | hs::ts -> match l with
-        | [] -> false
+        [] -> false
         | hl::tl -> hs = hl && starts_with tl ts
 
 (* Insert a new (key, value) pair into a trie *)
-(* TODO: this doesn't work completely yet *)
 let rec insert trie key value = match trie with
-    | Empty -> Node (key, value, []) (* Root *)
-    | Node (k, v, children) ->
+    Empty -> Node (key, value, []) (* Root *)
+    | Node (k, v, c) ->
         if k = key then
             raise (Failure "Inserted key already exists in trie")
         else if not (starts_with key k) then
             raise (Failure "Inserted key does not start with node key")
         else
-            (* Inserted key should be in this node because it starts with
-             * the node's key *)
-            let rec walk_nodes = function
-                | [] -> Empty
-                | node::tail -> match node with
-                    | Empty -> Empty
-                    | Node (k, _, _) ->
-                        if starts_with key k then
-                            Node (k, v, (insert node key value)::children)
-                        else
-                            walk_nodes tail
+            let match_node node = match node with
+                Empty -> false
+                | Node (k, v, c) -> starts_with key k
             in
-            (* First, check if the new pair should be inserted in one of the
-             * children. If not, prepend it to the children list while moving
-             * all children that are should be inside the new node *)
-            match walk_nodes children with
-            | Empty ->
-                let matches_key = function
-                    | Empty -> false
-                    | Node (k, _, _) -> starts_with k key
+            let matches = map match_node c in
+            if fold_left (||) false matches then
+                (* Match in child node, do not add new child *)
+                let apply_match (matched, node) =
+                    if matched then insert node key value else node
                 in
-                (* 'move' are the children that are moved to be the children of
-                 * the inserted node, 'siblings' are the children that remain
-                 * in the current matched node *)
-                let move, siblings = partition matches_key children in
-                Node (k, v, (Node (key, value, move))::siblings)
-            | node -> node
+                Node (k, v, map apply_match (combine matches c))
+            else
+                (* No match in any child node, add new child *)
+                Node (k, v, c @ [Node (key, value, [])])
 
 (* Helper function, checks if a trie is not empty *)
 let non_empty = function | Empty -> false | _ -> true
 
 (* Remove a key from a given trie *)
 let rec remove trie key = match trie with
-    | Empty -> Empty
+    Empty -> Empty
     | Node (k, v, children) ->
         if k = key then
             (* Key match, remove the node *)
@@ -61,7 +47,7 @@ let rec remove trie key = match trie with
         else if starts_with key k then
             (* No full key match but prefix does match, match all children *)
             let match_with_key node = match node with
-                | Empty -> Empty
+                Empty -> Empty
                 | Node (k, _, _) -> if k = key then Empty else remove node key
             in
             Node (k, v, (filter non_empty (map match_with_key children)))
@@ -73,7 +59,7 @@ let rec remove trie key = match trie with
  * Basically does the same as the 'remove' function above, only using
  * 'starts_with' instead of literally matching the key *)
 let rec removeAll trie prefix = match trie with
-    | Empty -> Empty
+    Empty -> Empty
     | Node (k, v, children) ->
         if starts_with k prefix then
             (* Prefix match, remove the node *)
@@ -82,7 +68,7 @@ let rec removeAll trie prefix = match trie with
             (* No full prefix match yet, but possibly in children so continue
              * matching them *)
             let match_with_prefix node = match node with
-                | Empty -> Empty
+                Empty -> Empty
                 | Node (key, _, _) -> if starts_with key prefix then Empty
                                       else removeAll node prefix
             in
@@ -93,7 +79,7 @@ let rec removeAll trie prefix = match trie with
 
 (* Look up a value associated with a key *)
 let rec lookup trie key = match trie with
-    | Empty -> None (* Trie is empty, so no result *)
+    Empty -> None (* Trie is empty, so no result *)
     | Node (k, value, children) ->
         if k = key then
             (* Keys are equal, return value *)
@@ -102,9 +88,9 @@ let rec lookup trie key = match trie with
             (* 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
+                [] -> None
                 | child::rest -> match lookup child key with
-                    | None -> walk_nodes rest
+                    None -> walk_nodes rest
                     | result -> result
             in
             walk_nodes children
@@ -114,11 +100,10 @@ let rec lookup trie key = match trie with
 
 (* Find all (key, value) pairs whose key start with a given prefix *)
 let rec matches trie key = match trie with
-    | Empty -> []
-    | Node (k, value, children) ->
+    Empty -> []
+    | Node (k, value, c) ->
         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
+        (if starts_with k key then [(k, value)] else []) @ match_nodes c