Make promise a built-in type.

CHANGELOG.md

@@ -18,7 +18,9 @@
 
 #### :rocket: New Feature
 
-- Add support for for `async`/`await` https://github.com/rescript-lang/rescript-compiler/pull/5537
+- Experimental support for for `async`/`await` https://github.com/rescript-lang/rescript-compiler/pull/5537
+
+- Make `promise` a built-in type https://github.com/rescript-lang/rescript-compiler/pull/5650
 
 - Initial support for JSX V4 including genType, still work in progress.
 

jscomp/gentype/TranslateTypeExprFromTypes.ml

@@ -203,7 +203,7 @@ let translateConstr ~config ~paramsTranslation ~(path : Path.t) ~typeEnv =
       | [ "Js"; "null_undefined" ] ),
       [ paramTranslation ] ) ->
       { paramTranslation with type_ = Nullable paramTranslation.type_ }
-  | [ "Js"; "Promise"; "t" ], [ paramTranslation ] ->
+  | ([ "Js"; "Promise"; "t" ] | ["promise"]), [ paramTranslation ] ->
       { paramTranslation with type_ = Promise paramTranslation.type_ }
   | ( [ "Js"; "Internal"; "fn" ],
       [ { dependencies = argsDependencies; type_ = Tuple ts }; ret ] ) ->

jscomp/main/builtin_cmj_datasets.ml

@@ -1,4 +1,4 @@
-(* 36afc4d4582ed9cc168039f5d3f28592 *) 
+(* a32a8631aa0bfcd37a4d742e9ad8aada *) 
 let module_names : string array = Obj.magic (
 "Js" (* 23 *),
 "Arg" (* 217 *),
@@ -209,7 +209,7 @@ let module_data : string array = Obj.magic (
 (* Belt_Float *)"\132\149\166\190\000\000\000\022\000\000\000\007\000\000\000\021\000\000\000\020\160\144\176*fromString\144\160\160A@@@A",
 (* Belt_Range *)"\132\149\166\190\000\000\000\160\000\000\0004\000\000\000\166\000\000\000\156\160\b\000\000(\000\176$some\144\160\160C@@@\176%every\144\160\160C@@@\176%someU\144\160\160C@@@\176&everyU\144\160\160C@@@\176&someBy\144\160\160D@@@\176'everyBy\144\160\160D@@@\176'forEach\144\160\160C@@@\176'someByU\144\160\160D@@@\176(everyByU\144\160\160D@@@\176(forEachU\144\160\160C@@@A",
 (* Js_console *)"\132\149\166\190\000\000\000\003\000\000\000\001\000\000\000\003\000\000\000\003\160\128A",
-(* Js_promise *)"\132\149\166\190\000\000\000\252\000\000\000J\000\000\000\243\000\000\000\232\160\160\176%catch\144\160\160B@@\144\148\192B\160\176\001\003\253$arg1@\160\176\001\003\254#obj@@\151\176\180%catch\160\160AA\160\160AA@\181%catch@@\160\144\004\014\160\151\176\b\000\000\004\016A\160\144\004\023@\176\1924others/js_promise.ml\000Q\001\011\018\001\011\018\192\004\002\000R\001\011T\001\011l@@\004\004\208B@@@@\176%then_\144\160\160B@@\144\148\192B\160\176\001\003\248$arg1@\160\176\001\003\249\004%@@\151\176\180$then\160\160AA\160\160AA@\181$then@@\160\144\004\r\160\151\176\b\000\000\004\016A\160\144\004\022@\176\192\004$\000N\001\n\186\001\n\186\192\004%\000O\001\n\248\001\011\016@@\004\003\208B@@@@A",
+(* Js_promise *)"\132\149\166\190\000\000\000\252\000\000\000J\000\000\000\243\000\000\000\232\160\160\176%catch\144\160\160B@@\144\148\192B\160\176\001\003\253$arg1@\160\176\001\003\254#obj@@\151\176\180%catch\160\160AA\160\160AA@\181%catch@@\160\144\004\014\160\151\176\b\000\000\004\016A\160\144\004\023@\176\1924others/js_promise.ml\000Q\001\011\241\001\011\241\192\004\002\000R\001\012?\001\012]@@\004\004\208B@@@@\176%then_\144\160\160B@@\144\148\192B\160\176\001\003\248$arg1@\160\176\001\003\249\004%@@\151\176\180$then\160\160AA\160\160AA@\181$then@@\160\144\004\r\160\151\176\b\000\000\004\016A\160\144\004\022@\176\192\004$\000N\001\011\135\001\011\135\192\004%\000O\001\011\209\001\011\239@@\004\003\208B@@@@A",
 (* Js_string2 *)"\132\149\166\190\000\000\000\003\000\000\000\001\000\000\000\003\000\000\000\003\160\128A",
 (* Js_weakmap *)"\132\149\166\190\000\000\000\003\000\000\000\001\000\000\000\003\000\000\000\003\160\128A",
 (* Js_weakset *)"\132\149\166\190\000\000\000\003\000\000\000\001\000\000\000\003\000\000\000\003\160\128A",

jscomp/ml/predef.ml

@@ -48,6 +48,8 @@ and ident_floatarray = ident_create "floatarray"
 
 and ident_unknown = ident_create "unknown"
 
+and ident_promise = ident_create "promise"
+
 type test =
   | For_sure_yes
   | For_sure_no 
@@ -87,6 +89,8 @@ and path_unkonwn = Pident ident_unknown
 and path_extension_constructor = Pident ident_extension_constructor
 and path_floatarray = Pident ident_floatarray
 
+and path_promise = Pident ident_promise
+
 let type_int = newgenty (Tconstr(path_int, [], ref Mnil))
 and type_char = newgenty (Tconstr(path_char, [], ref Mnil))
 and type_bytes = newgenty (Tconstr(path_bytes, [], ref Mnil))
@@ -227,6 +231,12 @@ let common_initial_env add_type add_extension empty_env =
      type_params = [tvar];
      type_arity = 1;
      type_variance = [Variance.covariant]}
+  and decl_promise =
+    let tvar = newgenvar() in
+    {decl_abstr with
+     type_params = [tvar];
+     type_arity = 1;
+     type_variance = [Variance.covariant]}
   in
 
   let add_extension id l =
@@ -268,7 +278,8 @@ let common_initial_env add_type add_extension empty_env =
   add_type ident_int decl_abstr_imm (
   add_type ident_extension_constructor decl_abstr (
   add_type ident_floatarray decl_abstr (
-    empty_env)))))))))))))))))))))))
+    add_type ident_promise decl_promise (
+      empty_env))))))))))))))))))))))))
 
 let build_initial_env add_type add_exception empty_env =
   let common = common_initial_env add_type add_exception empty_env in

