merge with trunk at rev 14512ephemeron

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

10 files changed, 218 insertions, 113 deletions

diff --git a/parsing/ast_helper.ml b/parsing/ast_helper.ml
index ed49f65a33..46696bc1cb 100644
--- a/parsing/ast_helper.ml
+++ b/parsing/ast_helper.ml
@@ -125,6 +125,7 @@ module Mty = struct
   let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]}
 
   let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a)
+  let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a)
   let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a)
   let functor_ ?loc ?attrs a b c = mk ?loc ?attrs (Pmty_functor (a, b, c))
   let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b))
@@ -263,29 +264,32 @@ module Val = struct
 end
 
 module Md = struct
-  let mk ?(attrs = []) name typ =
+  let mk ?(loc = !default_loc) ?(attrs = []) name typ =
     {
      pmd_name = name;
      pmd_type = typ;
      pmd_attributes = attrs;
+     pmd_loc = loc;
     }
 end
 
 module Mtd = struct
-  let mk ?(attrs = []) ?typ name =
+  let mk ?(loc = !default_loc) ?(attrs = []) ?typ name =
     {
      pmtd_name = name;
      pmtd_type = typ;
      pmtd_attributes = attrs;
+     pmtd_loc = loc;
     }
 end
 
 module Mb = struct
-  let mk ?(attrs = []) name expr =
+  let mk ?(loc = !default_loc) ?(attrs = []) name expr =
     {
      pmb_name = name;
      pmb_expr = expr;
      pmb_attributes = attrs;
+     pmb_loc = loc;
     }
 end
 
@@ -370,7 +374,7 @@ module Convenience = struct
   let may_tuple tup = function
     | [] -> None
     | [x] -> Some x
-    | l -> Some (tup l)
+    | l -> Some (tup ?loc:None ?attrs:None l)
 
   let lid s = mkloc (Longident.parse s) !default_loc
   let tuple l = Exp.tuple l
diff --git a/parsing/ast_helper.mli b/parsing/ast_helper.mli
index 562f519898..a0768a4ee1 100644
--- a/parsing/ast_helper.mli
+++ b/parsing/ast_helper.mli
@@ -100,7 +100,7 @@ module Exp:
     val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression option -> expression
     val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression
     val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression
-    val for_: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression -> direction_flag -> expression -> expression
+    val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression -> direction_flag -> expression -> expression
     val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> core_type -> expression
     val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type -> expression
     val send: ?loc:loc -> ?attrs:attrs -> expression -> string -> expression
@@ -144,8 +144,10 @@ module Mty:
     val attr: module_type -> attribute -> module_type
 
     val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type
+    val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type
     val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type
-    val functor_: ?loc:loc -> ?attrs:attrs -> str -> module_type -> module_type -> module_type
+    val functor_: ?loc:loc -> ?attrs:attrs ->
+      str -> module_type option -> module_type -> module_type
     val with_: ?loc:loc -> ?attrs:attrs -> module_type -> with_constraint list -> module_type
     val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type
     val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type
@@ -159,7 +161,8 @@ module Mod:
 
     val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr
     val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr
-    val functor_: ?loc:loc -> ?attrs:attrs -> str -> module_type -> module_expr -> module_expr
+    val functor_: ?loc:loc -> ?attrs:attrs ->
+      str -> module_type option -> module_expr -> module_expr
     val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> module_expr
     val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> module_expr
     val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr
@@ -210,19 +213,19 @@ module Str:
 (** Module declarations *)
 module Md:
   sig
-    val mk: ?attrs:attrs -> str -> module_type -> module_declaration
+    val mk: ?loc:loc -> ?attrs:attrs -> str -> module_type -> module_declaration
   end
 
 (** Module type declarations *)
 module Mtd:
   sig
-    val mk: ?attrs:attrs -> ?typ:module_type -> str -> module_type_declaration
+    val mk: ?loc:loc -> ?attrs:attrs -> ?typ:module_type -> str -> module_type_declaration
   end
 
 (** Module bindings *)
 module Mb:
   sig
-    val mk: ?attrs:attrs -> str -> module_expr -> module_binding
+    val mk: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> module_binding
   end
 
 (** Value bindings *)
diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml
index e10e32cbd1..03371b0cea 100644
--- a/parsing/ast_mapper.ml
+++ b/parsing/ast_mapper.ml
@@ -12,6 +12,10 @@
 
 (* A generic Parsetree mapping class *)
 
+;; [@@warning "+9"]
+  (* Ensure that record patterns don't miss any field. *)
+
+
 open Parsetree
 open Ast_helper
 open Location
@@ -159,9 +163,11 @@ module MT = struct
     let attrs = sub.attributes sub attrs in
     match desc with
     | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s)
+    | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s)
     | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg)
     | Pmty_functor (s, mt1, mt2) ->
-        functor_ ~loc ~attrs (map_loc sub s) (sub.module_type sub mt1)
+        functor_ ~loc ~attrs (map_loc sub s)
+          (Misc.may_map (sub.module_type sub) mt1)
           (sub.module_type sub mt2)
     | Pmty_with (mt, l) ->
         with_ ~loc ~attrs (sub.module_type sub mt)
@@ -213,7 +219,8 @@ module M = struct
     | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x)
     | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str)
     | Pmod_functor (arg, arg_ty, body) ->
