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

[Christian Stork <cstork@ics.uci.edu>]

[-- 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