-- No left-right shadowing
-- ie the substitution for (\x \y. e) a1 a2
-- so neither x nor y scope over a1 a2
-mkOpenSubst :: [(Var,CoreArg)] -> Subst
-mkOpenSubst pairs = Subst (mkInScopeSet (exprsFreeVars (map snd pairs)))
- (mkVarEnv [(id,e) | (id, e) <- pairs, isId id])
- (mkVarEnv [(tv,ty) | (tv, Type ty) <- pairs])
+mkOpenSubst :: InScopeSet -> [(Var,CoreArg)] -> Subst
+mkOpenSubst in_scope pairs = Subst in_scope
+ (mkVarEnv [(id,e) | (id, e) <- pairs, isId id])
+ (mkVarEnv [(tv,ty) | (tv, Type ty) <- pairs])
------------------------------
isInScope :: Var -> Subst -> Bool
import PprCore () -- Instances
import OccurAnal
import CoreSubst hiding( substTy )
+import CoreFVs ( exprFreeVars )
import CoreUtils
import Id
import DataCon
import Type
import Coercion
import PrelNames
+import VarEnv ( mkInScopeSet )
import Bag
import Util
import FastTypes
analyse _ _ = Nothing
-----------
+ in_scope = mkInScopeSet (exprFreeVars expr)
+
+ -----------
beta (Lam v body) pairs (arg : args)
| isTypeArg arg
= beta body ((v,arg):pairs) args
= Nothing
beta fun pairs args
- = case analyse (substExpr (mkOpenSubst pairs) fun) args of
+ = case analyse (substExpr subst fun) args of
Nothing -> -- pprTrace "Bale out! exprIsConApp_maybe" doc $
Nothing
Just ans -> -- pprTrace "Woo-hoo! exprIsConApp_maybe" doc $
Just ans
where
+ subst = mkOpenSubst in_scope pairs
-- doc = vcat [ppr fun, ppr expr, ppr pairs, ppr args]