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,
   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 CoreUtils        ( exprArity )
  18 import CoreFVs          ( ruleSomeFreeVars, exprSomeFreeVars )
  19 import CoreLint         ( showPass, endPass )
  20 import VarEnv
  21 import VarSet
  22 import Var              ( Id, Var )
  23 import Id               ( idType, idInfo, idName, isExportedId,
  24                           mkId, isLocalId, omitIfaceSigForId
  25                         )
  26 import IdInfo           ( IdInfo, mkIdInfo, vanillaIdInfo,
  27                           IdFlavour(..), flavourInfo, ppFlavourInfo,
  28                           specInfo, setSpecInfo,
  29                           cprInfo, setCprInfo,
  30                           inlinePragInfo, setInlinePragInfo, isNeverInlinePrag,
  31                           strictnessInfo, setStrictnessInfo,
  32                           isBottomingStrictness,
  33                           unfoldingInfo, setUnfoldingInfo,
  34                           occInfo, isLoopBreaker,
  35                           workerInfo, setWorkerInfo, WorkerInfo(..),
  36                           ArityInfo(..), setArityInfo
  37                         )
  38 import Name             ( getOccName, nameOccName, globaliseName, setNameOcc,
  39                           localiseName, mkLocalName, isGlobalName
  40                         )
  41 import OccName          ( TidyOccEnv, initTidyOccEnv, tidyOccName )
  42 import Type             ( tidyTopType, tidyType, tidyTyVar )
  43 import Module           ( Module, moduleName )
  44 import HscTypes         ( PersistentCompilerState( pcs_PRS ), PersistentRenamerState( prsOrig ),
  45                           OrigNameEnv( origNames ), OrigNameNameEnv
  46                         )
  47 import UniqSupply
  48 import FiniteMap        ( lookupFM, addToFM )
  49 import Maybes           ( maybeToBool, orElse )
  50 import ErrUtils         ( showPass )
  51 import SrcLoc           ( noSrcLoc )
  52 import UniqFM           ( mapUFM )
  53 import Outputable
  54 import List             ( partition )
  55 import Util             ( mapAccumL )
  56 \end{code}
  57
  58
  59
  60 %************************************************************************
  61 %*                                                                      *
  62 \subsection{What goes on}
  63 %*                                                                      *
  64 %************************************************************************
  65
  66 [SLPJ: 19 Nov 00]
  67
  68 The plan is this.
  69
  70 Step 1: Figure out external Ids
  71 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  72 First we figure out which Ids are "external" Ids.  An
  73 "external" Id is one that is visible from outside the compilation
  74 unit.  These are
  75         a) the user exported ones
  76         b) ones mentioned in the unfoldings, workers,
  77            or rules of externally-visible ones
  78 This exercise takes a sweep of the bindings bottom to top.  Actually,
  79 in Step 2 we're also going to need to know which Ids should be
  80 exported with their unfoldings, so we produce not an IdSet but an
  81 IdEnv Bool
  82
  83
  84 Step 2: Tidy the program
  85 ~~~~~~~~~~~~~~~~~~~~~~~~
  86 Next we traverse the bindings top to bottom.  For each top-level
  87 binder
  88
  89   - Make all external Ids have Global names and vice versa
  90     This is used by the code generator to decide whether
  91     to make the label externally visible
  92
  93   - Give external ids a "tidy" occurrence name.  This means
  94     we can print them in interface files without confusing
  95     "x" (unique 5) with "x" (unique 10).
  96
  97   - Give external Ids the same Unique as they had before
  98     if the name is in the renamer's name cache
  99
 100   - Clone all local Ids.  This means that Tidy Core has the property
 101     that all Ids are unique, rather than the weaker guarantee of
 102     no clashes which the simplifier provides.
 103
 104   - Give the Id its final IdInfo; in ptic,
 105         * Its flavour becomes ConstantId, reflecting the fact that
 106           from now on we regard it as a constant, not local, Id
 107         * its unfolding, if it should have one
 108
 109 Finally, substitute these new top-level binders consistently
 110 throughout, including in unfoldings.  We also tidy binders in
 111 RHSs, so that they print nicely in interfaces.
 112
 113 \begin{code}
 114 tidyCorePgm :: DynFlags -> Module
 115             -> PersistentCompilerState
 116             -> [CoreBind] -> [IdCoreRule]
 117             -> IO (PersistentCompilerState, [CoreBind], [IdCoreRule])
 118 tidyCorePgm dflags mod pcs binds_in orphans_in
 119   = do  { showPass dflags "Tidy Core"
 120
 121         ; let ext_ids = findExternalSet binds_in orphans_in
 122
 123         ; us <- mkSplitUniqSupply 't' -- for "tidy"
 124
 125         ; let ((us1, orig_env', occ_env, subst_env), binds_out)
 126                         = mapAccumL (tidyTopBind mod ext_ids)
 127                                     (init_tidy_env us) binds_in
 128
 129         ; let (orphans_out, us2)
 130                    = initUs us1 (tidyIdRules (occ_env,subst_env) orphans_in)
 131
 132         ; let prs' = prs { prsOrig = orig { origNames = orig_env' } }
 133               pcs' = pcs { pcs_PRS = prs' }
 134
 135         ; endPass dflags "Tidy Core" Opt_D_dump_simpl binds_out
 136
 137         ; return (pcs', binds_out, orphans_out)
 138         }
 139   where
 140         -- We also make sure to avoid any exported binders.  Consider
 141         --      f{-u1-} = 1     -- Local decl
 142         --      ...
 143         --      f{-u2-} = 2     -- Exported decl
 144         --
 145         -- The second exported decl must 'get' the name 'f', so we
 146         -- have to put 'f' in the avoids list before we get to the first
 147         -- decl.  tidyTopId then does a no-op on exported binders.
 148     prs              = pcs_PRS pcs
 149     orig             = prsOrig prs
 150     orig_env         = origNames orig
 151
 152     init_tidy_env us = (us, orig_env, initTidyOccEnv avoids, emptyVarEnv)
 153     avoids           = [getOccName bndr | bndr <- bindersOfBinds binds_in,
 154                                        isGlobalName (idName bndr)]
 155 \end{code}
 156
 157
 158 %************************************************************************
 159 %*                                                                      *
 160 \subsection{Step 1: finding externals}
 161 %*                                                                      *
 162 %************************************************************************
 163
 164 \begin{code}
 165 findExternalSet :: [CoreBind] -> [IdCoreRule]
 166                 -> IdEnv Bool   -- True <=> show unfolding
 167         -- Step 1 from the notes above
 168 findExternalSet binds orphan_rules
 169   = foldr find init_needed binds
 170   where
 171     orphan_rule_ids :: IdSet
 172     orphan_rule_ids = unionVarSets [ ruleSomeFreeVars isIdAndLocal rule
 173                                    | (_, rule) <- orphan_rules]
 174     init_needed :: IdEnv Bool
 175     init_needed = mapUFM (\_ -> False) orphan_rule_ids
 176         -- The mapUFM is a bit cheesy.  It is a cheap way
 177         -- to turn the set of orphan_rule_ids, which we use to initialise
 178         -- the sweep, into a mapping saying 'don't expose unfolding'
 179         -- (When we come to the binding site we may change our mind, of course.)
 180
 181     find (NonRec id rhs) needed
 182         | need_id needed id = addExternal (id,rhs) needed
 183         | otherwise         = needed
 184     find (Rec prs) needed   = find_prs prs needed
 185
 186         -- For a recursive group we have to look for a fixed point
 187     find_prs prs needed
 188         | null needed_prs = needed
 189         | otherwise       = find_prs other_prs new_needed
 190         where
 191           (needed_prs, other_prs) = partition (need_pr needed) prs
 192           new_needed = foldr addExternal needed needed_prs
 193
 194         -- The 'needed' set contains the Ids that are needed by earlier
 195         -- interface file emissions.  If the Id isn't in this set, and isn't
 196         -- exported, there's no need to emit anything
 197     need_id needed_set id       = id `elemVarEnv` needed_set || isExportedId id
 198     need_pr needed_set (id,rhs) = need_id needed_set id
 199
 200 isIdAndLocal id = isId id && isLocalId id
 201
 202 addExternal :: (Id,CoreExpr) -> IdEnv Bool -> IdEnv Bool
 203 -- The Id is needed; extend the needed set
 204 -- with it and its dependents (free vars etc)
 205 addExternal (id,rhs) needed
 206   = extendVarEnv (foldVarSet add_occ needed new_needed_ids)
 207                  id show_unfold
 208   where
 209     add_occ id needed = extendVarEnv needed id False
 210         -- "False" because we don't know we need the Id's unfolding
 211         -- We'll override it later when we find the binding site
 212
 213     new_needed_ids | opt_OmitInterfacePragmas = emptyVarSet
 214                    | otherwise                = worker_ids      `unionVarSet`
 215                                                 unfold_ids      `unionVarSet`
 216                                                 spec_ids
 217
 218     idinfo         = idInfo id
 219     dont_inline    = isNeverInlinePrag (inlinePragInfo idinfo)
 220     loop_breaker   = isLoopBreaker (occInfo idinfo)
 221     bottoming_fn   = isBottomingStrictness (strictnessInfo idinfo)
 222     spec_ids       = rulesRhsFreeVars (specInfo idinfo)
 223     worker_info    = workerInfo idinfo
 224
 225         -- Stuff to do with the Id's unfolding
 226         -- The simplifier has put an up-to-date unfolding
 227         -- in the IdInfo, but the RHS will do just as well
 228     unfolding    = unfoldingInfo idinfo
 229     rhs_is_small = not (neverUnfold unfolding)
 230
 231         -- We leave the unfolding there even if there is a worker
 232         -- In GHCI the unfolding is used by importers
 233         -- When writing an interface file, we omit the unfolding
 234         -- if there is a worker
 235     show_unfold = not bottoming_fn       &&     -- Not necessary
 236                   not dont_inline        &&
 237                   not loop_breaker       &&
 238                   rhs_is_small           &&     -- Small enough
 239                   okToUnfoldInHiFile rhs        -- No casms etc
 240
 241     unfold_ids | show_unfold = exprSomeFreeVars isIdAndLocal rhs
 242                | otherwise   = emptyVarSet
 243
 244     worker_ids = case worker_info of
 245                    HasWorker work_id _ -> unitVarSet work_id
 246                    otherwise           -> emptyVarSet
 247 \end{code}
 248
 249
 250 %************************************************************************
 251 %*                                                                      *
 252 \subsection{Step 2: top-level tidying}
 253 %*                                                                      *
 254 %************************************************************************
 255
 256
 257 \begin{code}
 258 type TopTidyEnv = (UniqSupply, OrigNameNameEnv, TidyOccEnv, VarEnv Var)
 259
 260 -- TopTidyEnv: when tidying we need to know
 261 --   * orig_env: Any pre-ordained Names.  These may have arisen because the
 262 --        renamer read in an interface file mentioning M.$wf, say,
 263 --        and assigned it unique r77.  If, on this compilation, we've
 264 --        invented an Id whose name is $wf (but with a different unique)
 265 --        we want to rename it to have unique r77, so that we can do easy
 266 --        comparisons with stuff from the interface file
 267 --
 268 --   * occ_env: The TidyOccEnv, which tells us which local occurrences
 269 --     are 'used'
 270 --
 271 --   * subst_env: A Var->Var mapping that substitutes the new Var for the old
 272 --
 273 --   * uniqsuppy: so we can clone any Ids with non-preordained names.
 274 --
 275 \end{code}
 276
 277
 278 \begin{code}
 279 tidyTopBind :: Module
 280             -> IdEnv Bool       -- Domain = Ids that should be external
 281                                 -- True <=> their unfolding is external too
 282             -> TopTidyEnv -> CoreBind
 283             -> (TopTidyEnv, CoreBind)
 284
 285 tidyTopBind mod ext_ids env (NonRec bndr rhs)
 286   = ((us2,orig,occ,subst) , NonRec bndr' rhs')
 287   where
 288     (env1@(us1,orig,occ,subst), bndr') = tidyTopBinder mod ext_ids env rhs' env bndr
 289     (rhs',us2)   = initUs us1 (tidyTopRhs env1 rhs)
 290
 291 tidyTopBind mod ext_ids env (Rec prs)
 292   = (final_env, Rec prs')
 293   where
 294     (final_env, prs')     = mapAccumL do_one env prs
 295
 296     do_one env (bndr,rhs)
 297         = ((us',orig,occ,subst), (bndr',rhs'))
 298         where
 299         (env'@(us,orig,occ,subst), bndr')
 300                 = tidyTopBinder mod ext_ids final_env rhs' env bndr
 301         (rhs', us') = initUs us (tidyTopRhs final_env rhs)
 302
 303
 304 tidyTopRhs :: TopTidyEnv -> CoreExpr -> UniqSM CoreExpr
 305         -- Just an impedence matcher
 306 tidyTopRhs (_, _, occ_env, subst_env) rhs
 307   = tidyExpr (occ_env, subst_env) rhs
 308
 309
 310 tidyTopBinder :: Module -> IdEnv Bool
 311               -> TopTidyEnv -> CoreExpr
 312               -> TopTidyEnv -> Id -> (TopTidyEnv, Id)
 313 tidyTopBinder mod ext_ids
 314         final_env@(_,  orig_env1, occ_env1, subst_env1) rhs
 315               env@(us, orig_env2, occ_env2, subst_env2) id
 316
 317   | omitIfaceSigForId id        -- Don't mess with constructors,
 318   = (env, id)                   -- record selectors, and the like
 319
 320   | otherwise
 321         -- This function is the heart of Step 2
 322         -- The second env is the one to use for the IdInfo
 323         -- It's necessary because when we are dealing with a recursive
 324         -- group, a variable late in the group might be mentioned
 325         -- in the IdInfo of one early in the group
 326
 327         -- The rhs is already tidied
 328
 329   = ((us_r, orig_env', occ_env', subst_env'), id')
 330   where
 331     (us_l, us_r)    = splitUniqSupply us
 332
 333     (orig_env', occ_env', name') = tidyTopName mod orig_env2 occ_env2
 334                                                is_external
 335                                                (idName id)
 336     ty'             = tidyTopType (idType id)
 337     idinfo'         = tidyIdInfo us_l (occ_env1, subst_env1)
 338                          is_external unfold_info arity_info id
 339
 340     id'        = mkId name' ty' idinfo'
 341     subst_env' = extendVarEnv subst_env2 id id'
 342
 343     maybe_external = lookupVarEnv ext_ids id
 344     is_external    = maybeToBool maybe_external
 345
 346     -- Expose an unfolding if ext_ids tells us to
 347     show_unfold = maybe_external `orElse` False
 348     unfold_info | show_unfold = mkTopUnfolding rhs
 349                 | otherwise   = noUnfolding
 350
 351     arity_info = exprArity rhs
 352
 353
 354 tidyIdInfo us tidy_env is_external unfold_info arity_info id
 355   | opt_OmitInterfacePragmas || not is_external
 356         -- No IdInfo if the Id isn't external, or if we don't have -O
 357   = mkIdInfo new_flavour
 358         `setStrictnessInfo` strictnessInfo core_idinfo
 359         `setArityInfo`      ArityExactly arity_info
 360         -- Keep strictness and arity info; it's used by the code generator
 361
 362   | otherwise
 363   =  let (rules', _) = initUs us (tidyRules  tidy_env (specInfo core_idinfo))
 364      in
 365      mkIdInfo new_flavour
 366         `setCprInfo`        cprInfo core_idinfo
 367         `setStrictnessInfo` strictnessInfo core_idinfo
 368         `setInlinePragInfo` inlinePragInfo core_idinfo
 369         `setUnfoldingInfo`  unfold_info
 370         `setWorkerInfo`     tidyWorker tidy_env (workerInfo core_idinfo)
 371         `setSpecInfo`       rules'
 372         `setArityInfo`      ArityExactly arity_info
 373                 -- this is the final IdInfo, it must agree with the
 374                 -- code finally generated (i.e. NO more transformations
 375                 -- after this!).
 376   where
 377     core_idinfo = idInfo id
 378
 379         -- A DFunId must stay a DFunId, so that we can gather the
 380         -- DFunIds up later.  Other local things become ConstantIds.
 381     new_flavour = case flavourInfo core_idinfo of
 382                     VanillaId  -> ConstantId
 383                     ExportedId -> ConstantId
 384                     ConstantId -> ConstantId    -- e.g. Default methods
 385                     DictFunId  -> DictFunId
 386                     flavour    -> pprTrace "tidyIdInfo" (ppr id <+> ppFlavourInfo flavour)
 387                                   flavour
 388
 389 -- this is where we set names to local/global based on whether they really are
 390 -- externally visible (see comment at the top of this module).  If the name
 391 -- was previously local, we have to give it a unique occurrence name if
 392 -- we intend to globalise it.
 393 tidyTopName mod orig_env occ_env external name
 394   | global && internal = (orig_env, occ_env, localiseName name)
 395   | local  && internal = (orig_env, occ_env', setNameOcc name occ') -- (*)
 396   | global && external = (orig_env, occ_env, name)
 397   | local  && external = globalise
 398         -- (*) just in case we're globalising all top-level names (because of
 399         -- -split-objs), we need to give *all* the top-level ids a
 400         -- unique occurrence name.  The actual globalisation now happens in the code
 401         -- generator.
 402   where
 403         -- If we want to globalise a currently-local name, check
 404         -- whether we have already assigned a unique for it.
 405         -- If so, use it; if not, extend the table
 406     globalise
 407         = case lookupFM orig_env key of
 408           Just orig -> (orig_env,                         occ_env', orig)
 409           Nothing   -> (addToFM orig_env key global_name, occ_env', global_name)
 410
 411     (occ_env', occ') = tidyOccName occ_env (nameOccName name)
 412     key              = (moduleName mod, occ')
 413     global_name      = globaliseName (setNameOcc name occ') mod
 414     global           = isGlobalName name
 415     local            = not global
 416     internal         = not external
 417
 418 tidyIdRules :: TidyEnv -> [IdCoreRule] -> UniqSM [IdCoreRule]
 419 tidyIdRules env [] = returnUs []
 420 tidyIdRules env ((fn,rule) : rules)
 421   = tidyRule env rule           `thenUs` \ rule ->
 422     tidyIdRules env rules       `thenUs` \ rules ->
 423     returnUs ((tidyVarOcc env fn, rule) : rules)
 424
 425 tidyWorker tidy_env (HasWorker work_id wrap_arity)
 426   = HasWorker (tidyVarOcc tidy_env work_id) wrap_arity
 427 tidyWorker tidy_env NoWorker
 428   = NoWorker
 429
 430 tidyRules :: TidyEnv -> CoreRules -> UniqSM CoreRules
 431 tidyRules env (Rules rules fvs)
 432   = mapUs (tidyRule env) rules          `thenUs` \ rules ->
 433     returnUs (Rules rules (foldVarSet tidy_set_elem emptyVarSet fvs))
 434   where
 435     tidy_set_elem var new_set = extendVarSet new_set (tidyVarOcc env var)
 436
 437 tidyRule :: TidyEnv -> CoreRule -> UniqSM CoreRule
 438 tidyRule env rule@(BuiltinRule _) = returnUs rule
 439 tidyRule env (Rule name vars tpl_args rhs)
 440   = tidyBndrs env vars                  `thenUs` \ (env', vars) ->
 441     mapUs (tidyExpr env') tpl_args      `thenUs` \ tpl_args ->
 442     tidyExpr env' rhs                   `thenUs` \ rhs ->
 443     returnUs (Rule name vars tpl_args rhs)
 444 \end{code}
 445
 446 %************************************************************************
 447 %*                                                                      *
 448 \subsection{Step 2: inner tidying
 449 %*                                                                      *
 450 %************************************************************************
 451
 452 \begin{code}
 453 tidyBind :: TidyEnv
 454          -> CoreBind
 455          -> UniqSM (TidyEnv, CoreBind)
 456 tidyBind env (NonRec bndr rhs)
 457   = tidyBndrWithRhs env (bndr,rhs) `thenUs` \ (env', bndr') ->
 458     tidyExpr env' rhs              `thenUs` \ rhs' ->
 459     returnUs (env', NonRec bndr' rhs')
 460
 461 tidyBind env (Rec prs)
 462   = mapAccumLUs tidyBndrWithRhs env prs         `thenUs` \ (env', bndrs') ->
 463     mapUs (tidyExpr env') (map snd prs)         `thenUs` \ rhss' ->
 464     returnUs (env', Rec (zip bndrs' rhss'))
 465
 466 tidyExpr env (Var v)   = returnUs (Var (tidyVarOcc env v))
 467 tidyExpr env (Type ty) = returnUs (Type (tidyType env ty))
 468 tidyExpr env (Lit lit) = returnUs (Lit lit)
 469
 470 tidyExpr env (App f a)
 471   = tidyExpr env f              `thenUs` \ f ->
 472     tidyExpr env a              `thenUs` \ a ->
 473     returnUs (App f a)
 474
 475 tidyExpr env (Note n e)
 476   = tidyExpr env e              `thenUs` \ e ->
 477     returnUs (Note (tidyNote env n) e)
 478
 479 tidyExpr env (Let b e)
 480   = tidyBind env b              `thenUs` \ (env', b') ->
 481     tidyExpr env' e             `thenUs` \ e ->
 482     returnUs (Let b' e)
 483
 484 tidyExpr env (Case e b alts)
 485   = tidyExpr env e              `thenUs` \ e ->
 486     tidyBndr env b              `thenUs` \ (env', b) ->
 487     mapUs (tidyAlt env') alts   `thenUs` \ alts ->
 488     returnUs (Case e b alts)
 489
 490 tidyExpr env (Lam b e)
 491   = tidyBndr env b              `thenUs` \ (env', b) ->
 492     tidyExpr env' e             `thenUs` \ e ->
 493     returnUs (Lam b e)
 494
 495
 496 tidyAlt env (con, vs, rhs)
 497   = tidyBndrs env vs            `thenUs` \ (env', vs) ->
 498     tidyExpr env' rhs           `thenUs` \ rhs ->
 499     returnUs (con, vs, rhs)
 500
 501 tidyNote env (Coerce t1 t2)  = Coerce (tidyType env t1) (tidyType env t2)
 502 tidyNote env note            = note
 503 \end{code}
 504
 505
 506 %************************************************************************
 507 %*                                                                      *
 508 \subsection{Tidying up non-top-level binders}
 509 %*                                                                      *
 510 %************************************************************************
 511
 512 \begin{code}
 513 tidyVarOcc (_, var_env) v = case lookupVarEnv var_env v of
 514                                   Just v' -> v'
 515                                   Nothing -> v
 516
 517 -- tidyBndr is used for lambda and case binders
 518 tidyBndr :: TidyEnv -> Var -> UniqSM (TidyEnv, Var)
 519 tidyBndr env var
 520   | isTyVar var = returnUs (tidyTyVar env var)
 521   | otherwise   = tidyId env var vanillaIdInfo
 522
 523 tidyBndrs :: TidyEnv -> [Var] -> UniqSM (TidyEnv, [Var])
 524 tidyBndrs env vars = mapAccumLUs tidyBndr env vars
 525
 526 -- tidyBndrWithRhs is used for let binders
 527 tidyBndrWithRhs :: TidyEnv -> (Var, CoreExpr) -> UniqSM (TidyEnv, Var)
 528 tidyBndrWithRhs env (id,rhs)
 529    = tidyId env id idinfo
 530    where
 531         idinfo = vanillaIdInfo `setArityInfo` ArityExactly (exprArity rhs)
 532                         -- NB: This throws away the IdInfo of the Id, which we
 533                         -- no longer need.  That means we don't need to
 534                         -- run over it with env, nor renumber it.
 535
 536 tidyId :: TidyEnv -> Id -> IdInfo -> UniqSM (TidyEnv, Id)
 537 tidyId env@(tidy_env, var_env) id idinfo
 538   =     -- Non-top-level variables
 539     getUniqueUs   `thenUs` \ uniq ->
 540     let
 541         -- Give the Id a fresh print-name, *and* rename its type
 542         -- The SrcLoc isn't important now,
 543         -- though we could extract it from the Id
 544         name'             = mkLocalName uniq occ' noSrcLoc
 545         (tidy_env', occ') = tidyOccName tidy_env (getOccName id)
 546         ty'               = tidyType (tidy_env,var_env) (idType id)
 547         id'               = mkId name' ty' idinfo
 548         var_env'          = extendVarEnv var_env id id'
 549     in
 550     returnUs ((tidy_env', var_env'), id')
 551 \end{code}