A small patch to call 'bind' for syntax 'let x <- expr in cont'

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@11959 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

1 files changed, 77 insertions, 0 deletions

diff --git a/experimental/garrigue/parser-lessminus.diffs b/experimental/garrigue/parser-lessminus.diffs
new file mode 100644
index 000000000..7b535307c
--- /dev/null
+++ b/experimental/garrigue/parser-lessminus.diffs
@@ -0,0 +1,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