diff --git a/compiler/src/typed/typecore.re b/compiler/src/typed/typecore.re index 1e14d79a3..76b37d21b 100644 --- a/compiler/src/typed/typecore.re +++ b/compiler/src/typed/typecore.re @@ -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, ), @@ -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, ), @@ -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, diff --git a/compiler/test/suites/functions.re b/compiler/test/suites/functions.re index 0d9f0136e..9524b1d6f 100644 --- a/compiler/test/suites/functions.re +++ b/compiler/test/suites/functions.re @@ -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",