-        functor_ ~loc ~attrs (map_loc sub arg) (sub.module_type sub arg_ty)
+        functor_ ~loc ~attrs (map_loc sub arg)
+          (Misc.may_map (sub.module_type sub) arg_ty)
           (sub.module_expr sub body)
     | Pmod_apply (m1, m2) ->
         apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2)
@@ -292,8 +299,8 @@ module E = struct
     | Pexp_sequence (e1, e2) ->
         sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2)
     | Pexp_while (e1, e2) -> while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2)
-    | Pexp_for (id, e1, e2, d, e3) ->
-        for_ ~loc ~attrs (map_loc sub id) (sub.expr sub e1) (sub.expr sub e2) d
+    | Pexp_for (p, e1, e2, d, e3) ->
+        for_ ~loc ~attrs (sub.pat sub p) (sub.expr sub e1) (sub.expr sub e2) d
           (sub.expr sub e3)
     | Pexp_coerce (e, t1, t2) ->
         coerce ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t1)
@@ -425,15 +432,18 @@ let default_mapper =
     signature_item = MT.map_signature_item;
     module_type = MT.map;
     with_constraint = MT.map_with_constraint;
-    class_declaration = (fun this -> CE.class_infos this (this.class_expr this));
+    class_declaration =
+      (fun this -> CE.class_infos this (this.class_expr this));
     class_expr = CE.map;
     class_field = CE.map_field;
     class_structure = CE.map_structure;
     class_type = CT.map;
     class_type_field = CT.map_field;
     class_signature = CT.map_signature;
-    class_type_declaration = (fun this -> CE.class_infos this (this.class_type this));
-    class_description = (fun this -> CE.class_infos this (this.class_type this));
+    class_type_declaration =
+      (fun this -> CE.class_infos this (this.class_type this));
+    class_description =
+      (fun this -> CE.class_infos this (this.class_type this));
     type_declaration = T.map_type_declaration;
     type_kind = T.map_type_kind;
     typ = T.map;
@@ -453,26 +463,28 @@ let default_mapper =
     expr = E.map;
 
     module_declaration =
-      (fun this {pmd_name; pmd_type; pmd_attributes} ->
+      (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} ->
          Md.mk
            (map_loc this pmd_name)
            (this.module_type this pmd_type)
            ~attrs:(this.attributes this pmd_attributes)
+           ~loc:(this.location this pmd_loc)
       );
 
     module_type_declaration =
-      (fun this {pmtd_name; pmtd_type; pmtd_attributes} ->
-         {
-           pmtd_name = map_loc this pmtd_name;
-           pmtd_type =map_opt (this.module_type this) pmtd_type;
-           pmtd_attributes = this.attributes this pmtd_attributes;
-         }
+      (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} ->
+         Mtd.mk
+           (map_loc this pmtd_name)
+           ?typ:(map_opt (this.module_type this) pmtd_type)
+           ~attrs:(this.attributes this pmtd_attributes)
+           ~loc:(this.location this pmtd_loc)
       );
 
     module_binding =
-      (fun this {pmb_name; pmb_expr; pmb_attributes} ->
+      (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} ->
          Mb.mk (map_loc this pmb_name) (this.module_expr this pmb_expr)
            ~attrs:(this.attributes this pmb_attributes)
+           ~loc:(this.location this pmb_loc)
       );
 
     value_binding =
diff --git a/parsing/lexer.mli b/parsing/lexer.mli
index b067b2aa3e..b54f111041 100644
--- a/parsing/lexer.mli
+++ b/parsing/lexer.mli
@@ -21,7 +21,7 @@ type error =
   | Illegal_escape of string
   | Unterminated_comment of Location.t
   | Unterminated_string
-  | Unterminated_string_in_comment of Location.t
+  | Unterminated_string_in_comment of Location.t * Location.t
   | Keyword_as_label of string
   | Literal_overflow of string
 ;;
diff --git a/parsing/lexer.mll b/parsing/lexer.mll
index 8aed03b2fc..910027c044 100644
--- a/parsing/lexer.mll
+++ b/parsing/lexer.mll
@@ -22,7 +22,7 @@ type error =
   | Illegal_escape of string
   | Unterminated_comment of Location.t
   | Unterminated_string
-  | Unterminated_string_in_comment of Location.t
+  | Unterminated_string_in_comment of Location.t * Location.t
   | Keyword_as_label of string
   | Literal_overflow of string
 ;;
@@ -235,8 +235,9 @@ let report_error ppf = function
       fprintf ppf "Comment not terminated"
   | Unterminated_string ->
       fprintf ppf "String literal not terminated"
-  | Unterminated_string_in_comment _ ->
-      fprintf ppf "This comment contains an unterminated string literal"
+  | Unterminated_string_in_comment (_, loc) ->
+      fprintf ppf "This comment contains an unterminated string literal@.%aString literal begins here"
+        Location.print_error loc
   | Keyword_as_label kwd ->
       fprintf ppf "`%s' is a keyword, it cannot be used as label name" kwd
   | Literal_overflow ty ->
@@ -254,7 +255,7 @@ let () =
 
 }
 
-let newline = ('\010' | "\013\010" )
+let newline = ('\013'* '\010' )
 let blank = [' ' '\009' '\012']
 let lowercase = ['a'-'z' '_']
 let uppercase = ['A'-'Z']
@@ -492,13 +493,14 @@ and comment = parse
         store_string_char '"';
         is_in_string := true;
         begin try string lexbuf
