modal modules

Author: riaqn

chamelon/chamelon.ml

@@ -121,7 +121,7 @@ let minimizers_to_run =
 (* ______ ONE FILE MINIMIZATION ______ *)
 
 (** [one_file_minimize c map file] minimizes [file] in the file set [map]
-  regarding to the command [c] *)
+    regarding to the command [c] *)
 let one_file_minimize c (map : structure Smap.t) file : structure Smap.t * bool
     =
   if !test then (

chamelon/compat.mli

@@ -19,9 +19,9 @@ type texp_function_param = {
   param : Ident.t;
   partial : partial;
   optional_default : expression option;
-      (** The optional argument's default value. If [optional_default] is present,
-      [arg_label] must be [Optional], and [pattern] matches values of type [t]
-      if the parameter type is [t option]. *)
+      (** The optional argument's default value. If [optional_default] is
+          present, [arg_label] must be [Optional], and [pattern] matches values
+          of type [t] if the parameter type is [t option]. *)
   param_identifier : texp_function_param_identifier;
 }
 

chamelon/function_compat.mli

@@ -3,14 +3,13 @@
 open Typedtree
 open Compat
 
-(** [cases_view] is similar to an old version of the [texp_function] type.
-   It would take some work to update old clients to use the new [texp_function]
-   type, so instead we have this compatibility layer between [cases_view] and
-   the new version of [texp_function].
+(** [cases_view] is similar to an old version of the [texp_function] type. It
+    would take some work to update old clients to use the new [texp_function]
+    type, so instead we have this compatibility layer between [cases_view] and
+    the new version of [texp_function].
 
     (Though, at some point we should just update the clients and remove this
-    compatibility layer.)
-*)
+    compatibility layer.) *)
 
 type cases_view_identifier =
   | Cases of texp_function_cases_identifier

chamelon/iterator.ml

@@ -69,9 +69,9 @@ let step_minimizer c minimize cur_file map ~pos ~len =
   in
   r
 
-(** [apply_minimizer test map cur_file minimize c] applies [minimize] for [cur_file]
-     in the file set [mapi] for the command [c] as much as possible if (not !test),
-     only once otherwise *)
+(** [apply_minimizer test map cur_file minimize c] applies [minimize] for
+    [cur_file] in the file set [mapi] for the command [c] as much as possible if
+    (not !test), only once otherwise *)
 let dicho = true
 
 let apply_minimizer test map cur_file minimize (c : string) =

chamelon/minimizer/simplifymatch.ml

@@ -6,7 +6,7 @@ open Tast_mapper
 open Compat
 
 (** [replace_mapper id to_replace] is a mapper replacing every occurence of [id]
-  by the expression [to_replace]*)
+    by the expression [to_replace]*)
 let replace_mapper id to_replace =
   {
     Tast_mapper.default with

chamelon/utils.ml

@@ -41,7 +41,8 @@ let rec path_eq p1 p2 =
   | Papply (t11, t12), Papply (t21, t22) -> path_eq t11 t21 && path_eq t12 t22
   | _ -> false
 
-(** [replace_path path n_path] is a mapper replacing each occurence of the path [path] by [n_path]*)
+(** [replace_path path n_path] is a mapper replacing each occurence of the path
+    [path] by [n_path]*)
 let replace_path path n_path =
   {
     Tast_mapper.default with
@@ -86,7 +87,8 @@ let replace_path path n_path =
         | _ -> Tast_mapper.default.typ mapper ct);
   }
 
