ghc/compiler/simplCore/SimplMonad.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1993-1998
   3 %
   4 \section[SimplMonad]{The simplifier Monad}
   5
   6 \begin{code}
   7 module SimplMonad (
   8         InId, InBind, InExpr, InAlt, InArg, InType, InBinder,
   9         OutId, OutBind, OutExpr, OutAlt, OutArg, OutType, OutBinder,
  10
  11         -- The continuation type
  12         SimplCont(..), DupFlag(..), contIsDupable,
  13
  14         -- The monad
  15         SimplM,
  16         initSmpl, returnSmpl, thenSmpl, thenSmpl_,
  17         mapSmpl, mapAndUnzipSmpl, mapAccumLSmpl,
  18
  19         -- Unique supply
  20         getUniqueSmpl, getUniquesSmpl,
  21         newId, newIds,
  22
  23         -- Counting
  24         SimplCount, TickType(..), TickCounts,
  25         tick, tickUnfold,
  26         getSimplCount, zeroSimplCount, pprSimplCount,
  27         plusSimplCount, isZeroSimplCount,
  28
  29         -- Switch checker
  30         SwitchChecker, getSwitchChecker, getSimplIntSwitch,
  31
  32         -- Cost centres
  33         getEnclosingCC, setEnclosingCC,
  34
  35         -- Environments
  36         InScopeEnv, SubstEnv,
  37         getInScope, setInScope, extendInScope, extendInScopes, modifyInScope,
  38         emptySubstEnv, getSubstEnv, setSubstEnv, zapSubstEnv,
  39         extendIdSubst, extendTySubst,
  40         getTyEnv, getValEnv,
  41         getSimplBinderStuff, setSimplBinderStuff,
  42         switchOffInlining
  43     ) where
  44
  45 #include "HsVersions.h"
  46
  47 import Id               ( Id, mkSysLocal, idMustBeINLINEd )
  48 import IdInfo           ( InlinePragInfo(..) )
  49 import CoreSyn
  50 import CoreUtils        ( IdSubst, SubstCoreExpr )
  51 import CostCentre       ( CostCentreStack, subsumedCCS )
  52 import Var              ( TyVar )
  53 import VarEnv
  54 import VarSet
  55 import Type             ( Type, TyVarSubst )
  56 import UniqSupply       ( uniqsFromSupply, uniqFromSupply, splitUniqSupply,
  57                           UniqSupply
  58                         )
  59 import CmdLineOpts      ( SimplifierSwitch(..), SwitchResult(..), intSwitchSet )
  60 import Unique           ( Unique )
  61 import Maybes           ( expectJust )
  62 import Util             ( zipWithEqual )
  63 import Outputable
  64
  65 infixr 9  `thenSmpl`, `thenSmpl_`
  66 \end{code}
  67
  68 %************************************************************************
  69 %*                                                                      *
  70 \subsection[Simplify-types]{Type declarations}
  71 %*                                                                      *
  72 %************************************************************************
  73
  74 \begin{code}
  75 type InBinder  = CoreBndr
  76 type InId      = Id                     -- Not yet cloned
  77 type InType    = Type                   -- Ditto
  78 type InBind    = CoreBind
  79 type InExpr    = CoreExpr
  80 type InAlt     = CoreAlt
  81 type InArg     = CoreArg
  82
  83 type OutBinder  = CoreBndr
  84 type OutId      = Id                    -- Cloned
  85 type OutType    = Type                  -- Cloned
  86 type OutBind    = CoreBind
  87 type OutExpr    = CoreExpr
  88 type OutAlt     = CoreAlt
  89 type OutArg     = CoreArg
  90
  91 type SwitchChecker = SimplifierSwitch -> SwitchResult
  92 \end{code}
  93
  94
  95 %************************************************************************
  96 %*                                                                      *
  97 \subsection{The continuation data type}
  98 %*                                                                      *
  99 %************************************************************************
 100
 101 \begin{code}
 102 data SimplCont
 103   = Stop
 104
 105   | CoerceIt DupFlag
 106              InType SubstEnv
 107              SimplCont
 108
 109   | ApplyTo  DupFlag
 110              InExpr SubstEnv            -- The argument, as yet unsimplified,
 111              SimplCont                  -- and its subst-env
 112
 113   | Select   DupFlag
 114              InId [InAlt] SubstEnv      -- The case binder, alts, and subst-env
 115              SimplCont
 116
 117 instance Outputable SimplCont where
 118   ppr Stop                           = ptext SLIT("Stop")
 119   ppr (ApplyTo dup arg se cont)      = (ptext SLIT("ApplyTo") <+> ppr dup <+> ppr arg) $$ ppr cont
 120   ppr (Select dup bndr alts se cont) = (ptext SLIT("Select") <+> ppr dup <+> ppr bndr) $$
 121                                        (nest 4 (ppr alts)) $$ ppr cont
 122   ppr (CoerceIt dup ty se cont)      = (ptext SLIT("CoerceIt") <+> ppr dup <+> ppr ty) $$ ppr cont
 123
 124 data DupFlag = OkToDup | NoDup
 125
 126 instance Outputable DupFlag where
 127   ppr OkToDup = ptext SLIT("ok")
 128   ppr NoDup   = ptext SLIT("nodup")
 129
 130 contIsDupable :: SimplCont -> Bool
 131 contIsDupable Stop                      = True
 132 contIsDupable (ApplyTo OkToDup _ _ _)   = True
 133 contIsDupable (Select  OkToDup _ _ _ _) = True
 134 contIsDupable (CoerceIt OkToDup _ _ _)  = True
 135 contIsDupable other                     = False
 136 \end{code}
 137
 138
 139 %************************************************************************
 140 %*                                                                      *
 141 \subsection{Monad plumbing}
 142 %*                                                                      *
 143 %************************************************************************
 144
 145 For the simplifier monad, we want to {\em thread} a unique supply and a counter.
 146 (Command-line switches move around through the explicitly-passed SimplEnv.)
 147
 148 \begin{code}
 149 type SimplM result              -- We thread the unique supply because
 150   =  SimplEnv                   -- constantly splitting it is rather expensive
 151   -> UniqSupply
 152   -> SimplCount
 153   -> (result, UniqSupply, SimplCount)
 154
 155 data SimplEnv
 156   = SimplEnv {
 157         seChkr     :: SwitchChecker,
 158         seCC       :: CostCentreStack,  -- The enclosing CCS (when profiling)
 159         seSubst    :: SubstEnv,         -- The current substitution
 160         seInScope  :: InScopeEnv        -- Says what's in scope and gives info about it
 161     }
 162 \end{code}
 163
 164 \begin{code}
 165 initSmpl :: SwitchChecker
 166          -> UniqSupply          -- No init count; set to 0
 167          -> SimplM a
 168          -> (a, SimplCount)
 169
 170 initSmpl chkr us m = case m (emptySimplEnv chkr) us zeroSimplCount of
 171                         (result, _, count) -> (result, count)
 172
 173
 174 {-# INLINE thenSmpl #-}
 175 {-# INLINE thenSmpl_ #-}
 176 {-# INLINE returnSmpl #-}
 177
 178 returnSmpl :: a -> SimplM a
 179 returnSmpl e env us sc = (e, us, sc)
 180
 181 thenSmpl  :: SimplM a -> (a -> SimplM b) -> SimplM b
 182 thenSmpl_ :: SimplM a -> SimplM b -> SimplM b
 183
 184 thenSmpl m k env us0 sc0
 185   = case (m env us0 sc0) of
 186         (m_result, us1, sc1) -> k m_result env us1 sc1
 187
 188 thenSmpl_ m k env us0 sc0
 189   = case (m env us0 sc0) of
 190         (_, us1, sc1) -> k env us1 sc1
 191 \end{code}
 192
 193
 194 \begin{code}
 195 mapSmpl         :: (a -> SimplM b) -> [a] -> SimplM [b]
 196 mapAndUnzipSmpl :: (a -> SimplM (b, c)) -> [a] -> SimplM ([b],[c])
 197
 198 mapSmpl f [] = returnSmpl []
 199 mapSmpl f (x:xs)
 200   = f x             `thenSmpl` \ x'  ->
 201     mapSmpl f xs    `thenSmpl` \ xs' ->
 202     returnSmpl (x':xs')
 203
 204 mapAndUnzipSmpl f [] = returnSmpl ([],[])
 205 mapAndUnzipSmpl f (x:xs)
 206   = f x                     `thenSmpl` \ (r1,  r2)  ->
 207     mapAndUnzipSmpl f xs    `thenSmpl` \ (rs1, rs2) ->
 208     returnSmpl (r1:rs1, r2:rs2)
 209
 210 mapAccumLSmpl f acc []     = returnSmpl (acc, [])
 211 mapAccumLSmpl f acc (x:xs) = f acc x    `thenSmpl` \ (acc', x') ->
 212                              mapAccumLSmpl f acc' xs    `thenSmpl` \ (acc'', xs') ->
 213                              returnSmpl (acc'', x':xs')
 214 \end{code}
 215
 216
 217 %************************************************************************
 218 %*                                                                      *
 219 \subsection{The unique supply}
 220 %*                                                                      *
 221 %************************************************************************
 222
 223 \begin{code}
 224 getUniqueSmpl :: SimplM Unique
 225 getUniqueSmpl env us sc = case splitUniqSupply us of
 226                                 (us1, us2) -> (uniqFromSupply us1, us2, sc)
 227
 228 getUniquesSmpl :: Int -> SimplM [Unique]
 229 getUniquesSmpl n env us sc = case splitUniqSupply us of
 230                                 (us1, us2) -> (uniqsFromSupply n us1, us2, sc)
 231 \end{code}
 232
 233
 234 %************************************************************************
 235 %*                                                                      *
 236 \subsection{Counting up what we've done}
 237 %*                                                                      *
 238 %************************************************************************
 239
 240 \begin{code}
 241 doTickSmpl :: (SimplCount -> SimplCount) -> SimplM ()
 242 doTickSmpl f env us sc = sc' `seq` ((), us, sc')
 243                        where
 244                          sc' = f sc
 245
 246 getSimplCount :: SimplM SimplCount
 247 getSimplCount env us sc = (sc, us, sc)
 248 \end{code}
 249
 250
 251 The assoc list isn't particularly costly, because we only use
 252 the number of ticks in ``real life.''
 253
 254 The right thing to do, if you want that to go fast, is thread
 255 a mutable array through @SimplM@.
 256
 257 \begin{code}
 258 data SimplCount
 259   = SimplCount  !TickCounts
 260                 !UnfoldingHistory
 261
 262 type TickCounts = [(TickType, Int)]     -- Assoc list of all diff kinds of ticks
 263                                         -- Kept in increasing order of TickType
 264                                         -- Zeros not present
 265
 266 type UnfoldingHistory = (Int,           -- N
 267                          [Id],          -- Last N unfoldings
 268                          [Id])          -- The MaxUnfoldHistory unfoldings before that
 269
 270 data TickType
 271   = PreInlineUnconditionally
 272   | PostInlineUnconditionally
 273   | UnfoldingDone
 274   | MagicUnfold
 275   | CaseOfCase
 276   | LetFloatFromLet
 277   | KnownBranch
 278   | Let2Case
 279   | Case2Let
 280   | CaseMerge
 281   | CaseElim
 282   | CaseIdentity
 283   | EtaExpansion
 284   | CaseOfError
 285   | BetaReduction
 286   | SpecialisationDone
 287   | FillInCaseDefault
 288   | LeavesExamined
 289   deriving (Eq, Ord, Show)
 290
 291 pprSimplCount :: SimplCount -> SDoc
 292 pprSimplCount (SimplCount stuff (_, unf1, unf2))
 293   = vcat (map ppr_item stuff)
 294     $$ (text "Most recent unfoldings (most recent at top):"
 295         $$ nest 4 (vcat (map ppr (unf1 ++ unf2))))
 296   where
 297     ppr_item (t,n) = text (show t) <+> char '\t' <+> ppr n
 298
 299 zeroSimplCount :: SimplCount
 300 zeroSimplCount = SimplCount [] (0, [], [])
 301
 302 isZeroSimplCount :: SimplCount -> Bool
 303 isZeroSimplCount (SimplCount []                   _) = True
 304 isZeroSimplCount (SimplCount [(LeavesExamined,_)] _) = True
 305 isZeroSimplCount other                               = False
 306
 307 -- incTick is careful to be pretty strict, so we don't
 308 -- get a huge buildup of thunks
 309 incTick :: TickType -> FAST_INT -> TickCounts -> TickCounts
 310 incTick tick_type n []
 311   = [(tick_type, IBOX(n))]
 312
 313 incTick tick_type n (x@(ttype, I# cnt#) : xs)
 314   = case tick_type `compare` ttype of
 315         LT ->   -- Insert here
 316                 (tick_type, IBOX(n)) : x : xs
 317
 318         EQ ->   -- Increment
 319                 case cnt# +# n of
 320                    incd -> (ttype, IBOX(incd)) : xs
 321
 322         GT ->   -- Move on
 323                 rest `seq` x : rest
 324            where
 325                 rest = incTick tick_type n xs
 326
 327 -- Second argument is more recent stuff
 328 plusSimplCount :: SimplCount -> SimplCount -> SimplCount
 329 plusSimplCount (SimplCount tc1 uh1) (SimplCount tc2 uh2)
 330   = SimplCount (plusTickCounts tc1 tc2) (plusUnfolds uh1 uh2)
 331
 332 plusTickCounts :: TickCounts -> TickCounts -> TickCounts
 333 plusTickCounts ts1 [] = ts1
 334 plusTickCounts [] ts2 = ts2
 335 plusTickCounts ((tt1,n1) : ts1) ((tt2,n2) : ts2)
 336   = case tt1 `compare` tt2 of
 337         LT -> (tt1,n1)    : plusTickCounts ts1              ((tt2,n2) : ts2)
 338         EQ -> (tt1,n1+n2) : plusTickCounts ts1              ts2
 339         GT -> (tt2,n2)    : plusTickCounts ((tt1,n1) : ts1) ts2
 340
 341 -- Second argument is the more recent stuff
 342 plusUnfolds uh1          (0, h2, t2)  = uh1                     -- Nothing recent
 343 plusUnfolds (n1, h1, t1) (n2, h2, []) = (n2, h2, (h1++t1))      -- Small amount recent
 344 plusUnfolds (n1, h1, t1) uh2          = uh2                     -- Decent batch recent
 345 \end{code}
 346
 347
 348 Counting-related monad functions:
 349
 350 \begin{code}
 351 tick :: TickType -> SimplM ()
 352
 353 tick tick_type
 354   = doTickSmpl f
 355   where
 356     f (SimplCount stuff unf) = SimplCount (incTick tick_type ILIT(1) stuff) unf
 357
 358 maxUnfoldHistory :: Int
 359 maxUnfoldHistory = 20
 360
 361 tickUnfold :: Id -> SimplM ()
 362 tickUnfold id
 363   = doTickSmpl f
 364   where
 365     f (SimplCount stuff (n_unf, unf1, unf2))
 366       | n_unf >= maxUnfoldHistory = SimplCount new_stuff (1, [id], unf1)
 367       | otherwise                 = SimplCount new_stuff (n_unf+1, id:unf1, unf2)
 368       where
 369         new_stuff = incTick UnfoldingDone ILIT(1) stuff
 370 \end{code}
 371
 372
 373 %************************************************************************
 374 %*                                                                      *
 375 \subsubsection{Command-line switches}
 376 %*                                                                      *
 377 %************************************************************************
 378
 379 \begin{code}
 380 getSwitchChecker :: SimplM SwitchChecker
 381 getSwitchChecker env us sc = (seChkr env, us, sc)
 382
 383 getSimplIntSwitch :: SwitchChecker -> (Int-> SimplifierSwitch) -> Int
 384 getSimplIntSwitch chkr switch
 385   = expectJust "getSimplIntSwitch" (intSwitchSet chkr switch)
 386 \end{code}
 387
 388
 389 @switchOffInlining@ is used to prepare the environment for simplifying
 390 the RHS of an Id that's marked with an INLINE pragma.  It is going to
 391 be inlined wherever they are used, and then all the inlining will take
 392 effect.  Meanwhile, there isn't much point in doing anything to the
 393 as-yet-un-INLINEd rhs.  Furthremore, it's very important to switch off
 394 inlining!  because
 395         (a) not doing so will inline a worker straight back into its wrapper!
 396
 397 and     (b) Consider the following example
 398                 let f = \pq -> BIG
 399                 in
 400                 let g = \y -> f y y
 401                     {-# INLINE g #-}
 402                 in ...g...g...g...g...g...
 403
 404         Now, if that's the ONLY occurrence of f, it will be inlined inside g,
 405         and thence copied multiple times when g is inlined.
 406
 407         Andy disagrees! Example:
 408                 all xs = foldr (&&) True xs
 409                 any p = all . map p  {-# INLINE any #-}
 410
 411         Problem: any won't get deforested, and so if it's exported and
 412         the importer doesn't use the inlining, (eg passes it as an arg)
 413         then we won't get deforestation at all.
 414         We havn't solved this problem yet!
 415
 416 We prepare the envt by simply modifying the in_scope_env, which has all the
 417 unfolding info. At one point we did it by modifying the chkr so that
 418 it said "EssentialUnfoldingsOnly", but that prevented legitmate, and
 419 important, simplifications happening in the body of the RHS.
 420
 421 6/98 update:
 422
 423 We *don't* prevent inlining from happening for identifiers
 424 that are marked as IMustBeINLINEd. An example of where
 425 doing this is crucial is:
 426
 427    class Bar a => Foo a where
 428      ...g....
 429    {-# INLINE f #-}
 430    f :: Foo a => a -> b
 431    f x = ....Foo_sc1...
 432
 433 If `f' needs to peer inside Foo's superclass, Bar, it refers
 434 to the appropriate super class selector, which is marked as
 435 must-inlineable. We don't generate any code for a superclass
 436 selector, so failing to inline it in the RHS of `f' will
 437 leave a reference to a non-existent id, with bad consequences.
 438
 439 ALSO NOTE that we do all this by modifing the inline-pragma,
 440 not by zapping the unfolding.  The latter may still be useful for
 441 knowing when something is evaluated.
 442
 443 June 98 update: I've gone back to dealing with this by adding
 444 the EssentialUnfoldingsOnly switch.  That doesn't stop essential
 445 unfoldings, nor inlineUnconditionally stuff; and the thing's going
 446 to be inlined at every call site anyway.  Running over the whole
 447 environment seems like wild overkill.
 448
 449 \begin{code}
 450 switchOffInlining :: SimplM a -> SimplM a
 451 switchOffInlining m env@(SimplEnv { seChkr = sw_chkr }) us sc
 452   = m (env { seChkr = new_chkr  }) us sc
 453   where
 454     new_chkr EssentialUnfoldingsOnly = SwBool True
 455     new_chkr other                   = sw_chkr other
 456 \end{code}
 457
 458
 459 %************************************************************************
 460 %*                                                                      *
 461 \subsubsection{The ``enclosing cost-centre''}
 462 %*                                                                      *
 463 %************************************************************************
 464
 465 \begin{code}
 466 getEnclosingCC :: SimplM CostCentreStack
 467 getEnclosingCC env us sc = (seCC env, us, sc)
 468
 469 setEnclosingCC :: CostCentreStack -> SimplM a -> SimplM a
 470 setEnclosingCC cc m env us sc = m (env { seCC = cc }) us sc
 471 \end{code}
 472
 473
 474 %************************************************************************
 475 %*                                                                      *
 476 \subsubsection{The @SimplEnv@ type}
 477 %*                                                                      *
 478 %************************************************************************
 479
 480 \begin{code}
 481 type SubstEnv = (TyVarSubst, IdSubst)
 482         -- The range of these substitutions is OutType and OutExpr resp
 483         --
 484         -- The substitution is idempotent
 485         -- It *must* be applied; things in its domain simply aren't
 486         -- bound in the result.
 487         --
 488         -- The substitution usually maps an Id to its clone,
 489         -- but if the orig defn is a let-binding, and
 490         -- the RHS of the let simplifies to an atom,
 491         -- we just add the binding to the substitution and elide the let.
 492
 493 type InScopeEnv = IdOrTyVarSet
 494         -- Domain includes *all* in-scope TyVars and Ids
 495         --
 496         -- The elements of the set may have better IdInfo than the
 497         -- occurrences of in-scope Ids, and (more important) they will
 498         -- have a correctly-substituted type.  So we use a lookup in this
 499         -- set to replace occurrences
 500
 501 -- INVARIANT:   If t is in the in-scope set, it certainly won't be
 502 --              in the domain of the SubstEnv, and vice versa
 503 \end{code}
 504
 505
 506 \begin{code}
 507 emptySubstEnv :: SubstEnv
 508 emptySubstEnv = (emptyVarEnv, emptyVarEnv)
 509
 510 emptySimplEnv :: SwitchChecker -> SimplEnv
 511
 512 emptySimplEnv sw_chkr
 513   = SimplEnv { seChkr = sw_chkr, seCC = subsumedCCS,
 514                seSubst   = emptySubstEnv,
 515                seInScope = emptyVarSet }
 516
 517         -- The top level "enclosing CC" is "SUBSUMED".
 518
 519 getTyEnv :: SimplM (TyVarSubst, InScopeEnv)
 520 getTyEnv (SimplEnv {seSubst = (ty_subst,_), seInScope = in_scope}) us sc
 521   = ((ty_subst, in_scope), us, sc)
 522
 523 getValEnv :: SimplM (IdSubst, InScopeEnv)
 524 getValEnv (SimplEnv {seSubst = (_, id_subst), seInScope = in_scope}) us sc
 525   = ((id_subst, in_scope), us, sc)
 526
 527 getInScope :: SimplM InScopeEnv
 528 getInScope env us sc = (seInScope env, us, sc)
 529
 530 setInScope :: InScopeEnv -> SimplM a -> SimplM a
 531 setInScope in_scope m env us sc = m (env {seInScope = in_scope}) us sc
 532
 533 extendInScope :: CoreBndr -> SimplM a -> SimplM a
 534 extendInScope v m env@(SimplEnv {seInScope = in_scope}) us sc
 535   = m (env {seInScope = extendVarSet in_scope v}) us sc
 536
 537 extendInScopes :: [CoreBndr] -> SimplM a -> SimplM a
 538 extendInScopes vs m env@(SimplEnv {seInScope = in_scope}) us sc
 539   = m (env {seInScope = foldl extendVarSet in_scope vs}) us sc
 540
 541 modifyInScope :: CoreBndr -> SimplM a -> SimplM a
 542 modifyInScope v m env us sc
 543 #ifdef DEBUG
 544   | not (v `elemVarSet` seInScope env )
 545   = pprTrace "modifyInScope: not in scope:" (ppr v)
 546     m env us sc
 547 #endif
 548   | otherwise
 549   = extendInScope v m env us sc
 550
 551 getSubstEnv :: SimplM SubstEnv
 552 getSubstEnv env us sc = (seSubst env, us, sc)
 553
 554 setSubstEnv :: SubstEnv -> SimplM a -> SimplM a
 555 setSubstEnv subst_env m env us sc = m (env {seSubst = subst_env}) us sc
 556
 557 extendIdSubst :: Id -> SubstCoreExpr -> SimplM a -> SimplM a
 558 extendIdSubst id expr m env@(SimplEnv {seSubst = (ty_subst, id_subst)}) us sc
 559   = m (env { seSubst = (ty_subst, extendVarEnv id_subst id expr) }) us sc
 560
 561 extendTySubst :: TyVar -> OutType -> SimplM a -> SimplM a
 562 extendTySubst tv ty m env@(SimplEnv {seSubst = (ty_subst, id_subst)}) us sc
 563   = m (env { seSubst = (extendVarEnv ty_subst tv ty, id_subst) }) us sc
 564
 565 zapSubstEnv :: SimplM a -> SimplM a
 566 zapSubstEnv m env us sc = m (env {seSubst = emptySubstEnv}) us sc
 567
 568 getSimplBinderStuff :: SimplM (TyVarSubst, IdSubst, InScopeEnv, UniqSupply)
 569 getSimplBinderStuff (SimplEnv {seSubst = (ty_subst, id_subst), seInScope = in_scope}) us sc
 570   = ((ty_subst, id_subst, in_scope, us), us, sc)
 571
 572 setSimplBinderStuff :: (TyVarSubst, IdSubst, InScopeEnv, UniqSupply)
 573                     -> SimplM a -> SimplM a
 574 setSimplBinderStuff (ty_subst, id_subst, in_scope, us) m env _ sc
 575   = m (env {seSubst = (ty_subst, id_subst), seInScope = in_scope}) us sc
 576 \end{code}
 577
 578
 579 \begin{code}
 580 newId :: Type -> (Id -> SimplM a) -> SimplM a
 581         -- Extends the in-scope-env too
 582 newId ty m env@(SimplEnv {seInScope = in_scope}) us sc
 583   =  case splitUniqSupply us of
 584         (us1, us2) -> m v (env {seInScope = extendVarSet in_scope v}) us2 sc
 585                    where
 586                       v = mkSysLocal (uniqFromSupply us1) ty
 587
 588 newIds :: [Type] -> ([Id] -> SimplM a) -> SimplM a
 589 newIds tys m env@(SimplEnv {seInScope = in_scope}) us sc
 590   =  case splitUniqSupply us of
 591         (us1, us2) -> m vs (env {seInScope = foldl extendVarSet in_scope vs}) us2 sc
 592                    where
 593                       vs = zipWithEqual "newIds" mkSysLocal (uniqsFromSupply (length tys) us1) tys
 594 \end{code}
 595