ghc/compiler/coreSyn/CoreFVs.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 Taken quite directly from the Peyton Jones/Lester paper.
   5
   6 \begin{code}
   7 module CoreFVs (
   8         isLocalVar, mustHaveLocalBinding,
   9
  10         exprFreeVars,   -- CoreExpr -> VarSet   -- Find all locally-defined free Ids or tyvars
  11         exprsFreeVars,  -- [CoreExpr] -> VarSet
  12
  13         exprSomeFreeVars, exprsSomeFreeVars,
  14
  15         idRuleVars, idFreeVars, idFreeTyVars,
  16         ruleSomeFreeVars, ruleSomeLhsFreeVars, ruleRhsFreeVars,
  17
  18         CoreExprWithFVs,        -- = AnnExpr Id VarSet
  19         CoreBindWithFVs,        -- = AnnBind Id VarSet
  20         freeVars,               -- CoreExpr -> CoreExprWithFVs
  21         freeVarsOf              -- CoreExprWithFVs -> IdSet
  22     ) where
  23
  24 #include "HsVersions.h"
  25
  26 import CoreSyn
  27 import Id               ( Id, idType, isLocalId, hasNoBinding, idSpecialisation )
  28 import VarSet
  29 import Var              ( Var, isId )
  30 import Type             ( tyVarsOfType )
  31 import Util             ( mapAndUnzip )
  32 import Outputable
  33 \end{code}
  34
  35
  36 %************************************************************************
  37 %*                                                                      *
  38 \subsection{isLocalVar}
  39 %*                                                                      *
  40 %************************************************************************
  41
  42 @isLocalVar@ returns True of all TyVars, and of Ids that are defined in
  43 this module and are not constants like data constructors and record selectors.
  44 These are the variables that we need to pay attention to when finding free
  45 variables, or doing dependency analysis.
  46
  47 \begin{code}
  48 isLocalVar :: Var -> Bool
  49 isLocalVar v = isTyVar v || isLocalId v
  50 \end{code}
  51
  52 \begin{code}
  53 mustHaveLocalBinding :: Var -> Bool
  54 -- True <=> the variable must have a binding in this module
  55 mustHaveLocalBinding v = isTyVar v || (isLocalId v && not (hasNoBinding v))
  56 \end{code}
  57
  58
  59 %************************************************************************
  60 %*                                                                      *
  61 \section{Finding the free variables of an expression}
  62 %*                                                                      *
  63 %************************************************************************
  64
  65 This function simply finds the free variables of an expression.
  66 So far as type variables are concerned, it only finds tyvars that are
  67
  68         * free in type arguments,
  69         * free in the type of a binder,
  70
  71 but not those that are free in the type of variable occurrence.
  72
  73 \begin{code}
  74 exprFreeVars :: CoreExpr -> VarSet      -- Find all locally-defined free Ids or tyvars
  75 exprFreeVars = exprSomeFreeVars isLocalVar
  76
  77 exprsFreeVars :: [CoreExpr] -> VarSet
  78 exprsFreeVars = foldr (unionVarSet . exprFreeVars) emptyVarSet
  79
  80 exprSomeFreeVars :: InterestingVarFun   -- Says which Vars are interesting
  81                  -> CoreExpr
  82                  -> VarSet
  83 exprSomeFreeVars fv_cand e = expr_fvs e fv_cand emptyVarSet
  84
  85 exprsSomeFreeVars :: InterestingVarFun  -- Says which Vars are interesting
  86                   -> [CoreExpr]
  87                   -> VarSet
  88 exprsSomeFreeVars fv_cand = foldr (unionVarSet . exprSomeFreeVars fv_cand) emptyVarSet
  89
  90 type InterestingVarFun = Var -> Bool    -- True <=> interesting
  91 \end{code}
  92
  93
  94 \begin{code}
  95 type FV = InterestingVarFun
  96           -> VarSet             -- In scope
  97           -> VarSet             -- Free vars
  98
  99 union :: FV -> FV -> FV
 100 union fv1 fv2 fv_cand in_scope = fv1 fv_cand in_scope `unionVarSet` fv2 fv_cand in_scope
 101
 102 noVars :: FV
 103 noVars fv_cand in_scope = emptyVarSet
 104
 105 -- At a variable occurrence, add in any free variables of its rule rhss
 106 -- Curiously, we gather the Id's free *type* variables from its binding
 107 -- site, but its free *rule-rhs* variables from its usage sites.  This
 108 -- is a little weird.  The reason is that the former is more efficient,
 109 -- but the latter is more fine grained, and a makes a difference when
 110 -- a variable mentions itself one of its own rule RHSs
 111 oneVar :: Id -> FV
 112 oneVar var fv_cand in_scope
 113   = ASSERT( isId var )
 114     foldVarSet add_rule_var var_itself_set (idRuleVars var)
 115   where
 116     var_itself_set | keep_it fv_cand in_scope var = unitVarSet var
 117                    | otherwise                = emptyVarSet
 118     add_rule_var var set | keep_it fv_cand in_scope var = extendVarSet set var
 119                          | otherwise                    = set
 120
 121 someVars :: VarSet -> FV
 122 someVars vars fv_cand in_scope
 123   = filterVarSet (keep_it fv_cand in_scope) vars
 124
 125 keep_it fv_cand in_scope var
 126   | var `elemVarSet` in_scope = False
 127   | fv_cand var               = True
 128   | otherwise                 = False
 129
 130
 131 addBndr :: CoreBndr -> FV -> FV
 132 addBndr bndr fv fv_cand in_scope
 133   | isId bndr = inside_fvs `unionVarSet` someVars (idFreeTyVars bndr) fv_cand in_scope
 134   | otherwise = inside_fvs
 135   where
 136     inside_fvs = fv fv_cand (in_scope `extendVarSet` bndr)
 137
 138 addBndrs :: [CoreBndr] -> FV -> FV
 139 addBndrs bndrs fv = foldr addBndr fv bndrs
 140 \end{code}
 141
 142
 143 \begin{code}
 144 expr_fvs :: CoreExpr -> FV
 145
 146 expr_fvs (Type ty)       = someVars (tyVarsOfType ty)
 147 expr_fvs (Var var)       = oneVar var
 148 expr_fvs (Lit lit)       = noVars
 149 expr_fvs (Note _ expr)   = expr_fvs expr
 150 expr_fvs (App fun arg)   = expr_fvs fun `union` expr_fvs arg
 151 expr_fvs (Lam bndr body) = addBndr bndr (expr_fvs body)
 152
 153 expr_fvs (Case scrut bndr alts)
 154   = expr_fvs scrut `union` addBndr bndr (foldr (union . alt_fvs) noVars alts)
 155   where
 156     alt_fvs (con, bndrs, rhs) = addBndrs bndrs (expr_fvs rhs)
 157
 158 expr_fvs (Let (NonRec bndr rhs) body)
 159   = expr_fvs rhs `union` addBndr bndr (expr_fvs body)
 160
 161 expr_fvs (Let (Rec pairs) body)
 162   = addBndrs bndrs (foldr (union . expr_fvs) (expr_fvs body) rhss)
 163   where
 164     (bndrs,rhss) = unzip pairs
 165 \end{code}
 166
 167
 168
 169 \begin{code}
 170 rulesSomeFreeVars :: InterestingVarFun -> CoreRules -> VarSet
 171 rulesSomeFreeVars interesting (Rules rules _)
 172   = foldr (unionVarSet . ruleSomeFreeVars interesting) emptyVarSet rules
 173
 174 ruleRhsFreeVars :: CoreRule -> VarSet
 175 ruleRhsFreeVars (BuiltinRule _) = noFVs
 176 ruleRhsFreeVars (Rule str tpl_vars tpl_args rhs)
 177   = rule_fvs isLocalVar emptyVarSet
 178   where
 179     rule_fvs = addBndrs tpl_vars (expr_fvs rhs)
 180
 181 ruleSomeFreeVars :: InterestingVarFun -> CoreRule -> VarSet
 182 ruleSomeFreeVars interesting (BuiltinRule _) = noFVs
 183 ruleSomeFreeVars interesting (Rule _ tpl_vars tpl_args rhs)
 184   = rule_fvs interesting emptyVarSet
 185   where
 186     rule_fvs = addBndrs tpl_vars $
 187                foldr (union . expr_fvs) (expr_fvs rhs) tpl_args
 188
 189 ruleSomeLhsFreeVars :: InterestingVarFun -> CoreRule -> VarSet
 190 ruleSomeLhsFreeVars fn (BuiltinRule _) = noFVs
 191 ruleSomeLhsFreeVars fn (Rule _ tpl_vars tpl_args rhs)
 192   = foldl delVarSet (exprsSomeFreeVars fn tpl_args) tpl_vars
 193 \end{code}
 194
 195
 196 %************************************************************************
 197 %*                                                                      *
 198 \section[freevars-everywhere]{Attaching free variables to every sub-expression}
 199 %*                                                                      *
 200 %************************************************************************
 201
 202 The free variable pass annotates every node in the expression with its
 203 NON-GLOBAL free variables and type variables.
 204
 205 \begin{code}
 206 type CoreBindWithFVs = AnnBind Id VarSet
 207 type CoreExprWithFVs = AnnExpr Id VarSet
 208         -- Every node annotated with its free variables,
 209         -- both Ids and TyVars
 210
 211 freeVarsOf :: CoreExprWithFVs -> IdSet
 212 freeVarsOf (free_vars, _) = free_vars
 213
 214 noFVs    = emptyVarSet
 215 aFreeVar = unitVarSet
 216 unionFVs = unionVarSet
 217
 218 delBindersFV :: [Var] -> VarSet -> VarSet
 219 delBindersFV bs fvs = foldr delBinderFV fvs bs
 220
 221 delBinderFV :: Var -> VarSet -> VarSet
 222 -- This way round, so we can do it multiple times using foldr
 223
 224 -- (b `delBinderFV` s) removes the binder b from the free variable set s,
 225 -- but *adds* to s
 226 --      (a) the free variables of b's type
 227 --      (b) the idSpecVars of b
 228 --
 229 -- This is really important for some lambdas:
 230 --      In (\x::a -> x) the only mention of "a" is in the binder.
 231 --
 232 -- Also in
 233 --      let x::a = b in ...
 234 -- we should really note that "a" is free in this expression.
 235 -- It'll be pinned inside the /\a by the binding for b, but
 236 -- it seems cleaner to make sure that a is in the free-var set
 237 -- when it is mentioned.
 238 --
 239 -- This also shows up in recursive bindings.  Consider:
 240 --      /\a -> letrec x::a = x in E
 241 -- Now, there are no explicit free type variables in the RHS of x,
 242 -- but nevertheless "a" is free in its definition.  So we add in
 243 -- the free tyvars of the types of the binders, and include these in the
 244 -- free vars of the group, attached to the top level of each RHS.
 245 --
 246 -- This actually happened in the defn of errorIO in IOBase.lhs:
 247 --      errorIO (ST io) = case (errorIO# io) of
 248 --                          _ -> bottom
 249 --                        where
 250 --                          bottom = bottom -- Never evaluated
 251
 252 delBinderFV b s | isId b    = (s `delVarSet` b) `unionFVs` idFreeVars b
 253                 | otherwise = s `delVarSet` b
 254
 255 idFreeVars :: Id -> VarSet
 256 idFreeVars id = ASSERT( isId id) idRuleVars id `unionVarSet` idFreeTyVars id
 257
 258 idFreeTyVars :: Id -> TyVarSet
 259 -- Only local Ids conjured up locally, can have free type variables.
 260 -- (During type checking top-level Ids can have free tyvars)
 261 idFreeTyVars id = tyVarsOfType (idType id)
 262 -- | isLocalId id = tyVarsOfType (idType id)
 263 -- | otherwise    = emptyVarSet
 264
 265 idRuleVars ::Id -> VarSet
 266 idRuleVars id = ASSERT( isId id) rulesRhsFreeVars (idSpecialisation id)
 267 \end{code}
 268
 269
 270 %************************************************************************
 271 %*                                                                      *
 272 \subsection{Free variables (and types)}
 273 %*                                                                      *
 274 %************************************************************************
 275
 276 \begin{code}
 277 freeVars :: CoreExpr -> CoreExprWithFVs
 278
 279 freeVars (Var v)
 280   = (fvs, AnnVar v)
 281   where
 282         -- ToDo: insert motivating example for why we *need*
 283         -- to include the idSpecVars in the FV list.
 284         --      Actually [June 98] I don't think it's necessary
 285         -- fvs = fvs_v `unionVarSet` idSpecVars v
 286
 287     fvs | isLocalVar v = aFreeVar v
 288         | otherwise    = noFVs
 289
 290 freeVars (Lit lit) = (noFVs, AnnLit lit)
 291 freeVars (Lam b body)
 292   = (b `delBinderFV` freeVarsOf body', AnnLam b body')
 293   where
 294     body' = freeVars body
 295
 296 freeVars (App fun arg)
 297   = (freeVarsOf fun2 `unionFVs` freeVarsOf arg2, AnnApp fun2 arg2)
 298   where
 299     fun2 = freeVars fun
 300     arg2 = freeVars arg
 301
 302 freeVars (Case scrut bndr alts)
 303   = ((bndr `delBinderFV` alts_fvs) `unionFVs` freeVarsOf scrut2,
 304      AnnCase scrut2 bndr alts2)
 305   where
 306     scrut2 = freeVars scrut
 307
 308     (alts_fvs_s, alts2) = mapAndUnzip fv_alt alts
 309     alts_fvs            = foldr1 unionFVs alts_fvs_s
 310
 311     fv_alt (con,args,rhs) = (delBindersFV args (freeVarsOf rhs2),
 312                              (con, args, rhs2))
 313                           where
 314                              rhs2 = freeVars rhs
 315
 316 freeVars (Let (NonRec binder rhs) body)
 317   = (freeVarsOf rhs2 `unionFVs` body_fvs,
 318      AnnLet (AnnNonRec binder rhs2) body2)
 319   where
 320     rhs2     = freeVars rhs
 321     body2    = freeVars body
 322     body_fvs = binder `delBinderFV` freeVarsOf body2
 323
 324 freeVars (Let (Rec binds) body)
 325   = (foldl delVarSet group_fvs binders,
 326         -- The "delBinderFV" part may have added one of the binders
 327         -- via the idSpecVars part, so we must delete it again
 328      AnnLet (AnnRec (binders `zip` rhss2)) body2)
 329   where
 330     (binders, rhss) = unzip binds
 331
 332     rhss2     = map freeVars rhss
 333     all_fvs   = foldr (unionFVs . fst) body_fvs rhss2
 334     group_fvs = delBindersFV binders all_fvs
 335
 336     body2     = freeVars body
 337     body_fvs  = freeVarsOf body2
 338
 339 freeVars (Note (Coerce to_ty from_ty) expr)
 340   = (freeVarsOf expr2 `unionFVs` tfvs1 `unionFVs` tfvs2,
 341      AnnNote (Coerce to_ty from_ty) expr2)
 342   where
 343     expr2  = freeVars expr
 344     tfvs1  = tyVarsOfType from_ty
 345     tfvs2  = tyVarsOfType to_ty
 346
 347 freeVars (Note other_note expr)
 348   = (freeVarsOf expr2, AnnNote other_note expr2)
 349   where
 350     expr2 = freeVars expr
 351
 352 freeVars (Type ty) = (tyVarsOfType ty, AnnType ty)
 353 \end{code}
 354