Extensible Interpreter/Tagless Final Approach

tagless-final-style.ml

module type SYM_base = sig
  type 'a repr
  val lam: ('a repr -> 'b repr) -> ('a -> 'b) repr
  val app: ('a -> 'b) repr -> 'a repr -> 'b repr
end

module type SYM_bool = sig
  include SYM_base
  val bool: bool -> bool repr
  val not_: bool repr -> bool repr
  val and_: bool repr -> bool repr -> bool repr
  val or_: bool repr -> bool repr -> bool repr
  val eq_: 'a repr -> 'a repr -> bool repr
  val if_: cond:bool repr -> then_:(unit -> 'a repr) -> else_:(unit -> 'a repr) -> 'a repr
end

module type SYM_integer = sig
  include SYM_bool
  val int: int -> int repr
  val add: int repr -> int repr -> int repr
  val sub: int repr -> int repr -> int repr
  val mul: int repr -> int repr -> int repr
  val div: int repr -> int repr -> int repr
  val gt: int repr -> int repr -> bool repr
  val le: int repr -> int repr -> bool repr
end

module Eval_base = struct
  type 'a repr = 'a
  let lam f   = f
  let app f x = f x
end

module Eval_bool = struct
  include Eval_base
  let bool b = b
  let not_   = Pervasives.( not )
  let and_   = Pervasives.( && )
  let or_    = Pervasives.( || )
  let eq_    = Pervasives.(=)
  let if_ ~cond ~then_ ~else_ =
    if cond then then_ () else else_ ()
end

module Eval_integer = struct
  include Eval_bool
  let int n = n
  let add   = Pervasives.( + )
  let sub   = Pervasives.( - )
  let mul   = Pervasives.( * )
  let div   = Pervasives.( / )
  let gt    = Pervasives.( > )
  let le    = Pervasives.( < )
end

module McCarthy91 (S: SYM_integer) = struct
  open S
  let rec f () = lam (fun n ->
      if_ ~cond:(gt n (int 100))
        ~then_:(fun () -> sub n (int 10))
        ~else_:(fun () -> app (f ()) @@ app (f ()) (add n (int 11))))

  let res0 = app (f ()) (int 11)
  let res1 = app (f ()) (int 99)
  let res2 = app (f ()) (int 87)
  let res3 = app (f ()) (int 34)
end

module McCarthy91Res = McCarthy91(Eval_integer)
let _ =
  Printf.printf "McCarthy91(11) = %d\n" McCarthy91Res.res0;
  Printf.printf "McCarthy91(99) = %d\n" McCarthy91Res.res1;
  Printf.printf "McCarthy91(87) = %d\n" McCarthy91Res.res2;
  Printf.printf "McCarthy91(34) = %d\n" McCarthy91Res.res3