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

[Jacques Garrigue <garrigue@math.nagoya-u.ac.jp>]

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'