first commit

lib/fromStdlib.ml

@@ -0,0 +1,29 @@
+(* https://github.com/ocaml/ocaml/blob/cce52acc7c7903e92078e9fe40745e11a1b944f0/stdlib/pervasives.ml *)
+
+let failwith = Stdlib.failwith
+let printf = Printf.printf
+
+external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply"
+
+external ( + ) : int -> int -> int = "%addint"
+external ( - ) : int -> int -> int = "%subint"
+external ( * ) : int -> int -> int = "%mulint"
+external ( / ) : int -> int -> int = "%divint"
+external ( mod ) : int -> int -> int = "%modint"
+
+external ( +. ) : float -> float -> float = "%addfloat"
+external ( -. ) : float -> float -> float = "%subfloat"
+external ( *. ) : float -> float -> float = "%mulfloat"
+external ( /. ) : float -> float -> float = "%divfloat"
+
+external ( = ) : 'a -> 'a -> bool = "%equal"
+external ( <> ) : 'a -> 'a -> bool = "%notequal"
+
+external ( < ) : 'a -> 'a -> bool = "%lessthan"
+external ( > ) : 'a -> 'a -> bool = "%greaterthan"
+external ( <= ) : 'a -> 'a -> bool = "%lessequal"
+external ( >= ) : 'a -> 'a -> bool = "%greaterequal"
+
+external not : bool -> bool = "%boolnot"
+external ( or ) : bool -> bool -> bool = "%sequor"
+external ( & ) : bool -> bool -> bool = "%sequand"

lib/functions.ml

@@ -0,0 +1,5 @@
+let id (x : 'a) = x
+
+let ( >> ) f g x = g (f x)
+
+let ( << ) g f x = g (f x)

lib/functions.mli

@@ -0,0 +1,8 @@
+(** Identity function. *)
+val id : 'a -> 'a
+
+(** Function composition. (f >> g) x represents g (f x). *)
+val ( >> ) : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c
+
+(** Function composition. (f << g) x represents f (g x). *)
+val ( << ) : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b

lib/list.ml

@@ -0,0 +1,146 @@
+open FromStdlib
+open Types
+
+let empty : 'a list = []
+
+let head (ls : 'a list) : 'a option =
+    match ls with
+    | x :: xs -> Some x
+    | [] -> None
+
+let tail (ls : 'a list) : 'a list =
+    match ls with
+    | x :: xs -> xs
+    | [] -> []
+
+let rec reverse_helper (ls : 'a list) (acc : 'a list) : 'a list =
+    match ls with
+    | x :: xs -> reverse_helper xs (x :: acc)
+    | [] -> acc
+
+let reverse (ls : 'a list) : 'a list =
+    reverse_helper ls []
+
+let rec append_tr_helper (ls1_rev : 'a list) (ls2 : 'a list) : 'a list =
+    match ls1_rev with
+    | [] -> ls2
+    | x :: xs ->
+        append_tr_helper xs (x :: ls2)
+
+let append_tr (ls1 : 'a list) (ls2 : 'a list) : 'a list =
+    append_tr_helper (reverse ls1) ls2
+
+let ( @ ) = append_tr
+
+let rec map (f : 'a -> 'b) (ls : 'a list) : 'b list =
+    match ls with
+    | x :: xs -> f x :: map f xs
+    | [] -> []
+
+let rec map_rev_tr_helper (f : 'a -> 'b) (ls : 'a list) (acc : 'b list) : 'b list =
+    match ls with
+    | x :: xs -> map_rev_tr_helper f xs (f x :: acc)
+    | [] -> acc
+
+let map_rev_tr (f : 'a -> 'b) (ls : 'a list) : 'b list =
+    map_rev_tr_helper f ls []
+
+let rec map_tr_helper (f : 'a -> 'b) (ls : 'a list) (acc : 'b list) : 'b list =
+    match ls with
+    | x :: xs -> map_tr_helper f xs (f x :: acc)
+    | [] -> reverse acc
+
+let rec map_tr (f : 'a -> 'b) (ls : 'a list) : 'b list =
+    map_tr_helper f ls []
+
+let rec foldl (f : 's -> 'a -> 's) (init : 's) (ls : 'a list) : 's =
+    match ls with
+    | x :: xs -> xs |> foldl f (f init x)
+    | [] -> init
+
+let rec foldr (f : 's -> 'a -> 's) (init : 's) (ls : 'a list) : 's =
+    foldl f init (reverse ls)
+
+let rec zip2_rev_tr_helper (ls1 : 'a list) (ls2 : 'b list) (acc : ('a * 'b) list) : ('a * 'b) list result =
+    
+    let first_head = head ls1 in
+    let second_head = head ls2 in
+
+    if first_head = None & second_head = None then
+        Success acc
+    else if (first_head = None & second_head <> None) or (first_head <> None & second_head = None) then
+        Error "The two lists must be of the same length."
+    else
+        let a = match first_head with | Some x -> x | None -> failwith "if this exception is raised there is an error in the implementation of the function that called it" in
+        let b = match second_head with | Some x -> x | None -> failwith "if this exception is raised there is an error in the implementation of the function that called it" in
+
+        zip2_rev_tr_helper (tail ls1) (tail ls2) ((a, b) :: acc)
+
+let rec zip2_rev_tr (ls1 : 'a list) (ls2 : 'b list) : ('a * 'b) list result =
+    zip2_rev_tr_helper ls1 ls2 []
+
+let zip2_tr (ls1 : 'a list) (ls2 : 'b list) : ('a * 'b) list result =
+    match zip2_rev_tr ls1 ls2 with
+    | Success x -> Success (reverse x)
+    | Error message -> Error message
+
+let rec unzip2_rev_tr_helper (ls : ('a * 'b) list) (acc1 : 'a list) (acc2 : 'b list) : ('a list) * ('b list) =
+    match ls with
+    | (first, second) :: xs -> unzip2_rev_tr_helper xs (first :: acc1) (second :: acc2)
+    | [] -> (acc1, acc2)
+
+let unzip2_rev_tr (ls : ('a * 'b) list) : ('a list) * ('b list) =
+    unzip2_rev_tr_helper ls [] []
+
+let rec pairwise_helper (ls : 'a list) (h : 'a) (acc : ('a * 'a) list) : ('a * 'a) list =
+    match ls with
+    | a :: (b :: tail) ->
+        let remaining = b :: tail in
+        let new_acc = ((a, b) :: acc) in
+        pairwise_helper remaining h new_acc
+    | [a] -> (a, h) :: acc
+    | _ -> acc
+
+let pairwise (ls : 'a list) : ('a * 'a) list =
+    match ls with
+    | [] -> []
+    | [_] -> []
+    | x :: xs ->
+        pairwise_helper ls x []
+
+let rec contains (a : 'a) (ls : 'a list) : bool =
+    match ls with
+    | x :: xs -> if x = a then true else contains a xs
+    | [] -> false
+
+let singleton (a : 'a) : 'a list =
+    a :: []
+
+let rec filter_rev_tr_helper (f : 'a -> bool) (ls : 'a list) (acc : 'a list) : 'a list =
+    match ls with
+    | x :: xs ->
+        if f x then
+            filter_rev_tr_helper f xs (x :: acc) 
+        else
+            filter_rev_tr_helper f xs acc
+    | [] -> acc
+
+let filter_rev_tr (f : 'a -> bool) (ls : 'a list) : 'a list =
+    filter_rev_tr_helper f ls []
+
+let rec find_helper (f : 'a -> bool) (ls : 'a list) (index : int) : ('a * int) option = 
+    match ls with
+    | x :: xs -> if f x then Some (x, index) else find_helper f xs (1 + index)
+    | [] -> None 
+
+let find (f : 'a -> bool) (ls : 'a list) : ('a * int) option =
+    find_helper f ls 0
+
+let rec initialize_helper (f : int -> 'a) (length : int) (index : int) (acc : 'a list) : 'a list =
+    if length = index then
+        acc
+    else
+        initialize_helper f length (index + 1) ((f index) :: acc)
+
+let initialize (f : int -> 'a) (length : int) : 'a list =
+    initialize_helper f length 0 []

lib/list.mli

@@ -0,0 +1,58 @@
+open Types
+
+(** The empty list *)
+val empty : 'a list
+
+(** Returns Some [x] if [x] is the head of the list, or None for the empty list. Runs in O(1). *)
+val head : 'a list -> 'a option
+
+(** Returns the tail of the list. Will be the empty list if the original list is empty or only contains one element. Runs in O(1). *)
+val tail : 'a list -> 'a list
+
+(** Reverses the order of the elements in the list. [reverse] is tail recursive. Runs in O(n). *)
+val reverse : 'a list -> 'a list
+
+(** Appends two lists together, by reversing the first and then appending each element from the first to the second. Runs in O(n), where n is the length of the first list. *)
+val ( @ ) : 'a list -> 'a list -> 'a list
+
+(** Maps the given function to each element of the list. [map] is not tail recursive and preserves order. Runs in O(n). *)
+val map : ('a -> 'b) -> 'a list -> 'b list
+
+(** Maps the given function to each element of the list. [map_rev_tr] is tail recursive and reverses the order of the list. If you wish to preserve order consider [map] for small lists, and [map_tr] for longer lists. Runs in O(n). *)
+val map_rev_tr : ('a -> 'b) -> 'a list -> 'b list
+
+(** Maps the given function to each element of the list. [map_tr] is tail recursive, and therefore has to reverse the resulting list. Calling [map_tr] is equivalent to calling [reverse] on the result of [map_rev_tr]. Runs in O(n). *)
+val map_tr : ('a -> 'b) -> 'a list -> 'b list
+
+(** Folds the list from the left, applying [f] to the existing state and each element at each step, using [init] as the initial state. [foldl] is tail recursive. Runs in O(n). *)
+val foldl : ('s -> 'a -> 's) -> 's -> 'a list -> 's
+
+(** Folds the list from the right, by reversing the list and then calling [foldl]. Runs in O(n). *)
+val foldr : ('s -> 'a -> 's) -> 's -> 'a list -> 's
+
+(** Combines two lists into a list of tuples, pairing elements in order and returning a list of pairs in reverse order compared to the original lists. [zip2_rev_tr] is tail recursive. Returns result type to handle errors where the two lists are not equal in length. Runs in O(n). *)
+val zip2_rev_tr : 'a list -> 'b list -> ('a * 'b) list result
+
+(** Combines two lists into a list of tuples, pairing elements in order from the front. [zip2_rev_tr] is tail recursive. Returns result type to handle errors where the two lists are not equal in length. This is equivalent to reversing the result of [zip2_rev_tr]. Runs in O(n). *)
+val zip2_tr : 'a list -> 'b list -> ('a * 'b) list result
+
+(** Converts a list of tuples into a tuple of lists, reversing the order of the elements in the resulting two lists. Runs in O(n). *)
+val unzip2_rev_tr : ('a * 'b) list -> 'a list * 'b list
+
+(* Returns all adjascent pairs of values from the list, as well as a pair of the last element and the first element. Runs in O(n). *)
+val pairwise : 'a list -> ('a * 'a) list
+
+(** Determines if the specified element is contained within the list, and returns a boolean. Runs in O(n). If this function is being called many times, consider a Set. *)
+val contains : 'a -> 'a list -> bool
+
+(** Creates a list of a single element. Runs in O(1). *)
+val singleton : 'a -> 'a list
+
+(** Filters a list according to the provided function, including elements where the function evaluates to true. The list is reversed in the process, and [filter_rev_tr] is tail recursive. Runs in O(n). *)
+val filter_rev_tr : ('a -> bool) -> 'a list -> 'a list
+
+(** Finds the first element in the provided list where the given function evaluates to true. Returns Some of the element and the index it appeared at, or none if the given function is false for all elements. Runs in O(n). *)
+val find : ('a -> bool) -> 'a list -> ('a * int) option
+
+(** Initializes a list using a length and a function from the index to the desired list value. Runs in O(n). *)
+val initialize : (int -> 'a) -> int -> 'a list

lib/main.ml

@@ -0,0 +1,4 @@
+open FromStdlib open Types
+
+
+let _ = printf "Hello, World\n"

lib/makefile

@@ -0,0 +1,43 @@
+# build recompiles and links all files (no incemental builds)
+build:
+	# fromStdlib manages things that need to be exposed from the standard library
+	ocamlopt -i fromStdlib.ml > fromStdlib.mli
+	ocamlopt -S -O3 -c fromStdlib.mli fromStdlib.ml
+
+	# types for other modules separated to easily expose without module reference in projects	
+	ocamlopt -S -O3 -nopervasives -c types.mli types.ml
+
+	# the following files make up the core custom standard library code
+	ocamlopt -S -O3 -nopervasives -c functions.mli functions.ml
+	ocamlopt -S -O3 -nopervasives -c stack.mli stack.ml
+	ocamlopt -S -O3 -nopervasives -c list.mli list.ml
+	ocamlopt -S -O3 -nopervasives -c map.mli map.ml
+	ocamlopt -S -O3 -nopervasives -c queue.mli queue.ml
+	ocamlopt -S -O3 -nopervasives -c set.mli set.ml
+	ocamlopt -S -O3 -nopervasives -c tree.mli tree.ml
+
+	# main is the main file to run code in
+	ocamlopt -i main.ml > main.mli
+	ocamlopt -S -O3 -nopervasives -c main.mli main.ml
+
+	# after all files are individually compiled with -nopervasives, this is compiled with it so that fromStdlib has the necessary linking
+	ocamlopt -S -O3 fromStdlib.cmx types.cmx functions.cmx stack.cmx list.cmx map.cmx queue.cmx set.cmx tree.cmx main.cmx -o program
+
+# clean removes all except source files. autogenerated mli files are also removed.
+clean:
+	rm -f *.o *.a *.s *.cmi *.cmx *.cmxa *.cmo *.cma fromStdlib.mli main.mli program
+
+# mostlyclean removes all except source files and the final executable. autogenerated mli files are also removed.
+mostlyclean:
+	rm -f *.o *.a *.s *.cmi *.cmx *.cmxa *.cmo *.cma fromStdlib.mli main.mli
+
+# install builds, mostlycleans and runs
+install:
+	make build
+	make mostlyclean
+	./program
+
+# just runs the executable if it has been produced by make build
+make run:
+	./program
+

lib/map.ml

@@ -0,0 +1,68 @@
+open FromStdlib
+
+module type Map = sig
+    type key
+
+    type 'v map
+
+    val empty : 'v map
+
+    val insert : (key * 'v) -> 'v map -> 'v map
+
+    val fetch : key -> 'v map -> 'v option
+end
+
+module type MapSpecification = sig
+    type key
+    
+    val comparison : key -> key -> int
+end
+
+module RBTreeMap (M : MapSpecification) : Map with type key = M.key = struct
+
+    type colour =
+        | Red
+        | Black
+
+    type key = M.key
+
+    type 'v map =
+        | Leaf
+        | Branch of colour * (key * 'v) * 'v map * 'v map
+    
+    let empty = Leaf
+
+    let rec fetch k = function
+        | Leaf -> None
+        | Branch (_, (key, value), left, right) ->
+            if M.comparison k key < 0 then
+                fetch k left
+            else if M.comparison k key > 0 then
+                fetch k right
+            else
+                Some value
+
+    let balance = function
+        | Black, z, Branch (Red, y, Branch (Red, x, a, b), c), d
+        | Black, z, Branch (Red, x, a, Branch (Red, y, b, c)), d
+        | Black, x, a, Branch (Red, z, Branch (Red, y, b, c), d)
+        | Black, x, a, Branch (Red, y, b, Branch (Red, z, c, d)) ->
+            Branch (Red, y, Branch (Black, x, a, b), Branch (Black, z, c, d))
+        | a, b, c, d -> Branch (a, b, c, d)
+
+    let rec insert_helper (k, v) = function
+        | Leaf -> Branch (Red, (k, v), Leaf, Leaf)
+        | Branch (colour, (key, value), left, right) ->
+            if M.comparison k key < 0 then
+                balance (colour, (key, value), insert_helper (k, v) left, right)
+            else if M.comparison k key > 0 then
+                balance (colour, (key, value), left, insert_helper (k, v) right)
+            else
+                Branch (colour, (key, v), left, right)
+
+    let insert ((k, v) : (key * 'v)) map =
+        match insert_helper (k, v) map with
+        | Branch (_, (key, value), left, right) ->  Branch (Black, (key, value), left, right)
+        | Leaf -> failwith "if this exception is raised there is an error in the implementation of the function that called it"
+
+end

lib/map.mli

@@ -0,0 +1,25 @@
+module type Map = sig
+    (** The type of keys in the map. *)
+    type key
+
+    (** Purely functional map, parameterised by the values stored in the map (not the keys). *)
+    type 'v map
+
+    (** The empty map. *)
+    val empty : 'v map
+
+    (** Inserts the key-value pair into the map. If the key already exists, it is overwritten. Runs in O(log(n)). *)
+    val insert : key * 'v -> 'v map -> 'v map
+    
+    (** Fetches a value from the map based on the key. Returns an option to handle cases where the key is not present. Runs in O(log(n)). *)
+    val fetch : key -> 'v map -> 'v option
+end
+
+module type MapSpecification = sig
+    (** The type of keys in the map. *)
+    type key
+    (** Comparison should return a value less than 0 for when the first value is smaller, greater than 0 for when the second is smaller, and 0 when they are equivalent. *)
+    val comparison : key -> key -> int
+end
+
+module RBTreeMap (M : MapSpecification) : Map with type key = M.key

lib/queue.ml

@@ -0,0 +1,13 @@
+open List
+open Types
+
+let enqueue (a : 'a) (qu : 'a queue) : 'a queue =
+    { qu with front = a :: qu.back }
+
+let dequeue (qu : 'a queue) : ('a option * 'a queue) =
+    match qu.front with
+    | [a] -> (Some a, { front = List.reverse qu.back; back = [] })
+    | h :: t -> (Some h, { qu with front = t })
+    | [] -> (None, qu)
+
+let empty = { front = []; back = [] }

lib/queue.mli

@@ -0,0 +1,10 @@
+open Types
+
+(** Adds an element to the back of the queue, returning the new queue. Runs in O(1). *)
+val enqueue : 'a -> 'a queue -> 'a queue
+
+(** Removes an element from the front of the queue, returning a tuple of the new queue and an option which is None if the queue is empty, or Some [x] where [x] wa the element on the front of the queue. Runs in best case O(1), worse case O(n) and amortized O(1). *)
+val dequeue : 'a queue -> 'a option * 'a queue
+
+(** The empty queue. *)
+val empty : 'a queue

lib/set.ml

@@ -0,0 +1,121 @@
+open FromStdlib
+
+module type RBTreeSet = sig
+    type member
+
+    type set
+
+    val empty : set
+
+    val insert : member -> set -> set
+
+    val member : member -> set -> bool
+
+    val union : set -> set -> set
+
+    val of_list : member list -> set
+
+    val remove : member -> set -> set
+
+    val difference : set -> set -> set
+
+    val cardinality : set -> int
+end
+
+module type SetSpecification = sig    
+    type member
+
+    val comparison : member -> member -> int
+end
+
+module RBTreeSet (M : SetSpecification) : RBTreeSet with type member = M.member = struct
+
+    type colour =
+        | Red
+        | Black
+
+    type member = M.member
+
+    type set =
+        | Leaf
+        | Branch of colour * member * set * set
+    
+    let empty = Leaf
+
+    let rec member v = function
+        | Leaf -> false
+        | Branch (_, value, left, right) ->
+            if M.comparison v value < 0 then
+                member v left
+            else if M.comparison v value > 0 then
+                member v right
+            else
+                true
+
+    let balance = function
+        | Black, z, Branch (Red, y, Branch (Red, x, a, b), c), d
+        | Black, z, Branch (Red, x, a, Branch (Red, y, b, c)), d
+        | Black, x, a, Branch (Red, z, Branch (Red, y, b, c), d)
+        | Black, x, a, Branch (Red, y, b, Branch (Red, z, c, d)) ->
+            Branch (Red, y, Branch (Black, x, a, b), Branch (Black, z, c, d))
+        | a, b, c, d -> Branch (a, b, c, d)
+
+    let rec insert_helper v = function
+        | Leaf -> Branch (Red, v, Leaf, Leaf)
+        | Branch (colour, value, left, right) ->
+            if M.comparison v value < 0 then
+                balance (colour, value, insert_helper v left, right)
+            else if M.comparison v value > 0 then
+                balance (colour, value, left, insert_helper v right)
+            else
+                Branch (colour, v, left, right)
+
+    let insert (v : member) (set : set) : set =
+        match insert_helper v set with
+        | Branch (_, value, left, right) ->  Branch (Black, value, left, right)
+        | Leaf -> failwith "if this exception is raised there is an error in the implementation of the function that called it"
+
+    let rec union set1 set2 =
+        match set1 with
+        | Leaf -> set2
+        | Branch (colour, value, left, right) ->
+            union left (union right (insert value set2))
+
+    let rec of_list_helper (ls : member list) (acc : set) : set =
+        match ls with
+        | x :: xs -> of_list_helper xs (insert x acc)
+        | [] -> acc
+
+    let of_list ls = of_list_helper ls empty
+    
+    let rec remove (v : member) (set : set) : set =
+        match set with
+        | Leaf -> Leaf
+        | Branch (colour, value, left, right) ->
+            if M.comparison v value < 0 then
+                balance (colour, value, remove v left, right)
+            else if M.comparison v value > 0 then
+                balance (colour, value, left, remove v right)
+            else
+                union left right
+
+    (* This needs a more efficient implementation. *)
+    let rec difference (set1 : set) (set2 : set) : set =
+        match set2 with
+        | Leaf -> set1
+        | Branch (_, value, left, right) ->
+            difference (union left right) (remove value set1)
+
+    (* Need a tail recursive implementation. *)
+    let rec cardinality (set : set) : int =
+        match set with
+        | Leaf -> 0
+        | Branch (_, _, left, right) ->
+            cardinality left + cardinality right + 1
+end
+
+(* Planned Functions:
+    - to_list
+    - intersection
+    - equal
+*)

lib/set.mli

@@ -0,0 +1,41 @@
+module type RBTreeSet = sig
+    (** Type of members in the set. *)
+    type member
+
+    (** Purely functional set, implemented as a red, black tree. *)
+    type set
+
+    (** The empty set. *)
+    val empty : set
+
+    (** Inserts a new element into the set. Runs in O(log(n)). *)
+    val insert : member -> set -> set
+
+    (** Determines if a specific value is a member of the set. Runs in O(log(n)). *)
+    val member : member -> set -> bool
+
+    (** Computes the union of two sets. Runs in O(mlog(n)), for the first set is of length m and the second is of length n. Hence if the lengths of the sets are known, this algorithm is most efficient if the second set is the longer one. *)
+    val union : set -> set -> set
+
+    (** Creates a set from a list. Will deduplicate if necessary. Runs in O(log(n!)). *)
+    val of_list : member list -> set
+
+    (** Removes the element specified from the set, if it exists. *)
+    val remove : member -> set -> set
+
+    (** Calculates the first set, without any elements that appear in the second. *)
+    val difference : set -> set -> set
+
+    (** Calculates the number of elements in the set. Note this is not tail recursive. Runs in O(n). *)
+    val cardinality : set -> int
+
+end
+
+module type SetSpecification = sig
+    (** Type of members in the set. *)
+    type member
+    (** Comparison should return a value less than 0 for when the first value is smaller, greater than 0 for when the second is smaller, and 0 when they are equivalent. *)
+    val comparison : member -> member -> int
+end
+
+module RBTreeSet (M : SetSpecification) : RBTreeSet with type member = M.member

lib/stack.ml

@@ -0,0 +1,30 @@
+open FromStdlib
+open Types
+
+let pop (st : 'a stack) : 'a option * 'a stack =
+    match st with
+    | Empty -> (None, Empty)
+    | Stacked (x, xs) -> (Some x, xs)
+
+let push (a : 'a) (st : 'a stack) : 'a stack =
+    Stacked (a, st)
+
+let peek (st : 'a stack) : 'a option =
+    match st with
+    | Empty -> None
+    | Stacked (x, xs) -> Some x
+
+let empty : 'a stack = Empty
+
+let rec height_helper (height : int) (st : 'a stack) =
+    match st with
+    | Empty -> height
+    | Stacked (x, xs) -> height_helper (height + 1) xs
+
+let height (st : 'a stack) : int =
+    height_helper 0 st
+
+let is_empty (st : 'a stack) =
+    match st with
+    | Empty -> true
+    | Stacked _ -> false

lib/stack.mli

@@ -0,0 +1,19 @@
+open Types
+
+(** Removes the top element from the stack, returning a tuple of the new stack, and None if the stack was empty, or Some [x] if [x] was on top of the stack. Popping an empty stack will result in the returned stack also being empty. Runs in O(1). *)
+val pop : 'a stack -> 'a option * 'a stack
+
+(** Pushes the specified element to the top of the stack, returning the new stack. Runs in O(1). *)
+val push : 'a -> 'a stack -> 'a stack
+
+(** Examines the top element of the stack, returning None for an empty stack, or Some [x] if [x] is the top element of the stack. Runs in O(1). *)
+val peek : 'a stack -> 'a option
+
+(** The empty stack. *)
+val empty : 'a stack
+
+(** Finds the height of the stack. Runs in O(n). *)
+val height : 'a stack -> int
+
+(** Determines if the stack is empty. Runs in O(1). *)
+val is_empty : 'a stack -> bool

lib/tree.ml

@@ -0,0 +1,5 @@
+open List
+open Types
+
+let combine (tr1 : 'a tree) (tr2 : 'a tree) (topBranch : 'a) : 'a tree =
+    Branch (topBranch, tr1 :: tr2 :: [])

lib/tree.mli

@@ -0,0 +1,4 @@
+open Types
+
+(* Combines two trees of the same type, with the specified value at the new top node. Runs in O(1). *)
+val combine : 'a tree -> 'a tree -> 'a -> 'a tree

lib/types.ml

@@ -0,0 +1,13 @@
+type 'a queue = { front : 'a list; back : 'a list }
+
+type 'a result =
+    | Error of string
+    | Success of 'a
+
+type 'a stack =
+    | Empty
+    | Stacked of 'a * 'a stack
+
+type 'a tree =
+    | Leaf
+    | Branch of 'a * 'a tree list

lib/types.mli

@@ -0,0 +1,16 @@
+(** Purely functional queue, implemented as a pair of lists. *)
+type 'a queue = { front : 'a list; back : 'a list }
+
+type 'a result =
+    | Error of string
+    | Success of 'a
+
+(** Purely functional stack. *)
+type 'a stack =
+    | Empty
+    | Stacked of 'a * 'a stack
+
+(* A purely functional tree with arbitrarily many branches at each node. *)
+type 'a tree =
+    | Leaf
+    | Branch of 'a * 'a tree list