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,
  24                           mkVanillaGlobal, isLocalId, isImplicitId,
  25                           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 constructor workers, because they won't appear
 208         -- 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   | isImplicitId id     -- Don't mess with constructors,
 397   = (env, id)           -- record selectors, and the like
 398
 399   | otherwise
 400         -- This function is the heart of Step 2
 401         -- The second env is the one to use for the IdInfo
 402         -- It's necessary because when we are dealing with a recursive
 403         -- group, a variable late in the group might be mentioned
 404         -- in the IdInfo of one early in the group
 405
 406         -- The rhs is already tidied
 407
 408   = ((orig_env', occ_env', subst_env'), id')
 409   where
 410     (orig_env', occ_env', name') = tidyTopName mod orig_env2 occ_env2
 411                                                is_external
 412                                                (idName id)
 413     ty'     = tidyTopType (idType id)
 414     cg_info = lookupCgInfo cg_info_env name'
 415     idinfo' = tidyIdInfo tidy_env is_external unfold_info cg_info id
 416
 417     id'        = mkVanillaGlobal name' ty' idinfo'
 418     subst_env' = extendVarEnv subst_env2 id id'
 419
 420     maybe_external = lookupVarEnv ext_ids id
 421     is_external    = maybeToBool maybe_external
 422
 423     -- Expose an unfolding if ext_ids tells us to
 424     show_unfold = maybe_external `orElse` False
 425     unfold_info | show_unfold = mkTopUnfolding rhs
 426                 | otherwise   = noUnfolding
 427
 428
 429 tidyIdInfo tidy_env is_external unfold_info cg_info id
 430   | opt_OmitInterfacePragmas || not is_external
 431         -- No IdInfo if the Id isn't external, or if we don't have -O
 432   = vanillaIdInfo
 433         `setCgInfo`         cg_info
 434         `setStrictnessInfo` strictnessInfo core_idinfo
 435         -- Keep strictness; it's used by CorePrep
 436
 437   | otherwise
 438   =  vanillaIdInfo
 439         `setCgInfo`         cg_info
 440         `setCprInfo`        cprInfo core_idinfo
 441         `setStrictnessInfo` strictnessInfo core_idinfo
 442         `setInlinePragInfo` inlinePragInfo core_idinfo
 443         `setUnfoldingInfo`  unfold_info
 444         `setWorkerInfo`     tidyWorker tidy_env (workerInfo core_idinfo)
 445         -- NB: we throw away the Rules
 446         -- They have already been extracted by findExternalRules
 447   where
 448     core_idinfo = idInfo id
 449
 450
 451 -- This is where we set names to local/global based on whether they really are
 452 -- externally visible (see comment at the top of this module).  If the name
 453 -- was previously local, we have to give it a unique occurrence name if
 454 -- we intend to globalise it.
 455 tidyTopName mod orig_env occ_env external name
 456   | global && internal = (orig_env, occ_env, localiseName name)
 457
 458   | local  && internal = (orig_env, occ_env', setNameOcc name occ')
 459         -- Even local, internal names must get a unique occurrence, because
 460         -- if we do -split-objs we globalise the name later, n the code generator
 461
 462   | global && external = (orig_env, occ_env, name)
 463         -- Global names are assumed to have been allocated by the renamer,
 464         -- so they already have the "right" unique
 465
 466   | local  && external = case lookupFM orig_env key of
 467                            Just orig -> (orig_env,                         occ_env', orig)
 468                            Nothing   -> (addToFM orig_env key global_name, occ_env', global_name)
 469         -- If we want to globalise a currently-local name, check
 470         -- whether we have already assigned a unique for it.
 471         -- If so, use it; if not, extend the table
 472
 473   where
 474     (occ_env', occ') = tidyOccName occ_env (nameOccName name)
 475     key              = (moduleName mod, occ')
 476     global_name      = globaliseName (setNameOcc name occ') mod
 477     global           = isGlobalName name
 478     local            = not global
 479     internal         = not external
 480
 481 ------------  Worker  --------------
 482 tidyWorker tidy_env (HasWorker work_id wrap_arity)
 483   = HasWorker (tidyVarOcc tidy_env work_id) wrap_arity
 484 tidyWorker tidy_env other
 485   = NoWorker
 486
 487 ------------  Rules  --------------
 488 tidyIdRules :: TidyEnv -> [IdCoreRule] -> [IdCoreRule]
 489 tidyIdRules env [] = []
 490 tidyIdRules env ((fn,rule) : rules)
 491   = tidyRule env rule           =: \ rule ->
 492     tidyIdRules env rules       =: \ rules ->
 493      ((tidyVarOcc env fn, rule) : rules)
 494
 495 tidyRule :: TidyEnv -> CoreRule -> CoreRule
 496 tidyRule env rule@(BuiltinRule _) = rule
 497 tidyRule env (Rule name vars tpl_args rhs)
 498   = tidyBndrs env vars                  =: \ (env', vars) ->
 499     map (tidyExpr env') tpl_args        =: \ tpl_args ->
 500      (Rule name vars tpl_args (tidyExpr env' rhs))
 501 \end{code}
 502
 503 %************************************************************************
 504 %*                                                                      *
 505 \subsection{Step 2: inner tidying
 506 %*                                                                      *
 507 %************************************************************************
 508
 509 \begin{code}
 510 tidyBind :: TidyEnv
 511          -> CoreBind
 512          ->  (TidyEnv, CoreBind)
 513
 514 tidyBind env (NonRec bndr rhs)
 515   = tidyBndrWithRhs env (bndr,rhs) =: \ (env', bndr') ->
 516     (env', NonRec bndr' (tidyExpr env' rhs))
 517
 518 tidyBind env (Rec prs)
 519   = mapAccumL tidyBndrWithRhs env prs   =: \ (env', bndrs') ->
 520     map (tidyExpr env') (map snd prs)   =: \ rhss' ->
 521     (env', Rec (zip bndrs' rhss'))
 522
 523
 524 tidyExpr env (Var v)    =  Var (tidyVarOcc env v)
 525 tidyExpr env (Type ty)  =  Type (tidyType env ty)
 526 tidyExpr env (Lit lit)  =  Lit lit
 527 tidyExpr env (App f a)  =  App (tidyExpr env f) (tidyExpr env a)
 528 tidyExpr env (Note n e) =  Note (tidyNote env n) (tidyExpr env e)
 529
 530 tidyExpr env (Let b e)
 531   = tidyBind env b      =: \ (env', b') ->
 532     Let b' (tidyExpr env' e)
 533
 534 tidyExpr env (Case e b alts)
 535   = tidyBndr env b      =: \ (env', b) ->
 536     Case (tidyExpr env e) b (map (tidyAlt env') alts)
 537
 538 tidyExpr env (Lam b e)
 539   = tidyBndr env b      =: \ (env', b) ->
 540     Lam b (tidyExpr env' e)
 541
 542
 543 tidyAlt env (con, vs, rhs)
 544   = tidyBndrs env vs    =: \ (env', vs) ->
 545     (con, vs, tidyExpr env' rhs)
 546
 547 tidyNote env (Coerce t1 t2)  = Coerce (tidyType env t1) (tidyType env t2)
 548 tidyNote env note            = note
 549 \end{code}
 550
 551
 552 %************************************************************************
 553 %*                                                                      *
 554 \subsection{Tidying up non-top-level binders}
 555 %*                                                                      *
 556 %************************************************************************
 557
 558 \begin{code}
 559 tidyVarOcc (_, var_env) v = case lookupVarEnv var_env v of
 560                                   Just v' -> v'
 561                                   Nothing -> v
 562
 563 -- tidyBndr is used for lambda and case binders
 564 tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)
 565 tidyBndr env var
 566   | isTyVar var = tidyTyVar env var
 567   | otherwise   = tidyId env var
 568
 569 tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
 570 tidyBndrs env vars = mapAccumL tidyBndr env vars
 571
 572 -- tidyBndrWithRhs is used for let binders
 573 tidyBndrWithRhs :: TidyEnv -> (Id, CoreExpr) -> (TidyEnv, Var)
 574 tidyBndrWithRhs env (id,rhs) = tidyId env id
 575
 576 tidyId :: TidyEnv -> Id -> (TidyEnv, Id)
 577 tidyId env@(tidy_env, var_env) id
 578   =     -- Non-top-level variables
 579     let
 580         -- Give the Id a fresh print-name, *and* rename its type
 581         -- The SrcLoc isn't important now,
 582         -- though we could extract it from the Id
 583         --
 584         -- All local Ids now have the same IdInfo, which should save some
 585         -- space.
 586         (tidy_env', occ') = tidyOccName tidy_env (getOccName id)
 587         ty'               = tidyType (tidy_env,var_env) (idType id)
 588         id'               = mkUserLocal occ' (idUnique id) ty' noSrcLoc
 589         var_env'          = extendVarEnv var_env id id'
 590     in
 591      ((tidy_env', var_env'), id')
 592 \end{code}
 593
 594 \begin{code}
 595 m =: k = m `seq` k m
 596 \end{code}