Declare the runtime class or typeof of types, and annotate the stdlib

analysis/src/completion_decorators.ml

@@ -298,6 +298,46 @@ You will need this decorator whenever you want to use a JSX component in ReScrip
       [
         {|The `@editor.completeFrom` decorator instructs the editor where it can draw additional completions from for this type.|};
       ] );
+    ( "instanceOf",
+      Some "instanceOf(\"$0\")",
+      [
+        {|The `@instanceOf` decorator states that the values of an abstract type are instances of a global JavaScript class. Such a type can be the payload of an untagged variant case, which is then recognized with `instanceof`, and is never `undefined`, like with `@notUndefined`.
+
+A private abbreviation of another annotated type declares a subclass. A case of the superclass then excludes the instances of a subclass that is a case too, whatever the order of the cases.
+
+Example usage:
+```rescript
+@instanceOf("Blob")
+type blob
+
+@instanceOf("File")
+type file = private blob
+```|};
+      ] );
+    ( "typeOf",
+      Some "typeOf(\"$0\")",
+      [
+        {|The `@typeOf` decorator states the JavaScript `typeof` of the values of an abstract type: one of `"string"`, `"number"`, `"bigint"`, `"boolean"`, `"symbol"`, `"function"` or `"object"`. Such a type can be the payload of an untagged variant case, and is never `undefined`, like with `@notUndefined`.
+
+Example usage:
+```rescript
+@typeOf("symbol")
+type key
+```|};
+      ] );
+    ( "notUndefined",
+      None,
+      [
+        {|The `@notUndefined` decorator marks an abstract type as one that can never be `undefined` in JavaScript. This allows the compiler to generate more efficient code when the type is used inside an `option`.
+
+Example usage:
+```rescript
+@notUndefined
+type t
+```
+
+[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#notundefined-decorator).|};
+      ] );
   ]
 
 let toplevel =
@@ -331,17 +371,4 @@ let toplevel =
 
 [Read more and see examples in the documentation](https://rescript-lang.org/docs/manual/latest/jsx#file-level-configuration).|};
       ] );
-    ( "notUndefined",
-      None,
-      [
-        {|The `@notUndefined` decorator marks an abstract type as one that can never be `undefined` in JavaScript. This allows the compiler to generate more efficient code when the type is used inside an `option`.
-
-Example usage:
-```rescript
-@notUndefined
-type t
-```
-
-[Read more and see examples in the documentation](https://rescript-lang.org/syntax-lookup#notundefined-decorator).|};
-      ] );
   ]

changes/instanceof-typeof-annotations.feature.md

@@ -0,0 +1 @@
+- Add `@instanceOf("Class")` and `@typeOf("…")` for abstract types and type abbreviations, so that values of bound JavaScript classes and opaque primitive types can be untagged variant cases. A private abbreviation of another annotated type declares a subclass.

changes/not-undefined-inclusion.fix.md

@@ -0,0 +1 @@
+- Reject an implementation that can hold `undefined` for a type its interface declares `@notUndefined`, which made `Some(None)` of the type `None` in clients.

changes/stdlib-instanceof-annotations.fix.md

@@ -0,0 +1 @@
+- An untagged variant with both `Blob` and `File` cases matches files as `File`, whatever the order of its cases. `File.t` is now a private abbreviation of `Blob.t`, and `JsError.t`, `Symbol.t` and the `Intl` classes can be untagged variant cases.

changes/untagged-no-hardcoded-classes.internal.md

@@ -0,0 +1 @@
+- Untagged variants recognize stdlib classes only through their `@instanceOf` annotations; the compiler's list of stdlib type names is gone.

changes/untagged-private-subclasses.polish.md

@@ -0,0 +1 @@
+- Require `= private` for every subclass declared with `@instanceOf`, also in phantom type hierarchies, and fold `null` into an untagged variant's object case as it is matched at run time.

compiler/core/js_exp_make.ml

@@ -1399,18 +1399,25 @@ let literal_tag = function
   | Null -> nil
   | Undefined -> undefined
 
+(* The constructor of a class at a global path such as "Intl.Locale": a
+   global with properties, so that a binding that shadows the global's name
+   is noticed. *)
+let class_constructor (instance : Variant_runtime.Instance.t) =
+  match
+    String.split_on_char '.' (Variant_runtime.Instance.to_string instance)
+  with
+  | [] -> 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.IntType | FloatType -> str "number"
-  | BigintType -> str "bigint"
-  | BooleanType -> str "boolean"
-  | FunctionType -> str "function"
-  | StringType -> str "string"
-  | InstanceType i -> js_global (Variant_runtime.Instance.to_string i)
-  | ObjectType -> str "object"
-  | UnknownType ->
-    (* TODO: this should not happen *)
-    assert false
+  | 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)
 
 let tag_type = function
   | Variant_runtime.Literal d -> literal_tag d
@@ -1431,8 +1438,7 @@ let rec emit_check (check : t Ast_untagged_variants.Dynamic_checks.t) =
   | TypeOf x -> typeof (emit_check x)
   | IsInstanceOf (Array, x) -> is_array (emit_check x)
   | IsInstanceOf (instance, x) ->
-    let instance_name = Variant_runtime.Instance.to_string instance in
-    instanceof (emit_check x) (js_global instance_name)
+    instanceof (emit_check x) (class_constructor instance)
   | Not x -> not (emit_check x)
   | Expr x -> x
 

compiler/core/lam_compile.ml

@@ -797,7 +797,7 @@ let compile output_prefix =
                     (fun (block_type : Variant_runtime.block_type) ->
                       match (literal, block_type) with
                       | String _, StringType
-                      | (Int _ | Float _), (IntType | FloatType)
+                      | (Int _ | Float _), NumberType
                       | BigInt _, BigintType
                       | Bool _, BooleanType
                       | _, UnknownType ->
@@ -882,20 +882,23 @@ let compile output_prefix =
       let not_typeof_clauses, typeof_clauses =
         List.partition clause_is_not_typeof clauses
       in
-      let has_object_typeof =
+      let has_typeof kind =
         List.exists
           (function
-            | Variant_runtime.Payload_shape ObjectType, _ -> true
+            | Variant_runtime.Payload_shape block_type, _ -> block_type = kind
             | _ -> false)
           typeof_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"). Guard against them when they should fall through to
-         default: null, and the instance cases without an arm of their own. *)
+         "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 then []
+        if not (has_object_typeof || has_typeof FunctionType) then []
         else
           Ext_list.filter_map block_cases (function
             | Variant_runtime.InstanceType instance
@@ -909,13 +912,20 @@ let compile output_prefix =
               Some instance
             | _ -> None)
       in
+      let instances =
+        Ext_list.filter_map block_cases (function
+          | Variant_runtime.InstanceType i -> Some i
+          | _ -> 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 (IsInstanceOf (instance_type, Expr e)))
+            (E.emit_check
+               (Ast_untagged_variants.Dynamic_checks.is_case_instance ~instances
+                  instance_type (Expr e)))
             switch_body
             ~else_:[build_if_chain rest]
         | _ -> (