Skip to content

Commit d1d8668

Browse files
cristianoccristianoc
committed
Move checking type invariant to separate function.
1 parent f02442c commit d1d8668

File tree

4 files changed

+121
-115
lines changed

4 files changed

+121
-115
lines changed

‎jscomp/ml/typecore.ml‎

Lines changed: 28 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -1864,37 +1864,40 @@ and type_expect ?in_function ?recarg env sexp ty_expected =
18641864
type_expect_ ?in_function ?recarg env sexp ty_expected
18651865
)
18661866
in
1867-
let () =
1868-
let rec extractPromise t =
1869-
match t.desc with
1870-
| Tconstr (Pdot (Pdot (Pident {name = "Js"}, "Promise", _), "t", _), [t1], _)
1871-
| Tconstr (Pident {name = "promise"}, [t1], _)
1872-
->
1867+
checkTypeInvariant exp;
1868+
Cmt_format.set_saved_types
1869+
(Cmt_format.Partial_expression exp :: previous_saved_types);
1870+
exp
1871+
1872+
and checkTypeInvariant exp =
1873+
let rec extractPromise t =
1874+
match t.desc with
1875+
| Tconstr
1876+
(Pdot (Pdot (Pident { name = "Js" }, "Promise", _), "t", _), [ t1 ], _)
1877+
| Tconstr (Pident { name = "promise" }, [ t1 ], _) ->
18731878
Some t1
1874-
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractPromise t1
1875-
| _ -> None
1876-
in
1877-
let rec findNestedPromise t =
1878-
match t.desc with
1879-
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> findNestedPromise t1
1880-
| Tconstr (_, ts, _) -> (
1879+
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractPromise t1
1880+
| _ -> None
1881+
in
1882+
let rec findNestedPromise t =
1883+
match t.desc with
1884+
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> findNestedPromise t1
1885+
| Tconstr (_, ts, _) -> (
18811886
match extractPromise t with
18821887
| Some t1 -> (
1883-
match extractPromise t1 with
1884-
| Some _t2 ->
1885-
let nestedType = Format.asprintf "%a" Printtyp.type_expr t in
1886-
Location.prerr_warning exp.exp_loc (Bs_nested_promise nestedType)
1887-
| None -> ts |> List.iter findNestedPromise)
1888+
match extractPromise t1 with
1889+
| Some _t2 ->
1890+
let nestedType = Format.asprintf "%a" Printtyp.type_expr t in
1891+
Location.prerr_warning exp.exp_loc
1892+
(Bs_nested_promise nestedType)
1893+
| None -> ts |> List.iter findNestedPromise)
18881894
| None -> ts |> List.iter findNestedPromise)
1889-
| Tarrow (_, t1, t2, _) ->
1895+
| Tarrow (_, t1, t2, _) ->
18901896
findNestedPromise t1;
18911897
findNestedPromise t2
1892-
| _ -> ()
1893-
in findNestedPromise exp.exp_type
1894-
in
1895-
Cmt_format.set_saved_types
1896-
(Cmt_format.Partial_expression exp :: previous_saved_types);
1897-
exp
1898+
| _ -> ()
1899+
in
1900+
findNestedPromise exp.exp_type
18981901

18991902
and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected =
19001903
let loc = sexp.pexp_loc in

‎lib/4.06.1/unstable/js_compiler.ml‎

Lines changed: 31 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -40813,38 +40813,39 @@ and type_expect ?in_function ?recarg env sexp ty_expected =
4081340813
type_expect_ ?in_function ?recarg env sexp ty_expected
4081440814
)
4081540815
in
40816-
let () =
40817-
let rec extractPromise t =
40818-
match t.desc with
40819-
| Tconstr (Pdot (Pdot (Pident {name = "Js"}, "Promise", _), "t", _), [t1], _)
40820-
| Tconstr (Pident {name = "promise"}, [t1], _)
40821-
->
40822-
Some t1
40823-
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractPromise t1
40824-
| _ -> None
40825-
in
40826-
let rec findNestedPromise t =
40827-
match t.desc with
40828-
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> findNestedPromise t1
40829-
| Tconstr (_, ts, _) -> (
40830-
match extractPromise t with
40831-
| Some t1 -> (
40832-
match extractPromise t1 with
40833-
| Some _t2 ->
40834-
let nestedType = Format.asprintf "%a" Printtyp.type_expr t in
40835-
Location.prerr_warning exp.exp_loc (Bs_nested_promise nestedType)
40836-
| None -> ts |> List.iter findNestedPromise)
40837-
| None -> ts |> List.iter findNestedPromise)
40838-
| Tarrow (_, t1, t2, _) ->
40839-
findNestedPromise t1;
40840-
findNestedPromise t2
40841-
| _ -> ()
40842-
in findNestedPromise exp.exp_type
40843-
in
40844-
Cmt_format.set_saved_types
40845-
(Cmt_format.Partial_expression exp :: previous_saved_types);
40816+
checkTypeInvariant exp;
40817+
Cmt_format.set_saved_types
40818+
(Cmt_format.Partial_expression exp :: previous_saved_types);
4084640819
exp
4084740820

