2 % (c) The AQUA Project, Glasgow University, 1993-1998
4 \section[SimplMonad]{The simplifier Monad}
8 InId, InBind, InExpr, InAlt, InArg, InType, InBinder,
9 OutId, OutBind, OutExpr, OutAlt, OutArg, OutType, OutBinder,
10 OutExprStuff, OutStuff,
14 initSmpl, returnSmpl, thenSmpl, thenSmpl_,
15 mapSmpl, mapAndUnzipSmpl, mapAccumLSmpl,
17 -- The inlining black-list
21 getUniqueSmpl, getUniquesSmpl,
27 getSimplCount, zeroSimplCount, pprSimplCount,
28 plusSimplCount, isZeroSimplCount,
31 SwitchChecker, getSwitchChecker, getSimplIntSwitch,
34 getEnclosingCC, setEnclosingCC,
37 getEnv, setAllExceptInScope,
39 getSubstEnv, extendSubst, extendSubstList,
40 getInScope, setInScope, extendInScope, extendInScopes, modifyInScope,
41 setSubstEnv, zapSubstEnv,
42 getSimplBinderStuff, setSimplBinderStuff,
46 #include "HsVersions.h"
48 import Id ( Id, mkSysLocal, idUnfolding, isDataConWrapId )
49 import IdInfo ( InlinePragInfo(..) )
50 import Demand ( Demand )
52 import CoreUnfold ( isCompulsoryUnfolding, isEvaldUnfolding )
53 import PprCore () -- Instances
54 import Rules ( RuleBase )
55 import CostCentre ( CostCentreStack, subsumedCCS )
56 import Name ( isLocallyDefined )
57 import OccName ( UserFS )
61 import qualified Subst
62 import Subst ( Subst, emptySubst, mkSubst,
64 InScopeSet, substInScope, isInScope
66 import Type ( Type, TyVarSubst, applyTy )
67 import UniqSupply ( uniqsFromSupply, uniqFromSupply, splitUniqSupply,
71 import CmdLineOpts ( SimplifierSwitch(..), SwitchResult(..),
72 opt_PprStyle_Debug, opt_HistorySize, opt_D_dump_simpl_stats,
75 import Unique ( Unique )
76 import Maybes ( expectJust )
77 import Util ( zipWithEqual )
80 infixr 0 `thenSmpl`, `thenSmpl_`
83 %************************************************************************
85 \subsection[Simplify-types]{Type declarations}
87 %************************************************************************
90 type InBinder = CoreBndr
91 type InId = Id -- Not yet cloned
92 type InType = Type -- Ditto
93 type InBind = CoreBind
94 type InExpr = CoreExpr
98 type OutBinder = CoreBndr
99 type OutId = Id -- Cloned
100 type OutType = Type -- Cloned
101 type OutBind = CoreBind
102 type OutExpr = CoreExpr
103 type OutAlt = CoreAlt
104 type OutArg = CoreArg
106 type SwitchChecker = SimplifierSwitch -> SwitchResult
108 type OutExprStuff = OutStuff (InScopeSet, OutExpr)
109 type OutStuff a = ([OutBind], a)
110 -- We return something equivalent to (let b in e), but
111 -- in pieces to avoid the quadratic blowup when floating
112 -- incrementally. Comments just before simplExprB in Simplify.lhs
116 %************************************************************************
118 \subsection{Monad plumbing}
120 %************************************************************************
122 For the simplifier monad, we want to {\em thread} a unique supply and a counter.
123 (Command-line switches move around through the explicitly-passed SimplEnv.)
126 type SimplM result -- We thread the unique supply because
127 = SimplEnv -- constantly splitting it is rather expensive
130 -> (result, UniqSupply, SimplCount)
134 seChkr :: SwitchChecker,
135 seCC :: CostCentreStack, -- The enclosing CCS (when profiling)
136 seBlackList :: Id -> Bool, -- True => don't inline this Id
137 seSubst :: Subst -- The current substitution
139 -- The range of the substitution is OutType and OutExpr resp
141 -- The substitution is idempotent
142 -- It *must* be applied; things in its domain simply aren't
143 -- bound in the result.
145 -- The substitution usually maps an Id to its clone,
146 -- but if the orig defn is a let-binding, and
147 -- the RHS of the let simplifies to an atom,
148 -- we just add the binding to the substitution and elide the let.
150 -- The in-scope part of Subst includes *all* in-scope TyVars and Ids
151 -- The elements of the set may have better IdInfo than the
152 -- occurrences of in-scope Ids, and (more important) they will
153 -- have a correctly-substituted type. So we use a lookup in this
154 -- set to replace occurrences
158 initSmpl :: SwitchChecker
159 -> UniqSupply -- No init count; set to 0
160 -> VarSet -- In scope (usually empty, but useful for nested calls)
161 -> (Id -> Bool) -- Black-list function
165 initSmpl chkr us in_scope black_list m
166 = case m (emptySimplEnv chkr in_scope black_list) us zeroSimplCount of
167 (result, _, count) -> (result, count)
170 {-# INLINE thenSmpl #-}
171 {-# INLINE thenSmpl_ #-}
172 {-# INLINE returnSmpl #-}
174 returnSmpl :: a -> SimplM a
175 returnSmpl e env us sc = (e, us, sc)
177 thenSmpl :: SimplM a -> (a -> SimplM b) -> SimplM b
178 thenSmpl_ :: SimplM a -> SimplM b -> SimplM b
180 thenSmpl m k env us0 sc0
181 = case (m env us0 sc0) of
182 (m_result, us1, sc1) -> k m_result env us1 sc1
184 thenSmpl_ m k env us0 sc0
185 = case (m env us0 sc0) of
186 (_, us1, sc1) -> k env us1 sc1
191 mapSmpl :: (a -> SimplM b) -> [a] -> SimplM [b]
192 mapAndUnzipSmpl :: (a -> SimplM (b, c)) -> [a] -> SimplM ([b],[c])
194 mapSmpl f [] = returnSmpl []
196 = f x `thenSmpl` \ x' ->
197 mapSmpl f xs `thenSmpl` \ xs' ->
200 mapAndUnzipSmpl f [] = returnSmpl ([],[])
201 mapAndUnzipSmpl f (x:xs)
202 = f x `thenSmpl` \ (r1, r2) ->
203 mapAndUnzipSmpl f xs `thenSmpl` \ (rs1, rs2) ->
204 returnSmpl (r1:rs1, r2:rs2)
206 mapAccumLSmpl f acc [] = returnSmpl (acc, [])
207 mapAccumLSmpl f acc (x:xs) = f acc x `thenSmpl` \ (acc', x') ->
208 mapAccumLSmpl f acc' xs `thenSmpl` \ (acc'', xs') ->
209 returnSmpl (acc'', x':xs')
213 %************************************************************************
215 \subsection{The unique supply}
217 %************************************************************************
220 getUniqueSmpl :: SimplM Unique
221 getUniqueSmpl env us sc = case splitUniqSupply us of
222 (us1, us2) -> (uniqFromSupply us1, us2, sc)
224 getUniquesSmpl :: Int -> SimplM [Unique]
225 getUniquesSmpl n env us sc = case splitUniqSupply us of
226 (us1, us2) -> (uniqsFromSupply n us1, us2, sc)
230 %************************************************************************
232 \subsection{Counting up what we've done}
234 %************************************************************************
237 getSimplCount :: SimplM SimplCount
238 getSimplCount env us sc = (sc, us, sc)
240 tick :: Tick -> SimplM ()
241 tick t env us sc = sc' `seq` ((), us, sc')
245 freeTick :: Tick -> SimplM ()
246 -- Record a tick, but don't add to the total tick count, which is
247 -- used to decide when nothing further has happened
248 freeTick t env us sc = sc' `seq` ((), us, sc')
250 sc' = doFreeTick t sc
254 verboseSimplStats = opt_PprStyle_Debug -- For now, anyway
256 zeroSimplCount :: SimplCount
257 isZeroSimplCount :: SimplCount -> Bool
258 pprSimplCount :: SimplCount -> SDoc
259 doTick, doFreeTick :: Tick -> SimplCount -> SimplCount
260 plusSimplCount :: SimplCount -> SimplCount -> SimplCount
264 data SimplCount = VerySimplZero -- These two are used when
265 | VerySimplNonZero -- we are only interested in
269 ticks :: !Int, -- Total ticks
270 details :: !TickCounts, -- How many of each type
272 log1 :: [Tick], -- Last N events; <= opt_HistorySize
273 log2 :: [Tick] -- Last opt_HistorySize events before that
276 type TickCounts = FiniteMap Tick Int
278 zeroSimplCount -- This is where we decide whether to do
279 -- the VerySimpl version or the full-stats version
280 | opt_D_dump_simpl_stats = SimplCount {ticks = 0, details = emptyFM,
281 n_log = 0, log1 = [], log2 = []}
282 | otherwise = VerySimplZero
284 isZeroSimplCount VerySimplZero = True
285 isZeroSimplCount (SimplCount { ticks = 0 }) = True
286 isZeroSimplCount other = False
288 doFreeTick tick sc@SimplCount { details = dts }
289 = dts' `seqFM` sc { details = dts' }
291 dts' = dts `addTick` tick
292 doFreeTick tick sc = sc
294 -- Gross hack to persuade GHC 3.03 to do this important seq
295 seqFM fm x | isEmptyFM fm = x
298 doTick tick sc@SimplCount { ticks = tks, details = dts, n_log = nl, log1 = l1, log2 = l2 }
299 | nl >= opt_HistorySize = sc1 { n_log = 1, log1 = [tick], log2 = l1 }
300 | otherwise = sc1 { n_log = nl+1, log1 = tick : l1 }
302 sc1 = sc { ticks = tks+1, details = dts `addTick` tick }
304 doTick tick sc = VerySimplNonZero -- The very simple case
307 -- Don't use plusFM_C because that's lazy, and we want to
308 -- be pretty strict here!
309 addTick :: TickCounts -> Tick -> TickCounts
310 addTick fm tick = case lookupFM fm tick of
311 Nothing -> addToFM fm tick 1
312 Just n -> n1 `seq` addToFM fm tick n1
317 plusSimplCount sc1@(SimplCount { ticks = tks1, details = dts1 })
318 sc2@(SimplCount { ticks = tks2, details = dts2 })
319 = log_base { ticks = tks1 + tks2, details = plusFM_C (+) dts1 dts2 }
321 -- A hackish way of getting recent log info
322 log_base | null (log1 sc2) = sc1 -- Nothing at all in sc2
323 | null (log2 sc2) = sc2 { log2 = log1 sc1 }
326 plusSimplCount VerySimplZero VerySimplZero = VerySimplZero
327 plusSimplCount sc1 sc2 = VerySimplNonZero
329 pprSimplCount VerySimplZero = ptext SLIT("Total ticks: ZERO!")
330 pprSimplCount VerySimplNonZero = ptext SLIT("Total ticks: NON-ZERO!")
331 pprSimplCount (SimplCount { ticks = tks, details = dts, log1 = l1, log2 = l2 })
332 = vcat [ptext SLIT("Total ticks: ") <+> int tks,
334 pprTickCounts (fmToList dts),
335 if verboseSimplStats then
337 ptext SLIT("Log (most recent first)"),
338 nest 4 (vcat (map ppr l1) $$ vcat (map ppr l2))]
342 pprTickCounts :: [(Tick,Int)] -> SDoc
343 pprTickCounts [] = empty
344 pprTickCounts ((tick1,n1):ticks)
345 = vcat [int tot_n <+> text (tickString tick1),
346 pprTCDetails real_these,
350 tick1_tag = tickToTag tick1
351 (these, others) = span same_tick ticks
352 real_these = (tick1,n1):these
353 same_tick (tick2,_) = tickToTag tick2 == tick1_tag
354 tot_n = sum [n | (_,n) <- real_these]
356 pprTCDetails ticks@((tick,_):_)
357 | verboseSimplStats || isRuleFired tick
358 = nest 4 (vcat [int n <+> pprTickCts tick | (tick,n) <- ticks])
363 %************************************************************************
367 %************************************************************************
371 = PreInlineUnconditionally Id
372 | PostInlineUnconditionally Id
375 | RuleFired FAST_STRING -- Rule name
377 | LetFloatFromLet Id -- Thing floated out
378 | EtaExpansion Id -- LHS binder
379 | EtaReduction Id -- Binder on outer lambda
380 | BetaReduction Id -- Lambda binder
383 | CaseOfCase Id -- Bndr on *inner* case
384 | KnownBranch Id -- Case binder
385 | CaseMerge Id -- Binder on outer case
386 | CaseElim Id -- Case binder
387 | CaseIdentity Id -- Case binder
388 | FillInCaseDefault Id -- Case binder
391 | SimplifierDone -- Ticked at each iteration of the simplifier
393 isRuleFired (RuleFired _) = True
394 isRuleFired other = False
396 instance Outputable Tick where
397 ppr tick = text (tickString tick) <+> pprTickCts tick
399 instance Eq Tick where
400 a == b = case a `cmpTick` b of { EQ -> True; other -> False }
402 instance Ord Tick where
405 tickToTag :: Tick -> Int
406 tickToTag (PreInlineUnconditionally _) = 0
407 tickToTag (PostInlineUnconditionally _) = 1
408 tickToTag (UnfoldingDone _) = 2
409 tickToTag (RuleFired _) = 3
410 tickToTag (LetFloatFromLet _) = 4
411 tickToTag (EtaExpansion _) = 5
412 tickToTag (EtaReduction _) = 6
413 tickToTag (BetaReduction _) = 7
414 tickToTag (CaseOfCase _) = 8
415 tickToTag (KnownBranch _) = 9
416 tickToTag (CaseMerge _) = 10
417 tickToTag (CaseElim _) = 11
418 tickToTag (CaseIdentity _) = 12
419 tickToTag (FillInCaseDefault _) = 13
420 tickToTag BottomFound = 14
421 tickToTag SimplifierDone = 16
423 tickString :: Tick -> String
424 tickString (PreInlineUnconditionally _) = "PreInlineUnconditionally"
425 tickString (PostInlineUnconditionally _)= "PostInlineUnconditionally"
426 tickString (UnfoldingDone _) = "UnfoldingDone"
427 tickString (RuleFired _) = "RuleFired"
428 tickString (LetFloatFromLet _) = "LetFloatFromLet"
429 tickString (EtaExpansion _) = "EtaExpansion"
430 tickString (EtaReduction _) = "EtaReduction"
431 tickString (BetaReduction _) = "BetaReduction"
432 tickString (CaseOfCase _) = "CaseOfCase"
433 tickString (KnownBranch _) = "KnownBranch"
434 tickString (CaseMerge _) = "CaseMerge"
435 tickString (CaseElim _) = "CaseElim"
436 tickString (CaseIdentity _) = "CaseIdentity"
437 tickString (FillInCaseDefault _) = "FillInCaseDefault"
438 tickString BottomFound = "BottomFound"
439 tickString SimplifierDone = "SimplifierDone"
441 pprTickCts :: Tick -> SDoc
442 pprTickCts (PreInlineUnconditionally v) = ppr v
443 pprTickCts (PostInlineUnconditionally v)= ppr v
444 pprTickCts (UnfoldingDone v) = ppr v
445 pprTickCts (RuleFired v) = ppr v
446 pprTickCts (LetFloatFromLet v) = ppr v
447 pprTickCts (EtaExpansion v) = ppr v
448 pprTickCts (EtaReduction v) = ppr v
449 pprTickCts (BetaReduction v) = ppr v
450 pprTickCts (CaseOfCase v) = ppr v
451 pprTickCts (KnownBranch v) = ppr v
452 pprTickCts (CaseMerge v) = ppr v
453 pprTickCts (CaseElim v) = ppr v
454 pprTickCts (CaseIdentity v) = ppr v
455 pprTickCts (FillInCaseDefault v) = ppr v
456 pprTickCts other = empty
458 cmpTick :: Tick -> Tick -> Ordering
459 cmpTick a b = case (tickToTag a `compare` tickToTag b) of
461 EQ | isRuleFired a || verboseSimplStats -> cmpEqTick a b
464 -- Always distinguish RuleFired, so that the stats
465 -- can report them even in non-verbose mode
467 cmpEqTick :: Tick -> Tick -> Ordering
468 cmpEqTick (PreInlineUnconditionally a) (PreInlineUnconditionally b) = a `compare` b
469 cmpEqTick (PostInlineUnconditionally a) (PostInlineUnconditionally b) = a `compare` b
470 cmpEqTick (UnfoldingDone a) (UnfoldingDone b) = a `compare` b
471 cmpEqTick (RuleFired a) (RuleFired b) = a `compare` b
472 cmpEqTick (LetFloatFromLet a) (LetFloatFromLet b) = a `compare` b
473 cmpEqTick (EtaExpansion a) (EtaExpansion b) = a `compare` b
474 cmpEqTick (EtaReduction a) (EtaReduction b) = a `compare` b
475 cmpEqTick (BetaReduction a) (BetaReduction b) = a `compare` b
476 cmpEqTick (CaseOfCase a) (CaseOfCase b) = a `compare` b
477 cmpEqTick (KnownBranch a) (KnownBranch b) = a `compare` b
478 cmpEqTick (CaseMerge a) (CaseMerge b) = a `compare` b
479 cmpEqTick (CaseElim a) (CaseElim b) = a `compare` b
480 cmpEqTick (CaseIdentity a) (CaseIdentity b) = a `compare` b
481 cmpEqTick (FillInCaseDefault a) (FillInCaseDefault b) = a `compare` b
482 cmpEqTick other1 other2 = EQ
486 %************************************************************************
488 \subsubsection{Command-line switches}
490 %************************************************************************
493 getSwitchChecker :: SimplM SwitchChecker
494 getSwitchChecker env us sc = (seChkr env, us, sc)
496 getSimplIntSwitch :: SwitchChecker -> (Int-> SimplifierSwitch) -> Int
497 getSimplIntSwitch chkr switch
498 = expectJust "getSimplIntSwitch" (intSwitchSet chkr switch)
502 @switchOffInlining@ is used to prepare the environment for simplifying
503 the RHS of an Id that's marked with an INLINE pragma. It is going to
504 be inlined wherever they are used, and then all the inlining will take
505 effect. Meanwhile, there isn't much point in doing anything to the
506 as-yet-un-INLINEd rhs. Furthremore, it's very important to switch off
508 (a) not doing so will inline a worker straight back into its wrapper!
510 and (b) Consider the following example
515 in ...g...g...g...g...g...
517 Now, if that's the ONLY occurrence of f, it will be inlined inside g,
518 and thence copied multiple times when g is inlined.
520 Andy disagrees! Example:
521 all xs = foldr (&&) True xs
522 any p = all . map p {-# INLINE any #-}
524 Problem: any won't get deforested, and so if it's exported and
525 the importer doesn't use the inlining, (eg passes it as an arg)
526 then we won't get deforestation at all.
527 We havn't solved this problem yet!
529 We prepare the envt by simply modifying the in_scope_env, which has all the
530 unfolding info. At one point we did it by modifying the chkr so that
531 it said "EssentialUnfoldingsOnly", but that prevented legitmate, and
532 important, simplifications happening in the body of the RHS.
536 We *don't* prevent inlining from happening for identifiers
537 that are marked as IMustBeINLINEd. An example of where
538 doing this is crucial is:
540 class Bar a => Foo a where
546 If `f' needs to peer inside Foo's superclass, Bar, it refers
547 to the appropriate super class selector, which is marked as
548 must-inlineable. We don't generate any code for a superclass
549 selector, so failing to inline it in the RHS of `f' will
550 leave a reference to a non-existent id, with bad consequences.
552 ALSO NOTE that we do all this by modifing the inline-pragma,
553 not by zapping the unfolding. The latter may still be useful for
554 knowing when something is evaluated.
556 June 98 update: I've gone back to dealing with this by adding
557 the EssentialUnfoldingsOnly switch. That doesn't stop essential
558 unfoldings, nor inlineUnconditionally stuff; and the thing's going
559 to be inlined at every call site anyway. Running over the whole
560 environment seems like wild overkill.
563 switchOffInlining :: SimplM a -> SimplM a
564 switchOffInlining m env us sc
565 = m (env { seBlackList = \v -> not (isCompulsoryUnfolding (idUnfolding v)) &&
566 not (isDataConWrapId v) &&
567 ((v `isInScope` subst) || not (isLocallyDefined v))
570 -- Inside inlinings, black list anything that is in scope or imported.
571 -- except for things that must be unfolded (Compulsory)
572 -- and data con wrappers. The latter is a hack, like the one in
573 -- SimplCore.simplRules, to make wrappers inline in rule LHSs. We
574 -- may as well do the same here.
577 old_black_list = seBlackList env
581 %************************************************************************
583 \subsubsection{The ``enclosing cost-centre''}
585 %************************************************************************
588 getEnclosingCC :: SimplM CostCentreStack
589 getEnclosingCC env us sc = (seCC env, us, sc)
591 setEnclosingCC :: CostCentreStack -> SimplM a -> SimplM a
592 setEnclosingCC cc m env us sc = m (env { seCC = cc }) us sc
596 %************************************************************************
598 \subsubsection{The @SimplEnv@ type}
600 %************************************************************************
604 emptySimplEnv :: SwitchChecker -> InScopeSet -> (Id -> Bool) -> SimplEnv
606 emptySimplEnv sw_chkr in_scope black_list
607 = SimplEnv { seChkr = sw_chkr, seCC = subsumedCCS,
608 seBlackList = black_list,
609 seSubst = mkSubst in_scope emptySubstEnv }
610 -- The top level "enclosing CC" is "SUBSUMED".
612 getEnv :: SimplM SimplEnv
613 getEnv env us sc = (env, us, sc)
615 setAllExceptInScope :: SimplEnv -> SimplM a -> SimplM a
616 setAllExceptInScope new_env@(SimplEnv {seSubst = new_subst}) m
617 (SimplEnv {seSubst = old_subst}) us sc
618 = m (new_env {seSubst = Subst.setInScope new_subst (substInScope old_subst)}) us sc
620 getSubst :: SimplM Subst
621 getSubst env us sc = (seSubst env, us, sc)
623 getBlackList :: SimplM (Id -> Bool)
624 getBlackList env us sc = (seBlackList env, us, sc)
626 setSubst :: Subst -> SimplM a -> SimplM a
627 setSubst subst m env us sc = m (env {seSubst = subst}) us sc
629 getSubstEnv :: SimplM SubstEnv
630 getSubstEnv env us sc = (substEnv (seSubst env), us, sc)
632 extendInScope :: CoreBndr -> SimplM a -> SimplM a
633 extendInScope v m env@(SimplEnv {seSubst = subst}) us sc
634 = m (env {seSubst = Subst.extendInScope subst v}) us sc
636 extendInScopes :: [CoreBndr] -> SimplM a -> SimplM a
637 extendInScopes vs m env@(SimplEnv {seSubst = subst}) us sc
638 = m (env {seSubst = Subst.extendInScopes subst vs}) us sc
640 getInScope :: SimplM InScopeSet
641 getInScope env us sc = (substInScope (seSubst env), us, sc)
643 setInScope :: InScopeSet -> SimplM a -> SimplM a
644 setInScope in_scope m env@(SimplEnv {seSubst = subst}) us sc
645 = m (env {seSubst = Subst.setInScope subst in_scope}) us sc
647 modifyInScope :: CoreBndr -> CoreBndr -> SimplM a -> SimplM a
648 modifyInScope v v' m env@(SimplEnv {seSubst = subst}) us sc
649 = m (env {seSubst = Subst.modifyInScope subst v v'}) us sc
651 extendSubst :: CoreBndr -> SubstResult -> SimplM a -> SimplM a
652 extendSubst var res m env@(SimplEnv {seSubst = subst}) us sc
653 = m (env { seSubst = Subst.extendSubst subst var res }) us sc
655 extendSubstList :: [CoreBndr] -> [SubstResult] -> SimplM a -> SimplM a
656 extendSubstList vars ress m env@(SimplEnv {seSubst = subst}) us sc
657 = m (env { seSubst = Subst.extendSubstList subst vars ress }) us sc
659 setSubstEnv :: SubstEnv -> SimplM a -> SimplM a
660 setSubstEnv senv m env@(SimplEnv {seSubst = subst}) us sc
661 = m (env {seSubst = Subst.setSubstEnv subst senv}) us sc
663 zapSubstEnv :: SimplM a -> SimplM a
664 zapSubstEnv m env@(SimplEnv {seSubst = subst}) us sc
665 = m (env {seSubst = Subst.zapSubstEnv subst}) us sc
667 getSimplBinderStuff :: SimplM (Subst, UniqSupply)
668 getSimplBinderStuff (SimplEnv {seSubst = subst}) us sc
669 = ((subst, us), us, sc)
671 setSimplBinderStuff :: (Subst, UniqSupply) -> SimplM a -> SimplM a
672 setSimplBinderStuff (subst, us) m env _ sc
673 = m (env {seSubst = subst}) us sc
678 newId :: UserFS -> Type -> (Id -> SimplM a) -> SimplM a
679 -- Extends the in-scope-env too
680 newId fs ty m env@(SimplEnv {seSubst = subst}) us sc
681 = case splitUniqSupply us of
682 (us1, us2) -> m v (env {seSubst = Subst.extendInScope subst v}) us2 sc
684 v = mkSysLocal fs (uniqFromSupply us1) ty
686 newIds :: UserFS -> [Type] -> ([Id] -> SimplM a) -> SimplM a
687 newIds fs tys m env@(SimplEnv {seSubst = subst}) us sc
688 = case splitUniqSupply us of
689 (us1, us2) -> m vs (env {seSubst = Subst.extendInScopes subst vs}) us2 sc
691 vs = zipWithEqual "newIds" (mkSysLocal fs)
692 (uniqsFromSupply (length tys) us1) tys