[commit: ghc] master: Move applyTysX near piResultTys (7d5ff3d)

git at git.haskell.org git at git.haskell.org
Thu Mar 24 09:47:59 UTC 2016


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

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

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

commit 7d5ff3d36946d99ba4691344e04dd0328b2c1ef2
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Mon Mar 21 12:51:40 2016 +0000

    Move applyTysX near piResultTys


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

7d5ff3d36946d99ba4691344e04dd0328b2c1ef2
 compiler/types/Type.hs | 24 ++++++++++++------------
 1 file changed, 12 insertions(+), 12 deletions(-)

diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index e3d3c88..c5561a3 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -913,6 +913,18 @@ piResultTys ty orig_args@(arg:args)
       | otherwise
       = pprPanic "piResultTys2" (ppr ty $$ ppr orig_args $$ ppr all_args)
 
+applyTysX :: [TyVar] -> Type -> [Type] -> Type
+-- applyTyxX beta-reduces (/\tvs. body_ty) arg_tys
+-- Assumes that (/\tvs. body_ty) is closed
+applyTysX tvs body_ty arg_tys
+  = ASSERT2( length arg_tys >= n_tvs, pp_stuff )
+    ASSERT2( tyCoVarsOfType body_ty `subVarSet` mkVarSet tvs, pp_stuff )
+    mkAppTys (substTyWith tvs (take n_tvs arg_tys) body_ty)
+             (drop n_tvs arg_tys)
+  where
+    pp_stuff = vcat [ppr tvs, ppr body_ty, ppr arg_tys]
+    n_tvs = length tvs
+
 {-
 ---------------------------------------------------------------------
                                 TyConApp
@@ -1484,18 +1496,6 @@ splitPiTysInvisible ty = split ty ty []
      split orig_ty _ bndrs
        = (reverse bndrs, orig_ty)
 
-applyTysX :: [TyVar] -> Type -> [Type] -> Type
--- applyTyxX beta-reduces (/\tvs. body_ty) arg_tys
--- Assumes that (/\tvs. body_ty) is closed
-applyTysX tvs body_ty arg_tys
-  = ASSERT2( length arg_tys >= n_tvs, pp_stuff )
-    ASSERT2( tyCoVarsOfType body_ty `subVarSet` mkVarSet tvs, pp_stuff )
-    mkAppTys (substTyWith tvs (take n_tvs arg_tys) body_ty)
-             (drop n_tvs arg_tys)
-  where
-    pp_stuff = vcat [ppr tvs, ppr body_ty, ppr arg_tys]
-    n_tvs = length tvs
-
 {-
 %************************************************************************
 %*                                                                      *



More information about the ghc-commits mailing list