ghc/compiler/coreSyn/FreeVars.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 FreeVars (
   8         freeVars,
   9         freeVarsOf,
  10         CoreExprWithFVs, CoreBindWithFVs
  11     ) where
  12
  13 #include "HsVersions.h"
  14
  15 import CoreSyn
  16 import CoreUtils        ( idFreeVars )
  17 import Id               ( Id )
  18 import VarSet
  19 import Var              ( IdOrTyVar, isId )
  20 import Name             ( isLocallyDefined )
  21 import Type             ( tyVarsOfType, Type )
  22 import Util             ( mapAndUnzip )
  23 \end{code}
  24
  25 %************************************************************************
  26 %*                                                                      *
  27 \section[freevars-everywhere]{Attaching free variables to every sub-expression
  28 %*                                                                      *
  29 %************************************************************************
  30
  31 The free variable pass annotates every node in the expression with its
  32 NON-GLOBAL free variables and type variables.
  33
  34 \begin{code}
  35 type CoreBindWithFVs = AnnBind Id IdOrTyVarSet
  36 type CoreExprWithFVs = AnnExpr Id IdOrTyVarSet
  37         -- Every node annotated with its free variables,
  38         -- both Ids and TyVars
  39
  40 freeVarsOf :: CoreExprWithFVs -> IdSet
  41 freeVarsOf (free_vars, _) = free_vars
  42
  43 noFVs    = emptyVarSet
  44 aFreeVar = unitVarSet
  45 unionFVs = unionVarSet
  46
  47 filters :: IdOrTyVar -> IdOrTyVarSet -> IdOrTyVarSet
  48
  49 -- (b `filters` s) removes the binder b from the free variable set s,
  50 -- but *adds* to s
  51 --      (a) the free variables of b's type
  52 --      (b) the idSpecVars of b
  53 --
  54 -- This is really important for some lambdas:
  55 --      In (\x::a -> x) the only mention of "a" is in the binder.
  56 --
  57 -- Also in
  58 --      let x::a = b in ...
  59 -- we should really note that "a" is free in this expression.
  60 -- It'll be pinned inside the /\a by the binding for b, but
  61 -- it seems cleaner to make sure that a is in the free-var set
  62 -- when it is mentioned.
  63 --
  64 -- This also shows up in recursive bindings.  Consider:
  65 --      /\a -> letrec x::a = x in E
  66 -- Now, there are no explicit free type variables in the RHS of x,
  67 -- but nevertheless "a" is free in its definition.  So we add in
  68 -- the free tyvars of the types of the binders, and include these in the
  69 -- free vars of the group, attached to the top level of each RHS.
  70 --
  71 -- This actually happened in the defn of errorIO in IOBase.lhs:
  72 --      errorIO (ST io) = case (errorIO# io) of
  73 --                          _ -> bottom
  74 --                        where
  75 --                          bottom = bottom -- Never evaluated
  76
  77 filters b s | isId b    = (s `delVarSet` b) `unionFVs` idFreeVars b
  78             | otherwise = s `delVarSet` b
  79 \end{code}
  80
  81
  82 %************************************************************************
  83 %*                                                                      *
  84 \subsection{Free variables (and types)}
  85 %*                                                                      *
  86 %************************************************************************
  87
  88 \begin{code}
  89 freeVars :: CoreExpr -> CoreExprWithFVs
  90
  91 freeVars (Var v)
  92   = (fvs, AnnVar v)
  93   where
  94         -- ToDo: insert motivating example for why we *need*
  95         -- to include the idSpecVars in the FV list.
  96         --      Actually [June 98] I don't think it's necessary
  97         -- fvs = fvs_v `unionVarSet` idSpecVars v
  98
  99     fvs | isLocallyDefined v = aFreeVar v
 100         | otherwise          = noFVs
 101
 102 freeVars (Con con args)
 103   = (foldr (unionFVs . freeVarsOf) noFVs args2, AnnCon con args2)
 104   where
 105     args2 = map freeVars args
 106
 107 freeVars (Lam b body)
 108   = (b `filters` freeVarsOf body', AnnLam b body')
 109   where
 110     body' = freeVars body
 111
 112 freeVars (App fun arg)
 113   = (freeVarsOf fun2 `unionFVs` freeVarsOf arg2, AnnApp fun2 arg2)
 114   where
 115     fun2 = freeVars fun
 116     arg2 = freeVars arg
 117
 118 freeVars (Case scrut bndr alts)
 119   = ((bndr `filters` alts_fvs) `unionFVs` freeVarsOf scrut2,
 120      AnnCase scrut2 bndr alts2)
 121   where
 122     scrut2 = freeVars scrut
 123
 124     (alts_fvs_s, alts2) = mapAndUnzip fv_alt alts
 125     alts_fvs            = foldr1 unionFVs alts_fvs_s
 126
 127     fv_alt (con,args,rhs) = (foldr filters (freeVarsOf rhs2) args,
 128                              (con, args, rhs2))
 129                           where
 130                              rhs2 = freeVars rhs
 131
 132 freeVars (Let (NonRec binder rhs) body)
 133   = (freeVarsOf rhs2 `unionFVs` body_fvs,
 134      AnnLet (AnnNonRec binder rhs2) body2)
 135   where
 136     rhs2     = freeVars rhs
 137     body2    = freeVars body
 138     body_fvs = binder `filters` freeVarsOf body2
 139
 140 freeVars (Let (Rec binds) body)
 141   = (foldl delVarSet group_fvs binders,
 142         -- The "filters" part may have added one of the binders
 143         -- via the idSpecVars part, so we must delete it again
 144      AnnLet (AnnRec (binders `zip` rhss2)) body2)
 145   where
 146     (binders, rhss) = unzip binds
 147
 148     rhss2     = map freeVars rhss
 149     all_fvs   = foldr (unionFVs . fst) body_fvs rhss2
 150     group_fvs = foldr filters all_fvs binders
 151
 152     body2     = freeVars body
 153     body_fvs  = freeVarsOf body2
 154
 155 freeVars (Note (Coerce to_ty from_ty) expr)
 156   = (freeVarsOf expr2 `unionFVs` tfvs1 `unionFVs` tfvs2,
 157      AnnNote (Coerce to_ty from_ty) expr2)
 158   where
 159     expr2  = freeVars expr
 160     tfvs1  = tyVarsOfType from_ty
 161     tfvs2  = tyVarsOfType to_ty
 162
 163 freeVars (Note other_note expr)
 164   = (freeVarsOf expr2, AnnNote other_note expr2)
 165   where
 166     expr2 = freeVars expr
 167
 168 freeVars (Type ty) = (tyVarsOfType ty, AnnType ty)
 169 \end{code}
 170