module SimplMonad (
InId, InBind, InExpr, InAlt, InArg, InType, InBinder,
OutId, OutBind, OutExpr, OutAlt, OutArg, OutType, OutBinder,
- OutExprStuff, OutStuff,
+ OutExprStuff, OutStuff, returnOutStuff,
-- The monad
SimplM,
initSmpl, returnSmpl, thenSmpl, thenSmpl_,
mapSmpl, mapAndUnzipSmpl, mapAccumLSmpl,
+ getDOptsSmpl,
-- The inlining black-list
- getBlackList,
+ setBlackList, getBlackList, noInlineBlackList,
-- Unique supply
- getUniqueSmpl, getUniquesSmpl,
+ getUniqueSmpl, getUniquesSmpl, getUniqSupplySmpl,
newId, newIds,
-- Counting
getEnv, setAllExceptInScope,
getSubst, setSubst,
getSubstEnv, extendSubst, extendSubstList,
- getInScope, setInScope, extendInScope, extendInScopes, modifyInScope,
+ getInScope, setInScope, modifyInScope, addNewInScopeIds,
setSubstEnv, zapSubstEnv,
getSimplBinderStuff, setSimplBinderStuff,
- switchOffInlining
+
+ -- Adding bindings
+ addLetBind, addLetBinds, addAuxiliaryBind, addAuxiliaryBinds,
+ addCaseBind, needsCaseBinding, addNonRecBind, wrapFloats, addFloats
) where
#include "HsVersions.h"
-import Id ( Id, mkSysLocal, idUnfolding, isDataConWrapId )
-import IdInfo ( InlinePragInfo(..) )
-import Demand ( Demand )
+import Id ( Id, mkSysLocal, idType, idUnfolding, isDataConWrapId )
import CoreSyn
-import CoreUnfold ( isCompulsoryUnfolding, isEvaldUnfolding )
+import CoreUnfold ( isCompulsoryUnfolding )
+import CoreUtils ( exprOkForSpeculation )
import PprCore () -- Instances
-import Rules ( RuleBase )
import CostCentre ( CostCentreStack, subsumedCCS )
-import Name ( isLocallyDefined )
import OccName ( UserFS )
-import Var ( TyVar )
import VarEnv
import VarSet
+import OrdList
import qualified Subst
-import Subst ( Subst, emptySubst, mkSubst,
- substTy, substEnv,
- InScopeSet, substInScope, isInScope
+import Subst ( Subst, mkSubst, substEnv,
+ InScopeSet, mkInScopeSet, substInScope
)
-import Type ( Type, TyVarSubst, applyTy )
+import Type ( Type, isUnLiftedType )
import UniqSupply ( uniqsFromSupply, uniqFromSupply, splitUniqSupply,
UniqSupply
)
import FiniteMap
import CmdLineOpts ( SimplifierSwitch(..), SwitchResult(..),
- opt_PprStyle_Debug, opt_HistorySize, opt_D_dump_simpl_stats,
+ DynFlags, DynFlag(..), dopt,
+ opt_PprStyle_Debug, opt_HistorySize,
intSwitchSet
)
import Unique ( Unique )
type SwitchChecker = SimplifierSwitch -> SwitchResult
-type OutExprStuff = OutStuff (InScopeSet, OutExpr)
-type OutStuff a = ([OutBind], a)
+type OutExprStuff = OutStuff OutExpr
+type OutStuff a = (OrdList OutBind, (InScopeSet, a))
-- We return something equivalent to (let b in e), but
-- in pieces to avoid the quadratic blowup when floating
-- incrementally. Comments just before simplExprB in Simplify.lhs
\end{code}
+\begin{code}
+wrapFloats :: OrdList CoreBind -> CoreExpr -> CoreExpr
+wrapFloats binds body = foldOL Let body binds
+
+returnOutStuff :: a -> SimplM (OutStuff a)
+returnOutStuff x = getInScope `thenSmpl` \ in_scope ->
+ returnSmpl (nilOL, (in_scope, x))
+
+addFloats :: OrdList CoreBind -> InScopeSet -> SimplM (OutStuff a) -> SimplM (OutStuff a)
+addFloats floats in_scope thing_inside
+ = setInScope in_scope thing_inside `thenSmpl` \ (binds, res) ->
+ returnSmpl (floats `appOL` binds, res)
+
+addLetBind :: CoreBind -> SimplM (OutStuff a) -> SimplM (OutStuff a)
+addLetBind bind thing_inside
+ = thing_inside `thenSmpl` \ (binds, res) ->
+ returnSmpl (bind `consOL` binds, res)
+
+addLetBinds :: [CoreBind] -> SimplM (OutStuff a) -> SimplM (OutStuff a)
+addLetBinds binds1 thing_inside
+ = thing_inside `thenSmpl` \ (binds2, res) ->
+ returnSmpl (toOL binds1 `appOL` binds2, res)
+
+addAuxiliaryBinds :: [CoreBind] -> SimplM (OutStuff a) -> SimplM (OutStuff a)
+ -- Extends the in-scope environment as well as wrapping the bindings
+addAuxiliaryBinds binds1 thing_inside
+ = addNewInScopeIds (bindersOfBinds binds1) $
+ addLetBinds binds1 thing_inside
+
+addAuxiliaryBind :: CoreBind -> SimplM (OutStuff a) -> SimplM (OutStuff a)
+ -- Extends the in-scope environment as well as wrapping the bindings
+addAuxiliaryBind bind thing_inside
+ = addNewInScopeIds (bindersOf bind) $
+ addLetBind bind thing_inside
+
+needsCaseBinding ty rhs = isUnLiftedType ty && not (exprOkForSpeculation rhs)
+ -- Make a case expression instead of a let
+ -- These can arise either from the desugarer,
+ -- or from beta reductions: (\x.e) (x +# y)
+
+addCaseBind bndr rhs thing_inside
+ = thing_inside `thenSmpl` \ (floats, (_, body)) ->
+ returnOutStuff (Case rhs bndr [(DEFAULT, [], wrapFloats floats body)])
+
+addNonRecBind bndr rhs thing_inside
+ -- Checks for needing a case binding
+ | needsCaseBinding (idType bndr) rhs = addCaseBind bndr rhs thing_inside
+ | otherwise = addLetBind (NonRec bndr rhs) thing_inside
+\end{code}
+
%************************************************************************
%* *
(Command-line switches move around through the explicitly-passed SimplEnv.)
\begin{code}
-type SimplM result -- We thread the unique supply because
- = SimplEnv -- constantly splitting it is rather expensive
- -> UniqSupply
+type SimplM result
+ = DynFlags
+ -> SimplEnv -- We thread the unique supply because
+ -> UniqSupply -- constantly splitting it is rather expensive
-> SimplCount
-> (result, UniqSupply, SimplCount)
+type BlackList = Id -> Bool -- True => don't inline this Id
+
data SimplEnv
= SimplEnv {
seChkr :: SwitchChecker,
seCC :: CostCentreStack, -- The enclosing CCS (when profiling)
- seBlackList :: Id -> Bool, -- True => don't inline this Id
+ seBlackList :: BlackList,
seSubst :: Subst -- The current substitution
}
-- The range of the substitution is OutType and OutExpr resp
\end{code}
\begin{code}
-initSmpl :: SwitchChecker
+initSmpl :: DynFlags
+ -> SwitchChecker
-> UniqSupply -- No init count; set to 0
-> VarSet -- In scope (usually empty, but useful for nested calls)
- -> (Id -> Bool) -- Black-list function
+ -> BlackList -- Black-list function
-> SimplM a
-> (a, SimplCount)
-initSmpl chkr us in_scope black_list m
- = case m (emptySimplEnv chkr in_scope black_list) us zeroSimplCount of
+initSmpl dflags chkr us in_scope black_list m
+ = case m dflags (emptySimplEnv chkr in_scope black_list) us
+ (zeroSimplCount dflags) of
(result, _, count) -> (result, count)
{-# INLINE returnSmpl #-}
returnSmpl :: a -> SimplM a
-returnSmpl e env us sc = (e, us, sc)
+returnSmpl e dflags env us sc = (e, us, sc)
thenSmpl :: SimplM a -> (a -> SimplM b) -> SimplM b
thenSmpl_ :: SimplM a -> SimplM b -> SimplM b
-thenSmpl m k env us0 sc0
- = case (m env us0 sc0) of
- (m_result, us1, sc1) -> k m_result env us1 sc1
+thenSmpl m k dflags env us0 sc0
+ = case (m dflags env us0 sc0) of
+ (m_result, us1, sc1) -> k m_result dflags env us1 sc1
-thenSmpl_ m k env us0 sc0
- = case (m env us0 sc0) of
- (_, us1, sc1) -> k env us1 sc1
+thenSmpl_ m k dflags env us0 sc0
+ = case (m dflags env us0 sc0) of
+ (_, us1, sc1) -> k dflags env us1 sc1
\end{code}
%************************************************************************
\begin{code}
-getUniqueSmpl :: SimplM Unique
-getUniqueSmpl env us sc = case splitUniqSupply us of
- (us1, us2) -> (uniqFromSupply us1, us2, sc)
+getUniqSupplySmpl :: SimplM UniqSupply
+getUniqSupplySmpl dflags env us sc
+ = case splitUniqSupply us of
+ (us1, us2) -> (us1, us2, sc)
-getUniquesSmpl :: Int -> SimplM [Unique]
-getUniquesSmpl n env us sc = case splitUniqSupply us of
- (us1, us2) -> (uniqsFromSupply n us1, us2, sc)
+getUniqueSmpl :: SimplM Unique
+getUniqueSmpl dflags env us sc
+ = case splitUniqSupply us of
+ (us1, us2) -> (uniqFromSupply us1, us2, sc)
+
+getUniquesSmpl :: SimplM [Unique]
+getUniquesSmpl dflags env us sc
+ = case splitUniqSupply us of
+ (us1, us2) -> (uniqsFromSupply us1, us2, sc)
+
+getDOptsSmpl :: SimplM DynFlags
+getDOptsSmpl dflags env us sc
+ = (dflags, us, sc)
\end{code}
\begin{code}
getSimplCount :: SimplM SimplCount
-getSimplCount env us sc = (sc, us, sc)
+getSimplCount dflags env us sc = (sc, us, sc)
tick :: Tick -> SimplM ()
-tick t env us sc = sc' `seq` ((), us, sc')
- where
- sc' = doTick t sc
+tick t dflags env us sc
+ = sc' `seq` ((), us, sc')
+ where
+ sc' = doTick t sc
freeTick :: Tick -> SimplM ()
-- Record a tick, but don't add to the total tick count, which is
-- used to decide when nothing further has happened
-freeTick t env us sc = sc' `seq` ((), us, sc')
- where
- sc' = doFreeTick t sc
+freeTick t dflags env us sc
+ = sc' `seq` ((), us, sc')
+ where
+ sc' = doFreeTick t sc
\end{code}
\begin{code}
verboseSimplStats = opt_PprStyle_Debug -- For now, anyway
-zeroSimplCount :: SimplCount
+zeroSimplCount :: DynFlags -> SimplCount
isZeroSimplCount :: SimplCount -> Bool
pprSimplCount :: SimplCount -> SDoc
doTick, doFreeTick :: Tick -> SimplCount -> SimplCount
type TickCounts = FiniteMap Tick Int
-zeroSimplCount -- This is where we decide whether to do
+zeroSimplCount dflags
+ -- This is where we decide whether to do
-- the VerySimpl version or the full-stats version
- | opt_D_dump_simpl_stats = SimplCount {ticks = 0, details = emptyFM,
- n_log = 0, log1 = [], log2 = []}
- | otherwise = VerySimplZero
+ | dopt Opt_D_dump_simpl_stats dflags
+ = SimplCount {ticks = 0, details = emptyFM,
+ n_log = 0, log1 = [], log2 = []}
+ | otherwise
+ = VerySimplZero
isZeroSimplCount VerySimplZero = True
isZeroSimplCount (SimplCount { ticks = 0 }) = True
| UnfoldingDone Id
| RuleFired FAST_STRING -- Rule name
- | LetFloatFromLet Id -- Thing floated out
+ | LetFloatFromLet
| EtaExpansion Id -- LHS binder
| EtaReduction Id -- Binder on outer lambda
| BetaReduction Id -- Lambda binder
tickToTag (PostInlineUnconditionally _) = 1
tickToTag (UnfoldingDone _) = 2
tickToTag (RuleFired _) = 3
-tickToTag (LetFloatFromLet _) = 4
+tickToTag LetFloatFromLet = 4
tickToTag (EtaExpansion _) = 5
tickToTag (EtaReduction _) = 6
tickToTag (BetaReduction _) = 7
tickString (PostInlineUnconditionally _)= "PostInlineUnconditionally"
tickString (UnfoldingDone _) = "UnfoldingDone"
tickString (RuleFired _) = "RuleFired"
-tickString (LetFloatFromLet _) = "LetFloatFromLet"
+tickString LetFloatFromLet = "LetFloatFromLet"
tickString (EtaExpansion _) = "EtaExpansion"
tickString (EtaReduction _) = "EtaReduction"
tickString (BetaReduction _) = "BetaReduction"
pprTickCts (PostInlineUnconditionally v)= ppr v
pprTickCts (UnfoldingDone v) = ppr v
pprTickCts (RuleFired v) = ppr v
-pprTickCts (LetFloatFromLet v) = ppr v
+pprTickCts LetFloatFromLet = empty
pprTickCts (EtaExpansion v) = ppr v
pprTickCts (EtaReduction v) = ppr v
pprTickCts (BetaReduction v) = ppr v
cmpEqTick (PostInlineUnconditionally a) (PostInlineUnconditionally b) = a `compare` b
cmpEqTick (UnfoldingDone a) (UnfoldingDone b) = a `compare` b
cmpEqTick (RuleFired a) (RuleFired b) = a `compare` b
-cmpEqTick (LetFloatFromLet a) (LetFloatFromLet b) = a `compare` b
cmpEqTick (EtaExpansion a) (EtaExpansion b) = a `compare` b
cmpEqTick (EtaReduction a) (EtaReduction b) = a `compare` b
cmpEqTick (BetaReduction a) (BetaReduction b) = a `compare` b
\begin{code}
getSwitchChecker :: SimplM SwitchChecker
-getSwitchChecker env us sc = (seChkr env, us, sc)
+getSwitchChecker dflags env us sc = (seChkr env, us, sc)
getSimplIntSwitch :: SwitchChecker -> (Int-> SimplifierSwitch) -> Int
getSimplIntSwitch chkr switch
\end{code}
-@switchOffInlining@ is used to prepare the environment for simplifying
+@setBlackList@ is used to prepare the environment for simplifying
the RHS of an Id that's marked with an INLINE pragma. It is going to
be inlined wherever they are used, and then all the inlining will take
effect. Meanwhile, there isn't much point in doing anything to the
then we won't get deforestation at all.
We havn't solved this problem yet!
-We prepare the envt by simply modifying the in_scope_env, which has all the
-unfolding info. At one point we did it by modifying the chkr so that
-it said "EssentialUnfoldingsOnly", but that prevented legitmate, and
-important, simplifications happening in the body of the RHS.
+We prepare the envt by simply modifying the black list.
6/98 update:
selector, so failing to inline it in the RHS of `f' will
leave a reference to a non-existent id, with bad consequences.
-ALSO NOTE that we do all this by modifing the inline-pragma,
+ALSO NOTE that we do all this by modifing the black list
not by zapping the unfolding. The latter may still be useful for
knowing when something is evaluated.
-June 98 update: I've gone back to dealing with this by adding
-the EssentialUnfoldingsOnly switch. That doesn't stop essential
-unfoldings, nor inlineUnconditionally stuff; and the thing's going
-to be inlined at every call site anyway. Running over the whole
-environment seems like wild overkill.
-
\begin{code}
-switchOffInlining :: SimplM a -> SimplM a
-switchOffInlining m env us sc
- = m (env { seBlackList = \v -> not (isCompulsoryUnfolding (idUnfolding v)) &&
- not (isDataConWrapId v) &&
- ((v `isInScope` subst) || not (isLocallyDefined v))
- }) us sc
-
+setBlackList :: BlackList -> SimplM a -> SimplM a
+setBlackList black_list m dflags env us sc
+ = m dflags (env { seBlackList = black_list }) us sc
+
+getBlackList :: SimplM BlackList
+getBlackList dflags env us sc = (seBlackList env, us, sc)
+
+noInlineBlackList :: BlackList
-- Inside inlinings, black list anything that is in scope or imported.
-- except for things that must be unfolded (Compulsory)
-- and data con wrappers. The latter is a hack, like the one in
- -- SimplCore.simplRules, to make wrappers inline in rule LHSs. We
- -- may as well do the same here.
- where
- subst = seSubst env
- old_black_list = seBlackList env
+ -- SimplCore.simplRules, to make wrappers inline in rule LHSs.
+ -- We may as well do the same here.
+noInlineBlackList v = not (isCompulsoryUnfolding (idUnfolding v)) &&
+ not (isDataConWrapId v)
+ -- NB: this implementation means that even inlinings *completely within*
+ -- an INLINE won't happen, which is perhaps overkill.
+ -- An earlier verion had: (v `isInScope` subst) || not (isLocallyDefined v)
+ -- but it's more expensive, and it probably doesn't matter.
\end{code}
\begin{code}
getEnclosingCC :: SimplM CostCentreStack
-getEnclosingCC env us sc = (seCC env, us, sc)
+getEnclosingCC dflags env us sc = (seCC env, us, sc)
setEnclosingCC :: CostCentreStack -> SimplM a -> SimplM a
-setEnclosingCC cc m env us sc = m (env { seCC = cc }) us sc
+setEnclosingCC cc m dflags env us sc = m dflags (env { seCC = cc }) us sc
\end{code}
\begin{code}
-emptySimplEnv :: SwitchChecker -> InScopeSet -> (Id -> Bool) -> SimplEnv
+emptySimplEnv :: SwitchChecker -> VarSet -> (Id -> Bool) -> SimplEnv
emptySimplEnv sw_chkr in_scope black_list
= SimplEnv { seChkr = sw_chkr, seCC = subsumedCCS,
seBlackList = black_list,
- seSubst = mkSubst in_scope emptySubstEnv }
+ seSubst = mkSubst (mkInScopeSet in_scope) emptySubstEnv }
-- The top level "enclosing CC" is "SUBSUMED".
getEnv :: SimplM SimplEnv
-getEnv env us sc = (env, us, sc)
+getEnv dflags env us sc = (env, us, sc)
setAllExceptInScope :: SimplEnv -> SimplM a -> SimplM a
-setAllExceptInScope new_env@(SimplEnv {seSubst = new_subst}) m
+setAllExceptInScope new_env@(SimplEnv {seSubst = new_subst}) m dflags
(SimplEnv {seSubst = old_subst}) us sc
- = m (new_env {seSubst = Subst.setInScope new_subst (substInScope old_subst)}) us sc
+ = m dflags (new_env {seSubst = Subst.setInScope new_subst (substInScope old_subst)})
+ us sc
getSubst :: SimplM Subst
-getSubst env us sc = (seSubst env, us, sc)
-
-getBlackList :: SimplM (Id -> Bool)
-getBlackList env us sc = (seBlackList env, us, sc)
+getSubst dflags env us sc = (seSubst env, us, sc)
setSubst :: Subst -> SimplM a -> SimplM a
-setSubst subst m env us sc = m (env {seSubst = subst}) us sc
+setSubst subst m dflags env us sc = m dflags (env {seSubst = subst}) us sc
getSubstEnv :: SimplM SubstEnv
-getSubstEnv env us sc = (substEnv (seSubst env), us, sc)
-
-extendInScope :: CoreBndr -> SimplM a -> SimplM a
-extendInScope v m env@(SimplEnv {seSubst = subst}) us sc
- = m (env {seSubst = Subst.extendInScope subst v}) us sc
+getSubstEnv dflags env us sc = (substEnv (seSubst env), us, sc)
-extendInScopes :: [CoreBndr] -> SimplM a -> SimplM a
-extendInScopes vs m env@(SimplEnv {seSubst = subst}) us sc
- = m (env {seSubst = Subst.extendInScopes subst vs}) us sc
+addNewInScopeIds :: [CoreBndr] -> SimplM a -> SimplM a
+ -- The new Ids are guaranteed to be freshly allocated
+addNewInScopeIds vs m dflags env@(SimplEnv {seSubst = subst}) us sc
+ = m dflags (env {seSubst = Subst.extendNewInScopeList subst vs}) us sc
getInScope :: SimplM InScopeSet
-getInScope env us sc = (substInScope (seSubst env), us, sc)
+getInScope dflags env us sc = (substInScope (seSubst env), us, sc)
setInScope :: InScopeSet -> SimplM a -> SimplM a
-setInScope in_scope m env@(SimplEnv {seSubst = subst}) us sc
- = m (env {seSubst = Subst.setInScope subst in_scope}) us sc
+setInScope in_scope m dflags env@(SimplEnv {seSubst = subst}) us sc
+ = m dflags (env {seSubst = Subst.setInScope subst in_scope}) us sc
modifyInScope :: CoreBndr -> CoreBndr -> SimplM a -> SimplM a
-modifyInScope v v' m env@(SimplEnv {seSubst = subst}) us sc
- = m (env {seSubst = Subst.modifyInScope subst v v'}) us sc
+modifyInScope v v' m dflags env@(SimplEnv {seSubst = subst}) us sc
+ = m dflags (env {seSubst = Subst.modifyInScope subst v v'}) us sc
extendSubst :: CoreBndr -> SubstResult -> SimplM a -> SimplM a
-extendSubst var res m env@(SimplEnv {seSubst = subst}) us sc
- = m (env { seSubst = Subst.extendSubst subst var res }) us sc
+extendSubst var res m dflags env@(SimplEnv {seSubst = subst}) us sc
+ = m dflags (env { seSubst = Subst.extendSubst subst var res }) us sc
extendSubstList :: [CoreBndr] -> [SubstResult] -> SimplM a -> SimplM a
-extendSubstList vars ress m env@(SimplEnv {seSubst = subst}) us sc
- = m (env { seSubst = Subst.extendSubstList subst vars ress }) us sc
+extendSubstList vars ress m dflags env@(SimplEnv {seSubst = subst}) us sc
+ = m dflags (env { seSubst = Subst.extendSubstList subst vars ress }) us sc
setSubstEnv :: SubstEnv -> SimplM a -> SimplM a
-setSubstEnv senv m env@(SimplEnv {seSubst = subst}) us sc
- = m (env {seSubst = Subst.setSubstEnv subst senv}) us sc
+setSubstEnv senv m dflags env@(SimplEnv {seSubst = subst}) us sc
+ = m dflags (env {seSubst = Subst.setSubstEnv subst senv}) us sc
zapSubstEnv :: SimplM a -> SimplM a
-zapSubstEnv m env@(SimplEnv {seSubst = subst}) us sc
- = m (env {seSubst = Subst.zapSubstEnv subst}) us sc
+zapSubstEnv m dflags env@(SimplEnv {seSubst = subst}) us sc
+ = m dflags (env {seSubst = Subst.zapSubstEnv subst}) us sc
getSimplBinderStuff :: SimplM (Subst, UniqSupply)
-getSimplBinderStuff (SimplEnv {seSubst = subst}) us sc
+getSimplBinderStuff dflags (SimplEnv {seSubst = subst}) us sc
= ((subst, us), us, sc)
setSimplBinderStuff :: (Subst, UniqSupply) -> SimplM a -> SimplM a
-setSimplBinderStuff (subst, us) m env _ sc
- = m (env {seSubst = subst}) us sc
+setSimplBinderStuff (subst, us) m dflags env _ sc
+ = m dflags (env {seSubst = subst}) us sc
\end{code}
\begin{code}
newId :: UserFS -> Type -> (Id -> SimplM a) -> SimplM a
-- Extends the in-scope-env too
-newId fs ty m env@(SimplEnv {seSubst = subst}) us sc
+newId fs ty m dflags env@(SimplEnv {seSubst = subst}) us sc
= case splitUniqSupply us of
- (us1, us2) -> m v (env {seSubst = Subst.extendInScope subst v}) us2 sc
+ (us1, us2) -> m v dflags (env {seSubst = Subst.extendNewInScope subst v})
+ us2 sc
where
v = mkSysLocal fs (uniqFromSupply us1) ty
newIds :: UserFS -> [Type] -> ([Id] -> SimplM a) -> SimplM a
-newIds fs tys m env@(SimplEnv {seSubst = subst}) us sc
+newIds fs tys m dflags env@(SimplEnv {seSubst = subst}) us sc
= case splitUniqSupply us of
- (us1, us2) -> m vs (env {seSubst = Subst.extendInScopes subst vs}) us2 sc
+ (us1, us2) -> m vs dflags (env {seSubst = Subst.extendNewInScopeList subst vs})
+ us2 sc
where
- vs = zipWithEqual "newIds" (mkSysLocal fs)
- (uniqsFromSupply (length tys) us1) tys
+ vs = zipWith (mkSysLocal fs) (uniqsFromSupply us1) tys
\end{code}
projects / ghc-hetmet.git / blobdiff