Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,7 @@
#### :bug: Bug fix

- Rewatch: warnings for unsupported/unknown rescript.json fields. https://github.com/rescript-lang/rescript/pull/8031
- Fix external signature inclusion for opaque function types. https://github.com/rescript-lang/rescript/pull/8045

#### :memo: Documentation

Expand Down
18 changes: 18 additions & 0 deletions compiler/ml/includecore.ml
Original file line number Diff line number Diff line change
Expand Up @@ -24,13 +24,31 @@ open Typedtree

exception Dont_match

(* When comparing externals in signatures, re-derive arity/from_constructor from
the value's type so abstract aliases (e.g. opaque function types) don't keep
default zeros stored in the primitive descriptor, which would make equal
externals look different. *)
let normalize_primitive ~env val_type (prim : Primitive.description) =
match Ctype.get_arity env val_type with
| Some prim_arity ->
let prim_from_constructor =
match (Ctype.repr val_type).desc with
| Tconstr _ -> true
| _ -> prim.prim_from_constructor
in
Primitive.with_arity prim ~arity:prim_arity
~from_constructor:prim_from_constructor
| None -> prim

let value_descriptions ~loc env name (vd1 : Types.value_description)
(vd2 : Types.value_description) =
Builtin_attributes.check_deprecated_inclusion ~def:vd1.val_loc
~use:vd2.val_loc loc vd1.val_attributes vd2.val_attributes (Ident.name name);
if Ctype.moregeneral env true vd1.val_type vd2.val_type then
match (vd1.val_kind, vd2.val_kind) with
| Val_prim p1, Val_prim p2 ->
let p1 = normalize_primitive ~env vd1.val_type p1 in
let p2 = normalize_primitive ~env vd2.val_type p2 in
if !Primitive.coerce p1 p2 then Tcoerce_none else raise Dont_match
| Val_prim p, _ ->
let pc =
Expand Down
3 changes: 3 additions & 0 deletions compiler/ml/primitive.ml
Original file line number Diff line number Diff line change
Expand Up @@ -30,6 +30,9 @@ type description = {

let set_transformed_jsx d ~transformed_jsx = {d with transformed_jsx}

let with_arity d ~arity ~from_constructor =
{d with prim_arity = arity; prim_from_constructor = from_constructor}

let coerce : (description -> description -> bool) ref =
ref (fun (p1 : description) (p2 : description) -> p1 = p2)

Expand Down
3 changes: 3 additions & 0 deletions compiler/ml/primitive.mli
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,9 @@ type description = private {

val set_transformed_jsx : description -> transformed_jsx:bool -> description

val with_arity :
description -> arity:int -> from_constructor:bool -> description

(* Invariant [List.length d.prim_native_repr_args = d.prim_arity] *)

val parse_declaration :
Expand Down
9 changes: 9 additions & 0 deletions tests/tests/src/gpr_8038_opaque_external.mjs
Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
// Generated by ReScript, PLEASE EDIT WITH CARE


let B = {};

export {
B,
}
/* No side effect */
10 changes: 10 additions & 0 deletions tests/tests/src/gpr_8038_opaque_external.res
Original file line number Diff line number Diff line change
@@ -0,0 +1,10 @@
/* Regression for https://github.com/rescript-lang/rescript/issues/8038 */
module type A = {
type t
@module external dep: t = "dep"
}

module B: A = {
type t = string => string
@module external dep: t = "dep"
}
Loading