ghc/compiler/coreSyn/CoreTidy.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section{Tidying up Core}
   5
   6 \begin{code}
   7 module CoreTidy (
   8         tidyCorePgm, tidyExpr, tidyCoreExpr,
   9         tidyBndr, tidyBndrs
  10     ) where
  11
  12 #include "HsVersions.h"
  13
  14 import CmdLineOpts      ( DynFlags, DynFlag(..), opt_OmitInterfacePragmas )
  15 import CoreSyn
  16 import CoreUnfold       ( noUnfolding, mkTopUnfolding, okToUnfoldInHiFile )
  17 import CoreFVs          ( ruleSomeFreeVars, exprSomeFreeVars )
  18 import CoreLint         ( showPass, endPass )
  19 import VarEnv
  20 import VarSet
  21 import Var              ( Id, Var )
  22 import Id               ( idType, idInfo, idName, isExportedId,
  23                           idSpecialisation, idUnique, isDataConWrapId,
  24                           mkVanillaGlobal, isLocalId, isRecordSelector,
  25                           setIdUnfolding, hasNoBinding, mkUserLocal
  26                         )
  27 import IdInfo           {- loads of stuff -}
  28 import Name             ( getOccName, nameOccName, globaliseName, setNameOcc,
  29                           localiseName, isGlobalName
  30                         )
  31 import NameEnv          ( filterNameEnv )
  32 import OccName          ( TidyOccEnv, initTidyOccEnv, tidyOccName )
  33 import Type             ( tidyTopType, tidyType, tidyTyVar )
  34 import Module           ( Module, moduleName )
  35 import HscTypes         ( PersistentCompilerState( pcs_PRS ),
  36                           PersistentRenamerState( prsOrig ),
  37                           NameSupply( nsNames ), OrigNameCache,
  38                           TypeEnv, extendTypeEnvList,
  39                           ModDetails(..), TyThing(..)
  40                         )
  41 import FiniteMap        ( lookupFM, addToFM )
  42 import Maybes           ( maybeToBool, orElse )
  43 import ErrUtils         ( showPass )
  44 import SrcLoc           ( noSrcLoc )
  45 import UniqFM           ( mapUFM )
  46 import List             ( partition )
  47 import Util             ( mapAccumL )
  48 import Outputable
  49 \end{code}
  50
  51
  52
  53 %************************************************************************
  54 %*                                                                      *
  55 \subsection{What goes on}
  56 %*                                                                      *
  57 %************************************************************************
  58
  59 [SLPJ: 19 Nov 00]
  60
  61 The plan is this.
  62
  63 Step 1: Figure out external Ids
  64 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  65 First we figure out which Ids are "external" Ids.  An
  66 "external" Id is one that is visible from outside the compilation
  67 unit.  These are
  68         a) the user exported ones
  69         b) ones mentioned in the unfoldings, workers,
  70            or rules of externally-visible ones
  71 This exercise takes a sweep of the bindings bottom to top.  Actually,
  72 in Step 2 we're also going to need to know which Ids should be
  73 exported with their unfoldings, so we produce not an IdSet but an
  74 IdEnv Bool
  75
  76
  77 Step 2: Tidy the program
  78 ~~~~~~~~~~~~~~~~~~~~~~~~
  79 Next we traverse the bindings top to bottom.  For each top-level
  80 binder
  81
  82   - Make all external Ids have Global names and vice versa
  83     This is used by the code generator to decide whether
  84     to make the label externally visible
  85
  86   - Give external ids a "tidy" occurrence name.  This means
  87     we can print them in interface files without confusing
  88     "x" (unique 5) with "x" (unique 10).
  89
  90   - Give external Ids the same Unique as they had before
  91     if the name is in the renamer's name cache
  92
  93   - Give the Id its UTTERLY FINAL IdInfo; in ptic,
  94         * Its IdDetails becomes VanillaGlobal, reflecting the fact that
  95           from now on we regard it as a global, not local, Id
  96
  97         * its unfolding, if it should have one
  98
  99         * its arity, computed from the number of visible lambdas
 100
 101         * its CAF info, computed from what is free in its RHS
 102
 103
 104 Finally, substitute these new top-level binders consistently
 105 throughout, including in unfoldings.  We also tidy binders in
 106 RHSs, so that they print nicely in interfaces.
 107
 108 \begin{code}
 109 tidyCorePgm :: DynFlags -> Module
 110             -> PersistentCompilerState
 111             -> CgInfoEnv                -- Information from the back end,
 112                                         -- to be splatted into the IdInfo
 113             -> ModDetails
 114             -> IO (PersistentCompilerState, ModDetails)
 115
 116 tidyCorePgm dflags mod pcs cg_info_env
 117             (ModDetails { md_types = env_tc, md_insts = insts_tc,
 118                           md_binds = binds_in, md_rules = orphans_in })
 119   = do  { showPass dflags "Tidy Core"
 120
 121         ; let ext_ids   = findExternalSet   binds_in orphans_in
 122         ; let ext_rules = findExternalRules binds_in orphans_in ext_ids
 123
 124         ; let ((orig_env', occ_env, subst_env), tidy_binds)
 125                         = mapAccumL (tidyTopBind mod ext_ids cg_info_env)
 126                                     init_tidy_env binds_in
 127
 128         ; let tidy_rules = tidyIdRules (occ_env,subst_env) ext_rules
 129
 130         ; let prs' = prs { prsOrig = orig { nsNames = orig_env' } }
 131               pcs' = pcs { pcs_PRS = prs' }
 132
 133         ; let final_ids  = [ id | bind <- tidy_binds
 134                            , id <- bindersOf bind
 135                            , isGlobalName (idName id)]
 136
 137                 -- Dfuns are local Ids that might have
 138                 -- changed their unique during tidying
 139         ; let lookup_dfun_id id = lookupVarEnv subst_env id `orElse`
 140                                   pprPanic "lookup_dfun_id" (ppr id)
 141
 142
 143         ; let tidy_type_env = mkFinalTypeEnv env_tc final_ids
 144               tidy_dfun_ids = map lookup_dfun_id insts_tc
 145
 146         ; let tidy_details = ModDetails { md_types = tidy_type_env,
 147                                           md_rules = tidy_rules,
 148                                           md_insts = tidy_dfun_ids,
 149                                           md_binds = tidy_binds }
 150
 151         ; endPass dflags "Tidy Core" Opt_D_dump_simpl tidy_binds
 152
 153         ; return (pcs', tidy_details)
 154         }
 155   where
 156         -- We also make sure to avoid any exported binders.  Consider
 157         --      f{-u1-} = 1     -- Local decl
 158         --      ...
 159         --      f{-u2-} = 2     -- Exported decl
 160         --
 161         -- The second exported decl must 'get' the name 'f', so we
 162         -- have to put 'f' in the avoids list before we get to the first
 163         -- decl.  tidyTopId then does a no-op on exported binders.
 164     prs              = pcs_PRS pcs
 165     orig             = prsOrig prs
 166     orig_env         = nsNames orig
 167
 168     init_tidy_env    = (orig_env, initTidyOccEnv avoids, emptyVarEnv)
 169     avoids           = [getOccName bndr | bndr <- bindersOfBinds binds_in,
 170                                           isGlobalName (idName bndr)]
 171
 172 tidyCoreExpr :: CoreExpr -> IO CoreExpr
 173 tidyCoreExpr expr = return (tidyExpr emptyTidyEnv expr)
 174 \end{code}
 175
 176
 177 %************************************************************************
 178 %*                                                                      *
 179 \subsection{Write a new interface file}
 180 %*                                                                      *
 181 %************************************************************************
 182
 183 \begin{code}
 184 mkFinalTypeEnv :: TypeEnv       -- From typechecker
 185                -> [Id]          -- Final Ids
 186                -> TypeEnv
 187
 188 mkFinalTypeEnv type_env final_ids
 189   = extendTypeEnvList (filterNameEnv keep_it type_env)
 190                       (map AnId final_ids)
 191   where
 192         -- The competed type environment is gotten from
 193         --      a) keeping the types and classes
 194         --      b) removing all Ids,
 195         --      c) adding Ids with correct IdInfo, including unfoldings,
 196         --              gotten from the bindings
 197         -- From (c) we keep only those Ids with Global names;
 198         --          the CoreTidy pass makes sure these are all and only
 199         --          the externally-accessible ones
 200         -- This truncates the type environment to include only the
 201         -- exported Ids and things needed from them, which saves space
 202         --
 203         -- However, we do keep things like constructors, which should not appear
 204         -- in interface files, because they are needed by importing modules when
 205         -- using the compilation manager
 206
 207         -- We keep "hasNoBinding" Ids, notably constructor workers,
 208         -- because they won't appear in the bindings from which final_ids are derived!
 209     keep_it (AnId id) = hasNoBinding id -- Remove all Ids except constructor workers
 210     keep_it other     = True            -- Keep all TyCons and Classes
 211 \end{code}
 212
 213 \begin{code}
 214 findExternalRules :: [CoreBind]
 215                   -> [IdCoreRule] -- Orphan rules
 216                   -> IdEnv a      -- Ids that are exported, so we need their rules
 217                   -> [IdCoreRule]
 218   -- The complete rules are gotten by combining
 219   --    a) the orphan rules
 220   --    b) rules embedded in the top-level Ids
 221 findExternalRules binds orphan_rules ext_ids
 222   | opt_OmitInterfacePragmas = []
 223   | otherwise
 224   = orphan_rules ++ local_rules
 225   where
 226     local_rules  = [ (id, rule)
 227                    | id <- bindersOfBinds binds,
 228                      id `elemVarEnv` ext_ids,
 229                      rule <- rulesRules (idSpecialisation id),
 230                      not (isBuiltinRule rule)
 231                         -- We can't print builtin rules in interface files
 232                         -- Since they are built in, an importing module
 233                         -- will have access to them anyway
 234                  ]
 235 \end{code}
 236
 237 %************************************************************************
 238 %*                                                                      *
 239 \subsection{Step 1: finding externals}
 240 %*                                                                      *
 241 %************************************************************************
 242
 243 \begin{code}
 244 findExternalSet :: [CoreBind] -> [IdCoreRule]
 245                 -> IdEnv Bool   -- In domain => external
 246                                 -- Range = True <=> show unfolding
 247         -- Step 1 from the notes above
 248 findExternalSet binds orphan_rules
 249   = foldr find init_needed binds
 250   where
 251     orphan_rule_ids :: IdSet
 252     orphan_rule_ids = unionVarSets [ ruleSomeFreeVars isLocalId rule
 253                                    | (_, rule) <- orphan_rules]
 254     init_needed :: IdEnv Bool
 255     init_needed = mapUFM (\_ -> False) orphan_rule_ids
 256         -- The mapUFM is a bit cheesy.  It is a cheap way
 257         -- to turn the set of orphan_rule_ids, which we use to initialise
 258         -- the sweep, into a mapping saying 'don't expose unfolding'
 259         -- (When we come to the binding site we may change our mind, of course.)
 260
 261     find (NonRec id rhs) needed
 262         | need_id needed id = addExternal (id,rhs) needed
 263         | otherwise         = needed
 264     find (Rec prs) needed   = find_prs prs needed
 265
 266         -- For a recursive group we have to look for a fixed point
 267     find_prs prs needed
 268         | null needed_prs = needed
 269         | otherwise       = find_prs other_prs new_needed
 270         where
 271           (needed_prs, other_prs) = partition (need_pr needed) prs
 272           new_needed = foldr addExternal needed needed_prs
 273
 274         -- The 'needed' set contains the Ids that are needed by earlier
 275         -- interface file emissions.  If the Id isn't in this set, and isn't
 276         -- exported, there's no need to emit anything
 277     need_id needed_set id       = id `elemVarEnv` needed_set || isExportedId id
 278     need_pr needed_set (id,rhs) = need_id needed_set id
 279
 280 addExternal :: (Id,CoreExpr) -> IdEnv Bool -> IdEnv Bool
 281 -- The Id is needed; extend the needed set
 282 -- with it and its dependents (free vars etc)
 283 addExternal (id,rhs) needed
 284   = extendVarEnv (foldVarSet add_occ needed new_needed_ids)
 285                  id show_unfold
 286   where
 287     add_occ id needed = extendVarEnv needed id False
 288         -- "False" because we don't know we need the Id's unfolding
 289         -- We'll override it later when we find the binding site
 290
 291     new_needed_ids | opt_OmitInterfacePragmas = emptyVarSet
 292                    | otherwise                = worker_ids      `unionVarSet`
 293                                                 unfold_ids      `unionVarSet`
 294                                                 spec_ids
 295
 296     idinfo         = idInfo id
 297     dont_inline    = isNeverInlinePrag (inlinePragInfo idinfo)
 298     loop_breaker   = isLoopBreaker (occInfo idinfo)
 299     bottoming_fn   = isBottomingStrictness (strictnessInfo idinfo)
 300     spec_ids       = rulesRhsFreeVars (specInfo idinfo)
 301     worker_info    = workerInfo idinfo
 302
 303         -- Stuff to do with the Id's unfolding
 304         -- The simplifier has put an up-to-date unfolding
 305         -- in the IdInfo, but the RHS will do just as well
 306     unfolding    = unfoldingInfo idinfo
 307     rhs_is_small = not (neverUnfold unfolding)
 308
 309         -- We leave the unfolding there even if there is a worker
 310         -- In GHCI the unfolding is used by importers
 311         -- When writing an interface file, we omit the unfolding
 312         -- if there is a worker
 313     show_unfold = not bottoming_fn       &&     -- Not necessary
 314                   not dont_inline        &&
 315                   not loop_breaker       &&
 316                   rhs_is_small           &&     -- Small enough
 317                   okToUnfoldInHiFile rhs        -- No casms etc
 318
 319     unfold_ids | show_unfold = exprSomeFreeVars isLocalId rhs
 320                | otherwise   = emptyVarSet
 321
 322     worker_ids = case worker_info of
 323                    HasWorker work_id _ -> unitVarSet work_id
 324                    otherwise           -> emptyVarSet
 325 \end{code}
 326
 327
 328 %************************************************************************
 329 %*                                                                      *
 330 \subsection{Step 2: top-level tidying}
 331 %*                                                                      *
 332 %************************************************************************
 333
 334
 335 \begin{code}
 336 type TopTidyEnv = (OrigNameCache, TidyOccEnv, VarEnv Var)
 337
 338 -- TopTidyEnv: when tidying we need to know
 339 --   * orig_env: Any pre-ordained Names.  These may have arisen because the
 340 --        renamer read in an interface file mentioning M.$wf, say,
 341 --        and assigned it unique r77.  If, on this compilation, we've
 342 --        invented an Id whose name is $wf (but with a different unique)
 343 --        we want to rename it to have unique r77, so that we can do easy
 344 --        comparisons with stuff from the interface file
 345 --
 346 --   * occ_env: The TidyOccEnv, which tells us which local occurrences
 347 --     are 'used'
 348 --
 349 --   * subst_env: A Var->Var mapping that substitutes the new Var for the old
 350 \end{code}
 351
 352
 353 \begin{code}
 354 tidyTopBind :: Module
 355             -> IdEnv Bool       -- Domain = Ids that should be external
 356                                 -- True <=> their unfolding is external too
 357             -> CgInfoEnv
 358             -> TopTidyEnv -> CoreBind
 359             -> (TopTidyEnv, CoreBind)
 360
 361 tidyTopBind mod ext_ids cg_info_env top_tidy_env (NonRec bndr rhs)
 362   = ((orig,occ,subst) , NonRec bndr' rhs')
 363   where
 364     ((orig,occ,subst), bndr')
 365          = tidyTopBinder mod ext_ids cg_info_env rec_tidy_env rhs' top_tidy_env bndr
 366     rec_tidy_env = (occ,subst)
 367     rhs' = tidyExpr rec_tidy_env rhs
 368
 369 tidyTopBind mod ext_ids cg_info_env top_tidy_env (Rec prs)
 370   = (final_env, Rec prs')
 371   where
 372     (final_env@(_,occ,subst), prs') = mapAccumL do_one top_tidy_env prs
 373     rec_tidy_env = (occ,subst)
 374
 375     do_one top_tidy_env (bndr,rhs)
 376         = ((orig,occ,subst), (bndr',rhs'))
 377         where
 378         ((orig,occ,subst), bndr')
 379            = tidyTopBinder mod ext_ids cg_info_env
 380                 rec_tidy_env rhs' top_tidy_env bndr
 381
 382         rhs' = tidyExpr rec_tidy_env rhs
 383
 384 tidyTopBinder :: Module -> IdEnv Bool
 385               -> CgInfoEnv
 386               -> TidyEnv -> CoreExpr
 387                         -- The TidyEnv is used to tidy the IdInfo
 388                         -- The expr is the already-tided RHS
 389                         -- Both are knot-tied: don't look at them!
 390               -> TopTidyEnv -> Id -> (TopTidyEnv, Id)
 391   -- NB: tidyTopBinder doesn't affect the unique supply
 392
 393 tidyTopBinder mod ext_ids cg_info_env tidy_env rhs
 394               env@(orig_env2, occ_env2, subst_env2) id
 395
 396   | isDataConWrapId id  -- Don't tidy constructor wrappers
 397   = (env, id)           -- The Id is stored in the TyCon, so it would be bad
 398                         -- if anything changed
 399
 400 -- HACK ALERT: we *do* tidy record selectors.  Reason: they mention error
 401 -- messages, which may be floated out:
 402 --      x_field pt = case pt of
 403 --                      Rect x y -> y
 404 --                      Pol _ _  -> error "buggle wuggle"
 405 -- The error message will be floated out so we'll get
 406 --      lvl5 = error "buggle wuggle"
 407 --      x_field pt = case pt of
 408 --                      Rect x y -> y
 409 --                      Pol _ _  -> lvl5
 410 --
 411 -- When this happens, it's vital that the Id exposed to importing modules
 412 -- (by ghci) mentions lvl5 in its unfolding, not the un-tidied version.
 413 --
 414 -- What about the Id in the TyCon?  It probably shouldn't be in the TyCon at
 415 -- all, but in any case it will have the error message inline so it won't matter.
 416
 417
 418   | isRecordSelector id -- We can't use the "otherwise" case, because that
 419                         -- forgets the IdDetails, which forgets that this is
 420                         -- a record selector, which confuses an importing module
 421   = (env, id `setIdUnfolding` unfold_info)
 422
 423   | otherwise
 424         -- This function is the heart of Step 2
 425         -- The second env is the one to use for the IdInfo
 426         -- It's necessary because when we are dealing with a recursive
 427         -- group, a variable late in the group might be mentioned
 428         -- in the IdInfo of one early in the group
 429
 430         -- The rhs is already tidied
 431
 432   = ((orig_env', occ_env', subst_env'), id')
 433   where
 434     (orig_env', occ_env', name') = tidyTopName mod orig_env2 occ_env2
 435                                                is_external
 436                                                (idName id)
 437     ty'     = tidyTopType (idType id)
 438     cg_info = lookupCgInfo cg_info_env name'
 439     idinfo' = tidyIdInfo tidy_env is_external unfold_info cg_info id
 440
 441     id'        = mkVanillaGlobal name' ty' idinfo'
 442     subst_env' = extendVarEnv subst_env2 id id'
 443
 444     maybe_external = lookupVarEnv ext_ids id
 445     is_external    = maybeToBool maybe_external
 446
 447     -- Expose an unfolding if ext_ids tells us to
 448     show_unfold = maybe_external `orElse` False
 449     unfold_info | show_unfold = mkTopUnfolding rhs
 450                 | otherwise   = noUnfolding
 451
 452
 453 tidyIdInfo tidy_env is_external unfold_info cg_info id
 454   | opt_OmitInterfacePragmas || not is_external
 455         -- No IdInfo if the Id isn't external, or if we don't have -O
 456   = vanillaIdInfo
 457         `setCgInfo`         cg_info
 458         `setStrictnessInfo` strictnessInfo core_idinfo
 459         -- Keep strictness; it's used by CorePrep
 460
 461   | otherwise
 462   =  vanillaIdInfo
 463         `setCgInfo`         cg_info
 464         `setCprInfo`        cprInfo core_idinfo
 465         `setStrictnessInfo` strictnessInfo core_idinfo
 466         `setInlinePragInfo` inlinePragInfo core_idinfo
 467         `setUnfoldingInfo`  unfold_info
 468         `setWorkerInfo`     tidyWorker tidy_env (workerInfo core_idinfo)
 469         -- NB: we throw away the Rules
 470         -- They have already been extracted by findExternalRules
 471   where
 472     core_idinfo = idInfo id
 473
 474
 475 -- This is where we set names to local/global based on whether they really are
 476 -- externally visible (see comment at the top of this module).  If the name
 477 -- was previously local, we have to give it a unique occurrence name if
 478 -- we intend to globalise it.
 479 tidyTopName mod orig_env occ_env external name
 480   | global && internal = (orig_env, occ_env, localiseName name)
 481
 482   | local  && internal = (orig_env, occ_env', setNameOcc name occ')
 483         -- Even local, internal names must get a unique occurrence, because
 484         -- if we do -split-objs we globalise the name later, n the code generator
 485
 486   | global && external = (orig_env, occ_env, name)
 487         -- Global names are assumed to have been allocated by the renamer,
 488         -- so they already have the "right" unique
 489
 490   | local  && external = case lookupFM orig_env key of
 491                            Just orig -> (orig_env,                         occ_env', orig)
 492                            Nothing   -> (addToFM orig_env key global_name, occ_env', global_name)
 493         -- If we want to globalise a currently-local name, check
 494         -- whether we have already assigned a unique for it.
 495         -- If so, use it; if not, extend the table
 496
 497   where
 498     (occ_env', occ') = tidyOccName occ_env (nameOccName name)
 499     key              = (moduleName mod, occ')
 500     global_name      = globaliseName (setNameOcc name occ') mod
 501     global           = isGlobalName name
 502     local            = not global
 503     internal         = not external
 504
 505 ------------  Worker  --------------
 506 tidyWorker tidy_env (HasWorker work_id wrap_arity)
 507   = HasWorker (tidyVarOcc tidy_env work_id) wrap_arity
 508 tidyWorker tidy_env other
 509   = NoWorker
 510
 511 ------------  Rules  --------------
 512 tidyIdRules :: TidyEnv -> [IdCoreRule] -> [IdCoreRule]
 513 tidyIdRules env [] = []
 514 tidyIdRules env ((fn,rule) : rules)
 515   = tidyRule env rule           =: \ rule ->
 516     tidyIdRules env rules       =: \ rules ->
 517      ((tidyVarOcc env fn, rule) : rules)
 518
 519 tidyRule :: TidyEnv -> CoreRule -> CoreRule
 520 tidyRule env rule@(BuiltinRule _) = rule
 521 tidyRule env (Rule name vars tpl_args rhs)
 522   = tidyBndrs env vars                  =: \ (env', vars) ->
 523     map (tidyExpr env') tpl_args        =: \ tpl_args ->
 524      (Rule name vars tpl_args (tidyExpr env' rhs))
 525 \end{code}
 526
 527 %************************************************************************
 528 %*                                                                      *
 529 \subsection{Step 2: inner tidying
 530 %*                                                                      *
 531 %************************************************************************
 532
 533 \begin{code}
 534 tidyBind :: TidyEnv
 535          -> CoreBind
 536          ->  (TidyEnv, CoreBind)
 537
 538 tidyBind env (NonRec bndr rhs)
 539   = tidyBndrWithRhs env (bndr,rhs) =: \ (env', bndr') ->
 540     (env', NonRec bndr' (tidyExpr env' rhs))
 541
 542 tidyBind env (Rec prs)
 543   = mapAccumL tidyBndrWithRhs env prs   =: \ (env', bndrs') ->
 544     map (tidyExpr env') (map snd prs)   =: \ rhss' ->
 545     (env', Rec (zip bndrs' rhss'))
 546
 547
 548 tidyExpr env (Var v)    =  Var (tidyVarOcc env v)
 549 tidyExpr env (Type ty)  =  Type (tidyType env ty)
 550 tidyExpr env (Lit lit)  =  Lit lit
 551 tidyExpr env (App f a)  =  App (tidyExpr env f) (tidyExpr env a)
 552 tidyExpr env (Note n e) =  Note (tidyNote env n) (tidyExpr env e)
 553
 554 tidyExpr env (Let b e)
 555   = tidyBind env b      =: \ (env', b') ->
 556     Let b' (tidyExpr env' e)
 557
 558 tidyExpr env (Case e b alts)
 559   = tidyBndr env b      =: \ (env', b) ->
 560     Case (tidyExpr env e) b (map (tidyAlt env') alts)
 561
 562 tidyExpr env (Lam b e)
 563   = tidyBndr env b      =: \ (env', b) ->
 564     Lam b (tidyExpr env' e)
 565
 566
 567 tidyAlt env (con, vs, rhs)
 568   = tidyBndrs env vs    =: \ (env', vs) ->
 569     (con, vs, tidyExpr env' rhs)
 570
 571 tidyNote env (Coerce t1 t2)  = Coerce (tidyType env t1) (tidyType env t2)
 572 tidyNote env note            = note
 573 \end{code}
 574
 575
 576 %************************************************************************
 577 %*                                                                      *
 578 \subsection{Tidying up non-top-level binders}
 579 %*                                                                      *
 580 %************************************************************************
 581
 582 \begin{code}
 583 tidyVarOcc (_, var_env) v = case lookupVarEnv var_env v of
 584                                   Just v' -> v'
 585                                   Nothing -> v
 586
 587 -- tidyBndr is used for lambda and case binders
 588 tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)
 589 tidyBndr env var
 590   | isTyVar var = tidyTyVar env var
 591   | otherwise   = tidyId env var
 592
 593 tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
 594 tidyBndrs env vars = mapAccumL tidyBndr env vars
 595
 596 -- tidyBndrWithRhs is used for let binders
 597 tidyBndrWithRhs :: TidyEnv -> (Id, CoreExpr) -> (TidyEnv, Var)
 598 tidyBndrWithRhs env (id,rhs) = tidyId env id
 599
 600 tidyId :: TidyEnv -> Id -> (TidyEnv, Id)
 601 tidyId env@(tidy_env, var_env) id
 602   =     -- Non-top-level variables
 603     let
 604         -- Give the Id a fresh print-name, *and* rename its type
 605         -- The SrcLoc isn't important now,
 606         -- though we could extract it from the Id
 607         --
 608         -- All local Ids now have the same IdInfo, which should save some
 609         -- space.
 610         (tidy_env', occ') = tidyOccName tidy_env (getOccName id)
 611         ty'               = tidyType (tidy_env,var_env) (idType id)
 612         id'               = mkUserLocal occ' (idUnique id) ty' noSrcLoc
 613         var_env'          = extendVarEnv var_env id id'
 614     in
 615      ((tidy_env', var_env'), id')
 616 \end{code}
 617
 618 \begin{code}
 619 m =: k = m `seq` k m
 620 \end{code}