[r2006-04-21 11:28:03 by cmiachon] modify // with recursive calls on subtrees matched

Original author: cmiachon
Date: 2006-04-21 11:28:03+00:00

parser/parser.ml

@@ -267,7 +267,7 @@ EXTEND
     | "not"; e = expr -> exp _loc (logical_not e)
     ]
     |
-    [ e1 = expr; ":="; e2 = expr -> exp _loc (set_ref e1 e2)
+    [ e1 = expr; ":="; e2 = expr -> exp _loc  (set_ref e1 e2)
     ]
     | 
     [ e1 = expr; op = ["=" | "<=" | "<<" | ">>" | ">=" ]; e2 = expr -> 
@@ -308,22 +308,37 @@ EXTEND
         let t = (p, Pair (Var id_dummy,cst_nil)) in
         exp _loc (Transform (e,[t]))
      | e = expr; "//" ; p = pat ->
-	 (*
-	   let $stack=ref [p*] [] in
-	   let _ = xtransform e with $$$ & p -> $stack := !$stack @ $$$ in
-	   !stack;; 
-	 *)
-	 let stk = U.mk "$stack" in
+	 (* let $xstack=ref [p*] [] in                  
+            let f  ( x : [Any*]) : [Any*] = 
+                     xtransform x with $$$ & p & <_ ..>[y::Any* ] ->  $stack := !$stack @ [$$$] ; f y
+            in let _ =f e in !$stack *)
+
+	 let stk = U.mk "$stack" in 
+	 let y = U.mk "y" in
+	 let x = U.mk "x" in
+	 let f = U.mk "f" in
 	 let assign = 
 	   set_ref 
 	     (Var stk)
-	     (concat (get_ref (Var stk)) (Pair (Var id_dummy,cst_nil))) in
-	 let capt = mk _loc (And (mk _loc (PatVar [U.mk "$$$"]),p)) in
-	 let xt = Xtrans (e,[capt,assign]) in
-	 let rf = Ref (cst_nil, mk _loc (Regexp (Star(Elem p)))) in
+	     (concat (get_ref (Var stk)) (Pair (Var id_dummy,cst_nil))) in  
+        	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 = (SeqCapture(noloc,y,Star(Elem(any)))) in
+	        let ct = mk _loc (Regexp re) in
+                let children = mk _loc (XmlT (tag, multi_prod _loc [att;ct])) in
+         let capt = mk _loc (And (mk _loc (And (mk _loc (PatVar [id_dummy]),p)),children)) in  
+	 let assign = exp _loc (seq assign ( exp _loc (Apply(Var(f) , Var(y) ) ) ) ) in
+	 let xt = Xtrans ((Var x),[capt,assign]) in 
+	 let rf = Ref (cst_nil, mk _loc (Regexp (Star(Elem p)))) in 
+         let targ = mk _loc (Regexp(Star(Elem(any)))) in
+	 let tres = targ in
+	 let arg = mk _loc(PatVar [x]) in
+         let abst = {fun_name = Some (lop _loc,ident "f") ; fun_iface = [(targ, tres)] ;fun_body = [(arg,xt)] } in
 	 let body = 
 	   let_in rf (mk _loc (PatVar [stk]))
-	     (let_in xt (mk _loc (Internal Types.any)) (get_ref (Var stk)))
+	    (let_in (exp _loc (Abstraction abst)) (mk _loc (PatVar[ident "f"])) 
+              (let_in (exp _loc (Apply(Var(f) , e) )  ) (mk _loc (Internal Types.any)) (get_ref (Var stk))))
 	 in
 	 exp _loc body
     ]
@@ -468,7 +483,7 @@ EXTEND
 		 others (tres,body) in
 	     let (targ,arg) = mkfun ((p1,targ1) :: args) in
 	     [(targ,tres)],[(arg,body)]
-	      ] ];
+	      ] ]; 
 
 
  fun_decl: [