(* Tagless Final using modules *)
(* Note the similarity with the Haskell type class ExpSYM *)
module type ExpSYM = sig
type repr
val lit : int -> repr
val neg : repr -> repr
val add : repr -> repr -> repr
end;;
(* A sample expression *)
(* It is now a functor: an expression is literally parameterized over
the interpreter.
The proper expression has the same form as in *)
(* Haskell, see Intro2.hs *)
module TF1(S: ExpSYM) = struct
open S
let res = add (lit 8) (neg (add (lit 1) (lit 2)))
end;;
(* Now we define one interpreter *)
(* It is clearly meta-circular *)
module Eval = struct
type repr = int
let lit n = n
let neg e = - e
let add e1 e2 = e1 + e2
end;;
(* We can evaluate our sample term *)
let 5 = let module M = TF1(Eval) in M.res;;
(* We can define another interpreter *)
module View = struct
type repr = string
let lit n = string_of_int n
let neg e = "(-" ^ e ^ ")"
let add e1 e2 = "(" ^ e1 ^ " + " ^ e2 ^ ")"
end;;
(* and evaluate the same term using the new interpreter *)
let "(8 + (-(1 + 2)))" = let module M = TF1(View) in M.res;;
(* We can extend our language with a new expression form *)
module type EMSYM = sig
include ExpSYM (* Reuse ExpSYM declaration *)
val mul : repr -> repr -> repr
end;;
(* We extend the interpreters, reusing the old code *)
module EvalM = struct
include Eval
let mul e1 e2 = e1 * e2
end;;
module ViewM = struct
include View
let mul e1 e2 = "(" ^ e1 ^ " * " ^ e2 ^ ")"
end;;
(* We can evaluate the old expression TF1 using the extended EvalM.
So, EvalM is fully backwards compatible with Eval
*)
let 5 = let module M = TF1(EvalM) in M.res;;
(* We can write extended terms *)
(* Again, the code for the expression has literally the same form
as that in ExtF.hs
*)
module TFM1(S: EMSYM) = struct
open S
let res = add (lit 7) (neg (mul (lit 1) (lit 2)))
end;;
module TFM2(S: EMSYM) = struct
open S
module Tf1 = TF1(S)
let res = mul (lit 7) Tf1.res (* reusing the old expression TF1 *)
end;;
let 5 = let module M = TFM1(EvalM) in M.res;;
let 35 = let module M = TFM2(EvalM) in M.res;;
(* we can't pass Eval to TFM1 by mistake:
let module M = TFM1(Eval) in M.res;;
Error: Signature mismatch:
Modules do not match:
sig
type repr = int
val lit : 'a -> 'a
val neg : int -> int
val add : int -> int -> int
end
is not included in
EMSYM
The field `mul' is required but not provided
*)
let "(7 + (-(1 * 2)))" = let module M = TFM1(ViewM) in M.res;;
let "(7 * (8 + (-(1 + 2))))" = let module M = TFM2(ViewM) in M.res;;
(* Unlike final_obj.ml, we obtain the extensibility along two axes,
adding new variants and adding new operations (interpreters)
*)
(* But there is a problem: our sample expressions, TF1, TFM1, TFM2
are modules -- which are not first-class (although they soon be, in OCaml).
In any case, first-class modules are rarity, and their theory is complex.
*)