Commit 932288b1 authored by Pietro Abate's avatar Pietro Abate

[r2004-07-08 17:12:41 by cmiachon] adding min

Original author: cmiachon
Date: 2004-07-08 17:12:41+00:00
parent 3c764682
......@@ -81,177 +81,6 @@ 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 (op2 "=" (Var s) (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)) ]))))
|"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 (op2 ">" (Var a) (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 (op2 "<" (Var a) (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)) ]))))
|"sum";pair=expr LEVEL "no_appl" ->
(*let fun sum ([Int+] -> Int)
| [h;t] -> let fun aux (([Int*],Int) -> Int)
|([h;t],a) -> aux(t,a+h)
|(_,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 "sum")) 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( Apply(exp loc (Var(U.mk "aux")),
exp loc(Pair(exp loc (Var (t)), op2 "+" (Var a) (Var h))))))
);
(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 "sum")),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,[]);;
*)
]
];
......@@ -273,7 +102,7 @@ EXTEND
];
keyword: [ [ a = [ "select" | "from" |"member" |"min"|"max"] -> a ] ];
keyword: [ [ a = [ "select" | "from" ] -> a ] ];
END
......
......@@ -624,3 +624,13 @@ let cduce2ocaml_bigint = function
let print_utf8 v =
print_string (U.get_str v);
flush stdout
let query_min = function
| Pair(Integer i,p) ->
let rec aux l i = match l with
| Pair(Integer j,r) -> if (compare (Integer i) (Integer
j) <0) then aux r i else aux r j
| Atom(_) -> Integer i
| _ -> assert false
in aux p i
|_ -> assert false
......@@ -117,3 +117,4 @@ val cduce2ocaml_bigint : t -> Big_int.big_int
val print_utf8: U.t -> unit
val query_min: t-> t
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment