CSCI 2041


Functors and Inclusion

last time

Functors and sharing:

module BSTree (Item : ordered) : BST
  with type elt = Item.t =
(* all that stuff a third time *)
module CIStringBST = BSTree(struct
    type t = String
    let upper s = String.uppercase_ascii s
    let compare x y = (upper x) (upper y)

OCaml’s Set.Make functor works similarly…

module IntSet = Set.Make(struct type t = int let compare = (-) end)


Suppose we want to make a “wrapper” module for BSTs…

module BSTWrapper(B : BST) = struct
  type elt = B.elt
  type t = B.t
  let empty = B.empty (* and so on *)

Instead of all that typing we can use include:

module BSTWrapper(B : BST) = struct
  include B
  let size t = fold (fun a _ -> a+1) 0 t
  let to_sorted_list t =
    fold (fun a e -> e::a) [] t
  let min t = ...
  let max t = ...
module M1 : sig val greet : string -> string end = struct
  let pre s = String.uppercase_ascii s
  let greet s = "HELLO " ^ (pre s)

module M2 = struct
  include M1
  let pre s = s^"!"

module M3 = struct
  include M1
  let print s = print_endline (greet s)
  let greet s = s ^ "!"

What is the result of:

  • M2.greet "world"?

  • M3.print "friend"?

  • M3.greet "friend"?

module M1 : sig type t val x : t end = struct
  type t = int list
  let x = []

(* Will this compile? *)
module M2 = struct
  include M1
  let z = match x with [] -> "yass!"
          | _ -> "nnnoooo!"

include M does not allow access to abstract types of M:

Error: This pattern matches values of type 'a list
       but a pattern was expected which matches values of type t
module M3 : sig val x : int end = struct
  let x = 17
  let y = 42
module M4 = struct
  include M3
  let z = y

include M does not allow accessing inaccessible values of M:

Error: Unbound value y

include also works in signatures, and can be modified with sharing:

module type IntSet = sig
  include Set.S with type elt = int

Define a “wrapper” functor that turns an IntSet module into a NatSet module by raising an exception when adding or testing negative ints:

module NatSetWrapper(S : IntSet) : IntSet = struct
  include S
  let add x s = if x < 0 then invalid_arg "NatSet.add" else (S.add x s)
  let mem x s = if x < 0 then invalid_arg "NatSet.mem" else (S.mem x s)
  let of_list ls = if List.exists ((>) 0) ls
    then invalid_arg "NatSet.of_list"
    else (S.of_list ls)
module NatSet = NatSetWrapper(Set.Make(struct type t = int let compare = (-) end))

// reveal.js plugins