runtime_hlist.ml

type void = |

module Make(T:sig type 'a t end) = struct
  type 'a t =
    | []: void t
    | (::): 'a T.t * 'b t -> ('a -> 'b) t
end

module HL = Make(struct type 'a t = 'a end)

type 'a ty =
 | Int: int ty
 | Float: float ty

module HLT =Make(struct type 'a t = 'a ty end)

type dyn = Typed: 'a HL.t * 'a HLT.t -> dyn
let rec gen n =
  if n = 0 then Typed (HL.[], HLT.[]) else
    let Typed(v,t) = gen (n - 1) in
    if Random.float 1. < 0.5 then
      Typed(HL.(Random.float 1.::v),
            HLT.(Float::t)
           )
    else
      Typed(HL.(Random.int 10::v),
            HLT.(Int::t)
           )

let rec add : type a. a HLT.t -> a HL.t -> float = fun ts xs ->
  match ts, xs with
  | [], [] -> 0.
  | Int :: ts, n :: xs -> float n +. add ts xs
  | Float :: ts, x :: xs -> x +. add ts xs

let test =
  let Typed(xs,ts) = gen 100 in
  add ts xs