coreSyn/CoreTidy.hs

    {-
    (c) The University of Glasgow 2006
    (c) The AQUA Project, Glasgow University, 1996-1998

    This module contains "tidying" code for *nested* expressions, bindings, rules.
    The code for *top-level* bindings is in TidyPgm.
    -}

    {-# LANGUAGE CPP #-}
    module CoreTidy (
            tidyExpr, tidyVarOcc, tidyRule, tidyRules, tidyUnfolding
        ) where

    #include "HsVersions.h"

    import CoreSyn
    import CoreUnfold ( mkCoreUnfolding )
    import CoreArity
    import Id
    import IdInfo
    import Demand ( zapUsageEnvSig )
    import Type( tidyType, tidyTyCoVarBndr )
    import Coercion( tidyCo )
    import Var
    import VarEnv
    import UniqFM
    import Name hiding (tidyNameOcc)
    import SrcLoc
    import Maybes
    import Data.List

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Tidying expressions, rules}
    *                                                                      *
    ************************************************************************
    -}

    tidyBind :: TidyEnv
             -> CoreBind
             ->  (TidyEnv, CoreBind)

    tidyBind env (NonRec bndr rhs)
      = tidyLetBndr env env (bndr,rhs) =: \ (env', bndr') ->
        (env', NonRec bndr' (tidyExpr env' rhs))

    tidyBind env (Rec prs)
      = let
           (env', bndrs') = mapAccumL (tidyLetBndr env') env prs
        in
        map (tidyExpr env') (map snd prs)   =: \ rhss' ->
        (env', Rec (zip bndrs' rhss'))

    ------------  Expressions  --------------
    tidyExpr :: TidyEnv -> CoreExpr -> CoreExpr
    tidyExpr env (Var v)       = Var (tidyVarOcc env v)
    tidyExpr env (Type ty)     = Type (tidyType env ty)
    tidyExpr env (Coercion co) = Coercion (tidyCo env co)
    tidyExpr _   (Lit lit)     = Lit lit
    tidyExpr env (App f a)     = App (tidyExpr env f) (tidyExpr env a)
    tidyExpr env (Tick t e)    = Tick (tidyTickish env t) (tidyExpr env e)
    tidyExpr env (Cast e co)   = Cast (tidyExpr env e) (tidyCo env co)

    tidyExpr env (Let b e)
      = tidyBind env b      =: \ (env', b') ->
        Let b' (tidyExpr env' e)

    tidyExpr env (Case e b ty alts)
      = tidyBndr env b  =: \ (env', b) ->
        Case (tidyExpr env e) b (tidyType env ty)
             (map (tidyAlt env') alts)

    tidyExpr env (Lam b e)
      = tidyBndr env b      =: \ (env', b) ->
        Lam b (tidyExpr env' e)

    ------------  Case alternatives  --------------
    tidyAlt :: TidyEnv -> CoreAlt -> CoreAlt
    tidyAlt env (con, vs, rhs)
      = tidyBndrs env vs    =: \ (env', vs) ->
        (con, vs, tidyExpr env' rhs)

    ------------  Tickish  --------------
    tidyTickish :: TidyEnv -> Tickish Id -> Tickish Id
    tidyTickish env (Breakpoint ix ids) = Breakpoint ix (map (tidyVarOcc env) ids)
    tidyTickish _   other_tickish       = other_tickish

    ------------  Rules  --------------
    tidyRules :: TidyEnv -> [CoreRule] -> [CoreRule]
    tidyRules _   [] = []
    tidyRules env (rule : rules)
      = tidyRule env rule           =: \ rule ->
        tidyRules env rules         =: \ rules ->
        (rule : rules)

    tidyRule :: TidyEnv -> CoreRule -> CoreRule
    tidyRule _   rule@(BuiltinRule {}) = rule
    tidyRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs,
                              ru_fn = fn, ru_rough = mb_ns })
      = tidyBndrs env bndrs         =: \ (env', bndrs) ->
        map (tidyExpr env') args    =: \ args ->
        rule { ru_bndrs = bndrs, ru_args = args,
               ru_rhs   = tidyExpr env' rhs,
               ru_fn    = tidyNameOcc env fn,
               ru_rough = map (fmap (tidyNameOcc env')) mb_ns }

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Tidying non-top-level binders}
    *                                                                      *
    ************************************************************************
    -}

    tidyNameOcc :: TidyEnv -> Name -> Name
    -- In rules and instances, we have Names, and we must tidy them too
    -- Fortunately, we can lookup in the VarEnv with a name
    tidyNameOcc (_, var_env) n = case lookupUFM var_env n of
                                    Nothing -> n
                                    Just v  -> idName v

    tidyVarOcc :: TidyEnv -> Var -> Var
    tidyVarOcc (_, var_env) v = lookupVarEnv var_env v `orElse` v

    -- tidyBndr is used for lambda and case binders
    tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)
    tidyBndr env var
      | isTyCoVar var = tidyTyCoVarBndr env var
      | otherwise     = tidyIdBndr env var

    tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
    tidyBndrs env vars = mapAccumL tidyBndr env vars

    -- Non-top-level variables, not covars
    tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
    tidyIdBndr env@(tidy_env, var_env) id
      = -- Do this pattern match strictly, otherwise we end up holding on to
        -- stuff in the OccName.
        case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') ->
        let
            -- Give the Id a fresh print-name, *and* rename its type
            -- The SrcLoc isn't important now,
            -- though we could extract it from the Id
            --
            ty'      = tidyType env (idType id)
            name'    = mkInternalName (idUnique id) occ' noSrcSpan
            id'      = mkLocalIdWithInfo name' ty' new_info
            var_env' = extendVarEnv var_env id id'

            -- Note [Tidy IdInfo]
            new_info = vanillaIdInfo `setOccInfo` occInfo old_info
                                     `setUnfoldingInfo` new_unf
                                      -- see Note [Preserve OneShotInfo]
                                     `setOneShotInfo` oneShotInfo old_info
            old_info = idInfo id
            old_unf  = unfoldingInfo old_info
            new_unf | isEvaldUnfolding old_unf = evaldUnfolding
                    | otherwise                = noUnfolding
              -- See Note [Preserve evaluatedness]
        in
        ((tidy_env', var_env'), id')
       }

    tidyLetBndr :: TidyEnv         -- Knot-tied version for unfoldings
                -> TidyEnv         -- The one to extend
                -> (Id, CoreExpr) -> (TidyEnv, Var)
    -- Used for local (non-top-level) let(rec)s
    -- Just like tidyIdBndr above, but with more IdInfo
    tidyLetBndr rec_tidy_env env@(tidy_env, var_env) (id,rhs)
      = case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') ->
        let
            ty'      = tidyType env (idType id)
            name'    = mkInternalName (idUnique id) occ' noSrcSpan
            details  = idDetails id
            id'      = mkLocalVar details name' ty' new_info
            var_env' = extendVarEnv var_env id id'

            -- Note [Tidy IdInfo]
            -- We need to keep around any interesting strictness and
            -- demand info because later on we may need to use it when
            -- converting to A-normal form.
            -- eg.
            --      f (g x),  where f is strict in its argument, will be converted
            --      into  case (g x) of z -> f z  by CorePrep, but only if f still
            --      has its strictness info.
            --
            -- Similarly for the demand info - on a let binder, this tells
            -- CorePrep to turn the let into a case.
            -- But: Remove the usage demand here
            --      (See Note [Zapping DmdEnv after Demand Analyzer] in WorkWrap)
            --
            -- Similarly arity info for eta expansion in CorePrep
            --
            -- Set inline-prag info so that we preseve it across
            -- separate compilation boundaries
            old_info = idInfo id
            new_info = vanillaIdInfo
                        `setOccInfo`        occInfo old_info
                        `setArityInfo`      exprArity rhs
                        `setStrictnessInfo` zapUsageEnvSig (strictnessInfo old_info)
                        `setDemandInfo`     demandInfo old_info
                        `setInlinePragInfo` inlinePragInfo old_info
                        `setUnfoldingInfo`  new_unf

            new_unf | isStableUnfolding old_unf = tidyUnfolding rec_tidy_env old_unf old_unf
                    | isEvaldUnfolding  old_unf = evaldUnfolding
                                                  -- See Note [Preserve evaluatedness]
                    | otherwise                 = noUnfolding
            old_unf = unfoldingInfo old_info
        in
        ((tidy_env', var_env'), id') }

    ------------ Unfolding  --------------
    tidyUnfolding :: TidyEnv -> Unfolding -> Unfolding -> Unfolding
    tidyUnfolding tidy_env df@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) _
      = df { df_bndrs = bndrs', df_args = map (tidyExpr tidy_env') args }
      where
        (tidy_env', bndrs') = tidyBndrs tidy_env bndrs

    tidyUnfolding tidy_env
                  (CoreUnfolding { uf_tmpl = unf_rhs, uf_is_top = top_lvl
                                 , uf_src = src, uf_guidance = guidance })
                  unf_from_rhs
      | isStableSource src
      = mkCoreUnfolding src top_lvl (tidyExpr tidy_env unf_rhs) guidance
        -- Preserves OccInfo

        -- Note that uf_is_value and friends may be a thunk containing a reference
        -- to the old template. Consequently it is important that we rebuild them,
        -- despite the fact that they won't change, to avoid a space leak (since,
        -- e.g., ToIface doesn't look at them; see #13564). This is the same
        -- approach we use in Simplify.simplUnfolding and TcIface.tcUnfolding.

      | otherwise
      = unf_from_rhs
    tidyUnfolding _ unf _ = unf     -- NoUnfolding or OtherCon

    {-
    Note [Tidy IdInfo]
    ~~~~~~~~~~~~~~~~~~
    All nested Ids now have the same IdInfo, namely vanillaIdInfo, which
    should save some space; except that we preserve occurrence info for
    two reasons:

      (a) To make printing tidy core nicer

      (b) Because we tidy RULES and InlineRules, which may then propagate
          via --make into the compilation of the next module, and we want
          the benefit of that occurrence analysis when we use the rule or
          or inline the function.  In particular, it's vital not to lose
          loop-breaker info, else we get an infinite inlining loop

    Note that tidyLetBndr puts more IdInfo back.

    Note [Preserve evaluatedness]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider
      data T = MkT !Bool
      ....(case v of MkT y ->
           let z# = case y of
                      True -> 1#
                      False -> 2#
           in ...)

    The z# binding is ok because the RHS is ok-for-speculation,
    but Lint will complain unless it can *see* that.  So we
    preserve the evaluated-ness on 'y' in tidyBndr.

    (Another alternative would be to tidy unboxed lets into cases,
    but that seems more indirect and surprising.)

    Note [Preserve OneShotInfo]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We keep the OneShotInfo because we want it to propagate into the interface.
    Not all OneShotInfo is determined by a compiler analysis; some is added by a
    call of GHC.Exts.oneShot, which is then discarded before the end of the
    optimisation pipeline, leaving only the OneShotInfo on the lambda. Hence we
    must preserve this info in inlinings. See Note [The oneShot function] in MkId.

    This applies to lambda binders only, hence it is stored in IfaceLamBndr.
    -}

    (=:) :: a -> (a -> b) -> b
    m =: k = m `seq` k m