[r2004-12-27 00:29:42 by afrisch] Get rid of [ .. ; p ], simulate it

Original author: afrisch
Date: 2004-12-27 00:29:42+00:00

parser/ast.ml

@@ -108,8 +108,7 @@ and ppat' =
   | Optional of ppat
   | Record of bool * (label * (ppat * ppat option)) list
   | Constant of id * pexpr
-  | Regexp of regexp * ppat
-      (* regular expression, continuation: [ re ; cont ], e.g: [ re ; nil ] *)
+  | Regexp of regexp
 
 and regexp =
   | Epsilon

parser/parser.ml

@@ -269,7 +269,7 @@ EXTEND
 	let att = mk loc (Internal Types.Record.any) in
 	let any = mk loc (Internal (Types.any)) in
 	let re = Star(Alt(SeqCapture(id_dummy,Elem p), Elem any)) in
-	let ct = mk loc (Regexp (re,any)) in
+	let ct = mk loc (Regexp re) in
         let p = mk loc (XmlT (tag, multi_prod loc [att;ct])) in
 	let b = (p,  Var (Id.value id_dummy)) in
 	exp loc (Transform (e,[b]))
@@ -540,9 +540,16 @@ EXTEND
       | "`"; c = tag_type -> c
       | "("; l = LIST1 pat SEP ","; ")" -> multi_prod loc l
       | "["; r = [ r = regexp -> r | -> Epsilon ];
-             q = [ ";"; q = pat -> q 
-                 | -> pat_nil ]; 
-             "]" -> mk loc (Regexp (r,q))
+             q = [ ";"; q = pat -> Some q
+                 | -> None ]; 
+             "]" -> 
+	       let r = match q with
+		 | Some q -> 	
+		     let any = mk loc (Internal (Types.any)) in
+		     Seq(r,Seq(Guard q, Star (Elem any)))
+		 | None -> r
+	       in
+	       mk loc (Regexp r)
       | "<"; t =
             [ x = tag_type -> x
             | "("; t = pat; ")" -> t ];

query/query.ml

@@ -83,7 +83,7 @@ mais pas prioritaire          [] -> ""
                                ((LabelPool.value s)))^"="^string_of_ppat(ppat)^listing r
 			     )in listing (lm)  *)	      
 	     |Constant(i,t) -> U.get_str (Id.value i)
-	     |Regexp(rg,p) -> "["^string_of_regexp rg ^ string_of_ppat p^"]"
+	     |Regexp(rg) -> "["^string_of_regexp rg ^ "]"
 	     | _ ->"?"
 	     )
 
@@ -120,8 +120,7 @@ let rec var_of_ppat x =
 		in 
 		List.fold_left aux [] lm
 	     |Constant(i,t) -> [i]
-	     |Regexp(rg,p) -> var_of_rg rg @ var_of_ppat p
-	     
+	     |Regexp(rg) -> var_of_rg rg
 	     |_ ->[]
 	     )
 

query/query_parse.ml

