[r2002-11-08 16:02:13 by cvscast] Empty log message

Original author: cvscast
Date: 2002-11-08 16:02:13+00:00

parser/parser.ml

@@ -161,17 +161,31 @@ EXTEND
   ];
 
  fun_decl: [
-  [ f = OPT LIDENT; "("; a = LIST0 arrow SEP ";"; ")"; b = branches -> 
-      (f,a,b)
-  | f = OPT LIDENT; "("; arg = LIDENT; ":"; targ = pat; ")"; ":"; tres = pat ; 
-      "="; body = expr ->
-	let b = [mk noloc (Capture arg), body] in
-	let a = [targ,tres] in
-	(f,a,b)
+(* need an hack to do this, because both productions would
+   match   [ OPT LIDENT; "("; pat ] .... *)
+   [ f = OPT LIDENT; "("; p1 = pat LEVEL "no_arrow";
+    res = [ "->"; p2 = pat;
+	    a = [ ";"; a = LIST0 arrow SEP ";" -> a | -> [] ];
+	    ")"; b = branches -> `Classic (p2,a,b)
+	  | ":"; targ1 = pat;
+	    args = LIST0 [ ","; arg = pat; ":"; targ = pat -> (arg,targ) ]; 
+	    ")"; ":"; tres = pat ; 
+	    "="; body = expr ->
+	      `Compact (targ1,args,tres,body)
+	  ] ->
+      match res with
+	| `Classic (p2,a,b) -> f,(p1,p2)::a,b
+	| `Compact (targ1,args,tres,body) ->
+	    let args = (p1,targ1) :: args in
+	    let targ = multi_prod noloc (List.map snd args) in
+	    let arg = multi_prod noloc (List.map fst args) in
+	    let b = [arg, body] in
+	    let a = [targ,tres] in
+	    (f,a,b)
   ]
  ];
 
-  arrow: [
+ arrow: [
     [ t1 = pat LEVEL "no_arrow"; "->"; t2 = pat -> (t1,t2)]
   ];
 

tests/funs.cd

+type T = <a>[Int*];;
+
+let fun f ( <a>l : T ) : Int = aux l;;
+
+let fun aux ([Int*] -> Int)
+   | [] -> 0
+   | (x,r) -> x + (aux r);;
+
+let a = f <a>[ 10 15 20 ];;