diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/GHC/Tc/Utils/Unify.hs | 13 |
1 files changed, 7 insertions, 6 deletions
diff --git a/compiler/GHC/Tc/Utils/Unify.hs b/compiler/GHC/Tc/Utils/Unify.hs index bf933127b8..f11c160ebe 100644 --- a/compiler/GHC/Tc/Utils/Unify.hs +++ b/compiler/GHC/Tc/Utils/Unify.hs @@ -212,12 +212,12 @@ matchExpectedFunTys herald ctx arity orig_ty thing_inside ------------ defer :: [Scaled ExpSigmaType] -> Arity -> ExpRhoType -> TcM (HsWrapper, a) defer acc_arg_tys n fun_ty - = do { more_arg_tys <- replicateM n newInferExpType + = do { more_arg_tys <- replicateM n (mkScaled <$> newFlexiTyVarTy multiplicityTy <*> newInferExpType) ; res_ty <- newInferExpType - ; result <- thing_inside (reverse acc_arg_tys ++ (map unrestricted more_arg_tys)) res_ty - ; more_arg_tys <- mapM readExpType more_arg_tys + ; result <- thing_inside (reverse acc_arg_tys ++ more_arg_tys) res_ty + ; more_arg_tys <- mapM (\(Scaled m t) -> Scaled m <$> readExpType t) more_arg_tys ; res_ty <- readExpType res_ty - ; let unif_fun_ty = mkVisFunTysMany more_arg_tys res_ty + ; let unif_fun_ty = mkVisFunTys more_arg_tys res_ty ; wrap <- tcSubType AppOrigin ctx unif_fun_ty fun_ty -- Not a good origin at all :-( ; return (wrap, result) } @@ -339,9 +339,10 @@ matchActualFunTySigma herald ct_orig mb_thing err_info fun_ty defer fun_ty = do { arg_ty <- newOpenFlexiTyVarTy ; res_ty <- newOpenFlexiTyVarTy - ; let unif_fun_ty = mkVisFunTyMany arg_ty res_ty + ; mult <- newFlexiTyVarTy multiplicityTy + ; let unif_fun_ty = mkVisFunTy mult arg_ty res_ty ; co <- unifyType mb_thing fun_ty unif_fun_ty - ; return (mkWpCastN co, unrestricted arg_ty, res_ty) } + ; return (mkWpCastN co, Scaled mult arg_ty, res_ty) } ------------ mk_ctxt :: TcType -> TidyEnv -> TcM (TidyEnv, MsgDoc) |