[r2004-12-26 23:35:01 by afrisch] Better localization of terminators (x:=`nil)

Original author: afrisch
Date: 2004-12-26 23:35:01+00:00

typing/typer.ml

@@ -249,12 +249,6 @@ let find_schema_descr env kind schema name =
 
 (* Eliminate Recursion, propagate Sequence Capture Variables *)
 
-let rec seq_vars accu = function
-  | Epsilon | Elem _ | Guard _ -> accu
-  | Seq (r1,r2) | Alt (r1,r2) -> seq_vars (seq_vars accu r1) r2
-  | Star r | WeakStar r -> seq_vars accu r
-  | SeqCapture (v,r) -> seq_vars (IdSet.add v accu) r
-
 (* We use two intermediate representation from AST types/patterns
    to internal ones:
 
@@ -437,16 +431,6 @@ module DerecursTable = Hashtbl.Make(
   end
 )
 
-module RE = Hashtbl.Make(
-  struct 
-    type t = derecurs_regexp * derecurs 
-    let hash (p,q) = 
-      (hash_derecurs_regexp p) + 17 * (hash_derecurs q)
-    let equal (p1,q1) (p2,q2) = 
-      (equal_derecurs_regexp p1 p2) && (equal_derecurs q1 q2)
-  end
-)
-
 let gen = ref 0
 let rank = ref 0
 	     
@@ -584,6 +568,12 @@ and remove_regexp2 r q_nonempty q_empty =
         x.pdescr <- remove_regexp2 r (POr (q_nonempty, PAlias x)) pempty;
         por q_empty (PAlias x)
 
+let cst_nil = Types.Atom Sequence.nil_atom
+let capture_all vars p = IdSet.fold (fun p x -> PAnd (p, PCapture x)) p vars
+let termin b vars p = 
+  if b then p 
+  else IdSet.fold (fun p x -> PSeq (p, PGuard (PConstant (x,cst_nil)))) p vars
+
 let rec derecurs env p = match p.descr with
   | PatVar v -> derecurs_var env p.loc v
   | SchemaVar (kind, schema_name, component_name) ->
@@ -605,33 +595,52 @@ let rec derecurs env p = match p.descr with
       PRecord (o, parse_record env.penv_tenv p.loc aux r)
   | Constant (x,c) -> PConstant (x,const env.penv_tenv p.loc c)
   | Cst c -> PType (Types.constant (const env.penv_tenv p.loc c))
-  | Regexp (r,q) -> 
-      let constant_nil t v = 
-	PAnd (t, PConstant (v, Types.Atom Sequence.nil_atom)) in
-      let vars = seq_vars IdSet.empty r in
-      let q = IdSet.fold constant_nil (derecurs env q) vars in
-      let r = derecurs_regexp (fun p -> p) env r in
-      PRegexp (r, q)
+  | Regexp (r,q) ->
+      let r,_ = derecurs_regexp IdSet.empty false IdSet.empty env r in
+      PRegexp (r, derecurs env q)
 	(* Note: computing remove_regexp here is slower (because
 	   of caching ?) *)
 
-and derecurs_regexp vars env = function
+and derecurs_regexp vars b rvars env = function
+(* - vars: seq variables to be propagated top-down and added
+     to each captured element
+   - b: below a star ?
+   - rvars: seq variables that appear on the right of the regexp
+
+  returns the set of seq variable of the regexp minus rvars
+  (they have already been terminated)
+*)
   | Epsilon -> 
-      PEpsilon
+      PEpsilon, IdSet.empty
   | Elem p -> 
-      PElem (vars (derecurs env p))
+      PElem (capture_all vars (derecurs env p)), IdSet.empty
   | Guard p ->
-      PGuard (vars (derecurs env p))
+      PGuard (derecurs env p), IdSet.empty
   | Seq (p1,p2) -> 
-      PSeq (derecurs_regexp vars env p1, derecurs_regexp vars env p2)
+      let (p2,v2) = derecurs_regexp vars b rvars env p2 in
+      let (p1,v1) = derecurs_regexp vars b (IdSet.cup rvars v2) env p1 in
+      PSeq (p1,p2), IdSet.cup v1 v2
   | Alt (p1,p2) -> 
-      PAlt (derecurs_regexp vars env p1, derecurs_regexp vars env p2)
+      let (p1,v1) = derecurs_regexp vars b rvars env p1
+      and (p2,v2) = derecurs_regexp vars b rvars env p2 in
+      PAlt (termin b (IdSet.diff v2 v1) p1, termin b (IdSet.diff v1 v2) p2),
+      IdSet.cup v1 v2
   | Star p -> 
-      PStar (derecurs_regexp vars env p)
+      let (p,v) = derecurs_regexp vars true rvars env p in
+      assert (IdSet.is_empty v);
+      termin b v (PStar p), v
   | WeakStar p -> 
-      PWeakStar (derecurs_regexp vars env p)
+      let (p,v) = derecurs_regexp vars true rvars env p in
+      assert (IdSet.is_empty v);
+      termin b v (PWeakStar p), v
   | SeqCapture (x,p) -> 
-      derecurs_regexp (fun p -> PAnd (vars p, PCapture x)) env p
+      let vars = IdSet.add x vars in
+      let after = IdSet.mem rvars x in
+      let rvars = IdSet.add x rvars in
+      let (p,v) = derecurs_regexp vars b rvars env p in
+      termin (after || b) (IdSet.singleton x) p, 
+      (if after then v else IdSet.add x v)
+
 
 and derecurs_var env loc v =
   match Ns.split_qname v with