-        with Error (Unterminated_string, _) ->
+        with Error (Unterminated_string, str_start) ->
           match !comment_start_loc with
           | [] -> assert false
           | loc :: _ ->
             let start = List.hd (List.rev !comment_start_loc) in
             comment_start_loc := [];
-            raise (Error (Unterminated_string_in_comment start, loc))
+            raise (Error (Unterminated_string_in_comment (start, str_start),
+                          loc))
         end;
         is_in_string := false;
         store_string_char '"';
@@ -511,13 +513,13 @@ and comment = parse
         store_lexeme lexbuf;
         is_in_string := true;
         begin try quoted_string delim lexbuf
-        with Error (Unterminated_string, _) ->
+        with Error (Unterminated_string, str_start) ->
           match !comment_start_loc with
           | [] -> assert false
           | loc :: _ ->
             let start = List.hd (List.rev !comment_start_loc) in
             comment_start_loc := [];
-            raise (Error (Unterminated_string_in_comment start, loc))
+            raise (Error (Unterminated_string_in_comment (start, str_start), loc))
         end;
         is_in_string := false;
         store_string_char '|';
diff --git a/parsing/parser.mly b/parsing/parser.mly
index 8b69f265ea..5a414ef848 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -510,16 +510,18 @@ top_structure_tail:
 ;
 use_file:
     use_file_tail                        { $1 }
-  | seq_expr post_item_attributes use_file_tail               { Ptop_def[mkstrexp $1 $2] :: $3 }
+  | seq_expr post_item_attributes use_file_tail
+                                         { Ptop_def[mkstrexp $1 $2] :: $3 }
 ;
 use_file_tail:
-    EOF                                         { [] }
-  | SEMISEMI EOF                                { [] }
-  | SEMISEMI seq_expr post_item_attributes use_file_tail             { Ptop_def[mkstrexp $2 $3] :: $4 }
-  | SEMISEMI structure_item use_file_tail       { Ptop_def[$2] :: $3 }
-  | SEMISEMI toplevel_directive use_file_tail   { $2 :: $3 }
-  | structure_item use_file_tail                { Ptop_def[$1] :: $2 }
-  | toplevel_directive use_file_tail            { $1 :: $2 }
+    EOF                                       { [] }
+  | SEMISEMI EOF                              { [] }
+  | SEMISEMI seq_expr post_item_attributes use_file_tail
+                                              { Ptop_def[mkstrexp $2 $3] :: $4 }
+  | SEMISEMI structure_item use_file_tail     { Ptop_def[$2] :: $3 }
+  | SEMISEMI toplevel_directive use_file_tail { $2 :: $3 }
+  | structure_item use_file_tail              { Ptop_def[$1] :: $2 }
+  | toplevel_directive use_file_tail          { $1 :: $2 }
 ;
 parse_core_type:
     core_type EOF { $1 }
@@ -533,6 +535,25 @@ parse_pattern:
 
 /* Module expressions */
 
+functor_arg:
+    LPAREN RPAREN
+      { mkrhs "()" 2, None }
+  | LPAREN functor_arg_name COLON module_type RPAREN
+      { mkrhs $2 2, Some $4 }
+;
+
+functor_arg_name:
+    UIDENT     { $1 }
+  | UNDERSCORE { "_" }
+;
+
+functor_args:
+    functor_args functor_arg
+      { $2 :: $1 }
+  | functor_arg
+      { [ $1 ] }
+;
+
 module_expr:
     mod_longident
       { mkmod(Pmod_ident (mkrhs $1 1)) }
@@ -540,10 +561,12 @@ module_expr:
       { mkmod(Pmod_structure($2)) }
   | STRUCT structure error
       { unclosed "struct" 1 "end" 3 }
-  | FUNCTOR LPAREN UIDENT COLON module_type RPAREN MINUSGREATER module_expr
-      { mkmod(Pmod_functor(mkrhs $3 3, $5, $8)) }
+  | FUNCTOR functor_args MINUSGREATER module_expr
+      { List.fold_left (fun acc (n, t) -> mkmod(Pmod_functor(n, t, acc))) $4 $2 }
   | module_expr LPAREN module_expr RPAREN
       { mkmod(Pmod_apply($1, $3)) }
+  | module_expr LPAREN RPAREN
+      { mkmod(Pmod_apply($1, mkmod (Pmod_structure []))) }
   | module_expr LPAREN module_expr error
       { unclosed "(" 2 ")" 4 }
   | LPAREN module_expr COLON module_type RPAREN
@@ -595,7 +618,8 @@ structure_item:
     LET ext_attributes rec_flag let_bindings
       {
         match $4 with
-          [ {pvb_pat = { ppat_desc = Ppat_any; ppat_loc = _ }; pvb_expr = exp; pvb_attributes = attrs}] ->
+          [ {pvb_pat = { ppat_desc = Ppat_any; ppat_loc = _ };
+             pvb_expr = exp; pvb_attributes = attrs}] ->
             let exp = wrap_exp_attrs exp $2 in
             mkstr(Pstr_eval (exp, attrs))
         | l ->
@@ -605,7 +629,8 @@ structure_item:
             | None, _ :: _ -> not_expecting 2 "attribute"
             end
       }
