[r2003-05-31 21:26:43 by cvscast] optional fun in let fun f (...)

Original author: cvscast
Date: 2003-05-31 21:26:43+00:00

parser/parser.ml

@@ -98,6 +98,16 @@ let protect_exn f g =
   try let x = f () in g (); x
   with e -> g (); raise e
 
+let is_fun_decl =
+   Grammar.Entry.of_parser gram "[is_fun_decl]"
+     (fun strm ->
+       match Stream.npeek 3 strm with
+	 | [ ("", "fun"); ("LIDENT", _); ("", "(") ]
+	 | [ ("LIDENT", _) ; ("", "(") ; _ ] -> ()
+	 | _ -> raise Stream.Failure
+     )
+
+
 EXTEND
   GLOBAL: top_phrases prog expr pat regexp const;
 
@@ -276,42 +286,45 @@ EXTEND
   ];
 	  
   let_binding: [
-    [ "let"; p = pat; "="; e = expr -> (false,p,e)
-    | "let"; p = pat; ":"; t = pat; "="; e = expr -> (false,p, Forget (e,t))
-    | "let"; "fun"; (f,a,b) = fun_decl ->
-	let p = match f with 
-	  | Some x -> mk loc (Capture x)
-	  | _ -> failwith "Function name mandatory in let fun declarations"
-	in
-	let abst = { fun_name = f; fun_iface = a; fun_body = b } in
+    [ "let"; is_fun_decl; OPT "fun"; (f,a,b) = fun_decl ->
+	let f = match f with Some x -> x | None -> assert false in
+	let p = mk loc (Capture f) in
+	let abst = { fun_name = Some f; fun_iface = a; fun_body = b } in
         let e = exp loc (Abstraction abst) in
         (true,p,e)
+    | "let"; p = pat; "="; e = expr -> (false,p,e)
+    | "let"; p = pat; ":"; t = pat; "="; e = expr -> (false,p, Forget (e,t))
     ] 
   ];
 
- fun_decl: [
+ fun_decl_after_lparen: [
 (* need an hack to do this, because both productions would
    match   [ OPT LIDENT; "("; pat ] .... *)
-   [ f = OPT [ x = LIDENT -> ident x]; "("; 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 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
+   [ 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) -> (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) ] ];
+
+
+ fun_decl: [
+   [ f = OPT [ x = LIDENT -> ident x]; "("; (a,b) = fun_decl_after_lparen ->
 	    (f,a,b)
-  ]
+   ]
  ];
 
  arrow: [