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