[r2003-12-08 14:42:50 by cmiachon] ajout de / , /@ et d une premiere version de //

Original author: cmiachon
Date: 2003-12-08 14:42:50+00:00

query/query_parse.ml

@@ -11,7 +11,16 @@ open Query
 let exp pos e = LocatedExpr (loc_of_pos pos,e)
 
 let cst_nil =  Const Sequence.nil_cst
+let parse_ident = U.mk
 
+let id_dummy = ident (U.mk "$$$")
+
+let label = parse_ident
+
+let rec multi_prod loc = function
+  | [ x ] -> x
+  | x :: l -> mk loc (Prod (x, multi_prod loc l))
+  | [] -> assert false
  
 EXTEND 
   GLOBAL: expr pat keyword;
@@ -34,7 +43,53 @@ EXTEND
 	if !Query.nooptim 
         then Query.select(loc,fin,l)
       	else Query.selectOpt(loc,fin,l,condi)
-   ] ];
+     	
+   ]
+   | [
+      e = expr; "/" ;
+      t = [a = pat ->
+        let tag = mk loc (Internal (Types.atom (Atoms.any))) in
+	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 a), Elem any)) in
+	let ct = mk loc (Regexp (re,any)) in
+        let p = mk loc (XmlT (tag, multi_prod loc [att;ct])) in
+	(p,  Var (Id.value id_dummy))
+       | "@";	  a = [IDENT|keyword]-> (* projection sur 1 attribut *)
+        let tag = mk loc (Internal(Types.atom Atoms.any)) in
+        let any = mk loc (Internal(Types.any)) in
+        let att = mk loc (Record(true,[(label a,mk loc (PatVar(U.mk "$$$")))]))in
+        let ct= mk loc (Regexp(Elem any , any)) in 
+        let p = mk loc(XmlT (tag,multi_prod loc[att;ct])) in
+        (p, Pair(Var (Id.value id_dummy),cst_nil)) 
+       ] ->  exp loc (Transform (e,[t]))
+     | e = expr; "/" ; "/" ; p = pat -> (* projections sur tous les descendants *)
+       let assign= 
+       exp loc ( Apply (Dot (Var(U.mk"$stack"), U.mk"set"),
+           (Pair (Var(U.mk"$$$"),(Apply(Dot(Var(U.mk"$stack"),U.mk"get"),cst_nil))))))
+       in let branche=Pair(Var (Id.value id_dummy),cst_nil)
+       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))))
+       in exp loc(Match(rf,[mk loc(PatVar(U.mk"$stack")),
+               exp loc(Match(xt,
+	          [mk loc(Internal Types.any),
+	          exp loc (Apply(Dot(Var(U.mk"$stack"),U.mk"get"),cst_nil))]))
+	       ]))   	      
+     
+     (* equivalent as:
+     
+      let $stack=ref [p*] []
+      in let _ = xtransform e with
+                  $$$ & p -> $stack := [ $$$ ; !$stack] ; [$$$]
+	in !stack;; 
+	
+     NB: order is inversed	
+	*)	  
+                    
+      ]
+    ];
    
   cond:
       [ [ a = expr ->