Skip to content

Commit 0561b94

Browse files
bobzhangbobzhang
committed
fix #4762 
1 parent 3a8dbbf commit 0561b94

File tree

5 files changed

+105
-81
lines changed

5 files changed

+105
-81
lines changed

‎jscomp/snapshot.ninja

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,7 @@ SNAP=../lib/$snapshot_path
1818
o snapshot: phony $SNAP/whole_compiler.ml $SNAP/bsb_helper.ml $SNAP/bsb.ml $SNAP/unstable/all_ounit_tests.ml
1919
# $SNAP/bspp.ml
2020
o $SNAP/whole_compiler.ml: bspack | ./bin/bspack.exe $LTO
21-
flags = ${releaseMode} -D BS_ONLY=true -bs-MD -module-alias Config=Config_whole_compiler -bs-exclude-I config -I $OCAML_SRC_UTILS -I $OCAML_SRC_PARSING -I $OCAML_SRC_TYPING -I $OCAML_SRC_BYTECOMP -I $OCAML_SRC_DRIVER ${includes}
21+
flags = ${releaseMode} -D BS_ONLY=true -bs-MD -module-alias Config=Config_whole_compiler -bs-exclude-I config -I $OCAML_SRC_UTILS -I $OCAML_SRC_PARSING -I $OCAML_SRC_TYPING -I $OCAML_SRC_BYTECOMP -I $OCAML_SRC_DRIVER $includes
2222
main = Js_main
2323
post_process = && node $LTO $SNAP/whole_compiler.ml
2424

‎jscomp/syntax/ast_uncurry_apply.ml

Lines changed: 26 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -34,6 +34,17 @@ type exp = Parsetree.expression
3434
let jsInternal =
3535
Ast_literal.Lid.js_internal
3636

37+
(* we use the trick
38+
[( opaque e : _) ] to avoid it being inspected,
39+
the type constraint is avoid some syntactic transformation, e.g ` e |. (f g [@bs])`
40+
`opaque` is to avoid it being inspected in the type level
41+
*)
42+
let opaque_full_apply ~loc (e : exp) : Parsetree.expression_desc =
43+
Pexp_constraint
44+
(Exp.apply ~loc (Exp.ident {txt = Ast_literal.Lid.js_internal_full_apply; loc})
45+
[Nolabel,e],
46+
Typ.any ~loc ()
47+
)
3748
let generic_apply loc
3849
(self : Bs_ast_mapper.mapper)
3950
(obj : Parsetree.expression)
@@ -56,18 +67,15 @@ let generic_apply loc
5667
(Exp.ident {txt = Ldot (jsInternal, "run");loc}, [Nolabel,fn])
5768
else
5869
let arity_s = string_of_int arity in
59-
60-
Parsetree.Pexp_apply (
61-
Exp.ident {txt = Ast_literal.Lid.js_internal_full_apply; loc},
62-
[Nolabel,
63-
Exp.apply ~loc
64-
(Exp.apply ~loc
65-
(Exp.ident ~loc {txt = Ast_literal.Lid.opaque; loc})
66-
[(Nolabel, Exp.field ~loc
67-
(Exp.constraint_ ~loc fn
68-
(Typ.constr ~loc {txt = Ldot (Ast_literal.Lid.js_fn, "arity"^arity_s);loc}
69-
[Typ.any ~loc ()])) {txt = Ast_literal.Lid.hidden_field arity_s; loc})])
70-
args])
70+
opaque_full_apply ~loc (
71+
Exp.apply ~loc
72+
(Exp.apply ~loc
73+
(Exp.ident ~loc {txt = Ast_literal.Lid.opaque; loc})
74+
[(Nolabel, Exp.field ~loc
75+
(Exp.constraint_ ~loc fn
76+
(Typ.constr ~loc {txt = Ldot (Ast_literal.Lid.js_fn, "arity"^arity_s);loc}
77+
[Typ.any ~loc ()])) {txt = Ast_literal.Lid.hidden_field arity_s; loc})])
78+
args)
7179

