Universal Type for OCaml

The unversal type is a type which can hold any subtype within it's "universe". For example, the Object type found in languages such as Java, C#, and other OOP languages. In other languages, this type is abstent, opaque, or useless. Languages the support this type as a feature usually have a means of downcasting them.

I'm mainly interested in this concept from the angle of prototype-based programming. Objects can be constructed "out of nohting" and assigned properties and methods on the fly. Every get is thus mapping the value of the key to the type of the field. This kinda of mapping starts to get in depedent typing.

However, some googling around yeilded this snippet of OCaml:

module type PROPERTY_LIST =
sig
    type t

    val create : unit -> t
    val new_property : unit -> (t -> 'a -> unit) * (t -> 'a option)
end

module MappedList : PROPERTY_LIST =
struct
    type t = (int, unit -> unit) Hashtbl.t

    let create () = Hashtbl.create 13

    let new_id : unit -> int =
    let id = ref 0 in
        fun () -> incr id; !id

    let new_property () =
        let id = new_id () in

        (* This ref is used to communicate information *)
        (* between set and get *)
        let v = ref None in

        let set t x =
            (* stash the update hook *)
            Hashtbl.replace t id (fun () -> v := Some x) in

        let get t =
            try
            (* call the update hook if it exist *)
            (Hashtbl.find t id) ();

            (* Then read the result if the above succeeded *)
            match !v with
                Some x as s ->
                    (* prevent the value cached in v from *)
                    (* existing longer than needed *)
                    (* without this, calling set could leave *)
                    v := None;
                    s
                | None -> None
                with Not_found -> None
        in
            (set, get)
end

OCaml Unveral Type and Property List

(unscrolled)

This implements a unversial type exploiting OCaml's mutable ref. When a property is created using MappedList.new_property (), it spawns a set and get function that are linked together using a ref captured in v. Calling set stashes a update hook into the provided hashmap. This hook has the type unit -> unit (take "nothing", return "nothing"). It has the side effect of updating that shared ref which can be extracted by get.

However, this has two things I didn't like. The linked article "Heterogenous containers in OCaml" notes this is not thread safe. That ref is shared across all objects that utilize the same property. Additionally, ever call to set generates a new anonymous function.

Using First Class Modules

After some more searching around, I found a version that utilized exceptions. A friend then posted a version that used extensible varients directly. I then added matched the API from the previous example.

module Univ = struct
    type t = ..
    let id =
        let id = ref 0 in
        fun () ->
            incr id ;
            !id

    module Embed (M : sig type t end) = struct
        type t += E of M.t
        let wrap m = E m
        let read = function E m -> Some m | _ -> None

        let new_property () =
            let id = id () in
            let set t v =
                Hashtbl.replace t id @@ wrap v in
            let get t =
                Hashtbl.find_opt t id |> Fun.flip Option.bind read in
            (set, get)
    end
end

A unversal type using first class modules and extesible varients

(unscrolled)

Each time a new Univ.Embed(M) module is created, it extends the varient stored in Univ.t. The newly created module then provides the new_property function which produces getters and setters. Those, getter and setters provide access to the underlying M.t, if it exist.

It can be used as followed:

module IntWrapper = Univ.Embed(Int)
module StringWrapper = Univ.Embed(String)

let and_null = Hashtbl.create 16
let or_watt = Hashtbl.create 16

let name = StringWrapper.new_property ()
let age = IntWrapper.new_property ()
let money = IntWrapper.new_property ()

let get t (set, get) = get t
let set t (set, get) x = set t x

let () = set and_null name "and Null"
let () = set and_null age 28
let () = set and_null money 20
let () = set or_watt name "or Watt"
let () = set or_watt age 28
let () = set or_watt money 100
let () = match get and_null money, get or_watt money with
    | Some m, Some n when m < n ->
        print_endline "and has more moneny than or."
    | Some m, Some n when n > m ->
        print_endline "or has more money than and."
    | Some _, Some _ ->
        print_endline "They have the same amount of money."
    | None, None ->
        print_endline "They broke AF."
    | (None, _) ->
        print_endline "and has no money :<"
    | (_, None) ->
        print_endline "or has no money :<"

Universal type in action, each value is stored within a hashtable. This effectively creates a crued form of prototype-based programming.

(unscrolled)