Fix issue #51, top-level lwt bindings were not implemented

ocaml · Jul 24, 2013 · d770474 · d770474
1 parent e2a0045
commit d770474
Show file tree

Hide file tree

Showing 2 changed files with 10 additions and 2 deletions.
diff --git a/src/chunk_parser.mly b/src/chunk_parser.mly
@@ -470,7 +470,7 @@ The precedences must be listed from low to high.
 %nonassoc IN
 %nonassoc below_SEMI
 %nonassoc SEMI                          (* below EQUAL ({lbl=...; lbl=...}) *)
-%nonassoc LET                           (* above SEMI ( ...; let ... in ...) *)
+%nonassoc LET LET_LWT                   (* above SEMI ( ...; let ... in ...) *)
 %nonassoc below_WITH
 %nonassoc FUNCTION WITH                 (* below BAR  (match ... with ...) *)
 %nonassoc FINALLY_LWT
@@ -608,6 +608,12 @@ structure_item:
             [mkstr $startpos $endpos (Pstr_eval exp)]
         | _ -> [mkstr $startpos $endpos (Pstr_value($2, List.rev $3))]
       }
+  | LET_LWT rec_flag let_bindings
+      { match $3 with
+        | [{ ppat_desc = Ppat_any; ppat_loc = _ }, exp] ->
+            [mkstr $startpos $endpos (Pstr_eval (Fake.app Fake.Lwt.un_lwt exp))]
+        | _ -> [mkstr $startpos $endpos (Pstr_value($2, List.rev_map (Fake.pat_app Fake.Lwt.un_lwt) $3))]
+      }
   | EXTERNAL val_ident COLON core_type EQUAL primitive_declaration
       { [mkstr $startpos $endpos
           (Pstr_primitive (mkrhs $startpos($2) $endpos($2) $2,

diff --git a/src/outline_parser.mly b/src/outline_parser.mly
@@ -169,7 +169,7 @@ The precedences must be listed from low to high.
 %nonassoc IN
 %nonassoc below_SEMI
 %nonassoc SEMI                          (* below EQUAL ({ () }) *)
-%nonassoc LET                           (* above SEMI ( ...; let ... in ...) *)
+%nonassoc LET LET_LWT                   (* above SEMI ( ...; let ... in ...) *)
 %nonassoc below_WITH
 %nonassoc FUNCTION WITH                 (* below BAR  (match ... with ...) *)
 %nonassoc FINALLY_LWT
@@ -302,6 +302,8 @@ comma_ext_list:
 structure_item:
     LET rec_flag let_bindings
       { emit_top Definition $endpos }
+  | LET_LWT rec_flag let_bindings
+      { emit_top Definition $endpos }
   | EXTERNAL val_ident COLON core_type EQUAL primitive_declaration
       { emit_top Definition $endpos }
   | TYPE type_declarations with_extension