7280
let method_apply loc
7381
(self : Bs_ast_mapper.mapper)
@@ -91,17 +99,15 @@ let method_apply loc
9199
(Exp.ident {txt = Ldot ((Ldot (Ast_literal.Lid.js_oo,"Internal")), "run");loc}, [Nolabel,fn])
92100
else
93101
let arity_s = string_of_int arity in
94-
Parsetree.Pexp_apply (
95-
Exp.ident {txt = Ast_literal.Lid.js_internal_full_apply; loc},
96-
[Nolabel,
97-
Exp.apply ~loc (
98-
Exp.apply ~loc (Exp.ident ~loc {txt = Ast_literal.Lid.opaque; loc})
99-
[(Nolabel,
102+
opaque_full_apply ~loc (
103+
Exp.apply ~loc (
104+
Exp.apply ~loc (Exp.ident ~loc {txt = Ast_literal.Lid.opaque; loc})
105+
[(Nolabel,
100106
Exp.field ~loc
101107
(Exp.constraint_ ~loc
102-
fn (Typ.constr ~loc {txt = Ldot (Ast_literal.Lid.js_meth,"arity"^arity_s);loc} [Typ.any ~loc ()]))
108+
fn (Typ.constr ~loc {txt = Ldot (Ast_literal.Lid.js_meth,"arity"^arity_s);loc} [Typ.any ~loc ()]))
103109
{loc; txt = Ast_literal.Lid.hidden_field arity_s})])
104-
args])
110+
args)
105111

106112

107113
let uncurry_fn_apply loc self fn args =

‎lib/4.06.1/unstable/js_compiler.ml

Lines changed: 26 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -406218,6 +406218,17 @@ type exp = Parsetree.expression
406218406218
let jsInternal =
406219406219
Ast_literal.Lid.js_internal
406220406220

406221+
(* we use the trick
406222+
[( opaque e : _) ] to avoid it being inspected,
406223+
the type constraint is avoid some syntactic transformation, e.g ` e |. (f g [@bs])`
406224+
`opaque` is to avoid it being inspected in the type level
406225+
*)
406226+
let opaque_full_apply ~loc (e : exp) : Parsetree.expression_desc =
406227+
Pexp_constraint
406228+
(Exp.apply ~loc (Exp.ident {txt = Ast_literal.Lid.js_internal_full_apply; loc})
406229+
[Nolabel,e],
406230+
Typ.any ~loc ()
406231+
)
406221406232
let generic_apply loc
406222406233
(self : Bs_ast_mapper.mapper)
406223406234
(obj : Parsetree.expression)
@@ -406240,18 +406251,15 @@ let generic_apply loc
406240406251
(Exp.ident {txt = Ldot (jsInternal, "run");loc}, [Nolabel,fn])
406241406252
else
406242406253
let arity_s = string_of_int arity in
406243-
406244-
Parsetree.Pexp_apply (
406245-
Exp.ident {txt = Ast_literal.Lid.js_internal_full_apply; loc},
406246-
[Nolabel,
406247-
Exp.apply ~loc
406248-
(Exp.apply ~loc
406249-
(Exp.ident ~loc {txt = Ast_literal.Lid.opaque; loc})
406250-
[(Nolabel, Exp.field ~loc
406251-
(Exp.constraint_ ~loc fn
406252-
(Typ.constr ~loc {txt = Ldot (Ast_literal.Lid.js_fn, "arity"^arity_s);loc}
406253-
[Typ.any ~loc ()])) {txt = Ast_literal.Lid.hidden_field arity_s; loc})])
406254-
args])
406254+
opaque_full_apply ~loc (
406255+
Exp.apply ~loc
406256+
(Exp.apply ~loc
406257+
(Exp.ident ~loc {txt = Ast_literal.Lid.opaque; loc})
406258+
[(Nolabel, Exp.field ~loc
406259+
(Exp.constraint_ ~loc fn
406260+
(Typ.constr ~loc {txt = Ldot (Ast_literal.Lid.js_fn, "arity"^arity_s);loc}
406261+
[Typ.any ~loc ()])) {txt = Ast_literal.Lid.hidden_field arity_s; loc})])
406262+
args)
406255406263

406256406264
let method_apply loc
406257406265
(self : Bs_ast_mapper.mapper)
@@ -406275,17 +406283,15 @@ let method_apply loc
406275406283
(Exp.ident {txt = Ldot ((Ldot (Ast_literal.Lid.js_oo,"Internal")), "run");loc}, [Nolabel,fn])
406276406284
else
406277406285
let arity_s = string_of_int arity in
406278-
Parsetree.Pexp_apply (
406279-
Exp.ident {txt = Ast_literal.Lid.js_internal_full_apply; loc},
406280-
[Nolabel,
406281-
Exp.apply ~loc (
406282-
Exp.apply ~loc (Exp.ident ~loc {txt = Ast_literal.Lid.opaque; loc})
406283-
[(Nolabel,
406286+
opaque_full_apply ~loc (
406287+
Exp.apply ~loc (
406288+
Exp.apply ~loc (Exp.ident ~loc {txt = Ast_literal.Lid.opaque; loc})
406289+
[(Nolabel,
406284406290
Exp.field ~loc
406285406291
(Exp.constraint_ ~loc
406286-
fn (Typ.constr ~loc {txt = Ldot (Ast_literal.Lid.js_meth,"arity"^arity_s);loc} [Typ.any ~loc ()]))
406292+
fn (Typ.constr ~loc {txt = Ldot (Ast_literal.Lid.js_meth,"arity"^arity_s);loc} [Typ.any ~loc ()]))
406287406293
{loc; txt = Ast_literal.Lid.hidden_field arity_s})])
406288-
args])
406294+
args)
406289406295

406290406296

406291406297
let uncurry_fn_apply loc self fn args =

‎lib/4.06.1/unstable/js_refmt_compiler.ml

Lines changed: 26 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -406218,6 +406218,17 @@ type exp = Parsetree.expression
406218406218
let jsInternal =
406219406219
Ast_literal.Lid.js_internal
406220406220

406221+
(* we use the trick
406222+
[( opaque e : _) ] to avoid it being inspected,
406223+
the type constraint is avoid some syntactic transformation, e.g ` e |. (f g [@bs])`
406224+
`opaque` is to avoid it being inspected in the type level
406225+
*)
406226+
let opaque_full_apply ~loc (e : exp) : Parsetree.expression_desc =
406227+
Pexp_constraint
406228+
(Exp.apply ~loc (Exp.ident {txt = Ast_literal.Lid.js_internal_full_apply; loc})
406229+
[Nolabel,e],
406230+
Typ.any ~loc ()
406231+
)
406221406232
let generic_apply loc
406222406233
(self : Bs_ast_mapper.mapper)
406223406234
(obj : Parsetree.expression)
@@ -406240,18 +406251,15 @@ let generic_apply loc
406240406251
(Exp.ident {txt = Ldot (jsInternal, "run");loc}, [Nolabel,fn])
406241406252
else
406242406253
let arity_s = string_of_int arity in
406243-
406244-
Parsetree.Pexp_apply (
406245-
Exp.ident {txt = Ast_literal.Lid.js_internal_full_apply; loc},
406246-
[Nolabel,
406247-
Exp.apply ~loc
406248-
(Exp.apply ~loc
406249-
(Exp.ident ~loc {txt = Ast_literal.Lid.opaque; loc})
406250-
[(Nolabel, Exp.field ~loc
406251-
(Exp.constraint_ ~loc fn
406252-
(Typ.constr ~loc {txt = Ldot (Ast_literal.Lid.js_fn, "arity"^arity_s);loc}
406253-
[Typ.any ~loc ()])) {txt = Ast_literal.Lid.hidden_field arity_s; loc})])
406254-
args])
406254+
opaque_full_apply ~loc (
406255+
Exp.apply ~loc
406256+
(Exp.apply ~loc
406257+
(Exp.ident ~loc {txt = Ast_literal.Lid.opaque; loc})
406258+
[(Nolabel, Exp.field ~loc
406259+
(Exp.constraint_ ~loc fn
406260+
(Typ.constr ~loc {txt = Ldot (Ast_literal.Lid.js_fn, "arity"^arity_s);loc}
406261+
[Typ.any ~loc ()])) {txt = Ast_literal.Lid.hidden_field arity_s; loc})])
406262+
args)
406255406263

406256406264
let method_apply loc
406257406265
(self : Bs_ast_mapper.mapper)
@@ -406275,17 +406283,15 @@ let method_apply loc
406275406283
(Exp.ident {txt = Ldot ((Ldot (Ast_literal.Lid.js_oo,"Internal")), "run");loc}, [Nolabel,fn])
406276406284
else
406277406285
let arity_s = string_of_int arity in
406278-
Parsetree.Pexp_apply (
406279-
Exp.ident {txt = Ast_literal.Lid.js_internal_full_apply; loc},
406280-
[Nolabel,
406281-
Exp.apply ~loc (
406282-
Exp.apply ~loc (Exp.ident ~loc {txt = Ast_literal.Lid.opaque; loc})
406283-
[(Nolabel,
406286+
opaque_full_apply ~loc (
406287+
Exp.apply ~loc (
406288+
Exp.apply ~loc (Exp.ident ~loc {txt = Ast_literal.Lid.opaque; loc})
406289+
[(Nolabel,
406284406290
Exp.field ~loc
406285406291
(Exp.constraint_ ~loc
406286-
fn (Typ.constr ~loc {txt = Ldot (Ast_literal.Lid.js_meth,"arity"^arity_s);loc} [Typ.any ~loc ()]))
406292+
fn (Typ.constr ~loc {txt = Ldot (Ast_literal.Lid.js_meth,"arity"^arity_s);loc} [Typ.any ~loc ()]))
406287406293
{loc; txt = Ast_literal.Lid.hidden_field arity_s})])
406288-
args])
406294+
args)
406289406295

406290406296

406291406297
let uncurry_fn_apply loc self fn args =

‎lib/4.06.1/whole_compiler.ml

Lines changed: 26 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -409111,6 +409111,17 @@ type exp = Parsetree.expression
409111409111
let jsInternal =
409112409112
Ast_literal.Lid.js_internal
409113409113

409114+
(* we use the trick
409115+
[( opaque e : _) ] to avoid it being inspected,
409116+
the type constraint is avoid some syntactic transformation, e.g ` e |. (f g [@bs])`
409117+
`opaque` is to avoid it being inspected in the type level
409118+
*)
409119+
let opaque_full_apply ~loc (e : exp) : Parsetree.expression_desc =
409120+
Pexp_constraint
409121+
(Exp.apply ~loc (Exp.ident {txt = Ast_literal.Lid.js_internal_full_apply; loc})
409122+
[Nolabel,e],
409123+
Typ.any ~loc ()
409124+
)
409114409125
let generic_apply loc
409115409126
(self : Bs_ast_mapper.mapper)
409116409127
(obj : Parsetree.expression)
@@ -409133,18 +409144,15 @@ let generic_apply loc
409133409144
(Exp.ident {txt = Ldot (jsInternal, "run");loc}, [Nolabel,fn])
409134409145
else
409135409146
let arity_s = string_of_int arity in
409136-
409137-
Parsetree.Pexp_apply (
409138-
Exp.ident {txt = Ast_literal.Lid.js_internal_full_apply; loc},
409139-
[Nolabel,
409140-
Exp.apply ~loc
409141-
(Exp.apply ~loc
409142-
(Exp.ident ~loc {txt = Ast_literal.Lid.opaque; loc})
409143-
[(Nolabel, Exp.field ~loc
409144-
(Exp.constraint_ ~loc fn
409145-
(Typ.constr ~loc {txt = Ldot (Ast_literal.Lid.js_fn, "arity"^arity_s);loc}
409146-
[Typ.any ~loc ()])) {txt = Ast_literal.Lid.hidden_field arity_s; loc})])
409147-
args])
409147+
opaque_full_apply ~loc (
409148+
Exp.apply ~loc
409149+
(Exp.apply ~loc
409150+
(Exp.ident ~loc {txt = Ast_literal.Lid.opaque; loc})
409151+
[(Nolabel, Exp.field ~loc
409152+
(Exp.constraint_ ~loc fn
409153+
(Typ.constr ~loc {txt = Ldot (Ast_literal.Lid.js_fn, "arity"^arity_s);loc}
409154+
[Typ.any ~loc ()])) {txt = Ast_literal.Lid.hidden_field arity_s; loc})])
409155+
args)
409148409156

409149409157
let method_apply loc
409150409158
(self : Bs_ast_mapper.mapper)
@@ -409168,17 +409176,15 @@ let method_apply loc
409168409176
(Exp.ident {txt = Ldot ((Ldot (Ast_literal.Lid.js_oo,"Internal")), "run");loc}, [Nolabel,fn])
409169409177
else
409170409178
let arity_s = string_of_int arity in
409171-
Parsetree.Pexp_apply (
409172-
Exp.ident {txt = Ast_literal.Lid.js_internal_full_apply; loc},
409173-
[Nolabel,
409174-
Exp.apply ~loc (
409175-
Exp.apply ~loc (Exp.ident ~loc {txt = Ast_literal.Lid.opaque; loc})
409176-
[(Nolabel,
409179+
opaque_full_apply ~loc (
409180+
Exp.apply ~loc (
409181+
Exp.apply ~loc (Exp.ident ~loc {txt = Ast_literal.Lid.opaque; loc})
409182+
[(Nolabel,
409177409183
Exp.field ~loc
409178409184
(Exp.constraint_ ~loc
409179-
fn (Typ.constr ~loc {txt = Ldot (Ast_literal.Lid.js_meth,"arity"^arity_s);loc} [Typ.any ~loc ()]))
409185+
fn (Typ.constr ~loc {txt = Ldot (Ast_literal.Lid.js_meth,"arity"^arity_s);loc} [Typ.any ~loc ()]))
409180409186
{loc; txt = Ast_literal.Lid.hidden_field arity_s})])
409181-
args])
409187+
args)
409182409188

409183409189

409184409190
let uncurry_fn_apply loc self fn args =

0 commit comments

Comments
 (0)