ghc/compiler/coreSyn/CoreTidy.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section{Tidying up Core}
   5
   6 \begin{code}
   7 module CoreTidy (
   8         tidyCorePgm, tidyExpr,
   9         tidyBndr, tidyBndrs
  10     ) where
  11
  12 #include "HsVersions.h"
  13
  14 import CmdLineOpts      ( DynFlags, DynFlag(..), opt_UsageSPOn, dopt )
  15 import CoreSyn
  16 import CoreUnfold       ( noUnfolding )
  17 import CoreLint         ( showPass, endPass )
  18 import UsageSPInf       ( doUsageSPInf )
  19 import VarEnv
  20 import VarSet
  21 import Var              ( Id, Var )
  22 import Id               ( idType, idInfo, idName,
  23                           mkVanillaId, mkId, exportWithOrigOccName,
  24                           idStrictness, setIdStrictness,
  25                           idDemandInfo, setIdDemandInfo,
  26                         )
  27 import IdInfo           ( specInfo, setSpecInfo,
  28                           setUnfoldingInfo, setDemandInfo,
  29                           workerInfo, setWorkerInfo, WorkerInfo(..)
  30                         )
  31 import Demand           ( wwLazy )
  32 import Name             ( getOccName, tidyTopName, mkLocalName )
  33 import OccName          ( initTidyOccEnv, tidyOccName )
  34 import Type             ( tidyTopType, tidyType, tidyTyVar )
  35 import Module           ( Module )
  36 import UniqSupply       ( mkSplitUniqSupply )
  37 import Unique           ( Uniquable(..) )
  38 import ErrUtils         ( showPass )
  39 import SrcLoc           ( noSrcLoc )
  40 import Util             ( mapAccumL )
  41 \end{code}
  42
  43
  44
  45 %************************************************************************
  46 %*                                                                      *
  47 \subsection{Tidying core}
  48 %*                                                                      *
  49 %************************************************************************
  50
  51 Several tasks are done by @tidyCorePgm@
  52
  53 1. If @opt_UsageSPOn@ then compute usage information (which is
  54    needed by Core2Stg).  ** NOTE _scc_ HERE **
  55    Do this first, because it may introduce new binders.
  56
  57 2.  Make certain top-level bindings into Globals. The point is that
  58     Global things get externally-visible labels at code generation
  59     time
  60
  61
  62 3. Give all binders a nice print-name.  Their uniques aren't changed;
  63    rather we give them lexically unique occ-names, so that we can
  64    safely print the OccNae only in the interface file.  [Bad idea to
  65    change the uniques, because the code generator makes global labels
  66    from the uniques for local thunks etc.]
  67
  68 \begin{code}
  69 tidyCorePgm :: DynFlags -> Module
  70             -> [CoreBind] -> [IdCoreRule]
  71             -> IO ([CoreBind], [IdCoreRule])
  72 tidyCorePgm dflags module_name binds_in orphans_in
  73   = do
  74         us <- mkSplitUniqSupply 'u'
  75
  76         showPass dflags "Tidy Core"
  77
  78         binds_in1 <- if opt_UsageSPOn
  79                      then _scc_ "CoreUsageSPInf"
  80                                 doUsageSPInf dflags us binds_in
  81                      else return binds_in
  82
  83         let (tidy_env1, binds_out)  = mapAccumL (tidyBind (Just module_name))
  84                                                 init_tidy_env binds_in1
  85             orphans_out             = tidyIdRules tidy_env1 orphans_in
  86
  87         endPass dflags "Tidy Core" (dopt Opt_D_dump_simpl dflags ||
  88                                     dopt Opt_D_verbose_core2core dflags)
  89                 binds_out
  90
  91         return (binds_out, orphans_out)
  92   where
  93         -- We also make sure to avoid any exported binders.  Consider
  94         --      f{-u1-} = 1     -- Local decl
  95         --      ...
  96         --      f{-u2-} = 2     -- Exported decl
  97         --
  98         -- The second exported decl must 'get' the name 'f', so we
  99         -- have to put 'f' in the avoids list before we get to the first
 100         -- decl.  tidyTopId then does a no-op on exported binders.
 101     init_tidy_env = (initTidyOccEnv avoids, emptyVarEnv)
 102     avoids        = [getOccName bndr | bndr <- bindersOfBinds binds_in,
 103                                        exportWithOrigOccName bndr]
 104
 105 tidyBind :: Maybe Module                -- (Just m) for top level, Nothing for nested
 106          -> TidyEnv
 107          -> CoreBind
 108          -> (TidyEnv, CoreBind)
 109 tidyBind maybe_mod env (NonRec bndr rhs)
 110   = let
 111         (env', bndr') = tidy_bndr maybe_mod env' env bndr
 112         rhs'          = tidyExpr env' rhs
 113         -- We use env' when tidying the RHS even though it's not
 114         -- strictly necessary; it makes the code pretty hard to read
 115         -- if we don't!
 116     in
 117     (env', NonRec bndr' rhs')
 118
 119 tidyBind maybe_mod env (Rec pairs)
 120   = let
 121         -- We use env' when tidying the rhss
 122         -- When tidying the binder itself we may tidy it's
 123         -- specialisations; if any of these mention other binders
 124         -- in the group we should really feed env' to them too;
 125         -- but that seems (a) unlikely and (b) a bit tiresome.
 126         -- So I left it out for now
 127
 128         (bndrs, rhss)  = unzip pairs
 129         (env', bndrs') = mapAccumL (tidy_bndr maybe_mod env') env bndrs
 130         rhss'          = map (tidyExpr env') rhss
 131   in
 132   (env', Rec (zip bndrs' rhss'))
 133
 134 tidyExpr env (Type ty)       = Type (tidyType env ty)
 135 tidyExpr env (Lit lit)       = Lit lit
 136 tidyExpr env (App f a)       = App (tidyExpr env f) (tidyExpr env a)
 137 tidyExpr env (Note n e)      = Note (tidyNote env n) (tidyExpr env e)
 138
 139 tidyExpr env (Let b e)       = Let b' (tidyExpr env' e)
 140                              where
 141                                (env', b') = tidyBind Nothing env b
 142
 143 tidyExpr env (Case e b alts) = Case (tidyExpr env e) b' (map (tidyAlt env') alts)
 144                              where
 145                                (env', b') = tidyBndr env b
 146
 147 tidyExpr env (Var v)         = Var (tidyVarOcc env v)
 148
 149 tidyExpr env (Lam b e)       = Lam b' (tidyExpr env' e)
 150                              where
 151                                (env', b') = tidyBndr env b
 152
 153 tidyAlt env (con, vs, rhs)   = (con, vs', tidyExpr env' rhs)
 154                              where
 155                                (env', vs') = tidyBndrs env vs
 156
 157 tidyNote env (Coerce t1 t2)  = Coerce (tidyType env t1) (tidyType env t2)
 158
 159 tidyNote env note            = note
 160
 161 tidyVarOcc (_, var_env) v = case lookupVarEnv var_env v of
 162                                   Just v' -> v'
 163                                   Nothing -> v
 164 \end{code}
 165
 166 \begin{code}
 167 tidy_bndr (Just mod) env_idinfo env var = tidyTopId mod env env_idinfo var
 168 tidy_bndr Nothing    env_idinfo env var = tidyBndr      env            var
 169 \end{code}
 170
 171
 172
 173 %************************************************************************
 174 %*                                                                      *
 175 \subsection{Tidying up a binder}
 176 %*                                                                      *
 177 %************************************************************************
 178
 179 \begin{code}
 180 tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)
 181 tidyBndr env var | isTyVar var = tidyTyVar env var
 182                  | otherwise   = tidyId    env var
 183
 184 tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
 185 tidyBndrs env vars = mapAccumL tidyBndr env vars
 186
 187 tidyId :: TidyEnv -> Id -> (TidyEnv, Id)
 188 tidyId env@(tidy_env, var_env) id
 189   =     -- Non-top-level variables
 190     let
 191         -- Give the Id a fresh print-name, *and* rename its type
 192         -- The SrcLoc isn't important now, though we could extract it from the Id
 193         name'             = mkLocalName (getUnique id) occ' noSrcLoc
 194         (tidy_env', occ') = tidyOccName tidy_env (getOccName id)
 195         ty'               = tidyType env (idType id)
 196         id'               = mkVanillaId name' ty'
 197                             `setIdStrictness` idStrictness id
 198                             `setIdDemandInfo` idDemandInfo id
 199                         -- NB: This throws away the IdInfo of the Id, which we
 200                         -- no longer need.  That means we don't need to
 201                         -- run over it with env, nor renumber it.
 202                         --
 203                         -- The exception is strictness and demand info, which
 204                         -- is used to decide whether to use let or case for
 205                         -- function arguments and let bindings
 206
 207         var_env'          = extendVarEnv var_env id id'
 208     in
 209     ((tidy_env', var_env'), id')
 210
 211 tidyTopId :: Module -> TidyEnv -> TidyEnv -> Id -> (TidyEnv, Id)
 212         -- The second env is the one to use for the IdInfo
 213         -- It's necessary because when we are dealing with a recursive
 214         -- group, a variable late in the group might be mentioned
 215         -- in the IdInfo of one early in the group
 216 tidyTopId mod env@(tidy_env, var_env) env_idinfo id
 217   =     -- Top level variables
 218     let
 219         (tidy_env', name') = tidyTopName mod tidy_env (idName id)
 220         ty'                = tidyTopType (idType id)
 221         idinfo'            = tidyIdInfo env_idinfo (idInfo id)
 222         id'                = mkId name' ty' idinfo'
 223         var_env'           = extendVarEnv var_env id id'
 224     in
 225     ((tidy_env', var_env'), id')
 226 \end{code}
 227
 228 \begin{code}
 229 -- tidyIdInfo does these things:
 230 --      a) tidy the specialisation info and worker info (if any)
 231 --      b) zap the unfolding and demand info
 232 -- The latter two are to avoid space leaks
 233
 234 tidyIdInfo env info
 235   = info5
 236   where
 237     rules = specInfo info
 238
 239     info2 | isEmptyCoreRules rules = info
 240           | otherwise              = info `setSpecInfo` tidyRules env rules
 241
 242     info3 = info2 `setUnfoldingInfo` noUnfolding
 243     info4 = info3 `setDemandInfo`    wwLazy
 244
 245     info5 = case workerInfo info of
 246                 NoWorker -> info4
 247                 HasWorker w a  -> info4 `setWorkerInfo` HasWorker (tidyVarOcc env w) a
 248
 249 tidyIdRules :: TidyEnv -> [IdCoreRule] -> [IdCoreRule]
 250 tidyIdRules env rules
 251   = [ (tidyVarOcc env fn, tidyRule env rule) | (fn,rule) <- rules  ]
 252
 253 tidyRules :: TidyEnv -> CoreRules -> CoreRules
 254 tidyRules env (Rules rules fvs)
 255   = Rules (map (tidyRule env) rules)
 256           (foldVarSet tidy_set_elem emptyVarSet fvs)
 257   where
 258     tidy_set_elem var new_set = extendVarSet new_set (tidyVarOcc env var)
 259
 260 tidyRule :: TidyEnv -> CoreRule -> CoreRule
 261 tidyRule env rule@(BuiltinRule _) = rule
 262 tidyRule env (Rule name vars tpl_args rhs)
 263   = (Rule name vars' (map (tidyExpr env') tpl_args) (tidyExpr env' rhs))
 264   where
 265     (env', vars') = tidyBndrs env vars
 266 \end{code}