jscomp/ml/predef.mli

@@ -52,6 +52,7 @@ val path_int64: Path.t
 val path_lazy_t: Path.t
 val path_extension_constructor: Path.t
 val path_floatarray: Path.t
+val path_promise: Path.t
 
 val path_match_failure: Path.t
 val path_assert_failure : Path.t

jscomp/ml/typecore.ml

@@ -1864,36 +1864,44 @@ and type_expect ?in_function ?recarg env sexp ty_expected =
          type_expect_ ?in_function ?recarg env sexp ty_expected
       )
   in
-  let () =
-    let rec extractPromise t =
-      match t.desc with
-      | Tconstr (Pdot (Pdot (Pident {name = "Js"}, "Promise", _), "t", _), [t1], _)
-        ->
+  checkTypeInvariant exp;
+  Cmt_format.set_saved_types
+  (Cmt_format.Partial_expression exp :: previous_saved_types);
+  exp
+
+(* NOTE: the type invariant check should have no side effects and be efficient *)
+and checkTypeInvariant exp : unit =
+  let rec extractPromise t =
+    match t.desc with
+    | Tconstr
+        (Pdot (Pdot (Pident { name = "Js" }, "Promise", _), "t", _), [ t1 ], _)
+    | Tconstr (Pident { name = "promise" }, [ t1 ], _) ->
+      (* Improvement: check for type aliases, if it can be done efficiently *)
         Some t1
