Unquantifiable escaping type in variation of visitor pattern

Unquantifiable escaping type in variation of visitor pattern

[Christian Stork]

Hello,

I'm tying to implement a framework for visitors over trees (e.g. ASTs).
These trees are built according to some rules.  Rules are much like the
productions of a grammar.

The following minimal example demonstrates my current design problem:


    type 'rule node = { rule:'rule; kids:'rule node list } 

    class someRule =
    object (self)
      method accept
        : 'baton . someRule node -> 'baton visitor -> 'baton -> 'baton
        = fun n v b -> v#visitSomeRuleNode n b
    end
    and ['baton] visitor =
    object (self)
      method visitSomeRuleNode (n:someRule node) (b:'baton) =
        List.fold_left
          (fun b' k -> k.rule#accept k (self:>'baton visitor) b')
          b n.kids
    end
   
 
The idea is that nodes are simple records that refer to their specific
rule, have child nodes, and carry some additional data (not shown
above).  Rules and visitors are implemented as objects.  They are
responsible for implementing the accept & visitSomeRuleNode methods.  (In
the minimalistic example there's only one rule but there can/will be
many.)  

The above code has one special twist, it allows the visitor's visit...
methods to hand eachother some argument, called the baton.  Different
visitors might want to use different types of batons.  The above code
tries to support this by parametrizing the accept method and the
visitor class.  Sadly, Ocaml complains about then with 

    ...in method accept...
    This type scheme cannot quantify 'baton :
    it escapes this scope.

I don't really understand this error message.  I assume it has to do
with 'baton being a parameter in 'baton visitor and its use in
visitSomeRuleNode.  Any clarifications are welcome! :-)

Anyway, is there maybe a different, workable way to model this variation
of the visitor pattern in OCaml?

Thanks for you time,
Chris

-- 
Chris Stork   <>  Support eff.org!  <>   http://www.ics.uci.edu/~cstork/
OpenPGP fingerprint:  B08B 602C C806 C492 D069  021E 41F3 8C8D 50F9 CA2F

Re: [Caml-list] Unquantifiable escaping type in variation of visitor pattern

[John Prevost]

Hmm.  Would it be possible to include a more complete example (even if
it doesn't compile)--that is, one where the visitor actually performs
real work?  My suspicion is that you would be better off *not*
encoding this visitor pattern using objects, but since I'm not clear
on how you intend to use it, I can't give a concrete example.  (And
likewise even if objects are the best choice.)

John.

Re: [Caml-list] Unquantifiable escaping type in variation of visitor pattern

[Jacques Garrigue]

From: Christian Stork <cstork@ics.uci.edu>

> I'm tying to implement a framework for visitors over trees (e.g. ASTs).
> These trees are built according to some rules.  Rules are much like the
> productions of a grammar.

In general I would advice against using an object-oriented
representation for ASTs. Variant types are the proven approach to do
that in functional languages, and generally work much better.

> The following minimal example demonstrates my current design problem:
[...]
> The above code has one special twist, it allows the visitor's visit...
> methods to hand eachother some argument, called the baton.  Different
> visitors might want to use different types of batons.  The above code
> tries to support this by parametrizing the accept method and the
> visitor class.  Sadly, Ocaml complains about then with 

This specific typing problem can be solved.
It stems from the fact you are defining someRule and ['baton] visitor
simultaneously, but use 'baton polymorphically in someRule.
Inside mutual recursive definitions of classes, parameters cannot be
used polymorphically.
The way to a void this problem is to break the recursion.
The following code does what you want.

type 'rule node = { rule:'rule; kids:'rule node list } 

class type ['baton,'rule] visitor = object
  method visitSomeRuleNode : 'rule node -> 'baton -> 'baton
end

class someRule =
  object (self)
    method accept
      : 'baton . someRule node -> ('baton,someRule) visitor -> 'baton -> 'baton
      = fun n v b -> v#visitSomeRuleNode n b
  end

class ['baton] visitor_impl =
  object (self)
    method visitSomeRuleNode n (b : 'baton) =
      List.fold_left
        (fun b' k -> (k.rule : someRule)#accept k (self :> _ visitor_impl) b')
        b n.kids
  end

Jacques Garrigue

Re: [Caml-list] Unquantifiable escaping type in variation of visitor pattern

[Christian Stork]

[-- Attachment #1: Type: text/plain, Size: 3518 bytes --]

Jacques and John, thanks for your replies.  Sorry for the long delay in
responding, but this took me some time to figure out...

On Wed, Feb 09, 2005 at 10:53:50AM +0900, Jacques Garrigue wrote:
> From: Christian Stork <cstork@ics.uci.edu>

> > I'm tying to implement a framework for visitors over trees (e.g. ASTs).
> > These trees are built according to some rules.  Rules are much like the
> > productions of a grammar.

> In general I would advice against using an object-oriented
> representation for ASTs. Variant types are the proven approach to do
> that in functional languages, and generally work much better.

Right now I think that a combination works best in my case.  My problem
is different from regular ASTs because in my application (compression of
different kinds of ASTs) the grammar for the ASTs is not fixed and for
now I really only care about certain kinds nodes/rules.

> > The following minimal example demonstrates my current design problem:
> [...]
> > The above code has one special twist, it allows the visitor's visit...
> > methods to hand eachother some argument, called the baton.  Different
> > visitors might want to use different types of batons.  The above code
> > tries to support this by parametrizing the accept method and the
> > visitor class.  Sadly, Ocaml complains about then with 

> This specific typing problem can be solved.
> It stems from the fact you are defining someRule and ['baton] visitor
> simultaneously, but use 'baton polymorphically in someRule.
> Inside mutual recursive definitions of classes, parameters cannot be
> used polymorphically.
> The way to a void this problem is to break the recursion.
> The following code does what you want.

> type 'rule node = { rule:'rule; kids:'rule node list } 

> class type ['baton,'rule] visitor = object
>   method visitSomeRuleNode : 'rule node -> 'baton -> 'baton
> end

> class someRule =
>   object (self)
>     method accept
>       : 'baton . someRule node -> ('baton,someRule) visitor -> 'baton -> 'baton
>       = fun n v b -> v#visitSomeRuleNode n b
>   end

> class ['baton] visitor_impl =
>   object (self)
>     method visitSomeRuleNode n (b : 'baton) =
>       List.fold_left
>         (fun b' k -> (k.rule : someRule)#accept k (self :> _ visitor_impl) b')
>         b n.kids
>   end

Great, this compiles. :-)  The only problem is that I have more than one
rule which means many type parameters.  I also ran into some other
problems when I expanded the above code.  So in the end I followed your
advice and turned nodes into variants, but they still refer to a rule.
These rules can be used to differentiate among nodes of the same
variant.  So I guess I reached a kind of compromise between the two
programming paradigms (FP & OO).

On Tue, Feb 08, 2005 at 07:16:56PM -0500, John Prevost wrote:
> Hmm.  Would it be possible to include a more complete example (even if
> it doesn't compile)--that is, one where the visitor actually performs
> real work?  My suspicion is that you would be better off *not*
> encoding this visitor pattern using objects, but since I'm not clear
> on how you intend to use it, I can't give a concrete example.  (And
> likewise even if objects are the best choice.)

I attached a simplified but still lengthy version of my current design.

Any comments welcome (even if unrelated to the above points)!

Thanks,
Chris

-- 
Chris Stork   <>  Support eff.org!  <>   http://www.ics.uci.edu/~cstork/
OpenPGP fingerprint:  B08B 602C C806 C492 D069  021E 41F3 8C8D 50F9 CA2F

[-- Attachment #2: cat.ml --]
[-- Type: text/plain, Size: 8873 bytes --]

(** Framework for trees built according to a tree grammar
 * 
 * Here tree grammars can have rules of six different kinds:
 * - Terminal rules which correspond to empty leaf nodes
 *   Ex:  trule
 * - Integer rules which correspond to leaf nodes containing an integer
 *   Ex:  irule = INTEGER
 * - String rules which correspond to leaf nodes containing a string
 *   Ex:  srule = STRING
 * - Aggregate rules which correspond to nodes that have a fixed number
 *   of child nodes.  Children are ordered and their corresponding rules
 *   are given in the aggregate rule.
 *   Ex:  arule = rule1 rule2 ... ruleN
 * - Choice rules which correspond to nodes that have one child which
 *   has a corresponding rule as given by the choice rule.
 *   Ex:  crule = rule1 | rule2 | ... | ruleN
 * - List rules which correspond to nodes that have zero or more children
 *   of a given rule.
 *   Ex:  lrule = rule*
 *
 * This framework is written so that grammars (ie sets of rules) can
 * be easily changed or even generated at runtime.  An actual rules is
 * an objects of one of the classes representing the above six kinds
 * of rules.  Rules and visitors are implemented as objects for best
 * code reuse.
 *
 * All this is relatively close to dealing with ASTs except that the
 * grammar is not static.
 * 
 *)

(** We need to parametrize the node type with all rule classes in
    order to work around the fact that OCaml does not support mutually
    recusive definitions of types and classes.  Eeech! *)

(** The parametrized version of the node type *)
type ('tr,'ir,'sr,'ar,'cr,'lr) node' = 
  | NTerm   of 'tr *  ('tr,'ir,'sr,'ar,'cr,'lr) nCommon' 
  | NInt    of 'ir *  ('tr,'ir,'sr,'ar,'cr,'lr) nCommon' 
      * int64 option ref
  | NStr    of 'sr *  ('tr,'ir,'sr,'ar,'cr,'lr) nCommon' 
      * string option ref
  | NAggr   of 'ar *  ('tr,'ir,'sr,'ar,'cr,'lr) nCommon' 
      * ('tr,'ir,'sr,'ar,'cr,'lr) node' list ref
  | NChoice of 'cr *  ('tr,'ir,'sr,'ar,'cr,'lr) nCommon' 
      * ('tr,'ir,'sr,'ar,'cr,'lr) node' option ref
  | NList   of 'lr *  ('tr,'ir,'sr,'ar,'cr,'lr) nCommon' 
      * ('tr,'ir,'sr,'ar,'cr,'lr) node' list ref

(** Common attributes of nodes are collected in this record *)
and  ('tr,'ir,'sr,'ar,'cr,'lr) nCommon' = {
  parent : ('tr,'ir,'sr,'ar,'cr,'lr) node' option ref;
  myself : ('tr,'ir,'sr,'ar,'cr,'lr) node';
}

(** All the different kinds of rules follow. *)

(** This abstract base class gathers common functionality of rules *)
class virtual abstractRule (name:string) =
object (self)
  method name = name
end
(** Terminal rules *)
and termRule name =
object (self)
  inherit abstractRule name
  method kind = "terminalRule"
  method to_string = name ^ "."
  method makeTermNode 
    (parent : (termRule,intRule,strRule,aggrRule,choiceRule,listRule) 
       node' option)
    = let rec n = NTerm ((self :> termRule), {parent=ref parent; myself=n})
    in n
end
(** Integer rules *)
and intRule name =
object (self)
  inherit abstractRule name
  method kind = "integerRule"
  method to_string = name ^ " =^= INTEGER."
  method makeIntNode 
    (parent : (termRule,intRule,strRule,aggrRule,choiceRule,listRule) 
       node' option)
    int_opt
    = let rec n = NInt ((self :> intRule), {parent=ref parent; myself=n},
                        ref int_opt)
    in n
end
(** String rules *)
and strRule name =
object (self)
  inherit abstractRule name
  method kind = "stringRule"
  method to_string = name ^ " =^= STRING."
  method makeStrNode 
    (parent : (termRule,intRule,strRule,aggrRule,choiceRule,listRule) 
       node' option)
    str_opt
    = let rec n = NStr ((self :> strRule), {parent=ref parent; myself=n},
                        ref str_opt)
    in n
end
(** Aggregate rules *)
and aggrRule name =
object (self)
  inherit abstractRule name
  method kind = "aggregateRule"
  val mutable parts = ([] : abstractRule list)
  method parts = parts
  method initParts parts' = parts <- parts'
  method to_string = name ^ " =^= "
    ^ (String.concat "; " (List.map (fun p -> p#name) parts)) ^ "."
  method makeAggrNode 
    (parent : (termRule,intRule,strRule,aggrRule,choiceRule,listRule) 
       node' option)
    kid_list
    = let rec n = NAggr ((self :> aggrRule), {parent=ref parent; myself=n},
                         ref kid_list)
    in n
end
(** Choice rules *)
and choiceRule name =
object (self)
  inherit abstractRule name
  method kind = "choiceRule"
  val mutable alts = ([] : abstractRule list)
  method alts = alts
  method initAlts alts' = alts <- alts'
  method to_string = name ^ " =^= " 
    ^ (String.concat " | " (List.map (fun a -> a#name) alts)) ^ "."
  method makeChoiceNode 
    (parent : (termRule,intRule,strRule,aggrRule,choiceRule,listRule) 
       node' option)
    kid_opt
    = let rec n = NChoice ((self :> choiceRule), {parent=ref parent; 
                                                  myself=n},
                           ref kid_opt)
    in n
end
(** List rules *)
and listRule name =
object (self)
  inherit abstractRule name
  method kind = "listRule"
  val mutable item = (None : abstractRule option)
  method item : abstractRule option = item
  method initItem item' = item <- Some item'
  method to_string = name ^ " =^= (" ^ 
    (match item with None -> "<NOT-YET-DEFINED>" | Some i -> i#name) 
    ^ ")*."
  method makeListNode 
    (parent : (termRule,intRule,strRule,aggrRule,choiceRule,listRule) 
       node' option)
    kid_list
    = let rec n = NList ((self :> listRule), {parent=ref parent; myself=n},
                         ref kid_list)
    in n
end

(* Finally shorter types *)
type node = 
    (termRule,intRule,strRule,aggrRule,choiceRule,listRule) node'
type nCommon = 
    (termRule,intRule,strRule,aggrRule,choiceRule,listRule) nCommon'


class type ['baton] visitorIface =
object
  method visitTermNode 
    : termRule -> nCommon -> 'baton -> 'baton 
  method visitIntNode 
    : intRule -> nCommon -> int64 option -> 'baton -> 'baton 
  method visitStrNode 
    :  strRule -> nCommon -> string option -> 'baton -> 'baton 
  method visitAggrNode 
    : aggrRule -> nCommon -> node list -> 'baton -> 'baton
  method visitChoiceNode 
    : choiceRule -> nCommon -> node option -> 'baton -> 'baton
  method visitListNode 
    : listRule -> nCommon -> node list -> 'baton -> 'baton
end

let accept (n:node) (v:'baton visitorIface) (b:'baton) =
  match n with
    | NTerm   (tr,c)    -> v#visitTermNode   tr c     b
    | NInt    (ir,c,io) -> v#visitIntNode    ir c !io b
    | NStr    (sr,c,so) -> v#visitStrNode    sr c !so b
    | NAggr   (ar,c,ks) -> v#visitAggrNode   ar c !ks b
    | NChoice (cr,c,ko) -> v#visitChoiceNode cr c !ko b
    | NList   (lr,c,ks) -> v#visitListNode   lr c !ks b


class ['baton] defaultVisitor =
object (self : 'baton #visitorIface)
  method visitTermNode   r c    b = b
  method visitIntNode    r c io b = b
  method visitStrNode    r c so b = b
  method visitAggrNode   r c kl b =
    List.fold_left
      (fun b k -> accept k (self :> _ defaultVisitor) b)
      b kl
  method visitChoiceNode r c ko b =
    match ko with
        None -> b
      | Some k -> accept k (self :> _ defaultVisitor) b
  method visitListNode   r c kl b =
    List.fold_left
      (fun b k -> accept k (self :> _ defaultVisitor) b)
      b kl
end

class summingVisitor =
object 
  inherit [int64] defaultVisitor
  method visitIntNode _ _ io b =
    match io with
        None -> b (* treat no integer as 0 *)
      | Some i -> Int64.add b i
end


class printingVisitor out =
object (self : _ #visitorIface)
  inherit [_] defaultVisitor as super
  method private indline out s indent=
    for i=0 to indent-1 do output_string out "  " done;
    output_string out (s ^ "\n")
  method visitTermNode r _ (ind,limit) =
    if limit = 0 then output_string out "...\n"
    else self#indline out ("terminal: " ^ r#name) ind;
    (ind,limit)
  method visitIntNode r _ io (ind,limit) =
    if limit = 0 then output_string out "...\n"
    else self#indline out ("integer: " ^ r#name ^ " " ^ match io with 
                          None -> "<UNINITIALIZED-INT>"
                        | Some i -> (Int64.to_string i)) 
      ind;
    (ind,limit)
  method visitAggrNode r c ks (ind,limit) =
    if limit = 0 
    then begin output_string out "...\n"; (ind,limit) end
    else begin self#indline out ("aggregate: " ^ r#name) ind;
      super#visitAggrNode r c ks(ind+1,limit-1) end
  method visitChoiceNode r c ko (ind,limit) =
    if limit = 0 
    then begin output_string out "...\n"; (ind,limit) end
    else begin self#indline out ("choice: " ^ r#name) ind;
      super#visitChoiceNode r c ko (ind+1,limit-1) end
  method visitListNode r c ks (ind,limit) =
    if limit = 0 
    then begin output_string out "...\n"; (ind,limit) end
    else begin self#indline out ("aggregate: " ^ r#name) ind;
      super#visitListNode r c ks(ind+1,limit-1) end
end

Re: [Caml-list] Unquantifiable escaping type in variation of visitor pattern

[Jacques Garrigue]

From: Christian Stork <cstork@ics.uci.edu>

> > In general I would advice against using an object-oriented
> > representation for ASTs. Variant types are the proven approach to do
> > that in functional languages, and generally work much better.
> 
> Right now I think that a combination works best in my case.  My problem
> is different from regular ASTs because in my application (compression of
> different kinds of ASTs) the grammar for the ASTs is not fixed and for
> now I really only care about certain kinds nodes/rules.

I read your code, but couldn't completely understand what you are
trying to do. It looks very imperative in flavor, with lots of
mutables and refs all over the place. Maybe you should first try to
write some standard AST code (purely functional), and then try to see
how you can adapt it to your problem. Even if you need extensibility,
you should not need mutability. Also, there are known ways to handle
extensible languages, using polymorphic variants for instance.
  http://wwwfun.kurims.kyoto-u.ac.jp/~garrigue/papers/fose2000.html
or even objects
  http://cristal.inria.fr/~remy/work/expr/

> Great, this compiles. :-)  The only problem is that I have more than one
> rule which means many type parameters.  I also ran into some other
> problems when I expanded the above code.  So in the end I followed your
> advice and turned nodes into variants, but they still refer to a rule.
> These rules can be used to differentiate among nodes of the same
> variant.  So I guess I reached a kind of compromise between the two
> programming paradigms (FP & OO).

I hope this can still be improved a lot.
If you want to keep this design, you can at least reduce the number of
parameters by collecting them in a single one.
Note that I reported, a few months ago, a bug in ocaml up to 3.08.2,
which means that this kind of parameter collecting is unsafe when
combined with subtyping. This is fixed in CVS and 3.08.3. But in your
particular example there is no subtyping at all, so there should be no
problem anyway.
I attach the modified part of your example, which uses a few tricks to
make the code much less verbose.

---------------------------------------------------------------------------
Jacques Garrigue      Nagoya University     garrigue at math.nagoya-u.ac.jp
		<A HREF=http://wwwfun.kurims.kyoto-u.ac.jp/~garrigue/>JG</A>

(** The parametrized version of the node type *)
type 'a node' = 
  | NTerm   of 'tr * 'a nCommon' 
  | NInt    of 'ir * 'a nCommon' * int64 option ref
  | NStr    of 'sr * 'a nCommon' * string option ref
  | NAggr   of 'ar * 'a nCommon' * 'a node' list ref
  | NChoice of 'cr * 'a nCommon' * 'a node' option ref
  | NList   of 'lr * 'a nCommon' * 'a node' list ref
  constraint 'a = <term:'tr; int:'ir; str:'sr; aggr:'ar; choice:'cr; list:'lr>

(** Common attributes of nodes are collected in this record *)
and 'a nCommon' = {
  parent : 'a node' option ref;
  myself : 'a node';
} constraint 'a = <term:'tr; int:'ir; str:'sr; aggr:'ar; choice:'cr; list:'lr>

(** All the different kinds of rules follow. *)

(** This abstract base class gathers common functionality of rules *)
class virtual abstractRule (name:string) =
object (self)
  method name = name
end
and virtual rules = object
    (self : <term:termRule; int:intRule; str:strRule; aggr:aggrRule;
             choice:choiceRule; list:listRule; ..>)
end
(** Terminal rules *)
and termRule name =
object (self)
  inherit abstractRule name
  method kind = "terminalRule"
  method to_string = name ^ "."
  method makeTermNode (parent : rules node' option) =
    let rec n = NTerm ((self :> termRule), {parent=ref parent; myself=n})
    in n
end
(** Integer rules *)
and intRule name =
object (self)
  inherit abstractRule name
  method kind = "integerRule"
  method to_string = name ^ " =^= INTEGER."
  method makeIntNode (parent : rules node' option) int_opt =
    let rec n = NInt ((self :> intRule), {parent=ref parent; myself=n},
                      ref int_opt)
    in n
end
(** String rules *)
and strRule name =
object (self)
  inherit abstractRule name
  method kind = "stringRule"
  method to_string = name ^ " =^= STRING."
  method makeStrNode (parent : rules node' option) str_opt =
    let rec n = NStr ((self :> strRule), {parent=ref parent; myself=n},
                      ref str_opt)
    in n
end
(** Aggregate rules *)
and aggrRule name =
object (self)
  inherit abstractRule name
  method kind = "aggregateRule"
  val mutable parts = ([] : abstractRule list)
  method parts = parts
  method initParts parts' = parts <- parts'
  method to_string = name ^ " =^= "
    ^ (String.concat "; " (List.map (fun p -> p#name) parts)) ^ "."
  method makeAggrNode (parent : rules node' option) kid_list =
    let rec n = NAggr ((self :> aggrRule), {parent=ref parent; myself=n},
                       ref kid_list)
    in n
end
(** Choice rules *)
and choiceRule name =
object (self)
  inherit abstractRule name
  method kind = "choiceRule"
  val mutable alts = ([] : abstractRule list)
  method alts = alts
  method initAlts alts' = alts <- alts'
  method to_string = name ^ " =^= " 
    ^ (String.concat " | " (List.map (fun a -> a#name) alts)) ^ "."
  method makeChoiceNode (parent : rules node' option) kid_opt =
    let rec n = NChoice ((self :> choiceRule), {parent=ref parent; 
                                                myself=n},
                         ref kid_opt)
    in n
end
(** List rules *)
and listRule name =
object (self)
  inherit abstractRule name
  method kind = "listRule"
  val mutable item = (None : abstractRule option)
  method item : abstractRule option = item
  method initItem item' = item <- Some item'
  method to_string = name ^ " =^= (" ^ 
    (match item with None -> "<NOT-YET-DEFINED>" | Some i -> i#name) 
    ^ ")*."
  method makeListNode (parent : rules node' option) kid_list =
    let rec n = NList ((self :> listRule), {parent=ref parent; myself=n},
                       ref kid_list)
    in n
end

(* Finally shorter types *)
type node = rules node'
type nCommon = rules nCommon'

Re: [Caml-list] Unquantifiable escaping type in variation of visitor pattern

[Christian Stork]

[-- Attachment #1: Type: text/plain, Size: 3985 bytes --]

Hello Jacques,

Thanks a lot for your reply.  This is very helpful.

On Wed, Feb 23, 2005 at 12:08:15PM +0900, Jacques Garrigue wrote:
> From: Christian Stork <cstork@ics.uci.edu>
...
> I read your code, but couldn't completely understand what you are
> trying to do. It looks very imperative in flavor, with lots of
> mutables and refs all over the place.

It's not that I didn't try otherwise.  These are the reasons (I attached
illustrative code):

- The mutable parts/alts/item fields in aggrRule/choiceRule/listRule
  seem necessary since I cannot define grammars (ie recursively defined
  objects).  Object instantiation is not allowed to the right of a let
  rec!  
  
  "This kind of expression is not allowed as right-hand side of `let rec'"
  
  I saw the reasoning for this documented in the manual and it seems
  that my only choice, if I want to stick to modelling rules with
  objects, is to break he recurrence with refs.  Not pretty but
  seems necessary if I want to be able to generate grammars at runtime
  which are base on a parsed DTD, for example.
  
- The refs in the node variants are (probably) needed since I will need
  to instantiate nodes before attached data/children are determined.  I
  didn't explain this in my previous emails and I am not yet 100% sure
  that I really need it.
  
  For example, the parent ref in nCommon could be unnecessary but when I
  used the make...Node methods to create a tree OCaml complained again
  that it does not allow me to use object instantiation on the
  right-hand side of let rec. 
  
  It seems that I have to write (after removing all the refs in the
  types):

    let rec (t:node) = 
      NChoice (exp, {parent=None; myself=t}, Some (
        let rec (i:node) = 
          NInt (intLit, {parent=(Some t); myself=i}, Some (
            Int64.of_int 0))
        in i));;
    
  Not pretty either, but functional.  The only drawback now is that I
  might need more flexibility in creating parent nodes independently.
  I'll get back to you once I know. 

> Maybe you should first try to
> write some standard AST code (purely functional), and then try to see
> how you can adapt it to your problem. Even if you need extensibility,
> you should not need mutability. Also, there are known ways to handle
> extensible languages, using polymorphic variants for instance.
>   http://wwwfun.kurims.kyoto-u.ac.jp/~garrigue/papers/fose2000.html
> or even objects
>   http://cristal.inria.fr/~remy/work/expr/

Thanks for the references.  I'll look at them.  (Actually I looked at
polymorphic variants (including your web page) already and I could not
see the immediate benefit for my problem and it seemed to me that it is
very easy to switch over from "monomorphic variants" once the need
becomes evident.)

...
> I hope this can still be improved a lot.

I'm all for it, but it depends on the answers to the above points. :-)

> If you want to keep this design, you can at least reduce the number of
> parameters by collecting them in a single one.
> Note that I reported, a few months ago, a bug in ocaml up to 3.08.2,
> which means that this kind of parameter collecting is unsafe when
> combined with subtyping. This is fixed in CVS and 3.08.3.

(Does that mean that 3.08.3 will be released soon?)

> But in your particular example there is no subtyping at all, so there
> should be no problem anyway.

I don't know which particular subtyping you refer to, but, of course, I
intend to subtype the rules and visitors.

> I attach the modified part of your example, which uses a few tricks to
> make the code much less verbose.

Hmm, are these tricks documentd anywhere?  I didn't even see the option
to use constraints in regular variant types in the official OCaml
manual.  Anyway, thanks a lot for the improvements.

Some examplary code attached.  Thanks,
Chris

-- 
Chris Stork   <>  Support eff.org!  <>   http://www.ics.uci.edu/~cstork/
OpenPGP fingerprint:  B08B 602C C806 C492 D069  021E 41F3 8C8D 50F9 CA2F

[-- Attachment #2: reply.ml --]
[-- Type: text/plain, Size: 5939 bytes --]

(** The parametrized version of the node type *)
type 'a node' = 
  | NTerm   of 'tr * 'a nCommon' 
  | NInt    of 'ir * 'a nCommon' * int64 option ref
  | NStr    of 'sr * 'a nCommon' * string option ref
  | NAggr   of 'ar * 'a nCommon' * 'a node' list ref
  | NChoice of 'cr * 'a nCommon' * 'a node' option ref
  | NList   of 'lr * 'a nCommon' * 'a node' list ref
  constraint 'a = <term:'tr; int:'ir; str:'sr; aggr:'ar; choice:'cr; list:'lr>

(** Common attributes of nodes are collected in this record *)
and 'a nCommon' = {
  parent : 'a node' option ref;
  myself : 'a node';
} constraint 'a = <term:'tr; int:'ir; str:'sr; aggr:'ar; choice:'cr; list:'lr>

(** All the different kinds of rules follow. *)

(** This abstract base class gathers common functionality of rules *)
class virtual abstractRule (name:string) =
object (self)
  method name = name
end
and virtual rules = object
    (self : <term:termRule; int:intRule; str:strRule; aggr:aggrRule;
             choice:choiceRule; list:listRule; ..>)
end
(** Terminal rules *)
and termRule name =
object (self)
  inherit abstractRule name
  method kind = "terminalRule"
  method to_string = name ^ "."
  method makeTermNode (parent : rules node' option) =
    let rec n = NTerm ((self :> termRule), {parent=ref parent; myself=n})
    in n
end
(** Integer rules *)
and intRule name =
object (self)
  inherit abstractRule name
  method kind = "integerRule"
  method to_string = name ^ " =^= INTEGER."
  method makeIntNode (parent : rules node' option) int_opt =
    let rec n = NInt ((self :> intRule), {parent=ref parent; myself=n},
                      ref int_opt)
    in n
end
(** String rules *)
and strRule name =
object (self)
  inherit abstractRule name
  method kind = "stringRule"
  method to_string = name ^ " =^= STRING."
  method makeStrNode (parent : rules node' option) str_opt =
    let rec n = NStr ((self :> strRule), {parent=ref parent; myself=n},
                      ref str_opt)
    in n
end
(** Aggregate rules *)
and aggrRule name =
object (self)
  inherit abstractRule name
  method kind = "aggregateRule"
  val mutable parts = ([] : abstractRule list)
  method parts = parts
  method initParts parts' = parts <- parts'
  method to_string = name ^ " =^= "
    ^ (String.concat "; " (List.map (fun p -> p#name) parts)) ^ "."
  method makeAggrNode (parent : rules node' option) kid_list =
    let rec n = NAggr ((self :> aggrRule), {parent=ref parent; myself=n},
                       ref kid_list)
    in n
end
(** Choice rules *)
and choiceRule name =
object (self)
  inherit abstractRule name
  method kind = "choiceRule"
  val mutable alts = ([] : abstractRule list)
  method alts = alts
  method initAlts alts' = alts <- alts'
  method to_string = name ^ " =^= " 
    ^ (String.concat " | " (List.map (fun a -> a#name) alts)) ^ "."
  method makeChoiceNode (parent : rules node' option) kid_opt =
    let rec n = NChoice ((self :> choiceRule), {parent=ref parent; 
                                                myself=n},
                         ref kid_opt)
    in n
end
(** List rules *)
and listRule name =
object (self)
  inherit abstractRule name
  method kind = "listRule"
  val mutable item = (None : abstractRule option)
  method item : abstractRule option = item
  method initItem item' = item <- Some item'
  method to_string = name ^ " =^= (" ^ 
    (match item with None -> "<NOT-YET-DEFINED>" | Some i -> i#name) 
    ^ ")*."
  method makeListNode (parent : rules node' option) kid_list =
    let rec n = NList ((self :> listRule), {parent=ref parent; myself=n},
                       ref kid_list)
    in n
end

(* Finally shorter types *)
type node = rules node'
type nCommon = rules nCommon'


(*** Re mutable rule fields  ***)

(* This is how I end up generating grammars at runtime. *)
(* Simple Test Grammar for plus/times expressions *)
  let exp = new choiceRule "exp"
  let intLit = new intRule "intLit"
  let binExp = new aggrRule "binExp"
  let binOp = new choiceRule "binOp"
  let plusOp = new termRule "plusOp"
  let timesOp = new termRule "timesOp"
  let startrule = exp;;
  exp#initAlts [
    (intLit :> abstractRule);
    (binExp :> abstractRule);
  ];;
  binExp#initParts[
    (exp :> abstractRule);
    (binOp :> abstractRule);
    (exp :> abstractRule)
  ];;
  binOp#initAlts [
    (plusOp :> abstractRule);
    (timesOp :> abstractRule);
  ];;


(*** Re parent ref cell in nCommon ***)

(* Simple Test Tree for the expression with the int litereral "0" *)

(* This is how I intended to write it but it does not compile due to
   "This kind of expression is not allowed as right-hand side of `let rec'" 
   which is interesting since it does not contain a new statement. *)

(*
let rec t = exp#makeChoiceNode None
  (Some (intLit#makeIntNode (Some t)
           (Some (Int64.of_int 3))));;
*)

(* The tree can be generated and later fixed like this, 
   but this requires parent refs: *)

let t = exp#makeChoiceNode None
  (Some (intLit#makeIntNode None
           (Some (Int64.of_int 3))));;

(* helpers for fixParents below *)
let common = function
    | NTerm   (_,c)
    | NInt    (_,c,_)
    | NStr    (_,c,_)
    | NAggr   (_,c,_)
    | NChoice (_,c,_)
    | NList   (_,c,_) -> c
let kids = function
    | NTerm   (_,_)
    | NInt    (_,_,_)
    | NStr    (_,_,_)
    | NChoice (_,_,{contents=None}) -> []
    | NChoice (_,_,{contents=Some k}) -> [k]
    | NAggr   (_,_,{contents=ks})
    | NList   (_,_,{contents=ks}) -> ks

let rec fixParents (p:node option) (n:node) =
  (common n).parent := p;
  List.iter (fun k -> fixParents (Some n) k) (kids n);;

fixParents None t;;

(* I guess this is how it should be done.  
   No need to put parent in a ref if trees can always be defined like this: *)

let rec (t:node) = 
  NChoice (exp, {parent=ref None; myself=t}, (ref (Some (
    let rec (i:node) = 
      NInt (intLit, {parent=ref (Some t); myself=i}, ref (Some (
        Int64.of_int 0)))
    in i))));;

Re: [Caml-list] Unquantifiable escaping type in variation of visitor pattern

[Jacques Garrigue]

From: Christian Stork <cstork@ics.uci.edu>

> It's not that I didn't try otherwise.  These are the reasons (I attached
> illustrative code):
> 
> - The mutable parts/alts/item fields in aggrRule/choiceRule/listRule
>   seem necessary since I cannot define grammars (ie recursively defined
>   objects).  Object instantiation is not allowed to the right of a let
>   rec!  
>   
>   "This kind of expression is not allowed as right-hand side of `let rec'"

The alternative is to use "lazy", which has the extra advantage of
being covariant.

> (Does that mean that 3.08.3 will be released soon?)

There was supposed to be a "Valentine day release", but clearly it
didn't happen.

> > But in your particular example there is no subtyping at all, so there
> > should be no problem anyway.
> 
> I don't know which particular subtyping you refer to, but, of course, I
> intend to subtype the rules and visitors.

Well, as long as you use refs in your definitions, subtyping is
impossible on nodes.
You may of course subclass rules, but then you won't need to use
explicit subtyping either, since it is already done in your make*Node
methods through a self-coercion.
So the specific problem I was writing about should not happen.

> > I attach the modified part of your example, which uses a few tricks to
> > make the code much less verbose.
> 
> Hmm, are these tricks documentd anywhere?  I didn't even see the option
> to use constraints in regular variant types in the official OCaml
> manual.  Anyway, thanks a lot for the improvements.

They are in the reference part of the manual.
In the tutorial, they only appear for objects, which is what they were
originally introduced for.
Somehow it's fortunate that these tricks are not well publicized,
since they trigger a bug. On the other hand the bug could have been
corrected earlier...

Jacques Garrigue

Re: [Caml-list] Unquantifiable escaping type in variation of visitor pattern

[Jacques Garrigue]

[-- Attachment #1: Type: Text/Plain, Size: 1215 bytes --]

From: Christian Stork <cstork@ics.uci.edu>

> > But in your particular example there is no subtyping at all, so there
> > should be no problem anyway.
> 
> I don't know which particular subtyping you refer to, but, of course, I
> intend to subtype the rules and visitors.

I should have looked at your code. Indeed you're using subtyping, but
not on nodes, so it's ok.

Yet I still don't understand what your code is about.
I see nothing specific in your classes, justifying using
object-orientation rather than normal variants.
Also, the way you're coercing to an abstract rule, you're forgetting
all useful information, to keep only the rule name.
I don't see how you can make any useful use of that.

Anyway, one can get rid at least part of the recursion, by
restructuring your types in a more standard way: putting the common
parts outside rather than inside.
And why do you need your nodes to refer to their parent?
When you walk the tree, it is clear who the parent is.

Here is a slightly modified (more readable) version of your code, but
I still don't see the point.

What about having a look at a more functional view on DTD's, like in
xmllight.
   http://tech.motion-twin.com/xmllight

Jacques Garrigue

[-- Attachment #2: reply.ml --]
[-- Type: Text/Plain, Size: 5270 bytes --]

(** The parametrized version of the node type *)
type 'a node_desc = 
  | NTerm   of 'tr 
  | NInt    of 'ir * int64 option ref
  | NStr    of 'sr * string option ref
  | NAggr   of 'ar * 'a node' list ref
  | NChoice of 'cr * 'a node' option ref
  | NList   of 'lr * 'a node' list ref
  constraint 'a = <term:'tr; int:'ir; str:'sr; aggr:'ar; choice:'cr; list:'lr>

(** Common attributes of nodes are collected in this record *)
and 'a node' = {
  desc : 'a node_desc;
  mutable parent : 'a node' option;
} constraint 'a = <term:'tr; int:'ir; str:'sr; aggr:'ar; choice:'cr; list:'lr>

(** All the different kinds of rules follow. *)

(** This abstract base class gathers common functionality of rules *)
class virtual abstractRule (name:string) =
object (self)
  method name = name
end
and virtual rules = object
    (self : <term:termRule; int:intRule; str:strRule; aggr:aggrRule;
             choice:choiceRule; list:listRule; ..>)
end
(** Terminal rules *)
and termRule name =
object (self)
  inherit abstractRule name
  method kind = "terminalRule"
  method to_string = name ^ "."
  method makeTermNode (parent : rules node' option) =
    {desc = NTerm(self :> termRule); parent = parent}
end
(** Integer rules *)
and intRule name =
object (self)
  inherit abstractRule name
  method kind = "integerRule"
  method to_string = name ^ " =^= INTEGER."
  method makeIntNode (parent : rules node' option) int_opt =
    {desc = NInt ((self :> intRule), ref int_opt); parent = parent}
end
(** String rules *)
and strRule name =
object (self)
  inherit abstractRule name
  method kind = "stringRule"
  method to_string = name ^ " =^= STRING."
  method makeStrNode (parent : rules node' option) str_opt =
    {desc = NStr ((self :> strRule), ref str_opt); parent = parent}
end
(** Aggregate rules *)
and aggrRule name =
object (self)
  inherit abstractRule name
  method kind = "aggregateRule"
  val mutable parts = ([] : abstractRule list)
  method parts = parts
  method initParts parts' = parts <- parts'
  method to_string = name ^ " =^= "
    ^ (String.concat "; " (List.map (fun p -> p#name) parts)) ^ "."
  method makeAggrNode (parent : rules node' option) kid_list =
    {desc = NAggr ((self :> aggrRule), ref kid_list); parent = parent}
end
(** Choice rules *)
and choiceRule name =
object (self)
  inherit abstractRule name
  method kind = "choiceRule"
  val mutable alts = ([] : abstractRule list)
  method alts = alts
  method initAlts alts' = alts <- alts'
  method to_string = name ^ " =^= " 
    ^ (String.concat " | " (List.map (fun a -> a#name) alts)) ^ "."
  method makeChoiceNode (parent : rules node' option) kid_opt =
    {desc = NChoice ((self :> choiceRule), ref kid_opt); parent = parent}
end
(** List rules *)
and listRule name =
object (self)
  inherit abstractRule name
  method kind = "listRule"
  val mutable item = (None : abstractRule option)
  method item : abstractRule option = item
  method initItem item' = item <- Some item'
  method to_string = name ^ " =^= (" ^ 
    (match item with None -> "<NOT-YET-DEFINED>" | Some i -> i#name) 
    ^ ")*."
  method makeListNode (parent : rules node' option) kid_list =
    {desc = NList ((self :> listRule), ref kid_list); parent = parent}
end

(* Finally shorter types *)
type node = rules node'

(*** Re mutable rule fields  ***)

(* This is how I end up generating grammars at runtime. *)
(* Simple Test Grammar for plus/times expressions *)
  let exp = new choiceRule "exp"
  let intLit = new intRule "intLit"
  let binExp = new aggrRule "binExp"
  let binOp = new choiceRule "binOp"
  let plusOp = new termRule "plusOp"
  let timesOp = new termRule "timesOp"
  let startrule = exp;;
  exp#initAlts [
    (intLit :> abstractRule);
    (binExp :> abstractRule);
  ];;
  binExp#initParts[
    (exp :> abstractRule);
    (binOp :> abstractRule);
    (exp :> abstractRule)
  ];;
  binOp#initAlts [
    (plusOp :> abstractRule);
    (timesOp :> abstractRule);
  ];;


(*** Re parent ref cell in nCommon ***)

(* Simple Test Tree for the expression with the int litereral "0" *)

(* This is how I intended to write it but it does not compile due to
   "This kind of expression is not allowed as right-hand side of `let rec'" 
   which is interesting since it does not contain a new statement. *)

(*
let rec t = exp#makeChoiceNode None
  (Some (intLit#makeIntNode (Some t)
           (Some (Int64.of_int 3))));;
*)

(* The tree can be generated and later fixed like this, 
   but this requires parent refs: *)

let t = exp#makeChoiceNode None
  (Some (intLit#makeIntNode None
           (Some (Int64.of_int 3))));;

(* helpers for fixParents below *)
let kids node =
  match node.desc with
  | NTerm _ | NInt _ | NStr _
  | NChoice (_,{contents=None}) -> []
  | NChoice (_,{contents=Some k}) -> [k]
  | NAggr   (_,{contents=ks})
  | NList   (_,{contents=ks}) -> ks

let rec fixParents (p:node option) (n:node) =
  n.parent <- p;
  List.iter (fun k -> fixParents (Some n) k) (kids n);;

fixParents None t;;

(* I guess this is how it should be done.  
   No need to put parent in a ref if trees can always be defined like this: *)

let rec (t:node) = 
  {desc = NChoice
     (exp,
      ref(Some{desc = NInt (intLit, ref(Some(Int64.of_int 0)));
               parent = Some t}));
   parent = None};;