40821+
and checkTypeInvariant exp =
40822+
let rec extractPromise t =
40823+
match t.desc with
40824+
| Tconstr (Pdot (Pdot (Pident {name = "Js"}, "Promise", _), "t", _), [t1], _)
40825+
| Tconstr (Pident {name = "promise"}, [t1], _)
40826+
->
40827+
Some t1
40828+
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractPromise t1
40829+
| _ -> None
40830+
in
40831+
let rec findNestedPromise t =
40832+
match t.desc with
40833+
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> findNestedPromise t1
40834+
| Tconstr (_, ts, _) -> (
40835+
match extractPromise t with
40836+
| Some t1 -> (
40837+
match extractPromise t1 with
40838+
| Some _t2 ->
40839+
let nestedType = Format.asprintf "%a" Printtyp.type_expr t in
40840+
Location.prerr_warning exp.exp_loc (Bs_nested_promise nestedType)
40841+
| None -> ts |> List.iter findNestedPromise)
40842+
| None -> ts |> List.iter findNestedPromise)
40843+
| Tarrow (_, t1, t2, _) ->
40844+
findNestedPromise t1;
40845+
findNestedPromise t2
40846+
| _ -> ()
40847+
in findNestedPromise exp.exp_type
40848+
4084840849
and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected =
4084940850
let loc = sexp.pexp_loc in
4085040851
(* Record the expression type before unifying it with the expected type *)

‎lib/4.06.1/unstable/js_playground_compiler.ml‎

Lines changed: 31 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -40813,38 +40813,39 @@ and type_expect ?in_function ?recarg env sexp ty_expected =
4081340813
type_expect_ ?in_function ?recarg env sexp ty_expected
4081440814
)
4081540815
in
40816-
let () =
40817-
let rec extractPromise t =
40818-
match t.desc with
40819-
| Tconstr (Pdot (Pdot (Pident {name = "Js"}, "Promise", _), "t", _), [t1], _)
40820-
| Tconstr (Pident {name = "promise"}, [t1], _)
40821-
->
40822-
Some t1
40823-
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractPromise t1
40824-
| _ -> None
40825-
in
40826-
let rec findNestedPromise t =
40827-
match t.desc with
40828-
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> findNestedPromise t1
40829-
| Tconstr (_, ts, _) -> (
40830-
match extractPromise t with
40831-
| Some t1 -> (
40832-
match extractPromise t1 with
40833-
| Some _t2 ->
40834-
let nestedType = Format.asprintf "%a" Printtyp.type_expr t in
40835-
Location.prerr_warning exp.exp_loc (Bs_nested_promise nestedType)
40836-
| None -> ts |> List.iter findNestedPromise)
40837-
| None -> ts |> List.iter findNestedPromise)
40838-
| Tarrow (_, t1, t2, _) ->
40839-
findNestedPromise t1;
40840-
findNestedPromise t2
40841-
| _ -> ()
40842-
in findNestedPromise exp.exp_type
40843-
in
40844-
Cmt_format.set_saved_types
40845-
(Cmt_format.Partial_expression exp :: previous_saved_types);
40816+
checkTypeInvariant exp;
40817+
Cmt_format.set_saved_types
40818+
(Cmt_format.Partial_expression exp :: previous_saved_types);
4084640819
exp
4084740820

