Add the "nonrec" keyword and allow it on type

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

parsing/ast_helper.ml

@@ -157,7 +157,7 @@ module Sig = struct
   let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc}
 
   let value ?loc a = mk ?loc (Psig_value a)
-  let type_ ?loc a = mk ?loc (Psig_type a)
+  let type_ ?loc rec_flag a = mk ?loc (Psig_type (rec_flag, a))
   let type_extension ?loc a = mk ?loc (Psig_typext a)
   let exception_ ?loc a = mk ?loc (Psig_exception a)
   let module_ ?loc a = mk ?loc (Psig_module a)
@@ -177,7 +177,7 @@ module Str = struct
   let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs))
   let value ?loc a b = mk ?loc (Pstr_value (a, b))
   let primitive ?loc a = mk ?loc (Pstr_primitive a)
-  let type_ ?loc a = mk ?loc (Pstr_type a)
+  let type_ ?loc rec_flag a = mk ?loc (Pstr_type (rec_flag, a))
   let type_extension ?loc a = mk ?loc (Pstr_typext a)
   let exception_ ?loc a = mk ?loc (Pstr_exception a)
   let module_ ?loc a = mk ?loc (Pstr_module a)

parsing/ast_helper.mli

@@ -209,7 +209,7 @@ module Sig:
     val mk: ?loc:loc -> signature_item_desc -> signature_item
 
     val value: ?loc:loc -> value_description -> signature_item
-    val type_: ?loc:loc -> type_declaration list -> signature_item
+    val type_: ?loc:loc -> rec_flag -> type_declaration list -> signature_item
     val type_extension: ?loc:loc -> type_extension -> signature_item
     val exception_: ?loc:loc -> extension_constructor -> signature_item
     val module_: ?loc:loc -> module_declaration -> signature_item
@@ -231,7 +231,7 @@ module Str:
     val eval: ?loc:loc -> ?attrs:attributes -> expression -> structure_item
     val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item
     val primitive: ?loc:loc -> value_description -> structure_item
-    val type_: ?loc:loc -> type_declaration list -> structure_item
+    val type_: ?loc:loc -> rec_flag -> type_declaration list -> structure_item
     val type_extension: ?loc:loc -> type_extension -> structure_item
     val exception_: ?loc:loc -> extension_constructor -> structure_item
     val module_: ?loc:loc -> module_binding -> structure_item

parsing/ast_mapper.ml

@@ -241,7 +241,7 @@ module MT = struct
     let loc = sub.location sub loc in
     match desc with
     | Psig_value vd -> value ~loc (sub.value_description sub vd)
-    | Psig_type l -> type_ ~loc (List.map (sub.type_declaration sub) l)
+    | Psig_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l)
     | Psig_typext te -> type_extension ~loc (sub.type_extension sub te)
     | Psig_exception ed -> exception_ ~loc (sub.extension_constructor sub ed)
     | Psig_module x -> module_ ~loc (sub.module_declaration sub x)
@@ -289,7 +289,7 @@ module M = struct
         eval ~loc ~attrs:(sub.attributes sub attrs) (sub.expr sub x)
     | Pstr_value (r, vbs) -> value ~loc r (List.map (sub.value_binding sub) vbs)
     | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd)
-    | Pstr_type l -> type_ ~loc (List.map (sub.type_declaration sub) l)
+    | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l)
     | Pstr_typext te -> type_extension ~loc (sub.type_extension sub te)
     | Pstr_exception ed -> exception_ ~loc (sub.extension_constructor sub ed)
     | Pstr_module x -> module_ ~loc (sub.module_binding sub x)

parsing/lexer.mll

@@ -63,6 +63,7 @@ let keyword_table =
     "module", MODULE;
     "mutable", MUTABLE;
     "new", NEW;
+    "nonrec", NONREC;
     "object", OBJECT;
     "of", OF;
     "open", OPEN;

parsing/parser.mly