@@ -69,7 +69,7 @@ EXTEND
        in let branches= exp loc (Match(assign,[pat_nil,branche]))
        in let xt=exp loc (Xtrans (e,[(mk loc(And(mk loc(PatVar(U.mk "$$$")),p))),branches]))
        in let rf=exp loc(Ref(cst_nil,mk loc (Regexp 
-	  (Star(Elem(p)),pat_nil))))
+	  (Star(Elem p)))))
        in exp loc(Match(rf,[mk loc(PatVar(U.mk"$stack")),
                exp loc(Match(xt,
 	          [mk loc(Internal Types.any),

typing/typer.ml

@@ -282,7 +282,7 @@ type derecurs_slot = {
   | PRecord of bool * (derecurs * derecurs option) label_map
   | PCapture of id
   | PConstant of id * Types.const
-  | PRegexp of derecurs_regexp * derecurs
+  | PRegexp of derecurs_regexp
 and derecurs_regexp =
   | PEpsilon
   | PElem of derecurs
@@ -292,9 +292,6 @@ and derecurs_regexp =
   | PStar of derecurs_regexp
   | PWeakStar of derecurs_regexp
 
-let pregexp r q = PRegexp (r,q)
-
-
 type descr = 
   | IDummy
   | IType of Types.descr
@@ -360,8 +357,8 @@ let rec hash_derecurs = function
       11 + 17 * (Id.hash x)
   | PConstant (x,c) -> 
       12 + 17 * (Id.hash x) + 257 * (Types.Const.hash c)
-  | PRegexp (p,q) -> 
-      13 + 17 * (hash_derecurs_regexp p) + 257 * (hash_derecurs q)
+  | PRegexp p -> 
+      13 + 17 * (hash_derecurs_regexp p)
 and hash_derecurs_field = function
   | (p, Some e) -> 1 + 17 * hash_derecurs p + 257 * hash_derecurs e
   | (p, None) -> 2 + 17 * hash_derecurs p
@@ -401,8 +398,8 @@ let rec equal_derecurs p1 p2 = (p1 == p2) || match p1,p2 with
       Id.equal x1 x2
   | PConstant (x1,c1), PConstant (x2,c2) -> 
       (Id.equal x1 x2) && (Types.Const.equal c1 c2)
-  | PRegexp (p1,q1), PRegexp (p2,q2) -> 
-      (equal_derecurs_regexp p1 p2) && (equal_derecurs q1 q2)
+  | PRegexp p1, PRegexp p2 -> 
+      equal_derecurs_regexp p1 p2
   | _ -> false
 and equal_derecurs_field r1 r2 = match (r1,r2) with
   | (p1,None),(p2,None) -> equal_derecurs p1 p2
@@ -595,17 +592,18 @@ 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 r,_ = derecurs_regexp IdSet.empty false IdSet.empty env r in
-      PRegexp (r, derecurs env q)
+  | Regexp r ->
+      let r,_ = derecurs_regexp IdSet.empty false IdSet.empty true env r in
+      PRegexp r
 	(* Note: computing remove_regexp here is slower (because
 	   of caching ?) *)
 
-and derecurs_regexp vars b rvars env = function
+and derecurs_regexp vars b rvars f 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
+   - f: tail position
 
   returns the set of seq variable of the regexp minus rvars
   (they have already been terminated if not below a star)
@@ -617,26 +615,28 @@ and derecurs_regexp vars b rvars env = function
   | Guard p ->
       PGuard (derecurs env p), IdSet.empty
   | Seq (p1,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
+      let (p2,v2) = derecurs_regexp vars b rvars f env p2 in
+      let (p1,v1) = derecurs_regexp vars b (IdSet.cup rvars v2) false env p1 in
       PSeq (p1,p2), IdSet.cup v1 v2
   | Alt (p1,p2) -> 
-      let (p1,v1) = derecurs_regexp vars b rvars env p1
-      and (p2,v2) = derecurs_regexp vars b rvars env p2 in
+      let (p1,v1) = derecurs_regexp vars b rvars f env p1
+      and (p2,v2) = derecurs_regexp vars b rvars f env p2 in
       PAlt (termin b (IdSet.diff v2 v1) p1, termin b (IdSet.diff v1 v2) p2),
       IdSet.cup v1 v2
   | Star p -> 
-      let (p,v) = derecurs_regexp vars true rvars env p in
+      let (p,v) = derecurs_regexp vars true rvars false env p in
       termin b v (PStar p), v
   | WeakStar p -> 
-      let (p,v) = derecurs_regexp vars true rvars env p in
+      let (p,v) = derecurs_regexp vars true rvars false env p in
       termin b v (PWeakStar p), v
   | SeqCapture (x,p) -> 
-      let vars = IdSet.add x vars in
+      let vars = if f then vars else 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, 
+      let (p,v) = derecurs_regexp vars b rvars false env p in
+      (if f 
+       then PSeq (PGuard (PCapture x), p) 
+       else termin (after || b) (IdSet.singleton x) p), 
       (if after then v else IdSet.add x v)
 
 
@@ -735,7 +735,7 @@ and real_compile = function
   | PRecord (o,r) ->  IRecord (o, LabelMap.map compile_field r)
   | PConstant (x,v) -> IConstant (x,v)
   | PCapture x -> ICapture x
-  | PRegexp (r,q) -> compile (remove_regexp r q)
+  | PRegexp r -> compile (remove_regexp r (PType Sequence.nil_type))
 
 and compile_field = function
   | (p, Some e) -> (compile_slot p, Some (compile e))
@@ -1527,12 +1527,12 @@ module Schema_converter =
     let mk_seq_derecurs ~base facets =
       match facets with
       | { length = Some (v, _) } ->
-          pregexp (mk_len_regexp ~min:v ~max:v base) nil_type
+          PRegexp (mk_len_regexp ~min:v ~max:v base)
       | { minLength = Some (v, _); maxLength = None } ->
-          pregexp (mk_len_regexp ~min:v base) nil_type
+          PRegexp (mk_len_regexp ~min:v base)
       | { minLength = None; maxLength = Some (v, _) } ->
-          pregexp (mk_len_regexp ~max:v base) nil_type
-      | _ -> pregexp base nil_type
+          PRegexp (mk_len_regexp ~max:v base)
+      | _ -> PRegexp base
 
     let mix_regexp =
       let pcdata = PStar (PElem (PType Builtin_defs.string)) in
@@ -1642,7 +1642,7 @@ module Schema_converter =
               if mixed then
                 Value.failwith' "Mixed content models aren't supported";
               let regexp = regexp_of_particle ~schema particle in
-              pregexp regexp (PType Sequence.nil_type)
+              PRegexp regexp
         in
         slot.pdescr <-
           PTimes (cd_type_of_attr_uses ~schema ct.ct_attrs, content_ast_node);
@@ -1694,7 +1694,7 @@ module Schema_converter =
       PXml (PType Types.any, cd_type_of_complex_type' ~schema ct)
 
     let cd_type_of_model_group ~schema g =
-      pregexp (regexp_of_model_group ~schema g) nil_type
+      PRegexp (regexp_of_model_group ~schema g)
 
     let typ r = Types.descr (do_typ noloc r)