[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