Skip to content

Commit

Permalink
fix(compiler): Correct type approximation on recursive functions (#2154)
Browse files Browse the repository at this point in the history
  • Loading branch information
spotandjake authored Aug 31, 2024
1 parent 36c0bb8 commit b0fb040
Show file tree
Hide file tree
Showing 2 changed files with 54 additions and 3 deletions.
29 changes: 26 additions & 3 deletions compiler/src/typed/typecore.re
Original file line number Diff line number Diff line change
Expand Up @@ -605,7 +605,15 @@ let rec approx_type = (env, sty) =>
| PTyArrow(args, ret) =>
newty(
TTyArrow(
List.map(x => (x.ptyp_arg_label, newvar()), args),
List.map(
x => {
switch (x.ptyp_arg_label) {
| Default(_) => (x.ptyp_arg_label, type_option(newvar()))
| _ => (x.ptyp_arg_label, newvar())
}
},
args,
),
approx_type(env, ret),
TComOk,
),
Expand Down Expand Up @@ -635,7 +643,14 @@ let rec type_approx = (env, sexp: Parsetree.expression) =>
| PExpLambda(args, e) =>
newty(
TTyArrow(
List.map(x => (x.pla_label, newvar()), args),
List.map(
x =>
switch (x.pla_label) {
| Default(_) => (x.pla_label, type_option(newvar()))
| _ => (x.pla_label, newvar())
},
args,
),
type_approx(env, e),
TComOk,
),
Expand Down Expand Up @@ -1862,7 +1877,15 @@ and type_application = (~in_function=?, ~loc, env, funct, sargs) => {
let (ty_args, ty_ret) =
switch (ty_fun.desc) {
| TTyVar(_) =>
let t_args = List.map(arg => (arg.paa_label, newvar()), sargs)
let t_args =
List.map(
arg =>
switch (arg.paa_label) {
| Default(_) => (arg.paa_label, type_option(newvar()))
| _ => (arg.paa_label, newvar())
},
sargs,
)
and t_ret = newvar();
unify(
env,
Expand Down
28 changes: 28 additions & 0 deletions compiler/test/suites/functions.re
Original file line number Diff line number Diff line change
Expand Up @@ -335,6 +335,34 @@ truc()|},
|},
"999\n",
);
assertRun(
"default_args7",
{|
let rec pExp = () => exp(p=0)
and exp = (p=0) => 0
let parse = (s: String) => {
exp(p=0)
}
print(parse("abc"))
|},
"0\n",
);
assertCompileError(
"default_args8",
{|
let rec pExp = () => exp(0)
and exp = (p=0) => 0
let parse = (s: String) => {
exp(0)
}
parse("abc")
|},
"It is called with too many arguments.",
);

assertRun(
"labeled_args_typecheck1",
Expand Down

0 comments on commit b0fb040

Please sign in to comment.