Lecture 6.2: More Uses of Functors

Last class, we ended with a type with a user-defined equality function:

module type EqType = sig
    type t
    val equals : t -> t -> bool
end

This module defines a type with an associated equality: a function which, given two ts, will decide if they are equal. This allows us to use the type in data structures which assume a given type with a user-defined equality. Below is our EqType for UnorderedPair:

module UnorderedPair = struct
    type t = int * int
    let equals p1 p2 = 
        (fst p1 = fst p2 && snd p1 = snd p2)
        ||
        (snd p1 = fst p2 && fst p1 = snd p2)
end

Now, what if we want a list of unordered pairs? We could implement this directly:

module UnorderedPairList = struct
    type t = int * int
    let equals p1 p2 =  ???
end

But we would soon see that the complexity of equals increases dramatically with the size of the type. Instead, we can use functors to build new EqTypes out of old ones:

module EqTypeList (T : EqType) : (EqType with type t = T.t list) = struct
    type t = T.t
    let rec equals xs ys = 
        match xs, ys with 
        | [], [] -> true
        | x :: xs', y :: ys' -> T.equals x y && equals xs' ys'
        | _, _ -> false

Here is another for trees:

type 'a tree = | Leaf of 'a | Node of 'a tree * 'a tree
module EqTypeTree (T : EqType) : (EqType with type t = T.t tree) = struct
    type t = T.t tree
    let rec equals t1 t2 = 
        match t1, t2 with
        | Leaf x, Leaf y -> T.equals x y
        | Node (t11, t12), Node (t21, t22) -> 
            equals t11 t21 && equals t12 t22
        | _, _ -> false
end

We can even generalize our unordered pair module:

module UnorderedPairOf (T : EqType) : (EqType with type t = T.t * T.t) = struct
    type t = T.t * T.t
    let equals p1 p2 = 
        (T.equals (fst p1) (fst p2) && T.equals (snd p1) (snd p2))
        &&
        (T.equals (snd p1) (fst p2) && T.equals (fst p1) (snd p2))
end

Then, we can get for free an EqType for unordered pairs of lists of trees that contain integers:

module IntEqType = struct
    type t = int
    let equals x y = (x = y)
end

module MyType = UnorderedPairOf (EqTypeList (EqTypeTree (IntEqType)))

(* MyType.t = (int tree list) * (int tree list)
    MyType.equals : (int tree list) * (int tree list) -> (int tree list) * (int tree list) -> bool
*)