Source

parvel / univ.ml

(* parvel won't use this code, it's an example only *)

(* the original code by Stephen Weeks is:
module Univ : Univ = struct
  type t = { 
    id : unit ref;
    store : unit -> unit; 
  }
 
  let embed () = 
    let id = ref () in
    let r = ref None in
    let put a =
      let o = Some a in
      { id = id; store = (fun () -> r := o); }
    in
    let get t =
      if id == t.id then (t.store (); let a = !r in r := None; a) else None
    in
    (put, get)
end
*)


module Variant
 =
  struct

    type t 'a =
      { variant_name : string
      ; temp_contents : mutable option 'a
      }
    ;

    value create variant_name =
      { variant_name = String.copy variant_name
      ; temp_contents = None
      }
    ;

  end
;

open Variant
;

type t =
  { store : unit -> unit
  ; vname : string
  }
;

value variant_name x = x.vname
;

value create v a =
  let o = Some a in
  { store = fun () -> v.temp_contents := o
  ; vname = v.variant_name
  }
;

value match_ v a =
  if a.vname == v.variant_name
  then
    let () = a.store () in
    let a = v.temp_contents in
    let () = v.temp_contents := None in
    a
  else
    None
;


(******)


value tests () =
  let vint = Variant.create "int"
  and vstr = Variant.create "string" in
  let lst = [ create vint 123; create vstr "asd" ] in
  let ok1 = (List.map (match_ vint) lst) = [Some 123; None]
  and ok2 = (List.map (match_ vstr) lst) = [None; Some "asd"]
  and ok3 = (List.map variant_name lst) = ["int"; "string"] in
  let ok = ok1 && ok2 && ok3 in
  Printf.printf "univ tests ok = %b\n%!" ok
;


value _ () = tests ()
;