[r2004-07-07 15:00:49 by cmiachon] adding min and max

Original author: cmiachon
Date: 2004-07-07 15:00:49+00:00

query/query_parse.ml

@@ -83,7 +83,7 @@ EXTEND
       
       (*AGREGATS*)
       | "member";pair= expr LEVEL "no_appl" -> 
-        (*let fun member ((Any,Any) -> Bool)
+        (*let fun member ((Any,[Any*]) -> Bool)
         |(s,[h;t]) -> if (s=h) then `true else member (s,t)
         |_ -> `false
         in member( pair ) *)
@@ -106,6 +106,108 @@ EXTEND
         let e = exp loc (Abstraction abst) in
         (( exp loc (Match (e,[p,exp loc(Apply( exp loc
         (Var(U.mk "member")),pair)) ]))))
+      |"min";pair=expr LEVEL "no_appl" ->
+      (*
+      let fun min ([Int+] -> Int)
+       | [h;t] -> let fun aux (([Int*],Int) -> Int)
+                  |([h;t],a) -> if a>> h then aux (t,h) else aux(t,a)
+                  |(_,a) -> a
+              in aux(t,h);;
+      *)
+      let int = mk loc(PatVar(U.mk "Int")) in
+      let any = mk loc(PatVar(U.mk "Any")) in
+       let h = 	U.mk"h" in 
+       let t = 	U.mk"t" in 
+       let a = 	U.mk"a" in 
+      let f = (ident (U.mk "min")) in 
+      let p = mk loc (PatVar (Id.value f)) in
+
+      let faux = (ident (U.mk "aux")) in 
+      let paux = mk loc (PatVar (Id.value faux)) in 
+      
+      let aux = 
+       { fun_name = Some faux; 
+         fun_iface = [multi_prod loc [mk loc (Regexp(Star(Elem(int)),pat_nil)); int],int]; 
+         fun_body = [
+	    (mk loc ( Prod(mk loc(Regexp(Elem(mk loc(PatVar(h))),mk loc(PatVar(t)))),mk loc(PatVar(a)))),
+             exp loc(if_then_else (exp loc (Op(">",[(exp loc (Var (a)));(exp loc (Var (h)))])))
+	     (exp loc( Apply(exp loc (Var(U.mk "aux")),
+	      exp loc(Pair(exp loc (Var (t)),exp loc (Var(h)))))))
+	     (exp loc( Apply(exp loc (Var(U.mk "aux")),
+	      exp loc(Pair(exp loc (Var (t)),exp loc (Var(a)))))) 
+	          )));
+	    (mk loc ( Prod(any,mk loc(PatVar(a)))),exp loc (Var(a))) ]} in
+         
+      let abst = 
+       { fun_name = Some f; 
+         fun_iface = [mk loc (Regexp(Seq(Elem(int) ,Star(Elem(int))),pat_nil)),
+	                                    int]; 
+	      fun_body = [
+	      (mk loc(Regexp(Elem(mk loc(PatVar(h))),mk loc(PatVar(t)))),
+	      
+               exp loc (Match (exp loc (Abstraction aux),[paux,exp loc(Apply( exp loc
+                (Var(U.mk "aux")),exp loc(Pair(exp loc (Var (t)),exp loc (Var(h)))))) ]))
+	      ) 
+	      ]} in
+      let e = exp loc (Abstraction abst) in
+        (( exp loc (Match (e,[p,exp loc(Apply( exp loc
+        (Var(U.mk "min")),pair)) ]))))
+      |"max";pair=expr LEVEL "no_appl" ->
+      (*
+      let fun max ([Int+] -> Int)
+       | [h;t] -> let fun aux (([Int*],Int) -> Int)
+                  |([h;t],a) -> if a<< h then aux (t,h) else aux(t,a)
+                  |(_,a) -> a
+              in aux(t,h);;
+      *)
+      let int = mk loc(PatVar(U.mk "Int")) in
+      let any = mk loc(PatVar(U.mk "Any")) in
+       let h = 	U.mk"h" in 
+       let t = 	U.mk"t" in 
+       let a = 	U.mk"a" in 
+      let f = (ident (U.mk "max")) in 
+      let p = mk loc (PatVar (Id.value f)) in
+
+      let faux = (ident (U.mk "aux")) in 
+      let paux = mk loc (PatVar (Id.value faux)) in 
+      
+      let aux = 
+       { fun_name = Some faux; 
+         fun_iface = [multi_prod loc [mk loc (Regexp(Star(Elem(int)),pat_nil)); int],int]; 
+         fun_body = [
+	    (mk loc ( Prod(mk loc(Regexp(Elem(mk loc(PatVar(h))),mk loc(PatVar(t)))),mk loc(PatVar(a)))),
+             exp loc(if_then_else (exp loc (Op("<",[(exp loc (Var (a)));(exp loc (Var (h)))])))
+	     (exp loc( Apply(exp loc (Var(U.mk "aux")),
+	      exp loc(Pair(exp loc (Var (t)),exp loc (Var(h)))))))
+	     (exp loc( Apply(exp loc (Var(U.mk "aux")),
+	      exp loc(Pair(exp loc (Var (t)),exp loc (Var(a)))))) 
+	          )));
+	    (mk loc ( Prod(any,mk loc(PatVar(a)))),exp loc (Var(a))) ]} in
+         
+      let abst = 
+       { fun_name = Some f; 
+         fun_iface = [mk loc (Regexp(Seq(Elem(int) ,Star(Elem(int))),pat_nil)),
+	                                    int]; 
+	      fun_body = [
+	      (mk loc(Regexp(Elem(mk loc(PatVar(h))),mk loc(PatVar(t)))),
+	      
+               exp loc (Match (exp loc (Abstraction aux),[paux,exp loc(Apply( exp loc
+                (Var(U.mk "aux")),exp loc(Pair(exp loc (Var (t)),exp loc (Var(h)))))) ]))
+	      ) 
+	      ]} in
+      let e = exp loc (Abstraction abst) in
+        (( exp loc (Match (e,[p,exp loc(Apply( exp loc
+        (Var(U.mk "max")),pair)) ]))))
+      
+      (*
+       let fun distinct_values ([Any*] -> [Any*])
+        | l -> let fun aux (([Any*],[Any*])->[Any*])
+                 | ([h;t],l2) ->if member(h,t) then aux(t,l2)
+                                            else aux(t,l2@[h])
+                 | ([],l2) -> l2
+             in aux(l,[]);;
+         *)
+      
       ]
       
     ];