diff options
author | Bartosz Nitka <niteria@gmail.com> | 2016-02-12 06:38:29 -0800 |
---|---|---|
committer | Bartosz Nitka <niteria@gmail.com> | 2016-02-12 06:54:10 -0800 |
commit | f3b9db31e099836420fbf88eaa36f6fe3d6b85b5 (patch) | |
tree | 356c2d9dc13aee210d5de33ad87fa16e30d8ec94 | |
parent | be3d7f661968a7b8c6751c0be3bf23e703b32c3e (diff) | |
download | haskell-f3b9db31e099836420fbf88eaa36f6fe3d6b85b5.tar.gz |
Revert "Build the substitution correctly in piResultTy"
This reverts commit dbf72dbc6e49b3db7f2337a7a41e95c1d0169163.
This commit introduced performance regressions:
https://ghc.haskell.org/trac/ghc/ticket/11371#comment:27,
I will push it again after I fix it.
Test Plan: revert
Reviewers: simonpj, bgamari, simonmar, austin, goldfire, thomie
Differential Revision: https://phabricator.haskell.org/D1907
-rw-r--r-- | compiler/types/Type.hs | 26 |
1 files changed, 6 insertions, 20 deletions
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs index a6497004d4..67365e3622 100644 --- a/compiler/types/Type.hs +++ b/compiler/types/Type.hs @@ -801,29 +801,15 @@ funResultTy ty = piResultTy ty (pprPanic "funResultTy" (ppr ty)) -- | Essentially 'funResultTy' on kinds handling pi-types too piResultTy :: Type -> Type -> Type -piResultTy ty arg = piResultTys ty [arg] +piResultTy ty arg | Just ty' <- coreView ty = piResultTy ty' arg +piResultTy (ForAllTy (Anon _) res) _ = res +piResultTy (ForAllTy (Named tv _) res) arg = substTyWithUnchecked [tv] [arg] res +piResultTy ty arg = pprPanic "piResultTy" + (ppr ty $$ ppr arg) -- | Fold 'piResultTy' over many types piResultTys :: Type -> [Type] -> Type -piResultTys ty args = go empty_subst ty args - where - empty_subst = mkEmptyTCvSubst (mkInScopeSet $ tyCoVarsOfTypes (ty:args)) - -- The free vars of 'ty' and 'args' need to be in scope to satisfy the - -- invariant in Note [The substitution invariant] in TyCoRep. - - go subst ty [] = substTy subst ty - go subst ty args@(arg:args') - | Just (bndr, res) <- splitPiTy_maybe ty - = case bndr of - Anon _ -> go subst res args' - Named tv _ -> go (extendTCvSubst subst tv arg) res args' - - | Just tv <- getTyVar_maybe ty - -- Deals with piResultTys (forall a. a) [forall b.b, Int] - = go empty_subst (substTyVar subst tv) args - - | otherwise - = panic "piResultTys" +piResultTys = foldl piResultTy funArgTy :: Type -> Type -- ^ Extract the function argument type and panic if that is not possible |