Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
cduce
cduce
Commits
28985ea2
Commit
28985ea2
authored
Oct 05, 2007
by
Pietro Abate
Browse files
[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
Changes
1
Hide whitespace changes
Inline
Side-by-side
parser/parser.ml
View file @
28985ea2
...
...
@@ -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
:
[
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment