Visitor Design Pattern in OCaml

Question

I am attempting to implement the Visitor Design Pattern using OCaml's OO constructs and type system and am running into problems upon instantiation of an Element.

class virtual ['hrRep] employee = object 
 method virtual receiveEvaluation : 'hrRep -> unit
 method virtual getName : string
end;;

class ['hrRep] accountant myName = object (self : 'a)
 inherit ['hrRep]employee
 val name = myName
 method receiveEvaluation rep = rep#visitAccountant self
 method getName = name
end;;

class ['hrRep] salesman myName = object (self : 'a)
 inherit ['hrRep]employee
 val name = myName
 method receiveEvaluation rep = rep#visitSalesman self
 method getName = name
end;;

class virtual ['accountant, 'salesman] hrRep = object (self)
 method virtual visitSalesman : 'salesman -> unit
 method virtual visitAccountant : 'accountant -> unit
end;;

class ['employee, 'salesman] lowerLevelHRRep = object (self) inherit ['employee, 'salesman]hrRep
 method visitSalesman s = print_endline ("Visiting salesman "^s#getName)
 method visitAccountant a = print_endline ("Visiting accountant "^a#getName)
end;;

let s1 : (< visitSalesman : 'a -> unit>) salesman = new salesman "Bob";;
let a1 : (< visitAccountant : 'a -> unit>) accountant = new accountant "Mary";;
let s2 : (< visitSalesman : 'a -> unit>) salesman = new salesman "Sue";;

let h1 : (< getName : string>, < getName : string>) lowerLevelHRRep = new lowerLevelHRRep;;
s1#receiveEvaluation h1;;

The error I get upon compilation is,

"The type of this expression, unit; _.. > salesman as 'a, contains type variables that cannot be generalized"

, however, the code compiles minus the line instantiating the salesman. How do I go about instantiating the salesman while maintaining the classes' functionality?

---

Edit: Error received with call to receiveEvaluation: This expression has type (, < getName : string>) lowerLevelHRRep but is here used with type unit > as 'a. The second object type has no method visitAccountant

Answer 1

EDIT - Separated the answer in 3 main points: the resolution of the initial compile error, a recursive solution, and a parametrized solution

Resolution of the compile error

Note that your code works fine in the top level:

# let s = new salesman ();;
val s : < visitSalesman : 'a -> unit; _.. > salesman as 'a = <obj>

This kind of compile error is generally solved by adding a type annotation to help the compiler figuring the type. As the top level kindly told us what it was, we can modify the instantiation:

let s : (< visitSalesman : 'a -> unit>) salesman = new salesman ();;

And this compiles!

A recursive solution

It is possible to reduce complexity by using recursive classes. This totally removes the need for parametrized classes, but means that all objects need to be defined in the same source file.

class virtual employee =
object
  method virtual receiveEvaluation:(hrrep -> unit)
end

and accountant = 
object(self)
  inherit employee
  method receiveEvaluation:(hrrep -> unit) = fun rep -> rep#visitAccountant (self :> accountant)
end

and salesman = 
object (self)
  inherit employee
  method receiveEvaluation:(hrrep -> unit) = fun rep -> rep#visitSalesman (self :> salesman)
end

and hrrep = 
object
  method visitSalesman:(salesman -> unit) = fun s -> print_endline ("Visiting salesman")
  method visitAccountant:(accountant -> unit) = fun s -> print_endline ("Visiting accountant")
end

let s = new salesman;;
let e = (s :> employee);;
let v = new hrrep;;

e#receiveEvaluation v;;

This prints "Visiting salesman". The coercion to employee is just to make this closer to a real world scenario.

A parametrized solution

Looking at the problem again, I think it is not necessary to have a parametrized hrRep, because at this moment, all other types are known. By just making the employee class parametrized, I get this:

class virtual ['a] employee = 
object
  method virtual receiveEvaluation : 'a -> unit
  method virtual getName : string
end

class ['a] accountant name =
object(self)
  inherit ['a] employee
  val name = name
  method receiveEvaluation rep = rep#visitAccountant self
  method getName = "A " ^ name
end

class ['a] salesman name =
object(self)
  inherit ['a] employee
  val name = name
  method receiveEvaluation rep = rep#visitSalesman self
  method getName = "S " ^ name
end

class virtual hrRep = 
object
  method virtual visitAccountant : hrRep accountant -> unit
  method virtual visitSalesman : hrRep salesman -> unit
end

class lowerLevelHRRep =
object
  inherit hrRep
  method visitAccountant a = print_endline ("Visiting accountant " ^ a#getName)
  method visitSalesman s = print_endline ("Visiting salesman " ^ s#getName)
end;;

let bob = new salesman "Bob";;
let mary = new accountant "Mary";;
let sue = new salesman "Sue";;
let h = new lowerLevelHRRep;;
bob#receiveEvaluation h;;
mary#receiveEvaluation h;;
sue#receiveEvaluation h;;

This returns:

Visiting salesman S Bob

Visiting accountant A Mary

Visiting salesman S Sue

The advantage of this solution is that employees do not need to know about the visitor, and therefore can be defined in their own compilation units, leading to cleaner code and less recompilation to do when adding new types of employees.