Fix signature matching for externals when abstract alias hides function arity (rescript-lang#8045)

Author: cknitt

CHANGELOG.md

@@ -22,6 +22,7 @@
 
 - Rewatch: warnings for unsupported/unknown rescript.json fields. https://github.com/rescript-lang/rescript/pull/8031
 - Fix missing `ignore` function in some Stdlib modules. https://github.com/rescript-lang/rescript/pull/8060
+- Fix signature matching for externals when abstract alias hides function arity. https://github.com/rescript-lang/rescript/pull/8045
 
 #### :memo: Documentation
 

compiler/ml/includecore.ml

@@ -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 =

compiler/ml/primitive.ml

@@ -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)
 

compiler/ml/primitive.mli

@@ -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 :

tests/tests/src/external_abstract_function_arity.res.mjs

@@ -0,0 +1,9 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+
+let B = {};
+
+export {
+  B,
+}
+/* No side effect */

tests/tests/src/external_abstract_function_arity.res.res

@@ -0,0 +1,11 @@
+// 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"
+}