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