40821+
and checkTypeInvariant exp =
40822+
let rec extractPromise t =
40823+
match t.desc with
40824+
| Tconstr (Pdot (Pdot (Pident {name = "Js"}, "Promise", _), "t", _), [t1], _)
40825+
| Tconstr (Pident {name = "promise"}, [t1], _)
40826+
->
40827+
Some t1
40828+
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractPromise t1
40829+
| _ -> None
40830+
in
40831+
let rec findNestedPromise t =
40832+
match t.desc with
40833+
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> findNestedPromise t1
40834+
| Tconstr (_, ts, _) -> (
40835+
match extractPromise t with
40836+
| Some t1 -> (
40837+
match extractPromise t1 with
40838+
| Some _t2 ->
40839+
let nestedType = Format.asprintf "%a" Printtyp.type_expr t in
40840+
Location.prerr_warning exp.exp_loc (Bs_nested_promise nestedType)
40841+
| None -> ts |> List.iter findNestedPromise)
40842+
| None -> ts |> List.iter findNestedPromise)
40843+
| Tarrow (_, t1, t2, _) ->
40844+
findNestedPromise t1;
40845+
findNestedPromise t2
40846+
| _ -> ()
40847+
in findNestedPromise exp.exp_type
40848+
4084840849
and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected =
4084940850
let loc = sexp.pexp_loc in
4085040851
(* Record the expression type before unifying it with the expected type *)

‎lib/4.06.1/whole_compiler.ml‎

Lines changed: 31 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -217200,38 +217200,39 @@ and type_expect ?in_function ?recarg env sexp ty_expected =
217200217200
type_expect_ ?in_function ?recarg env sexp ty_expected
217201217201
)
217202217202
in
217203-
let () =
217204-
let rec extractPromise t =
217205-
match t.desc with
217206-
| Tconstr (Pdot (Pdot (Pident {name = "Js"}, "Promise", _), "t", _), [t1], _)
217207-
| Tconstr (Pident {name = "promise"}, [t1], _)
217208-
->
217209-
Some t1
217210-
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractPromise t1
217211-
| _ -> None
217212-
in
217213-
let rec findNestedPromise t =
217214-
match t.desc with
217215-
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> findNestedPromise t1
217216-
| Tconstr (_, ts, _) -> (
217217-
match extractPromise t with
217218-
| Some t1 -> (
217219-
match extractPromise t1 with
217220-
| Some _t2 ->
217221-
let nestedType = Format.asprintf "%a" Printtyp.type_expr t in
217222-
Location.prerr_warning exp.exp_loc (Bs_nested_promise nestedType)
217223-
| None -> ts |> List.iter findNestedPromise)
217224-
| None -> ts |> List.iter findNestedPromise)
217225-
| Tarrow (_, t1, t2, _) ->
217226-
findNestedPromise t1;
217227-
findNestedPromise t2
217228-
| _ -> ()
217229-
in findNestedPromise exp.exp_type
217230-
in
217231-
Cmt_format.set_saved_types
217232-
(Cmt_format.Partial_expression exp :: previous_saved_types);
217203+
checkTypeInvariant exp;
217204+
Cmt_format.set_saved_types
217205+
(Cmt_format.Partial_expression exp :: previous_saved_types);
217233217206
exp
217234217207

217208+
and checkTypeInvariant exp =
217209+
let rec extractPromise t =
217210+
match t.desc with
217211+
| Tconstr (Pdot (Pdot (Pident {name = "Js"}, "Promise", _), "t", _), [t1], _)
217212+
| Tconstr (Pident {name = "promise"}, [t1], _)
217213+
->
217214+
Some t1
217215+
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractPromise t1
217216+
| _ -> None
217217+
in
217218+
let rec findNestedPromise t =
217219+
match t.desc with
217220+
| Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> findNestedPromise t1
217221+
| Tconstr (_, ts, _) -> (
217222+
match extractPromise t with
217223+
| Some t1 -> (
217224+
match extractPromise t1 with
217225+
| Some _t2 ->
217226+
let nestedType = Format.asprintf "%a" Printtyp.type_expr t in
217227+
Location.prerr_warning exp.exp_loc (Bs_nested_promise nestedType)
217228+
| None -> ts |> List.iter findNestedPromise)
217229+
| None -> ts |> List.iter findNestedPromise)
217230+
| Tarrow (_, t1, t2, _) ->
217231+
findNestedPromise t1;
217232+
findNestedPromise t2
217233+
| _ -> ()
217234+
in findNestedPromise exp.exp_type
217235+
217235217236
and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected =
217236217237
let loc = sexp.pexp_loc in
217237217238
(* Record the expression type before unifying it with the expected type *)

0 commit comments

Comments
 (0)