(*
This document can be processed with
ocamlweb <http://www.lri.fr/~filliatr/ocamlweb/>
to obtained a latex document.

Recommended options are: 

        ocamlweb --no-index --short --noweb exp.ml exp1.ml exp2.ml

OCaml compilation options: 

        ocamlc -c -w vm exp.ml
*)

(*
%HEVEA\usepackage{symboltott}

This document is also available in \href{exp.ps}{Postscript}.

Table of modules
\begin{itemize}
\item \hyperlink{Exp}{Exp}: data-centric encoding.
\item \hyperlink{Exp1}{Exp1}: operation-centric encoding.
\item \hyperlink{Exp2}{Exp2}: another operation-centric encoding.
\end{itemize}

This is another solution in OCaml to the \emph{Independently Extensible
Solutions to the Expression Problem.}  as described by
\href{http://lampwww.epfl.ch/~zenger/}{Zenger} and
\href{http://lampwww.epfl.ch/~odersky/}{Odersky} in their Technical Report
\href{http://lampwww.epfl.ch/papers/IC_TECH_REPORT_200433.pdf}{Nr. 200433},
March 2004.

This code has been check with OCaml 3.08.  It uses anonymous classes in
[DblePlusNegTest]. This could have been expanded into toplevel class
definitions in an earlier version of OCaml, which allowed closed classes
(classes where self had a closed object type).
The recent versions of OCaml do not allow this but for anonymous classes).

The code is then a mere translation of the original code in Scala,
where type annotations have been removed. Hence, the code is in general
shorter than in scala with the only exception of using private methods for 
sharable instance variables discussed above.

Jacques Garrigue and Didier R{\'e}my. 
*)

(*\section*{\label{Exp}Module \href{exp.ml}{Exp}}*)

(*\subsection* {3~ Object-oriented style}*)

(*\subsubsection* {3.2~ Framework}*)

module Base = struct
  class exp = object end

  class num v = object
    inherit exp
    val value : int = v
    method eval = value
  end
end

module BaseTest = struct
  let e = new Base.num 7
  let _ = Printf.printf "e is %d\n" (e#eval)
end
    

(*\subsection* {3.3~ Data extensions} *)

module BasePlus = struct
  class plus l r = object
    inherit Base.exp
    val left = l
    val right = r
    method eval = left#eval + right#eval
  end
end

module BaseNeg = struct
  class neg t = object
    inherit Base.exp
    val term = t
    method eval = 0 - term#eval
  end
end

(*\subsubsection* {Combining Independent Extensions} *)

module BasePlusNeg = struct
  include Base
  include BasePlus
  include BaseNeg
end


(*\subsection* {3.4~ Operation Extensions} *)

module Show = struct
  class num v = object 
    inherit Base.num v
    method show = string_of_int value
  end
end

(*\subsubsection* {Linear extensions} *)

module ShowPlusNeg = struct
  include Show
  class plus l r = object 
    inherit BasePlusNeg.plus l r
    method show = 
      Printf.sprintf "(%s + %s)" (left#show) (right#show)
  end
  class neg t = object 
    inherit BasePlusNeg.neg t
    method show = Printf.sprintf "-%s" (term#show)
  end
end

module ShowPlusNegTest = struct
  open ShowPlusNeg
  let e = new neg (new plus (new num 7) (new num 6))
  let _ = Printf.printf "%s = %d\n" (e#show) (e#eval)
end


(*\subsubsection* {Tree-transformer extensions} *)

module DblePlusNeg = struct
  class virtual num v = object (self : 'a)
    inherit BasePlusNeg.num v
    method private virtual num : int -> 'a
    method dble = self#num (value * 2)
  end
  class virtual plus l r = object (self : 'a)
    inherit BasePlusNeg.plus l r
    method private virtual plus : 'a -> 'a -> 'a
    method dble = self#plus (left#dble) (right#dble)
  end
  class virtual neg t = object (self : 'a)
    inherit BasePlusNeg.neg t
    method private virtual neg : 'a -> 'a
    method dble = self#neg (term#dble)
  end
end

module DblePlusNegTest = struct
  open DblePlusNeg
  let rec num v = object inherit num v method private num = num end 
  and plus l r = object inherit plus l r method private plus = plus end
  and neg t =  object inherit neg t method private neg = neg end

  let e = plus (neg (plus (num 1) (num 3))) (num 2)
  let _ =  Printf.printf "e * 2 is -4 ? %d\n" (e#dble#eval)
end

(* It is useless to check for type errors... OCaml is sound! *)


(*\subsubsection* {Combining independent extensions} *)

module ShowDblePlusNeg = struct
  class virtual num v = object
      inherit ShowPlusNeg.num v
      inherit DblePlusNeg.num v
  end
  class virtual plus l r = object
      inherit ShowPlusNeg.plus l r
 inherit DblePlusNeg.plus l r
  end
  class virtual neg t = object
      inherit ShowPlusNeg.neg t
      inherit DblePlusNeg.neg t
  end
end

(* [ShowDblePlusNeg] uses multiple inheritance of two classes built from a
common ancestor. This is a known difficulty when using multiple inheritance,
since the state of the common ancestor is being dupplicated in the two
subclasses. For instance, objects of the class [ShowDblePlusNeg.num] will
contained two occurrences of field [value].  This is fine here because
instance variables are not mutable and fields are not updated, so they can
be freely dupplicated: the two fields are filled with (and retain) the
same initial value [v].

OCaml does not offer any primitive construct to deal with this situation.
However, a simple solution is to make all read, write and update to instance
variables of the shared class go indirectly through private methdods. Since
methods definitions are overridden during inheritance, all methods will then
refer to the same instance variable---the one defined last---and unused
dupplicates will passively sit in the state of the object. Ths is not very
elegant, but it works well.  A small extension of the language with
annotations on instance variables could be used to drive the inheritance
of instance variables and avoid the use of private methods.

We have not used this schema here because objects are purely functional.
*)

(*\subsection* {Section 5: Binary methods} *)

(* Binary methods are rarely a problem in OCaml... *)

module Equals = struct
  class exp = object 
    inherit Base.exp
    method isNum (v : int) = false
  end
      
  class num v = object (self : 'a)
    inherit exp
    inherit Base.num v
    method eql (other : 'a) = other#isNum v
    method isNum v = v = value
  end
end

(*\subsection* {5.1~ Data extensions}*)

module EqualsPlusNeg = struct
  class exp = object (self : 'a)
    inherit Equals.exp
    method isNum (v : int) = false
    method isPlus (l : 'a) (r : 'a) = false
    method isNeg (t : 'a)  = false
  end

  class num v = object
    inherit exp
    inherit Equals.num v
  end

  class plus l r = object (self : 'a)
    inherit exp
    inherit BasePlusNeg.plus l r
    method isPlus l r = left#eql l && right#eql r
    method eql (other : 'a) = other#isPlus (left) (right)
  end

  class neg t = object (self : 'a)
    inherit exp
    inherit BasePlusNeg.neg t
    method isNeg t = term#eql t
    method eql (other : 'a) = other#isNeg (term)
  end
end

(*\subsection* {5.2~ Operation extensions}*)

module EqualsShowPlusNeg = struct
  class num v = object
    inherit EqualsPlusNeg.num v
    inherit ShowPlusNeg.num v
  end

  class plus l r = object
    inherit EqualsPlusNeg.plus l r
    inherit ShowPlusNeg.plus l r 
  end

  class neg t = object
    inherit EqualsPlusNeg.neg t
    inherit ShowPlusNeg.neg t
  end

end

module EqualsShowPlusNegTest = struct
  open EqualsShowPlusNeg
  let t1 = new plus (new num 1) (new num 2)
  let t2 = new plus (new num 1) (new num 2)
  let t3 = new neg (new num 2)
  let _ =
    Printf.printf "%s = %s ? %b\n" (t1#show) (t2#show) (t2#eql t2);
    Printf.printf "%s = %s ? %b\n" (t1#show) (t3#show) (t2#eql t3)
end