Re: [Caml-list] Private types in 3.11, again

[Jacques Garrigue <garrigue@math.nagoya-u.ac.jp>]

From: Dario Teixeira <darioteixeira@yahoo.com>
> > So my question is how can I make the Foobar code behave as if it were
> > defined inside Node.  Based on a previous thread [1], I'm guessing there
> > is a solution, but I've been unable to hit on its exact formulation.
> 
> There have been no replies yet to my question, but I'm still stuck with
> this little problem.  The offending code is below; though it doesn't
> compile, I reckon that all it needs is a suitable type annotation.  I'm
> guessing this because the function capitalise_node function will compile
> fine if placed inside the Node module.  Any ideas on how to solve this?

The problem is much deeper than a simple annotation.
If you want capitalize_node to have a polymorphic type, while it is
based on operations that produce values with specific (non-polymorphic)
types, ideally you need something like GADTs. Unfortunately they are
not available in ocaml, so you have to provide the basic building
blocks in Node; i.e. you need a polymorphic function collecting
non-polymorphic values.

Here is some sample code. Note that I use an object here, but this is
only to be able to pass a polymorphic function for "bold" (a record
would have worked too). Also, the same code would probably work with
polymorphic variants, except for the "[`Nonlink] t" inside the
definition of "t" (polymorphic variants may only have regular types).

More practically, the "map" function in Node is not the map of lists:
it doesn't recurse on the structure of t. The recursion is rather done
inside "capitalize_node", by redefining bold and mref. You might want
to define such a generic recursive maker somewhere, but the point is
that you don't have to do it inside Node, and you keep full generality
(i.e. your make may choose to only recurse on Bold for instance...)

I hope this gives you some ideas on how to proceed.

Cheers,

Jacques Garrigue

module Node: sig
  type +'a t = private
    | Text of string
    | Bold of 'a t list
    | Href of string
    | Mref of string * [`Nonlink] t list

  val text: string -> [> `Nonlink ] t
  val bold: 'a t list -> 'a t
  val href: string -> [> `Link ] t
  val mref: string -> [ `Nonlink ] t list -> [> `Link ] t
  class maker : object
    method text: string -> [ `Nonlink ] t
    method bold: 'a t list -> 'a t
    method href: string -> [ `Link ] t
    method mref: string -> [ `Nonlink ] t list -> [ `Link ] t
  end
  val map: maker -> 'a t -> 'a t
end = struct
  type +'a t =
    | Text of string
    | Bold of 'a t list
    | Href of string
    | Mref of string * [`Nonlink] t list

  let text txt = Text txt
  let bold seq = Bold seq
  let href lnk = Href lnk
  let mref lnk seq = Mref (lnk, seq)
  class maker = object
    method text: string -> [ `Nonlink ] t = text
    method bold: 'a. 'a t list -> 'a t = bold
    method href: string -> [ `Link ] t = href
    method mref: string -> [ `Nonlink ] t list -> [ `Link ] t = mref
  end
  let rec map (m : maker) = function
      Text s -> (m#text s :> 'a t)
    | Bold l -> (m#bold l :> 'a t)
    | Href s -> (m#href s :> 'a t)
    | Mref (s, l) -> (m#mref s l :> 'a t)
  let map = (map : _ -> 'a t -> 'a t :> _ -> 'b t -> 'b t)
end

module Foobar: sig
  open Node
  val capitalise_node: 'a t -> 'a t
end = struct
  open Node
  let capitalise_node node =
    map
      (object (self) inherit maker
        method text txt = text (String.capitalize txt)
        method bold l = bold (List.map (map self) l)
        method mref s l = mref s (List.map (map self) l)
       end)
      node
end


# open Node;;
# Foobar.capitalise_node (mref "a" [bold [text "b"]; text "c"]);;
- : [> `Link ] Node.t = Mref ("a", [Bold [Text "B"]; Text "C"])