-  | EXTERNAL val_ident COLON core_type EQUAL primitive_declaration post_item_attributes
+  | EXTERNAL val_ident COLON core_type EQUAL primitive_declaration
+    post_item_attributes
       { mkstr
           (Pstr_primitive (Val.mk (mkrhs $2 2) $4
                              ~prim:$6 ~attrs:$7 ~loc:(symbol_rloc ()))) }
@@ -620,9 +645,11 @@ structure_item:
   | MODULE REC module_bindings
       { mkstr(Pstr_recmodule(List.rev $3)) }
   | MODULE TYPE ident post_item_attributes
-      { mkstr(Pstr_modtype (Mtd.mk (mkrhs $3 3) ~attrs:$4)) }
+      { mkstr(Pstr_modtype (Mtd.mk (mkrhs $3 3)
+                              ~attrs:$4 ~loc:(symbol_rloc()))) }
   | MODULE TYPE ident EQUAL module_type post_item_attributes
-      { mkstr(Pstr_modtype (Mtd.mk (mkrhs $3 3) ~typ:$5 ~attrs:$6)) }
+      { mkstr(Pstr_modtype (Mtd.mk (mkrhs $3 3)
+                              ~typ:$5 ~attrs:$6 ~loc:(symbol_rloc()))) }
   | OPEN override_flag mod_longident post_item_attributes
       { mkstr(Pstr_open ($2, mkrhs $3 3, $4)) }
   | CLASS class_declarations
@@ -639,8 +666,8 @@ module_binding_body:
       { $2 }
   | COLON module_type EQUAL module_expr
       { mkmod(Pmod_constraint($4, $2)) }
-  | LPAREN UIDENT COLON module_type RPAREN module_binding_body
-      { mkmod(Pmod_functor(mkrhs $2 2, $4, $6)) }
+  | functor_arg module_binding_body
+      { mkmod(Pmod_functor(fst $1, snd $1, $2)) }
 ;
 module_bindings:
     module_binding                        { [$1] }
@@ -648,7 +675,7 @@ module_bindings:
 ;
 module_binding:
     UIDENT module_binding_body post_item_attributes
-    { Mb.mk (mkrhs $1 1) $2 ~attrs:$3 }
+    { Mb.mk (mkrhs $1 1) $2 ~attrs:$3 ~loc:(symbol_rloc ()) }
 ;
 
 /* Module types */
@@ -660,13 +687,15 @@ module_type:
       { mkmty(Pmty_signature $2) }
   | SIG signature error
       { unclosed "sig" 1 "end" 3 }
-  | FUNCTOR LPAREN UIDENT COLON module_type RPAREN MINUSGREATER module_type
+  | FUNCTOR functor_args MINUSGREATER module_type
       %prec below_WITH
-      { mkmty(Pmty_functor(mkrhs $3 3, $5, $8)) }
+      { List.fold_left (fun acc (n, t) -> mkmty(Pmty_functor(n, t, acc))) $4 $2 }
   | module_type WITH with_constraints
       { mkmty(Pmty_with($1, List.rev $3)) }
   | MODULE TYPE OF module_expr %prec below_LBRACKETAT
       { mkmty(Pmty_typeof $4) }
+  | LPAREN MODULE mod_longident RPAREN
+      { mkmty (Pmty_alias (mkrhs $3 3)) }
   | LPAREN module_type RPAREN
       { $2 }
   | LPAREN module_type error
@@ -692,7 +721,8 @@ signature_item:
     VAL val_ident COLON core_type post_item_attributes
       { mksig(Psig_value
                 (Val.mk (mkrhs $2 2) $4 ~attrs:$5 ~loc:(symbol_rloc()))) }
-  | EXTERNAL val_ident COLON core_type EQUAL primitive_declaration post_item_attributes
+  | EXTERNAL val_ident COLON core_type EQUAL primitive_declaration
+    post_item_attributes
       { mksig(Psig_value
                 (Val.mk (mkrhs $2 2) $4 ~prim:$6 ~attrs:$7
                    ~loc:(symbol_rloc()))) }
@@ -701,13 +731,23 @@ signature_item:
   | EXCEPTION exception_declaration
       { mksig(Psig_exception $2) }
   | MODULE UIDENT module_declaration post_item_attributes
-      { mksig(Psig_module (Md.mk (mkrhs $2 2) $3 ~attrs:$4)) }
+      { mksig(Psig_module (Md.mk (mkrhs $2 2)
+                             $3 ~attrs:$4 ~loc:(symbol_rloc()))) }
+  | MODULE UIDENT EQUAL mod_longident post_item_attributes
+      { mksig(Psig_module (Md.mk (mkrhs $2 2)
+                             (Mty.alias ~loc:(rhs_loc 4) (mkrhs $4 4))
+                             ~attrs:$5
+                             ~loc:(symbol_rloc())
+                          )) }
   | MODULE REC module_rec_declarations
       { mksig(Psig_recmodule (List.rev $3)) }
   | MODULE TYPE ident post_item_attributes
-      { mksig(Psig_modtype (Mtd.mk (mkrhs $3 3) ~attrs:$4)) }
+      { mksig(Psig_modtype (Mtd.mk (mkrhs $3 3)
+                              ~attrs:$4 ~loc:(symbol_rloc()))) }
   | MODULE TYPE ident EQUAL module_type post_item_attributes