-      | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractPromise t1
-      | _ -> None
-    in
-    let rec findNestedPromise t =
-      match t.desc with
-      | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> findNestedPromise t1
-      | Tconstr (_, ts, _) -> (
+    | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractPromise t1
+    | _ -> None
+  in
+  (* Only traverse arguments of a type constructors and function types.
+     This should guarantee that the traversal finished quickly. *)
+  let rec findNestedPromise t =
+    match t.desc with
+    | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> findNestedPromise t1
+    | Tconstr (_, ts, _) -> (
         match extractPromise t with
         | Some t1 -> (
-          match extractPromise t1 with
-          | Some _t2 ->
-            let nestedType = Format.asprintf "%a" Printtyp.type_expr t in
-            Location.prerr_warning exp.exp_loc (Bs_nested_promise nestedType)
-          | None -> ts |> List.iter findNestedPromise)
+            match extractPromise t1 with
+            | Some _t2 ->
+                let nestedType = Format.asprintf "%a" Printtyp.type_expr t in
+                Location.prerr_warning exp.exp_loc
+                  (Bs_nested_promise nestedType)
+            | None -> ts |> List.iter findNestedPromise)
         | None -> ts |> List.iter findNestedPromise)
-      | Tarrow (_, t1, t2, _) ->
+    | Tarrow (_, t1, t2, _) ->
         findNestedPromise t1;
         findNestedPromise t2
-      | _ -> ()
-     in findNestedPromise exp.exp_type
-    in
-    Cmt_format.set_saved_types
-    (Cmt_format.Partial_expression exp :: previous_saved_types);
-  exp
+    | _ -> ()
+  in
+  findNestedPromise exp.exp_type
 
 and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected =
   let loc = sexp.pexp_loc in

jscomp/others/js_promise.ml

@@ -31,7 +31,7 @@
 
 [@@@warning "-103"]
 
-type +'a t
+type +'a t = 'a promise
 type error
 
 (*
@@ -43,52 +43,52 @@ type error
 external make :
   ((resolve:(('a -> unit)[@bs]) -> reject:((exn -> unit)[@bs]) -> unit)
   [@bs.uncurry]) ->
-  'a t = "Promise"
+  'a promise = "Promise"
   [@@bs.new]
 
 (* `make (fun resolve reject -> .. )` *)
-external resolve : 'a -> 'a t = "resolve" [@@bs.val] [@@bs.scope "Promise"]
-external reject : exn -> 'a t = "reject" [@@bs.val] [@@bs.scope "Promise"]
+external resolve : 'a -> 'a promise = "resolve" [@@bs.val] [@@bs.scope "Promise"]
+external reject : exn -> 'a promise = "reject" [@@bs.val] [@@bs.scope "Promise"]
 
-external all : 'a t array -> 'a array t = "all"
+external all : 'a promise array -> 'a array promise = "all"
   [@@bs.val] [@@bs.scope "Promise"]
 
-external all2 : 'a0 t * 'a1 t -> ('a0 * 'a1) t = "all"
+external all2 : 'a0 promise * 'a1 promise -> ('a0 * 'a1) promise = "all"
   [@@bs.val] [@@bs.scope "Promise"]
 
-external all3 : 'a0 t * 'a1 t * 'a2 t -> ('a0 * 'a1 * 'a2) t = "all"
+external all3 : 'a0 promise * 'a1 promise * 'a2 promise -> ('a0 * 'a1 * 'a2) promise = "all"
   [@@bs.val] [@@bs.scope "Promise"]
 
-external all4 : 'a0 t * 'a1 t * 'a2 t * 'a3 t -> ('a0 * 'a1 * 'a2 * 'a3) t
+external all4 : 'a0 promise * 'a1 promise * 'a2 promise * 'a3 promise -> ('a0 * 'a1 * 'a2 * 'a3) promise
   = "all"
   [@@bs.val] [@@bs.scope "Promise"]
 
 external all5 :
-  'a0 t * 'a1 t * 'a2 t * 'a3 t * 'a4 t -> ('a0 * 'a1 * 'a2 * 'a3 * 'a4) t
+  'a0 promise * 'a1 promise * 'a2 promise * 'a3 promise * 'a4 promise -> ('a0 * 'a1 * 'a2 * 'a3 * 'a4) promise
   = "all"
   [@@bs.val] [@@bs.scope "Promise"]
 
 external all6 :
