[r2004-05-25 08:57:11 by afrisch] Curried functions

Original author: afrisch
Date: 2004-05-25 08:57:11+00:00

parser/parser.ml

@@ -375,19 +375,39 @@ EXTEND
 	     ")"; b = branches -> `Classic (p2,a,b)
 	   | ":"; targ1 = pat;
 	     args = LIST0 [ ","; arg = pat; ":"; targ = pat -> (arg,targ) ]; 
-	     ")"; ":"; tres = pat ; 
+	     ")";
+	     others = LIST0 
+			[ "(";
+			  args = 
+			    LIST1 
+			      [ arg = pat; ":"; targ = pat -> (arg,targ) ]
+			      SEP ",";
+			  ")" -> args ];
+	     ":"; tres = pat ; 
 	     "="; body = expr ->
-	       `Compact (targ1,args,tres,body)
+	       `Compact (targ1,args,others,tres,body)
 	   ] ->
        match res with
 	 | `Classic (p2,a,b) -> (p1,p2)::a,b
-	 | `Compact (targ1,args,tres,body) ->
-	     let args = (p1,targ1) :: args in
-	     let targ = multi_prod nopos (List.map snd args) in
-	     let arg = multi_prod nopos (List.map fst args) in
-	     let b = [arg, body] in
-	     let a = [targ,tres] in
-	     (a,b) ] ];
+	 | `Compact (targ1,args,others,tres,body) ->
+	     let mkfun args =
+	       multi_prod nopos (List.map snd args),
+	       multi_prod nopos (List.map fst args)
+	     in
+	     let (tres,body) =
+	       List.fold_right
+		 (fun args (tres,body) ->
+		    let (targ,arg) = mkfun args in
+		    let e = Abstraction 
+			      { fun_name = None; fun_iface = [targ,tres]; 
+				fun_body = [arg,body] } in
+		    let t = mknoloc (Arrow (targ,tres)) in
+		    (t,e)
+		 )
+		 others (tres,body) in
+	     let (targ,arg) = mkfun ((p1,targ1) :: args) in
+	     [(targ,tres)],[(arg,body)]
+	      ] ];
 
 
  fun_decl: [