Commit 973539a8 authored by simonmar's avatar simonmar

[project @ 2001-12-10 14:07:30 by simonmar]

Make the inclusion of the old strictness analyser, CPR analyser, and
the relevant IdInfo components, conditional on DEBUG.  This makes
IdInfo smaller by three fields in a non-DEBUG compiler, and reduces
the risk that the unused fields could harbour space leaks.

Eventually these passes will go away altogether.
parent a0cb0c4b
......@@ -44,29 +44,38 @@ module Id (
-- IdInfo stuff
setIdUnfolding,
setIdArity,
setIdDemandInfo, setIdNewDemandInfo,
setIdStrictness, setIdNewStrictness, zapIdNewStrictness,
setIdNewDemandInfo,
setIdNewStrictness, zapIdNewStrictness,
setIdTyGenInfo,
setIdWorkerInfo,
setIdSpecialisation,
setIdCgInfo,
setIdCprInfo,
setIdOccInfo,
#ifdef DEBUG
idDemandInfo,
idStrictness,
idCprInfo,
setIdStrictness,
setIdDemandInfo,
setIdCprInfo,
#endif
idArity,
idDemandInfo, idNewDemandInfo,
idStrictness, idNewStrictness, idNewStrictness_maybe,
idNewDemandInfo,
idNewStrictness, idNewStrictness_maybe,
idTyGenInfo,
idWorkerInfo,
idUnfolding,
idSpecialisation,
idCgInfo,
idCafInfo,
idCprInfo,
idLBVarInfo,
idOccInfo,
#ifdef DEBUG
newStrictnessFromOld -- Temporary
#endif
) where
......@@ -104,20 +113,21 @@ import SrcLoc ( SrcLoc )
import Outputable
import Unique ( Unique, mkBuiltinUnique )
-- infixl so you can say (id `set` a `set` b)
infixl 1 `setIdUnfolding`,
`setIdArity`,
`setIdDemandInfo`,
`setIdStrictness`,
`setIdNewDemandInfo`,
`setIdNewStrictness`,
`setIdTyGenInfo`,
`setIdWorkerInfo`,
`setIdSpecialisation`,
`setInlinePragma`,
`idCafInfo`,
`idCprInfo`
-- infixl so you can say (id `set` a `set` b)
`idCafInfo`
#ifdef DEBUG
,`idCprInfo`
,`setIdStrictness`
,`setIdDemandInfo`
#endif
\end{code}
......@@ -311,13 +321,15 @@ idArity id = arityInfo (idInfo id)
setIdArity :: Id -> Arity -> Id
setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
#ifdef DEBUG
---------------------------------
-- STRICTNESS
-- (OLD) STRICTNESS
idStrictness :: Id -> StrictnessInfo
idStrictness id = strictnessInfo (idInfo id)
setIdStrictness :: Id -> StrictnessInfo -> Id
setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
#endif
-- isBottomingId returns true if an application to n args would diverge
isBottomingId :: Id -> Bool
......@@ -359,13 +371,15 @@ idUnfolding id = unfoldingInfo (idInfo id)
setIdUnfolding :: Id -> Unfolding -> Id
setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
#ifdef DEBUG
---------------------------------
-- DEMAND
-- (OLD) DEMAND
idDemandInfo :: Id -> Demand.Demand
idDemandInfo id = demandInfo (idInfo id)
setIdDemandInfo :: Id -> Demand.Demand -> Id
setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
#endif
idNewDemandInfo :: Id -> NewDemand.Demand
idNewDemandInfo id = newDemandInfo (idInfo id)
......@@ -405,14 +419,15 @@ idCafInfo id = case cgInfo (idInfo id) of
#else
idCafInfo id = cgCafInfo (idCgInfo id)
#endif
---------------------------------
-- CPR INFO
#ifdef DEBUG
idCprInfo :: Id -> CprInfo
idCprInfo id = cprInfo (idInfo id)
setIdCprInfo :: Id -> CprInfo -> Id
setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
#endif
---------------------------------
-- Occcurrence INFO
......
......@@ -25,14 +25,13 @@ module IdInfo (
-- New demand and strictness info
newStrictnessInfo, setNewStrictnessInfo,
newDemandInfo, setNewDemandInfo, newDemand, oldDemand,
newDemandInfo, setNewDemandInfo,
-- Strictness; imported from Demand
StrictnessInfo(..),
mkStrictnessInfo, noStrictnessInfo,
ppStrictnessInfo,isBottomingStrictness,
strictnessInfo, setStrictnessInfo, setAllStrictnessInfo,
oldStrictnessFromNew, newStrictnessFromOld, cprInfoFromNewStrictness,
setAllStrictnessInfo,
-- Usage generalisation
TyGenInfo(..),
......@@ -46,8 +45,17 @@ module IdInfo (
-- Unfolding
unfoldingInfo, setUnfoldingInfo,
-- DemandInfo
#ifdef DEBUG
-- Old DemandInfo and StrictnessInfo
demandInfo, setDemandInfo,
strictnessInfo, setStrictnessInfo,
cprInfoFromNewStrictness,
oldStrictnessFromNew, newStrictnessFromOld,
oldDemand, newDemand,
-- Constructed Product Result Info
CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo,
#endif
-- Inline prags
InlinePragInfo,
......@@ -69,9 +77,6 @@ module IdInfo (
-- CAF info
CafInfo(..), ppCafInfo, setCafInfo, mayHaveCafRefs,
-- Constructed Product Result Info
CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo,
-- Lambda-bound variable info
LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo, hasNoLBVarInfo
) where
......@@ -95,25 +100,19 @@ import DataCon ( DataCon )
import ForeignCall ( ForeignCall )
import FieldLabel ( FieldLabel )
import Type ( usOnce, usMany )
import Demand hiding( Demand )
import Demand hiding( Demand, seqDemand )
import qualified Demand
import NewDemand ( Demand(..), DmdResult(..), Demands(..),
lazyDmd, topDmd, dmdTypeDepth, isStrictDmd, isBotRes,
splitStrictSig, strictSigResInfo,
StrictSig, mkStrictSig, mkTopDmdType, evalDmd, lazyDmd
)
import NewDemand
import Outputable
import Util ( seqList, listLengthCmp )
import List ( replicate )
infixl 1 `setDemandInfo`,
`setTyGenInfo`,
`setStrictnessInfo`,
-- infixl so you can say (id `set` a `set` b)
infixl 1 `setTyGenInfo`,
`setSpecInfo`,
`setArityInfo`,
`setInlinePragInfo`,
`setUnfoldingInfo`,
`setCprInfo`,
`setWorkerInfo`,
`setLBVarInfo`,
`setOccInfo`,
......@@ -122,7 +121,11 @@ infixl 1 `setDemandInfo`,
`setNewStrictnessInfo`,
`setAllStrictnessInfo`,
`setNewDemandInfo`
-- infixl so you can say (id `set` a `set` b)
#ifdef DEBUG
`setCprInfo`,
`setDemandInfo`,
`setStrictnessInfo`,
#endif
\end{code}
%************************************************************************
......@@ -138,13 +141,23 @@ setAllStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo
-- Set old and new strictness info
setAllStrictnessInfo info Nothing
= info { newStrictnessInfo = Nothing,
#ifdef DEBUG
strictnessInfo = NoStrictnessInfo,
cprInfo = NoCPRInfo }
cprInfo = NoCPRInfo,
#endif
}
setAllStrictnessInfo info (Just sig)
= info { newStrictnessInfo = Just sig,
#ifdef DEBUG
strictnessInfo = oldStrictnessFromNew sig,
cprInfo = cprInfoFromNewStrictness sig }
cprInfo = cprInfoFromNewStrictness sig,
#endif
}
seqNewStrictnessInfo Nothing = ()
seqNewStrictnessInfo (Just ty) = seqStrictSig ty
#ifdef DEBUG
oldStrictnessFromNew :: StrictSig -> Demand.StrictnessInfo
oldStrictnessFromNew sig = mkStrictnessInfo (map oldDemand dmds, isBotRes res_info)
where
......@@ -196,6 +209,8 @@ oldDemand (Defer d) = WwLazy False
oldDemand (Eval (Prod ds)) = WwUnpack True (map oldDemand ds)
oldDemand (Eval (Poly _)) = WwStrict
oldDemand (Call _) = WwStrict
#endif /* DEBUG */
\end{code}
......@@ -261,15 +276,17 @@ case. KSW 1999-04).
\begin{code}
data IdInfo
= IdInfo {
arityInfo :: ArityInfo, -- Its arity
demandInfo :: Demand.Demand, -- Whether or not it is definitely demanded
arityInfo :: !ArityInfo, -- Its arity
specInfo :: CoreRules, -- Specialisations of this function which exist
tyGenInfo :: TyGenInfo, -- Restrictions on usage-generalisation of this Id
#ifdef DEBUG
cprInfo :: CprInfo, -- Function always constructs a product result
demandInfo :: Demand.Demand, -- Whether or not it is definitely demanded
strictnessInfo :: StrictnessInfo, -- Strictness properties
#endif
workerInfo :: WorkerInfo, -- Pointer to Worker Function
unfoldingInfo :: Unfolding, -- Its unfolding
cgInfo :: CgInfo, -- Code generator info (arity, CAF info)
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
......@@ -286,21 +303,26 @@ seqIdInfo (IdInfo {}) = ()
megaSeqIdInfo :: IdInfo -> ()
megaSeqIdInfo info
= seqArity (arityInfo info) `seq`
seqDemand (demandInfo info) `seq`
seqRules (specInfo info) `seq`
= seqRules (specInfo info) `seq`
seqTyGenInfo (tyGenInfo info) `seq`
seqStrictnessInfo (strictnessInfo info) `seq`
seqWorker (workerInfo info) `seq`
-- seqUnfolding (unfoldingInfo info) `seq`
-- Omitting this improves runtimes a little, presumably because
-- some unfoldings are not calculated at all
-- seqUnfolding (unfoldingInfo info) `seq`
seqDemand (newDemandInfo info) `seq`
seqNewStrictnessInfo (newStrictnessInfo info) `seq`
#ifdef DEBUG
Demand.seqDemand (demandInfo info) `seq`
seqStrictnessInfo (strictnessInfo info) `seq`
seqCpr (cprInfo info) `seq`
#endif
-- CgInfo is involved in a loop, so we have to be careful not to seq it
-- too early.
-- seqCg (cgInfo info) `seq`
seqCpr (cprInfo info) `seq`
seqLBVar (lbvarInfo info) `seq`
seqOccInfo (occInfo info)
\end{code}
......@@ -313,7 +335,9 @@ setSpecInfo info sp = sp `seq` info { specInfo = sp }
setTyGenInfo info tg = tg `seq` info { tyGenInfo = tg }
setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }
setOccInfo info oc = oc `seq` info { occInfo = oc }
#ifdef DEBUG
setStrictnessInfo info st = st `seq` info { strictnessInfo = st }
#endif
-- Try to avoid spack leaks by seq'ing
setUnfoldingInfo info uf
......@@ -334,14 +358,18 @@ setUnfoldingInfo info uf
-- actually increases residency significantly.
= info { unfoldingInfo = uf }
#ifdef DEBUG
setDemandInfo info dd = info { demandInfo = dd }
setCprInfo info cp = info { cprInfo = cp }
#endif
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 = dd }
setLBVarInfo info lb = {-lb `seq`-} info { lbvarInfo = lb }
setNewDemandInfo info dd = dd `seq` info { newDemandInfo = dd }
setNewStrictnessInfo info dd = dd `seq` info { newStrictnessInfo = dd }
\end{code}
......@@ -351,13 +379,15 @@ vanillaIdInfo
= IdInfo {
cgInfo = noCgInfo,
arityInfo = unknownArity,
#ifdef DEBUG
cprInfo = NoCPRInfo,
demandInfo = wwLazy,
strictnessInfo = NoStrictnessInfo,
#endif
specInfo = emptyCoreRules,
tyGenInfo = noTyGenInfo,
workerInfo = NoWorker,
strictnessInfo = NoStrictnessInfo,
unfoldingInfo = noUnfolding,
cprInfo = NoCPRInfo,
lbvarInfo = NoLBVarInfo,
inlinePragInfo = AlwaysActive,
occInfo = NoOccInfo,
......@@ -393,9 +423,6 @@ type ArityInfo = Arity
-- The arity might increase later in the compilation process, if
-- an extra lambda floats up to the binding site.
seqArity :: ArityInfo -> ()
seqArity a = a `seq` ()
unknownArity = 0 :: Arity
ppArityInfo 0 = empty
......@@ -502,7 +529,7 @@ instance Show TyGenInfo where
If this Id has a worker then we store a reference to it. Worker
functions are generated by the worker/wrapper pass. This uses
information from the strictness and CPR analyses.
information from strictness analysis.
There might not be a worker, even for a strict function, because:
(a) the function might be small enough to inline, so no need
......@@ -534,7 +561,7 @@ data WorkerInfo = NoWorker
-- w/w split. See comments in MkIface.ifaceId, with the 'Worker' code.
seqWorker :: WorkerInfo -> ()
seqWorker (HasWorker id _) = id `seq` ()
seqWorker (HasWorker id a) = id `seq` a `seq` ()
seqWorker NoWorker = ()
ppWorkerInfo NoWorker = empty
......@@ -643,6 +670,7 @@ function has the CPR property and which components of the result are
also CPRs.
\begin{code}
#ifdef DEBUG
data CprInfo
= NoCPRInfo
| ReturnsCPR -- Yes, this function returns a constructed product
......@@ -653,9 +681,7 @@ data CprInfo
-- We used to keep nested info about sub-components, but
-- we never used it so I threw it away
\end{code}
\begin{code}
seqCpr :: CprInfo -> ()
seqCpr ReturnsCPR = ()
seqCpr NoCPRInfo = ()
......@@ -670,6 +696,7 @@ instance Outputable CprInfo where
instance Show CprInfo where
showsPrec p c = showsPrecSDoc p (ppr c)
#endif
\end{code}
......@@ -823,8 +850,11 @@ shortableIdInfo info = isEmptyCoreRules (specInfo info)
copyIdInfo :: IdInfo -- f_local
-> IdInfo -- f (the exported one)
-> IdInfo -- New info for f
copyIdInfo f_local f = f { strictnessInfo = strictnessInfo f_local,
workerInfo = workerInfo f_local,
copyIdInfo f_local f = f { newStrictnessInfo = newStrictnessInfo f_local,
#ifdef DEBUG
strictnessInfo = strictnessInfo f_local,
cprInfo = cprInfo f_local
#endif
workerInfo = workerInfo f_local,
}
\end{code}
......@@ -72,8 +72,8 @@ import Id ( idType, mkGlobalId, mkVanillaGlobal, mkSysLocal,
import IdInfo ( IdInfo, noCafNoTyGenIdInfo,
setUnfoldingInfo,
setArityInfo, setSpecInfo, setCafInfo,
newStrictnessFromOld, setAllStrictnessInfo,
GlobalIdDetails(..), CafInfo(..), CprInfo(..)
setAllStrictnessInfo,
GlobalIdDetails(..), CafInfo(..)
)
import NewDemand ( mkStrictSig, strictSigResInfo, DmdResult(..),
mkTopDmdType, topDmd, evalDmd, lazyDmd,
......@@ -640,7 +640,7 @@ mkPrimOpId :: PrimOp -> Id
mkPrimOpId prim_op
= id
where
(tyvars,arg_tys,res_ty, arity, strict_info) = primOpSig prim_op
(tyvars,arg_tys,res_ty, arity, strict_sig) = primOpSig prim_op
ty = mkForAllTys tyvars (mkFunTys arg_tys res_ty)
name = mkPrimOpIdName prim_op
id = mkGlobalId (PrimOpId prim_op) name ty info
......@@ -648,8 +648,7 @@ mkPrimOpId prim_op
info = noCafNoTyGenIdInfo
`setSpecInfo` rules
`setArityInfo` arity
`setAllStrictnessInfo` Just (newStrictnessFromOld name arity strict_info NoCPRInfo)
-- Until we modify the primop generation code
`setAllStrictnessInfo` Just strict_sig
rules = foldl (addRule id) emptyCoreRules (primOpRules prim_op)
......
......@@ -20,18 +20,24 @@ module PprCore (
import CoreSyn
import CostCentre ( pprCostCentreCore )
import Id ( Id, idType, isDataConId_maybe, idLBVarInfo, idArity,
idInfo, idInlinePragma, idDemandInfo, idOccInfo,
globalIdDetails, isGlobalId, isExportedId, isSpecPragmaId
idInfo, idInlinePragma, idOccInfo,
#ifdef DEBUG
idDemandInfo,
#endif
globalIdDetails, isGlobalId, isExportedId,
isSpecPragmaId, idNewDemandInfo
)
import Var ( isTyVar )
import IdInfo ( IdInfo, megaSeqIdInfo,
arityInfo, ppArityInfo,
specInfo, cprInfo, ppCprInfo,
strictnessInfo, ppStrictnessInfo,
cprInfo, ppCprInfo,
specInfo, ppStrictnessInfo,
workerInfo, ppWorkerInfo,
tyGenInfo, ppTyGenInfo,
newDemandInfo, newStrictnessInfo
newStrictnessInfo,
#ifdef DEBUG
cprInfo, ppCprInfo,
strictnessInfo,
#endif
)
import DataCon ( dataConTyCon )
import TyCon ( tupleTyConBoxity, isTupleTyCon )
......@@ -330,8 +336,11 @@ 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 (newDemandInfo (idInfo id)) <+>
ppr (idLBVarInfo id))
#ifdef DEBUG
ppr (idDemandInfo id) <+>
#endif
ppr (idNewDemandInfo id) <+>
ppr (idLBVarInfo id)))
\end{code}
......@@ -347,8 +356,10 @@ ppIdInfo b info
= hsep [ ppArityInfo a,
ppTyGenInfo g,
ppWorkerInfo (workerInfo info),
#ifdef DEBUG
ppStrictnessInfo s,
ppCprInfo m,
#endif
ppr (newStrictnessInfo info),
pprCoreRules b p
-- Inline pragma, occ, demand, lbvar info
......@@ -358,8 +369,10 @@ ppIdInfo b info
where
a = arityInfo info
g = tyGenInfo info
#ifdef DEBUG
s = strictnessInfo info
m = cprInfo info
#endif
p = specInfo info
\end{code}
......
......@@ -2,6 +2,11 @@
constructed product result}
\begin{code}
#ifndef DEBUG
module CprAnalyse ( ) where
#else
module CprAnalyse ( cprAnalyse ) where
#include "HsVersions.h"
......@@ -131,11 +136,6 @@ ids decorated with their CprInfo pragmas.
\begin{code}
cprAnalyse :: DynFlags -> [CoreBind] -> IO [CoreBind]
#ifndef DEBUG
-- Omit unless DEBUG is on
cprAnalyse dflags binds = return binds
#else
cprAnalyse dflags binds
= do {
showPass dflags "Constructed Product analysis" ;
......
......@@ -24,7 +24,7 @@ import PrimRep -- most of it
import TysPrim
import TysWiredIn
import Demand ( wwLazy, wwPrim, wwStrict, StrictnessInfo(..) )
import NewDemand
import Var ( TyVar )
import Name ( Name, mkWiredInName )
import RdrName ( RdrName, mkRdrOrig )
......@@ -140,7 +140,7 @@ mkGenPrimOp str tvs tys ty = GenPrimOp (mkVarOcc str) tvs tys ty
Not all primops are strict!
\begin{code}
primOpStrictness :: PrimOp -> Arity -> StrictnessInfo
primOpStrictness :: PrimOp -> Arity -> StrictSig
-- See Demand.StrictnessInfo for discussion of what the results
-- The arity should be the arity of the primop; that's why
-- this function isn't exported.
......@@ -415,7 +415,7 @@ primOpOcc op = case (primOpInfo op) of
-- (type variables, argument types, result type)
-- It also gives arity, strictness info
primOpSig :: PrimOp -> ([TyVar], [Type], Type, Arity, StrictnessInfo)
primOpSig :: PrimOp -> ([TyVar], [Type], Type, Arity, StrictSig)
primOpSig op
= (tyvars, arg_tys, res_ty, arity, primOpStrictness op arity)
where
......
-----------------------------------------------------------------------
-- $Id: primops.txt.pp,v 1.11 2001/12/07 11:34:48 sewardj Exp $
-- $Id: primops.txt.pp,v 1.12 2001/12/10 14:07:30 simonmar Exp $
--
-- Primitive Operations
--
......@@ -57,7 +57,7 @@ defaults
commutable = False
needs_wrapper = False
can_fail = False
strictness = { \ arity -> StrictnessInfo (replicate arity wwPrim) False }
strictness = { \ arity -> mkStrictSig (mkTopDmdType (replicate arity lazyDmd) TopRes) }
usage = { nomangle other }
-- Currently, documentation is produced using latex, so contents of
......@@ -686,7 +686,6 @@ primop NewArrayOp "newArray#" GenPrimOp
in the specified state thread,
with each element containing the specified initial value.}
with
strictness = { \ arity -> StrictnessInfo [wwPrim, wwLazy, wwPrim] False }
usage = { mangle NewArrayOp [mkP, mkM, mkP] mkM }
out_of_line = True
......@@ -706,7 +705,6 @@ primop WriteArrayOp "writeArray#" GenPrimOp
{Write to specified index of mutable array.}
with
usage = { mangle WriteArrayOp [mkM, mkP, mkM, mkP] mkR }
strictness = { \ arity -> StrictnessInfo [wwPrim, wwPrim, wwLazy, wwPrim] False }
has_side_effects = True
primop IndexArrayOp "indexArray#" GenPrimOp
......@@ -1164,7 +1162,6 @@ primop TouchOp "touch#" GenPrimOp
o -> State# RealWorld -> State# RealWorld
with
has_side_effects = True
strictness = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False }
primop EqForeignObj "eqForeignObj#" GenPrimOp
ForeignObj# -> ForeignObj# -> Bool
......@@ -1232,7 +1229,6 @@ primop NewMutVarOp "newMutVar#" GenPrimOp
{Create MutVar\# with specified initial value in specified state thread.}
with
usage = { mangle NewMutVarOp [mkM, mkP] mkM }
strictness = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False }
out_of_line = True
primop ReadMutVarOp "readMutVar#" GenPrimOp
......@@ -1245,7 +1241,6 @@ primop WriteMutVarOp "writeMutVar#" GenPrimOp
MutVar# s a -> a -> State# s -> State# s
{Write contents of MutVar\#.}
with
strictness = { \ arity -> StrictnessInfo [wwPrim, wwLazy, wwPrim] False }
usage = { mangle WriteMutVarOp [mkM, mkM, mkP] mkR }
has_side_effects = True
......@@ -1264,7 +1259,6 @@ primop CatchOp "catch#" GenPrimOp
-> State# RealWorld
-> (# State# RealWorld, a #)
with
strictness = { \ arity -> StrictnessInfo [wwLazy, wwLazy, wwPrim] False }
-- Catch is actually strict in its first argument
-- but we don't want to tell the strictness
-- analyser about that!
......@@ -1276,8 +1270,8 @@ primop CatchOp "catch#" GenPrimOp
primop RaiseOp "raise#" GenPrimOp
a -> b
with
strictness = { \ arity -> StrictnessInfo [wwLazy] True }
-- NB: True => result is bottom
strictness = { \ arity -> mkStrictSig (mkTopDmdType [lazyDmd] BotRes) }
-- NB: result is bottom
usage = { mangle RaiseOp [mkM] mkM }
out_of_line = True
......@@ -1285,14 +1279,12 @@ primop BlockAsyncExceptionsOp "blockAsyncExceptions#" GenPrimOp
(State# RealWorld -> (# State# RealWorld, a #))
-> (State# RealWorld -> (# State# RealWorld, a #))
with
strictness = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False }
out_of_line = True
primop UnblockAsyncExceptionsOp "unblockAsyncExceptions#" GenPrimOp
(State# RealWorld -> (# State# RealWorld, a #))
-> (State# RealWorld -> (# State# RealWorld, a #))
with
strictness = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False }
out_of_line = True
------------------------------------------------------------------------
......@@ -1333,7 +1325,6 @@ primop PutMVarOp "putMVar#" GenPrimOp
{If mvar is full, block until it becomes empty.
Then store value arg as its new contents.}
with
strictness = { \ arity -> StrictnessInfo [wwPrim, wwLazy, wwPrim] False }
usage = { mangle PutMVarOp [mkM, mkM, mkP] mkR }
has_side_effects = True
out_of_line = True
......@@ -1343,7 +1334,6 @@ primop TryPutMVarOp "tryPutMVar#" GenPrimOp
{If mvar is full, immediately return with integer 0.
Otherwise, store value arg as mvar's new contents, and return with integer 1.}
with
strictness = { \ arity -> StrictnessInfo [wwPrim, wwLazy, wwPrim] False }
usage = { mangle TryPutMVarOp [mkM, mkM, mkP] mkR }
has_side_effects = True
out_of_line = True
......@@ -1399,7 +1389,6 @@ primop ForkOp "fork#" GenPrimOp
a -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
with
usage = { mangle ForkOp [mkO, mkP] mkR }
strictness = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False }
has_side_effects = True
out_of_line = True
......@@ -1430,7 +1419,6 @@ section "Weak pointers"
primop MkWeakOp "mkWeak#" GenPrimOp
o -> b -> c -> State# RealWorld -> (# State# RealWorld, Weak# b #)
with
strictness = { \ arity -> StrictnessInfo [wwLazy, wwLazy, wwLazy, wwPrim] False }
usage = { mangle MkWeakOp [mkZ, mkM, mkM, mkP] mkM }
has_side_effects = True
out_of_line = True
......@@ -1459,7 +1447,6 @@ section "Stable pointers and names"
primop MakeStablePtrOp "makeStablePtr#" GenPrimOp
a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)
with
strictness = { \ arity -> StrictnessInfo [wwLazy, wwPrim] False }