Remove the need for mandatory spaces around ':' in function parameters.

Now functions such as
let fun f (x:Int):Int = ...
are parsed correctly (that is, its parameter is 'x' with type Int).

parser/parser.ml

@@ -45,6 +45,24 @@ let keyword = Gram.Entry.mk "keyword"
 let lop pos = Cduce_loc.loc_of_pos (tloc pos)
 let exp pos e = LocatedExpr (lop pos,e)
 
+let split_id_list loc l =
+  let rec loop l acc =
+  match l with
+    [] -> acc, []
+  | qname :: ll ->
+    try
+      let i = String.index qname ':' in
+      let pre = String.sub qname 0 i in
+      let post = String.sub qname (i+1) (String.length qname - i - 1) in
+      pre :: acc, post::ll
+    with
+    Not_found -> loop ll (qname :: acc)
+  in
+  let l1, l2 = loop l [] in
+  if l2 == [] then raise Stream.Failure else
+    (mk loc (PatVar(List.rev_map ident l1, [])),
+     mk loc (PatVar(List.map ident l2, [])))
+
 let rec multi_prod loc = function
   | [ x ] -> x
   | x :: l -> mk loc (Prod (x, multi_prod loc l))
@@ -329,7 +347,7 @@ EXTEND Gram
           let tres = targ in
           let arg = mknoloc(PatVar ([x],[])) in
           let abst = {fun_name = Some (lop _loc,ident "f") ; fun_iface = [(targ, tres)] ;fun_body = [(arg,xt)] } in
-          let body = 
+          let body =
             let_in rf (mknoloc (PatVar ([stk],[])))
             (let_in ((Abstraction abst)) (mknoloc (PatVar ([ident "f"],[])))
             (let_in ((Apply(Var(f) , e) )  ) (mknoloc (Internal Types.any)) (get_ref (Var stk))))
@@ -437,6 +455,17 @@ EXTEND Gram
     ]
   ];
 
+  arg_colon_type: [
+    [ p1 = pat ; targ1 = OPT [ ":"; p = pat -> p ] ->
+
+      match p1.descr,targ1 with
+        PatVar(id1, []), None ->
+        split_id_list _loc (List.map Ident.U.get_str id1)
+      | _, Some targ1 -> p1, targ1
+      | _ -> raise Stream.Failure
+    ]
+  ];
+
  fun_decl_after_lparen: [
   (* need an hack to do this, because both productions would
    match   [ OPT IDENT; "("; pat ] .... *)
@@ -444,40 +473,48 @@ EXTEND Gram
      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) ];
+	   | targ1 = OPT [ ":"; p = pat -> p ];
+	     args = LIST0 [ ","; arg = arg_colon_type -> arg ];
 	     ")";
 	     others = LIST0
 			[ "(";
 			  args =
 			    LIST1
-			      [ arg = pat; ":"; targ = pat -> (arg,targ) ]
+			      [ arg = arg_colon_type -> arg ]
 			      SEP ",";
 			  ")" -> args ];
-	     ":"; tres = pat ;
+	     ":" ; tres = pat ;
 	     "="; body = expr ->
 	       `Compact (targ1,args,others,tres,body)
+
      ] ->
-       match res with
-	 | `Classic (p2,a,b) -> (p1,p2)::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)]
+     match res with
+     | `Classic (p2,a,b) -> (p1,p2)::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 p1, targ1 =
+         match p1.descr,targ1 with
+           PatVar(id1, []), None ->
+           split_id_list _loc (List.map Ident.U.get_str id1)
+         | _, Some targ1 -> p1, targ1
+         | _ -> raise Stream.Failure
+       in
+       let (targ,arg) = mkfun ((p1,targ1) :: args) in
+       [(targ,tres)],[(arg,body)]
     ]
   ];
 
@@ -575,7 +612,7 @@ EXTEND Gram
 
   pat: [
     [ x = pat; "where";
-      b = LIST1 [ x = located_ident; "="; y = pat -> (x,[],y) ] SEP "and" -> 
+      b = LIST1 [ x = located_ident; "="; y = pat -> (x,[],y) ] SEP "and" ->
         mk _loc (Recurs (x,b)) ]
     | RIGHTA [ x = pat; "->"; y = pat -> mk _loc (Arrow (x,y))
              | x = pat; "@"; y = pat -> mk _loc (Concat (x,y))
@@ -583,7 +620,7 @@ EXTEND Gram
     | "no_arrow" [ x = pat; "|"; y = pat -> mk _loc (Or (x,y)) ]
     | "simple" [ x = pat; "&"; y = pat -> mk _loc (And (x,y))
 	         | x = pat; "\\"; y = pat -> mk _loc (Diff (x,y)) ]
-    | "var" [ x = PVAR -> 
+    | "var" [ x = PVAR ->
         mk _loc (Internal (Types.var (Var.mk (ident_aux x)))) ]
     |
       [ "{"; r = record_spec; "}" -> r
@@ -633,7 +670,7 @@ EXTEND Gram
 	       mk _loc (Regexp r)
       | "<"; t =
             [ x = tag_type -> x
-            | "("; t = pat; ")" -> t ]; 
+            | "("; t = pat; ")" -> t ];
             a = attrib_spec; ">"; c = pat ->
               mk _loc (XmlT (t, multi_prod _loc [a;c]))
       | s = STRING ->
@@ -653,11 +690,11 @@ EXTEND Gram
 
   or_else : [ [ OPT [ "else"; y = pat -> y ]  ] ];
 
-  opt_field_pat: [ 
+  opt_field_pat: [
     [ OPT [ "=";
       o = [ "?" -> true | -> false];
-      x = pat;  y = or_else -> (o,x,y) ] 
-    ] 
+      x = pat;  y = or_else -> (o,x,y) ]
+    ]
   ];
 
   record_spec: [
@@ -688,7 +725,7 @@ EXTEND Gram
 
   opt_field_expr: [ [ OPT [ "="; x = expr LEVEL "no_appl" -> x ] ] ];
 
-  expr_record_spec: [ 
+  expr_record_spec: [
     [ r = LIST0 [ l = ident_or_keyword;
         x = opt_field_expr; OPT ";" ->
           let x = match x with Some x -> x | None ->  Var (ident l) in