diff --git a/CHANGELOG.md b/CHANGELOG.md index 77ebdd91a9..c3917f4045 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -20,6 +20,7 @@ - Fix async context checking for module await. https://github.com/rescript-lang/rescript/pull/7271 - Fix `%external` extension. https://github.com/rescript-lang/rescript/pull/7272 +- Fix issue with type environment for unified ops. https://github.com/rescript-lang/rescript/pull/7277 # 12.0.0-alpha.8 diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index fc100aa3c9..8e60080d51 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -3379,22 +3379,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 +3409,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)] diff --git a/tests/tests/src/EnvUnifiedOps.mjs b/tests/tests/src/EnvUnifiedOps.mjs new file mode 100644 index 0000000000..1dc7c0f036 --- /dev/null +++ b/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 */ diff --git a/tests/tests/src/EnvUnifiedOps.res b/tests/tests/src/EnvUnifiedOps.res new file mode 100644 index 0000000000..608bb008b1 --- /dev/null +++ b/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