diff --git a/changes/untagged-dispatch.polish.md b/changes/untagged-dispatch.polish.md new file mode 100644 index 0000000000..71fd94313c --- /dev/null +++ b/changes/untagged-dispatch.polish.md @@ -0,0 +1 @@ +- Match an untagged variant with one `switch` over its literals and one `switch (typeof x)` over its primitive cases before any class check, so that strings and numbers skip `instanceof` and a class missing at run time no longer throws for them. diff --git a/compiler/core/js_exp_make.ml b/compiler/core/js_exp_make.ml index 8623b72df4..076cbb4bff 100644 --- a/compiler/core/js_exp_make.ml +++ b/compiler/core/js_exp_make.ml @@ -1409,52 +1409,44 @@ let class_constructor (instance : Variant_runtime.Instance.t) = | [] -> assert false | global :: properties -> List.fold_left dot (js_global global) properties -(* The [typeof] string an untagged payload answers to. *) -let block_type_name = function - | Variant_runtime.InstanceType i -> class_constructor i - | block_type -> ( - match Variant_runtime.typeof_name block_type with - | Some name -> str name - | None -> - (* An unknown payload has no check: it is the only payload case *) - assert false) +(* The [typeof] string an untagged payload answers to, as a [switch] key. + Instances are told apart by [is_instance_of], an unknown payload is not + checked *) +let block_type_name block_type = + match Variant_runtime.typeof_name block_type with + | Some name -> str name + | None -> assert false let tag_type = function | Variant_runtime.Literal d -> literal_tag d | Payload_shape b -> block_type_name b -let rec emit_check (check : t Ast_untagged_variants.Dynamic_checks.t) = - match check with - | TagType t -> tag_type t - | BinOp (op, x, y) -> - let op = - match op with - | EqEqEq -> Js_op.EqEqEq - | NotEqEq -> NotEqEq - | And -> And - | Or -> Or - in - bin op (emit_check x) (emit_check y) - | TypeOf x -> typeof (emit_check x) - | IsInstanceOf (Array, x) -> is_array (emit_check x) - | IsInstanceOf (instance, x) -> - instanceof (emit_check x) (class_constructor instance) - | Not x -> not (emit_check x) - | Expr x -> x - -let is_a_literal_case ~literal_cases ~block_cases (e : t) = - let check = - Ast_untagged_variants.Dynamic_checks.is_a_literal_case ~literal_cases - ~block_cases (Expr e) - in - emit_check check - -let is_int_tag ?has_null_undefined_other e = - let check = - Ast_untagged_variants.Dynamic_checks.is_int_tag ?has_null_undefined_other - (Expr e) +let is_instance_of (instance : Variant_runtime.Instance.t) e = + match instance with + | Array -> is_array e + | Class _ -> instanceof e (class_constructor instance) + +(* Whether a value of a tagged variant is a constant rather than a block, + given the literals of its constants *) +let is_int_tag ~(literal_tags : Variant_runtime.literal_tag list) e = + let has_null = List.mem Variant_runtime.Null literal_tags in + let has_undefined = List.mem Variant_runtime.Undefined literal_tags in + let has_other = + List.exists + (function + | Variant_runtime.Null | Undefined -> false + | String _ | Int _ | Float _ | BigInt _ | Bool _ -> true) + literal_tags in - emit_check check + let is_null = bin EqEqEq e nil in + let is_undefined = bin EqEqEq e undefined in + let not_an_object = bin NotEqEq (typeof e) (str "object") in + match (has_null, has_undefined, has_other) with + | true, false, false -> is_null + | true, true, false -> bin Or is_null is_undefined + | false, true, false -> is_undefined + | true, _, true -> bin Or is_null not_an_object + | false, _, _ -> not_an_object let tag ?comment ?(name = Js_dump_lit.tag) e : t = {expression_desc = Caml_block_tag (e, name); comment; source_loc = None} diff --git a/compiler/core/js_exp_make.mli b/compiler/core/js_exp_make.mli index 70f6e7326f..e1622ec8e0 100644 --- a/compiler/core/js_exp_make.mli +++ b/compiler/core/js_exp_make.mli @@ -164,7 +164,8 @@ val assign : ?comment:string -> t -> t -> t val literal_tag : Variant_runtime.literal_tag -> t val tag_type : Variant_runtime.tag_type -> t -val emit_check : t Ast_untagged_variants.Dynamic_checks.t -> t +val is_instance_of : Variant_runtime.Instance.t -> t -> t +(** [Array.isArray(e)] or [e instanceof C] *) val triple_equal : ?comment:string -> t -> t -> t (* TODO: reduce [triple_equal] use *) @@ -179,13 +180,7 @@ val eq_null_undefined_boolean : ?comment:string -> t -> t -> t val neq_null_undefined_boolean : ?comment:string -> t -> t -> t -val is_int_tag : ?has_null_undefined_other:bool * bool * bool -> t -> t - -val is_a_literal_case : - literal_cases:Variant_runtime.literal_tag list -> - block_cases:Variant_runtime.block_type list -> - t -> - t +val is_int_tag : literal_tags:Variant_runtime.literal_tag list -> t -> t val is_type_object : t -> t diff --git a/compiler/core/js_stmt_make.mli b/compiler/core/js_stmt_make.mli index b3dbcd9b00..7be481bee9 100644 --- a/compiler/core/js_stmt_make.mli +++ b/compiler/core/js_stmt_make.mli @@ -76,6 +76,9 @@ val string_switch : (Variant_runtime.tag_type * J.case_clause) list -> t +val block_last_is_return_throw_or_continue : J.block -> bool +(** Whether control never falls out of the end of the block *) + val declare_variable : ?comment:string -> ?ident_info:J.ident_info -> diff --git a/compiler/core/lam_compile.ml b/compiler/core/lam_compile.ml index 4ed029f6e4..678f318e35 100644 --- a/compiler/core/lam_compile.ml +++ b/compiler/core/lam_compile.ml @@ -164,7 +164,13 @@ let group_apply ~merge_cases cases callback = only jmp_table and env needed *) -type default_case = Default of Lambda.t | Complete | NonComplete +type default_case = + | Default of Lambda.t + | Compiled of (Lam_compile_context.t -> J.block) + (** a default compiled by the caller, such as the payload dispatch of + an untagged variant after its literals *) + | Complete + | NonComplete let default_action ~saturated failaction = match failaction with @@ -181,20 +187,9 @@ let tag_of_switch_key = function Some (Variant_runtime.to_matchable_tag tag) let dispatch_info = function - | Lambda.Switch_direct -> (Js_dump_lit.tag, [], [], (false, false, false)) - | Switch_variant - { - Variant_runtime.tag_name; - block_types; - literal_tags; - has_null; - has_undefined; - has_other_literal; - } -> - ( Option.value tag_name ~default:Js_dump_lit.tag, - block_types, - literal_tags, - (has_null, has_undefined, has_other_literal) ) + | Lambda.Switch_direct -> (Js_dump_lit.tag, [], []) + | Switch_variant {Variant_runtime.tag_name; block_types; literal_tags} -> + (Option.value tag_name ~default:Js_dump_lit.tag, block_types, literal_tags) let no_effects_const = lazy true (* let has_effects_const = lazy false *) @@ -564,6 +559,7 @@ let compile output_prefix = switch_exp:J.expression -> default:default_case -> ?merge_cases:('a -> 'a -> bool) -> + ?always_switch:bool -> ('a * Lambda.t) list -> J.block = fun (type a) ~(make_exp : a -> J.expression) @@ -576,13 +572,19 @@ let compile output_prefix = _ -> (a * J.case_clause) list -> J.statement) ~(switch_exp : J.expression) ~(default : default_case) - ?(merge_cases = fun _ _ -> true) (cases : (a * Lambda.t) list) -> + ?(merge_cases = fun _ _ -> true) ?(always_switch = false) + (cases : (a * Lambda.t) list) -> let output_block_with_source_loc cxt lam = compile_lambda cxt lam |> Js_output.output_as_block |> with_block_source_loc lam in + let output_default cxt = function + | Default lam -> output_block_with_source_loc cxt lam + | Compiled compile -> compile cxt + | Complete | NonComplete -> [] + in match (cases, default) with - | [], Default lam -> output_block_with_source_loc cxt lam + | [], (Default _ | Compiled _) -> output_default cxt default | [], (Complete | NonComplete) -> [] | [(_, lam)], Complete -> (* To take advantage of such optimizations, @@ -592,14 +594,23 @@ let compile output_prefix = it's also complete *) output_block_with_source_loc cxt lam - | [(id, lam)], NonComplete -> + | [(id, lam)], NonComplete when not always_switch -> morph_declare_to_assign cxt (fun cxt define -> [ S.if_ ?declaration:define (eq_exp None switch_exp (Some id) (make_exp id)) (output_block_with_source_loc cxt lam); ]) - | [(id, lam)], Default x | [(id, lam); (_, x)], Complete -> + | [(id, lam)], (Default _ | Compiled _) when not always_switch -> + morph_declare_to_assign cxt (fun cxt define -> + let else_block = output_default cxt default in + let then_block = output_block_with_source_loc cxt lam in + [ + S.if_ ?declaration:define + (eq_exp None switch_exp (Some id) (make_exp id)) + then_block ~else_:else_block; + ]) + | [(id, lam); (_, x)], Complete when not always_switch -> morph_declare_to_assign cxt (fun cxt define -> let else_block = output_block_with_source_loc cxt x in let then_block = output_block_with_source_loc cxt lam in @@ -639,14 +650,9 @@ let compile output_prefix = in let switch_cxt = Lam_compile_context.enter_switch cxt in let default = - match default with - | Complete -> None - | NonComplete -> None - | Default lam -> ( - let statements = output_block_with_source_loc switch_cxt lam in - match statements with - | [] -> None - | _ -> Some statements) + match output_default switch_cxt default with + | [] -> None + | statements -> Some statements in let body = group_apply ~merge_cases cases (fun last (switch_case, lam) -> @@ -696,14 +702,14 @@ let compile output_prefix = Some ((Literal (String name), lam) :: string_table) | _, _ -> None) table (Some []) - and compile_cases ?(untagged = false) ?(has_null_case = false) ~cxt + and compile_cases ?(untagged = false) ?(null_guard = false) ~cxt ~(switch_exp : E.t) ?(default = NonComplete) ?(block_cases = []) cases : initialization = match use_compile_literal_cases cases with | Some string_cases -> if untagged then - compile_untagged_cases ~cxt ~switch_exp ~block_cases ~default - ~has_null_case string_cases + compile_untagged_cases ~cxt ~switch_exp ~block_cases ~null_guard + ~default string_cases else compile_string_cases ~cxt ~switch_exp ~default string_cases | None -> cases @@ -748,9 +754,7 @@ let compile output_prefix = let sw_blocks_default = default_action ~saturated:sw_blocks_full sw_failaction in - let tag_name, block_cases, literal_cases, has_null_undefined_other = - dispatch_info sw_dispatch - in + let tag_name, block_cases, literal_cases = dispatch_info sw_dispatch in let untagged = block_cases <> [] in let compile_whole (cxt : Lam_compile_context.t) = match @@ -770,59 +774,161 @@ let compile output_prefix = else (* [e] will be used twice *) let dispatch e = - let is_a_literal_case () = - if untagged then E.is_a_literal_case ~literal_cases ~block_cases e - else E.is_int_tag ~has_null_undefined_other e - in - let eq_default d1 d2 = - match (d1, d2) with - | Default lam1, Default lam2 -> Lambda.eq_approx lam1 lam2 - | Complete, Complete -> true - | NonComplete, NonComplete -> true - | _ -> false - in - (* A literal handled by the default would otherwise pass the - check of a payload arm of its kind *) - let a_literal_reaches_an_arm () = - let arm_types = + if untagged then + (* The literals first, compared with [===] by one switch whose + default is the payload dispatch. A literal without an arm + goes to the match's default, never to a payload arm *) + let named = + Ext_list.filter_map sw_consts (fun (key, _) -> + match tag_of_switch_key key with + | Some {tag_type = Some (Literal literal)} -> Some literal + | Some {name; tag_type = None} -> Some (String name) + | Some {tag_type = Some (Payload_shape _)} | None -> None) + in + (* A literal reaches the same default through the payload + dispatch when no payload arm accepts its kind and no class + check runs on it *) + let payload_arms = Ext_list.filter_map sw_blocks (fun (key, _) -> match tag_of_switch_key key with | Some {tag_type = Some (Payload_shape block_type)} -> Some block_type - | Some _ | None -> None) + | Some {tag_type = Some (Literal _) | None} | None -> + (* The blocks of an untagged variant are all untagged *) + None) in - Ext_list.exists literal_cases - (fun (literal : Variant_runtime.literal_tag) -> - Ext_list.exists arm_types - (fun (block_type : Variant_runtime.block_type) -> - match (literal, block_type) with - | String _, StringType - | (Int _ | Float _), NumberType - | BigInt _, BigintType - | Bool _, BooleanType - | _, UnknownType -> - true - | _, _ -> false)) - in - if - untagged - && List.length sw_consts = 0 - && eq_default sw_num_default sw_blocks_default - && not (a_literal_reaches_an_arm ()) - then - let has_null_case = List.mem Variant_runtime.Null literal_cases in - compile_cases ~untagged ~cxt - ~switch_exp:(if untagged then e else E.tag ~name:tag_name e) - ~block_cases ~has_null_case ~default:sw_blocks_default sw_blocks + let reaches_a_payload_arm literal = + List.exists + (Variant_runtime.literal_passes literal) + payload_arms + in + let has_class_case = + List.exists + (function + | Variant_runtime.InstanceType (Class _) -> true + | _ -> false) + block_cases + in + let unnamed = + List.filter + (fun literal -> not (List.mem literal named)) + literal_cases + in + (* [null] passes only the object check, which then tests + [x !== null] *) + let skips_the_switch (literal : Variant_runtime.literal_tag) = + (not has_class_case) + && ((not (reaches_a_payload_arm literal)) + || literal = Null + && not (List.mem Variant_runtime.UnknownType payload_arms) + ) + in + (* Values no payload arm takes are the literals without an arm: + a complete payload dispatch checks its last arm, and these + literals skip the switch *) + let blocks_default = + match (sw_num_default, sw_blocks_default) with + | Default lam, Complete + when List.exists skips_the_switch unnamed -> + Default lam + | _ -> sw_blocks_default + in + let null_guard = + match (sw_num_default, blocks_default) with + | Default _, Default _ -> + List.exists + (fun (literal : Variant_runtime.literal_tag) -> + literal = Null && skips_the_switch literal) + unnamed + | _ -> false + in + let unnamed = + match (sw_num_default, blocks_default) with + | Default lam, Default _ -> + Ext_list.filter_map unnamed (fun literal -> + if skips_the_switch literal then None + else Some (Variant_runtime.Literal literal, lam)) + | Default lam, (Compiled _ | Complete | NonComplete) -> + List.map + (fun literal -> (Variant_runtime.Literal literal, lam)) + unnamed + | (Compiled _ | Complete | NonComplete), _ -> [] + in + let literal_arms = + match use_compile_literal_cases sw_consts with + | Some arms -> arms @ unnamed + | None -> assert false + in + (* A complete payload dispatch with one body runs it unchecked, + so a literal arm with the same body can go there too *) + let literal_arms = + match (blocks_default, sw_blocks) with + | Complete, (_, body) :: rest + when List.for_all + (fun (_, other) -> Lambda.eq_approx body other) + rest -> + List.filter + (fun (_, lam) -> not (Lambda.eq_approx body lam)) + literal_arms + | _ -> literal_arms + in + let payload = + Compiled + (fun cxt -> + compile_cases ~untagged ~null_guard ~cxt ~switch_exp:e + ~block_cases ~default:blocks_default sw_blocks) + in + if List.length literal_arms <= 2 then + (* An [if] per body, testing its literals with [===] *) + let rec group = function + | [] -> [] + | (tag, lam) :: rest -> + let same, others = + List.partition + (fun (_, other) -> Lambda.eq_approx lam other) + rest + in + (tag :: List.map fst same, lam) :: group others + in + let rec chain ~cxt = function + | [] -> ( + match payload with + | Compiled compile -> compile cxt + | Default _ | Complete | NonComplete -> assert false) + | group :: rest -> + compile_general_cases + ~make_exp:(fun tags -> E.tag_type (List.hd tags)) + ~eq_exp:(fun _ x tags _ -> + match tags with + | Some (tag :: tags) -> + List.fold_left + (fun check tag -> + E.or_ check (E.string_equal x (E.tag_type tag))) + (E.string_equal x (E.tag_type tag)) + tags + | Some [] | None -> assert false) + ~cxt + ~switch:(fun ?default:_ ?declaration:_ _ _ -> + assert false) + ~switch_exp:e + ~default: + (match rest with + | [] -> payload + | _ :: _ -> Compiled (fun cxt -> chain ~cxt rest)) + [group] + in + chain ~cxt (group literal_arms) + else + compile_string_cases ~cxt ~switch_exp:e ~default:payload + literal_arms else [ - S.if_ (is_a_literal_case ()) + S.if_ + (E.is_int_tag ~literal_tags:literal_cases e) (compile_cases ~cxt ~switch_exp:e ~block_cases ~default:sw_num_default sw_consts) ~else_: - (compile_cases ~untagged ~cxt - ~switch_exp: - (if untagged then e else E.tag ~name:tag_name e) + (compile_cases ~cxt ~switch_exp:(E.tag ~name:tag_name e) ~block_cases ~default:sw_blocks_default sw_blocks); ] in @@ -858,106 +964,220 @@ let compile output_prefix = ~switch:(fun ?default ?declaration e clauses -> S.string_switch ?default ?declaration e clauses) ~switch_exp ~default - and compile_untagged_cases ~cxt ~switch_exp ~default ~block_cases - ~has_null_case cases = - let mk_eq (i : Variant_runtime.tag_type option) x j y = - let check = - match (i, j) with - | Some tag_type, _ -> - Ast_untagged_variants.Dynamic_checks.add_runtime_type_check ~tag_type - ~has_null_case ~block_cases (Expr x) (Expr y) - | _, Some tag_type -> - Ast_untagged_variants.Dynamic_checks.add_runtime_type_check ~tag_type - ~has_null_case ~block_cases (Expr y) (Expr x) - | _ -> Ast_untagged_variants.Dynamic_checks.( == ) (Expr x) (Expr y) - in - E.emit_check check - in - let tag_is_not_typeof = function - | Variant_runtime.Payload_shape (InstanceType _) -> true + and compile_untagged_cases ~cxt ~switch_exp ~default ~block_cases ~null_guard + cases = + (* The payload cases of an untagged variant, after its literals: one + [switch (typeof x)] over the primitive kinds, whose default is an [if] + chain over the classes (subclasses first), arrays, functions and + objects. Primitives never reach a class check, and a class instance + never reaches the function or object arm before its own. In a complete + match the last arm is not checked. *) + let is_primitive_tag = function + | Variant_runtime.Payload_shape + (NumberType | StringType | BigintType | BooleanType | SymbolType) -> + true | _ -> false in - let clause_is_not_typeof (tag, _) = tag_is_not_typeof tag in - let switch ?default ?declaration e clauses = - let not_typeof_clauses, typeof_clauses = - List.partition clause_is_not_typeof clauses + let complete = + match default with + | Complete -> true + | Default _ | Compiled _ | NonComplete -> false + in + let switch ?default:compiled_default ?declaration e clauses = + (* [None] in a complete match, where the last arm is not checked. A + value of an incomplete match that no arm takes runs no statement *) + let default = + if complete then None + else Some (Option.value compiled_default ~default:[]) in - let has_typeof kind = - List.exists - (function - | Variant_runtime.Payload_shape block_type, _ -> block_type = kind - | _ -> false) - typeof_clauses + let primitive_clauses, other_clauses = + List.partition (fun (tag, _) -> is_primitive_tag tag) clauses in - let has_object_typeof = has_typeof ObjectType in - (* When there's an ObjectType typeof case, null, arrays and class - instances can incorrectly match it (typeof null === typeof [] === - "object"), and class instances can match a FunctionType case, since - a class can extend Function. Guard against them when they should fall - through to default: null, and the instance cases without an arm of - their own. *) - let needs_null_guard = has_object_typeof && has_null_case in - let unmatched_instances = - if not (has_object_typeof || has_typeof FunctionType) then [] - else - Ext_list.filter_map block_cases (function - | Variant_runtime.InstanceType instance - when not - (List.exists - (function - | Variant_runtime.Payload_shape (InstanceType i), _ -> - i = instance - | _ -> false) - not_typeof_clauses) -> - Some instance - | _ -> None) + let arm block_type = + List.find_map + (fun (tag, {J.switch_body}) -> + if tag = Variant_runtime.Payload_shape block_type then + Some switch_body + else None) + other_clauses + in + (* A subclass is checked before its superclasses, otherwise the + declaration order decides *) + let rec subclasses_first = function + | [] -> [] + | instances -> + let first = + List.find + (fun i -> + not + (List.exists + (fun j -> Variant_runtime.Instance.is_subclass j ~of_:i) + instances)) + instances + in + first + :: subclasses_first (List.filter (fun i -> i <> first) instances) in let instances = - Ext_list.filter_map block_cases (function - | Variant_runtime.InstanceType i -> Some i - | _ -> None) + subclasses_first + (Ext_list.filter_map block_cases (function + | Variant_runtime.InstanceType i -> Some i + | _ -> None)) + in + let is_class = function + | Variant_runtime.Instance.Class _ -> true + | Array -> false + in + let check_instance i = E.is_instance_of i e in + let typeof_is name = E.string_equal (E.typeof e) (E.str name) in + (* [null], when it did not go to the default before *) + let is_object = + if null_guard then E.and_ (typeof_is "object") (E.not (E.is_null e)) + else typeof_is "object" + in + (* [Some body] for an arm, [None] for the default *) + let entries = + List.map + (fun i -> (Some (check_instance i), i, arm (InstanceType i))) + instances + |> List.filter_map (fun (check, i, body) -> + match (body, default) with + | Some body, _ -> Some (check, is_class i, Some body) + | None, Some _ -> Some (check, is_class i, None) + | None, None -> None) in - let rec build_if_chain remaining_clauses = - match remaining_clauses with - | ( Variant_runtime.Payload_shape (InstanceType instance_type), - {J.switch_body} ) - :: rest -> - S.if_ - (E.emit_check - (Ast_untagged_variants.Dynamic_checks.is_case_instance ~instances - instance_type (Expr e))) - switch_body - ~else_:[build_if_chain rest] - | _ -> ( - let typeof_switch () = - S.string_switch ?default ?declaration (E.typeof e) typeof_clauses + let entries = + entries + @ (match arm FunctionType with + | Some body -> [(Some (typeof_is "function"), false, Some body)] + | None -> []) + @ (match arm ObjectType with + | Some body -> [(Some is_object, false, Some body)] + | None -> []) + @ + match arm UnknownType with + | Some body -> [(None, false, Some body)] + | None -> [] + in + (* Checks leading to the default are needed only before an arm *) + let rec drop_trailing_defaults = function + | [] -> [] + | entries -> ( + match List.rev entries with + | (_, _, None) :: rest -> drop_trailing_defaults (List.rev rest) + | _ -> entries) + in + let entries = drop_trailing_defaults entries in + (* [if (c1) default else if (c2) body else default] is + [if (c2 && !c1) body else default], and [c1] then runs only on + values passing [c2], never on primitives *) + let entries = + match (default, List.rev entries) with + | Some _, (Some check, is_class, Some body) :: rest -> + let rec absorb check = function + | (Some previous, _, None) :: rest -> + absorb (E.and_ check (E.not previous)) rest + | rest -> List.rev ((Some check, is_class, Some body) :: rest) in - let guards = - (if needs_null_guard then [E.is_null e] else []) - @ List.map - (fun instance -> E.emit_check (IsInstanceOf (instance, Expr e))) - unmatched_instances + absorb check rest + | _ -> entries + in + (* Consecutive checks leading to the default share one [if] *) + let rec merge_defaults = function + | (Some c1, class1, None) :: (Some c2, class2, None) :: rest -> + merge_defaults ((Some (E.or_ c1 c2), class1 || class2, None) :: rest) + | entry :: rest -> entry :: merge_defaults rest + | [] -> [] + in + let entries = merge_defaults entries in + (* An arm may compile to no statement, so arms are counted here *) + let has_other_arms = entries <> [] in + (* The last arm of a complete match is not checked *) + let entries, final = + match (default, List.rev entries) with + | Some default, _ -> (entries, Some default) + | None, (_, _, body) :: rest -> (List.rev rest, body) + | None, [] -> (entries, None) + in + let has_class_check = + List.exists (fun (_, is_class, _) -> is_class) entries + in + let rec chain = function + | [] -> Option.value final ~default:[] + | (check, _, body) :: rest -> ( + let body = + Option.value body ~default:(Option.value default ~default:[]) in - let guard = - match guards with - | [] -> None - | first :: rest -> Some (List.fold_left E.or_ first rest) + match check with + | Some check -> [S.if_ check body ~else_:(chain rest)] + | None -> body) + in + let other = chain entries in + (* The primitive kinds of the type without an arm go to the default + directly when the chain has class checks *) + let unmatched_primitives = + match default with + | Some default when has_class_check -> + let kinds = + Ext_list.filter_map block_cases (fun block_type -> + let tag = Variant_runtime.Payload_shape block_type in + if + is_primitive_tag tag + && not (List.exists (fun (t, _) -> t = tag) primitive_clauses) + then Some tag + else None) in - match (guard, default) with - | Some guard, Some default_body -> - S.if_ guard default_body ~else_:[typeof_switch ()] - | Some guard, None -> S.if_ (E.not guard) [typeof_switch ()] - | None, _ -> typeof_switch ()) + Ext_list.mapi kinds (fun index tag -> + let last = index = List.length kinds - 1 in + ( tag, + { + J.switch_body = (if last then default else []); + should_break = + last + && not (S.block_last_is_return_throw_or_continue default); + comment = None; + source_loc = None; + } )) + | Some _ | None -> [] + in + let primitive_clauses = primitive_clauses @ unmatched_primitives in + (* One kind is an [if], more a [switch (typeof x)] *) + let typeof_switch ?default clauses = + match clauses with + | [ + ( Variant_runtime.Payload_shape block_type, + {J.switch_body; should_break} ); + ] + when switch_body <> [] || should_break -> ( + (* Not a clause falling through to the default *) + match Variant_runtime.typeof_name block_type with + | Some name -> + S.if_ ?declaration (typeof_is name) switch_body ?else_:default + | None -> assert false) + | _ -> S.string_switch ?declaration ?default (E.typeof e) clauses in - build_if_chain not_typeof_clauses + match primitive_clauses with + | [] -> ( + match declaration with + | Some (kind, id) -> S.block (S.declare_variable ~kind id :: other) + | None -> S.block other) + | _ :: _ when not has_other_arms -> ( + (* No other arm: in a complete match the last primitive arm is not + checked *) + match List.rev primitive_clauses with + | (_, {J.switch_body}) :: rest when complete -> + typeof_switch ~default:switch_body (List.rev rest) + | _ -> typeof_switch ?default primitive_clauses) + | _ :: _ -> typeof_switch ~default:other primitive_clauses in let merge_cases tag1 tag2 = - (* only merge typeof cases, as instanceof cases are pulled out into if-then-else *) - not (tag_is_not_typeof tag1 || tag_is_not_typeof tag2) + (* Only primitive kinds share a switch, and so bodies *) + is_primitive_tag tag1 && is_primitive_tag tag2 in cases - |> compile_general_cases ~make_exp:E.tag_type ~eq_exp:mk_eq ~cxt ~switch - ~switch_exp ~default ~merge_cases + |> compile_general_cases ~make_exp:E.tag_type + ~eq_exp:(fun _ _ _ _ -> assert false) + ~cxt ~switch ~switch_exp ~default ~merge_cases ~always_switch:true and compile_stringswitch l cases default (lambda_cxt : Lam_compile_context.t) = (* TODO might better optimization according to the number of cases diff --git a/compiler/ml/UntaggedVariants.md b/compiler/ml/UntaggedVariants.md index 91039ea064..070e42f22e 100644 --- a/compiler/ml/UntaggedVariants.md +++ b/compiler/ml/UntaggedVariants.md @@ -282,71 +282,84 @@ constructor: | `@as(true) LitTrue \| AnyBool(bool)` | `AnyBool(false)` | `AnyBool` | | `@as(null) LitNull \| AnyObject({x: int})` | `LitNull` | `LitNull` | -The "is a literal case" test is the smaller of two equivalent expressions: the -disjunction of `x === literal` over the literal cases, or the conjunction of -the negated payload checks (with a payload check replaced by the literal -disjunction where a literal overlaps it). A `switch` whose arms name no -literal case still tests the literals first when one of them would pass the -check of a payload arm, such as `@as("lit")` beside a `string` arm, so that -it reaches the default arm. - -- Implementation: `lam_compile.ml:compile_switch`, - `ast_untagged_variants.ml:Dynamic_checks.is_a_literal_case`. +The literals are compared with `===`: by one `switch (x)` over the literal +arms, whose default holds the payload dispatch, or, when at most two +literals get a `case`, by an `if` per arm body. A literal without an arm of its own goes +to the default arm. It gets a `case` leading there when it could pass a +check of the payload dispatch (a string literal beside a `string` arm, any +literal beside an unknown-kind arm) or when the variant has class cases; +otherwise it reaches the default through the payload dispatch, which then +checks its last arm. A `null` literal that only the object check would +accept adds `x !== null` to that check instead (rule 9). + +- Implementation: `lam_compile.ml:compile_switch`. - Tests: `spec_test` rule 7; `tests/tests/src/untagged_variants_heuristic.res` - (choice of expression). + (literals that skip the `switch`). - Shaped by #6125, #7128, #7135. ### 8. Payload cases -The payload arms compile in one of two forms. +The payload arms compile to one `switch (typeof x)` over the arms of +primitive kinds (string, number, bigint, boolean, symbol), an `if` for one +kind, whose default is an `if` chain over the other arms: -- **Two arms, or one arm and a default**: one `if` on the check of the arm - declared first, with the other branch unchecked (rule 10). The object check is - `typeof x === "object"`, followed by `x !== null` when the variant has an - `@as(null)` case, and by `!(x instanceof C)` (`!Array.isArray(x)` for - arrays) for every instance case of the variant. The function check is - followed by `!(x instanceof C)` for every class case. -- **Three or more arms**: an `if` chain of the instance checks, in the - declaration order of the cases, then one `switch (typeof x)` over the other - arms. - -In both forms a value of an instance case never lands in the object or -function case. A class check is followed by `!(x instanceof D)` for every -case whose class `D` is a subclass of it (rule 5), so a subclass instance -never lands in its superclass's case, whatever the declaration order: +1. the instance cases (arrays, tuples and classes), a subclass before its + superclasses (rule 5), otherwise in declaration order; +2. the function case, `typeof x === "function"`; +3. the object case, `typeof x === "object"`; +4. the unknown-kind case, unchecked. ```js -if (v instanceof Animal && !(v instanceof Dog)) { ... } +switch (typeof x) { + case "string": ... + case "number": ... + default: + if (x instanceof Dog) { ... } + else if (x instanceof Animal) { ... } + else if (typeof x === "object") { ... } +} ``` +An instance case without an arm leads to the default arm, so an array or a +class instance never lands in the function or object case. Before the last +checked arm such checks are folded into its check, which then guards them: +`typeof x === "object" && !(x instanceof Date)`. A primitive never reaches a +class check: it is taken by the `switch (typeof x)`, where a primitive kind +of the variant without an arm has a `case` leading to the default when a +class check could follow. In a complete match the last arm is not checked +(rule 10). + A value upcast to the superclass and wrapped in its case lands in the subclass case, as a payload equal to a literal lands in the literal's case -(rule 7). Classes not declared to be related are tested in declaration order. -`instanceof` consults `Symbol.hasInstance`, which is trusted. +(rule 7). `instanceof` consults `Symbol.hasInstance`, which is trusted for +the values that reach the check: objects and functions, and values outside +every case (rule 10). An `int` case is recognized by `typeof x === "number"` and so receives every number, integral or not. +`break` and `continue` in an arm leave or continue the enclosing loop: every +arm placed in a generated `switch` is compiled in a `switch` context, where +they are labeled. + - Implementation: `lam_compile.ml:compile_untagged_cases`, - `compile_general_cases`; - `ast_untagged_variants.ml:Dynamic_checks.add_runtime_type_check`, - `is_case_instance`. + `compile_general_cases`. - Tests: `spec_test` rules 4, 5 and 8 (`instanceName` shows the chain in - declaration order, `objectFirst` both forms); `tests/tests/src/UntaggedVariants.res` - (`AllInstanceofTypes`, `MergeCases`); - `tests/tests/src/untagged_runtime_annotations_test.res` (subclasses, the - function case). + declaration order, `objectFirst` the unchecked last arm); + `tests/tests/src/UntaggedVariants.res` (`AllInstanceofTypes`, + `MergeCases`); `tests/tests/src/untagged_runtime_annotations_test.res` + (subclasses, the function case, a missing class); + `untagged_default_arm_test.res` (`Symbol.hasInstance`, incomplete + matches); `untagged_loop_control_test.res` (`break`, `continue`). - Shaped by #6103, #6383, #6792, #7144, #7149. ### 9. `null` and arrays are not objects -`typeof null` and `typeof []` are `"object"`, and so is the `typeof` of a -class instance. The object case never receives `null` when the variant has an -`@as(null)` case, and never receives a value of another instance case (array, -tuple or class): the two-arm form adds the checks of rule 8, and the -`switch (typeof x)` form is preceded by `x === null`, `Array.isArray(x)` and -`x instanceof C` guards that send those values to the default arm when their -own arm is absent. -A case declared with `@typeOf("object")` +`typeof null` and `typeof []` are `"object"`, and a class instance is an +object or a function. The object case never receives `null` when the variant +has an `@as(null)` case: the literal comparisons run first (rule 7), or the +object check tests `x !== null` when `null` goes to the default arm. Neither +the object nor the function case receives an instance of another case: the +instance checks come first (rule 8). A case declared with `@typeOf("object")` (rule 5) is an object case: without an `@as(null)` case, it receives `null`, as a record case does. @@ -356,40 +369,42 @@ as a record case does. | | all | `null` | `GNull` | | | `GObject(_)`, `_` | `[]`, `null` | `_` | -- Implementation: `lam_compile.ml:compile_untagged_cases` (`needs_null_guard`, - `unmatched_instances`), `Dynamic_checks.add_runtime_type_check`. +- Implementation: `lam_compile.ml:compile_switch` (`null_guard`), + `compile_untagged_cases`. - Tests: `spec_test` rule 9; `UntaggedVariants.res` (`ObjectAndNull`, `Json`); `tests/tests/src/untagged_default_arm_test.res`. - Shaped by #6219, #7303, #8253, #8255, #8279, #8995. ### 10. Values outside every case -Recognition trusts the type. A value that belongs to no case is not rejected: - -- in the two-arm form it lands in the unchecked branch: with - `I(int) | S(string)`, `true` lands in `S`; with - `TDate(Date.t) | TRegExp(RegExp.t)`, `{x: 1}` lands in `TRegExp`; with - `PPromise(promise) | PFloat(float)`, a thenable that is not a - `Promise` lands in `PFloat`; -- in the `switch (typeof x)` form it matches no arm, and the `switch` - completes without running any arm. +Recognition trusts the type. A value that belongs to no case is not +rejected: in a complete match it lands in the arm that is not checked, the +last one of the `if` chain, or the last primitive arm when there is no other +arm. When the match sends several cases to one shared default, the dispatch +checks the arms before it and the value lands in that default instead. With `I(int) | S(string)`, `true` lands in `S`; with +`TDate(Date.t) | TRegExp(RegExp.t)`, `{x: 1}` lands in `TRegExp`; with +`PPromise(promise) | PFloat(float)`, the float case is checked, so a +thenable that is not a `Promise` lands in `PPromise`. A value from another JavaScript realm fails every `instanceof` check and is recognized the same way (by the semantics of `instanceof`; not tested): recognition is local to a realm. A class that does not exist where the -`switch` runs makes its check throw, for every value: the instance checks -precede the `typeof` checks, so primitives reach them too. +`switch` runs makes its check throw for every value that reaches it: objects +and functions, and values outside every case. The literals and the +primitives of the variant never reach it. -- Implementation: `lam_compile.ml:compile_general_cases` (a complete match - emits no check for its last clause). -- Tests: `spec_test` rule 10 (two-arm form); `kindName` in - `untagged_variants_spec_test.mjs` shows the `switch` form. +- Implementation: `lam_compile.ml:compile_untagged_cases` (a complete match + emits no check for its last arm). +- Tests: `spec_test` rule 10; `untagged_runtime_annotations_test.res` (a + missing class). ### 11. Constant folding -A `switch` on a constant untagged value folds to the arm that the run-time -dispatch selects for the constant's JavaScript value, so `S("a")` matched -against `@as("a") A | S(string)` folds to `A`. +A `switch` on an untagged value the compiler knows, a literal or a block of +constants, folds to the arm that the run-time dispatch selects for its +JavaScript value, so `S("a")` matched against `@as("a") A | S(string)` folds +to `A`. A value built at run time, such as `A([1])` with its array, is +matched at run time. - Implementation: `lambda.ml:switch` (`untagged_action`, `literal_denotes_same`). - Tests: `tests/tests/src/unboxed_variant_fold_test.res`. @@ -554,6 +569,5 @@ had to answer, and the answers of rule 5: 9. **Globals.** A shadowed class is read through `globalThis`. A missing class throws when the check runs (rule 10). -Still open: a class imported from a module cannot be named; the `typeof` -checks could precede the instance checks, so that a missing class affects -only objects; and the typed arrays share one type (#8955). +Still open: a class imported from a module cannot be named, and the typed +arrays share one type (#8955). diff --git a/compiler/ml/ast_untagged_variants.ml b/compiler/ml/ast_untagged_variants.ml index 08f83a80c0..c95d205096 100644 --- a/compiler/ml/ast_untagged_variants.ml +++ b/compiler/ml/ast_untagged_variants.ml @@ -551,191 +551,3 @@ let check_tag_field_conflicts (cstrs : Types.constructor_declaration list) = fields | _ -> ()) cstrs - -module Dynamic_checks = struct - type op = EqEqEq | NotEqEq | Or | And - type 'a t = - | BinOp of op * 'a t * 'a t - | TagType of tag_type - | TypeOf of 'a t - | IsInstanceOf of Instance.t * 'a t - | Not of 'a t - | Expr of 'a - - let rec size = function - | BinOp (_, x, y) -> 1 + size x + size y - | TagType _ -> 1 - | TypeOf x -> 1 + size x - | IsInstanceOf (_, x) -> 1 + size x - | Not x -> 1 + size x - | Expr _ -> 1 - - let bin op x y = BinOp (op, x, y) - let tag_type t = TagType t - let typeof x = TypeOf x - let str s = Literal (String s) |> tag_type - let is_instance i x = IsInstanceOf (i, x) - let not x = Not x - let nil = Literal Null |> tag_type - let undefined = Literal Undefined |> tag_type - let object_ = Payload_shape ObjectType |> tag_type - - let function_ = Payload_shape FunctionType |> tag_type - let string = Payload_shape StringType |> tag_type - let number = Payload_shape NumberType |> tag_type - - let bigint = Payload_shape BigintType |> tag_type - - let boolean = Payload_shape BooleanType |> tag_type - - let symbol = Payload_shape SymbolType |> tag_type - - let ( == ) x y = bin EqEqEq x y - let ( != ) x y = bin NotEqEq x y - let ( ||| ) x y = bin Or x y - let ( &&& ) x y = bin And x y - - let rec is_a_literal_case ~(literal_cases : literal_tag list) ~block_cases - ~list_literal_cases (e : _ t) = - let overlaps p = Ext_list.exists literal_cases p in - let literals_overlaps_with_string () = - overlaps (function - | String _ -> true - | _ -> false) - in - let literals_overlaps_with_number () = - overlaps (function - | Int _ | Float _ -> true - | _ -> false) - in - let literals_overlaps_with_bigint () = - overlaps (function - | BigInt _ -> true - | _ -> false) - in - let literals_overlaps_with_boolean () = - overlaps (function - | Bool _ -> true - | _ -> false) - in - let literals_overlaps_with_object () = - overlaps (function - | Null -> true - | _ -> false) - in - let is_literal_case (t : literal_tag) : _ t = e == tag_type (Literal t) in - let is_not_block_case (c : block_type) : _ t = - match c with - | StringType - when literals_overlaps_with_string () = false (* No overlap *) -> - typeof e != string - | NumberType when literals_overlaps_with_number () = false -> - typeof e != number - | BigintType when literals_overlaps_with_bigint () = false -> - typeof e != bigint - | BooleanType when literals_overlaps_with_boolean () = false -> - typeof e != boolean - | InstanceType i -> not (is_instance i e) - | SymbolType -> typeof e != symbol - | FunctionType -> typeof e != function_ - | ObjectType when literals_overlaps_with_object () = false -> - typeof e != object_ - | ObjectType (* overlap *) -> e == nil ||| (typeof e != object_) - | StringType (* overlap *) - | NumberType (* overlap *) - | BigintType (* overlap *) - | BooleanType (* overlap *) - | UnknownType -> ( - (* We don't know the type of unknown, so we need to express: - this is not one of the literals *) - match literal_cases with - | [] -> - (* this should not happen *) - assert false - | l1 :: others -> - let is_literal_1 = is_literal_case l1 in - Ext_list.fold_right others is_literal_1 (fun literal_n acc -> - is_literal_case literal_n ||| acc)) - in - if list_literal_cases then - let rec mk cases = - match List.rev cases with - | [case] -> is_literal_case case - | case :: rest -> is_literal_case case ||| mk rest - | [] -> assert false - in - mk literal_cases - else - match block_cases with - | [c] -> is_not_block_case c - | c1 :: (_ :: _ as rest) -> - is_not_block_case c1 - &&& is_a_literal_case ~literal_cases ~block_cases:rest - ~list_literal_cases e - | [] -> assert false - - let is_a_literal_case ~literal_cases ~block_cases e = - let with_literal_cases = - is_a_literal_case ~literal_cases ~block_cases ~list_literal_cases:true e - in - let without_literal_cases = - is_a_literal_case ~literal_cases ~block_cases ~list_literal_cases:false e - in - if size with_literal_cases <= size without_literal_cases then - with_literal_cases - else without_literal_cases - - let is_int_tag ?(has_null_undefined_other = (false, false, false)) (e : _ t) : - _ t = - let has_null, has_undefined, has_other = has_null_undefined_other in - if has_null && has_undefined = false && has_other = false then - (* null *) - bin EqEqEq e nil - else if has_null && has_undefined && has_other = false then - (* null + undefined *) - e == nil ||| e == undefined - else if has_null = false && has_undefined && has_other = false then - (* undefined *) - e == undefined - else if has_null then - (* (null + undefined + other) || (null + other) *) - e == nil ||| typeof e != object_ - else (* (undefiled + other) || other *) - typeof e != object_ - - (* An instance of the case's class [i] that is not an instance of a subclass - of [i] that is a case of its own: [instanceof] holds for superclasses - too. *) - let is_case_instance ~(instances : Instance.t list) i y = - Ext_list.fold_left instances (is_instance i y) (fun check other -> - if Instance.is_subclass other ~of_:i then - check &&& not (is_instance other y) - else check) - - let add_runtime_type_check ~tag_type ~has_null_case - ~(block_cases : block_type list) x y = - let instances = - Ext_list.filter_map block_cases (function - | InstanceType i -> Some i - | _ -> None) - in - (* Instances of a class can be objects or functions, so the cases of - those kinds exclude the class cases *) - let not_one_of_the_instances case = - Ext_list.fold_right instances case (fun i x -> - x &&& not (is_instance i y)) - in - match tag_type with - | Payload_shape - (NumberType | StringType | BigintType | BooleanType | SymbolType) -> - typeof y == x - | Payload_shape FunctionType -> not_one_of_the_instances (typeof y == x) - | Payload_shape ObjectType -> - not_one_of_the_instances - (if has_null_case then typeof y == x &&& (y != nil) else typeof y == x) - | Payload_shape (InstanceType i) -> is_case_instance ~instances i y - | Payload_shape UnknownType -> - (* This should not happen because unknown must be the only non-literal case *) - assert false - | Literal _ -> x -end diff --git a/compiler/ml/lambda.ml b/compiler/ml/lambda.ml index 33443e420e..9912aade63 100644 --- a/compiler/ml/lambda.ml +++ b/compiler/ml/lambda.ml @@ -848,19 +848,18 @@ let runtime_value_kind (c : structured_constant) = Integer tags are emitted through [Int32.of_int], just like [Const_int]. *) let literal_denotes_same = Variant_runtime.same_literal_value -(* Mirror [Dynamic_checks]: literals take precedence; the object case excludes - arrays when an array case exists. Int and float share one runtime type. *) +(* Whether the payload dispatch sends a value of this kind to a case of this + block type. Literals are checked as the generated code checks them; the + object case excludes arrays when an array case exists. *) let value_has_block_type ~block_types (kind : value_kind) (block_type : Variant_runtime.block_type) = match (block_type, kind) with - | NumberType, Is_literal (Int _ | Float _) -> true - | StringType, Is_literal (String _) -> true - | BooleanType, Is_literal (Bool _) -> true + | _, Is_literal literal -> Variant_runtime.literal_passes literal block_type | ObjectType, Is_object -> true | InstanceType Array, Is_array -> true | ObjectType, Is_array -> not (List.mem (Variant_runtime.InstanceType Array) block_types) - | UnknownType, (Is_literal _ | Is_object | Is_array) -> true + | UnknownType, (Is_object | Is_array) -> true | UnknownType, Unknown_value -> false | ( ( NumberType | StringType | BooleanType | ObjectType | BigintType | SymbolType | FunctionType | InstanceType _ ), diff --git a/compiler/ml/variant_runtime.ml b/compiler/ml/variant_runtime.ml index e9ae359589..4b21e9294d 100644 --- a/compiler/ml/variant_runtime.ml +++ b/compiler/ml/variant_runtime.ml @@ -91,6 +91,20 @@ let literal_value_key = function let same_literal_value a b = literal_value_key a = literal_value_key b +let literal_passes (literal : literal_tag) (block_type : block_type) = + match (block_type, literal) with + | UnknownType, _ + | StringType, String _ + | NumberType, (Int _ | Float _) + | BigintType, BigInt _ + | BooleanType, Bool _ + | ObjectType, Null -> + true + | ( ( StringType | NumberType | BigintType | BooleanType | ObjectType + | InstanceType _ | SymbolType | FunctionType ), + _ ) -> + false + (** Information used to recognize a constructor during matching. A literal identifies a constant or an object's tag; a payload shape identifies a value represented directly by its payload. *) @@ -126,7 +140,8 @@ type matching_facts = { standard [TAG] field. *) block_types: block_type list; (** Runtime shapes of constructors represented directly by their - payload. Tagged object constructors do not appear here. *) + payload, in declaration order. Tagged object constructors do not + appear here. *) literal_tags: literal_tag list; (** Runtime values of all nullary constructors. In an untagged variant these may overlap the values of a payload constructor, as in @@ -134,9 +149,6 @@ type matching_facts = { payload constructor only receives values that are not literals, and [S("a")] matches as [A]: constructor identity is not observable at runtime for such values. *) - has_null: bool; - has_undefined: bool; - has_other_literal: bool; } (** Declaration-level facts needed when lowering a constructor match. This is not an occurrence-specific matching plan: it contains no arms, actions, @@ -202,35 +214,24 @@ let compute_matching_facts ~tag_name (constructors : constructor_case array) : matching_facts = let block_types = ref [] in let literal_tags = ref [] in - let has_null = ref false in - let has_undefined = ref false in - let has_other_literal = ref false in Array.iter (function - | Constant {name; literal} -> ( + | Constant {name; literal} -> (* Without an [@as], a nullary constructor is its own name. *) let literal = match literal with | Some literal -> literal | None -> String name in - literal_tags := literal :: !literal_tags; - match literal with - | Null -> has_null := true - | Undefined -> has_undefined := true - | String _ | Int _ | Float _ | BigInt _ | Bool _ -> - has_other_literal := true) + literal_tags := literal :: !literal_tags | Block (Untagged {block_type}) -> block_types := block_type :: !block_types | Block (Tagged _) -> ()) constructors; { tag_name; - block_types = !block_types; - literal_tags = !literal_tags; - has_null = !has_null; - has_undefined = !has_undefined; - has_other_literal = !has_other_literal; + block_types = List.rev !block_types; + literal_tags = List.rev !literal_tags; } let make_layout ~(configuration : configuration) constructors = diff --git a/compiler/ml/variant_runtime.mli b/compiler/ml/variant_runtime.mli index 93cc06f12c..81a6153c94 100644 --- a/compiler/ml/variant_runtime.mli +++ b/compiler/ml/variant_runtime.mli @@ -61,6 +61,11 @@ val literal_value_key : literal_tag -> string val same_literal_value : literal_tag -> literal_tag -> bool +val literal_passes : literal_tag -> block_type -> bool +(** Whether a literal passes the check of a payload case of this kind, as + [typeof] sees it: ["a"] a string case, [null] an object case, anything an + unknown case, which is not checked *) + (** Information used to recognize a constructor during matching. A literal identifies a constant or an object's tag; a payload shape identifies a value represented directly by its payload. *) @@ -101,9 +106,6 @@ type matching_facts = { tag_name: string option; block_types: block_type list; literal_tags: literal_tag list; - has_null: bool; - has_undefined: bool; - has_other_literal: bool; } type layout diff --git a/tests/gentype_tests/typescript-react-example/src/Unboxed.res.js b/tests/gentype_tests/typescript-react-example/src/Unboxed.res.js index 96d724a1a1..b91dfe50ff 100644 --- a/tests/gentype_tests/typescript-react-example/src/Unboxed.res.js +++ b/tests/gentype_tests/typescript-react-example/src/Unboxed.res.js @@ -12,12 +12,10 @@ function r2Test(x) { function tLength(v) { if (Array.isArray(v)) { return v.length; - } - switch (typeof v) { - case "object" : - return v.x; - case "function" : - return v(0); + } else if (typeof v === "function") { + return v(0); + } else { + return v.x; } } diff --git a/tests/ounit_tests/ounit_lambda_constant_tests.ml b/tests/ounit_tests/ounit_lambda_constant_tests.ml index d1a470144f..5fa2219cc5 100644 --- a/tests/ounit_tests/ounit_lambda_constant_tests.ml +++ b/tests/ounit_tests/ounit_lambda_constant_tests.ml @@ -139,6 +139,15 @@ let switch_tests = ( Lambda.blk_record [|("x", false)|] Asttypes.Immutable, [Const_int 1l] )) "object" ); + ( "null without a null case is an object" >:: fun _ -> + let record = block "Record" ObjectType in + let text = block "Text" StringType in + let sw = + variant_switch ~constructors:[record; text] + ~cases:[(record, "record"); (text, "text")] + ~default:None + in + assert_fold sw Const_js_null "record" ); ( "empty list is zero at runtime" >:: fun _ -> let zero = literal "Zero" (Int 0) in let values = block "Values" UnknownType in diff --git a/tests/ounit_tests/ounit_string_literal_tests.ml b/tests/ounit_tests/ounit_string_literal_tests.ml index f95904db70..4839155e76 100644 --- a/tests/ounit_tests/ounit_string_literal_tests.ml +++ b/tests/ounit_tests/ounit_string_literal_tests.ml @@ -774,14 +774,10 @@ let suites = | _ -> OUnit.assert_failure "expected Array.isArray simplification to remain active"); - let open Ast_untagged_variants.Dynamic_checks in let date = Variant_runtime.Instance.Class {name = "Date"; ancestors = []} in - assert_js_global ~expected:"Date" - (Js_exp_make.emit_check - (TagType (Variant_runtime.Payload_shape (InstanceType date)))); - match Js_exp_make.emit_check (IsInstanceOf (date, Expr value)) with + match Js_exp_make.is_instance_of date value with | {expression_desc = Bin (InstanceOf, argument, constructor)} -> OUnit.assert_bool "expected the original argument" (Js_analyzer.eq_expression value argument); diff --git a/tests/tests/src/UntaggedVariants.mjs b/tests/tests/src/UntaggedVariants.mjs index df8f7b89be..3004d9e4b1 100644 --- a/tests/tests/src/UntaggedVariants.mjs +++ b/tests/tests/src/UntaggedVariants.mjs @@ -21,12 +21,10 @@ function classify2(x) { } function cls(x) { - if (typeof x !== "object") { - if (x === "One") { - return "one"; - } else { - return "two"; - } + if (x === "One") { + return "one"; + } else if (x === "Two") { + return "two"; } else { return "object" + x.y; } @@ -77,12 +75,10 @@ let Truthy = { }; function classify$1(x) { - if (x == null) { - if (x === null) { - return "null"; - } else { - return "undefined"; - } + if (x === null) { + return "null"; + } else if (x === undefined) { + return "undefined"; } else { return "object" + x.name; } @@ -93,12 +89,11 @@ let TwoObjects = { }; function classify$2(x) { - if (x === "A" || x === "B") { - if (x === "A") { - return "a"; - } else { - return "b"; - } + if (x === "A") { + return "a"; + } + if (x === "B") { + return "b"; } console.log(x); return "Unknown"; @@ -109,26 +104,24 @@ let Unknown = { }; function classify$3(x) { - if (x === "A" || x === "D" || x === "B" || x === "C") { - switch (x) { - case "A" : - return "a"; - case "B" : - return "b"; - case "C" : - return "c"; - case "D" : - return "d"; - } - } else { - switch (typeof x) { - case "string" : - return "string"; - case "number" : - return "int"; - case "object" : - return "Object" + x.name; - } + switch (x) { + case "A" : + return "a"; + case "B" : + return "b"; + case "C" : + return "c"; + case "D" : + return "d"; + default: + switch (typeof x) { + case "string" : + return "string"; + case "number" : + return "int"; + default: + return "Object" + x.name; + } } } @@ -142,7 +135,7 @@ function classify$4(x) { return "string"; case "number" : return "int"; - case "object" : + default: return "Object" + x.name; } } @@ -152,16 +145,17 @@ let OnlyBlocks = { }; function classify$5(x) { - if (Array.isArray(x)) { - return "array"; - } switch (typeof x) { case "string" : return "string"; case "number" : return "int"; - case "object" : - return "Object" + x.name; + default: + if (Array.isArray(x)) { + return "array"; + } else { + return "Object" + x.name; + } } } @@ -170,39 +164,38 @@ let WithArray = { }; function classify$6(x) { - if (x === false || x === null || x === true) { - switch (x) { - case false : - return "JSONFalse"; - case true : - return "JSONTrue"; - case null : - return "JSONNull"; - } - } else { - if (Array.isArray(x)) { - return { - TAG: "JSONArray", - _0: x - }; - } - switch (typeof x) { - case "string" : - return { - TAG: "JSONString", - _0: x - }; - case "number" : - return { - TAG: "JSONNumber", - _0: x - }; - case "object" : - return { - TAG: "JSONObject", - _0: x - }; - } + switch (x) { + case false : + return "JSONFalse"; + case true : + return "JSONTrue"; + case null : + return "JSONNull"; + default: + switch (typeof x) { + case "string" : + return { + TAG: "JSONString", + _0: x + }; + case "number" : + return { + TAG: "JSONNumber", + _0: x + }; + default: + if (Array.isArray(x)) { + return { + TAG: "JSONArray", + _0: x + }; + } else { + return { + TAG: "JSONObject", + _0: x + }; + } + } } } @@ -231,9 +224,6 @@ let TrickyNested = { }; function checkEnum(e) { - if (e !== "One" && e !== "Three" && e !== "Two") { - return "Something else..." + e; - } switch (e) { case "One" : return "One!"; @@ -241,6 +231,8 @@ function checkEnum(e) { return "Two"; case "Three" : return "Threeeee"; + default: + return "Something else..." + e; } } @@ -249,9 +241,6 @@ let OverlapString = { }; function checkEnum$1(e) { - if (e !== 1.0 && e !== "Three" && e !== "Two") { - return "Something else..."; - } switch (e) { case 1.0 : return "One!"; @@ -259,6 +248,8 @@ function checkEnum$1(e) { return "Two"; case "Three" : return "Threeeee"; + default: + return "Something else..."; } } @@ -267,9 +258,6 @@ let OverlapNumber = { }; function checkEnum$2(e) { - if (e !== null && typeof e === "object") { - return "Object..."; - } switch (e) { case null : return "One!"; @@ -277,6 +265,8 @@ function checkEnum$2(e) { return "Two"; case "Three" : return "Threeeee"; + default: + return "Object..."; } } @@ -297,10 +287,10 @@ let RecordIsObject = { }; function classify$8(v) { - if (typeof v === "object" && !Array.isArray(v)) { - return v.x; - } else { + if (Array.isArray(v)) { return v[0]; + } else { + return v.x; } } @@ -354,12 +344,10 @@ let OptionUnboxingHeuristic = { function classify$9(v) { if (Array.isArray(v)) { return v[0]; - } - switch (typeof v) { - case "object" : - return v.x; - case "function" : - return v(3); + } else if (typeof v === "function") { + return v(3); + } else { + return v.x; } } @@ -383,27 +371,23 @@ function check$1(s) { let match = s[0]; if (match === true) { let match$1 = s[1]; - if (match$1 === undefined || match$1 === null || match$1 === false || match$1 === true) { - if (match$1 === false) { - let match$2 = s[2]; - if (Array.isArray(match$2)) { - if (match$2.length !== 2) { - console.log("Nope..."); - return; - } - let match$3 = match$2[0]; - if (typeof match$3 === "string") { - if (match$3 === "My name is") { - let match$4 = match$2[1]; - if (typeof match$4 === "number") { - if (match$4 !== 10) { - console.log("Nope..."); - } else { - console.log("yup"); - } - return; + if (match$1 === false) { + let match$2 = s[2]; + if (Array.isArray(match$2)) { + if (match$2.length !== 2) { + console.log("Nope..."); + return; + } + let match$3 = match$2[0]; + if (typeof match$3 === "string") { + if (match$3 === "My name is") { + let match$4 = match$2[1]; + if (typeof match$4 === "number") { + if (match$4 !== 10) { + console.log("Nope..."); + } else { + console.log("yup"); } - console.log("Nope..."); return; } console.log("Nope..."); @@ -417,18 +401,14 @@ function check$1(s) { } console.log("Nope..."); return; - } else { - console.log("Nope..."); - return; } - } else { console.log("Nope..."); return; } - } else { console.log("Nope..."); return; } + console.log("Nope..."); } let ComplexPattern = { @@ -437,26 +417,21 @@ let ComplexPattern = { }; async function getUserName(u) { - if (u instanceof Promise) { + if (typeof u === "string") { + return u; + } else if (u instanceof Promise) { return (await u).name; - } - switch (typeof u) { - case "object" : - return u.name; - case "string" : - return u; + } else { + return u.name; } } async function awaitUser(u) { - if (u instanceof Promise) { + if (typeof u === "string" || !(u instanceof Promise)) { + return "dummy"; + } else { return (await u).name; } - switch (typeof u) { - case "object" : - case "string" : - return "dummy"; - } } let PromiseSync = { @@ -465,31 +440,27 @@ let PromiseSync = { }; async function classify$10(a) { - if (a === "test" || a === 12) { - if (a === "test") { - console.log("testing"); - return; - } + if (a === "test") { + console.log("testing"); + return; + } + if (a === 12) { console.log(12); return; - } else { - if (Array.isArray(a)) { - console.log(a.join("-")); - return; - } - if (a instanceof Promise) { - console.log(await a); - return; - } - switch (typeof a) { - case "string" : - console.log(a); - return; - case "object" : - console.log(a.userName); - return; - } } + if (typeof a === "string") { + console.log(a); + return; + } + if (Array.isArray(a)) { + console.log(a.join("-")); + return; + } + if (a instanceof Promise) { + console.log(await a); + return; + } + console.log(a.userName); } let Arr = { @@ -497,6 +468,10 @@ let Arr = { }; async function classifyAll(t) { + if (typeof t === "string") { + console.log(t); + return; + } if (Array.isArray(t)) { console.log(t.join("-")); return; @@ -517,7 +492,7 @@ async function classifyAll(t) { console.log(t.name); return; } - if (t instanceof Blob && !(t instanceof File)) { + if (t instanceof Blob) { console.log(t.size); return; } @@ -589,14 +564,7 @@ async function classifyAll(t) { console.log("WeakMap"); return; } - switch (typeof t) { - case "string" : - console.log(t); - return; - case "object" : - console.log(t.userName); - return; - } + console.log(t.userName); } let AllInstanceofTypes = { @@ -604,13 +572,12 @@ let AllInstanceofTypes = { }; function test(t) { - switch (typeof t) { - case "object" : - return t["Hello"]; - case "string" : - return t; - case "function" : - return t(); + if (typeof t === "string") { + return t; + } else if (typeof t === "function") { + return t(); + } else { + return t["Hello"]; } } @@ -631,17 +598,11 @@ function shareEquivalentStringActions(x) { } function can_merge(x) { - if (Array.isArray(x)) { - return "do not merge"; - } - if (x instanceof Date) { + if (typeof x === "boolean" || !(Array.isArray(x) || x instanceof Date)) { + return "merge"; + } else { return "do not merge"; } - switch (typeof x) { - case "boolean" : - case "object" : - return "merge"; - } } function shareAlphaEquivalentStringActions(value) { @@ -665,6 +626,9 @@ function shareAlphaEquivalentStringActions(value) { } function preserveDiscriminatorGroups(x) { + if (typeof x === "boolean") { + return; + } if (Array.isArray(x)) { while (keepGoing()) { sideEffect(); @@ -677,15 +641,9 @@ function preserveDiscriminatorGroups(x) { }; return; } - switch (typeof x) { - case "boolean" : - return; - case "object" : - while (keepGoing()) { - sideEffect(); - }; - return; - } + while (keepGoing()) { + sideEffect(); + }; } let MergeCases = { diff --git a/tests/tests/src/pm_opt_fields_mixed_test.mjs b/tests/tests/src/pm_opt_fields_mixed_test.mjs index 05b2bfb58d..7635a10af3 100644 --- a/tests/tests/src/pm_opt_fields_mixed_test.mjs +++ b/tests/tests/src/pm_opt_fields_mixed_test.mjs @@ -136,12 +136,8 @@ function withU(v) { function stringOrOther(r) { let s = r.u; if (s !== undefined) { - if (s == null) { - if (s === undefined) { - return "other"; - } else { - return "null"; - } + if (s === null) { + return "null"; } else if (typeof s === "string") { return s; } else { @@ -158,13 +154,9 @@ function objectOrOther(r) { return "other"; } let tmp = Primitive_option.valFromOption(match); - if (tmp == null) { - if (tmp === undefined) { - return "undefined"; - } else { - return "other"; - } - } else if (typeof tmp === "string") { + if (tmp === undefined) { + return "undefined"; + } else if (tmp === null || typeof tmp === "string") { return "other"; } else { return "object"; diff --git a/tests/tests/src/unboxed_variant_fold_test.mjs b/tests/tests/src/unboxed_variant_fold_test.mjs index 2e1a13ff3c..686732a8af 100644 --- a/tests/tests/src/unboxed_variant_fold_test.mjs +++ b/tests/tests/src/unboxed_variant_fold_test.mjs @@ -28,12 +28,10 @@ function pureName(v) { } function optName(v) { - if (v == null) { - if (v === null) { - return "null"; - } else { - return "undef"; - } + if (v === null) { + return "null"; + } else if (v === undefined) { + return "undef"; } else { return "obj"; } @@ -58,12 +56,10 @@ function answerName(v) { } function mixedName(v) { - if (v === false || v === null) { - if (v === false) { - return "off"; - } else { - return "unset"; - } + if (v === false) { + return "off"; + } else if (v === null) { + return "unset"; } else if (typeof v === "boolean") { if (v) { return "toggle true"; @@ -148,12 +144,10 @@ function wideName(value) { } function numberOrBigintName(value) { - if (typeof value !== "string") { - if (value === 1) { - return "number"; - } else { - return "bigint"; - } + if (value === 1) { + return "number"; + } else if (value === 1n) { + return "bigint"; } else { return value; } diff --git a/tests/tests/src/untagged_builtin_alias_test.mjs b/tests/tests/src/untagged_builtin_alias_test.mjs index fbaf95ceb5..8346c5a56a 100644 --- a/tests/tests/src/untagged_builtin_alias_test.mjs +++ b/tests/tests/src/untagged_builtin_alias_test.mjs @@ -4,14 +4,12 @@ import * as Mocha from "mocha"; import * as Test_utils from "./test_utils.mjs"; function kind(value) { - if (Array.isArray(value)) { + if (typeof value === "string") { + return value; + } else if (Array.isArray(value)) { return "pair"; - } - switch (typeof value) { - case "object" : - return "entries"; - case "string" : - return value; + } else { + return "entries"; } } diff --git a/tests/tests/src/untagged_default_arm_test.mjs b/tests/tests/src/untagged_default_arm_test.mjs index 49ddffd59e..018df97174 100644 --- a/tests/tests/src/untagged_default_arm_test.mjs +++ b/tests/tests/src/untagged_default_arm_test.mjs @@ -3,55 +3,134 @@ import * as Mocha from "mocha"; import * as Test_utils from "./test_utils.mjs"; +globalThis.UntaggedAnyValue = class AnyValue { + static [Symbol.hasInstance]() { return true } +} +; + function id(x) { return x; } function objectOrString(value) { - if (value instanceof RegExp || value instanceof Date) { + if (typeof value === "string") { + return "S"; + } else if (typeof value === "object" && !(value instanceof RegExp) && !(value instanceof Date)) { + return "O"; + } else { return "other"; } - switch (typeof value) { - case "object" : - return "O"; - case "string" : - return "S"; - default: - return "other"; - } } function textOrRecord(value) { if (value === "lit") { return "other"; + } else if (typeof value === "string") { + return "text"; + } else if (typeof value === "object") { + return "record"; + } else { + return "other"; } - switch (typeof value) { - case "string" : - return "text"; - case "object" : - return "record"; +} + +function twoArmsKind(value) { + if (typeof value === "string") { + return "name"; + } else { + return "any"; + } +} + +function withLiteralsKind(value) { + switch (value) { + case 1 : + return "one"; + case 2 : + return "two"; + case 3 : + return "three"; + case 4 : + return "four"; + case 5 : + return "five"; default: + if (typeof value === "string") { + return "name"; + } else { + return "any"; + } + } +} + +function pair(a, b) { + let exit = 0; + if (typeof a === "string") { + if (typeof b === "object" && b !== null && !Array.isArray(b)) { + return "string, object"; + } else { return "other"; + } + } + exit = 2; + if (exit === 2 && typeof b === "object" && b !== null && !Array.isArray(b)) { + return "any, object"; + } + if (typeof a === "number") { + return "number, any"; + } else { + return "other"; + } +} + +let logged = []; + +function logString(value) { + if (typeof value === "string") { + logged.push("string"); } + logged.push("done"); } Mocha.describe("Untagged_default_arm_test", () => { + Mocha.test("an empty arm keeps the checks before it", () => { + logString(id({ + x: 1 + })); + logString(id("a")); + Test_utils.eq("File \"untagged_default_arm_test.res\", line 95, characters 7-14", [ + "done", + "string", + "done" + ], logged); + }); Mocha.test("an instance handled by the default is not an object case", () => { - Test_utils.eq("File \"untagged_default_arm_test.res\", line 31, characters 7-14", "other", objectOrString(id(new Date()))); - Test_utils.eq("File \"untagged_default_arm_test.res\", line 32, characters 7-14", "other", objectOrString(id(/a/))); - Test_utils.eq("File \"untagged_default_arm_test.res\", line 33, characters 7-14", "O", objectOrString(id({ + Test_utils.eq("File \"untagged_default_arm_test.res\", line 99, characters 7-14", "other", objectOrString(id(new Date()))); + Test_utils.eq("File \"untagged_default_arm_test.res\", line 100, characters 7-14", "other", objectOrString(id(/a/))); + Test_utils.eq("File \"untagged_default_arm_test.res\", line 101, characters 7-14", "O", objectOrString(id({ x: 1 }))); - Test_utils.eq("File \"untagged_default_arm_test.res\", line 34, characters 7-14", "S", objectOrString(id("s"))); - Test_utils.eq("File \"untagged_default_arm_test.res\", line 35, characters 7-14", "other", objectOrString(id(1))); + Test_utils.eq("File \"untagged_default_arm_test.res\", line 102, characters 7-14", "S", objectOrString(id("s"))); + Test_utils.eq("File \"untagged_default_arm_test.res\", line 103, characters 7-14", "other", objectOrString(id(1))); }); Mocha.test("a literal handled by the default is not a string case", () => { - Test_utils.eq("File \"untagged_default_arm_test.res\", line 39, characters 7-14", "other", textOrRecord(id("lit"))); - Test_utils.eq("File \"untagged_default_arm_test.res\", line 40, characters 7-14", "text", textOrRecord(id("lit2"))); - Test_utils.eq("File \"untagged_default_arm_test.res\", line 41, characters 7-14", "record", textOrRecord(id({ + Test_utils.eq("File \"untagged_default_arm_test.res\", line 107, characters 7-14", "other", textOrRecord(id("lit"))); + Test_utils.eq("File \"untagged_default_arm_test.res\", line 108, characters 7-14", "text", textOrRecord(id("lit2"))); + Test_utils.eq("File \"untagged_default_arm_test.res\", line 109, characters 7-14", "record", textOrRecord(id({ x: 1 }))); - Test_utils.eq("File \"untagged_default_arm_test.res\", line 42, characters 7-14", "other", textOrRecord(id(1))); + Test_utils.eq("File \"untagged_default_arm_test.res\", line 110, characters 7-14", "other", textOrRecord(id(1))); + }); + Mocha.test("primitives skip class checks in the two-arm form", () => Test_utils.eq("File \"untagged_default_arm_test.res\", line 114, characters 7-14", "name", twoArmsKind(id("a")))); + Mocha.test("a value no arm of an incomplete match takes falls through", () => { + Test_utils.eq("File \"untagged_default_arm_test.res\", line 118, characters 7-14", "number, any", pair(id(1), id([]))); + Test_utils.eq("File \"untagged_default_arm_test.res\", line 119, characters 7-14", "number, any", pair(id(1), id(null))); + Test_utils.eq("File \"untagged_default_arm_test.res\", line 120, characters 7-14", "any, object", pair(id(1), id({}))); + Test_utils.eq("File \"untagged_default_arm_test.res\", line 121, characters 7-14", "other", pair(id("a"), id([]))); + }); + Mocha.test("literals skip class checks", () => { + Test_utils.eq("File \"untagged_default_arm_test.res\", line 125, characters 7-14", "one", withLiteralsKind(id(1))); + Test_utils.eq("File \"untagged_default_arm_test.res\", line 126, characters 7-14", "name", withLiteralsKind(id("a"))); }); }); @@ -59,5 +138,10 @@ export { id, objectOrString, textOrRecord, + twoArmsKind, + withLiteralsKind, + pair, + logged, + logString, } /* Not a pure module */ diff --git a/tests/tests/src/untagged_default_arm_test.res b/tests/tests/src/untagged_default_arm_test.res index dce3172e6a..811f2aa95a 100644 --- a/tests/tests/src/untagged_default_arm_test.res +++ b/tests/tests/src/untagged_default_arm_test.res @@ -1,6 +1,12 @@ open Mocha open Test_utils +%%raw(` +globalThis.UntaggedAnyValue = class AnyValue { + static [Symbol.hasInstance]() { return true } +} +`) + @inline(never) let id = x => x // A switch with a default arm keeps the cases it does not name out of the @@ -26,7 +32,69 @@ let textOrRecord = value => | _ => "other" } +// A class whose Symbol.hasInstance accepts every value does not take +// primitives in the two-arm form or in the literal test +@instanceOf("UntaggedAnyValue") type anyValue + +@unboxed +type twoArms = Any(anyValue) | Name(string) + +let twoArmsKind = value => + switch value { + | Any(_) => "any" + | Name(_) => "name" + } + +@unboxed +type withLiterals = + | @as(1) One + | @as(2) Two + | @as(3) Three + | @as(4) Four + | @as(5) Five + | AnyLit(anyValue) + | NameLit(string) + +let withLiteralsKind = value => + switch value { + | One => "one" + | Two => "two" + | Three => "three" + | Four => "four" + | Five => "five" + | AnyLit(_) => "any" + | NameLit(_) => "name" + } + +// The match on [b] is not complete: a value no arm takes falls through to the +// later arms +let pair = (a: JSON.t, b: JSON.t) => + switch (a, b) { + | (String(_), Object(_)) => "string, object" + | (_, Object(_)) => "any, object" + | (Number(_), _) => "number, any" + | _ => "other" + } + +// An arm that does nothing is still an arm: the string check stays +@unboxed type stringOrRecord = LogStr(string) | LogRec({x: int}) + +let logged = [] +let logString = value => { + switch value { + | LogStr(_) => logged->Array.push("string") + | LogRec(_) => () + } + logged->Array.push("done") +} + describe(__MODULE__, () => { + test("an empty arm keeps the checks before it", () => { + logString(id(LogRec({x: 1}))) + logString(id(LogStr("a"))) + eq(__LOC__, ["done", "string", "done"], logged) + }) + test("an instance handled by the default is not an object case", () => { eq(__LOC__, "other", objectOrString(id(D(Date.make())))) eq(__LOC__, "other", objectOrString(id(R(/a/)))) @@ -41,4 +109,20 @@ describe(__MODULE__, () => { eq(__LOC__, "record", textOrRecord(id(Rec({x: 1})))) eq(__LOC__, "other", textOrRecord(id(Count(1)))) }) + + test("primitives skip class checks in the two-arm form", () => { + eq(__LOC__, "name", twoArmsKind(id(Name("a")))) + }) + + test("a value no arm of an incomplete match takes falls through", () => { + eq(__LOC__, "number, any", pair(id(JSON.Number(1.)), id(JSON.Array([])))) + eq(__LOC__, "number, any", pair(id(JSON.Number(1.)), id(JSON.Null))) + eq(__LOC__, "any, object", pair(id(JSON.Number(1.)), id(JSON.Object(dict{})))) + eq(__LOC__, "other", pair(id(JSON.String("a")), id(JSON.Array([])))) + }) + + test("literals skip class checks", () => { + eq(__LOC__, "one", withLiteralsKind(id(One))) + eq(__LOC__, "name", withLiteralsKind(id(NameLit("a")))) + }) }) diff --git a/tests/tests/src/untagged_file_blob_test.mjs b/tests/tests/src/untagged_file_blob_test.mjs index 6fb2f5a1c5..6b9b7206ff 100644 --- a/tests/tests/src/untagged_file_blob_test.mjs +++ b/tests/tests/src/untagged_file_blob_test.mjs @@ -4,18 +4,18 @@ import * as Mocha from "mocha"; import * as Test_utils from "./test_utils.mjs"; function kind(upload) { - if (upload instanceof Blob && !(upload instanceof File)) { - return "blob"; - } else { + if (upload instanceof File) { return "file"; + } else { + return "blob"; } } function onlyBlob(upload) { - if (upload instanceof Blob && !(upload instanceof File)) { - return "blob"; - } else { + if (upload instanceof File) { return "other"; + } else { + return "blob"; } } diff --git a/tests/tests/src/untagged_loop_control_test.mjs b/tests/tests/src/untagged_loop_control_test.mjs new file mode 100644 index 0000000000..42ea62f619 --- /dev/null +++ b/tests/tests/src/untagged_loop_control_test.mjs @@ -0,0 +1,186 @@ +// Generated by ReScript, PLEASE EDIT WITH CARE + +import * as Mocha from "mocha"; +import * as Test_utils from "./test_utils.mjs"; + +function scan(values) { + let seen = []; + loop_0: for (let i = 0, i_finish = values.length; i < i_finish; ++i) { + let text = values[i]; + if (text === "stop") { + break; + } + if (text === "skip") { + continue; + } + switch (typeof text) { + case "string" : + switch (text) { + case "break" : + break loop_0; + case "continue" : + continue loop_0; + default: + seen.push(text); + } + break; + case "number" : + if (text < 0) { + break loop_0; + } + seen.push("count"); + break; + default: + if (text instanceof Date) { + continue loop_0; + } + break loop_0; + } + seen.push("."); + } + return seen; +} + +function scanDefault(values) { + let seen = []; + let i = 0; + loop_0: while (i < values.length) { + let value = values[i]; + i = i + 1 | 0; + if (value === "stop") { + break; + } + if (value === "skip") { + continue; + } + switch (typeof value) { + case "string" : + seen.push(value); + break; + case "number" : + continue loop_0; + default: + if (value instanceof Date) { + seen.push("date"); + } else { + continue loop_0; + } + } + seen.push("."); + }; + return seen; +} + +function scanDefaultBreak(values) { + let seen = []; + loop_0: for (let i = 0, i_finish = values.length; i < i_finish; ++i) { + let text = values[i]; + if (text === "stop" || text === "skip") { + break; + } + switch (typeof text) { + case "string" : + seen.push(text); + break; + case "number" : + break loop_0; + default: + if (text instanceof Date) { + seen.push("date"); + } else { + break loop_0; + } + } + } + return seen; +} + +Mocha.describe("Untagged_loop_control_test", () => { + Mocha.test("a literal arm", () => Test_utils.eq("File \"untagged_loop_control_test.res\", line 68, characters 7-14", scan([ + "a", + "skip", + "b", + "stop", + "c" + ]), [ + "a", + ".", + "b", + "." + ])); + Mocha.test("a primitive arm", () => { + Test_utils.eq("File \"untagged_loop_control_test.res\", line 73, characters 6-13", scan([ + "a", + "continue", + 1, + "break", + "c" + ]), [ + "a", + ".", + "count", + "." + ]); + Test_utils.eq("File \"untagged_loop_control_test.res\", line 77, characters 7-14", scan([ + 1, + -1, + "c" + ]), [ + "count", + "." + ]); + }); + Mocha.test("a class and an object arm", () => Test_utils.eq("File \"untagged_loop_control_test.res\", line 81, characters 7-14", scan([ + new Date(), + "a", + { + x: 1 + }, + "c" + ]), [ + "a", + "." + ])); + Mocha.test("a default arm", () => { + Test_utils.eq("File \"untagged_loop_control_test.res\", line 86, characters 6-13", scanDefault([ + 1, + "a", + "skip", + { + x: 1 + }, + new Date(), + "stop", + "c" + ]), [ + "a", + ".", + "date", + "." + ]); + Test_utils.eq("File \"untagged_loop_control_test.res\", line 90, characters 7-14", scanDefaultBreak([ + "a", + 1, + "c" + ]), ["a"]); + Test_utils.eq("File \"untagged_loop_control_test.res\", line 91, characters 7-14", scanDefaultBreak([ + "a", + { + x: 1 + }, + "c" + ]), ["a"]); + Test_utils.eq("File \"untagged_loop_control_test.res\", line 92, characters 7-14", scanDefaultBreak([ + new Date(), + "skip", + "c" + ]), ["date"]); + }); +}); + +export { + scan, + scanDefault, + scanDefaultBreak, +} +/* Not a pure module */ diff --git a/tests/tests/src/untagged_loop_control_test.res b/tests/tests/src/untagged_loop_control_test.res new file mode 100644 index 0000000000..ac373e2b28 --- /dev/null +++ b/tests/tests/src/untagged_loop_control_test.res @@ -0,0 +1,94 @@ +open Mocha +open Test_utils + +// break and continue in the arms of an untagged variant switch leave or +// continue the loop, not the generated switch + +@unboxed +type value = + | @as("stop") Stop + | @as("skip") Skip + | Date(Date.t) + | Text(string) + | Count(float) + | Object({x: int}) + +let scan = (values: array) => { + let seen = [] + for i in 0 to Array.length(values) - 1 { + switch values->Array.getUnsafe(i) { + | Stop => break + | Skip => continue + | Text("break") => break + | Text("continue") => continue + | Text(text) => seen->Array.push(text) + | Count(n) if n < 0. => break + | Count(_) => seen->Array.push("count") + | Date(_) => continue + | Object(_) => break + } + seen->Array.push(".") + } + seen +} + +// Some cases go to the default, which lands both in the typeof switch and +// in the class chain +let scanDefault = (values: array) => { + let seen = [] + let i = ref(0) + while i.contents < Array.length(values) { + let value = values->Array.getUnsafe(i.contents) + i := i.contents + 1 + switch value { + | Stop => break + | Text(text) => seen->Array.push(text) + | Date(_) => seen->Array.push("date") + | _ => continue + } + seen->Array.push(".") + } + seen +} + +let scanDefaultBreak = (values: array) => { + let seen = [] + for i in 0 to Array.length(values) - 1 { + switch values->Array.getUnsafe(i) { + | Text(text) => seen->Array.push(text) + | Date(_) => seen->Array.push("date") + | _ => break + } + } + seen +} + +describe(__MODULE__, () => { + test("a literal arm", () => { + eq(__LOC__, scan([Text("a"), Skip, Text("b"), Stop, Text("c")]), ["a", ".", "b", "."]) + }) + + test("a primitive arm", () => { + eq( + __LOC__, + scan([Text("a"), Text("continue"), Count(1.), Text("break"), Text("c")]), + ["a", ".", "count", "."], + ) + eq(__LOC__, scan([Count(1.), Count(-1.), Text("c")]), ["count", "."]) + }) + + test("a class and an object arm", () => { + eq(__LOC__, scan([Date(Date.make()), Text("a"), Object({x: 1}), Text("c")]), ["a", "."]) + }) + + test("a default arm", () => { + eq( + __LOC__, + scanDefault([Count(1.), Text("a"), Skip, Object({x: 1}), Date(Date.make()), Stop, Text("c")]), + ["a", ".", "date", "."], + ) + eq(__LOC__, scanDefaultBreak([Text("a"), Count(1.), Text("c")]), ["a"]) + eq(__LOC__, scanDefaultBreak([Text("a"), Object({x: 1}), Text("c")]), ["a"]) + eq(__LOC__, scanDefaultBreak([Date(Date.make()), Skip, Text("c")]), ["date"]) + }) +}) diff --git a/tests/tests/src/untagged_runtime_annotations_shadow_test.mjs b/tests/tests/src/untagged_runtime_annotations_shadow_test.mjs index ce74261c11..4dcca29bca 100644 --- a/tests/tests/src/untagged_runtime_annotations_shadow_test.mjs +++ b/tests/tests/src/untagged_runtime_annotations_shadow_test.mjs @@ -20,16 +20,13 @@ let UntaggedNs = { }; function kind(value) { - if (value instanceof globalThis.UntaggedShadowed) { + if (typeof value === "string") { + return value; + } else if (value instanceof globalThis.UntaggedShadowed) { return "shadowed"; - } - if (value instanceof globalThis.UntaggedNs.Klass) { + } else { return "klass"; } - switch (typeof value) { - case "string" : - return value; - } } Mocha.describe("Untagged_runtime_annotations_shadow_test", () => { diff --git a/tests/tests/src/untagged_runtime_annotations_test.mjs b/tests/tests/src/untagged_runtime_annotations_test.mjs index 1e22475ae7..9e80734b94 100644 --- a/tests/tests/src/untagged_runtime_annotations_test.mjs +++ b/tests/tests/src/untagged_runtime_annotations_test.mjs @@ -11,28 +11,20 @@ globalThis.UntaggedCallable = class Callable extends Function {} ; function describePet(pet) { - if (pet instanceof UntaggedAnimal && !(pet instanceof UntaggedDog)) { - return "animal"; - } - if (pet instanceof UntaggedDog) { + if (typeof pet === "string") { + return pet; + } else if (pet instanceof UntaggedDog) { return "dog"; - } - switch (typeof pet) { - case "string" : - return pet; + } else { + return "animal"; } } function onlyAnimal(pet) { - if (pet instanceof UntaggedAnimal && !(pet instanceof UntaggedDog)) { - return "animal"; - } - if (pet instanceof UntaggedDog) { + if (typeof pet === "string" || pet instanceof UntaggedDog) { return "other"; - } - switch (typeof pet) { - case "string" : - return "other"; + } else { + return "animal"; } } @@ -47,10 +39,10 @@ function describeReversed(pet) { let Zoo = {}; function describeAliased(pet) { - if (pet instanceof UntaggedAnimal && !(pet instanceof UntaggedDog)) { - return "animal"; - } else { + if (pet instanceof UntaggedDog) { return "dog"; + } else { + return "animal"; } } @@ -71,106 +63,159 @@ function referenceKind(reference) { } function localeKind(locale) { - if (locale instanceof Intl.Locale) { - return "locale"; - } else { + if (typeof locale === "string") { return locale; + } else { + return "locale"; } } function describePhantom(pet) { - if (pet instanceof UntaggedAnimal && !(pet instanceof UntaggedDog)) { - return "animal"; - } else { + if (pet instanceof UntaggedDog) { return "dog"; + } else { + return "animal"; } } function handlerKind(handler) { - if (typeof handler === "function" && !(handler instanceof UntaggedCallable)) { - return "function"; - } else { + if (handler instanceof UntaggedCallable) { return "callable"; + } else { + return "function"; } } function wideHandlerKind(handler) { - if (handler instanceof UntaggedAnimal || handler instanceof UntaggedCallable) { + if (typeof handler === "string") { + return "name"; + } else if (typeof handler === "function" && !(handler instanceof UntaggedAnimal) && !(handler instanceof UntaggedCallable)) { + return "function"; + } else { return "other"; } - switch (typeof handler) { - case "function" : - return "function"; +} + +function objectOrNameKind(value) { + if (typeof value === "string") { + return value; + } else { + return "dog"; + } +} + +function id(x) { + return x; +} + +function missingKind(value) { + switch (typeof value) { case "string" : - return "name"; + return value; + case "number" : + return "count"; default: + return "missing"; + } +} + +function missingOrDefault(value) { + switch (typeof value) { + case "string" : + return value; + case "number" : return "other"; + default: + return "missing"; } } -function objectOrNameKind(value) { - if (value instanceof UntaggedDog) { - return "dog"; - } else { - return value; +function sharedKind(value) { + let kind; + switch (typeof value) { + case "string" : + kind = "text"; + break; + case "number" : + kind = "other"; + break; + default: + kind = value instanceof Date ? "date" : "other"; } + return kind + "!"; } Mocha.describe("Untagged_runtime_annotations_test", () => { Mocha.test("a subclass case is not taken for its superclass", () => { - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 165, characters 7-14", "animal", describePet(new UntaggedAnimal())); - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 166, characters 7-14", "dog", describePet(new UntaggedDog())); - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 167, characters 7-14", "rex", "rex"); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 199, characters 7-14", "animal", describePet(new UntaggedAnimal())); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 200, characters 7-14", "dog", describePet(new UntaggedDog())); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 201, characters 7-14", "rex", "rex"); }); Mocha.test("a superclass case alone excludes the subclass", () => { - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 171, characters 7-14", "animal", onlyAnimal(new UntaggedAnimal())); - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 172, characters 7-14", "other", onlyAnimal(new UntaggedDog())); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 205, characters 7-14", "animal", onlyAnimal(new UntaggedAnimal())); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 206, characters 7-14", "other", onlyAnimal(new UntaggedDog())); }); Mocha.test("declaration order does not matter", () => { - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 176, characters 7-14", "dog", describeReversed(new UntaggedDog())); - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 177, characters 7-14", "animal", describeReversed(new UntaggedAnimal())); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 210, characters 7-14", "dog", describeReversed(new UntaggedDog())); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 211, characters 7-14", "animal", describeReversed(new UntaggedAnimal())); }); Mocha.test("a subclass upcasts to its superclass", () => { let animal = new UntaggedDog(); - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 182, characters 7-14", "dog", describePet(animal)); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 216, characters 7-14", "dog", describePet(animal)); }); Mocha.test("classes reached through a module alias", () => { - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 186, characters 7-14", "animal", describeAliased(new UntaggedAnimal())); - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 187, characters 7-14", "dog", describeAliased(new UntaggedDog())); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 220, characters 7-14", "animal", describeAliased(new UntaggedAnimal())); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 221, characters 7-14", "dog", describeAliased(new UntaggedDog())); }); Mocha.test("typeOf symbol", () => { - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 191, characters 7-14", "symbol", keyKind(Symbol.for("key"))); - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 192, characters 7-14", "text", "text"); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 225, characters 7-14", "symbol", keyKind(Symbol.for("key"))); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 226, characters 7-14", "text", "text"); }); Mocha.test("typeOf string", () => { - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 196, characters 7-14", "id", "id"); - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 197, characters 7-14", "index", "index"); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 230, characters 7-14", "id", "id"); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 231, characters 7-14", "index", "index"); }); Mocha.test("a class at a dotted path", () => { - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 201, characters 7-14", "locale", localeKind(new Intl.Locale("en"))); - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 202, characters 7-14", "de", "de"); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 235, characters 7-14", "locale", localeKind(new Intl.Locale("en"))); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 236, characters 7-14", "de", "de"); }); Mocha.test("an annotated type is not wrapped in an option", () => { let animal = new UntaggedAnimal(); - Test_utils.ok("File \"untagged_runtime_annotations_test.res\", line 207, characters 7-14", animal === animal); - Test_utils.ok("File \"untagged_runtime_annotations_test.res\", line 208, characters 7-14", animal === animal); + Test_utils.ok("File \"untagged_runtime_annotations_test.res\", line 241, characters 7-14", animal === animal); + Test_utils.ok("File \"untagged_runtime_annotations_test.res\", line 242, characters 7-14", animal === animal); }); Mocha.test("a phantom type hierarchy", () => { - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 212, characters 7-14", "animal", describePhantom(new UntaggedAnimal())); - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 213, characters 7-14", "dog", describePhantom(new UntaggedDog())); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 246, characters 7-14", "animal", describePhantom(new UntaggedAnimal())); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 247, characters 7-14", "dog", describePhantom(new UntaggedDog())); }); Mocha.test("a function case excludes class instances", () => { - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 217, characters 7-14", "callable", handlerKind(new UntaggedCallable())); - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 218, characters 7-14", "function", handlerKind(x => x)); - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 219, characters 7-14", "other", wideHandlerKind(new UntaggedCallable())); - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 220, characters 7-14", "other", wideHandlerKind(new UntaggedAnimal())); - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 221, characters 7-14", "function", wideHandlerKind(x => x)); - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 222, characters 7-14", "name", "name"); - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 223, characters 7-14", "other", "other"); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 251, characters 7-14", "callable", handlerKind(new UntaggedCallable())); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 252, characters 7-14", "function", handlerKind(x => x)); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 253, characters 7-14", "other", wideHandlerKind(new UntaggedCallable())); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 254, characters 7-14", "other", wideHandlerKind(new UntaggedAnimal())); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 255, characters 7-14", "function", wideHandlerKind(x => x)); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 256, characters 7-14", "name", "name"); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 257, characters 7-14", "other", "other"); }); Mocha.test("a class declared over an object type", () => { - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 227, characters 7-14", "dog", objectOrNameKind(new UntaggedDog())); - Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 228, characters 7-14", "rex", "rex"); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 261, characters 7-14", "dog", objectOrNameKind(new UntaggedDog())); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 262, characters 7-14", "rex", "rex"); + }); + Mocha.test("primitive cases are tested before class checks", () => { + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 266, characters 7-14", "a", missingKind(id("a"))); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 267, characters 7-14", "count", missingKind(id(1))); + }); + Mocha.test("a primitive without an arm skips class checks", () => { + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 271, characters 7-14", "a", missingOrDefault(id("a"))); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 272, characters 7-14", "other", missingOrDefault(id(1))); + }); + Mocha.test("a default shared by a primitive and an object case", () => { + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 276, characters 7-14", "date!", sharedKind(id(new Date()))); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 277, characters 7-14", "other!", sharedKind(id({ + x: 1 + }))); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 278, characters 7-14", "text!", sharedKind(id("a"))); + Test_utils.eq("File \"untagged_runtime_annotations_test.res\", line 279, characters 7-14", "other!", sharedKind(id(1))); }); }); @@ -190,5 +235,9 @@ export { handlerKind, wideHandlerKind, objectOrNameKind, + id, + missingKind, + missingOrDefault, + sharedKind, } /* Not a pure module */ diff --git a/tests/tests/src/untagged_runtime_annotations_test.res b/tests/tests/src/untagged_runtime_annotations_test.res index 90d2645d80..062bf85fca 100644 --- a/tests/tests/src/untagged_runtime_annotations_test.res +++ b/tests/tests/src/untagged_runtime_annotations_test.res @@ -160,6 +160,40 @@ let objectOrNameKind = value => | ObjectName(name) => name } +@inline(never) let id = x => x + +// No class of this name exists at run time +@instanceOf("UntaggedMissingClass") type missing + +@unboxed +type withMissing = Missing(missing) | Text(string) | Count(float) + +let missingKind = value => + switch value { + | Missing(_) => "missing" + | Text(text) => text + | Count(_) => "count" + } + +@unboxed +type shared = SharedDate(Date.t) | SharedObject({x: int}) | SharedText(string) | SharedCount(float) + +let missingOrDefault = value => + switch value { + | Missing(_) => "missing" + | Text(text) => text + | _ => "other" + } + +let sharedKind = value => { + let kind = switch value { + | SharedDate(_) => "date" + | SharedText(_) => "text" + | _ => "other" + } + kind ++ "!" +} + describe(__MODULE__, () => { test("a subclass case is not taken for its superclass", () => { eq(__LOC__, "animal", describePet(Animal(makeAnimal()))) @@ -227,4 +261,21 @@ describe(__MODULE__, () => { eq(__LOC__, "dog", objectOrNameKind(ObjectDog(makeObjectDog()))) eq(__LOC__, "rex", objectOrNameKind(ObjectName("rex"))) }) + + test("primitive cases are tested before class checks", () => { + eq(__LOC__, "a", missingKind(id(Text("a")))) + eq(__LOC__, "count", missingKind(id(Count(1.)))) + }) + + test("a primitive without an arm skips class checks", () => { + eq(__LOC__, "a", missingOrDefault(id(Text("a")))) + eq(__LOC__, "other", missingOrDefault(id(Count(1.)))) + }) + + test("a default shared by a primitive and an object case", () => { + eq(__LOC__, "date!", sharedKind(id(SharedDate(Date.make())))) + eq(__LOC__, "other!", sharedKind(id(SharedObject({x: 1})))) + eq(__LOC__, "text!", sharedKind(id(SharedText("a")))) + eq(__LOC__, "other!", sharedKind(id(SharedCount(1.)))) + }) }) diff --git a/tests/tests/src/untagged_variants_spec_test.mjs b/tests/tests/src/untagged_variants_spec_test.mjs index 9eed05b5fa..0612499b8e 100644 --- a/tests/tests/src/untagged_variants_spec_test.mjs +++ b/tests/tests/src/untagged_variants_spec_test.mjs @@ -28,10 +28,12 @@ function kindName(v) { return "bigint"; case "boolean" : return "bool"; - case "function" : - return "function"; - case "object" : - return "object"; + default: + if (typeof v === "function") { + return "function"; + } else { + return "object"; + } } } @@ -44,57 +46,44 @@ function tupleName(v) { } function aliasDictName(v) { - if (typeof v === "object" && !Array.isArray(v)) { - return "object"; - } else { + if (Array.isArray(v)) { return "array"; + } else { + return "object"; } } function instanceName(v) { - if (v instanceof Date) { + if (typeof v === "string") { + return "string"; + } else if (v instanceof Date) { return "Date"; - } - if (v instanceof RegExp) { + } else if (v instanceof RegExp) { return "RegExp"; - } - if (v instanceof Promise) { + } else if (v instanceof Promise) { return "Promise"; - } - if (v instanceof Map) { + } else if (v instanceof Map) { return "Map"; - } - if (v instanceof Set) { + } else if (v instanceof Set) { return "Set"; - } - if (v instanceof WeakMap) { + } else if (v instanceof WeakMap) { return "WeakMap"; - } - if (v instanceof WeakSet) { + } else if (v instanceof WeakSet) { return "WeakSet"; - } - if (v instanceof ArrayBuffer) { + } else if (v instanceof ArrayBuffer) { return "ArrayBuffer"; - } - if (v instanceof DataView) { + } else if (v instanceof DataView) { return "DataView"; - } - if (v instanceof Float64Array) { + } else { return "Float64Array"; } - switch (typeof v) { - case "string" : - return "string"; - } } function unknownName(v) { - if (v === null || v === "none") { - if (v === null) { - return "null"; - } else { - return "none"; - } + if (v === null) { + return "null"; + } else if (v === "none") { + return "none"; } else { return "list"; } @@ -133,10 +122,10 @@ function overlapNullName(v) { } function objectFirstName(v) { - if (typeof v === "object" && !(v instanceof Date)) { - return "object"; - } else { + if (v instanceof Date) { return "Date"; + } else { + return "object"; } } @@ -175,10 +164,10 @@ function twoInstancesName(v) { } function promiseOrFloatName(v) { - if (v instanceof Promise) { - return "promise"; - } else { + if (typeof v === "number") { return "float"; + } else { + return "promise"; } } @@ -348,7 +337,7 @@ Mocha.describe("Untagged_variants_spec_test", () => { x: 1 }), "RegExp"); let thenable = ({then: (resolve) => resolve(1)}); - Test_utils.eq("File \"untagged_variants_spec_test.res\", line 319, characters 7-14", promiseOrFloatName(thenable), "float"); + Test_utils.eq("File \"untagged_variants_spec_test.res\", line 319, characters 7-14", promiseOrFloatName(thenable), "promise"); }); Mocha.test("rule 12: option of an untagged variant", () => { Test_utils.eq("File \"untagged_variants_spec_test.res\", line 323, characters 7-14", someWithNull(null), null); diff --git a/tests/tests/src/untagged_variants_spec_test.res b/tests/tests/src/untagged_variants_spec_test.res index 0587b8980e..fc65258e76 100644 --- a/tests/tests/src/untagged_variants_spec_test.res +++ b/tests/tests/src/untagged_variants_spec_test.res @@ -316,7 +316,7 @@ describe(__MODULE__, () => { eq(__LOC__, intOrStringName(raw(true)), "string") eq(__LOC__, twoInstancesName(raw({"x": 1})), "RegExp") let thenable = %raw(`{then: (resolve) => resolve(1)}`) - eq(__LOC__, promiseOrFloatName(raw(thenable)), "float") + eq(__LOC__, promiseOrFloatName(raw(thenable)), "promise") }) test("rule 12: option of an untagged variant", () => { diff --git a/tests/tests/src/variantsMatching.mjs b/tests/tests/src/variantsMatching.mjs index a23fbd46a8..5d45bd1d34 100644 --- a/tests/tests/src/variantsMatching.mjs +++ b/tests/tests/src/variantsMatching.mjs @@ -230,12 +230,10 @@ function plus$2(x, y) { } function kind(x) { - if (x == null) { - if (x === null) { - return "null"; - } else { - return "undefined"; - } + if (x === null) { + return "null"; + } else if (x === undefined) { + return "undefined"; } else { return "present"; } @@ -270,36 +268,33 @@ function isWhyNot(x) { } function plus$3(x, y) { - if (x === null || x === "WhyNotAnotherOne" || x === undefined) { - switch (x) { - case null : - case undefined : - return y; - case "WhyNotAnotherOne" : - break; - } - } else if (y !== null && y !== "WhyNotAnotherOne" && y !== undefined) { - return { - x: x.x + y.x, - y: x.y + y.y - }; - } - if (y !== null && y !== "WhyNotAnotherOne" && y !== undefined) { - return "WhyNotAnotherOne"; - } - switch (y) { + switch (x) { case null : case undefined : - return x; + return y; case "WhyNotAnotherOne" : - return "WhyNotAnotherOne"; + break; + default: + switch (y) { + case null : + case undefined : + case "WhyNotAnotherOne" : + break; + default: + return { + x: x.x + y.x, + y: x.y + y.y + }; + } + } + if (y == null) { + return x; + } else { + return "WhyNotAnotherOne"; } } function kind$1(x) { - if (x !== null && x !== "WhyNotAnotherOne" && x !== undefined) { - return "present"; - } switch (x) { case null : return "null"; @@ -307,6 +302,8 @@ function kind$1(x) { return "undefined"; case "WhyNotAnotherOne" : return "whynot"; + default: + return "present"; } } @@ -388,7 +385,7 @@ function classify(x) { } else { return "boolean"; } - case "object" : + default: return "Object" + x.name; } }