Commit fdc83001 authored by simonpj's avatar simonpj
Browse files

[project @ 2001-07-17 15:28:30 by simonpj]

--------------------------------
	First cut at the demand analyser
	--------------------------------

This demand analyser is intended to replace the strictness/absence
analyser, and the CPR analyser.

This commit adds it to the compiler, but in an entirely non-invasive
way.

	If you build the compiler without -DDEBUG,
	you won't get it at all.

	If you build the compiler with -DDEBUG,
	you'll get the demand analyser, but the existing
	strictness analyser etc are still there.  All the
	demand analyser does is to compare its output with
	the existing stuff and report differences.

There's no cross-module stuff for demand info yet.

The strictness/demand info is put the IdInfo as
	newStrictnessInfo
	newDemandInfo

Eventually we'll remove the old ones.

Simon
parent d011e911
......@@ -23,6 +23,10 @@ module IdInfo (
exactArity, atLeastArity, unknownArity, hasArity,
arityInfo, setArityInfo, ppArityInfo, arityLowerBound,
-- New demand and strictness info
newStrictnessInfo, setNewStrictnessInfo, mkNewStrictnessInfo,
newDemandInfo, setNewDemandInfo, newDemand,
-- Strictness; imported from Demand
StrictnessInfo(..),
mkStrictnessInfo, noStrictnessInfo,
......@@ -92,8 +96,10 @@ import ForeignCall ( ForeignCall )
import FieldLabel ( FieldLabel )
import Type ( usOnce, usMany )
import Demand -- Lots of stuff
import qualified NewDemand
import Outputable
import Util ( seqList )
import List ( replicate )
infixl 1 `setDemandInfo`,
`setTyGenInfo`,
......@@ -108,10 +114,46 @@ infixl 1 `setDemandInfo`,
`setOccInfo`,
`setCgInfo`,
`setCafInfo`,
`setCgArity`
`setCgArity`,
`setNewStrictnessInfo`,
`setNewDemandInfo`
-- infixl so you can say (id `set` a `set` b)
\end{code}
%************************************************************************
%* *
\subsection{New strictness info}
%* *
%************************************************************************
To be removed later
\begin{code}
mkNewStrictnessInfo :: Arity -> StrictnessInfo -> CprInfo -> NewDemand.StrictSig
mkNewStrictnessInfo arity NoStrictnessInfo cpr
= NewDemand.mkStrictSig
arity
(NewDemand.mkDmdFun (replicate arity NewDemand.Lazy) (newRes False cpr))
mkNewStrictnessInfo arity (StrictnessInfo ds res) cpr
= NewDemand.mkStrictSig
arity
(NewDemand.mkDmdFun (map newDemand ds) (newRes res cpr))
newRes True _ = NewDemand.BotRes
newRes False ReturnsCPR = NewDemand.RetCPR
newRes False NoCPRInfo = NewDemand.TopRes
newDemand :: Demand -> NewDemand.Demand
newDemand (WwLazy True) = NewDemand.Abs
newDemand (WwLazy False) = NewDemand.Lazy
newDemand WwStrict = NewDemand.Eval
newDemand (WwUnpack unpk ds) = NewDemand.Seq NewDemand.Drop (map newDemand ds)
newDemand WwPrim = NewDemand.Lazy
newDemand WwEnum = NewDemand.Eval
\end{code}
%************************************************************************
%* *
\subsection{GlobalIdDetails
......@@ -185,7 +227,10 @@ data IdInfo
cprInfo :: CprInfo, -- Function always constructs a product result
lbvarInfo :: LBVarInfo, -- Info about a lambda-bound variable
inlinePragInfo :: InlinePragInfo, -- Inline pragma
occInfo :: OccInfo -- How it occurs
occInfo :: OccInfo, -- How it occurs
newStrictnessInfo :: Maybe NewDemand.StrictSig,
newDemandInfo :: NewDemand.Demand
}
seqIdInfo :: IdInfo -> ()
......@@ -246,6 +291,9 @@ setArityInfo info ar = info { arityInfo = ar }
setCgInfo info cg = info { cgInfo = cg }
setCprInfo info cp = info { cprInfo = cp }
setLBVarInfo info lb = info { lbvarInfo = lb }
setNewDemandInfo info dd = info { newDemandInfo = dd }
setNewStrictnessInfo info dd = info { newStrictnessInfo = Just dd }
\end{code}
......@@ -264,7 +312,9 @@ vanillaIdInfo
cprInfo = NoCPRInfo,
lbvarInfo = NoLBVarInfo,
inlinePragInfo = NoInlinePragInfo,
occInfo = NoOccInfo
occInfo = NoOccInfo,
newDemandInfo = NewDemand.topDmd,
newStrictnessInfo = Nothing
}
noCafNoTyGenIdInfo = vanillaIdInfo `setTyGenInfo` TyGenNever
......
......@@ -58,7 +58,7 @@ import Name ( mkWiredInName, mkFCallName, Name )
import OccName ( mkVarOcc )
import PrimOp ( PrimOp(DataToTagOp), primOpSig, mkPrimOpIdName )
import ForeignCall ( ForeignCall )
import Demand ( wwStrict, wwPrim, mkStrictnessInfo,
import Demand ( wwStrict, wwPrim, mkStrictnessInfo, noStrictnessInfo,
StrictnessMark(..), isMarkedUnboxed, isMarkedStrict )
import DataCon ( DataCon,
dataConFieldLabels, dataConRepArity, dataConTyCon,
......@@ -75,7 +75,8 @@ import Id ( idType, mkGlobalId, mkVanillaGlobal, mkSysLocal,
import IdInfo ( IdInfo, noCafNoTyGenIdInfo,
exactArity, setUnfoldingInfo, setCprInfo,
setArityInfo, setSpecInfo, setCgInfo,
mkStrictnessInfo, setStrictnessInfo,
setStrictnessInfo,
mkNewStrictnessInfo, setNewStrictnessInfo,
GlobalIdDetails(..), CafInfo(..), CprInfo(..),
CgInfo(..), setCgArity
)
......@@ -143,11 +144,11 @@ mkDataConId work_name data_con
info = noCafNoTyGenIdInfo
`setCgArity` arity
`setArityInfo` exactArity arity
`setStrictnessInfo` strict_info
`setCprInfo` cpr_info
`setStrictnessInfo` strict_info
`setNewStrictnessInfo` mkNewStrictnessInfo arity strict_info cpr_info
arity = dataConRepArity data_con
strict_info = mkStrictnessInfo (dataConRepStrictness data_con, False)
tycon = dataConTyCon data_con
......@@ -225,6 +226,7 @@ mkDataConWrapId data_con
`setArityInfo` exactArity arity
-- It's important to specify the arity, so that partial
-- applications are treated as values
`setNewStrictnessInfo` mkNewStrictnessInfo arity noStrictnessInfo cpr_info
wrap_ty = mkForAllTys all_tyvars $
mkFunTys all_arg_tys
......@@ -604,6 +606,7 @@ mkPrimOpId prim_op
`setCgArity` arity
`setArityInfo` exactArity arity
`setStrictnessInfo` strict_info
`setNewStrictnessInfo` mkNewStrictnessInfo arity strict_info NoCPRInfo
rules = maybe emptyCoreRules (addRule emptyCoreRules id)
(primOpRule prim_op)
......@@ -635,6 +638,7 @@ mkFCallId uniq fcall ty
`setCgArity` arity
`setArityInfo` exactArity arity
`setStrictnessInfo` strict_info
`setNewStrictnessInfo` mkNewStrictnessInfo arity strict_info NoCPRInfo
(_, tau) = tcSplitForAllTys ty
(arg_tys, _) = tcSplitFunTys tau
......@@ -831,8 +835,11 @@ pcMiscPrelId key mod str ty info
pc_bottoming_Id key mod name ty
= pcMiscPrelId key mod name ty bottoming_info
where
strict_info = mkStrictnessInfo ([wwStrict], True)
bottoming_info = noCafNoTyGenIdInfo
`setStrictnessInfo` mkStrictnessInfo ([wwStrict], True)
`setStrictnessInfo` strict_info
`setNewStrictnessInfo` mkNewStrictnessInfo 1 strict_info NoCPRInfo
-- these "bottom" out, no matter what their arguments
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[Demand]{@Demand@: the amount of demand on a value}
\begin{code}
module NewDemand(
Demand(..), Keepity(..), topDmd,
StrictSig(..), topSig, botSig, mkStrictSig,
DmdType(..), topDmdType, mkDmdFun,
Result(..)
) where
#include "HsVersions.h"
import BasicTypes ( Arity )
import qualified Demand
import Outputable
\end{code}
%************************************************************************
%* *
\subsection{Strictness signatures
%* *
%************************************************************************
\begin{code}
data StrictSig = StrictSig Arity DmdType
deriving( Eq )
-- Equality needed when comparing strictness
-- signatures for fixpoint finding
topSig = StrictSig 0 topDmdType
botSig = StrictSig 0 botDmdType
mkStrictSig :: Arity -> DmdType -> StrictSig
mkStrictSig arity ty
= WARN( arity /= dmdTypeDepth ty, ppr arity $$ ppr ty )
StrictSig arity ty
instance Outputable StrictSig where
ppr (StrictSig arity ty) = ppr ty
\end{code}
%************************************************************************
%* *
\subsection{Demand types}
%* *
%************************************************************************
\begin{code}
data DmdType = DmdRes Result | DmdFun Demand DmdType
deriving( Eq )
-- Equality needed for fixpoints in DmdAnal
data Result = TopRes -- Nothing known
| RetCPR -- Returns a constructed product
| BotRes -- Diverges or errors
deriving( Eq )
-- Equality needed for fixpoints in DmdAnal
instance Outputable DmdType where
ppr (DmdRes TopRes) = char 'T'
ppr (DmdRes RetCPR) = char 'M'
ppr (DmdRes BotRes) = char 'X'
ppr (DmdFun d r) = ppr d <> ppr r
topDmdType = DmdRes TopRes
botDmdType = DmdRes BotRes
mkDmdFun :: [Demand] -> Result -> DmdType
mkDmdFun ds res = foldr DmdFun (DmdRes res) ds
dmdTypeDepth :: DmdType -> Arity
dmdTypeDepth (DmdFun _ ty) = 1 + dmdTypeDepth ty
dmdTypeDepth (DmdRes _) = 0
\end{code}
%************************************************************************
%* *
\subsection{Demands}
%* *
%************************************************************************
\begin{code}
data Demand
= Lazy -- L; used for unlifted types too, so that
-- A `lub` L = L
| Abs -- A
| Call Demand -- C(d)
| Eval -- V
| Seq Keepity -- S/U(ds)
[Demand]
| Err -- X
| Bot -- B
deriving( Eq )
-- Equality needed for fixpoints in DmdAnal
data Keepity = Keep | Drop
deriving( Eq )
topDmd :: Demand -- The most uninformative demand
topDmd = Lazy
instance Outputable Demand where
ppr Lazy = char 'L'
ppr Abs = char 'A'
ppr Eval = char 'V'
ppr Err = char 'X'
ppr Bot = char 'B'
ppr (Call d) = char 'C' <> parens (ppr d)
ppr (Seq k ds) = ppr k <> parens (hcat (map ppr ds))
instance Outputable Keepity where
ppr Keep = char 'S'
ppr Drop = char 'U'
\end{code}
......@@ -30,7 +30,8 @@ import IdInfo ( IdInfo, megaSeqIdInfo,
strictnessInfo, ppStrictnessInfo, cgInfo,
cprInfo, ppCprInfo,
workerInfo, ppWorkerInfo,
tyGenInfo, ppTyGenInfo
tyGenInfo, ppTyGenInfo,
newDemandInfo, newStrictnessInfo
)
import DataCon ( dataConTyCon )
import TyCon ( tupleTyConBoxity, isTupleTyCon )
......@@ -328,7 +329,8 @@ pprIdBndr id = ppr id <+>
(megaSeqIdInfo (idInfo id) `seq`
-- Useful for poking on black holes
ifPprDebug (ppr (idInlinePragma id) <+> ppr (idOccInfo id) <+>
ppr (idDemandInfo id)) <+> ppr (idLBVarInfo id))
ppr (idDemandInfo id)) <+> ppr (newDemandInfo (idInfo id)) <+>
ppr (idLBVarInfo id))
\end{code}
......@@ -345,6 +347,7 @@ ppIdInfo b info
ppTyGenInfo g,
ppWorkerInfo (workerInfo info),
ppStrictnessInfo s,
ppr (newStrictnessInfo info),
-- pprCgInfo c,
ppCprInfo m,
pprCoreRules b p
......
-----------------------------------------------------------------------------
-- $Id: DriverState.hs,v 1.48 2001/07/09 17:44:08 sof Exp $
-- $Id: DriverState.hs,v 1.49 2001/07/17 15:28:30 simonpj Exp $
--
-- Settings for the driver
--
......@@ -248,8 +248,8 @@ buildCoreToDo = do
-- This gets foldr inlined before strictness analysis
]),
if strictness then CoreDoStrictness else CoreDoNothing,
if cpr then CoreDoCPResult else CoreDoNothing,
if strictness then CoreDoStrictness else CoreDoNothing,
CoreDoWorkerWrapper,
CoreDoGlomBinds,
......
......@@ -35,7 +35,7 @@ import Type ( splitFunTy_maybe, splitForAllTys )
import Maybes ( maybeToBool, orElse )
import Digraph ( stronglyConnCompR, SCC(..) )
import PrelNames ( buildIdKey, foldrIdKey, runSTRepIdKey, augmentIdKey )
import Unique ( u2i )
import Unique ( Unique )
import UniqFM ( keysUFM )
import Util ( zipWithEqual, mapAndUnzip )
import FastTypes
......@@ -230,7 +230,7 @@ Bindings
\begin{code}
type IdWithOccInfo = Id -- An Id with fresh PragmaInfo attached
type Node details = (details, Int, [Int]) -- The Ints are gotten from the Unique,
type Node details = (details, Unique, [Unique]) -- The Ints are gotten from the Unique,
-- which is gotten from the Id.
type Details1 = (Id, UsageDetails, CoreExpr)
type Details2 = (IdWithOccInfo, CoreExpr)
......@@ -310,7 +310,7 @@ occAnalBind env (Rec pairs) body_usage
---- stuff for dependency analysis of binds -------------------------------
edges :: [Node Details1]
edges = _scc_ "occAnalBind.assoc"
[ (details, iBox (u2i (idUnique id)), edges_from rhs_usage)
[ (details, idUnique id, edges_from rhs_usage)
| details@(id, rhs_usage, rhs) <- analysed_pairs
]
......@@ -323,7 +323,7 @@ occAnalBind env (Rec pairs) body_usage
-- maybeToBool (lookupVarEnv rhs_usage bndr)]
-- which has n**2 cost, and this meant that edges_from alone
-- consumed 10% of total runtime!
edges_from :: UsageDetails -> [Int]
edges_from :: UsageDetails -> [Unique]
edges_from rhs_usage = _scc_ "occAnalBind.edges_from"
keysUFM rhs_usage
......
......@@ -40,6 +40,7 @@ import Specialise ( specProgram)
import SpecConstr ( specConstrProgram)
import UsageSPInf ( doUsageSPInf )
import StrictAnal ( saBinds )
import DmdAnal ( dmdAnalPgm )
import WorkWrap ( wwTopBinds )
import CprAnalyse ( cprAnalyse )
......@@ -154,7 +155,8 @@ doCorePass dfs rb us binds (CoreDoFloatOutwards f)
doCorePass dfs rb us binds CoreDoStaticArgs
= _scc_ "StaticArgs" noStats dfs (doStaticArgs us binds)
doCorePass dfs rb us binds CoreDoStrictness
= _scc_ "Stranal" noStats dfs (saBinds dfs binds)
= _scc_ "Stranal" noStats dfs (do { binds1 <- saBinds dfs binds ;
dmdAnalPgm dfs binds1 })
doCorePass dfs rb us binds CoreDoWorkerWrapper
= _scc_ "WorkWrap" noStats dfs (wwTopBinds dfs us binds)
doCorePass dfs rb us binds CoreDoSpecialising
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
%
-----------------
A demand analysis
-----------------
\begin{code}
module DmdAnal ( dmdAnalPgm ) where
#include "HsVersions.h"
import CmdLineOpts ( DynFlags, DynFlag(..) )
import NewDemand -- All of it
import CoreSyn
import DataCon ( dataConTyCon )
import TyCon ( isProductTyCon, isRecursiveTyCon )
import Id ( Id, idInfo, idArity, idStrictness, idCprInfo, idDemandInfo,
modifyIdInfo, isDataConId, isImplicitId )
import IdInfo ( newStrictnessInfo, setNewStrictnessInfo, mkNewStrictnessInfo,
newDemandInfo, setNewDemandInfo, newDemand
)
import Var ( Var )
import VarEnv
import UniqFM ( plusUFM_C, addToUFM_Directly, keysUFM, minusUFM )
import CoreLint ( showPass, endPass )
import ErrUtils ( dumpIfSet_dyn )
import Util ( mapAccumL, mapAccumR, zipWithEqual )
import BasicTypes ( Arity )
import Maybes ( orElse )
import Outputable
import FastTypes
\end{code}
ToDo: set a noinline pragma on bottoming Ids
%************************************************************************
%* *
\subsection{Top level stuff}
%* *
%************************************************************************
\begin{code}
dmdAnalPgm :: DynFlags -> [CoreBind] -> IO [CoreBind]
#ifndef DEBUG
dmdAnalPgm dflags binds = return binds
#else
dmdAnalPgm dflags binds
= do {
showPass dflags "Demand analysis" ;
let { binds_plus_dmds = do_prog binds ;
dmd_changes = get_changes binds_plus_dmds } ;
endPass dflags "Demand analysis"
Opt_D_dump_stranal binds_plus_dmds ;
printDump (text "Changes in demands" $$ dmd_changes) ;
return binds_plus_dmds
}
where
do_prog :: [CoreBind] -> [CoreBind]
do_prog binds = snd $ mapAccumL dmdAnalTopBind emptySigEnv binds
dmdAnalTopBind :: SigEnv
-> CoreBind
-> (SigEnv, CoreBind)
dmdAnalTopBind sigs (NonRec id rhs)
| isImplicitId id -- Don't touch the info on constructors, selectors etc
= (sigs, NonRec id rhs) -- It's pre-computed in MkId.lhs
| otherwise
= let
(sig, rhs_env, (id', rhs')) = downRhs sigs (id, rhs)
sigs' = extendSigEnv sigs id sig
in
(sigs', NonRec id' rhs')
dmdAnalTopBind sigs (Rec pairs)
= let
(sigs', _, pairs') = dmdFix sigs pairs
in
(sigs', Rec pairs')
\end{code}
%************************************************************************
%* *
\subsection{The analyser itself}
%* *
%************************************************************************
\begin{code}
dmdAnal :: SigEnv -> Demand -> CoreExpr -> (DmdType, DmdEnv, CoreExpr)
dmdAnal sigs Abs e = (DmdRes TopRes, emptyDmdEnv, e)
dmdAnal sigs Lazy e = let
(res_ty, dmd_env, e') = dmdAnal sigs Eval e
in
(res_ty, lazify dmd_env, e')
-- It's important not to analyse e with a lazy demand because
-- a) When we encounter case s of (a,b) ->
-- we demand s with U(d1d2)... but if the overall demand is lazy
-- that is wrong, and we'd need to reduce the demand on s (inconvenient)
-- b) More important, consider
-- f (let x = R in x+x), where f is lazy
-- We still want to mark x as demanded, because it will be when we
-- enter the let. If we analyse f's arg with a Lazy demand, we'll
-- just mark x as Lazy
dmdAnal sigs dmd (Var var)
= (res_ty,
blackHoleEnv res_ty (unitDmdEnv var dmd),
Var var)
where
res_ty = dmdTransform sigs var dmd
dmdAnal sigs dmd (Lit lit)
= (topDmdType, emptyDmdEnv, Lit lit)
dmdAnal sigs dmd (Note n e)
= (dmd_ty, dmd_env, Note n e')
where
(dmd_ty, dmd_env, e') = dmdAnal sigs dmd e
dmdAnal sigs dmd (App fun (Type ty))
= (fun_ty, fun_env, App fun' (Type ty))
where
(fun_ty, fun_env, fun') = dmdAnal sigs dmd fun
dmdAnal sigs dmd (App fun arg) -- Non-type arguments
= let -- [Type arg handled above]
(fun_ty, fun_env, fun') = dmdAnal sigs (Call dmd) fun
(arg_ty, arg_env, arg') = dmdAnal sigs arg_dmd arg
(arg_dmd, res_ty) = splitDmdTy fun_ty
in
(res_ty,
blackHoleEnv res_ty (fun_env `bothEnv` arg_env),
App fun' arg')
dmdAnal sigs dmd (Lam var body)
| isTyVar var
= let
(body_ty, body_env, body') = dmdAnal sigs dmd body
in
(body_ty, body_env, Lam var body')
| otherwise
= let
body_dmd = case dmd of
Call dmd -> dmd
other -> Lazy -- Conservative
(body_ty, body_env, body') = dmdAnal sigs body_dmd body
(lam_env, var') = annotateBndr body_env var
in
(DmdFun (idNewDemandInfo var') body_ty,
body_env `delDmdEnv` var,
Lam var' body')
dmdAnal sigs dmd (Case scrut case_bndr [alt@(DataAlt dc,bndrs,rhs)])
| let tycon = dataConTyCon dc,
isProductTyCon tycon,
not (isRecursiveTyCon tycon)
= let
bndr_ids = filter isId bndrs
(alt_ty, alt_env, alt') = dmdAnalAlt sigs dmd alt
(_, scrut_env, scrut') = dmdAnal sigs scrut_dmd scrut
(alt_env2, case_bndr') = annotateBndr alt_env case_bndr
(_, bndrs', _) = alt'
scrut_dmd = Seq Drop [idNewDemandInfo b | b <- bndrs', isId b]
in
(alt_ty,
alt_env2 `bothEnv` scrut_env,
Case scrut' case_bndr' [alt'])
dmdAnal sigs dmd (Case scrut case_bndr alts)
= let
(alt_tys, alt_envs, alts') = unzip3 (map (dmdAnalAlt sigs dmd) alts)
(scrut_ty, scrut_env, scrut') = dmdAnal sigs Eval scrut
(alt_env2, case_bndr') = annotateBndr (foldr1 lubEnv alt_envs) case_bndr
in
(foldr1 lubDmdTy alt_tys,
alt_env2 `bothEnv` scrut_env,
Case scrut' case_bndr' alts')
dmdAnal sigs dmd (Let (NonRec id rhs) body)
| idArity id == 0 -- A thunk; analyse the body first, then the thunk
= let
(body_ty, body_env, body') = dmdAnal sigs dmd body
(rhs_ty, rhs_env, rhs') = dmdAnal sigs (lookupDmd body_env id) rhs
(body_env1, id1) = annotateBndr body_env id
in
(body_ty, body_env1 `bothEnv` rhs_env, Let (NonRec id1 rhs') body')
| otherwise -- A function; analyse the function first, then the body
= let
(sig, rhs_env, (id1, rhs')) = downRhs sigs (id, rhs)
sigs' = extendSigEnv sigs id sig
(body_ty, body_env, body') = dmdAnal sigs' dmd body
rhs_env1 = weaken body_env id rhs_env
(body_env1, id2) = annotateBndr body_env id1
in
(body_ty, body_env1 `bothEnv` rhs_env1, Let (NonRec id2 rhs') body')
dmdAnal sigs dmd (Let (Rec pairs) body)
= let
bndrs = map fst pairs
(sigs', rhs_envs, pairs') = dmdFix sigs pairs
(body_ty, body_env, body') = dmdAnal sigs' dmd body
weakened_rhs_envs = zipWithEqual "dmdAnal:Let" (weaken body_env) bndrs rhs_envs
-- I saw occasions where it was really worth using the
-- call demands on the Ids to propagate demand info
-- on the free variables. An example is 'roll' in imaginary/wheel-sieve2
-- Something like this:
-- roll x = letrec go y = if ... then roll (x-1) else x+1
-- in go ms
-- We want to see that this is strict in x.
rhs_env1 = foldr1 bothEnv weakened_rhs_envs
result_env = delDmdEnvList (body_env `bothEnv` rhs_env1) bndrs
-- Don't bother to add demand info to recursive
-- binders as annotateBndr does;
-- being recursive, we can't treat them strictly.
-- But we do need to remove the binders from the result demand env
in
(body_ty, result_env, Let (Rec pairs') body')
\end{code}
\begin{code}
dmdAnalAlt sigs dmd (con,bndrs,rhs)
= let
(rhs_ty, rhs_env, rhs') = dmdAnal sigs dmd rhs
(alt_env, bndrs') = annotateBndrs rhs_env bndrs
in
(rhs_ty, alt_env, (con, bndrs', rhs'))
\end{code}
%************************************************************************
%* *
\subsection{Bindings}
%* *
%************************************************************************
\begin{code}
dmdFix :: SigEnv -- Does not include bindings for this binding
-> [(Id,CoreExpr)]
-> (SigEnv,
[DmdEnv], -- Demands from RHSs
[(Id,CoreExpr)]) -- Binders annotated with stricness info
dmdFix sigs pairs
= loop (map initial_sig pairs) pairs
where