Support modules of non-legacy modes (#3759)

Author: riaqn

driver/compile_common.ml

@@ -87,7 +87,7 @@ let typecheck_intf info ast =
           (Printtyp.printed_signature (Unit_info.source_file info.target))
           sg);
   ignore (Includemod.signatures info.env ~mark:true
-    ~modes:(Legacy None) sg sg);
+    ~modes:Includemod.modes_unit sg sg);
   Typecore.force_delayed_checks ();
   Builtin_attributes.warn_unused ();
   Warnings.check_fatal ();

jane/doc/extensions/_05-modes/syntax.md

@@ -127,6 +127,12 @@ fun x y @ modes -> ..
 We don't support `fun x y : ty @ modes -> 42` due to a limitation in the
 parser.
 
+## Including signatures
+The following includes all items from `S` with extra modality `portable` applied.
+```ocaml
+include S @@ portable
+```
+
 ## Expressions
 ```ocaml
 (expression : ty @ modes)

lambda/matching.ml

@@ -2072,7 +2072,7 @@ let get_mod_field modname field =
        Env.add_persistent_structure mod_ident
          (Lazy.force Env.initial)
      in
-     let _, env = Env.open_pers_signature modname env in
+     let _, _, env = Env.open_pers_signature modname env in
      match Env.find_value_by_name (Longident.Lident field) env with
      | exception Not_found ->
          fatal_errorf "Primitive %s.%s not found." modname field

stdlib/ephemeron.ml

@@ -381,6 +381,10 @@ module GenHashTable = struct
 
   end
 
+  open struct
+    module DLS = Domain.Safe.DLS
+  end
+
   module MakeSeededPortable(H: sig @@ portable
     type t
     type 'a container
@@ -414,8 +418,6 @@ module GenHashTable = struct
       else if x * 2 > Sys.max_array_length then x
       else power_2_above (x * 2) n
 
-    module DLS = Domain.Safe.DLS
-
     let prng_key = DLS.new_key Random.State.make_self_init
 
     let create ?(random = (Hashtbl.is_randomized ())) initial_size =

stdlib/map.mli

@@ -14,6 +14,8 @@
 (*                                                                        *)
 (**************************************************************************)
 
+@@ portable
+
 open! Stdlib
 
 (* NOTE: If this file is map.mli, do not edit it directly! Instead,

stdlib/set.mli

@@ -14,6 +14,8 @@
 (*                                                                        *)
 (**************************************************************************)
 
+@@ portable
+
 open! Stdlib
 
 (* NOTE: If this file is set.mli, do not edit it directly! Instead,

stdlib/stdLabels.mli

@@ -37,7 +37,9 @@ open! Stdlib
 
 [@@@ocaml.nolabels]
 
+include sig
 module Array = ArrayLabels
 module Bytes = BytesLabels
 module List = ListLabels
 module String = StringLabels
+end @@ nonportable

stdlib/stdlib.mli

@@ -1412,6 +1412,7 @@ val do_domain_local_at_exit : (unit -> unit) ref @@ nonportable
 (** {1:modules Standard library modules } *)
 
 (*MODULE_ALIASES*)
+include sig
 module Arg            = Arg
 module Array          = Array
 module ArrayLabels    = ArrayLabels
@@ -1483,3 +1484,4 @@ module Type           = Type
 module Uchar          = Uchar
 module Unit           = Unit
 module Weak           = Weak
+end @@ nonportable

testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference

@@ -89,10 +89,10 @@ let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
       <def_rec>
         pattern (test_locations.ml[17,534+8]..test_locations.ml[17,534+11])
           Tpat_var "fib"
-          value_mode global,many,portable,unyielding,stateful;imply(unique,uncontended,read_write)(modevar#1[aliased,contended,immutable .. unique,uncontended,read_write])
+          value_mode global,many,portable,unyielding,stateful;imply(unique,uncontended,read_write)(modevar#3[aliased,contended,immutable .. unique,uncontended,read_write])
         expression (test_locations.ml[17,534+14]..test_locations.ml[19,572+34])
           Texp_function
-          alloc_mode global,many,portable,unyielding,stateful;id(modevar#7[aliased,contended,immutable .. unique,uncontended,read_write])
+          alloc_mode global,many,portable,unyielding,stateful;id(modevar#9[aliased,contended,immutable .. unique,uncontended,read_write])
           []
           Tfunction_cases (test_locations.ml[17,534+14]..test_locations.ml[19,572+34])
           alloc_mode global,many,nonportable,unyielding,stateful;aliased,uncontended,read_write

testsuite/tests/formatting/test_locations.dno-locations.ocamlc.reference

@@ -89,10 +89,10 @@ let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
       <def_rec>
         pattern 
           Tpat_var "fib"
-          value_mode global,many,portable,unyielding,stateful;imply(unique,uncontended,read_write)(modevar#1[aliased,contended,immutable .. unique,uncontended,read_write])
+          value_mode global,many,portable,unyielding,stateful;imply(unique,uncontended,read_write)(modevar#3[aliased,contended,immutable .. unique,uncontended,read_write])
         expression 
           Texp_function
-          alloc_mode global,many,portable,unyielding,stateful;id(modevar#7[aliased,contended,immutable .. unique,uncontended,read_write])
+          alloc_mode global,many,portable,unyielding,stateful;id(modevar#9[aliased,contended,immutable .. unique,uncontended,read_write])
           []
           Tfunction_cases 
           alloc_mode global,many,nonportable,unyielding,stateful;aliased,uncontended,read_write