Re: [Caml-list] Polymorphic method question

[brogoff <brogoff@speakeasy.net>]

On Mon, 10 Jul 2006, Richard Jones wrote:

> On Mon, Jul 10, 2006 at 12:21:26PM -0700, brogoff wrote:
> > This type scheme cannot quantify 'a :
> > it escapes this scope.
>
> Check out this thread:
>
> http://caml.inria.fr/pub/ml-archives/caml-list/2005/02/a67b1a509263be01705305f36d64c39c.en.html
>
> Rich.

Hi Rich,

Thanks for the info, I guess I missed that one when it came out. Unfortunately,
the solution proposed, breaking the recursion by introducing some polymorphic
algebraic type to hold any kind of value in some class type to represent the
visitor, breaks the whole thing. There are just too many recursive
dependencies. Here's a more complete, but still small, example. The modules
are only there to show how the classes would go into files, they're not
essential.

PS: Before anyone tells me that algebraic data types are favored for this
over visitor classes, I'm well aware of all that, and in general agree
with those who prefer their ML sans OOP. However, I was trying to encode a
design pattern I read about somewhere (Felleisen?) which made good use of
polymorphic methods, only to find that it just doesn't translate into the OCaml
class system. The restriction on polymorphism in mutually recursive class
definitions makes the idea unworkable. Any possibility that restriction will be
lifted?

(* The following code won't work, but hopefully gives the idea *)

module Shape =
  struct
    class virtual ['a] shape_visitor =
      object
        method visit_square : square -> 'a
        method visit_rectangle : rectangle  -> 'a
        method visit_polygon :  polygon -> 'a
        method visit_translated : translated  -> 'a
        (* and potentially many more! *)
      end
    and virtual shape =
      object
        method virtual visit : 'a . 'a shape_visitor -> 'a
      end
    and square pt width =
      object (self)
        inherit shape
        method visit visitor = visitor#visit_square self

        method as_tuple : ((int * int) * (int * int)) =
          let (ll_x, ll_y) = pt in
          (pt, (ll_x + width, ll_y + width))

        method as_point_list : (int * int) list =
          failwith "Shape.square#as_point_list: unimplemented"
      end
    and rectangle ll ur =
      object (self)
        inherit shape
        method visit visitor = visitor#visit_rectangle self

        method as_tuple : ((int * int) * (int * int)) = (ll, ur)

        method as_point_list : (int * int) list =
          failwith "Shape.rectangle#as_point_list: unimplemented"
      end

    and polygon points =
      object (self)
        val points : (int * int) list = points
        inherit shape

        method visit visitor = visitor#visit_polygon self

        method as_point_list : (int * int) list =
          points
      end

    class translated pt s =
      object (self)
        inherit shape
        method visit visitor = visitor#visit_translated self

        method get_shape = s
        method get_translation = pt

        method as_point_list : (int * int) list =
          failwith "Shape.translated#as_point_list: unimplemented"
      end
  end (* module Shape *)

module Contains_point =
  struct
    (* Writing code that works over shapes *)
    class contains_point point =
      object
        inherit bool Shape.shape_visitor

        method make_contains_point p =
          new contains_point p

        method visit_square : Shape.square node -> bool =
          fun s ->
            let ((ll_x, ll_y), (ur_x, ur_y)) = s#as_tuple in
            let (x, y) = point in
            ll_x <= x && x <= ur_x && ll_y <= y && y <= ur_y

        method visit_rectangle : Shape.rectangle node  -> bool =
          fun r ->
            let ((ll_x, ll_y), (ur_x, ur_y)) = r#as_tuple in
            let (x, y) = point in
            ll_x <= x && x <= ur_x && ll_y <= y && y <= ur_y

        method visit_polygon : Shape.polygon node  -> bool =
          fun p ->
            failwith "Contains_point.contains_point#visit_polygon: unimplemented"

        method visit_translated : Shape.translated node  -> bool =
          fun t ->
            failwith "Contains_point.contains_point#visit_translated: unimplemented"
  end;;



-- 
-- Brian