[r2004-07-06 17:12:01 by cmiachon] adding member

Original author: cmiachon
Date: 2004-07-06 17:12:01+00:00

query/query_parse.ml

@@ -21,16 +21,18 @@ let rec multi_prod loc = function
   | [ x ] -> x
   | x :: l -> mk loc (Prod (x, multi_prod loc l))
   | [] -> assert false
- 
+
+let if_then_else cond e1 e2 = Match (cond, [pat_true,e1; pat_false,e2])
+
 EXTEND 
   GLOBAL: expr pat keyword;
 
 
   expr: [
-    "top" [
+    "top" RIGHTA[
      "select"; e = expr;
      "from";l = LIST1 [ x= pat ; "in"; e = expr -> (x,e)] SEP "," ;
-      z=OPT["where"  ; w = cond -> w]  -> 
+       z=OPT[ "where"  ; w = cond -> w]  -> 
 	let (condi,fin) =
 	  match z with
               Some w -> 
@@ -78,7 +80,34 @@ EXTEND
 	
      NB: order is inversed	
 	*)	  
+      
+      (*AGREGATS*)
+      | "member";pair= expr LEVEL "no_appl" -> 
+        (*let fun member ((Any,Any) -> Bool)
+        |(s,[h;t]) -> if (s=h) then `true else member (s,t)
+        |_ -> `false
+        in member( pair ) *)
+       let any =mk loc(PatVar(U.mk "Any")) in
+       let h = 	U.mk"h" in 
+       let t = 	U.mk"t" in 
+       let s = 	U.mk"s" in 
+	let f = (ident (U.mk "member")) in 
+        let p = mk loc (PatVar (Id.value f)) in
+        let abst = 
+	    { fun_name = Some f; 
+              fun_iface = [multi_prod loc [any ;mk loc (Regexp(Star(Elem(any)),pat_nil))],
+	                                    mk loc(PatVar(U.mk "Bool"))]; 
+	      fun_body = [
+             ( mk loc(Prod(mk loc(PatVar(s)),mk loc(Regexp(Elem(mk loc(PatVar(h))),
+	     mk loc(PatVar(t)))))),
+              exp loc (if_then_else (exp loc (Op("=", [(exp loc (Var (s)));(exp loc
+	      (Var (h)))]))) cst_true (exp loc( Apply(exp loc (Var(U.mk "member")),
+	      exp loc(Pair(exp loc (Var (s)),exp loc (Var(t)))))))));(any, cst_false)]} in
+        let e = exp loc (Abstraction abst) in
+        (( exp loc (Match (e,[p,exp loc(Apply( exp loc
+        (Var(U.mk "member")),pair)) ]))))
       ]
+      
     ];
    
   cond:
@@ -98,7 +127,7 @@ EXTEND
     ];
 
 
-  keyword: [ [ a = [ "select" | "from" | "where" ] -> a ] ];
+  keyword: [ [ a = [ "select" | "from" |"member" ] -> a ] ];
 END