-      { mksig(Psig_modtype (Mtd.mk (mkrhs $3 3) ~typ:$5 ~attrs:$6)) }
+      { mksig(Psig_modtype (Mtd.mk (mkrhs $3 3) ~typ:$5
+                              ~loc:(symbol_rloc())
+                              ~attrs:$6)) }
   | OPEN override_flag mod_longident post_item_attributes
       { mksig(Psig_open ($2, mkrhs $3 3, $4)) }
   | INCLUDE module_type post_item_attributes %prec below_WITH
@@ -724,7 +764,9 @@ module_declaration:
     COLON module_type
       { $2 }
   | LPAREN UIDENT COLON module_type RPAREN module_declaration
-      { mkmty(Pmty_functor(mkrhs $2 2, $4, $6)) }
+      { mkmty(Pmty_functor(mkrhs $2 2, Some $4, $6)) }
+  | LPAREN RPAREN module_declaration
+      { mkmty(Pmty_functor(mkrhs "()" 1, None, $3)) }
 ;
 module_rec_declarations:
     module_rec_declaration                              { [$1] }
@@ -732,7 +774,7 @@ module_rec_declarations:
 ;
 module_rec_declaration:
     UIDENT COLON module_type post_item_attributes
-    { Md.mk (mkrhs $1 1) $3 ~attrs:$4 }
+    { Md.mk (mkrhs $1 1) $3 ~attrs:$4 ~loc:(symbol_rloc()) }
 ;
 
 /* Class expressions */
@@ -1048,8 +1090,8 @@ expr:
       { mkexp_attrs (Pexp_ifthenelse($3, $5, None)) $2 }
   | WHILE ext_attributes seq_expr DO seq_expr DONE
       { mkexp_attrs (Pexp_while($3, $5)) $2 }
-  | FOR ext_attributes val_ident EQUAL seq_expr direction_flag seq_expr DO seq_expr DONE
-      { mkexp_attrs(Pexp_for(mkrhs $3 3, $5, $7, $6, $9)) $2 }
+  | FOR ext_attributes pattern EQUAL seq_expr direction_flag seq_expr DO seq_expr DONE
+      { mkexp_attrs(Pexp_for($3, $5, $7, $6, $9)) $2 }
   | expr COLONCOLON expr
       { mkexp_cons (rhs_loc 2) (ghexp(Pexp_tuple[$1;$3])) (symbol_rloc()) }
   | LPAREN COLONCOLON RPAREN LPAREN expr COMMA expr RPAREN
@@ -1165,16 +1207,31 @@ simple_expr:
       { let (exten, fields) = $2 in mkexp (Pexp_record(fields, exten)) }
   | LBRACE record_expr error
       { unclosed "{" 1 "}" 3 }
+  | mod_longident DOT LBRACE record_expr RBRACE
+      { let (exten, fields) = $4 in
+        let rec_exp = mkexp(Pexp_record(fields, exten)) in
+        mkexp(Pexp_open(Fresh, mkrhs $1 1, rec_exp)) }
+  | mod_longident DOT LBRACE record_expr error
+      { unclosed "{" 3 "}" 5 }
   | LBRACKETBAR expr_semi_list opt_semi BARRBRACKET
       { mkexp (Pexp_array(List.rev $2)) }
   | LBRACKETBAR expr_semi_list opt_semi error
       { unclosed "[|" 1 "|]" 4 }
   | LBRACKETBAR BARRBRACKET
       { mkexp (Pexp_array []) }
+  | mod_longident DOT LBRACKETBAR expr_semi_list opt_semi BARRBRACKET
+      { mkexp(Pexp_open(Fresh, mkrhs $1 1, mkexp(Pexp_array(List.rev $4)))) }
+  | mod_longident DOT LBRACKETBAR expr_semi_list opt_semi error
+      { unclosed "[|" 3 "|]" 6 }
   | LBRACKET expr_semi_list opt_semi RBRACKET
       { reloc_exp (mktailexp (rhs_loc 4) (List.rev $2)) }
   | LBRACKET expr_semi_list opt_semi error
       { unclosed "[" 1 "]" 4 }
+  | mod_longident DOT LBRACKET expr_semi_list opt_semi RBRACKET
+      { let list_exp = reloc_exp (mktailexp (rhs_loc 6) (List.rev $4)) in
+        mkexp(Pexp_open(Fresh, mkrhs $1 1, list_exp)) }
+  | mod_longident DOT LBRACKET expr_semi_list opt_semi error
+      { unclosed "[" 3 "]" 6 }
   | PREFIXOP simple_expr
       { mkexp(Pexp_apply(mkoperator $1 1, ["",$2])) }
   | BANG simple_expr
@@ -1187,6 +1244,10 @@ simple_expr:
       { unclosed "{<" 1 ">}" 4 }
   | LBRACELESS GREATERRBRACE
       { mkexp (Pexp_override [])}
+  | mod_longident DOT LBRACELESS field_expr_list opt_semi GREATERRBRACE
+      { mkexp(Pexp_open(Fresh, mkrhs $1 1, mkexp (Pexp_override(List.rev $4)))) }
+  | mod_longident DOT LBRACELESS field_expr_list opt_semi error
+      { unclosed "{<" 3 ">}" 6 }
   | simple_expr SHARP label
       { mkexp(Pexp_send($1, $3)) }
   | LPAREN MODULE module_expr RPAREN
