tf.ml

module TaggedInitial = struct
  type _ t =
    | Int : int -> int t
    | Bool : bool -> bool t
    | Eql : ('a t * 'a t) -> bool t
    | If : (bool t * 'a t * 'a t) -> 'a t

  let term =
    If (Bool true, Int 42, Int 0)

  let rec eval : type a. a t -> a = function
    | Int i -> i
    | Bool b -> b
    | Eql (l, r) -> eval l = eval r
    | If (c, t, e) ->
      if eval c then
        eval t
      else
        eval e
end

module TaglessFinal = struct
  module type S = sig
    type 'a t
    val int : int -> int t
    val bool : bool -> bool t
    val eql : 'a t -> 'a t -> bool t
    val if_ : bool t -> 'a t -> 'a t -> 'a t
  end

  module Eval(M : S) = struct
    let value =
      M.(if_ (bool true) (int 42) (int 0))
  end

  let v =
    let module M = struct
      type 'a t = 'a
      let int i = i
      let bool b = b
      let eql l r = l = r
      let if_ c t e = if c then t else e
    end
    in
    let module R = Eval(M) in
    R.value
end