diff --git a/CHANGELOG.md b/CHANGELOG.md index 6aa51477a9..8c89d284bb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -23,6 +23,7 @@ - Rewatch: add `--prod` flag to `build`, `watch`, and `clean` to skip dev-dependencies and dev sources (`"type": "dev"`), enabling builds in environments where dev packages aren't installed (e.g. after `pnpm install --prod`). https://github.com/rescript-lang/rescript/pull/8347 - Add `Dict.assignMany`, `Dict.concat`, `Dict.concatMany`, `Dict.concatAll`, `Array.concatAll` to the stdlib. https://github.com/rescript-lang/rescript/pull/8364 +- Allow mutation of private record fields with @allowMutation https://github.com/rescript-lang/rescript/pull/8366 #### :bug: Bug fix diff --git a/compiler/ml/builtin_attributes.ml b/compiler/ml/builtin_attributes.ml index a4d073104b..877d1963b8 100644 --- a/compiler/ml/builtin_attributes.ml +++ b/compiler/ml/builtin_attributes.ml @@ -240,6 +240,13 @@ let immediate = | {txt = "ocaml.immediate" | "immediate"; _}, _ -> true | _ -> false) +let has_allow_mutation attr = + List.exists + (function + | {txt = "allowMutation"; _}, _ -> true + | _ -> false) + attr + (* The "ocaml.boxed (default)" and "ocaml.unboxed (default)" attributes cannot be input by the user, they are added by the compiler when applying the default setting. This is done to record diff --git a/compiler/ml/builtin_attributes.mli b/compiler/ml/builtin_attributes.mli index 63bf762331..dd67933349 100644 --- a/compiler/ml/builtin_attributes.mli +++ b/compiler/ml/builtin_attributes.mli @@ -93,5 +93,7 @@ val explicit_arity : Parsetree.attributes -> bool val immediate : Parsetree.attributes -> bool +val has_allow_mutation : Parsetree.attributes -> bool + val has_unboxed : Parsetree.attributes -> bool val has_boxed : Parsetree.attributes -> bool diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index f069a9412e..1d98503393 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -313,7 +313,6 @@ let extract_concrete_record env ty = match extract_concrete_typedecl env ty with | p0, p, {type_kind = Type_record (fields, repr)} -> (p0, p, fields, repr) | _ -> raise Not_found - let extract_concrete_variant env ty = match extract_concrete_typedecl env ty with | p0, p, {type_kind = Type_variant cstrs} -> (p0, p, cstrs) @@ -3463,9 +3462,24 @@ and type_label_exp ~call_context create env loc ty_expected end_def (); (* Generalize information merged from ty_expected *) generalize_structure ty_arg); - if label.lbl_private = Private then - if create then raise (Error (loc, env, Private_type ty_expected)) - else raise (Error (lid.loc, env, Private_label (lid.txt, ty_expected))); + (if label.lbl_private = Private then + if create then raise (Error (loc, env, Private_type ty_expected)) + else + let allow_private_assignment = + match extract_concrete_typedecl env label.lbl_res with + | ( _, + _, + { + type_kind = Type_record _; + type_private = Private; + type_attributes; + } ) -> + Builtin_attributes.has_allow_mutation type_attributes + | _ -> false + | exception Not_found -> false + in + if not allow_private_assignment then + raise (Error (lid.loc, env, Private_label (lid.txt, ty_expected)))); let arg = let snap = if vars = [] then None else Some (Btype.snapshot ()) in let field_name = Longident.last lid.txt in diff --git a/compiler/ml/typedecl.ml b/compiler/ml/typedecl.ml index 0f44d4595f..4da9f45f3e 100644 --- a/compiler/ml/typedecl.ml +++ b/compiler/ml/typedecl.ml @@ -381,6 +381,15 @@ let transl_declaration ~type_record_as_object ~untagged_wfc env sdecl id = ( sdecl.ptype_loc, Invalid_attribute "@notUndefined can only be used on abstract types" ))); + (if Builtin_attributes.has_allow_mutation sdecl.ptype_attributes then + match (sdecl.ptype_private, sdecl.ptype_kind) with + | Private, Ptype_record _ -> () + | _ -> + raise + (Error + ( sdecl.ptype_loc, + Invalid_attribute + "@allowMutation can only be used on private record types" ))); (* Bind type parameters *) reset_type_variables (); diff --git a/tests/build_tests/super_errors/expected/allowMutation_private_abstract_attribute.res.expected b/tests/build_tests/super_errors/expected/allowMutation_private_abstract_attribute.res.expected new file mode 100644 index 0000000000..107dea8190 --- /dev/null +++ b/tests/build_tests/super_errors/expected/allowMutation_private_abstract_attribute.res.expected @@ -0,0 +1,9 @@ + + We've found a bug for you! + /.../fixtures/allowMutation_private_abstract_attribute.res:2:1-20 + + 1 │ @allowMutation + 2 │ type t = private int + 3 │ + + @allowMutation can only be used on private record types \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/allowMutation_private_record_construction.res.expected b/tests/build_tests/super_errors/expected/allowMutation_private_record_construction.res.expected new file mode 100644 index 0000000000..f4d2a59656 --- /dev/null +++ b/tests/build_tests/super_errors/expected/allowMutation_private_record_construction.res.expected @@ -0,0 +1,10 @@ + + We've found a bug for you! + /.../fixtures/allowMutation_private_record_construction.res:10:30-39 + + 8 │ } + 9 │ + 10 │ let _item: PrivateRecord.t = {value: 1} + 11 │ + + Cannot create values of the private type PrivateRecord.t \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/allowMutation_private_record_immutable_field.res.expected b/tests/build_tests/super_errors/expected/allowMutation_private_record_immutable_field.res.expected new file mode 100644 index 0000000000..bf1a495122 --- /dev/null +++ b/tests/build_tests/super_errors/expected/allowMutation_private_record_immutable_field.res.expected @@ -0,0 +1,10 @@ + + We've found a bug for you! + /.../fixtures/allowMutation_private_record_immutable_field.res:11:1-21 + + 9 │ + 10 │ let item = PrivateRecord.make(1) + 11 │ item.name = "changed" + 12 │ + + The record field name is not mutable \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/allowMutation_private_record_update.res.expected b/tests/build_tests/super_errors/expected/allowMutation_private_record_update.res.expected new file mode 100644 index 0000000000..2a7f9f7e97 --- /dev/null +++ b/tests/build_tests/super_errors/expected/allowMutation_private_record_update.res.expected @@ -0,0 +1,10 @@ + + We've found a bug for you! + /.../fixtures/allowMutation_private_record_update.res:11:16-34 + + 9 │ + 10 │ let item = PrivateRecord.make(1) + 11 │ let _updated = {...item, value: 2} + 12 │ + + Cannot create values of the private type PrivateRecord.t \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/allowMutation_private_variant_attribute.res.expected b/tests/build_tests/super_errors/expected/allowMutation_private_variant_attribute.res.expected new file mode 100644 index 0000000000..9928291eab --- /dev/null +++ b/tests/build_tests/super_errors/expected/allowMutation_private_variant_attribute.res.expected @@ -0,0 +1,9 @@ + + We've found a bug for you! + /.../fixtures/allowMutation_private_variant_attribute.res:2:1-22 + + 1 │ @allowMutation + 2 │ type t = private A | B + 3 │ + + @allowMutation can only be used on private record types \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/allowMutation_public_record_attribute.res.expected b/tests/build_tests/super_errors/expected/allowMutation_public_record_attribute.res.expected new file mode 100644 index 0000000000..8c7f3110d4 --- /dev/null +++ b/tests/build_tests/super_errors/expected/allowMutation_public_record_attribute.res.expected @@ -0,0 +1,9 @@ + + We've found a bug for you! + /.../fixtures/allowMutation_public_record_attribute.res:2:1-29 + + 1 │ @allowMutation + 2 │ type t = {mutable value: int} + 3 │ + + @allowMutation can only be used on private record types \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/private_record_mutation_without_allowMutation.res.expected b/tests/build_tests/super_errors/expected/private_record_mutation_without_allowMutation.res.expected new file mode 100644 index 0000000000..1650667d84 --- /dev/null +++ b/tests/build_tests/super_errors/expected/private_record_mutation_without_allowMutation.res.expected @@ -0,0 +1,10 @@ + + We've found a bug for you! + /.../fixtures/private_record_mutation_without_allowMutation.res:10:6-10 + + 8 │ + 9 │ let item = PrivateRecord.make(1) + 10 │ item.value = 2 + 11 │ + + Cannot assign field value of the private type PrivateRecord.t \ No newline at end of file diff --git a/tests/build_tests/super_errors/fixtures/allowMutation_private_abstract_attribute.res b/tests/build_tests/super_errors/fixtures/allowMutation_private_abstract_attribute.res new file mode 100644 index 0000000000..cb6e2710e3 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/allowMutation_private_abstract_attribute.res @@ -0,0 +1,2 @@ +@allowMutation +type t = private int diff --git a/tests/build_tests/super_errors/fixtures/allowMutation_private_record_construction.res b/tests/build_tests/super_errors/fixtures/allowMutation_private_record_construction.res new file mode 100644 index 0000000000..7a1ec724aa --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/allowMutation_private_record_construction.res @@ -0,0 +1,10 @@ +module PrivateRecord: { + @allowMutation + type t = private {mutable value: int} + let make: int => t +} = { + type t = {mutable value: int} + let make = value => {value: value} +} + +let _item: PrivateRecord.t = {value: 1} diff --git a/tests/build_tests/super_errors/fixtures/allowMutation_private_record_immutable_field.res b/tests/build_tests/super_errors/fixtures/allowMutation_private_record_immutable_field.res new file mode 100644 index 0000000000..5a23fdc32e --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/allowMutation_private_record_immutable_field.res @@ -0,0 +1,11 @@ +module PrivateRecord: { + @allowMutation + type t = private {mutable value: int, name: string} + let make: int => t +} = { + type t = {mutable value: int, name: string} + let make = value => {value, name: "stable"} +} + +let item = PrivateRecord.make(1) +item.name = "changed" diff --git a/tests/build_tests/super_errors/fixtures/allowMutation_private_record_update.res b/tests/build_tests/super_errors/fixtures/allowMutation_private_record_update.res new file mode 100644 index 0000000000..09aba6dcb5 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/allowMutation_private_record_update.res @@ -0,0 +1,11 @@ +module PrivateRecord: { + @allowMutation + type t = private {mutable value: int} + let make: int => t +} = { + type t = {mutable value: int} + let make = value => {value: value} +} + +let item = PrivateRecord.make(1) +let _updated = {...item, value: 2} diff --git a/tests/build_tests/super_errors/fixtures/allowMutation_private_variant_attribute.res b/tests/build_tests/super_errors/fixtures/allowMutation_private_variant_attribute.res new file mode 100644 index 0000000000..d9120dbfc8 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/allowMutation_private_variant_attribute.res @@ -0,0 +1,2 @@ +@allowMutation +type t = private A | B diff --git a/tests/build_tests/super_errors/fixtures/allowMutation_public_record_attribute.res b/tests/build_tests/super_errors/fixtures/allowMutation_public_record_attribute.res new file mode 100644 index 0000000000..46cd4adecf --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/allowMutation_public_record_attribute.res @@ -0,0 +1,2 @@ +@allowMutation +type t = {mutable value: int} diff --git a/tests/build_tests/super_errors/fixtures/private_record_mutation_without_allowMutation.res b/tests/build_tests/super_errors/fixtures/private_record_mutation_without_allowMutation.res new file mode 100644 index 0000000000..c375d8e6b3 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/private_record_mutation_without_allowMutation.res @@ -0,0 +1,10 @@ +module PrivateRecord: { + type t = private {mutable value: int} + let make: int => t +} = { + type t = {mutable value: int} + let make = value => {value: value} +} + +let item = PrivateRecord.make(1) +item.value = 2 diff --git a/tests/tests/src/allowMutationPrivateRecord.mjs b/tests/tests/src/allowMutationPrivateRecord.mjs new file mode 100644 index 0000000000..6de7f921e7 --- /dev/null +++ b/tests/tests/src/allowMutationPrivateRecord.mjs @@ -0,0 +1,24 @@ +// Generated by ReScript, PLEASE EDIT WITH CARE + + +function make(value) { + return { + value: value, + name: "stable" + }; +} + +function value(t) { + return t.value; +} + +function name(t) { + return t.name; +} + +export { + make, + value, + name, +} +/* No side effect */ diff --git a/tests/tests/src/allowMutationPrivateRecord.res b/tests/tests/src/allowMutationPrivateRecord.res new file mode 100644 index 0000000000..bf8e308c43 --- /dev/null +++ b/tests/tests/src/allowMutationPrivateRecord.res @@ -0,0 +1,8 @@ +type t = { + mutable value: int, + name: string, +} + +let make = value => {value, name: "stable"} +let value = t => t.value +let name = t => t.name diff --git a/tests/tests/src/allowMutationPrivateRecord.resi b/tests/tests/src/allowMutationPrivateRecord.resi new file mode 100644 index 0000000000..01ac08b645 --- /dev/null +++ b/tests/tests/src/allowMutationPrivateRecord.resi @@ -0,0 +1,9 @@ +@allowMutation +type t = private { + mutable value: int, + name: string, +} + +let make: int => t +let value: t => int +let name: t => string diff --git a/tests/tests/src/allowMutationPrivateRecord_test.mjs b/tests/tests/src/allowMutationPrivateRecord_test.mjs new file mode 100644 index 0000000000..3aa45d47b6 --- /dev/null +++ b/tests/tests/src/allowMutationPrivateRecord_test.mjs @@ -0,0 +1,17 @@ +// Generated by ReScript, PLEASE EDIT WITH CARE + +import * as Mocha from "mocha"; +import * as Test_utils from "./test_utils.mjs"; +import * as AllowMutationPrivateRecord from "./allowMutationPrivateRecord.mjs"; + +Mocha.describe("AllowMutationPrivateRecord_test", () => { + Mocha.test("mutates a mutable field exposed by an @allowMutation private record", () => { + let item = AllowMutationPrivateRecord.make(1); + item.value = 2; + Test_utils.eq("File \"allowMutationPrivateRecord_test.res\", line 8, characters 7-14", item.value, 2); + Test_utils.eq("File \"allowMutationPrivateRecord_test.res\", line 9, characters 7-14", AllowMutationPrivateRecord.value(item), 2); + Test_utils.eq("File \"allowMutationPrivateRecord_test.res\", line 10, characters 7-14", item.name, "stable"); + }); +}); + +/* Not a pure module */ diff --git a/tests/tests/src/allowMutationPrivateRecord_test.res b/tests/tests/src/allowMutationPrivateRecord_test.res new file mode 100644 index 0000000000..5ab791cf4f --- /dev/null +++ b/tests/tests/src/allowMutationPrivateRecord_test.res @@ -0,0 +1,12 @@ +open Mocha +open Test_utils + +describe(__MODULE__, () => { + test("mutates a mutable field exposed by an @allowMutation private record", () => { + let item = AllowMutationPrivateRecord.make(1) + item.value = 2 + eq(__LOC__, item.value, 2) + eq(__LOC__, AllowMutationPrivateRecord.value(item), 2) + eq(__LOC__, item.name, "stable") + }) +})