@@ -1196,6 +1257,12 @@ simple_expr:
                                 ghtyp (Ptyp_package $5))) }
   | LPAREN MODULE module_expr COLON error
       { unclosed "(" 1 ")" 5 }
+  | mod_longident DOT LPAREN MODULE module_expr COLON package_type RPAREN
+      { mkexp(Pexp_open(Fresh, mkrhs $1 1,
+        mkexp (Pexp_constraint (ghexp (Pexp_pack $5),
+                                ghtyp (Ptyp_package $7))))) }
+  | mod_longident DOT LPAREN MODULE module_expr COLON error
+      { unclosed "(" 3 ")" 7 }
   | extension
       { mkexp (Pexp_extension $1) }
 ;
@@ -1248,6 +1315,8 @@ let_binding_:
         (ghpat(Ppat_constraint(mkpatvar $1 1, poly)), exp) }
   | pattern EQUAL seq_expr
       { ($1, $3) }
+  | simple_pattern_not_ident COLON core_type EQUAL seq_expr
+      { (ghpat(Ppat_constraint($1, $3)), $5) }
 ;
 fun_binding:
     strict_binding
@@ -1356,6 +1425,9 @@ pattern:
 simple_pattern:
     val_ident %prec below_EQUAL
       { mkpat(Ppat_var (mkrhs $1 1)) }
+  | simple_pattern_not_ident { $1 }
+;
+simple_pattern_not_ident:
   | UNDERSCORE
       { mkpat(Ppat_any) }
   | signed_constant
diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli
index 5de17d439c..7bf5537c6b 100644
--- a/parsing/parsetree.mli
+++ b/parsing/parsetree.mli
@@ -244,7 +244,7 @@ and expression_desc =
   | Pexp_while of expression * expression
         (* while E1 do E2 done *)
   | Pexp_for of
-      string loc *  expression * expression * direction_flag * expression
+      pattern *  expression * expression * direction_flag * expression
         (* for i = E1 to E2 do E3 done      (flag = Upto)
            for i = E1 downto E2 do E3 done  (flag = Downto)
          *)
@@ -543,7 +543,7 @@ and module_type_desc =
         (* S *)
   | Pmty_signature of signature
         (* sig ... end *)
-  | Pmty_functor of string loc * module_type * module_type
+  | Pmty_functor of string loc * module_type option * module_type
         (* functor(X : MT1) -> MT2 *)
   | Pmty_with of module_type * with_constraint list
         (* MT with ... *)
@@ -551,6 +551,8 @@ and module_type_desc =
         (* module type of ME *)
   | Pmty_extension of extension
         (* [%id] *)
+  | Pmty_alias of Longident.t loc
+        (* (module M) *)
 
 and signature = signature_item list
 
@@ -597,6 +599,7 @@ and module_declaration =
      pmd_name: string loc;
      pmd_type: module_type;
      pmd_attributes: attributes; (* ... [@@id1] [@@id2] *)
+     pmd_loc: Location.t;
     }
 (* S : MT *)
 
@@ -605,6 +608,7 @@ and module_type_declaration =
      pmtd_name: string loc;
      pmtd_type: module_type option;
      pmtd_attributes: attributes; (* ... [@@id1] [@@id2] *)
+     pmtd_loc: Location.t;
     }
 (* S = MT
    S       (abstract module type declaration, pmtd_type = None)
@@ -637,7 +641,7 @@ and module_expr_desc =
         (* X *)
   | Pmod_structure of structure
         (* struct ... end *)
-  | Pmod_functor of string loc * module_type * module_expr
+  | Pmod_functor of string loc * module_type option * module_expr
         (* functor(X : MT1) -> ME *)
   | Pmod_apply of module_expr * module_expr
         (* ME1(ME2) *)
@@ -704,6 +708,7 @@ and module_binding =
      pmb_name: string loc;
      pmb_expr: module_expr;
      pmb_attributes: attributes;
+     pmb_loc: Location.t;
     }
 (* X = ME *)
 
diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml
index f8db3d646a..7496ee2525 100644
--- a/parsing/pprintast.ml
+++ b/parsing/pprintast.ml
@@ -31,7 +31,6 @@ let numeric_chars  = [ '0'; '1'; '2'; '3'; '4'; '5'; '6'; '7'; '8'; '9' ]
 
 (* type fixity = Infix| Prefix  *)
 
-
 let special_infix_strings =
   ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; ":="; "!=" ]
 
@@ -56,6 +55,30 @@ let is_predef_option = function
   | (Ldot (Lident "*predef*","option")) -> true
   | _ -> false
 
+(* which identifiers are in fact operators needing parentheses *)
+let needs_parens txt =
+  is_infix (fixity_of_string txt)
+  || List.mem txt.[0] prefix_symbols
+
+(* some infixes need spaces around parens to avoid clashes with comment syntax *)
+let needs_spaces txt =
+  txt.[0]='*' || txt.[String.length txt - 1] = '*'
+
+(* add parentheses to binders when they are in fact infix or prefix operators *)
+let protect_ident ppf txt =
+  let format : (_, _, _) format =
+    if not (needs_parens txt) then "%s"
+    else if needs_spaces txt then "(@;%s@;)"
+    else "(%s)"
+  in fprintf ppf format txt
+
+let protect_longident ppf print_longident longprefix txt =
+  let format : (_, _, _) format =
+    if not (needs_parens txt) then "%a.%s"
+    else if needs_spaces txt then  "(@;%a.%s@;)"
+    else "(%a.%s)" in
+  fprintf ppf format print_longident longprefix txt
+
 type space_formatter = (unit, Format.formatter, unit) format
 
 let override = function
