Commit 28985ea2 authored by Pietro Abate's avatar Pietro Abate

[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
parent 49fd3245
......@@ -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: [
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment