[r2004-07-07 15:46:55 by cmiachon] adding sum

Original author: cmiachon
Date: 2004-07-07 15:46:55+00:00

query/query_parse.ml

@@ -199,6 +199,50 @@ EXTEND
         (( 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)),exp loc (Op("+",[(exp loc (Var (a)));(exp loc (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*])