-(** [replace_id id n_id] is a mapper replacing each occurence of the ident [id] by [n_id]*)
+(** [replace_id id n_id] is a mapper replacing each occurence of the ident [id]
+    by [n_id]*)
 let replace_id id n_id =
   {
     Tast_mapper.default with
@@ -182,15 +184,16 @@ let update_single name str =
   flush oc;
   close_out oc
 
-(** [add_def str] adds dummy1, dummy2 and ignore definitions, needed by some minmizers, in [str]*)
+(** [add_def str] adds dummy1, dummy2 and ignore definitions, needed by some
+    minmizers, in [str]*)
 let add_def str =
   {
     str with
     str_items = dummy1_def :: dummy2_def :: ignore_def :: str.str_items;
   }
 
-(** [update_output map] replaces the content of each file
-    by its associated structure in [map] *)
+(** [update_output map] replaces the content of each file by its associated
+    structure in [map] *)
 let update_output map = Smap.iter update_single (Smap.map add_def map)
 
 let save_outputs map =

driver/compile_common.ml

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

otherlibs/stdlib_alpha/effect.mli

@@ -123,7 +123,6 @@ module type S = sig
       with [t] to tie the knot on recursive operations. *)
 
   module Result : sig
-    @@ portable
 
     type eff := t
 
@@ -274,8 +273,6 @@ module type S1 = sig
       with ['p t] to tie the knot on recursive operations. *)
 
   module Result : sig
-    @@ portable
-
     type 'p eff := 'p t
 
     type ('a, 'p, 'es) t =
@@ -418,8 +415,6 @@ module type S2 = sig
       with [('p, 'q) t] to tie the knot on recursive operations. *)
 
   module Result : sig
-    @@ portable
-
     type ('p, 'q) eff := ('p, 'q) t
 
     type ('a, 'p, 'q, 'es) t =

parsing/builtin_attributes.ml

@@ -115,7 +115,6 @@ let builtin_attrs =
   ; "layout_poly"
   ; "no_mutable_implied_modalities"
   ; "or_null_reexport"
-  ; "no_recursive_modalities"
   ; "jane.non_erasable.instances"
   ]
 

stdlib/ephemeron.mli

@@ -150,7 +150,7 @@ end
 (** The output signature of the functors {!K1.MakeSeeded} and {!K2.MakeSeeded}.
 *)
 
-module K1 : sig
+module K1 : sig @@ portable
   type ('k,'d) t (** an ephemeron with one key *)
 
   val make : 'k -> 'd -> ('k,'d) t
@@ -161,19 +161,19 @@ module K1 : sig
       ephemeron's data) if [key] is physically equal to [eph]'s key, and
       [None] if [eph] is empty or [key] is not equal to [eph]'s key. *)
 
-  module Make (H:Hashtbl.HashedType) : S with type key = H.t
+  module (Make @ nonportable) (H:Hashtbl.HashedType) : S with type key = H.t
   (** Functor building an implementation of a weak hash table *)
 
   module MakePortable (H:sig @@ portable include Hashtbl.HashedType end)
     : sig @@ portable include S with type key = H.t end
   (** Like {!Make}, but takes a portable [hash] function to
       portable [Ephemeron] operations. *)
 
-  module MakeSeeded (H:Hashtbl.SeededHashedType) : SeededS with type key = H.t
+  module (MakeSeeded @ nonportable) (H:Hashtbl.SeededHashedType) : SeededS with type key = H.t
   (** Functor building an implementation of a weak hash table.
       The seed is similar to the one of {!Hashtbl.MakeSeeded}. *)
 
-  module MakeSeededPortable (H:sig @@ portable include Hashtbl.SeededHashedType end)
+  module (MakeSeededPortable @ nonportable) (H:sig @@ portable include Hashtbl.SeededHashedType end)
     : sig @@ portable include SeededS with type key = H.t end
   (** Like {!MakeSeeded}, but takes a portable [seeded_hash] function to
       portable [Ephemeron] operations. *)
@@ -206,10 +206,10 @@ module K1 : sig
 
   end
 
-end
+end @@ nonportable
 (** Ephemerons with one key. *)
 
-module K2 : sig
+module K2 : sig @@ portable
   type ('k1,'k2,'d) t (** an ephemeron with two keys *)
 
   val make : 'k1 -> 'k2 -> 'd -> ('k1,'k2,'d) t
@@ -218,7 +218,7 @@ module K2 : sig
   val query : ('k1,'k2,'d) t -> 'k1 -> 'k2 -> 'd option
   (** Same as {!Ephemeron.K1.query} *)
 
-  module Make
+  module (Make @ nonportable)
       (H1:Hashtbl.HashedType)
       (H2:Hashtbl.HashedType) :
     S with type key = H1.t * H2.t
@@ -231,14 +231,14 @@ module K2 : sig
   (** Like {!Make}, but takes portable [hash] functions to
       portable [Ephemeron] operations. *)
 
-  module MakeSeeded
+  module (MakeSeeded @ nonportable)
       (H1:Hashtbl.SeededHashedType)
       (H2:Hashtbl.SeededHashedType) :
     SeededS with type key = H1.t * H2.t
   (** Functor building an implementation of a weak hash table.
       The seed is similar to the one of {!Hashtbl.MakeSeeded}. *)
 
-  module MakeSeededPortable
+  module (MakeSeededPortable @ nonportable)
       (H1:sig @@ portable include Hashtbl.SeededHashedType end)
       (H2:sig @@ portable include Hashtbl.SeededHashedType end) :
     sig @@ portable include SeededS with type key = H1.t * H2.t end
@@ -273,10 +273,10 @@ module K2 : sig
 
   end
 
-end
+end @@ nonportable
 (** Ephemerons with two keys. *)
 
-module Kn : sig
+module Kn : sig @@ portable
   type ('k,'d) t (** an ephemeron with an arbitrary number of keys
                       of the same type *)
 
@@ -286,7 +286,7 @@ module Kn : sig
   val query : ('k,'d) t -> 'k array -> 'd option
   (** Same as {!Ephemeron.K1.query} *)
 
-  module Make
+  module (Make @ nonportable)
       (H:Hashtbl.HashedType) :
     S with type key = H.t array
   (** Functor building an implementation of a weak hash table *)
@@ -297,13 +297,13 @@ module Kn : sig
   (** Like {!Make}, but takes a portable [hash] function to
       portable [Ephemeron] operations. *)
 
-  module MakeSeeded
+  module (MakeSeeded @ nonportable)
       (H:Hashtbl.SeededHashedType) :
     SeededS with type key = H.t array
   (** Functor building an implementation of a weak hash table.
       The seed is similar to the one of {!Hashtbl.MakeSeeded}. *)
 
-  module MakeSeededPortable
+  module (MakeSeededPortable @ nonportable)
       (H:sig @@ portable include Hashtbl.SeededHashedType end) :
     sig @@ portable include SeededS with type key = H.t array end
   (** Like {!MakeSeeded}, but takes a portable [seeded_hash] function to
@@ -337,5 +337,5 @@ module Kn : sig
 
   end
 
-end
+end @@ nonportable
 (** Ephemerons with arbitrary number of keys of the same type. *)

stdlib/hashtbl.mli

@@ -421,7 +421,7 @@ module type S =
   end
 (** The output signature of the functor {!Make}. *)
 
-module Make (H : HashedType) : S with type key = H.t
+module (Make @ nonportable) (H : HashedType) : S with type key = H.t
 (** Functor building an implementation of the hashtable structure.
     The functor [Hashtbl.Make] returns a structure containing
     a type [key] of keys and a type ['a t] of hash tables
@@ -504,7 +504,7 @@ module type SeededS =
 (** The output signature of the functor {!MakeSeeded}.
     @since 4.00 *)
 
-module MakeSeeded (H : SeededHashedType) : SeededS with type key = H.t
+module (MakeSeeded @ nonportable) (H : SeededHashedType) : SeededS with type key = H.t
 (** Functor building an implementation of the hashtable structure.
     The functor [Hashtbl.MakeSeeded] returns a structure containing
     a type [key] of keys and a type ['a t] of hash tables

stdlib/moreLabels.mli

@@ -39,7 +39,7 @@ open! Stdlib
 
 [@@@ocaml.nolabels]
 
-module Hashtbl : sig
+module Hashtbl : sig @@ portable
   (** Hash tables and hash functions.
 
      Hash tables are hashed association tables, with in-place modification.
@@ -440,7 +440,7 @@ module Hashtbl : sig
     end
   (** The output signature of the functor {!Make}. *)
 
-    module Make : functor (H : HashedType) -> S
+    module (Make @ nonportable) : functor (H : HashedType) -> S
     with type key = H.t
      and type 'a t = 'a Hashtbl.Make(H).t
   (** Functor building an implementation of the hashtable structure.
@@ -528,7 +528,7 @@ module Hashtbl : sig
   (** The output signature of the functor {!MakeSeeded}.
       @since 4.00 *)
 
-    module MakeSeeded (H : SeededHashedType) : SeededS
+    module (MakeSeeded @ nonportable) (H : SeededHashedType) : SeededS
     with type key = H.t
      and type 'a t = 'a Hashtbl.MakeSeeded(H).t
   (** Functor building an implementation of the hashtable structure.
@@ -685,7 +685,7 @@ module Hashtbl : sig
 
   *)
 
-end
+end @@ nonportable
 
 module Map : sig
   (** Association tables over ordered types.
@@ -1049,7 +1049,7 @@ module Map : sig
   (** Like {!Make}, but takes a portable [compare] function to
       portable [Map] operations. *)
 
-end
+end @@ nonportable
 
 module Set : sig
   (** Sets over ordered types.
@@ -1368,4 +1368,4 @@ module Set : sig
   (** Like {!Make}, but takes a portable [compare] function to
       portable [Set] operations. *)
 
-end
+end @@ nonportable

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
@@ -1482,3 +1483,4 @@ module Type           = Type
 module Uchar          = Uchar
 module Unit           = Unit
 module Weak           = Weak
+end @@ nonportable

stdlib/sys.mli

@@ -491,7 +491,7 @@ module Immediate64 : sig
       | Non_immediate : Non_immediate.t repr
     val repr : t repr
   end
-end
+end @@ nonportable
 
 (** Submodule containing non-backwards-compatible functions which enforce thread safety
     via modes. *)

stdlib/weak.mli

@@ -198,7 +198,7 @@ module type S = sig
 end
 (** The output signature of the functor {!Weak.Make}. *)
 
-module Make (H : Hashtbl.HashedType) : S with type data = H.t
+module (Make @ nonportable) (H : Hashtbl.HashedType) : S with type data = H.t
 (** Functor building an implementation of the weak hash set structure.
     [H.equal] can't be the physical equality, since only shallow
     copies of the elements in the set are given to it.

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;imply(unique,uncontended)(modevar#1[aliased,contended .. unique,uncontended])
+          value_mode global,many,portable,unyielding;imply(unique,uncontended)(modevar#3[aliased,contended .. unique,uncontended])
         expression (test_locations.ml[17,534+14]..test_locations.ml[19,572+34])
           Texp_function
-          alloc_mode global,many,portable,unyielding;id(modevar#7[aliased,contended .. unique,uncontended])
+          alloc_mode global,many,portable,unyielding;id(modevar#9[aliased,contended .. unique,uncontended])
           []
           Tfunction_cases (test_locations.ml[17,534+14]..test_locations.ml[19,572+34])
           alloc_mode global,many,nonportable,unyielding;aliased,uncontended

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;imply(unique,uncontended)(modevar#1[aliased,contended .. unique,uncontended])
+          value_mode global,many,portable,unyielding;imply(unique,uncontended)(modevar#3[aliased,contended .. unique,uncontended])
         expression 
           Texp_function
-          alloc_mode global,many,portable,unyielding;id(modevar#7[aliased,contended .. unique,uncontended])
+          alloc_mode global,many,portable,unyielding;id(modevar#9[aliased,contended .. unique,uncontended])
           []
           Tfunction_cases 
           alloc_mode global,many,nonportable,unyielding;aliased,uncontended