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 diff --git a/compiler/ml/ast_untagged_variants.ml b/compiler/ml/ast_untagged_variants.ml index 5e7df5cd69..5a4859b15a 100644 --- a/compiler/ml/ast_untagged_variants.ml +++ b/compiler/ml/ast_untagged_variants.ml @@ -91,6 +91,19 @@ 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 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) @@ -328,23 +341,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 03f11793f6..c3036b65e7 100644 --- a/compiler/ml/parmatch.ml +++ b/compiler/ml/parmatch.ml @@ -539,6 +539,33 @@ 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 cdecl = + Ast_untagged_variants + .constructor_declaration_from_constructor_description + ~env:pat.pat_env cd + 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 + 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) diff --git a/tests/tests/src/pattern_match_json.mjs b/tests/tests/src/pattern_match_json.mjs new file mode 100644 index 0000000000..378f82afeb --- /dev/null +++ b/tests/tests/src/pattern_match_json.mjs @@ -0,0 +1,60 @@ +// 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) { + 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 + ]; + } +} + +function decodeNull(x) { + let tmp = x.field; + if (tmp === null) { + return "yes it's null"; + } else { + return "no"; + } +} + +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 new file mode 100644 index 0000000000..4e0844639e --- /dev/null +++ b/tests/tests/src/pattern_match_json.res @@ -0,0 +1,33 @@ +@unboxed +type rec t = + | Boolean(bool) + | @as(null) Null + | @as(undefined) Undefined + | 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") + } +} + +let decodeNull = x => + switch x { + | dict{"field": Null} => "yes it's null" + | _ => "no" + } + +let decodeUndefined = x => + switch x { + | dict{"field": Undefined} => "yes it's undefined" + | _ => "no" + }