diff --git a/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference b/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference index 7a75bc5e8d3..6e2167d9384 100644 --- a/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference +++ b/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference @@ -89,7 +89,7 @@ let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2)) pattern (test_locations.ml[17,534+8]..test_locations.ml[17,534+11]) Tpat_var "fib" - value_mode global,many,nonportable;join(aliased,contended)(modevar#1[aliased,uncontended .. unique,uncontended]) + value_mode global,many,nonportable;unique,uncontended expression (test_locations.ml[17,534+14]..test_locations.ml[19,572+34]) Texp_function alloc_mode global,many,nonportable;id(modevar#7[aliased,contended .. unique,uncontended]) diff --git a/testsuite/tests/formatting/test_locations.dno-locations.ocamlc.reference b/testsuite/tests/formatting/test_locations.dno-locations.ocamlc.reference index 93910acca50..3daafc6f3f1 100644 --- a/testsuite/tests/formatting/test_locations.dno-locations.ocamlc.reference +++ b/testsuite/tests/formatting/test_locations.dno-locations.ocamlc.reference @@ -89,7 +89,7 @@ let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2)) pattern Tpat_var "fib" - value_mode global,many,nonportable;join(aliased,contended)(modevar#1[aliased,uncontended .. unique,uncontended]) + value_mode global,many,nonportable;unique,uncontended expression Texp_function alloc_mode global,many,nonportable;id(modevar#7[aliased,contended .. unique,uncontended]) diff --git a/testsuite/tests/parsetree/source_jane_street.ml b/testsuite/tests/parsetree/source_jane_street.ml index 55d134d925f..c479b754014 100644 --- a/testsuite/tests/parsetree/source_jane_street.ml +++ b/testsuite/tests/parsetree/source_jane_street.ml @@ -793,9 +793,9 @@ let (~x:x0, ~s, ~(y:int), ..) : (x:int * s:string * y:int * string) = (~x: 1, ~s: "a", ~y: 2, "ignore me") [%%expect{| -val x0 : int @@ portable = 1 -val s : string @@ portable = "a" -val y : int @@ portable = 2 +val x0 : int = 1 +val s : string = "a" +val y : int = 2 |}] module M : sig @@ -834,9 +834,9 @@ val foo : ('a : value_or_null) ('b : value_or_null). 'a -> (unit -> 'b) -> (unit -> 'b) -> 'b = -val x : int @@ portable = 1 +val x : int = 1 val y : int = 2 -val x : int @@ portable = 1 +val x : int = 1 val y : int = 2 val f : (foo:int * bar:int) -> int = val f : (x:int * int) -> int = diff --git a/testsuite/tests/templates/basic/bad_arg_impl.reference b/testsuite/tests/templates/basic/bad_arg_impl.reference index db59ddb47c5..83bea0280fd 100644 --- a/testsuite/tests/templates/basic/bad_arg_impl.reference +++ b/testsuite/tests/templates/basic/bad_arg_impl.reference @@ -2,7 +2,7 @@ File "bad_arg_impl.ml", line 1: Error: The argument module bad_arg_impl.ml does not match the parameter signature monoid.cmi: Values do not match: - val append : unit -> unit -> [> `Banana ] + val append : unit -> unit -> [> `Banana ] @@ portable is not included in val append : t -> t -> t The type "unit -> unit -> [> `Banana ]" is not compatible with the type diff --git a/testsuite/tests/typing-modes/incl_modalities.ml b/testsuite/tests/typing-modes/incl_modalities.ml index 865f9d9d8fc..7d4d35e9d5f 100644 --- a/testsuite/tests/typing-modes/incl_modalities.ml +++ b/testsuite/tests/typing-modes/incl_modalities.ml @@ -1,5 +1,5 @@ (* TEST - flags += "-extension mode_alpha"; + flags += "-extension mode"; expect; *) diff --git a/testsuite/tests/typing-modes/md_modalities.ml b/testsuite/tests/typing-modes/md_modalities.ml index 4e64dd01389..eadcabf9fca 100644 --- a/testsuite/tests/typing-modes/md_modalities.ml +++ b/testsuite/tests/typing-modes/md_modalities.ml @@ -1,5 +1,5 @@ (* TEST - flags += "-extension mode_alpha"; + flags += "-extension mode"; expect; *) diff --git a/testsuite/tests/typing-modes/modes.ml b/testsuite/tests/typing-modes/modes.ml index 31f51e17eab..39d880861f3 100644 --- a/testsuite/tests/typing-modes/modes.ml +++ b/testsuite/tests/typing-modes/modes.ml @@ -455,18 +455,6 @@ let foo () = val foo : unit -> unit = |}] -(* modalities on normal values requires [-extension mode_alpha] *) -module type S = sig - val x : string -> string @ local @@ foo bar -end -[%%expect{| -Line 2, characters 38-41: -2 | val x : string -> string @ local @@ foo bar - ^^^ -Error: The extension "mode" is disabled and cannot be used -|}] - - (* * Modification of return modes in argument position *) diff --git a/testsuite/tests/typing-modes/portable_interface.mli b/testsuite/tests/typing-modes/portable_interface.mli index 1fa585f5667..ad4d90ecf70 100644 --- a/testsuite/tests/typing-modes/portable_interface.mli +++ b/testsuite/tests/typing-modes/portable_interface.mli @@ -1,6 +1,6 @@ (* TEST readonly_files = "portable_interface.mli use_portable_interface.ml"; - flags += "-extension mode_alpha"; + flags += "-extension mode"; setup-ocamlc.byte-build-env; module = "portable_interface.mli"; ocamlc.byte; diff --git a/testsuite/tests/typing-modes/val_modalities.ml b/testsuite/tests/typing-modes/val_modalities.ml index e105ca35d73..56ba90c437a 100644 --- a/testsuite/tests/typing-modes/val_modalities.ml +++ b/testsuite/tests/typing-modes/val_modalities.ml @@ -1,5 +1,5 @@ (* TEST - flags = "-extension mode_alpha"; + flags = "-extension mode"; expect; *) @@ -62,7 +62,7 @@ module M = struct let x @ contended = "hello" end [%%expect{| -module M : sig val x : string @@ portable contended end +module M : sig val x : string @@ contended end |}] (* Testing the defaulting behaviour. @@ -171,8 +171,7 @@ module Without_inclusion = struct let () = portable_use M.x end [%%expect{| -module Without_inclusion : - sig module M : sig val x : 'a -> 'a @@ portable end end +module Without_inclusion : sig module M : sig val x : 'a -> 'a end end |}] module Without_inclusion = struct @@ -265,10 +264,7 @@ module Close_over_value = struct end [%%expect{| module Close_over_value : - sig - module M : sig val x : string @@ portable end - val foo : unit -> unit @@ portable - end + sig module M : sig val x : string end val foo : unit -> unit end |}] (* CR mode-crossing: This is used for the below test in place of a mutable record. *) @@ -855,7 +851,7 @@ module M_portable = struct end [%%expect{| module M_nonportable : sig val f : unit -> unit end -module M_portable : sig val f : unit -> unit @@ portable end +module M_portable : sig val f : unit -> unit end |}] let (foo @ portable) () = diff --git a/testsuite/tests/typing-modes/val_modalities_floor.ml b/testsuite/tests/typing-modes/val_modalities_floor.ml index 57f300a9b42..3266bb870b3 100644 --- a/testsuite/tests/typing-modes/val_modalities_floor.ml +++ b/testsuite/tests/typing-modes/val_modalities_floor.ml @@ -9,7 +9,7 @@ strongest instead of legacy *) "; { setup-ocamlopt.byte-build-env; - flags = "-extension mode_alpha"; + flags = "-extension mode"; { src = "def_portable.ml"; diff --git a/testsuite/tests/typing-unique/rbtree.ml b/testsuite/tests/typing-unique/rbtree.ml index 1e2e47cd62d..e14fd4cc8d6 100644 --- a/testsuite/tests/typing-unique/rbtree.ml +++ b/testsuite/tests/typing-unique/rbtree.ml @@ -508,10 +508,10 @@ module Make_Okasaki : val fold : 'a 'b ('c : value_or_null). ('a -> 'b -> 'c -> 'c) -> 'c -> ('a, 'b) tree -> 'c - val balance_left : ('a, 'b) tree -> ('a, 'b) tree @@ portable - val balance_right : ('a, 'b) tree -> ('a, 'b) tree @@ portable + val balance_left : ('a, 'b) tree -> ('a, 'b) tree + val balance_right : ('a, 'b) tree -> ('a, 'b) tree val ins : Ord.t -> 'a -> (Ord.t, 'a) tree -> (Ord.t, 'a) tree - val set_black : ('a, 'b) tree -> ('a, 'b) tree @@ portable + val set_black : ('a, 'b) tree -> ('a, 'b) tree val insert : Ord.t -> 'a -> (Ord.t, 'a) tree -> (Ord.t, 'a) tree end Line 110, characters 16-52: diff --git a/typing/mode_intf.mli b/typing/mode_intf.mli index 5b0f4897265..ece85a5968b 100644 --- a/typing/mode_intf.mli +++ b/typing/mode_intf.mli @@ -482,6 +482,19 @@ module type S = sig type nonrec equate_error = equate_step * error + (* In the following we have both [Const.t] and [t]. The former is parameterized by + constant modes and thus its behavior fully determined. It is what users read and + write on constructor arguments, record fields and value descriptions in signatures. + + The latter is parameterized by variable modes and thus its behavior changes as the + variable modes change. It is used in module type inference: structures are inferred + to have a signature containing a list of value descriptions, each of which carries a + modality. This modality depends on the mode of the value, which is a variable. + Therefore, we parameterize the modality over the variable mode. + + Utilities are provided to convert between [Const.t] and [t], such as [of_const], + [zap_to_id], [zap_to_floor], etc.. *) + module Const : sig (** A modality that acts on [Value] modes. Conceptually it is a sequnce of [atom] that acts on individual axes. *) diff --git a/typing/printtyp.ml b/typing/printtyp.ml index e91897f5d75..a32f45887ed 100644 --- a/typing/printtyp.ml +++ b/typing/printtyp.ml @@ -2160,7 +2160,7 @@ let tree_of_value_description id decl = (* Important: process the fvs *after* the type; tree_of_type_scheme resets the naming context *) let snap = Btype.snapshot () in - let moda = Mode.Modality.Value.zap_to_floor decl.val_modalities in + let moda = Mode.Modality.Value.zap_to_id decl.val_modalities in let qtvs = extract_qtvs [decl.val_type] in let apparent_arity = let rec count n typ = diff --git a/typing/typedecl.ml b/typing/typedecl.ml index 30f24d1577f..b1348e11d74 100644 --- a/typing/typedecl.ml +++ b/typing/typedecl.ml @@ -3096,7 +3096,7 @@ let transl_value_decl env loc ~sig_modalities valdecl = let modalities = match valdecl.pval_modalities with | [] -> sig_modalities - | l -> Typemode.transl_modalities ~maturity:Alpha Immutable + | l -> Typemode.transl_modalities ~maturity:Stable Immutable valdecl.pval_attributes l in let modalities = Mode.Modality.Value.of_const modalities in diff --git a/typing/typemod.ml b/typing/typemod.ml index 0674677a654..ff386d16935 100644 --- a/typing/typemod.ml +++ b/typing/typemod.ml @@ -1042,7 +1042,7 @@ let apply_pmd_modalities env sig_modalities pmd_modalities mty = match pmd_modalities with | [] -> sig_modalities | _ :: _ -> - Typemode.transl_modalities ~maturity:Alpha Immutable [] pmd_modalities + Typemode.transl_modalities ~maturity:Stable Immutable [] pmd_modalities in (* Workaround for pmd_modalities @@ -1248,7 +1248,7 @@ and approx_sig_items env ssg= | [] -> sg | _ -> let modalities = - Typemode.transl_modalities ~maturity:Alpha Immutable [] moda + Typemode.transl_modalities ~maturity:Stable Immutable [] moda in let recursive = not @@ Builtin_attributes.has_attribute "no_recursive_modalities" attrs @@ -1750,7 +1750,7 @@ and transl_signature env {psg_items; psg_modalities; psg_loc} = let names = Signature_names.create () in let sig_modalities = - Typemode.transl_modalities ~maturity:Alpha Immutable [] psg_modalities + Typemode.transl_modalities ~maturity:Stable Immutable [] psg_modalities in let transl_include ~loc env sig_acc sincl modalities = @@ -1776,7 +1776,7 @@ and transl_signature env {psg_items; psg_modalities; psg_loc} = match modalities with | [] -> sig_modalities | _ -> - Typemode.transl_modalities ~maturity:Alpha Immutable [] modalities + Typemode.transl_modalities ~maturity:Stable Immutable [] modalities in let sg = if not @@ Mode.Modality.Value.Const.is_id modalities then @@ -2563,7 +2563,7 @@ let simplify_app_summary app_view = match app_view.arg with | false, None -> Includemod.Error.Anonymous, mty let maybe_infer_modalities ~loc ~env ~md_mode ~mode = - if Language_extension.(is_at_least Mode Alpha) then begin + if Language_extension.(is_at_least Mode Stable) then begin (* Upon construction, for comonadic (prescriptive) axes, module must be weaker than the values therein, for otherwise operations would be allowed to performed on the module (and extended to the