[commit: ghc] master: Revert "Build the substitution correctly in piResultTy" (f3b9db3)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/f3b9db31e099836420fbf88eaa36f6fe3d6b85b5/ghc

>---------------------------------------------------------------

commit f3b9db31e099836420fbf88eaa36f6fe3d6b85b5
Author: Bartosz Nitka <niteria at gmail.com>
Date:   Fri Feb 12 06:38:29 2016 -0800

    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


>---------------------------------------------------------------

f3b9db31e099836420fbf88eaa36f6fe3d6b85b5
 compiler/types/Type.hs | 26 ++++++--------------------
 1 file changed, 6 insertions(+), 20 deletions(-)

diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index a649700..67365e3 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