fixup! wip: Fix checking intersection-typed function calls

josefs · Feb 2, 2023 · 8c23d6c · 8c23d6c
1 parent d5b9ca7
commit 8c23d6c
Showing 1 changed file with 39 additions and 10 deletions.
diff --git a/src/typechecker.erl b/src/typechecker.erl
@@ -2203,8 +2203,8 @@ type_check_call_ty(Env, {fun_ty, ArgsTy, ResTy, Cs}, Args, E) ->
             P = element(2, E),
             throw(argument_length_mismatch(P, arity(LenTy), arity(LenArgs)))
     end;
-type_check_call_ty(Env, {fun_ty_intersection, Tyss, Cs}, Args, E) ->
-    {ResTy, VarBinds, CsI} = type_check_call_ty_intersect(Env, Tyss, Args, E),
+type_check_call_ty(Env, {fun_ty_intersection, ClauseTys, Cs}, Args, E) ->
+    {ResTy, VarBinds, CsI} = type_check_call_ty_intersect(Env, ClauseTys, Args, E),
     {ResTy, VarBinds, constraints:combine(Cs, CsI)};
 type_check_call_ty(Env, {fun_ty_union, Tyss, Cs}, Args, E) ->
     {ResTy, VarBinds, CsI} = type_check_call_ty_union(Env, Tyss, Args, E),
@@ -2213,18 +2213,47 @@ type_check_call_ty(_Env, {type_error, _}, _Args, {Name, _P, FunTy}) ->
     throw(type_error(Name, FunTy, type('fun'))).
 
 -spec type_check_call_ty_intersect(env(), _, _, _) -> {type(), env(), constraints:t()}.
-type_check_call_ty_intersect(Env, [], Args, {Name, P, FunTy}) ->
-    throw(type_error(call_intersect, P, Name, FunTy, infer_arg_types(Args, Env)));
-type_check_call_ty_intersect(Env, [Ty | Tys], Args, E) ->
-    try
-        type_check_call_ty(Env, Ty, Args, E)
-    catch
-        Error when element(1,Error) == type_error ->
-            type_check_call_ty_intersect(Env, Tys, Args, E)
+type_check_call_ty_intersect(Env, ClauseTys, Args, E = {Name, P, FunTy}) ->
+    check_call_arity(hd(ClauseTys), Args, E),
+    MatchingClausesCss = lists:foldr(fun ({fun_ty, ClauseArgTys, _, _} = Clause, Acc) ->
+                                             case args_match_clause(Args, ClauseArgTys, Env) of
+                                                 {true, Cs} ->
+                                                     [{Clause, Cs} | Acc];
+                                                 false ->
+                                                     Acc
+                                             end
+                                     end, [], ClauseTys),
+    case MatchingClausesCss of
+        [_|_] ->
+            {MatchingClauses, Css} = lists:unzip(MatchingClausesCss),
+            ResTys = [ ResTy || {fun_ty, _, ResTy, _} <- MatchingClauses ],
+            {lub(ResTys, Env), Env, constraints:combine(Css)};
+        [] ->
+            throw(type_error(call_intersect, P, Name, FunTy, infer_arg_types(Args, Env)))
     end.
 
+-spec args_match_clause(_, [type()], env()) -> {true, constraints:t()} | false.
+args_match_clause(Args, ClauseArgTys, Env) ->
+    lists:foldl(fun ({_Arg, _ClauseArgTy}, false) ->
+                        false;
+                    ({Arg, ClauseArgTy}, {true, AccCs}) ->
+                        Subtype = case infer_arg_types([Arg], Env) of
+                                      [?type(union, Tys)] ->
+                                          any_subtype(Tys, ClauseArgTy, Env);
+                                      [Ty] ->
+                                          subtype(Ty, ClauseArgTy, Env)
+                                  end,
+                        case Subtype of
+                            {true, Cs} ->
+                                {true, constraints:combine(Cs, AccCs)};
+                            false ->
+                                false
+                        end
+                end, {true, constraints:empty()}, lists:zip(Args, ClauseArgTys)).
+
 -spec infer_arg_types([expr()], env()) -> [type()].
 infer_arg_types(Args, Env) ->
+    %% TODO: don't drop the constraints
     lists:map(fun (Arg) ->
                       {ArgTy, _VB, _Cs} = type_check_expr(Env#env{infer = true}, Arg),
                       ArgTy