substTyWith, substTy, substTheta, deShadowTy,
-- Expression stuff
- substExpr
+ substExpr, substRules
) where
#include "HsVersions.h"
-- it'll never be evaluated
mkTyVarSubst :: [TyVar] -> [Type] -> Subst
mkTyVarSubst tyvars tys = Subst (mkInScopeSet (tyVarsOfTypes tys))
- (zip_ty_env tyvars tys emptySubstEnv)
+ (zipTyEnv tyvars tys)
-- mkTopTyVarSubst is called when doing top-level substitutions.
-- Here we expect that the free vars of the range of the
-- substitution will be empty.
mkTopTyVarSubst :: [TyVar] -> [Type] -> Subst
-mkTopTyVarSubst tyvars tys = Subst emptyInScopeSet (zip_ty_env tyvars tys emptySubstEnv)
+mkTopTyVarSubst tyvars tys = Subst emptyInScopeSet (zipTyEnv tyvars tys)
+
+zipTyEnv tyvars tys
+#ifdef DEBUG
+ | length tyvars /= length tys
+ = pprTrace "mkTopTyVarSubst" (ppr tyvars $$ ppr tys) emptySubstEnv
+ | otherwise
+#endif
+ = zip_ty_env tyvars tys emptySubstEnv
zip_ty_env [] [] env = env
zip_ty_env (tv:tvs) (ty:tys) env = zip_ty_env tvs tys (extendSubstEnv env tv (DoneTy ty))
| otherwise = Just (info `setOccInfo` (if zap_occ then NoOccInfo else old_occ)
`setSpecInfo` substRules subst old_rules
`setWorkerInfo` substWorker subst old_wrkr
- `setLBVarInfo` substLBVar subst old_lbv
`setUnfoldingInfo` noUnfolding)
-- setSpecInfo does a seq
-- setWorkerInfo does a seq
nothing_to_do = not zap_occ &&
isEmptyCoreRules old_rules &&
not (workerExists old_wrkr) &&
- hasNoLBVarInfo old_lbv &&
not (hasUnfolding (unfoldingInfo info))
zap_occ = is_fragile_occ old_occ
old_occ = occInfo info
old_rules = specInfo info
old_wrkr = workerInfo info
- old_lbv = lbvarInfo info
------------------
substIdType :: Subst -> Id -> Id
DoneEx expr -> exprFreeVars expr
DoneTy ty -> tyVarsOfType ty
ContEx se' expr -> substVarSet (setSubstEnv subst se') (exprFreeVars expr)
-
-------------------
-substLBVar subst NoLBVarInfo = NoLBVarInfo
-substLBVar subst (LBVarInfo ty) = ty1 `seq` LBVarInfo ty1
- where
- ty1 = substTy subst ty
\end{code}