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