From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Delivered-To: caml-list@yquem.inria.fr Received: from nez-perce.inria.fr (nez-perce.inria.fr [192.93.2.78]) by yquem.inria.fr (Postfix) with ESMTP id DF4FDBC75 for ; Tue, 22 Feb 2005 18:29:11 +0100 (CET) Received: from pauillac.inria.fr (pauillac.inria.fr [128.93.11.35]) by nez-perce.inria.fr (8.13.0/8.13.0) with ESMTP id j1MHTAhX021284 for ; Tue, 22 Feb 2005 18:29:11 +0100 Received: from concorde.inria.fr (concorde.inria.fr [192.93.2.39]) by pauillac.inria.fr (8.7.6/8.7.3) with ESMTP id SAA25618 for ; Tue, 22 Feb 2005 18:29:10 +0100 (MET) Received: from anthony.ics.uci.edu (anthony.ics.uci.edu [128.195.21.186]) by concorde.inria.fr (8.13.0/8.13.0) with SMTP id j1MHT88l020329 for ; Tue, 22 Feb 2005 18:29:09 +0100 Received: (qmail 9070 invoked by uid 1000); 22 Feb 2005 17:29:07 -0000 Date: Tue, 22 Feb 2005 09:29:07 -0800 From: Christian Stork To: John Prevost , Jacques Garrigue , caml-list@inria.fr Subject: Re: [Caml-list] Unquantifiable escaping type in variation of visitor pattern Message-ID: <20050222172907.GA8376@anthony.ics.uci.edu> Mail-Followup-To: John Prevost , Jacques Garrigue , caml-list@inria.fr References: <20050208225542.GA20967@anthony.ics.uci.edu> <20050209.105350.108297361.garrigue@math.nagoya-u.ac.jp> <20050208225542.GA20967@anthony.ics.uci.edu> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="MGYHOYXEY6WxJCY8" Content-Disposition: inline In-Reply-To: <20050209.105350.108297361.garrigue@math.nagoya-u.ac.jp> X-Archive: encrypt User-Agent: Mutt/1.5.6+20040907i X-Miltered: at nez-perce with ID 421B6BE6.000 by Joe's j-chkmail (http://j-chkmail.ensmp.fr)! X-Miltered: at concorde with ID 421B6BE4.001 by Joe's j-chkmail (http://j-chkmail.ensmp.fr)! X-Spam: no; 0.00; caml-list:01 escaping:01 wrote:01 grammar:01 grammar:01 nodes:01 ocaml:01 recursive:01 recursion:01 impl:01 impl:01 nodes:01 variants:01 prevost:01 wrote:01 X-Attachments: name="cat.ml" X-Spam-Checker-Version: SpamAssassin 3.0.2 (2004-11-16) on yquem.inria.fr X-Spam-Status: No, score=0.0 required=5.0 tests=none autolearn=disabled version=3.0.2 X-Spam-Level: --MGYHOYXEY6WxJCY8 Content-Type: text/plain; charset=us-ascii Content-Disposition: inline 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 > > 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 --MGYHOYXEY6WxJCY8 Content-Type: text/plain; charset=us-ascii Content-Disposition: attachment; filename="cat.ml" (** 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 -> "" | 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 -> "" | 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 --MGYHOYXEY6WxJCY8--