Modèle de conception de visiteur dans OCaml

Question

J'essaye d'implémenter le modèle de conception de visiteur en utilisant les constructions OO d'OCaml et le système de type et suis en train de rencontrer des problèmes lors de l'instanciation d'un élément.

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;; 

L'erreur que je reçois lors de la compilation est:

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

Cependant, le code compile moins la ligne instanciation du salesman.

Comment faire pour instancier le salesman tout en conservant la fonctionnalité des classes?

Modifier erreur reçu avec l'appel à receiveEvaluation:

This expression has type (<getName:string>, < getName:string>) lowerLevelHRRep 
but is here used with type <visitSalesman : 'a salesman -> unit > as 'a. 

Le deuxième type d'objet n'a pas de méthode visitAccountant.

Answer 1

EDIT - Séparer la réponse en 3 points principaux: la résolution de l'erreur de compilation initiale, une solution récursive et une solution paramétrisé

Résolution de l'erreur de compilation

de noter que votre code fonctionne bien au niveau supérieur:

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

Ce genre d'erreur est généralement compilation résolu en ajoutant une annotation de type pour aider le compilateur déterminer le type. Comme le niveau supérieur nous a gentiment dit ce que c'était, nous pouvons modifier l'instanciation:

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

Et cela compile!

Une solution récursive

Il est possible de réduire la complexité en utilisant des classes récursives. Cela supprime totalement le besoin de classes paramétrées, mais signifie que tous les objets doivent être définis dans le même fichier source.

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;; 

Ceci imprime "Visiting salesman". La coercition à l'employé est juste pour le rapprocher d'un scénario du monde réel.

Une solution paramétrisé

En regardant à nouveau le problème, je pense qu'il est pas nécessaire d'avoir un hrRep paramétrisé, parce qu'à ce moment, tous les autres types sont connus.En faisant juste la classe des employés paramétrées, je reçois ceci:

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;; 

Ce retour:

vendeur qui rend visite S Bob

Visite comptable A Mary

vendeur qui rend visite S Sue

L'avantage de cette solution est que les employés n'ont pas besoin de connaître le visiteur et peuvent donc être définis dans leurs propres unités de compilation. Pour obtenir un code plus propre et moins de recompilation à faire lors de l'ajout de nouveaux types d'employés.