compiler/coreSyn/CoreTidy.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The AQUA Project, Glasgow University, 1996-1998
   4 %
   5
   6 This module contains "tidying" code for *nested* expressions, bindings, rules.
   7 The code for *top-level* bindings is in TidyPgm.
   8
   9 \begin{code}
  10 module CoreTidy (
  11         tidyExpr, tidyVarOcc, tidyRule, tidyRules, tidyUnfolding
  12     ) where
  13
  14 #include "HsVersions.h"
  15
  16 import CoreSyn
  17 import CoreArity
  18 import Id
  19 import IdInfo
  20 import TcType( tidyType, tidyCo, tidyTyVarBndr )
  21 import Var
  22 import VarEnv
  23 import UniqFM
  24 import Name hiding (tidyNameOcc)
  25 import SrcLoc
  26 import Maybes
  27 import Data.List
  28 import Outputable
  29 \end{code}
  30
  31
  32 %************************************************************************
  33 %*                                                                      *
  34 \subsection{Tidying expressions, rules}
  35 %*                                                                      *
  36 %************************************************************************
  37
  38 \begin{code}
  39 tidyBind :: TidyEnv
  40          -> CoreBind
  41          ->  (TidyEnv, CoreBind)
  42
  43 tidyBind env (NonRec bndr rhs)
  44   = tidyLetBndr env env (bndr,rhs) =: \ (env', bndr') ->
  45     (env', NonRec bndr' (tidyExpr env' rhs))
  46
  47 tidyBind env (Rec prs)
  48   = let
  49        (env', bndrs') = mapAccumL (tidyLetBndr env') env prs
  50     in
  51     map (tidyExpr env') (map snd prs)   =: \ rhss' ->
  52     (env', Rec (zip bndrs' rhss'))
  53
  54
  55 ------------  Expressions  --------------
  56 tidyExpr :: TidyEnv -> CoreExpr -> CoreExpr
  57 tidyExpr env (Var v)     =  Var (tidyVarOcc env v)
  58 tidyExpr env (Type ty)  =  Type (tidyType env ty)
  59 tidyExpr env (Coercion co) = Coercion (tidyCo env co)
  60 tidyExpr _   (Lit lit)   =  Lit lit
  61 tidyExpr env (App f a)   =  App (tidyExpr env f) (tidyExpr env a)
  62 tidyExpr env (Note n e)  =  Note (tidyNote env n) (tidyExpr env e)
  63 tidyExpr env (Cast e co) =  Cast (tidyExpr env e) (tidyCo env co)
  64
  65 tidyExpr env (Let b e)
  66   = tidyBind env b      =: \ (env', b') ->
  67     Let b' (tidyExpr env' e)
  68
  69 tidyExpr env (Case e b ty alts)
  70   = tidyBndr env b      =: \ (env', b) ->
  71     Case (tidyExpr env e) b (tidyType env ty)
  72          (map (tidyAlt b env') alts)
  73
  74 tidyExpr env (Lam b e)
  75   = tidyBndr env b      =: \ (env', b) ->
  76     Lam b (tidyExpr env' e)
  77
  78 ------------  Case alternatives  --------------
  79 tidyAlt :: CoreBndr -> TidyEnv -> CoreAlt -> CoreAlt
  80 tidyAlt _case_bndr env (con, vs, rhs)
  81   = tidyBndrs env vs    =: \ (env', vs) ->
  82     (con, vs, tidyExpr env' rhs)
  83
  84 ------------  Notes  --------------
  85 tidyNote :: TidyEnv -> Note -> Note
  86 tidyNote _ note            = note
  87
  88 ------------  Rules  --------------
  89 tidyRules :: TidyEnv -> [CoreRule] -> [CoreRule]
  90 tidyRules _   [] = []
  91 tidyRules env (rule : rules)
  92   = tidyRule env rule           =: \ rule ->
  93     tidyRules env rules         =: \ rules ->
  94     (rule : rules)
  95
  96 tidyRule :: TidyEnv -> CoreRule -> CoreRule
  97 tidyRule _   rule@(BuiltinRule {}) = rule
  98 tidyRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs,
  99                           ru_fn = fn, ru_rough = mb_ns })
 100   = tidyBndrs env bndrs         =: \ (env', bndrs) ->
 101     map (tidyExpr env') args    =: \ args ->
 102     rule { ru_bndrs = bndrs, ru_args = args,
 103            ru_rhs   = tidyExpr env' rhs,
 104            ru_fn    = tidyNameOcc env fn,
 105            ru_rough = map (fmap (tidyNameOcc env')) mb_ns }
 106 \end{code}
 107
 108
 109 %************************************************************************
 110 %*                                                                      *
 111 \subsection{Tidying non-top-level binders}
 112 %*                                                                      *
 113 %************************************************************************
 114
 115 \begin{code}
 116 tidyNameOcc :: TidyEnv -> Name -> Name
 117 -- In rules and instances, we have Names, and we must tidy them too
 118 -- Fortunately, we can lookup in the VarEnv with a name
 119 tidyNameOcc (_, var_env) n = case lookupUFM var_env n of
 120                                 Nothing -> n
 121                                 Just v  -> idName v
 122
 123 tidyVarOcc :: TidyEnv -> Var -> Var
 124 tidyVarOcc (_, var_env) v = lookupVarEnv var_env v `orElse` v
 125
 126 -- tidyBndr is used for lambda and case binders
 127 tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)
 128 tidyBndr env var
 129   | isTyVar var = tidyTyVarBndr env var
 130   | otherwise   = tidyIdBndr env var
 131
 132 tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
 133 tidyBndrs env vars = mapAccumL tidyBndr env vars
 134
 135 tidyLetBndr :: TidyEnv         -- Knot-tied version for unfoldings
 136             -> TidyEnv         -- The one to extend
 137             -> (Id, CoreExpr) -> (TidyEnv, Var)
 138 -- Used for local (non-top-level) let(rec)s
 139 tidyLetBndr rec_tidy_env env (id,rhs)
 140   = ((tidy_occ_env,new_var_env), final_id)
 141   where
 142     ((tidy_occ_env,var_env), new_id) = tidyIdBndr env id
 143     new_var_env = extendVarEnv var_env id final_id
 144        -- Override the env we get back from tidyId with the
 145        -- new IdInfo so it gets propagated to the usage sites.
 146
 147         -- We need to keep around any interesting strictness and
 148         -- demand info because later on we may need to use it when
 149         -- converting to A-normal form.
 150         -- eg.
 151         --      f (g x),  where f is strict in its argument, will be converted
 152         --      into  case (g x) of z -> f z  by CorePrep, but only if f still
 153         --      has its strictness info.
 154         --
 155         -- Similarly for the demand info - on a let binder, this tells
 156         -- CorePrep to turn the let into a case.
 157         --
 158         -- Similarly arity info for eta expansion in CorePrep
 159         --
 160         -- Set inline-prag info so that we preseve it across
 161         -- separate compilation boundaries
 162     final_id = new_id `setIdInfo` new_info
 163     idinfo   = idInfo id
 164     new_info = idInfo new_id
 165                 `setArityInfo`          exprArity rhs
 166                 `setStrictnessInfo`     strictnessInfo idinfo
 167                 `setDemandInfo`         demandInfo idinfo
 168                 `setInlinePragInfo`     inlinePragInfo idinfo
 169                 `setUnfoldingInfo`      new_unf
 170
 171     new_unf | isStableUnfolding unf = tidyUnfolding rec_tidy_env unf (panic "tidy_unf")
 172             | otherwise             = noUnfolding
 173     unf = unfoldingInfo idinfo
 174
 175 -- Non-top-level variables
 176 tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
 177 tidyIdBndr env@(tidy_env, var_env) id
 178   = -- Do this pattern match strictly, otherwise we end up holding on to
 179     -- stuff in the OccName.
 180     case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') ->
 181     let
 182         -- Give the Id a fresh print-name, *and* rename its type
 183         -- The SrcLoc isn't important now,
 184         -- though we could extract it from the Id
 185         --
 186         ty'      = tidyType env (idType id)
 187         name'    = mkInternalName (idUnique id) occ' noSrcSpan
 188         id'      = mkLocalIdWithInfo name' ty' new_info
 189         var_env' = extendVarEnv var_env id id'
 190
 191         -- Note [Tidy IdInfo]
 192         new_info = vanillaIdInfo `setOccInfo` occInfo old_info
 193         old_info = idInfo id
 194     in
 195     ((tidy_env', var_env'), id')
 196    }
 197
 198 ------------ Unfolding  --------------
 199 tidyUnfolding :: TidyEnv -> Unfolding -> Unfolding -> Unfolding
 200 tidyUnfolding tidy_env (DFunUnfolding ar con ids) _
 201   = DFunUnfolding ar con (map (fmap (tidyExpr tidy_env)) ids)
 202 tidyUnfolding tidy_env
 203               unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })
 204               unf_from_rhs
 205   | isStableSource src
 206   = unf { uf_tmpl = tidyExpr tidy_env unf_rhs,     -- Preserves OccInfo
 207           uf_src  = tidySrc tidy_env src }
 208   | otherwise
 209   = unf_from_rhs
 210 tidyUnfolding _ unf _ = unf     -- NoUnfolding or OtherCon
 211
 212 tidySrc :: TidyEnv -> UnfoldingSource -> UnfoldingSource
 213 tidySrc tidy_env (InlineWrapper w) = InlineWrapper (tidyVarOcc tidy_env w)
 214 tidySrc _        inl_info          = inl_info
 215 \end{code}
 216
 217 Note [Tidy IdInfo]
 218 ~~~~~~~~~~~~~~~~~~
 219 All nested Ids now have the same IdInfo, namely vanillaIdInfo, which
 220 should save some space; except that we preserve occurrence info for
 221 two reasons:
 222
 223   (a) To make printing tidy core nicer
 224
 225   (b) Because we tidy RULES and InlineRules, which may then propagate
 226       via --make into the compilation of the next module, and we want
 227       the benefit of that occurrence analysis when we use the rule or
 228       or inline the function.  In particular, it's vital not to lose
 229       loop-breaker info, else we get an infinite inlining loop
 230
 231 Note that tidyLetBndr puts more IdInfo back.
 232
 233
 234 \begin{code}
 235 (=:) :: a -> (a -> b) -> b
 236 m =: k = m `seq` k m
 237 \end{code}