From c1b970185a2f21bf24f656adc7cd8efc55a44e51 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Mon, 27 Nov 2023 10:42:09 +0100 Subject: [PATCH] Experiment with allowing empty inline records (#6494) * experiment with allowing empty inline records * remove check for empty record pattern match * syntax tests * Update inline_record_test.res * add extra test for top level empty record match * changelog * Remove some dead code. --------- Co-authored-by: Cristiano Calcagno --- CHANGELOG.md | 5 +++ jscomp/frontend/bs_ast_invariant.ml | 3 -- jscomp/gentype/GenTypeCommon.ml | 2 +- jscomp/gentype/Runtime.ml | 15 -------- jscomp/gentype/Runtime.mli | 5 --- jscomp/gentype/TranslateCoreType.ml | 3 +- jscomp/gentype/TranslateTypeDeclarations.ml | 37 ++++--------------- jscomp/gentype/TranslateTypeExprFromTypes.ml | 17 +++------ .../package-lock.json | 2 +- jscomp/ml/typecore.ml | 1 - jscomp/syntax/src/res_core.ml | 9 ----- .../expected/emptyInlineRecord.res.txt | 11 ------ jscomp/test/inline_record_test.js | 18 +++++++++ jscomp/test/inline_record_test.res | 17 +++++++++ 14 files changed, 55 insertions(+), 90 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 40b5335aac..beb8586b46 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,11 @@ # 11.0.0-rc.7 (Unreleased) +#### :rocket: New Feature + +- Allow empty inline records in variants. https://github.com/rescript-lang/rescript-compiler/pull/6494 +- Allow empty record patterns in pattern matching. https://github.com/rescript-lang/rescript-compiler/pull/6494 + # 11.0.0-rc.6 #### :rocket: New Feature diff --git a/jscomp/frontend/bs_ast_invariant.ml b/jscomp/frontend/bs_ast_invariant.ml index 21df059fa0..131b0f0526 100644 --- a/jscomp/frontend/bs_ast_invariant.ml +++ b/jscomp/frontend/bs_ast_invariant.ml @@ -166,9 +166,6 @@ let emit_external_warnings : iterator = (fun self (pat : Parsetree.pattern) -> match pat.ppat_desc with | Ppat_constant constant -> check_constant pat.ppat_loc constant - | Ppat_record ([], _) -> - Location.raise_errorf ~loc:pat.ppat_loc - "Empty record pattern is not supported" | _ -> super.pat self pat); } diff --git a/jscomp/gentype/GenTypeCommon.ml b/jscomp/gentype/GenTypeCommon.ml index 4e7258e181..d7356e28c9 100644 --- a/jscomp/gentype/GenTypeCommon.ml +++ b/jscomp/gentype/GenTypeCommon.ml @@ -26,7 +26,7 @@ type labelJS = | IntLabel of string | StringLabel of string -type case = {label: string; labelJS: labelJS} +type case = {labelJS: labelJS} let isJSSafePropertyName name = name = "" diff --git a/jscomp/gentype/Runtime.ml b/jscomp/gentype/Runtime.ml index a6c45736b2..2238fa7c08 100644 --- a/jscomp/gentype/Runtime.ml +++ b/jscomp/gentype/Runtime.ml @@ -1,21 +1,6 @@ -type recordGen = {mutable unboxed: int; mutable boxed: int} -type recordValue = int type moduleItem = string type moduleAccessPath = Root of string | Dot of moduleAccessPath * moduleItem -let recordValueToString recordValue = recordValue |> string_of_int -let recordGen () = {unboxed = 0; boxed = 0} - -let newRecordValue ~unboxed recordGen = - if unboxed then ( - let v = recordGen.unboxed in - recordGen.unboxed <- recordGen.unboxed + 1; - v) - else - let v = recordGen.boxed in - recordGen.boxed <- recordGen.boxed + 1; - v - let newModuleItem ~name = name let rec emitModuleAccessPath ~config moduleAccessPath = diff --git a/jscomp/gentype/Runtime.mli b/jscomp/gentype/Runtime.mli index a6eca6acd9..a7d16b4e87 100644 --- a/jscomp/gentype/Runtime.mli +++ b/jscomp/gentype/Runtime.mli @@ -1,7 +1,5 @@ open GenTypeCommon -type recordGen -type recordValue type moduleItem type moduleAccessPath = Root of string | Dot of moduleAccessPath * moduleItem @@ -11,9 +9,6 @@ val emitModuleAccessPath : config:Config.t -> moduleAccessPath -> string val isMutableObjectField : string -> bool val newModuleItem : name:string -> moduleItem -val newRecordValue : unboxed:bool -> recordGen -> recordValue -val recordGen : unit -> recordGen -val recordValueToString : recordValue -> string val jsVariantTag : polymorphic:bool -> tag:string option -> string val jsVariantPayloadTag : n:int -> string val jsVariantValue : polymorphic:bool -> string diff --git a/jscomp/gentype/TranslateCoreType.ml b/jscomp/gentype/TranslateCoreType.ml index 384df3e170..ce5d850d01 100644 --- a/jscomp/gentype/TranslateCoreType.ml +++ b/jscomp/gentype/TranslateCoreType.ml @@ -192,7 +192,7 @@ and translateCoreType_ ~config ~typeVarsGen else if isNumber label then IntLabel label else StringLabel label in - {label; labelJS}) + {labelJS}) in let payloadsTranslations = payloads @@ -207,7 +207,6 @@ and translateCoreType_ ~config ~typeVarsGen { case = { - label; labelJS = (if isNumber label then IntLabel label else StringLabel label); diff --git a/jscomp/gentype/TranslateTypeDeclarations.ml b/jscomp/gentype/TranslateTypeDeclarations.ml index 5e57a01d4b..14385d08c1 100644 --- a/jscomp/gentype/TranslateTypeDeclarations.ml +++ b/jscomp/gentype/TranslateTypeDeclarations.ml @@ -23,7 +23,6 @@ let createExportTypeFromTypeDeclaration ~annotation ~loc ~nameAs ~opaque ~type_ let createCase (label, attributes) ~poly = { - label; labelJS = (match attributes |> Annotation.getAttributePayload Annotation.tagIsAs @@ -230,7 +229,6 @@ let traslateDeclarationKind ~config ~loc ~outputFileRelative ~resolver } |> returnTypeDeclaration | VariantDeclarationFromTypes constructorDeclarations, None -> - let recordGen = Runtime.recordGen () in let variants = constructorDeclarations |> List.map (fun constructorDeclaration -> @@ -262,46 +260,25 @@ let traslateDeclarationKind ~config ~loc ~outputFileRelative ~resolver |> Translation.translateDependencies ~config ~outputFileRelative ~resolver in - let recordValue = - recordGen - |> Runtime.newRecordValue - ~unboxed:(constructorArgs = Cstr_tuple []) - in - ( name, - attributes, - argTypes, - importTypes, - recordValue |> Runtime.recordValueToString )) + (name, attributes, argTypes, importTypes)) in let variantsNoPayload, variantsWithPayload = - variants |> List.partition (fun (_, _, argTypes, _, _) -> argTypes = []) + variants |> List.partition (fun (_, _, argTypes, _) -> argTypes = []) in let noPayloads = variantsNoPayload - |> List.map - (fun (name, attributes, _argTypes, _importTypes, recordValue) -> - { - ((name, attributes) |> createCase ~poly:false) with - label = recordValue; - }) + |> List.map (fun (name, attributes, _argTypes, _importTypes) -> + (name, attributes) |> createCase ~poly:false) in let payloads = variantsWithPayload - |> List.map - (fun (name, attributes, argTypes, _importTypes, recordValue) -> + |> List.map (fun (name, attributes, argTypes, _importTypes) -> let type_ = match argTypes with | [type_] -> type_ | _ -> Tuple argTypes in - { - case = - { - ((name, attributes) |> createCase ~poly:false) with - label = recordValue; - }; - t = type_; - }) + {case = (name, attributes) |> createCase ~poly:false; t = type_}) in let variantTyp = createVariant ~inherits:[] ~noPayloads ~payloads ~polymorphic:false @@ -325,7 +302,7 @@ let traslateDeclarationKind ~config ~loc ~outputFileRelative ~resolver in let importTypes = variants - |> List.map (fun (_, _, _, importTypes, _) -> importTypes) + |> List.map (fun (_, _, _, importTypes) -> importTypes) |> List.concat in {CodeItem.exportFromTypeDeclaration; importTypes} |> returnTypeDeclaration diff --git a/jscomp/gentype/TranslateTypeExprFromTypes.ml b/jscomp/gentype/TranslateTypeExprFromTypes.ml index 30fff9432e..9278341a56 100644 --- a/jscomp/gentype/TranslateTypeExprFromTypes.ml +++ b/jscomp/gentype/TranslateTypeExprFromTypes.ml @@ -137,15 +137,13 @@ let translateConstr ~config ~paramsTranslation ~(path : Path.t) ~typeEnv = } | ( (["Pervasives"; "result"] | ["Belt"; "Result"; "t"] | ["result"]), [paramTranslation1; paramTranslation2] ) -> - let case n name type_ = - {case = {label = string_of_int n; labelJS = StringLabel name}; t = type_} - in + let case name type_ = {case = {labelJS = StringLabel name}; t = type_} in let variant = createVariant ~inherits:[] ~noPayloads:[] ~payloads: [ - case 0 "Ok" paramTranslation1.type_; - case 1 "Error" paramTranslation2.type_; + case "Ok" paramTranslation1.type_; + case "Error" paramTranslation2.type_; ] ~polymorphic:false ~tag:None ~unboxed:false in @@ -384,7 +382,6 @@ and translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv noPayloads |> List.map (fun label -> { - label; labelJS = (if isNumber label then IntLabel label else StringLabel label); @@ -401,8 +398,7 @@ and translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv t |> translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv | {noPayloads; payloads; unknowns = []} -> let noPayloads = - noPayloads - |> List.map (fun label -> {label; labelJS = StringLabel label}) + noPayloads |> List.map (fun label -> {labelJS = StringLabel label}) in let payloadTranslations = payloads @@ -414,10 +410,7 @@ and translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv let payloads = payloadTranslations |> List.map (fun (label, translation) -> - { - case = {label; labelJS = StringLabel label}; - t = translation.type_; - }) + {case = {labelJS = StringLabel label}; t = translation.type_}) in let type_ = createVariant ~inherits:[] ~noPayloads ~payloads ~polymorphic:true diff --git a/jscomp/gentype_tests/typescript-react-example/package-lock.json b/jscomp/gentype_tests/typescript-react-example/package-lock.json index 7aafa5a701..de73e10c11 100644 --- a/jscomp/gentype_tests/typescript-react-example/package-lock.json +++ b/jscomp/gentype_tests/typescript-react-example/package-lock.json @@ -24,7 +24,7 @@ }, "../../..": { "name": "rescript", - "version": "11.0.0-rc.6", + "version": "11.0.0-rc.7", "dev": true, "hasInstallScript": true, "license": "SEE LICENSE IN LICENSE", diff --git a/jscomp/ml/typecore.ml b/jscomp/ml/typecore.ml index 111ac9fe9e..77b5a748af 100644 --- a/jscomp/ml/typecore.ml +++ b/jscomp/ml/typecore.ml @@ -1273,7 +1273,6 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env | _ -> k None end | Ppat_record(lid_sp_list, closed) -> - assert (lid_sp_list <> []); let opath, record_ty = try let (p0, p, _, _) = extract_concrete_record !env expected_ty in diff --git a/jscomp/syntax/src/res_core.ml b/jscomp/syntax/src/res_core.ml index e15f1e66e0..b2d2b01230 100644 --- a/jscomp/syntax/src/res_core.ml +++ b/jscomp/syntax/src/res_core.ml @@ -4544,7 +4544,6 @@ and parseConstrDeclArgs p = (* TODO: this could use some cleanup/stratification *) match p.Parser.token with | Lbrace -> ( - let lbrace = p.startPos in Parser.next p; let startPos = p.Parser.startPos in match p.Parser.token with @@ -4683,14 +4682,6 @@ and parseConstrDeclArgs p = :: parseCommaDelimitedRegion ~grammar:Grammar.FieldDeclarations ~closing:Rbrace ~f:parseFieldDeclarationRegion p in - let () = - match fields with - | [] -> - Parser.err ~startPos:lbrace p - (Diagnostics.message - "An inline record declaration needs at least one field") - | _ -> () - in Parser.expect Rbrace p; Parser.optional p Comma |> ignore; Parser.expect Rparen p; diff --git a/jscomp/syntax/tests/parsing/errors/typeDef/expected/emptyInlineRecord.res.txt b/jscomp/syntax/tests/parsing/errors/typeDef/expected/emptyInlineRecord.res.txt index 58391e6720..78d9c4d8fa 100644 --- a/jscomp/syntax/tests/parsing/errors/typeDef/expected/emptyInlineRecord.res.txt +++ b/jscomp/syntax/tests/parsing/errors/typeDef/expected/emptyInlineRecord.res.txt @@ -1,14 +1,3 @@ - - Syntax error! - tests/parsing/errors/typeDef/emptyInlineRecord.res:3:10-11 - - 1 │ type node<'a> = - 2 │ | Nil - 3 │ | Node({}) - 4 │ - - An inline record declaration needs at least one field - type nonrec 'a node = | Nil | Node of { diff --git a/jscomp/test/inline_record_test.js b/jscomp/test/inline_record_test.js index 4cd3cf31b8..25d6b5c3fe 100644 --- a/jscomp/test/inline_record_test.js +++ b/jscomp/test/inline_record_test.js @@ -195,6 +195,18 @@ function ff1(x) { Mt.from_pair_suites("Inline_record_test", suites.contents); +var b = { + TAG: "B" +}; + +if (typeof b !== "object") { + console.log("A!"); +} else { + console.log("B"); +} + +console.log("10!"); + var v2 = { TAG: "A0", lbl: 3, @@ -207,6 +219,10 @@ var vvv = { more: /* [] */0 }; +var r = { + y: 10 +}; + exports.suites = suites; exports.test_id = test_id; exports.eq = eq; @@ -224,4 +240,6 @@ exports.A4 = A4; exports.v6 = v6; exports.ff0 = ff0; exports.ff1 = ff1; +exports.b = b; +exports.r = r; /* Not a pure module */ diff --git a/jscomp/test/inline_record_test.res b/jscomp/test/inline_record_test.res index cabfb7dd85..cfc5b2430c 100644 --- a/jscomp/test/inline_record_test.res +++ b/jscomp/test/inline_record_test.res @@ -117,3 +117,20 @@ let ff1 = (x: t1): t1 => } let () = Mt.from_pair_suites(__MODULE__, suites.contents) + +type emptyRecord = A | B({}) + +let b = B({}) + +let () = switch b { +| A => Js.log("A!") +| B({}) => Js.log("B") +} + +type r = {y: int} +let r = {y: 10} + +switch r { +| {y: 10} => Js.log("10!") +| {} => Js.log("Catch all?") +}