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
2011-12-27 08:54:18 +00:00 · 2011-12-27 08:54:18 +00:00 · dd29cb76ea
parent 76ac0c7cb1
commit dd29cb76ea
1 changed files with 77 additions and 0 deletions
--- a/experimental/garrigue/parser-lessminus.diffs
+++ 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