Commit f3b9db31 authored by niteria's avatar niteria

Revert "Build the substitution correctly in piResultTy"

This reverts commit dbf72dbc.
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
parent be3d7f66
...@@ -801,29 +801,15 @@ funResultTy ty = piResultTy ty (pprPanic "funResultTy" (ppr ty)) ...@@ -801,29 +801,15 @@ funResultTy ty = piResultTy ty (pprPanic "funResultTy" (ppr ty))
-- | Essentially 'funResultTy' on kinds handling pi-types too -- | Essentially 'funResultTy' on kinds handling pi-types too
piResultTy :: Type -> Type -> Type 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 -- | Fold 'piResultTy' over many types
piResultTys :: Type -> [Type] -> Type piResultTys :: Type -> [Type] -> Type
piResultTys ty args = go empty_subst ty args piResultTys = foldl piResultTy
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"
funArgTy :: Type -> Type funArgTy :: Type -> Type
-- ^ Extract the function argument type and panic if that is not possible -- ^ Extract the function argument type and panic if that is not possible
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment