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

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

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