never executed always true always false
    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 GHC.Iface.Tidy.
    8 -}
    9 
   10 
   11 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
   12 module GHC.Core.Tidy (
   13         tidyExpr, tidyRules, tidyUnfolding
   14     ) where
   15 
   16 import GHC.Prelude
   17 
   18 import GHC.Core
   19 import GHC.Core.Seq ( seqUnfolding )
   20 import GHC.Types.Id
   21 import GHC.Types.Id.Info
   22 import GHC.Types.Demand ( zapDmdEnvSig )
   23 import GHC.Core.Type     ( tidyType, tidyVarBndr )
   24 import GHC.Core.Coercion ( tidyCo )
   25 import GHC.Types.Var
   26 import GHC.Types.Var.Env
   27 import GHC.Types.Unique (getUnique)
   28 import GHC.Types.Unique.FM
   29 import GHC.Types.Name hiding (tidyNameOcc)
   30 import GHC.Types.SrcLoc
   31 import GHC.Types.Tickish
   32 import GHC.Data.Maybe
   33 import Data.List (mapAccumL)
   34 
   35 {-
   36 ************************************************************************
   37 *                                                                      *
   38 \subsection{Tidying expressions, rules}
   39 *                                                                      *
   40 ************************************************************************
   41 -}
   42 
   43 tidyBind :: TidyEnv
   44          -> CoreBind
   45          ->  (TidyEnv, CoreBind)
   46 
   47 tidyBind env (NonRec bndr rhs)
   48   = tidyLetBndr env env bndr =: \ (env', bndr') ->
   49     (env', NonRec bndr' (tidyExpr env' rhs))
   50 
   51 tidyBind env (Rec prs)
   52   = let
   53        (bndrs, rhss)  = unzip prs
   54        (env', bndrs') = mapAccumL (tidyLetBndr env') env bndrs
   55     in
   56     map (tidyExpr env') rhss =: \ rhss' ->
   57     (env', Rec (zip bndrs' rhss'))
   58 
   59 
   60 ------------  Expressions  --------------
   61 tidyExpr :: TidyEnv -> CoreExpr -> CoreExpr
   62 tidyExpr env (Var v)       = Var (tidyVarOcc env v)
   63 tidyExpr env (Type ty)     = Type (tidyType env ty)
   64 tidyExpr env (Coercion co) = Coercion (tidyCo env co)
   65 tidyExpr _   (Lit lit)     = Lit lit
   66 tidyExpr env (App f a)     = App (tidyExpr env f) (tidyExpr env a)
   67 tidyExpr env (Tick t e)    = Tick (tidyTickish env t) (tidyExpr env e)
   68 tidyExpr env (Cast e co)   = Cast (tidyExpr env e) (tidyCo env co)
   69 
   70 tidyExpr env (Let b e)
   71   = tidyBind env b      =: \ (env', b') ->
   72     Let b' (tidyExpr env' e)
   73 
   74 tidyExpr env (Case e b ty alts)
   75   = tidyBndr env b  =: \ (env', b) ->
   76     Case (tidyExpr env e) b (tidyType env ty)
   77          (map (tidyAlt env') alts)
   78 
   79 tidyExpr env (Lam b e)
   80   = tidyBndr env b      =: \ (env', b) ->
   81     Lam b (tidyExpr env' e)
   82 
   83 ------------  Case alternatives  --------------
   84 tidyAlt :: TidyEnv -> CoreAlt -> CoreAlt
   85 tidyAlt env (Alt con vs rhs)
   86   = tidyBndrs env vs    =: \ (env', vs) ->
   87     (Alt con vs (tidyExpr env' rhs))
   88 
   89 ------------  Tickish  --------------
   90 tidyTickish :: TidyEnv -> CoreTickish -> CoreTickish
   91 tidyTickish env (Breakpoint ext ix ids)
   92   = Breakpoint ext ix (map (tidyVarOcc env) ids)
   93 tidyTickish _   other_tickish       = other_tickish
   94 
   95 ------------  Rules  --------------
   96 tidyRules :: TidyEnv -> [CoreRule] -> [CoreRule]
   97 tidyRules _   [] = []
   98 tidyRules env (rule : rules)
   99   = tidyRule env rule           =: \ rule ->
  100     tidyRules env rules         =: \ rules ->
  101     (rule : rules)
  102 
  103 tidyRule :: TidyEnv -> CoreRule -> CoreRule
  104 tidyRule _   rule@(BuiltinRule {}) = rule
  105 tidyRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs,
  106                           ru_fn = fn, ru_rough = mb_ns })
  107   = tidyBndrs env bndrs         =: \ (env', bndrs) ->
  108     map (tidyExpr env') args    =: \ args ->
  109     rule { ru_bndrs = bndrs, ru_args = args,
  110            ru_rhs   = tidyExpr env' rhs,
  111            ru_fn    = tidyNameOcc env fn,
  112            ru_rough = map (fmap (tidyNameOcc env')) mb_ns }
  113 
  114 {-
  115 ************************************************************************
  116 *                                                                      *
  117 \subsection{Tidying non-top-level binders}
  118 *                                                                      *
  119 ************************************************************************
  120 -}
  121 
  122 tidyNameOcc :: TidyEnv -> Name -> Name
  123 -- In rules and instances, we have Names, and we must tidy them too
  124 -- Fortunately, we can lookup in the VarEnv with a name
  125 tidyNameOcc (_, var_env) n = case lookupUFM_Directly var_env (getUnique n) of
  126                                 Nothing -> n
  127                                 Just v  -> idName v
  128 
  129 tidyVarOcc :: TidyEnv -> Var -> Var
  130 tidyVarOcc (_, var_env) v = lookupVarEnv var_env v `orElse` v
  131 
  132 -- tidyBndr is used for lambda and case binders
  133 tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)
  134 tidyBndr env var
  135   | isTyCoVar var = tidyVarBndr env var
  136   | otherwise     = tidyIdBndr env var
  137 
  138 tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
  139 tidyBndrs env vars = mapAccumL tidyBndr env vars
  140 
  141 -- Non-top-level variables, not covars
  142 tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
  143 tidyIdBndr env@(tidy_env, var_env) id
  144   = -- Do this pattern match strictly, otherwise we end up holding on to
  145     -- stuff in the OccName.
  146     case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') ->
  147     let
  148         -- Give the Id a fresh print-name, *and* rename its type
  149         -- The SrcLoc isn't important now,
  150         -- though we could extract it from the Id
  151         --
  152         ty'      = tidyType env (idType id)
  153         mult'    = tidyType env (idMult id)
  154         name'    = mkInternalName (idUnique id) occ' noSrcSpan
  155         id'      = mkLocalIdWithInfo name' mult' ty' new_info
  156         var_env' = extendVarEnv var_env id id'
  157 
  158         -- Note [Tidy IdInfo]
  159         new_info = vanillaIdInfo `setOccInfo` occInfo old_info
  160                                  `setUnfoldingInfo` new_unf
  161                                   -- see Note [Preserve OneShotInfo]
  162                                  `setOneShotInfo` oneShotInfo old_info
  163         old_info = idInfo id
  164         old_unf  = realUnfoldingInfo old_info
  165         new_unf  = zapUnfolding old_unf  -- See Note [Preserve evaluatedness]
  166     in
  167     ((tidy_env', var_env'), id')
  168    }
  169 
  170 tidyLetBndr :: TidyEnv         -- Knot-tied version for unfoldings
  171             -> TidyEnv         -- The one to extend
  172             -> Id -> (TidyEnv, Id)
  173 -- Used for local (non-top-level) let(rec)s
  174 -- Just like tidyIdBndr above, but with more IdInfo
  175 tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id
  176   = case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') ->
  177     let
  178         ty'      = tidyType env (idType id)
  179         mult'    = tidyType env (idMult id)
  180         name'    = mkInternalName (idUnique id) occ' noSrcSpan
  181         details  = idDetails id
  182         id'      = mkLocalVar details name' mult' ty' new_info
  183         var_env' = extendVarEnv var_env id id'
  184 
  185         -- Note [Tidy IdInfo]
  186         -- We need to keep around any interesting strictness and
  187         -- demand info because later on we may need to use it when
  188         -- converting to A-normal form.
  189         -- eg.
  190         --      f (g x),  where f is strict in its argument, will be converted
  191         --      into  case (g x) of z -> f z  by CorePrep, but only if f still
  192         --      has its strictness info.
  193         --
  194         -- Similarly for the demand info - on a let binder, this tells
  195         -- CorePrep to turn the let into a case.
  196         -- But: Remove the usage demand here
  197         --      (See Note [Zapping DmdEnv after Demand Analyzer] in GHC.Core.Opt.WorkWrap)
  198         --
  199         -- Similarly arity info for eta expansion in CorePrep
  200         -- Don't attempt to recompute arity here; this is just tidying!
  201         -- Trying to do so led to #17294
  202         --
  203         -- Set inline-prag info so that we preserve it across
  204         -- separate compilation boundaries
  205         old_info = idInfo id
  206         new_info = vanillaIdInfo
  207                     `setOccInfo`        occInfo old_info
  208                     `setArityInfo`      arityInfo old_info
  209                     `setDmdSigInfo` zapDmdEnvSig (dmdSigInfo old_info)
  210                     `setDemandInfo`     demandInfo old_info
  211                     `setInlinePragInfo` inlinePragInfo old_info
  212                     `setUnfoldingInfo`  new_unf
  213 
  214         old_unf = realUnfoldingInfo old_info
  215         new_unf | isStableUnfolding old_unf = tidyUnfolding rec_tidy_env old_unf old_unf
  216                 | otherwise                 = zapUnfolding old_unf
  217                                               -- See Note [Preserve evaluatedness]
  218 
  219     in
  220     ((tidy_env', var_env'), id') }
  221 
  222 ------------ Unfolding  --------------
  223 tidyUnfolding :: TidyEnv -> Unfolding -> Unfolding -> Unfolding
  224 tidyUnfolding tidy_env df@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) _
  225   = df { df_bndrs = bndrs', df_args = map (tidyExpr tidy_env') args }
  226   where
  227     (tidy_env', bndrs') = tidyBndrs tidy_env bndrs
  228 
  229 tidyUnfolding tidy_env
  230               unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })
  231               unf_from_rhs
  232   | isStableSource src
  233   = seqIt $ unf { uf_tmpl = tidyExpr tidy_env unf_rhs }    -- Preserves OccInfo
  234     -- This seqIt avoids a space leak: otherwise the uf_is_value,
  235     -- uf_is_conlike, ... fields may retain a reference to the
  236     -- pre-tidied expression forever (GHC.CoreToIface doesn't look at them)
  237 
  238   | otherwise
  239   = unf_from_rhs
  240   where seqIt unf = seqUnfolding unf `seq` unf
  241 tidyUnfolding _ unf _ = unf     -- NoUnfolding or OtherCon
  242 
  243 {-
  244 Note [Tidy IdInfo]
  245 ~~~~~~~~~~~~~~~~~~
  246 All nested Ids now have the same IdInfo, namely vanillaIdInfo, which
  247 should save some space; except that we preserve occurrence info for
  248 two reasons:
  249 
  250   (a) To make printing tidy core nicer
  251 
  252   (b) Because we tidy RULES and InlineRules, which may then propagate
  253       via --make into the compilation of the next module, and we want
  254       the benefit of that occurrence analysis when we use the rule or
  255       or inline the function.  In particular, it's vital not to lose
  256       loop-breaker info, else we get an infinite inlining loop
  257 
  258 Note that tidyLetBndr puts more IdInfo back.
  259 
  260 Note [Preserve evaluatedness]
  261 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  262 Consider
  263   data T = MkT !Bool
  264   ....(case v of MkT y ->
  265        let z# = case y of
  266                   True -> 1#
  267                   False -> 2#
  268        in ...)
  269 
  270 The z# binding is ok because the RHS is ok-for-speculation,
  271 but Lint will complain unless it can *see* that.  So we
  272 preserve the evaluated-ness on 'y' in tidyBndr.
  273 
  274 (Another alternative would be to tidy unboxed lets into cases,
  275 but that seems more indirect and surprising.)
  276 
  277 Note [Preserve OneShotInfo]
  278 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
  279 We keep the OneShotInfo because we want it to propagate into the interface.
  280 Not all OneShotInfo is determined by a compiler analysis; some is added by a
  281 call of GHC.Exts.oneShot, which is then discarded before the end of the
  282 optimisation pipeline, leaving only the OneShotInfo on the lambda. Hence we
  283 must preserve this info in inlinings. See Note [The oneShot function] in GHC.Types.Id.Make.
  284 
  285 This applies to lambda binders only, hence it is stored in IfaceLamBndr.
  286 -}
  287 
  288 (=:) :: a -> (a -> b) -> b
  289 m =: k = m `seq` k m