-  'a0 t * 'a1 t * 'a2 t * 'a3 t * 'a4 t * 'a5 t ->
-  ('a0 * 'a1 * 'a2 * 'a3 * 'a4 * 'a5) t = "all"
+  'a0 promise * 'a1 promise * 'a2 promise * 'a3 promise * 'a4 promise * 'a5 promise ->
+  ('a0 * 'a1 * 'a2 * 'a3 * 'a4 * 'a5) promise = "all"
   [@@bs.val] [@@bs.scope "Promise"]
 
-external race : 'a t array -> 'a t = "race" [@@bs.val] [@@bs.scope "Promise"]
+external race : 'a promise array -> 'a promise = "race" [@@bs.val] [@@bs.scope "Promise"]
 
-external then_ : (('a -> 'b t)[@bs.uncurry]) -> 'b t = "then"
-  [@@bs.send.pipe: 'a t]
+external then_ : (('a -> 'b promise)[@bs.uncurry]) -> 'b promise = "then"
+  [@@bs.send.pipe: 'a promise]
 
-external catch : ((error -> 'a t)[@bs.uncurry]) -> 'a t = "catch"
-  [@@bs.send.pipe: 'a t]
+external catch : ((error -> 'a promise)[@bs.uncurry]) -> 'a promise = "catch"
+  [@@bs.send.pipe: 'a promise]
 (* ` p|> catch handler`
     Note in JS the returned promise type is actually runtime dependent,
     if promise is rejected, it will pick the `handler` otherwise the original promise,
     to make it strict we enforce reject handler
     https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Promise/catch
 *)
 
-external unsafe_async : 'a -> 'a t = "%identity"
-external unsafe_await : 'a t -> 'a = "?await"
+external unsafe_async : 'a -> 'a promise = "%identity"
+external unsafe_await : 'a promise -> 'a = "?await"
 
 
 (*

lib/4.06.1/unstable/all_ounit_tests.ml

@@ -43611,6 +43611,7 @@ val path_int64: Path.t
 val path_lazy_t: Path.t
 val path_extension_constructor: Path.t
 val path_floatarray: Path.t
+val path_promise: Path.t
 
 val path_match_failure: Path.t
 val path_assert_failure : Path.t
@@ -43697,6 +43698,8 @@ and ident_floatarray = ident_create "floatarray"
 
 and ident_unknown = ident_create "unknown"
 
+and ident_promise = ident_create "promise"
+
 type test =
   | For_sure_yes
   | For_sure_no 
@@ -43736,6 +43739,8 @@ and path_unkonwn = Pident ident_unknown
 and path_extension_constructor = Pident ident_extension_constructor
 and path_floatarray = Pident ident_floatarray
 
+and path_promise = Pident ident_promise
+
 let type_int = newgenty (Tconstr(path_int, [], ref Mnil))
 and type_char = newgenty (Tconstr(path_char, [], ref Mnil))
 and type_bytes = newgenty (Tconstr(path_bytes, [], ref Mnil))
@@ -43876,6 +43881,12 @@ let common_initial_env add_type add_extension empty_env =
      type_params = [tvar];
      type_arity = 1;
      type_variance = [Variance.covariant]}
+  and decl_promise =
+    let tvar = newgenvar() in
+    {decl_abstr with
+     type_params = [tvar];
+     type_arity = 1;
+     type_variance = [Variance.covariant]}
   in
 
   let add_extension id l =
@@ -43917,7 +43928,8 @@ let common_initial_env add_type add_extension empty_env =
   add_type ident_int decl_abstr_imm (
   add_type ident_extension_constructor decl_abstr (
   add_type ident_floatarray decl_abstr (
-    empty_env)))))))))))))))))))))))
+    add_type ident_promise decl_promise (
+      empty_env))))))))))))))))))))))))
 
 let build_initial_env add_type add_exception empty_env =
   let common = common_initial_env add_type add_exception empty_env in