@@ -160,17 +183,8 @@ class printer  ()= object(self:'self)
 
 
   method longident f = function
-    | Lident s ->
-        (match s.[0] with
-        | 'a' .. 'z' | 'A' .. 'Z' | '_'
-          when not (is_infix (fixity_of_string s)) ->
-            pp f "%s" s
-        | _ -> pp f "(@;%s@;)" s )
-    | Ldot(y,s) -> (match s.[0] with
-      | 'a'..'z' | 'A' .. 'Z' | '_' when not(is_infix (fixity_of_string s)) ->
-          pp f "%a.%s" self#longident y s
-      | _ ->
-          pp f "%a.(@;%s@;)@ " self#longident y s)
+    | Lident s -> protect_ident f s
+    | Ldot(y,s) -> protect_longident f self#longident y s
     | Lapply (y,s) ->
         pp f "%a(%a)" self#longident y self#longident s
   method longident_loc f x = pp f "%a" self#longident x.txt
@@ -337,12 +351,7 @@ class printer  ()= object(self:'self)
     end
     else match x.ppat_desc with
     | Ppat_alias (p, s) -> pp f "@[<2>%a@;as@;%a@]"
-          self#pattern p
-          (fun f s->
-            if is_infix (fixity_of_string s.txt)
-               || List.mem s.txt.[0] prefix_symbols
-            then pp f "( %s )" s.txt
-            else pp f "%s" s.txt ) s (* RA*)
+          self#pattern p protect_ident s.txt (* RA*)
     | Ppat_or (p1, p2) -> (* *)
         pp f "@[<hov0>%a@]" (self#list ~sep:"@,|" self#pattern) (list_of_pattern [] x)
     | _ -> self#pattern1 f x
@@ -372,14 +381,7 @@ class printer  ()= object(self:'self)
     match x.ppat_desc with
     | Ppat_construct (({txt=Lident ("()"|"[]" as x);_}), _) -> pp f  "%s" x
     | Ppat_any -> pp f "_";
-    | Ppat_var ({txt = txt;_}) ->
-        if (is_infix (fixity_of_string txt)) || List.mem txt.[0] prefix_symbols then
-          if txt.[0]='*' || txt.[String.length txt - 1] = '*' then
-            pp f "(@;%s@;)@ " txt
-          else
-            pp f "(%s)" txt
-        else
-          pp f "%s" txt
+    | Ppat_var ({txt = txt;_}) -> protect_ident f txt
     | Ppat_array l ->
         pp f "@[<2>[|%a|]@]"  (self#list self#pattern1 ~sep:";") l
     | Ppat_unpack (s) ->
@@ -680,8 +682,8 @@ class printer  ()= object(self:'self)
         pp f fmt self#expression e1 self#expression e2
     | Pexp_for (s, e1, e2, df, e3) ->
         let fmt:(_,_,_)format =
-          "@[<hv0>@[<hv2>@[<2>for %s =@;%a@;%a%a@;do@]@;%a@]@;done@]" in
-        pp f fmt s.txt self#expression e1 self#direction_flag df self#expression e2  self#expression e3
+          "@[<hv0>@[<hv2>@[<2>for %a =@;%a@;%a%a@;do@]@;%a@]@;done@]" in
+        pp f fmt self#pattern s self#expression e1 self#direction_flag df self#expression e2  self#expression e3
     | _ ->  self#paren true self#expression f x
 
   method attributes f l =
@@ -831,10 +833,14 @@ class printer  ()= object(self:'self)
     match x.pmty_desc with
     | Pmty_ident li ->
         pp f "%a" self#longident_loc li;
+    | Pmty_alias li ->
+        pp f "(module %a)" self#longident_loc li;
     | Pmty_signature (s) ->
         pp f "@[<hv0>@[<hv2>sig@ %a@]@ end@]" (* "@[<hov>sig@ %a@ end@]" *)
           (self#list self#signature_item  ) s (* FIXME wrong indentation*)
-    | Pmty_functor (s, mt1, mt2) ->
+    | Pmty_functor (_, None, mt2) ->
+        pp f "@[<hov2>functor () ->@ %a@]" self#module_type mt2 
+    | Pmty_functor (s, Some mt1, mt2) ->
         pp f "@[<hov2>functor@ (%s@ :@ %a)@ ->@ %a@]" s.txt
           self#module_type mt1  self#module_type mt2
     | Pmty_with (mt, l) ->
@@ -873,10 +879,7 @@ class printer  ()= object(self:'self)
         pp f "@[<2>%a@]"
           (fun f vd ->
             let intro = if vd.pval_prim = [] then "val" else "external" in
-            if (is_infix (fixity_of_string vd.pval_name.txt)) || List.mem vd.pval_name.txt.[0] prefix_symbols then
-              pp f "%s@ (@ %s@ )@ :@ " intro vd.pval_name.txt
-            else
-              pp f "%s@ %s@ :@ " intro vd.pval_name.txt;
+            pp f "%s@ %a@ :@ " intro protect_ident vd.pval_name.txt;
             self#value_description f vd;) vd
     | Psig_exception ed ->
         self#exception_declaration f ed
@@ -891,8 +894,13 @@ class printer  ()= object(self:'self)
           (fun f l ->  match l with
             |[]  ->()
             |[x] -> pp f "@[<2>class %a@]" class_description x
-            |_ -> self#list ~first:"@[<v0>class @[<2>" ~sep:"@]@;and @[" ~last:"@]@]"
-                  class_description f l) l
+            |_ ->
+                self#list ~first:"@[<v0>class @[<2>" ~sep:"@]@;and @["
+                  ~last:"@]@]" class_description f l)
+          l
+    | Psig_module {pmd_name; pmd_type={pmty_desc=Pmty_alias alias}} ->
+        pp f "@[<hov>module@ %s@ =@ %a@]"
+          pmd_name.txt self#longident_loc alias
     | Psig_module pmd ->
         pp f "@[<hov>module@ %s@ :@ %a@]"
           pmd.pmd_name.txt
@@ -940,7 +948,9 @@ class printer  ()= object(self:'self)
           self#module_type mt
     | Pmod_ident (li) ->
         pp f "%a" self#longident_loc li;
-    | Pmod_functor (s, mt, me) ->
+    | Pmod_functor (_, None, me) ->
+        pp f "functor ()@;->@;%a" self#module_expr me
+    | Pmod_functor (s, Some mt, me) ->
         pp f "functor@ (%s@ :@ %a)@;->@;%a"
           s.txt  self#module_type mt  self#module_expr me
     | Pmod_apply (me1, me2) ->
@@ -1025,7 +1035,8 @@ class printer  ()= object(self:'self)
     | Pstr_module x ->
         let rec module_helper me = match me.pmod_desc with
         | Pmod_functor(s,mt,me) ->
-            pp f "(%s:%a)"  s.txt  self#module_type mt ;
+            if mt = None then pp f "()"
+            else Misc.may (pp f "(%s:%a)" s.txt self#module_type) mt;
             module_helper me
         | _ -> me in
         pp f "@[<hov2>module %s%a@]"
@@ -1088,13 +1099,7 @@ class printer  ()= object(self:'self)
     | Pstr_class_type (l) ->
         self#class_type_declaration_list f l ;
     | Pstr_primitive vd ->
-        let need_parens =
-          match vd.pval_name.txt with
-          | "or" | "mod" | "land"| "lor" | "lxor" | "lsl" | "lsr" | "asr" -> true
-          | _ -> match vd.pval_name.txt.[0] with
-              'a'..'z' -> false | _ -> true in
-        pp f "@[<hov2>external@ %s@ :@ %a@]"
-          (if need_parens then "( "^vd.pval_name.txt^" )" else vd.pval_name.txt)
+        pp f "@[<hov2>external@ %a@ :@ %a@]" protect_ident vd.pval_name.txt
           self#value_description  vd
     | Pstr_include (me, _attrs) ->
         pp f "@[<hov2>include@ %a@]"  self#module_expr  me
diff --git a/parsing/printast.ml b/parsing/printast.ml
index dfaf8ce8be..48bfe9f5ba 100644
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -299,8 +299,9 @@ and expression i ppf x =
       line i ppf "Pexp_while\n";
       expression i ppf e1;
       expression i ppf e2;
-  | Pexp_for (s, e1, e2, df, e3) ->
-      line i ppf "Pexp_for %a %a\n" fmt_direction_flag df fmt_string_loc s;
+  | Pexp_for (p, e1, e2, df, e3) ->
+      line i ppf "Pexp_for %a\n" fmt_direction_flag df;
+      pattern i ppf p;
       expression i ppf e1;
       expression i ppf e2;
       expression i ppf e3;
@@ -571,12 +572,13 @@ and module_type i ppf x =
   let i = i+1 in
   match x.pmty_desc with
   | Pmty_ident li -> line i ppf "Pmty_ident %a\n" fmt_longident_loc li;
+  | Pmty_alias li -> line i ppf "Pmty_alias %a\n" fmt_longident_loc li;
   | Pmty_signature (s) ->
       line i ppf "Pmty_signature\n";
       signature i ppf s;
   | Pmty_functor (s, mt1, mt2) ->
       line i ppf "Pmty_functor %a\n" fmt_string_loc s;
-      module_type i ppf mt1;
+      Misc.may (module_type i ppf) mt1;
       module_type i ppf mt2;
   | Pmty_with (mt, l) ->
       line i ppf "Pmty_with\n";
@@ -670,7 +672,7 @@ and module_expr i ppf x =
       structure i ppf s;
   | Pmod_functor (s, mt, me) ->
       line i ppf "Pmod_functor %a\n" fmt_string_loc s;
-      module_type i ppf mt;
+      Misc.may (module_type i ppf) mt;
       module_expr i ppf me;
   | Pmod_apply (me1, me2) ->
       line i ppf "Pmod_apply\n";
diff --git a/parsing/syntaxerr.ml b/parsing/syntaxerr.ml
index 13212eecd3..e239d6fe2a 100644
--- a/parsing/syntaxerr.ml
+++ b/parsing/syntaxerr.ml
@@ -46,7 +46,7 @@ let prepare_error = function
          are not supported when the option -no-app-func is set."
   | Variable_in_scope (loc, var) ->
       Location.errorf ~loc
-        "Error: In this scoped type, variable '%s@ \
+        "Error: In this scoped type, variable '%s \
          is reserved for the local type %s."
         var var
   | Other loc ->