Type errors in polymorphic OOP visitors

I’m trying to learn more about OCaml’s object system by implementing the classic OOP visitor pattern. Specifically, I’m trying to translate the code in this blog post: logji: Correcting the Visitor pattern.. A simplified version (in Java) goes as follows:

interface Tree {
  public <B> B accept(TreeVisitor<B> v);
}

interface TreeVisitor<B> {
  public B visitLeaf(Leaf t);
}

class Leaf implements Tree {
  public final int value;

  public Leaf(int value) {
    this.value = value;
  }

  public <B> B accept(TreeVisitor<B> v) {
    return v.visitLeaf(this);
  }
}

My naive translation doesn’t compile:

class virtual tree =
  object
    method virtual accept : 'a . 'a tree_visitor -> 'a
  end

and virtual ['a] tree_visitor =
  object
    method virtual visit_leaf : (leaf -> 'a)
  end

and leaf (i : int) =
  object (self)
    method get = i

    method accept (v : 'a tree_visitor) : 'a =
      v#visit_leaf (self :> leaf)
  end

The error I get is:

File "visitor.ml", line 3, characters 28-54:
3 |     method virtual accept : 'a . 'a tree_visitor -> 'a
                                ^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: The universal type variable 'a cannot be generalized:
       it escapes its scope.

When I leave off the 'a . it still doesn’t compile. How do I fix this example? I know of the visitor library, which is much more sophisticated than this, so I’m pretty sure there is a way to fix this. Any help would be appreciated!

(I should have added inherit tree in the leaf class, but the error message doesn’t change.)

I don’t know how to fix it purely with classes, but I am able to get this to work:

class virtual tree =
  object
    method virtual accept : 'a. (leaf -> 'a) -> 'a
  end

and leaf (i : int) =
  object (self)
    inherit tree
    method value = i
    method accept visitor = visitor (self :> leaf)
  end
1 Like

Is leaf a class or not? I can’t find a description of any special syntax for mutually-recursive classes.

Correction: OCaml - Objects in OCaml says that what you’ve written makes both tree and leaf classes.

An important point to keep in mind is that classes (and functions without explicit polymorphic annotations) are monomorphic while they are being defined. For instance,

class ['a] c (x:'a) = object
  method x = x
end
and  d = object
  method strange = (new c 0)#x
end

constrains the type of the class c to:

class ['a] c : 'a -> object constraint 'a = int method x : 'a end

because the mutually defined class d is using an int c instance of c.

Going back to the example at end:

class virtual tree = object
    method virtual accept : 'a . 'a tree_visitor -> 'a
  end

and virtual ['a] tree_visitor = object
    method virtual visit_leaf : (leaf -> 'a)
  end

and leaf (i : int) = object (self)
    method get = i
    method accept (v : 'a tree_visitor) : 'a = v#visit_leaf (self :> leaf)
  end

this means that we have tree different variables 'a in play:

  1. the local explicitly polymorphic 'a in method virtual accept : 'a . 'a tree_visitor -> 'a
  2. the global variable method virtual visit_leaf : (leaf -> 'a) bound in the class
    definition of tree_visitor
  3. the unbound global variable in the accept method accept (v : 'a tree_visitor) : 'a

The error message is telling us that the first explicitly polymorphic variables cannot escape its local scope by being unified the first global instance of 'a. Let’s fix that point by splitting the definition of tree_visitor out of the mutually recursive group:

class virtual ['a, 'leaf] tree_visitor = object
    method virtual visit_leaf :  'leaf -> 'a
  end

class virtual tree = object
    method virtual accept : 'a .  ('a, leaf) tree_visitor -> 'a
end

and leaf (i : int) = object (self:'self)
    method get = i

    method accept (v: ('a,leaf) tree_visitor): 'a =
      v#visit_leaf self
  end

with this change the error moves to the leaf class with

The method accept has type ('a, 'b) tree_visitor → 'a where 'a
is unbound

And indeed, with the current declaration, we declared that accept should work for some 'a tree_visitor without giving any indication of what is this 'a. The fix is thus to indicate that accept should work for any 'a:

and leaf (i : int) = object (self:'self)
    method get = i
    method accept: 'a. ('a, leaf) tree_visitor -> 'a = fun v ->
      v#visit_leaf self
  end

and with those two changes we don’t have conflicting view on 'a anymore, and the code compiles.

2 Likes

Thanks for the detailed response!

When I scale your approach up to the full problem, I get this:

class virtual ['a, 'empty, 'leaf, 'node] tree_visitor =
 object
   method virtual visit_empty :  'empty -> 'a
   method virtual visit_leaf :  'leaf -> 'a
   method virtual visit_node :  'node -> 'a
 end

class virtual tree =
  object
    method virtual accept : 'a .  ('a, empty, leaf, node) tree_visitor -> 'a
  end

and empty =
  object (self)
    method accept : 'a . ('a, empty, leaf, node) tree_visitor -> 'a =
      fun v -> v#visit_empty (self :> empty)
  end

and leaf (i : int) =
  object (self)
    method get = i
    method accept : 'a . ('a, empty, leaf, node) tree_visitor -> 'a =
      fun v -> v#visit_leaf (self :> leaf)
  end

and node (left : tree) (right : tree) =
  object (self)
    method get_left = left
    method get_right = right
    method accept : 'a . ('a, empty, leaf, node) tree_visitor -> 'a =
      fun v -> v#visit_node (self :> node)
  end

This compiles, but it’s not scalable in the sense that the Java solution was: every new subclass means a new type parameter.

Also, I can’t figure out how to use it. When I create a simple counter visitor:

class ['empty, 'leaf, 'node] counter =
  object (self)
    inherit ['a, 'empty, 'leaf, 'node] tree_visitor

    method visit_empty _ = 0
    method visit_leaf _ = 1
    method visit_node n =
      let l = n#get_left in
      let r = n#get_right in
      let vl = l#accept (self :> (int, empty, leaf, node) tree_visitor) in
      let vr = r#accept (self :> (int, empty, leaf, node) tree_visitor) in
        1 + vl + vr
  end

I get this type error:

43 |       let vl = l#accept (self :> (int, empty, leaf, node) tree_visitor) in
                              ^^^^
Error: This expression cannot be coerced to type
         (int, empty, leaf, node) tree_visitor =
           < visit_empty : empty -> int; visit_leaf : leaf -> int;
             visit_node : node -> int >;
       it has type
         < visit_empty : empty -> int; visit_leaf : leaf -> int;
           visit_node : < get_left : < accept : 'b -> 'c; .. >; get_right : 'd;
                          .. > ->
                        int;
           .. >
       but is here used with type
         (int, empty, leaf, node) #tree_visitor as 'e =
           < visit_empty : empty -> int; visit_leaf : leaf -> int;
             visit_node : node -> int; .. >
       Type < get_left : < accept : 'b -> 'c; .. >; get_right : 'd; .. >
       is not compatible with type
         node =
           < accept : 'a. ('a, empty, leaf, node) tree_visitor -> 'a;
             get_left : tree; get_right : tree >
       Type < accept : 'b -> 'c; .. > is not compatible with type
         tree = < accept : 'a. ('a, empty, leaf, node) tree_visitor -> 'a >
       Type 'b is not compatible with type
         ('a, empty, leaf, node) tree_visitor =
           < visit_empty : empty -> 'a; visit_leaf : leaf -> 'a;
             visit_node : node -> 'a >
       The universal variable 'a would escape its scope.
This simple coercion was not fully general.
Hint: Consider using a fully explicit coercion
of the form: `(foo : ty1 :> ty2)'.

Can this be fixed? Or am I just doing this wrong?

I am able to scale up to the full example using the same technique I showed before, just expanding with more functions to model the visitors of different cases:

class virtual tree =
  object
    method virtual accept
        : 'a.
          visit_empty:(empty -> 'a) ->
          visit_leaf:(leaf -> 'a) ->
          visit_node:(node -> 'a) ->
          'a
  end

and empty =
  object (self)
    inherit tree

    method accept ~visit_empty ~visit_leaf:_ ~visit_node:_ =
      visit_empty (self :> empty)
  end

and leaf (i : int) =
  object (self)
    inherit tree
    method value = i

    method accept ~visit_empty:_ ~visit_leaf ~visit_node:_ =
      visit_leaf (self :> leaf)
  end

and node (l : tree) (r : tree) =
  object (self)
    inherit tree
    method left = l
    method right = r

    method accept ~visit_empty:_ ~visit_leaf:_ ~visit_node =
      visit_node (self :> node)
  end

OK, so I used that to write a simple counter visitor:

let counter =
  let visit_empty _ = 0 in
  let visit_leaf _ = 1 in
  let rec visit_node n =
    let l = n#left in
    let r = n#right in
    let vl = l#accept ~visit_empty ~visit_leaf ~visit_node in
    let vr = r#accept ~visit_empty ~visit_leaf ~visit_node in
      1 + vl + vr
  in
    (visit_empty, visit_leaf, visit_node)

(* Doesn't work. *)
let test () =
  let e1 = new empty in
  let e2 = new leaf 1 in
  let e3 = new leaf 2 in
  let e4 = new node (e1 :> tree) (e2 :> tree) in
  let (_, _, vn) = counter in
    begin
      Printf.printf "%d\n" (vn e4)
    end

The counter value compiles, but the test function fails:

57 |       Printf.printf "%d\n" (vn e4)
                                    ^^
Error: This expression has type
         node =
           < accept : 'a.
                        visit_empty:(empty -> 'a) ->
                        visit_leaf:(leaf -> 'a) ->
                        visit_node:(node -> 'a) -> 'a;
             left : tree; right : tree >
       but an expression was expected of type
         < left : < accept : visit_empty:(empty -> int) ->
                             visit_leaf:('c -> int) ->
                             visit_node:('b -> int) -> int;
                    .. >;
           right : < accept : visit_empty:('d -> int) ->
                              visit_leaf:('e -> int) ->
                              visit_node:('b -> int) -> int;
                     .. >;
           .. >
         as 'b
       Type
         tree =
           < accept : 'a.
                        visit_empty:(empty -> 'a) ->
                        visit_leaf:(leaf -> 'a) ->
                        visit_node:(node -> 'a) -> 'a >
       is not compatible with type
         < accept : visit_empty:(empty -> int) ->
                    visit_leaf:('c -> int) ->
                    visit_node:(< left : 'f;
                                  right : < accept : visit_empty:('d -> int) ->
                                                     visit_leaf:('e -> int) ->
                                                     visit_node:'g -> int;
                                            .. >;
                                  .. > ->
                                int as 'g) ->
                    int;
           .. >
         as 'f
       Types for method accept are incompatible

I’m not sure what I’m doing wrong.

Once you have polymorphic methods, type inference become partial, and you will need to annotate every object with such method. In your test, this means writing the visitor as:

let counter =
  let visit_empty _ = ... in
  let visit_leaf _ = ... in
  let rec visit_node (n:node) = ... in
  (visit_empty, visit_leaf, visit_node)

with an annotation on the node n since you are using the polymorphic method accept on its left and right children.

Going back to the direct translation, it is indeed more efficient to use inheritance to define the type of the accept method once:

class virtual ['a, 'leaf, 'node, 'empty] open_tree_visitor = object
    method virtual visit_leaf :  'leaf -> 'a
    method virtual visit_node :  'node -> 'a
    method virtual visit_empty :  'empty -> 'a
end

class virtual tree = object
    method virtual accept : 'a .
      ('a, 'leaf, 'node, 'empty) open_tree_visitor -> 'a
end

and leaf (i : int) = object (self:'self)
    inherit tree
    method get = i
    method accept v = v#visit_leaf (self:> leaf)
 end
and node (x : tree) (y: tree) = object (self:'self)
    inherit tree
    method left = x
    method right = y
    method accept v = v#visit_node (self:> node)
  end
and empty = object (self:'self)
    inherit tree
    method accept v = v#visit_empty (self:>empty)
  end

which avoid the quadratic factor in the number of subclasses. (It is also possible to keep the same number of parameters in open_tree_visitor at the price of a constraint).
We can then define the standard tree visitor with:

class virtual ['a] tree_visitor = ['a, leaf, node, empty] open_tree_visitor

which is useful for defining visitor without getting lost in type parameters:

class counter = object(self)
  inherit [int] tree_visitor
  method visit_empty _ = 0
  method visit_leaf _ = 1
  method visit_node n =
    n#left#accept (self:>int tree_visitor)
    + n#right#accept (self:> int tree_visitor)
end

let test () =
  let e1 = new empty in
  let e2 = new leaf 1 in
  let e3 = new leaf 2 in
  let e4 = new node (e3 :> tree) (e2 :> tree) in
  e4#accept (new counter)
end
2 Likes

Thank you! This is what I wanted. The open_tree_visitor class is genius. I should have thought of that; I teach lectures on the Y combinator… :slight_smile:

What’s great about this is that the boilerplate is restricted to the open visitor class. I do wonder how Java gets away with just a single type parameter. (Perhaps it’s because everything in a .java file is automatically mutually recursive?) Anyway, this approach is definitely workable.

This works for me:

class virtual tree =
  object
    method virtual accept
        : 'a.
          visit_empty:(empty -> 'a) ->
          visit_leaf:(leaf -> 'a) ->
          visit_node:(node -> 'a) ->
          'a
  end

and empty =
  object (self)
    inherit tree

    method accept ~visit_empty ~visit_leaf:_ ~visit_node:_ =
      visit_empty (self :> empty)
  end

and leaf (i : int) =
  object (self)
    inherit tree
    method value = i

    method accept ~visit_empty:_ ~visit_leaf ~visit_node:_ =
      visit_leaf (self :> leaf)
  end

and node (l : tree) (r : tree) =
  object (self)
    inherit tree
    method left = l
    method right = r

    method accept ~visit_empty:_ ~visit_leaf:_ ~visit_node =
      visit_node (self :> node)
  end

let test () =
  let rec visit_empty _ = 0
  and visit_leaf _ = 1
  and visit_node (n : node) =
    n#left#accept ~visit_empty ~visit_leaf ~visit_node
    + n#right#accept ~visit_empty ~visit_leaf ~visit_node
  in
  let tree = new node (new empty) (new leaf 1 :> tree) in
  print_int (tree#accept ~visit_empty ~visit_leaf ~visit_node)

The key is to upcast n : node in the visit_node function.

1 Like

To me this example looks like an expressivity limitation in the combination of mutually-recursive classes and polymorphic methods, reminiscent of the distinction between regular and non-regular recursive type definitions.

From a language-design perspective this limitation is frustrating: OCaml accepts non-regular recursive type definitions, which before the introduction of GADTs had only very niche use-cases (now we need them), but rejects non-regular class declarations, which have idiomatic / well-known use-cases in OOP programming.

I created a bug report to discuss this limitation: mutually-recursive classes cannot have type parameters · Issue #12299 · ocaml/ocaml · GitHub .

I don’t know if this limitation is there due to a lack of resources (there are fewer users of object-oriented programming in OCaml, so relatively little interest in working on their type-checking to make it more complete and more complex) or due to fundamental soundness issues that would be caused by non-regular class declarations.

(I tried to find for past issues/reports, but I haven’t found any. This is surprising because I find it a natural thing to try, I would have expected to find past discussions of this limitation.)

3 Likes