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
18 setBlackList, getBlackList, noInlineBlackList,
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, modifyInScope, addNewInScopeIds,
41 setSubstEnv, zapSubstEnv,
42 getSimplBinderStuff, setSimplBinderStuff
45 #include "HsVersions.h"
47 import Id ( Id, mkSysLocal, idUnfolding, isDataConWrapId )
49 import CoreUnfold ( isCompulsoryUnfolding )
50 import PprCore () -- Instances
51 import CostCentre ( CostCentreStack, subsumedCCS )
52 import Name ( isLocallyDefined )
53 import OccName ( UserFS )
56 import qualified Subst
57 import Subst ( Subst, mkSubst, substEnv,
58 InScopeSet, mkInScopeSet, substInScope, isInScope
61 import UniqSupply ( uniqsFromSupply, uniqFromSupply, splitUniqSupply,
65 import CmdLineOpts ( SimplifierSwitch(..), SwitchResult(..),
66 opt_PprStyle_Debug, opt_HistorySize, opt_D_dump_simpl_stats,
69 import Unique ( Unique )
70 import Maybes ( expectJust )
71 import Util ( zipWithEqual )
74 infixr 0 `thenSmpl`, `thenSmpl_`
77 %************************************************************************
79 \subsection[Simplify-types]{Type declarations}
81 %************************************************************************
84 type InBinder = CoreBndr
85 type InId = Id -- Not yet cloned
86 type InType = Type -- Ditto
87 type InBind = CoreBind
88 type InExpr = CoreExpr
92 type OutBinder = CoreBndr
93 type OutId = Id -- Cloned
94 type OutType = Type -- Cloned
95 type OutBind = CoreBind
96 type OutExpr = CoreExpr
100 type SwitchChecker = SimplifierSwitch -> SwitchResult
102 type OutExprStuff = OutStuff (InScopeSet, OutExpr)
103 type OutStuff a = ([OutBind], a)
104 -- We return something equivalent to (let b in e), but
105 -- in pieces to avoid the quadratic blowup when floating
106 -- incrementally. Comments just before simplExprB in Simplify.lhs
110 %************************************************************************
112 \subsection{Monad plumbing}
114 %************************************************************************
116 For the simplifier monad, we want to {\em thread} a unique supply and a counter.
117 (Command-line switches move around through the explicitly-passed SimplEnv.)
120 type SimplM result -- We thread the unique supply because
121 = SimplEnv -- constantly splitting it is rather expensive
124 -> (result, UniqSupply, SimplCount)
126 type BlackList = Id -> Bool -- True => don't inline this Id
130 seChkr :: SwitchChecker,
131 seCC :: CostCentreStack, -- The enclosing CCS (when profiling)
132 seBlackList :: BlackList,
133 seSubst :: Subst -- The current substitution
135 -- The range of the substitution is OutType and OutExpr resp
137 -- The substitution is idempotent
138 -- It *must* be applied; things in its domain simply aren't
139 -- bound in the result.
141 -- The substitution usually maps an Id to its clone,
142 -- but if the orig defn is a let-binding, and
143 -- the RHS of the let simplifies to an atom,
144 -- we just add the binding to the substitution and elide the let.
146 -- The in-scope part of Subst includes *all* in-scope TyVars and Ids
147 -- The elements of the set may have better IdInfo than the
148 -- occurrences of in-scope Ids, and (more important) they will
149 -- have a correctly-substituted type. So we use a lookup in this
150 -- set to replace occurrences
154 initSmpl :: SwitchChecker
155 -> UniqSupply -- No init count; set to 0
156 -> VarSet -- In scope (usually empty, but useful for nested calls)
157 -> BlackList -- Black-list function
161 initSmpl chkr us in_scope black_list m
162 = case m (emptySimplEnv chkr in_scope black_list) us zeroSimplCount of
163 (result, _, count) -> (result, count)
166 {-# INLINE thenSmpl #-}
167 {-# INLINE thenSmpl_ #-}
168 {-# INLINE returnSmpl #-}
170 returnSmpl :: a -> SimplM a
171 returnSmpl e env us sc = (e, us, sc)
173 thenSmpl :: SimplM a -> (a -> SimplM b) -> SimplM b
174 thenSmpl_ :: SimplM a -> SimplM b -> SimplM b
176 thenSmpl m k env us0 sc0
177 = case (m env us0 sc0) of
178 (m_result, us1, sc1) -> k m_result env us1 sc1
180 thenSmpl_ m k env us0 sc0
181 = case (m env us0 sc0) of
182 (_, us1, sc1) -> k env us1 sc1
187 mapSmpl :: (a -> SimplM b) -> [a] -> SimplM [b]
188 mapAndUnzipSmpl :: (a -> SimplM (b, c)) -> [a] -> SimplM ([b],[c])
190 mapSmpl f [] = returnSmpl []
192 = f x `thenSmpl` \ x' ->
193 mapSmpl f xs `thenSmpl` \ xs' ->
196 mapAndUnzipSmpl f [] = returnSmpl ([],[])
197 mapAndUnzipSmpl f (x:xs)
198 = f x `thenSmpl` \ (r1, r2) ->
199 mapAndUnzipSmpl f xs `thenSmpl` \ (rs1, rs2) ->
200 returnSmpl (r1:rs1, r2:rs2)
202 mapAccumLSmpl f acc [] = returnSmpl (acc, [])
203 mapAccumLSmpl f acc (x:xs) = f acc x `thenSmpl` \ (acc', x') ->
204 mapAccumLSmpl f acc' xs `thenSmpl` \ (acc'', xs') ->
205 returnSmpl (acc'', x':xs')
209 %************************************************************************
211 \subsection{The unique supply}
213 %************************************************************************
216 getUniqueSmpl :: SimplM Unique
217 getUniqueSmpl env us sc = case splitUniqSupply us of
218 (us1, us2) -> (uniqFromSupply us1, us2, sc)
220 getUniquesSmpl :: Int -> SimplM [Unique]
221 getUniquesSmpl n env us sc = case splitUniqSupply us of
222 (us1, us2) -> (uniqsFromSupply n us1, us2, sc)
226 %************************************************************************
228 \subsection{Counting up what we've done}
230 %************************************************************************
233 getSimplCount :: SimplM SimplCount
234 getSimplCount env us sc = (sc, us, sc)
236 tick :: Tick -> SimplM ()
237 tick t env us sc = sc' `seq` ((), us, sc')
241 freeTick :: Tick -> SimplM ()
242 -- Record a tick, but don't add to the total tick count, which is
243 -- used to decide when nothing further has happened
244 freeTick t env us sc = sc' `seq` ((), us, sc')
246 sc' = doFreeTick t sc
250 verboseSimplStats = opt_PprStyle_Debug -- For now, anyway
252 zeroSimplCount :: SimplCount
253 isZeroSimplCount :: SimplCount -> Bool
254 pprSimplCount :: SimplCount -> SDoc
255 doTick, doFreeTick :: Tick -> SimplCount -> SimplCount
256 plusSimplCount :: SimplCount -> SimplCount -> SimplCount
260 data SimplCount = VerySimplZero -- These two are used when
261 | VerySimplNonZero -- we are only interested in
265 ticks :: !Int, -- Total ticks
266 details :: !TickCounts, -- How many of each type
268 log1 :: [Tick], -- Last N events; <= opt_HistorySize
269 log2 :: [Tick] -- Last opt_HistorySize events before that
272 type TickCounts = FiniteMap Tick Int
274 zeroSimplCount -- This is where we decide whether to do
275 -- the VerySimpl version or the full-stats version
276 | opt_D_dump_simpl_stats = SimplCount {ticks = 0, details = emptyFM,
277 n_log = 0, log1 = [], log2 = []}
278 | otherwise = VerySimplZero
280 isZeroSimplCount VerySimplZero = True
281 isZeroSimplCount (SimplCount { ticks = 0 }) = True
282 isZeroSimplCount other = False
284 doFreeTick tick sc@SimplCount { details = dts }
285 = dts' `seqFM` sc { details = dts' }
287 dts' = dts `addTick` tick
288 doFreeTick tick sc = sc
290 -- Gross hack to persuade GHC 3.03 to do this important seq
291 seqFM fm x | isEmptyFM fm = x
294 doTick tick sc@SimplCount { ticks = tks, details = dts, n_log = nl, log1 = l1, log2 = l2 }
295 | nl >= opt_HistorySize = sc1 { n_log = 1, log1 = [tick], log2 = l1 }
296 | otherwise = sc1 { n_log = nl+1, log1 = tick : l1 }
298 sc1 = sc { ticks = tks+1, details = dts `addTick` tick }
300 doTick tick sc = VerySimplNonZero -- The very simple case
303 -- Don't use plusFM_C because that's lazy, and we want to
304 -- be pretty strict here!
305 addTick :: TickCounts -> Tick -> TickCounts
306 addTick fm tick = case lookupFM fm tick of
307 Nothing -> addToFM fm tick 1
308 Just n -> n1 `seq` addToFM fm tick n1
313 plusSimplCount sc1@(SimplCount { ticks = tks1, details = dts1 })
314 sc2@(SimplCount { ticks = tks2, details = dts2 })
315 = log_base { ticks = tks1 + tks2, details = plusFM_C (+) dts1 dts2 }
317 -- A hackish way of getting recent log info
318 log_base | null (log1 sc2) = sc1 -- Nothing at all in sc2
319 | null (log2 sc2) = sc2 { log2 = log1 sc1 }
322 plusSimplCount VerySimplZero VerySimplZero = VerySimplZero
323 plusSimplCount sc1 sc2 = VerySimplNonZero
325 pprSimplCount VerySimplZero = ptext SLIT("Total ticks: ZERO!")
326 pprSimplCount VerySimplNonZero = ptext SLIT("Total ticks: NON-ZERO!")
327 pprSimplCount (SimplCount { ticks = tks, details = dts, log1 = l1, log2 = l2 })
328 = vcat [ptext SLIT("Total ticks: ") <+> int tks,
330 pprTickCounts (fmToList dts),
331 if verboseSimplStats then
333 ptext SLIT("Log (most recent first)"),
334 nest 4 (vcat (map ppr l1) $$ vcat (map ppr l2))]
338 pprTickCounts :: [(Tick,Int)] -> SDoc
339 pprTickCounts [] = empty
340 pprTickCounts ((tick1,n1):ticks)
341 = vcat [int tot_n <+> text (tickString tick1),
342 pprTCDetails real_these,
346 tick1_tag = tickToTag tick1
347 (these, others) = span same_tick ticks
348 real_these = (tick1,n1):these
349 same_tick (tick2,_) = tickToTag tick2 == tick1_tag
350 tot_n = sum [n | (_,n) <- real_these]
352 pprTCDetails ticks@((tick,_):_)
353 | verboseSimplStats || isRuleFired tick
354 = nest 4 (vcat [int n <+> pprTickCts tick | (tick,n) <- ticks])
359 %************************************************************************
363 %************************************************************************
367 = PreInlineUnconditionally Id
368 | PostInlineUnconditionally Id
371 | RuleFired FAST_STRING -- Rule name
373 | LetFloatFromLet Id -- Thing floated out
374 | EtaExpansion Id -- LHS binder
375 | EtaReduction Id -- Binder on outer lambda
376 | BetaReduction Id -- Lambda binder
379 | CaseOfCase Id -- Bndr on *inner* case
380 | KnownBranch Id -- Case binder
381 | CaseMerge Id -- Binder on outer case
382 | CaseElim Id -- Case binder
383 | CaseIdentity Id -- Case binder
384 | FillInCaseDefault Id -- Case binder
387 | SimplifierDone -- Ticked at each iteration of the simplifier
389 isRuleFired (RuleFired _) = True
390 isRuleFired other = False
392 instance Outputable Tick where
393 ppr tick = text (tickString tick) <+> pprTickCts tick
395 instance Eq Tick where
396 a == b = case a `cmpTick` b of { EQ -> True; other -> False }
398 instance Ord Tick where
401 tickToTag :: Tick -> Int
402 tickToTag (PreInlineUnconditionally _) = 0
403 tickToTag (PostInlineUnconditionally _) = 1
404 tickToTag (UnfoldingDone _) = 2
405 tickToTag (RuleFired _) = 3
406 tickToTag (LetFloatFromLet _) = 4
407 tickToTag (EtaExpansion _) = 5
408 tickToTag (EtaReduction _) = 6
409 tickToTag (BetaReduction _) = 7
410 tickToTag (CaseOfCase _) = 8
411 tickToTag (KnownBranch _) = 9
412 tickToTag (CaseMerge _) = 10
413 tickToTag (CaseElim _) = 11
414 tickToTag (CaseIdentity _) = 12
415 tickToTag (FillInCaseDefault _) = 13
416 tickToTag BottomFound = 14
417 tickToTag SimplifierDone = 16
419 tickString :: Tick -> String
420 tickString (PreInlineUnconditionally _) = "PreInlineUnconditionally"
421 tickString (PostInlineUnconditionally _)= "PostInlineUnconditionally"
422 tickString (UnfoldingDone _) = "UnfoldingDone"
423 tickString (RuleFired _) = "RuleFired"
424 tickString (LetFloatFromLet _) = "LetFloatFromLet"
425 tickString (EtaExpansion _) = "EtaExpansion"
426 tickString (EtaReduction _) = "EtaReduction"
427 tickString (BetaReduction _) = "BetaReduction"
428 tickString (CaseOfCase _) = "CaseOfCase"
429 tickString (KnownBranch _) = "KnownBranch"
430 tickString (CaseMerge _) = "CaseMerge"
431 tickString (CaseElim _) = "CaseElim"
432 tickString (CaseIdentity _) = "CaseIdentity"
433 tickString (FillInCaseDefault _) = "FillInCaseDefault"
434 tickString BottomFound = "BottomFound"
435 tickString SimplifierDone = "SimplifierDone"
437 pprTickCts :: Tick -> SDoc
438 pprTickCts (PreInlineUnconditionally v) = ppr v
439 pprTickCts (PostInlineUnconditionally v)= ppr v
440 pprTickCts (UnfoldingDone v) = ppr v
441 pprTickCts (RuleFired v) = ppr v
442 pprTickCts (LetFloatFromLet v) = ppr v
443 pprTickCts (EtaExpansion v) = ppr v
444 pprTickCts (EtaReduction v) = ppr v
445 pprTickCts (BetaReduction v) = ppr v
446 pprTickCts (CaseOfCase v) = ppr v
447 pprTickCts (KnownBranch v) = ppr v
448 pprTickCts (CaseMerge v) = ppr v
449 pprTickCts (CaseElim v) = ppr v
450 pprTickCts (CaseIdentity v) = ppr v
451 pprTickCts (FillInCaseDefault v) = ppr v
452 pprTickCts other = empty
454 cmpTick :: Tick -> Tick -> Ordering
455 cmpTick a b = case (tickToTag a `compare` tickToTag b) of
457 EQ | isRuleFired a || verboseSimplStats -> cmpEqTick a b
460 -- Always distinguish RuleFired, so that the stats
461 -- can report them even in non-verbose mode
463 cmpEqTick :: Tick -> Tick -> Ordering
464 cmpEqTick (PreInlineUnconditionally a) (PreInlineUnconditionally b) = a `compare` b
465 cmpEqTick (PostInlineUnconditionally a) (PostInlineUnconditionally b) = a `compare` b
466 cmpEqTick (UnfoldingDone a) (UnfoldingDone b) = a `compare` b
467 cmpEqTick (RuleFired a) (RuleFired b) = a `compare` b
468 cmpEqTick (LetFloatFromLet a) (LetFloatFromLet b) = a `compare` b
469 cmpEqTick (EtaExpansion a) (EtaExpansion b) = a `compare` b
470 cmpEqTick (EtaReduction a) (EtaReduction b) = a `compare` b
471 cmpEqTick (BetaReduction a) (BetaReduction b) = a `compare` b
472 cmpEqTick (CaseOfCase a) (CaseOfCase b) = a `compare` b
473 cmpEqTick (KnownBranch a) (KnownBranch b) = a `compare` b
474 cmpEqTick (CaseMerge a) (CaseMerge b) = a `compare` b
475 cmpEqTick (CaseElim a) (CaseElim b) = a `compare` b
476 cmpEqTick (CaseIdentity a) (CaseIdentity b) = a `compare` b
477 cmpEqTick (FillInCaseDefault a) (FillInCaseDefault b) = a `compare` b
478 cmpEqTick other1 other2 = EQ
482 %************************************************************************
484 \subsubsection{Command-line switches}
486 %************************************************************************
489 getSwitchChecker :: SimplM SwitchChecker
490 getSwitchChecker env us sc = (seChkr env, us, sc)
492 getSimplIntSwitch :: SwitchChecker -> (Int-> SimplifierSwitch) -> Int
493 getSimplIntSwitch chkr switch
494 = expectJust "getSimplIntSwitch" (intSwitchSet chkr switch)
498 @setBlackList@ is used to prepare the environment for simplifying
499 the RHS of an Id that's marked with an INLINE pragma. It is going to
500 be inlined wherever they are used, and then all the inlining will take
501 effect. Meanwhile, there isn't much point in doing anything to the
502 as-yet-un-INLINEd rhs. Furthremore, it's very important to switch off
504 (a) not doing so will inline a worker straight back into its wrapper!
506 and (b) Consider the following example
511 in ...g...g...g...g...g...
513 Now, if that's the ONLY occurrence of f, it will be inlined inside g,
514 and thence copied multiple times when g is inlined.
516 Andy disagrees! Example:
517 all xs = foldr (&&) True xs
518 any p = all . map p {-# INLINE any #-}
520 Problem: any won't get deforested, and so if it's exported and
521 the importer doesn't use the inlining, (eg passes it as an arg)
522 then we won't get deforestation at all.
523 We havn't solved this problem yet!
525 We prepare the envt by simply modifying the black list.
529 We *don't* prevent inlining from happening for identifiers
530 that are marked as IMustBeINLINEd. An example of where
531 doing this is crucial is:
533 class Bar a => Foo a where
539 If `f' needs to peer inside Foo's superclass, Bar, it refers
540 to the appropriate super class selector, which is marked as
541 must-inlineable. We don't generate any code for a superclass
542 selector, so failing to inline it in the RHS of `f' will
543 leave a reference to a non-existent id, with bad consequences.
545 ALSO NOTE that we do all this by modifing the black list
546 not by zapping the unfolding. The latter may still be useful for
547 knowing when something is evaluated.
550 setBlackList :: BlackList -> SimplM a -> SimplM a
551 setBlackList black_list m env us sc = m (env { seBlackList = black_list }) us sc
553 getBlackList :: SimplM BlackList
554 getBlackList env us sc = (seBlackList env, us, sc)
556 noInlineBlackList :: BlackList
557 -- Inside inlinings, black list anything that is in scope or imported.
558 -- except for things that must be unfolded (Compulsory)
559 -- and data con wrappers. The latter is a hack, like the one in
560 -- SimplCore.simplRules, to make wrappers inline in rule LHSs.
561 -- We may as well do the same here.
562 noInlineBlackList v = not (isCompulsoryUnfolding (idUnfolding v)) &&
563 not (isDataConWrapId v)
564 -- ((v `isInScope` subst) || not (isLocallyDefined v))
565 -- I don't see why we have these conditions
569 %************************************************************************
571 \subsubsection{The ``enclosing cost-centre''}
573 %************************************************************************
576 getEnclosingCC :: SimplM CostCentreStack
577 getEnclosingCC env us sc = (seCC env, us, sc)
579 setEnclosingCC :: CostCentreStack -> SimplM a -> SimplM a
580 setEnclosingCC cc m env us sc = m (env { seCC = cc }) us sc
584 %************************************************************************
586 \subsubsection{The @SimplEnv@ type}
588 %************************************************************************
592 emptySimplEnv :: SwitchChecker -> VarSet -> (Id -> Bool) -> SimplEnv
594 emptySimplEnv sw_chkr in_scope black_list
595 = SimplEnv { seChkr = sw_chkr, seCC = subsumedCCS,
596 seBlackList = black_list,
597 seSubst = mkSubst (mkInScopeSet in_scope) emptySubstEnv }
598 -- The top level "enclosing CC" is "SUBSUMED".
600 getEnv :: SimplM SimplEnv
601 getEnv env us sc = (env, us, sc)
603 setAllExceptInScope :: SimplEnv -> SimplM a -> SimplM a
604 setAllExceptInScope new_env@(SimplEnv {seSubst = new_subst}) m
605 (SimplEnv {seSubst = old_subst}) us sc
606 = m (new_env {seSubst = Subst.setInScope new_subst (substInScope old_subst)}) us sc
608 getSubst :: SimplM Subst
609 getSubst env us sc = (seSubst env, us, sc)
611 setSubst :: Subst -> SimplM a -> SimplM a
612 setSubst subst m env us sc = m (env {seSubst = subst}) us sc
614 getSubstEnv :: SimplM SubstEnv
615 getSubstEnv env us sc = (substEnv (seSubst env), us, sc)
617 addNewInScopeIds :: [CoreBndr] -> SimplM a -> SimplM a
618 -- The new Ids are guaranteed to be freshly allocated
619 addNewInScopeIds vs m env@(SimplEnv {seSubst = subst}) us sc
620 = m (env {seSubst = Subst.extendNewInScopeList subst vs}) us sc
622 getInScope :: SimplM InScopeSet
623 getInScope env us sc = (substInScope (seSubst env), us, sc)
625 setInScope :: InScopeSet -> SimplM a -> SimplM a
626 setInScope in_scope m env@(SimplEnv {seSubst = subst}) us sc
627 = m (env {seSubst = Subst.setInScope subst in_scope}) us sc
629 modifyInScope :: CoreBndr -> CoreBndr -> SimplM a -> SimplM a
630 modifyInScope v v' m env@(SimplEnv {seSubst = subst}) us sc
631 = m (env {seSubst = Subst.modifyInScope subst v v'}) us sc
633 extendSubst :: CoreBndr -> SubstResult -> SimplM a -> SimplM a
634 extendSubst var res m env@(SimplEnv {seSubst = subst}) us sc
635 = m (env { seSubst = Subst.extendSubst subst var res }) us sc
637 extendSubstList :: [CoreBndr] -> [SubstResult] -> SimplM a -> SimplM a
638 extendSubstList vars ress m env@(SimplEnv {seSubst = subst}) us sc
639 = m (env { seSubst = Subst.extendSubstList subst vars ress }) us sc
641 setSubstEnv :: SubstEnv -> SimplM a -> SimplM a
642 setSubstEnv senv m env@(SimplEnv {seSubst = subst}) us sc
643 = m (env {seSubst = Subst.setSubstEnv subst senv}) us sc
645 zapSubstEnv :: SimplM a -> SimplM a
646 zapSubstEnv m env@(SimplEnv {seSubst = subst}) us sc
647 = m (env {seSubst = Subst.zapSubstEnv subst}) us sc
649 getSimplBinderStuff :: SimplM (Subst, UniqSupply)
650 getSimplBinderStuff (SimplEnv {seSubst = subst}) us sc
651 = ((subst, us), us, sc)
653 setSimplBinderStuff :: (Subst, UniqSupply) -> SimplM a -> SimplM a
654 setSimplBinderStuff (subst, us) m env _ sc
655 = m (env {seSubst = subst}) us sc
660 newId :: UserFS -> Type -> (Id -> SimplM a) -> SimplM a
661 -- Extends the in-scope-env too
662 newId fs ty m env@(SimplEnv {seSubst = subst}) us sc
663 = case splitUniqSupply us of
664 (us1, us2) -> m v (env {seSubst = Subst.extendNewInScope subst v}) us2 sc
666 v = mkSysLocal fs (uniqFromSupply us1) ty
668 newIds :: UserFS -> [Type] -> ([Id] -> SimplM a) -> SimplM a
669 newIds fs tys m env@(SimplEnv {seSubst = subst}) us sc
670 = case splitUniqSupply us of
671 (us1, us2) -> m vs (env {seSubst = Subst.extendNewInScopeList subst vs}) us2 sc
673 vs = zipWithEqual "newIds" (mkSysLocal fs)
674 (uniqsFromSupply (length tys) us1) tys