From 5846cc17ad5d32e5d3ff88f9108b1f6ef4986936 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 2 Nov 2024 08:54:45 +0100 Subject: [PATCH 1/6] Optional fields pattern matching: untagged variants Add support for untagged variants to optimised pattern matching for optional fields. --- compiler/ml/parmatch.ml | 25 ++++++++++++++++++ tests/tests/src/pattern_match_json.mjs | 35 ++++++++++++++++++++++++++ tests/tests/src/pattern_match_json.res | 20 +++++++++++++++ 3 files changed, 80 insertions(+) create mode 100644 tests/tests/src/pattern_match_json.mjs create mode 100644 tests/tests/src/pattern_match_json.res diff --git a/compiler/ml/parmatch.ml b/compiler/ml/parmatch.ml index 03f11793f6..665d03e61d 100644 --- a/compiler/ml/parmatch.ml +++ b/compiler/ml/parmatch.ml @@ -539,6 +539,31 @@ let all_record_args lbls = [({pat_desc = Tpat_constant _} as c)] ) when lbl_is_optional () -> (id, lbl, c) + | Tpat_construct + ( {txt = Longident.Ldot (Longident.Lident "*predef*", "Some")}, + _, + [({pat_desc = Tpat_construct (_, cd, _)} as pat_construct)] ) + when lbl_is_optional () -> ( + let block_type = + match cd.cstr_res.desc with + | Tconstr (path, _, _) -> ( + match Env.find_type path pat.pat_env with + | {type_kind = Type_variant cstrs} -> + Ext_list.find_opt cstrs (fun cstr -> + if cstr.cd_id.name = cd.cstr_name then + Ast_untagged_variants.get_block_type ~env:pat.pat_env + cstr + else None) + | _ -> None) + | _ -> None + in + match block_type with + | Some + ( IntType | StringType | FloatType | BigintType | BooleanType + | InstanceType _ | FunctionType | ObjectType ) -> + (* These types cannot be undefined *) + (id, lbl, pat_construct) + | _ -> x) | _ -> x in t.(lbl.lbl_pos) <- x) diff --git a/tests/tests/src/pattern_match_json.mjs b/tests/tests/src/pattern_match_json.mjs new file mode 100644 index 0000000000..69fc37f45b --- /dev/null +++ b/tests/tests/src/pattern_match_json.mjs @@ -0,0 +1,35 @@ +// Generated by ReScript, PLEASE EDIT WITH CARE + + +function decodeGroup(group) { + let id = group.id; + if (id === null) { + return [ + "e", + "f" + ]; + } + if (typeof id !== "string") { + return [ + "e", + "f" + ]; + } + let name = group.name; + if (typeof name !== "string") { + return [ + "e", + "f" + ]; + } else { + return [ + id, + name + ]; + } +} + +export { + decodeGroup, +} +/* No side effect */ diff --git a/tests/tests/src/pattern_match_json.res b/tests/tests/src/pattern_match_json.res new file mode 100644 index 0000000000..60e73c4619 --- /dev/null +++ b/tests/tests/src/pattern_match_json.res @@ -0,0 +1,20 @@ +@unboxed +type rec t = + | Boolean(bool) + | @as(null) Null + | String(string) + | Number(float) + | Object(Dict.t) + | Array(array) + +type group = { + id: string, + name: string, +} + +let decodeGroup = group => { + switch group { + | dict{"id": String(id), "name": String(name)} => (id, name) + | _ => ("e", "f") + } +} From 7bdfdb0faa7f2e34033e083d831b5bc54371b43a Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 2 Nov 2024 09:50:07 +0100 Subject: [PATCH 2/6] refactor: more logic in ast_untagged_variants --- compiler/ml/ast_untagged_variants.ml | 36 +++++++++++++++++++++------- compiler/ml/parmatch.ml | 35 +++++++++++++-------------- 2 files changed, 43 insertions(+), 28 deletions(-) diff --git a/compiler/ml/ast_untagged_variants.ml b/compiler/ml/ast_untagged_variants.ml index 5e7df5cd69..fd690100f9 100644 --- a/compiler/ml/ast_untagged_variants.ml +++ b/compiler/ml/ast_untagged_variants.ml @@ -91,6 +91,12 @@ type switch_names = {consts: tag array; blocks: block array} let untagged = "unboxed" +let block_type_can_be_undefined = function + | IntType | StringType | FloatType | BigintType | BooleanType | InstanceType _ + | FunctionType | ObjectType -> + false + | UnknownType -> true + let has_untagged (attrs : Parsetree.attributes) = Ext_list.exists attrs (function {txt}, _ -> txt = untagged) @@ -328,23 +334,35 @@ let check_invariant ~is_untagged_def ~(consts : (Location.t * tag) list) invariant loc block.tag.name | None -> ()) +let get_cstr_loc_tag (cstr : Types.constructor_declaration) = + ( cstr.cd_loc, + { + name = Ident.name cstr.cd_id; + tag_type = process_tag_type cstr.cd_attributes; + } ) + +let constructor_declaration_from_constructor_description ~env + (cd : Types.constructor_description) : Types.constructor_declaration option + = + match cd.cstr_res.desc with + | Tconstr (path, _, _) -> ( + match Env.find_type path env with + | {type_kind = Type_variant cstrs} -> + Ext_list.find_opt cstrs (fun cstr -> + if cstr.cd_id.name = cd.cstr_name then Some cstr else None) + | _ -> None) + | _ -> None + let names_from_type_variant ?(is_untagged_def = false) ~env (cstrs : Types.constructor_declaration list) = - let get_cstr_name (cstr : Types.constructor_declaration) = - ( cstr.cd_loc, - { - name = Ident.name cstr.cd_id; - tag_type = process_tag_type cstr.cd_attributes; - } ) - in let get_block (cstr : Types.constructor_declaration) : block = - let tag = snd (get_cstr_name cstr) in + let tag = snd (get_cstr_loc_tag cstr) in {tag; tag_name = get_tag_name cstr; block_type = get_block_type ~env cstr} in let consts, blocks = Ext_list.fold_left cstrs ([], []) (fun (consts, blocks) cstr -> if is_nullary_variant cstr.cd_args then - (get_cstr_name cstr :: consts, blocks) + (get_cstr_loc_tag cstr :: consts, blocks) else (consts, (cstr.cd_loc, get_block cstr) :: blocks)) in check_invariant ~is_untagged_def ~consts ~blocks; diff --git a/compiler/ml/parmatch.ml b/compiler/ml/parmatch.ml index 665d03e61d..783087b90d 100644 --- a/compiler/ml/parmatch.ml +++ b/compiler/ml/parmatch.ml @@ -544,26 +544,23 @@ let all_record_args lbls = _, [({pat_desc = Tpat_construct (_, cd, _)} as pat_construct)] ) when lbl_is_optional () -> ( - let block_type = - match cd.cstr_res.desc with - | Tconstr (path, _, _) -> ( - match Env.find_type path pat.pat_env with - | {type_kind = Type_variant cstrs} -> - Ext_list.find_opt cstrs (fun cstr -> - if cstr.cd_id.name = cd.cstr_name then - Ast_untagged_variants.get_block_type ~env:pat.pat_env - cstr - else None) - | _ -> None) - | _ -> None + let cdecl = + Ast_untagged_variants + .constructor_declaration_from_constructor_description + ~env:pat.pat_env cd in - match block_type with - | Some - ( IntType | StringType | FloatType | BigintType | BooleanType - | InstanceType _ | FunctionType | ObjectType ) -> - (* These types cannot be undefined *) - (id, lbl, pat_construct) - | _ -> x) + match cdecl with + | None -> x + | Some cstr -> ( + match + Ast_untagged_variants.get_block_type ~env:pat.pat_env cstr + with + | Some block_type + when not + (Ast_untagged_variants.block_type_can_be_undefined + block_type) -> + (id, lbl, pat_construct) + | _ -> x)) | _ -> x in t.(lbl.lbl_pos) <- x) From 4149577d19cdbd440ba95de5e3d9b578a4a468c6 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 2 Nov 2024 10:02:46 +0100 Subject: [PATCH 3/6] Extend test with 0-ary case. --- tests/tests/src/pattern_match_json.mjs | 10 ++++++++++ tests/tests/src/pattern_match_json.res | 6 ++++++ 2 files changed, 16 insertions(+) diff --git a/tests/tests/src/pattern_match_json.mjs b/tests/tests/src/pattern_match_json.mjs index 69fc37f45b..85a36e3256 100644 --- a/tests/tests/src/pattern_match_json.mjs +++ b/tests/tests/src/pattern_match_json.mjs @@ -29,7 +29,17 @@ function decodeGroup(group) { } } +function decodeNull(x) { + let match = x.field; + if (match !== undefined && match === null) { + return "yes it's null"; + } else { + return "no"; + } +} + export { decodeGroup, + decodeNull, } /* No side effect */ diff --git a/tests/tests/src/pattern_match_json.res b/tests/tests/src/pattern_match_json.res index 60e73c4619..3364df8997 100644 --- a/tests/tests/src/pattern_match_json.res +++ b/tests/tests/src/pattern_match_json.res @@ -18,3 +18,9 @@ let decodeGroup = group => { | _ => ("e", "f") } } + +let decodeNull = x => + switch x { + | dict{"field": Null} => "yes it's null" + | _ => "no" + } From 117383e350016cbb75bae9afdcb32bcac4896c2b Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 2 Nov 2024 10:04:47 +0100 Subject: [PATCH 4/6] Support nullary variants. --- compiler/ml/ast_untagged_variants.ml | 7 +++++++ compiler/ml/parmatch.ml | 5 +++++ tests/tests/src/pattern_match_json.mjs | 4 ++-- 3 files changed, 14 insertions(+), 2 deletions(-) diff --git a/compiler/ml/ast_untagged_variants.ml b/compiler/ml/ast_untagged_variants.ml index fd690100f9..5a4859b15a 100644 --- a/compiler/ml/ast_untagged_variants.ml +++ b/compiler/ml/ast_untagged_variants.ml @@ -97,6 +97,13 @@ let block_type_can_be_undefined = function false | UnknownType -> true +let tag_can_be_undefined tag = + match tag.tag_type with + | None -> false + | Some (String _ | Int _ | Float _ | BigInt _ | Bool _ | Null) -> false + | Some (Untagged block_type) -> block_type_can_be_undefined block_type + | Some Undefined -> true + let has_untagged (attrs : Parsetree.attributes) = Ext_list.exists attrs (function {txt}, _ -> txt = untagged) diff --git a/compiler/ml/parmatch.ml b/compiler/ml/parmatch.ml index 783087b90d..c3036b65e7 100644 --- a/compiler/ml/parmatch.ml +++ b/compiler/ml/parmatch.ml @@ -551,6 +551,11 @@ let all_record_args lbls = in match cdecl with | None -> x + | Some cstr + when Ast_untagged_variants.is_nullary_variant cstr.cd_args -> + let _, tag = Ast_untagged_variants.get_cstr_loc_tag cstr in + if Ast_untagged_variants.tag_can_be_undefined tag then x + else (id, lbl, pat_construct) | Some cstr -> ( match Ast_untagged_variants.get_block_type ~env:pat.pat_env cstr diff --git a/tests/tests/src/pattern_match_json.mjs b/tests/tests/src/pattern_match_json.mjs index 85a36e3256..6678d878e9 100644 --- a/tests/tests/src/pattern_match_json.mjs +++ b/tests/tests/src/pattern_match_json.mjs @@ -30,8 +30,8 @@ function decodeGroup(group) { } function decodeNull(x) { - let match = x.field; - if (match !== undefined && match === null) { + let tmp = x.field; + if (tmp === null) { return "yes it's null"; } else { return "no"; From c7a0714c14e12f48497ce5c7a6c79efff36b031e Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 2 Nov 2024 10:08:49 +0100 Subject: [PATCH 5/6] Add test to check correctness of undefined case. --- tests/tests/src/pattern_match_json.mjs | 17 ++++++++++++++++- tests/tests/src/pattern_match_json.res | 7 +++++++ 2 files changed, 23 insertions(+), 1 deletion(-) diff --git a/tests/tests/src/pattern_match_json.mjs b/tests/tests/src/pattern_match_json.mjs index 6678d878e9..378f82afeb 100644 --- a/tests/tests/src/pattern_match_json.mjs +++ b/tests/tests/src/pattern_match_json.mjs @@ -1,9 +1,10 @@ // Generated by ReScript, PLEASE EDIT WITH CARE +import * as Primitive_option from "rescript/lib/es6/Primitive_option.js"; function decodeGroup(group) { let id = group.id; - if (id === null) { + if (id == null) { return [ "e", "f" @@ -38,8 +39,22 @@ function decodeNull(x) { } } +function decodeUndefined(x) { + let match = x.field; + if (match === undefined) { + return "no"; + } + let tmp = Primitive_option.valFromOption(match); + if (tmp === undefined) { + return "yes it's undefined"; + } else { + return "no"; + } +} + export { decodeGroup, decodeNull, + decodeUndefined, } /* No side effect */ diff --git a/tests/tests/src/pattern_match_json.res b/tests/tests/src/pattern_match_json.res index 3364df8997..4e0844639e 100644 --- a/tests/tests/src/pattern_match_json.res +++ b/tests/tests/src/pattern_match_json.res @@ -2,6 +2,7 @@ type rec t = | Boolean(bool) | @as(null) Null + | @as(undefined) Undefined | String(string) | Number(float) | Object(Dict.t) @@ -24,3 +25,9 @@ let decodeNull = x => | dict{"field": Null} => "yes it's null" | _ => "no" } + +let decodeUndefined = x => + switch x { + | dict{"field": Undefined} => "yes it's undefined" + | _ => "no" + } From 8ab1bdc40189b15f7da1c0eee597cf511d5b7d9d Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 2 Nov 2024 10:09:48 +0100 Subject: [PATCH 6/6] Update CHANGELOG.md --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 1a72b5bf13..30da409643 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -56,7 +56,7 @@ - Improve code generation or pattern matching of untagged variants. https://github.com/rescript-lang/rescript-compiler/pull/7128 - Improve negation handling in combination with and/or to simplify generated code (especially coming out of pattern matching). https://github.com/rescript-lang/rescript-compiler/pull/7138 - optimize JavaScript code generation by using x == null checks and improving type-based optimizations for string/number literals. https://github.com/rescript-lang/rescript-compiler/pull/7141 -- Improve pattern matching on optional fields. https://github.com/rescript-lang/rescript-compiler/pull/7143 +- Improve pattern matching on optional fields. https://github.com/rescript-lang/rescript-compiler/pull/7143 https://github.com/rescript-lang/rescript-compiler/pull/7144 #### :house: Internal