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,   -- CoreExpr -> VarSet   -- Find all locally-defined free Ids or tyvars
   9         exprsFreeVars,  -- [CoreExpr] -> VarSet
  10
  11         exprSomeFreeVars, exprsSomeFreeVars,
  12         exprFreeNames, exprsFreeNames,
  13
  14         idRuleVars, idFreeVars, idFreeTyVars,
  15         ruleRhsFreeVars, rulesRhsFreeVars,
  16         ruleLhsFreeNames, ruleLhsFreeIds,
  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, idSpecialisation, isLocalId )
  28 import IdInfo           ( specInfoFreeVars )
  29 import NameSet
  30 import UniqFM           ( delFromUFM )
  31 import Name             ( isExternalName )
  32 import VarSet
  33 import Var              ( Var, isId, isLocalVar, varName )
  34 import Type             ( tyVarsOfType )
  35 import TcType           ( tyClsNamesOfType )
  36 import Util             ( mapAndUnzip )
  37 import Outputable
  38 \end{code}
  39
  40
  41 %************************************************************************
  42 %*                                                                      *
  43 \section{Finding the free variables of an expression}
  44 %*                                                                      *
  45 %************************************************************************
  46
  47 This function simply finds the free variables of an expression.
  48 So far as type variables are concerned, it only finds tyvars that are
  49
  50         * free in type arguments,
  51         * free in the type of a binder,
  52
  53 but not those that are free in the type of variable occurrence.
  54
  55 \begin{code}
  56 exprFreeVars :: CoreExpr -> VarSet      -- Find all locally-defined free Ids or tyvars
  57 exprFreeVars = exprSomeFreeVars isLocalVar
  58
  59 exprsFreeVars :: [CoreExpr] -> VarSet
  60 exprsFreeVars = foldr (unionVarSet . exprFreeVars) emptyVarSet
  61
  62 exprSomeFreeVars :: InterestingVarFun   -- Says which Vars are interesting
  63                  -> CoreExpr
  64                  -> VarSet
  65 exprSomeFreeVars fv_cand e = expr_fvs e fv_cand emptyVarSet
  66
  67 exprsSomeFreeVars :: InterestingVarFun  -- Says which Vars are interesting
  68                   -> [CoreExpr]
  69                   -> VarSet
  70 exprsSomeFreeVars fv_cand = foldr (unionVarSet . exprSomeFreeVars fv_cand) emptyVarSet
  71
  72 type InterestingVarFun = Var -> Bool    -- True <=> interesting
  73 \end{code}
  74
  75
  76 \begin{code}
  77 type FV = InterestingVarFun
  78         -> VarSet               -- In scope
  79         -> VarSet               -- Free vars
  80
  81 union :: FV -> FV -> FV
  82 union fv1 fv2 fv_cand in_scope = fv1 fv_cand in_scope `unionVarSet` fv2 fv_cand in_scope
  83
  84 noVars :: FV
  85 noVars fv_cand in_scope = emptyVarSet
  86
  87 --      Comment about obselete code
  88 -- We used to gather the free variables the RULES at a variable occurrence
  89 -- with the following cryptic comment:
  90 --     "At a variable occurrence, add in any free variables of its rule rhss
  91 --     Curiously, we gather the Id's free *type* variables from its binding
  92 --     site, but its free *rule-rhs* variables from its usage sites.  This
  93 --     is a little weird.  The reason is that the former is more efficient,
  94 --     but the latter is more fine grained, and a makes a difference when
  95 --     a variable mentions itself one of its own rule RHSs"
  96 -- Not only is this "weird", but it's also pretty bad because it can make
  97 -- a function seem more recursive than it is.  Suppose
  98 --      f  = ...g...
  99 --      g  = ...
 100 --         RULE g x = ...f...
 101 -- Then f is not mentioned in its own RHS, and needn't be a loop breaker
 102 -- (though g may be).  But if we collect the rule fvs from g's occurrence,
 103 -- it looks as if f mentions itself.  (This bites in the eftInt/eftIntFB
 104 -- code in GHC.Enum.)
 105 --
 106 -- Anyway, it seems plain wrong.  The RULE is like an extra RHS for the
 107 -- function, so its free variables belong at the definition site.
 108 --
 109 -- Deleted code looked like
 110 --     foldVarSet add_rule_var var_itself_set (idRuleVars var)
 111 --     add_rule_var var set | keep_it fv_cand in_scope var = extendVarSet set var
 112 --                          | otherwise                    = set
 113 --      SLPJ Feb06
 114
 115 oneVar :: Id -> FV
 116 oneVar var fv_cand in_scope
 117   = ASSERT( isId var )
 118     if keep_it fv_cand in_scope var
 119     then unitVarSet var
 120     else emptyVarSet
 121
 122 someVars :: VarSet -> FV
 123 someVars vars fv_cand in_scope
 124   = filterVarSet (keep_it fv_cand in_scope) vars
 125
 126 keep_it fv_cand in_scope var
 127   | var `elemVarSet` in_scope = False
 128   | fv_cand var               = True
 129   | otherwise                 = False
 130
 131
 132 addBndr :: CoreBndr -> FV -> FV
 133 addBndr bndr fv fv_cand in_scope
 134   | isId bndr = inside_fvs `unionVarSet` someVars (idFreeTyVars bndr) fv_cand in_scope
 135   | otherwise = inside_fvs
 136   where
 137     inside_fvs = fv fv_cand (in_scope `extendVarSet` bndr)
 138
 139 addBndrs :: [CoreBndr] -> FV -> FV
 140 addBndrs bndrs fv = foldr addBndr fv bndrs
 141 \end{code}
 142
 143
 144 \begin{code}
 145 expr_fvs :: CoreExpr -> FV
 146
 147 expr_fvs (Type ty)       = someVars (tyVarsOfType ty)
 148 expr_fvs (Var var)       = oneVar var
 149 expr_fvs (Lit lit)       = noVars
 150 expr_fvs (Note _ expr)   = expr_fvs expr
 151 expr_fvs (App fun arg)   = expr_fvs fun `union` expr_fvs arg
 152 expr_fvs (Lam bndr body) = addBndr bndr (expr_fvs body)
 153
 154 expr_fvs (Case scrut bndr ty alts)
 155   = expr_fvs scrut `union` someVars (tyVarsOfType ty) `union` addBndr bndr
 156       (foldr (union . alt_fvs) noVars alts)
 157   where
 158     alt_fvs (con, bndrs, rhs) = addBndrs bndrs (expr_fvs rhs)
 159
 160 expr_fvs (Let (NonRec bndr rhs) body)
 161   = rhs_fvs (bndr, rhs) `union` addBndr bndr (expr_fvs body)
 162
 163 expr_fvs (Let (Rec pairs) body)
 164   = addBndrs (map fst pairs)
 165              (foldr (union . rhs_fvs) (expr_fvs body) pairs)
 166
 167 ---------
 168 rhs_fvs (bndr, rhs) = expr_fvs rhs `union` someVars (idRuleVars bndr)
 169         -- Treat any RULES as extra RHSs of the binding
 170
 171 ---------
 172 exprs_fvs exprs = foldr (union . expr_fvs) noVars exprs
 173 \end{code}
 174
 175
 176 %************************************************************************
 177 %*                                                                      *
 178 \section{Free names}
 179 %*                                                                      *
 180 %************************************************************************
 181
 182 exprFreeNames finds the free *external* *names* of an expression, notably
 183 including the names of type constructors (which of course do not show
 184 up in exprFreeVars).  Similarly ruleLhsFreeNames.  The latter is used
 185 when deciding whether a rule is an orphan.  In particular, suppose that
 186 T is defined in this module; we want to avoid declaring that a rule like
 187         fromIntegral T = fromIntegral_T
 188 is an orphan.  Of course it isn't, an declaring it an orphan would
 189 make the whole module an orphan module, which is bad.
 190
 191 There's no need to delete local binders, because they will all
 192 be *internal* names.
 193
 194 \begin{code}
 195 ruleLhsFreeNames :: CoreRule -> NameSet
 196 ruleLhsFreeNames (BuiltinRule { ru_fn = fn }) = unitNameSet fn
 197 ruleLhsFreeNames (Rule { ru_fn = fn, ru_bndrs = tpl_vars, ru_args = tpl_args })
 198   = addOneToNameSet (exprsFreeNames tpl_args) fn
 199
 200 exprFreeNames :: CoreExpr -> NameSet
 201 -- Find the free *external* names of an expression
 202 exprFreeNames e
 203   = go e
 204   where
 205     go (Var v)
 206       | isExternalName n    = unitNameSet n
 207       | otherwise           = emptyNameSet
 208       where n = varName v
 209     go (Lit _)              = emptyNameSet
 210     go (Type ty)            = tyClsNamesOfType ty       -- Don't need free tyvars
 211     go (App e1 e2)          = go e1 `unionNameSets` go e2
 212     go (Lam v e)            = go e `delFromNameSet` varName v
 213     go (Note n e)           = go e
 214     go (Let (NonRec b r) e) = go e `unionNameSets` go r
 215     go (Let (Rec prs) e)    = exprsFreeNames (map snd prs) `unionNameSets` go e
 216     go (Case e b ty as)     = go e `unionNameSets` tyClsNamesOfType ty
 217                               `unionNameSets` unionManyNameSets (map go_alt as)
 218
 219     go_alt (_,_,r) = go r
 220
 221 exprsFreeNames es = foldr (unionNameSets . exprFreeNames) emptyNameSet es
 222 \end{code}
 223
 224 %************************************************************************
 225 %*                                                                      *
 226 \section[freevars-everywhere]{Attaching free variables to every sub-expression}
 227 %*                                                                      *
 228 %************************************************************************
 229
 230
 231 \begin{code}
 232 ruleRhsFreeVars :: CoreRule -> VarSet
 233 ruleRhsFreeVars (BuiltinRule {}) = noFVs
 234 ruleRhsFreeVars (Rule { ru_fn = fn, ru_bndrs = bndrs, ru_rhs = rhs })
 235   = delFromUFM fvs fn
 236         -- Hack alert!
 237         -- Don't include the Id in its own rhs free-var set.
 238         -- Otherwise the occurrence analyser makes bindings recursive
 239         -- that shoudn't be.  E.g.
 240         --      RULE:  f (f x y) z  ==>  f x (f y z)
 241   where
 242     fvs = addBndrs bndrs (expr_fvs rhs) isLocalVar emptyVarSet
 243
 244 rulesRhsFreeVars :: [CoreRule] -> VarSet
 245 rulesRhsFreeVars rules
 246   = foldr (unionVarSet . ruleRhsFreeVars) emptyVarSet rules
 247
 248 ruleLhsFreeIds :: CoreRule -> VarSet
 249 -- This finds all locally-defined free Ids on the LHS of the rule
 250 ruleLhsFreeIds (BuiltinRule {}) = noFVs
 251 ruleLhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args })
 252   = addBndrs bndrs (exprs_fvs args) isLocalId emptyVarSet
 253 \end{code}
 254
 255
 256 %************************************************************************
 257 %*                                                                      *
 258 \section[freevars-everywhere]{Attaching free variables to every sub-expression}
 259 %*                                                                      *
 260 %************************************************************************
 261
 262 The free variable pass annotates every node in the expression with its
 263 NON-GLOBAL free variables and type variables.
 264
 265 \begin{code}
 266 type CoreBindWithFVs = AnnBind Id VarSet
 267 type CoreExprWithFVs = AnnExpr Id VarSet
 268         -- Every node annotated with its free variables,
 269         -- both Ids and TyVars
 270
 271 freeVarsOf :: CoreExprWithFVs -> IdSet
 272 freeVarsOf (free_vars, _) = free_vars
 273
 274 noFVs    = emptyVarSet
 275 aFreeVar = unitVarSet
 276 unionFVs = unionVarSet
 277
 278 delBindersFV :: [Var] -> VarSet -> VarSet
 279 delBindersFV bs fvs = foldr delBinderFV fvs bs
 280
 281 delBinderFV :: Var -> VarSet -> VarSet
 282 -- This way round, so we can do it multiple times using foldr
 283
 284 -- (b `delBinderFV` s) removes the binder b from the free variable set s,
 285 -- but *adds* to s
 286 --      (a) the free variables of b's type
 287 --      (b) the idSpecVars of b
 288 --
 289 -- This is really important for some lambdas:
 290 --      In (\x::a -> x) the only mention of "a" is in the binder.
 291 --
 292 -- Also in
 293 --      let x::a = b in ...
 294 -- we should really note that "a" is free in this expression.
 295 -- It'll be pinned inside the /\a by the binding for b, but
 296 -- it seems cleaner to make sure that a is in the free-var set
 297 -- when it is mentioned.
 298 --
 299 -- This also shows up in recursive bindings.  Consider:
 300 --      /\a -> letrec x::a = x in E
 301 -- Now, there are no explicit free type variables in the RHS of x,
 302 -- but nevertheless "a" is free in its definition.  So we add in
 303 -- the free tyvars of the types of the binders, and include these in the
 304 -- free vars of the group, attached to the top level of each RHS.
 305 --
 306 -- This actually happened in the defn of errorIO in IOBase.lhs:
 307 --      errorIO (ST io) = case (errorIO# io) of
 308 --                          _ -> bottom
 309 --                        where
 310 --                          bottom = bottom -- Never evaluated
 311
 312 delBinderFV b s | isId b    = (s `delVarSet` b) `unionFVs` idFreeVars b
 313                 | otherwise = s `delVarSet` b
 314
 315 idFreeVars :: Id -> VarSet
 316 idFreeVars id = ASSERT( isId id) idRuleVars id `unionVarSet` idFreeTyVars id
 317
 318 idFreeTyVars :: Id -> TyVarSet
 319 -- Only local Ids conjured up locally, can have free type variables.
 320 -- (During type checking top-level Ids can have free tyvars)
 321 idFreeTyVars id = tyVarsOfType (idType id)
 322 --  | isLocalId id = tyVarsOfType (idType id)
 323 --  | otherwise    = emptyVarSet
 324
 325 idRuleVars ::Id -> VarSet
 326 idRuleVars id = ASSERT( isId id) specInfoFreeVars (idSpecialisation id)
 327 \end{code}
 328
 329
 330 %************************************************************************
 331 %*                                                                      *
 332 \subsection{Free variables (and types)}
 333 %*                                                                      *
 334 %************************************************************************
 335
 336 \begin{code}
 337 freeVars :: CoreExpr -> CoreExprWithFVs
 338
 339 freeVars (Var v)
 340   = (fvs, AnnVar v)
 341   where
 342         -- ToDo: insert motivating example for why we *need*
 343         -- to include the idSpecVars in the FV list.
 344         --      Actually [June 98] I don't think it's necessary
 345         -- fvs = fvs_v `unionVarSet` idSpecVars v
 346
 347     fvs | isLocalVar v = aFreeVar v
 348         | otherwise    = noFVs
 349
 350 freeVars (Lit lit) = (noFVs, AnnLit lit)
 351 freeVars (Lam b body)
 352   = (b `delBinderFV` freeVarsOf body', AnnLam b body')
 353   where
 354     body' = freeVars body
 355
 356 freeVars (App fun arg)
 357   = (freeVarsOf fun2 `unionFVs` freeVarsOf arg2, AnnApp fun2 arg2)
 358   where
 359     fun2 = freeVars fun
 360     arg2 = freeVars arg
 361
 362 freeVars (Case scrut bndr ty alts)
 363 -- gaw 2004
 364   = ((bndr `delBinderFV` alts_fvs) `unionFVs` freeVarsOf scrut2 `unionFVs` tyVarsOfType ty,
 365      AnnCase scrut2 bndr ty alts2)
 366   where
 367     scrut2 = freeVars scrut
 368
 369     (alts_fvs_s, alts2) = mapAndUnzip fv_alt alts
 370     alts_fvs            = foldr1 unionFVs alts_fvs_s
 371
 372     fv_alt (con,args,rhs) = (delBindersFV args (freeVarsOf rhs2),
 373                              (con, args, rhs2))
 374                           where
 375                              rhs2 = freeVars rhs
 376
 377 freeVars (Let (NonRec binder rhs) body)
 378   = (freeVarsOf rhs2 `unionFVs` body_fvs,
 379      AnnLet (AnnNonRec binder rhs2) body2)
 380   where
 381     rhs2     = freeVars rhs
 382     body2    = freeVars body
 383     body_fvs = binder `delBinderFV` freeVarsOf body2
 384
 385 freeVars (Let (Rec binds) body)
 386   = (foldl delVarSet group_fvs binders,
 387         -- The "delBinderFV" part may have added one of the binders
 388         -- via the idSpecVars part, so we must delete it again
 389      AnnLet (AnnRec (binders `zip` rhss2)) body2)
 390   where
 391     (binders, rhss) = unzip binds
 392
 393     rhss2     = map freeVars rhss
 394     all_fvs   = foldr (unionFVs . fst) body_fvs rhss2
 395     group_fvs = delBindersFV binders all_fvs
 396
 397     body2     = freeVars body
 398     body_fvs  = freeVarsOf body2
 399
 400 freeVars (Note (Coerce to_ty from_ty) expr)
 401   = (freeVarsOf expr2 `unionFVs` tfvs1 `unionFVs` tfvs2,
 402      AnnNote (Coerce to_ty from_ty) expr2)
 403   where
 404     expr2  = freeVars expr
 405     tfvs1  = tyVarsOfType from_ty
 406     tfvs2  = tyVarsOfType to_ty
 407
 408 freeVars (Note other_note expr)
 409   = (freeVarsOf expr2, AnnNote other_note expr2)
 410   where
 411     expr2 = freeVars expr
 412
 413 freeVars (Type ty) = (tyVarsOfType ty, AnnType ty)
 414 \end{code}
 415