Fix issue with type environments and unified ops.

Fixes #7275

Author: cristianoc

compiler/ml/typecore.ml

@@ -2423,10 +2423,14 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg = Rejected) env sexp
     begin_def ();
     let total_app = not partial in
     let type_clash_context = type_clash_context_from_function sexp sfunct in
+    let _ = translate_unified_ops in
     let args, ty_res, fully_applied =
-      match translate_unified_ops env funct sargs with
-      | Some (targs, result_type) -> (targs, result_type, true)
-      | None -> type_application ?type_clash_context total_app env funct sargs
+      if false then
+        type_application ?type_clash_context total_app env funct sargs
+      else
+        match translate_unified_ops env funct sargs with
+        | Some (targs, result_type) -> (targs, result_type, true)
+        | None -> type_application ?type_clash_context total_app env funct sargs
     in
     end_def ();
     unify_var env (newvar ()) funct.exp_type;
@@ -3379,22 +3383,22 @@ and translate_unified_ops (env : Env.t) (funct : Typedtree.expression)
       let result_type =
         match (lhs_type.desc, specialization) with
         | Tconstr (path, _, _), _ when Path.same path Predef.path_int ->
-          Predef.type_int
+          instance_def Predef.type_int
         | Tconstr (path, _, _), {bool = Some _}
           when Path.same path Predef.path_bool ->
-          Predef.type_bool
+          instance_def Predef.type_bool
         | Tconstr (path, _, _), {float = Some _}
           when Path.same path Predef.path_float ->
-          Predef.type_float
+          instance_def Predef.type_float
         | Tconstr (path, _, _), {bigint = Some _}
           when Path.same path Predef.path_bigint ->
-          Predef.type_bigint
+          instance_def Predef.type_bigint
         | Tconstr (path, _, _), {string = Some _}
           when Path.same path Predef.path_string ->
-          Predef.type_string
+          instance_def Predef.type_string
         | _ ->
-          unify env lhs_type Predef.type_int;
-          Predef.type_int
+          unify env lhs_type (instance_def Predef.type_int);
+          instance_def Predef.type_int
       in
       let targs = [(to_noloc lhs_label, Some lhs)] in
       Some (targs, result_type)
@@ -3409,50 +3413,50 @@ and translate_unified_ops (env : Env.t) (funct : Typedtree.expression)
         match (lhs_type.desc, specialization) with
         | Tconstr (path, _, _), _ when Path.same path Predef.path_int ->
           let rhs = type_expect env rhs_expr Predef.type_int in
-          (lhs, rhs, Predef.type_int)
+          (lhs, rhs, instance_def Predef.type_int)
         | Tconstr (path, _, _), {bool = Some _}
           when Path.same path Predef.path_bool ->
           let rhs = type_expect env rhs_expr Predef.type_bool in
-          (lhs, rhs, Predef.type_bool)
+          (lhs, rhs, instance_def Predef.type_bool)
         | Tconstr (path, _, _), {float = Some _}
           when Path.same path Predef.path_float ->
           let rhs = type_expect env rhs_expr Predef.type_float in
-          (lhs, rhs, Predef.type_float)
+          (lhs, rhs, instance_def Predef.type_float)
         | Tconstr (path, _, _), {bigint = Some _}
           when Path.same path Predef.path_bigint ->
           let rhs = type_expect env rhs_expr Predef.type_bigint in
-          (lhs, rhs, Predef.type_bigint)
+          (lhs, rhs, instance_def Predef.type_bigint)
         | Tconstr (path, _, _), {string = Some _}
           when Path.same path Predef.path_string ->
           let rhs = type_expect env rhs_expr Predef.type_string in
-          (lhs, rhs, Predef.type_string)
+          (lhs, rhs, instance_def Predef.type_string)
         | _ -> (
           (* Rule 2. Try unifying to rhs *)
           match (rhs_type.desc, specialization) with
           | Tconstr (path, _, _), _ when Path.same path Predef.path_int ->
             let lhs = type_expect env lhs_expr Predef.type_int in
-            (lhs, rhs, Predef.type_int)
+            (lhs, rhs, instance_def Predef.type_int)
           | Tconstr (path, _, _), {bool = Some _}
             when Path.same path Predef.path_bool ->
             let lhs = type_expect env lhs_expr Predef.type_bool in
-            (lhs, rhs, Predef.type_bool)
+            (lhs, rhs, instance_def Predef.type_bool)
           | Tconstr (path, _, _), {float = Some _}
             when Path.same path Predef.path_float ->
             let lhs = type_expect env lhs_expr Predef.type_float in
-            (lhs, rhs, Predef.type_float)
+            (lhs, rhs, instance_def Predef.type_float)
           | Tconstr (path, _, _), {bigint = Some _}
             when Path.same path Predef.path_bigint ->
             let lhs = type_expect env lhs_expr Predef.type_bigint in
-            (lhs, rhs, Predef.type_bigint)
+            (lhs, rhs, instance_def Predef.type_bigint)
           | Tconstr (path, _, _), {string = Some _}
             when Path.same path Predef.path_string ->
             let lhs = type_expect env lhs_expr Predef.type_string in
-            (lhs, rhs, Predef.type_string)
+            (lhs, rhs, instance_def Predef.type_string)
           | _ ->
             (* Rule 3. Fallback to int *)
             let lhs = type_expect env lhs_expr Predef.type_int in
             let rhs = type_expect env rhs_expr Predef.type_int in
-            (lhs, rhs, Predef.type_int))
+            (lhs, rhs, instance_def Predef.type_int))
       in
       let targs =
         [(to_noloc lhs_label, Some lhs); (to_noloc rhs_label, Some rhs)]

tests/tests/src/EnvUnifiedOps.mjs

@@ -0,0 +1,18 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+
+function n(x) {
+  return x + 1 | 0;
+}
+
+let X = {
+  n: n
+};
+
+let z = 3;
+
+export {
+  X,
+  z,
+}
+/* No side effect */

tests/tests/src/EnvUnifiedOps.res

@@ -0,0 +1,6 @@
+module X = {
+  type t = int
+  let n: t => t = x => x + 1
+}
+
+let z: X.t = 3