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