1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
Index: parsing/parser.mly
===================================================================
--- parsing/parser.mly (revision 11929)
+++ parsing/parser.mly (working copy)
@@ -319,6 +319,11 @@
let polyvars, core_type = varify_constructors newtypes core_type in
(exp, ghtyp(Ptyp_poly(polyvars,core_type)))
+let no_lessminus =
+ List.map (fun (p,e,b) ->
+ match b with None -> (p,e)
+ | Some loc -> raise (Syntaxerr.Error (Syntaxerr.Other loc)))
+
%}
/* Tokens */
@@ -597,8 +602,9 @@
structure_item:
LET rec_flag let_bindings
{ match $3 with
- [{ ppat_desc = Ppat_any; ppat_loc = _ }, exp] -> mkstr(Pstr_eval exp)
- | _ -> mkstr(Pstr_value($2, List.rev $3)) }
+ [{ ppat_desc = Ppat_any; ppat_loc = _ }, exp, None] ->
+ mkstr(Pstr_eval exp)
+ | _ -> mkstr(Pstr_value($2, no_lessminus (List.rev $3))) }
| EXTERNAL val_ident COLON core_type EQUAL primitive_declaration
{ mkstr(Pstr_primitive($2, {pval_type = $4; pval_prim = $6})) }
| TYPE type_declarations
@@ -744,7 +750,7 @@
| class_simple_expr simple_labeled_expr_list
{ mkclass(Pcl_apply($1, List.rev $2)) }
| LET rec_flag let_bindings IN class_expr
- { mkclass(Pcl_let ($2, List.rev $3, $5)) }
+ { mkclass(Pcl_let ($2, no_lessminus (List.rev $3), $5)) }
;
class_simple_expr:
LBRACKET core_type_comma_list RBRACKET class_longident
@@ -981,9 +987,15 @@
| simple_expr simple_labeled_expr_list
{ mkexp(Pexp_apply($1, List.rev $2)) }
| LET rec_flag let_bindings IN seq_expr
- { mkexp(Pexp_let($2, List.rev $3, $5)) }
+ { match $3 with
+ | [pat, expr, Some loc] when $2 = Nonrecursive ->
+ mkexp(Pexp_apply(
+ {pexp_desc = Pexp_ident(Lident "bind"); pexp_loc = loc},
+ ["", expr; "", ghexp(Pexp_function("", None, [pat, $5]))]))
+ | bindings ->
+ mkexp(Pexp_let($2, no_lessminus (List.rev $3), $5)) }
| LET DOT simple_expr let_binding IN seq_expr
- { let (pat, expr) = $4 in
+ { let (pat, expr, _) = $4 in
mkexp(Pexp_apply($3, ["", expr; "", ghexp(Pexp_function("", None, [pat, $6]))])) }
| LET MODULE UIDENT module_binding IN seq_expr
{ mkexp(Pexp_letmodule($3, $4, $6)) }
@@ -1197,14 +1209,17 @@
;
let_binding:
val_ident fun_binding
- { (mkpatvar $1 1, $2) }
+ { (mkpatvar $1 1, $2, None) }
| val_ident COLON typevar_list DOT core_type EQUAL seq_expr
- { (ghpat(Ppat_constraint(mkpatvar $1 1, ghtyp(Ptyp_poly($3,$5)))), $7) }
+ { (ghpat(Ppat_constraint(mkpatvar $1 1, ghtyp(Ptyp_poly($3,$5)))), $7,
+ None) }
| val_ident COLON TYPE lident_list DOT core_type EQUAL seq_expr
{ let exp, poly = wrap_type_annotation $4 $6 $8 in
- (ghpat(Ppat_constraint(mkpatvar $1 1, poly)), exp) }
+ (ghpat(Ppat_constraint(mkpatvar $1 1, poly)), exp, None) }
| pattern EQUAL seq_expr
- { ($1, $3) }
+ { ($1, $3, None) }
+ | pattern LESSMINUS seq_expr
+ { ($1, $3, Some (rhs_loc 2)) }
;
fun_binding:
strict_binding
|