@@ -378,6 +378,7 @@ let mkctf_attrs d attrs =
 %token MUTABLE
 %token <nativeint> NATIVEINT
 %token NEW
+%token NONREC
 %token OBJECT
 %token OF
 %token OPEN
@@ -653,10 +654,11 @@ structure_item:
       { mkstr
           (Pstr_primitive (Val.mk (mkrhs $2 2) $4
                              ~attrs:$5 ~loc:(symbol_rloc()))) }
-  | TYPE type_declarations
-      { mkstr(Pstr_type (List.rev $2) ) }
-  | TYPE str_type_extension
-      { mkstr(Pstr_typext $2) }
+  | TYPE nonrec_flag type_declarations
+      { mkstr(Pstr_type ($2, List.rev $3) ) }
+  | TYPE nonrec_flag str_type_extension
+      { if $2 <> Recursive then not_expecting 2 "nonrec flag";
+        mkstr(Pstr_typext $3) }
   | EXCEPTION str_exception_declaration
       { mkstr(Pstr_exception $2) }
   | MODULE module_binding
@@ -740,10 +742,11 @@ signature_item:
       { mksig(Psig_value
                 (Val.mk (mkrhs $2 2) $4 ~prim:$6 ~attrs:$7
                    ~loc:(symbol_rloc()))) }
-  | TYPE type_declarations
-      { mksig(Psig_type (List.rev $2)) }
-  | TYPE sig_type_extension
-      { mksig(Psig_typext $2) }
+  | TYPE nonrec_flag type_declarations
+      { mksig(Psig_type ($2, List.rev $3)) }
+  | TYPE nonrec_flag sig_type_extension
+      { if $2 <> Recursive then not_expecting 2 "nonrec flag";
+        mksig(Psig_typext $3) }
   | EXCEPTION sig_exception_declaration
       { mksig(Psig_exception $2) }
   | MODULE UIDENT module_declaration post_item_attributes
@@ -2098,6 +2101,10 @@ rec_flag:
     /* empty */                                 { Nonrecursive }
   | REC                                         { Recursive }
 ;
+nonrec_flag:
+    /* empty */                                 { Recursive }
+  | NONREC                                      { Nonrecursive }
+;
 direction_flag:
     TO                                          { Upto }
   | DOWNTO                                      { Downto }

parsing/pprintast.ml

