Private types in 3.11, again

[Dario Teixeira <darioteixeira@yahoo.com>]

Hi,

(Note: this problem is similar to one I've posted before; there are however
differences.  Also, my apologies for the problem requiring a long introduction
before actually being presented).

Consider a sequence of nodes such as those present in an inline context in
XHTML.  Some of these nodes are leaf nodes (Text and Href), while others are
built from a list of existing nodes (Bold and Mref).  Moreover, some nodes
create hyperlinks (Href and Mref).  A straightforward Ocaml representation
could be as follows:


type node_t =
	| Text of string
	| Bold of node_t list			(* recursive! *)
	| Href of string
	| Mref of string * node_t list		(* recursive! *)


There is furthermore an important restriction: a link node may not be the
ancestor of another link node, no matter how deep the ancestry level (in
similarity with the W3C rules for XHTML).  While this restriction could be
enforced by runtime checking, I very much prefer to represent nodes in such
a way that the type system itself would ensure the impossibility of creating
illegal values.

Below is the best solution I could come up with so far (note that this code
requires 3.11).  It uses a phantom type to "taint" link nodes, making them
unsuitable to be descendants of other link nodes.  Also, note the use of
'private' to allow pattern-matching by external code without breaking the
phantom type restrictions.


module Node:
sig
	type node_t =
		private
		| Text of string
		| Bold of node_t list
		| Href of string
		| Mref of string * node_t list

	type +'a t = private node_t

	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
end =
struct
	type node_t =
		| Text of string
		| Bold of node_t list
		| Href of string
		| Mref of string * node_t list

	type +'a t = node_t

	let text txt = Text txt
	let bold seq = Bold seq
	let href lnk = Href lnk
	let mref lnk seq = Mref (lnk, seq)
end


So far so good.  Now consider a function that takes a node and returns
another node, in all identical except that all occurrences of Text (either
in the parent or in all descendants if the node is defined recursively)
are replaced by the capitalised version.  Moreover, I want to place this
function in a different module, called Foobar:


module Foobar:
sig
        open M
        val capitalise_node: 'a t -> 'a t
end =
struct
        open M
        let capitalise_node node =
                let rec capitalise_node_aux forbid_link node = match (forbid_link, node) with
                        | (_, Text txt)                 -> text (String.capitalize txt)
                        | (x, Bold seq)                 -> bold (List.map (capitalise_node_aux x) seq)
                        | (false, Href lnk)             -> href lnk
                        | (false, Mref (lnk, seq))      -> mref lnk (List.map (capitalise_node_aux true) seq)
                        | _                             -> failwith "oops"
                in capitalise_node_aux false node
end


Unfortunately, the code above fails to compile, producing this error:


Error: This expression has type [> `Link | `Nonlink ] M.t list
       but is here used with type [< `Nonlink ] M.t list
       The second variant type does not allow tag(s) `Link


For the Foobar module to work, I have to remove the 'private' declaration in
module Node, which of course breaks the phantom type.  Note that the function
above will also compile fine if it is defined inside Node instead of Foobar
(but which is useless to me).

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.


Thanks in advance for any light you may shed on this issue.  It is much
appreciated!

Kind regards,
Dario Teixeira


[1] http://groups.google.com/group/fa.caml/browse_thread/thread/d9c5e30b973db187#