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

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

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