@@ -193,9 +193,14 @@ class printer  ()= object(self:'self)
     | Virtual -> pp f "virtual@;"
 
   (* trailing space added *)
-  method rec_flag f = function
+  method rec_flag f rf =
+    match rf with
     | Nonrecursive -> ()
     | Recursive -> pp f "rec "
+  method nonrec_flag f rf =
+    match rf with
+    | Nonrecursive -> pp f "nonrec "
+    | Recursive -> ()
   method direction_flag f = function
     | Upto -> pp f "to@ "
     | Downto -> pp f "downto@ "
@@ -597,7 +602,7 @@ class printer  ()= object(self:'self)
         pp f "@[<hov2>assert@ %a@]" self#simple_expr e
     | Pexp_lazy (e) ->
         pp f "@[<hov2>lazy@ %a@]" self#simple_expr e
-    (* Pexp_poly: impossible but we should print it anyway, rather than assert false *) 
+    (* Pexp_poly: impossible but we should print it anyway, rather than assert false *)
     | Pexp_poly (e, None) ->
         pp f "@[<hov2>!poly!@ %a@]" self#simple_expr e
     | Pexp_poly (e, Some ct) ->
@@ -920,8 +925,8 @@ class printer  ()= object(self:'self)
 
   method signature_item f x :unit= begin
     match x.psig_desc with
-    | Psig_type l ->
-        self#type_def_list f l
+    | Psig_type (rf, l) ->
+        self#type_def_list f (rf, l)
     | Psig_value vd ->
         let intro = if vd.pval_prim = [] then "val" else "external" in
           pp f "@[<2>%s@ %a@ :@ %a@]%a" intro
@@ -1091,8 +1096,8 @@ class printer  ()= object(self:'self)
         pp f "@[<hov2>let@ _ =@ %a@]%a"
           self#expression e
           self#item_attributes attrs
-    | Pstr_type [] -> assert false
-    | Pstr_type l  -> self#type_def_list f l
+    | Pstr_type (_, []) -> assert false
+    | Pstr_type (rf, l)  -> self#type_def_list f (rf, l)
     | Pstr_value (rf, l) -> (* pp f "@[<hov2>let %a%a@]"  self#rec_flag rf self#bindings l *)
         pp f "@[<2>%a@]" self#bindings (rf,l)
     | Pstr_typext te -> self#type_extension f te
@@ -1213,14 +1218,15 @@ class printer  ()= object(self:'self)
   method type_params f = function
     [] -> ()
   | l -> pp f "%a " (self#list self#type_param ~first:"(" ~last:")" ~sep:",") l
-  method  type_def_list f l =
-    let type_decl kwd f x =
+  method  type_def_list f (rf, l) =
+    let type_decl kwd rf f x =
       let eq =
         if (x.ptype_kind = Ptype_abstract)
            && (x.ptype_manifest = None) then ""
         else " ="
       in
-      pp f "@[<2>%s %a%s%s%a@]%a" kwd
+      pp f "@[<2>%s %a%a%s%s%a@]%a" kwd
+        self#nonrec_flag rf
         self#type_params x.ptype_params
         x.ptype_name.txt eq
         self#type_declaration x
@@ -1228,10 +1234,10 @@ class printer  ()= object(self:'self)
     in
     match l with
     | [] -> assert false
-    | [x] -> type_decl "type" f x
+    | [x] -> type_decl "type" rf f x
     | x :: xs -> pp f "@[<v>%a@,%a@]"
-          (type_decl "type") x
-          (self#list ~sep:"@," (type_decl "and")) xs
+          (type_decl "type" rf) x
+          (self#list ~sep:"@," (type_decl "and" Recursive)) xs
 
   method record_declaration f lbls =
     let type_record_field f pld =

parsing/pprintast.mli

@@ -81,6 +81,7 @@ class printer :
     method payload : Format.formatter -> Parsetree.payload -> unit
     method private_flag : Format.formatter -> Asttypes.private_flag -> unit
     method rec_flag : Format.formatter -> Asttypes.rec_flag -> unit
+    method nonrec_flag : Format.formatter -> Asttypes.rec_flag -> unit
     method record_declaration : Format.formatter -> Parsetree.label_declaration list -> unit
 
     method reset : 'b
@@ -105,7 +106,7 @@ class printer :
     method type_declaration :
       Format.formatter -> Parsetree.type_declaration -> unit
     method type_def_list :
-      Format.formatter -> Parsetree.type_declaration list -> unit
+      Format.formatter -> Asttypes.rec_flag * Parsetree.type_declaration list -> unit
     method type_extension :
       Format.formatter -> Parsetree.type_extension -> unit
     method type_param :

parsing/printast.ml

@@ -647,8 +647,8 @@ and signature_item i ppf x =
   | Psig_value vd ->
       line i ppf "Psig_value\n";
       value_description i ppf vd;
-  | Psig_type (l) ->
-      line i ppf "Psig_type\n";
+  | Psig_type (rf, l) ->
+      line i ppf "Psig_type %a\n" fmt_rec_flag rf;
       list i type_declaration ppf l;
   | Psig_typext te ->
       line i ppf "Psig_typext\n";
@@ -755,8 +755,8 @@ and structure_item i ppf x =
   | Pstr_primitive vd ->
       line i ppf "Pstr_primitive\n";
       value_description i ppf vd;
-  | Pstr_type l ->
-      line i ppf "Pstr_type\n";
+  | Pstr_type (rf, l) ->
+      line i ppf "Pstr_type %a\n" fmt_rec_flag rf;
       list i type_declaration ppf l;
   | Pstr_typext te ->
       line i ppf "Pstr_typext\n";