Match untagged variants with a literal switch and one typeof dispatch

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.

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}

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
 

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 ->