[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.

ghc/compiler/basicTypes/Id.lhs

@@ -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

ghc/compiler/basicTypes/IdInfo.lhs

@@ -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}

ghc/compiler/basicTypes/MkId.lhs

@@ -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)
 

ghc/compiler/coreSyn/PprCore.lhs

@@ -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}
 

ghc/compiler/cprAnalysis/CprAnalyse.lhs

@@ -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" ;

ghc/compiler/prelude/PrimOp.lhs

@@ -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

ghc/compiler/prelude/primops.txt.pp

 -----------------------------------------------------------------------
--- $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 }