diff options
author | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2020-12-17 02:36:31 +0100 |
---|---|---|
committer | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2021-01-22 20:31:44 +0100 |
commit | 9387c263aa844bc57cdeb0b989cd412fb6cc5308 (patch) | |
tree | cc41e65f21aa3309ad2f24021be9e819bcd0e100 /compiler | |
parent | db497d5fb2571e0ab78858dbc124e88523b444f6 (diff) | |
download | haskell-wip/linear-backports-9.0.tar.gz |
Improve inference with linear typeswip/linear-backports-9.0
This fixes test Linear14. The code in Unify.hs was always using
multiplicity Many instead of a new metavariable.
(cherry picked from commit 65721691ce9c4107d1cf84ad131bf167a9e42a7d)
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) |