From 2662dbc5b2c30fc11ccb99e7f9b2dba794d680ba Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Thu, 19 Nov 2009 15:43:47 +0000
Subject: [PATCH] Remove the (very) old strictness analyser

I finally got tired of the #ifdef OLD_STRICTNESS stuff.  I had been
keeping it around in the hope of doing old-to-new comparisions, but
have failed to do so for many years, so I don't think it's going to
happen.  This patch deletes the clutter.
---
 compiler/basicTypes/Demand.lhs      |  431 ++++++++++------
 compiler/basicTypes/Id.lhs          |  105 +---
 compiler/basicTypes/IdInfo.lhs      |  269 ++--------
 compiler/basicTypes/MkId.lhs        |   14 +-
 compiler/basicTypes/NewDemand.lhs   |  342 -------------
 compiler/coreSyn/CoreArity.lhs      |    4 +-
 compiler/coreSyn/CoreLint.lhs       |    8 +-
 compiler/coreSyn/CorePrep.lhs       |    6 +-
 compiler/coreSyn/CoreTidy.lhs       |    4 +-
 compiler/coreSyn/PprCore.lhs        |   13 +-
 compiler/cprAnalysis/CprAnalyse.lhs |  317 ------------
 compiler/ghc.cabal.in               |    5 -
 compiler/iface/BinIface.hs          |    4 +-
 compiler/iface/IfaceSyn.lhs         |    2 +-
 compiler/iface/MkIface.lhs          |    4 +-
 compiler/iface/TcIface.lhs          |    6 +-
 compiler/main/DynFlags.hs           |    4 -
 compiler/main/TidyPgm.lhs           |   10 +-
 compiler/prelude/PrimOp.lhs         |    2 +-
 compiler/simplCore/SetLevels.lhs    |    4 +-
 compiler/simplCore/SimplCore.lhs    |   22 +-
 compiler/simplCore/SimplUtils.lhs   |    4 +-
 compiler/simplCore/Simplify.lhs     |   10 +-
 compiler/specialise/SpecConstr.lhs  |    6 +-
 compiler/stranal/DmdAnal.lhs        |  129 +----
 compiler/stranal/SaAbsInt.lhs       |  932 -----------------------------------
 compiler/stranal/SaLib.lhs          |  137 -----
 compiler/stranal/StrictAnal.lhs     |  464 -----------------
 compiler/stranal/WorkWrap.lhs       |   12 +-
 compiler/stranal/WwLib.lhs          |   14 +-
 30 files changed, 421 insertions(+), 2863 deletions(-)
 delete mode 100644 compiler/basicTypes/NewDemand.lhs
 delete mode 100644 compiler/cprAnalysis/CprAnalyse.lhs
 delete mode 100644 compiler/stranal/SaAbsInt.lhs
 delete mode 100644 compiler/stranal/SaLib.lhs
 delete mode 100644 compiler/stranal/StrictAnal.lhs

diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs
index d85315a..b1e9ccb 100644
--- a/compiler/basicTypes/Demand.lhs
+++ b/compiler/basicTypes/Demand.lhs
@@ -5,215 +5,338 @@
 \section[Demand]{@Demand@: the amount of demand on a value}
 
 \begin{code}
-#ifndef OLD_STRICTNESS
-module Demand () where
-#else
-
 module Demand(
-	Demand(..),
-
-	wwLazy, wwStrict, wwUnpack, wwPrim, wwEnum, 
-	isStrict, isLazy, isPrim,
-
-	pprDemands, seqDemand, seqDemands,
-
-	StrictnessInfo(..),	
-	mkStrictnessInfo,
-	noStrictnessInfo,
-	ppStrictnessInfo, seqStrictnessInfo,
-	isBottomingStrictness, appIsBottom,
-
+	Demand(..), 
+	topDmd, lazyDmd, seqDmd, evalDmd, errDmd, isStrictDmd, 
+	isTop, isAbsent, seqDemand,
+
+	DmdType(..), topDmdType, botDmdType, mkDmdType, mkTopDmdType, 
+		dmdTypeDepth, seqDmdType,
+	DmdEnv, emptyDmdEnv,
+	DmdResult(..), retCPR, isBotRes, returnsCPR, resTypeArgDmd,
+	
+	Demands(..), mapDmds, zipWithDmds, allTop, seqDemands,
+
+	StrictSig(..), mkStrictSig, topSig, botSig, cprSig,
+        isTopSig,
+	splitStrictSig, increaseStrictSigArity,
+	pprIfaceStrictSig, appIsBottom, isBottomingSig, seqStrictSig,
      ) where
 
 #include "HsVersions.h"
 
-import Outputable
+import StaticFlags
+import BasicTypes
+import VarEnv
+import UniqFM
 import Util
+import Outputable
 \end{code}
 
 
 %************************************************************************
 %*									*
-\subsection{The @Demand@ data type}
+\subsection{Demands}
 %*									*
 %************************************************************************
 
 \begin{code}
 data Demand
-  = WwLazy		-- Argument is lazy as far as we know
-	MaybeAbsent	-- (does not imply worker's existence [etc]).
-			-- If MaybeAbsent == True, then it is
-			--  *definitely* lazy.  (NB: Absence implies
-			-- a worker...)
-
-  | WwStrict		-- Argument is strict but that's all we know
-			-- (does not imply worker's existence or any
-			-- calling-convention magic)
-
-  | WwUnpack		-- Argument is strict & a single-constructor type
-	Bool		-- True <=> wrapper unpacks it; False <=> doesn't
-	[Demand]	-- Its constituent parts (whose StrictInfos
-			-- are in the list) should be passed
-			-- as arguments to the worker.
-
-  | WwPrim		-- Argument is of primitive type, therefore
-			-- strict; doesn't imply existence of a worker;
-			-- argument should be passed as is to worker.
-
-  | WwEnum		-- Argument is strict & an enumeration type;
-			-- an Int# representing the tag (start counting
-			-- at zero) should be passed to the worker.
-  deriving( Eq )
+  = Top			-- T; used for unlifted types too, so that
+			--	A `lub` T = T
+  | Abs			-- A
 
-type MaybeAbsent = Bool -- True <=> not even used
+  | Call Demand		-- C(d)
 
--- versions that don't worry about Absence:
-wwLazy, wwStrict, wwPrim, wwEnum :: Demand
-wwUnpack :: [Demand] -> Demand
+  | Eval Demands	-- U(ds)
 
-wwLazy	    = WwLazy 	  False
-wwStrict    = WwStrict
-wwUnpack xs = WwUnpack False xs
-wwPrim	    = WwPrim
-wwEnum	    = WwEnum
+  | Defer Demands	-- D(ds)
 
-seqDemand :: Demand -> ()
-seqDemand (WwLazy a)      = a `seq` ()
-seqDemand (WwUnpack b ds) = b `seq` seqDemands ds
-seqDemand _               = ()
-
-seqDemands :: [Demand] -> ()
-seqDemands [] = ()
-seqDemands (d:ds) = seqDemand d `seq` seqDemands ds
-\end{code}
+  | Box Demand		-- B(d)
 
+  | Bot			-- B
+  deriving( Eq )
+	-- Equality needed for fixpoints in DmdAnal
+
+data Demands = Poly Demand	-- Polymorphic case
+	     | Prod [Demand]	-- Product case
+	     deriving( Eq )
+
+allTop :: Demands -> Bool
+allTop (Poly d)  = isTop d
+allTop (Prod ds) = all isTop ds
+
+isTop :: Demand -> Bool
+isTop Top = True
+isTop _   = False 
+
+isAbsent :: Demand -> Bool
+isAbsent Abs = True
+isAbsent _   = False 
+
+mapDmds :: (Demand -> Demand) -> Demands -> Demands
+mapDmds f (Poly d)  = Poly (f d)
+mapDmds f (Prod ds) = Prod (map f ds)
+
+zipWithDmds :: (Demand -> Demand -> Demand)
+	    -> Demands -> Demands -> Demands
+zipWithDmds f (Poly d1)  (Poly d2)  = Poly (d1 `f` d2)
+zipWithDmds f (Prod ds1) (Poly d2)  = Prod [d1 `f` d2 | d1 <- ds1]
+zipWithDmds f (Poly d1)  (Prod ds2) = Prod [d1 `f` d2 | d2 <- ds2]
+zipWithDmds f (Prod ds1) (Prod ds2) 
+  | length ds1 == length ds2 = Prod (zipWithEqual "zipWithDmds" f ds1 ds2)
+  | otherwise		     = Poly topDmd
+	-- This really can happen with polymorphism
+	-- \f. case f x of (a,b) -> ...
+	--     case f y of (a,b,c) -> ...
+	-- Here the two demands on f are C(LL) and C(LLL)!
+
+topDmd, lazyDmd, seqDmd, evalDmd, errDmd :: Demand
+topDmd  = Top			-- The most uninformative demand
+lazyDmd = Box Abs
+seqDmd  = Eval (Poly Abs)	-- Polymorphic seq demand
+evalDmd = Box seqDmd		-- Evaluate and return
+errDmd  = Box Bot		-- This used to be called X
+
+isStrictDmd :: Demand -> Bool
+isStrictDmd Bot      = True
+isStrictDmd (Eval _) = True
+isStrictDmd (Call _) = True
+isStrictDmd (Box d)  = isStrictDmd d
+isStrictDmd _        = False
 
-%************************************************************************
-%*									*
-\subsection{Functions over @Demand@}
-%*									*
-%************************************************************************
+seqDemand :: Demand -> ()
+seqDemand (Call d)   = seqDemand d
+seqDemand (Eval ds)  = seqDemands ds
+seqDemand (Defer ds) = seqDemands ds
+seqDemand (Box d)    = seqDemand d
+seqDemand _          = ()
 
-\begin{code}
-isLazy :: Demand -> Bool
-isLazy (WwLazy _) = True
-isLazy _	  = False
+seqDemands :: Demands -> ()
+seqDemands (Poly d)  = seqDemand d
+seqDemands (Prod ds) = seqDemandList ds
 
-isStrict :: Demand -> Bool
-isStrict d = not (isLazy d)
+seqDemandList :: [Demand] -> ()
+seqDemandList [] = ()
+seqDemandList (d:ds) = seqDemand d `seq` seqDemandList ds
 
-isPrim :: Demand -> Bool
-isPrim WwPrim = True
-isPrim _      = False
+instance Outputable Demand where
+    ppr Top  = char 'T'
+    ppr Abs  = char 'A'
+    ppr Bot  = char 'B'
+
+    ppr (Defer ds)      = char 'D' <> ppr ds
+    ppr (Eval ds)       = char 'U' <> ppr ds
+				      
+    ppr (Box (Eval ds)) = char 'S' <> ppr ds
+    ppr (Box Abs)	= char 'L'
+    ppr (Box Bot)	= char 'X'
+    ppr d@(Box _)	= pprPanic "ppr: Bad boxed demand" (ppr d)
+
+    ppr (Call d)	= char 'C' <> parens (ppr d)
+
+
+instance Outputable Demands where
+    ppr (Poly Abs) = empty
+    ppr (Poly d)   = parens (ppr d <> char '*')
+    ppr (Prod ds)  = parens (hcat (map ppr ds))
+	-- At one time I printed U(AAA) as U, but that
+	-- confuses (Poly Abs) with (Prod AAA), and the
+	-- worker/wrapper generation differs slightly for these two
+	-- [Reason: in the latter case we can avoid passing the arg;
+	--  see notes with WwLib.mkWWstr_one.]
 \end{code}
 
 
 %************************************************************************
 %*									*
-\subsection{Instances}
+\subsection{Demand types}
 %*									*
 %************************************************************************
 
-
 \begin{code}
-pprDemands :: [Demand] -> Bool -> SDoc
-pprDemands demands bot = hcat (map pprDemand demands) <> pp_bot
-		       where
-			 pp_bot | bot       = ptext (sLit "B")
-				| otherwise = empty
-
-
-pprDemand :: Demand -> SDoc
-pprDemand (WwLazy False)  	 = char 'L'
-pprDemand (WwLazy True)   	 = char 'A'
-pprDemand WwStrict	      	 = char 'S'
-pprDemand WwPrim	      	 = char 'P'
-pprDemand WwEnum	      	 = char 'E'
-pprDemand (WwUnpack wu args)     = char ch <> parens (hcat (map pprDemand args))
-				      where
-					ch = if wu then 'U' else 'u'
-
-instance Outputable Demand where
-    ppr (WwLazy False) = empty
-    ppr other_demand   = ptext (sLit "__D") <+> pprDemand other_demand
-
-instance Show Demand where
-    showsPrec p d = showsPrecSDoc p (ppr d)
-
--- Reading demands is done in Lex.lhs
+data DmdType = DmdType 
+		    DmdEnv	-- Demand on explicitly-mentioned 
+				--	free variables
+		    [Demand]	-- Demand on arguments
+		    DmdResult	-- Nature of result
+
+	-- 		IMPORTANT INVARIANT
+	-- The default demand on free variables not in the DmdEnv is:
+	-- DmdResult = BotRes        <=>  Bot
+	-- DmdResult = TopRes/ResCPR <=>  Abs
+
+	-- 		ANOTHER IMPORTANT INVARIANT
+	-- The Demands in the argument list are never
+	--	Bot, Defer d
+	-- Handwavey reason: these don't correspond to calling conventions
+	-- See DmdAnal.funArgDemand for details
+
+
+-- This guy lets us switch off CPR analysis
+-- by making sure that everything uses TopRes instead of RetCPR
+-- Assuming, of course, that they don't mention RetCPR by name.
+-- They should onlyu use retCPR
+retCPR :: DmdResult
+retCPR | opt_CprOff = TopRes
+       | otherwise  = RetCPR
+
+seqDmdType :: DmdType -> ()
+seqDmdType (DmdType _env ds res) = 
+  {- ??? env `seq` -} seqDemandList ds `seq` res `seq` ()
+
+type DmdEnv = VarEnv Demand
+
+data DmdResult = TopRes	-- Nothing known	
+	       | RetCPR	-- Returns a constructed product
+	       | BotRes	-- Diverges or errors
+	       deriving( Eq, Show )
+	-- Equality for fixpoints
+	-- Show needed for Show in Lex.Token (sigh)
+
+-- Equality needed for fixpoints in DmdAnal
+instance Eq DmdType where
+  (==) (DmdType fv1 ds1 res1)
+       (DmdType fv2 ds2 res2) =  ufmToList fv1 == ufmToList fv2
+			      && ds1 == ds2 && res1 == res2
+
+instance Outputable DmdType where
+  ppr (DmdType fv ds res) 
+    = hsep [text "DmdType",
+	    hcat (map ppr ds) <> ppr res,
+	    if null fv_elts then empty
+	    else braces (fsep (map pp_elt fv_elts))]
+    where
+      pp_elt (uniq, dmd) = ppr uniq <> text "->" <> ppr dmd
+      fv_elts = ufmToList fv
+
+instance Outputable DmdResult where
+  ppr TopRes = empty	  -- Keep these distinct from Demand letters
+  ppr RetCPR = char 'm'	  -- so that we can print strictness sigs as
+  ppr BotRes = char 'b'   --    dddr
+			  -- without ambiguity
+
+emptyDmdEnv :: VarEnv Demand
+emptyDmdEnv = emptyVarEnv
+
+topDmdType, botDmdType, cprDmdType :: DmdType
+topDmdType = DmdType emptyDmdEnv [] TopRes
+botDmdType = DmdType emptyDmdEnv [] BotRes
+cprDmdType = DmdType emptyVarEnv [] retCPR
+
+isTopDmdType :: DmdType -> Bool
+-- Only used on top-level types, hence the assert
+isTopDmdType (DmdType env [] TopRes) = ASSERT( isEmptyVarEnv env) True	
+isTopDmdType _                       = False
+
+isBotRes :: DmdResult -> Bool
+isBotRes BotRes = True
+isBotRes _      = False
+
+resTypeArgDmd :: DmdResult -> Demand
+-- TopRes and BotRes are polymorphic, so that
+--	BotRes = Bot -> BotRes
+--	TopRes = Top -> TopRes
+-- This function makes that concrete
+-- We can get a RetCPR, because of the way in which we are (now)
+-- giving CPR info to strict arguments.  On the first pass, when
+-- nothing has demand info, we optimistically give CPR info or RetCPR to all args
+resTypeArgDmd TopRes = Top
+resTypeArgDmd RetCPR = Top
+resTypeArgDmd BotRes = Bot
+
+returnsCPR :: DmdResult -> Bool
+returnsCPR RetCPR = True
+returnsCPR _      = False
+
+mkDmdType :: DmdEnv -> [Demand] -> DmdResult -> DmdType
+mkDmdType fv ds res = DmdType fv ds res
+
+mkTopDmdType :: [Demand] -> DmdResult -> DmdType
+mkTopDmdType ds res = DmdType emptyDmdEnv ds res
+
+dmdTypeDepth :: DmdType -> Arity
+dmdTypeDepth (DmdType _ ds _) = length ds
 \end{code}
 
 
 %************************************************************************
 %*									*
-\subsection[strictness-IdInfo]{Strictness info about an @Id@}
+\subsection{Strictness signature
 %*									*
 %************************************************************************
 
-We specify the strictness of a function by giving information about
-each of the ``wrapper's'' arguments (see the description about
-worker/wrapper-style transformations in the PJ/Launchbury paper on
-unboxed types).
+In a let-bound Id we record its strictness info.  
+In principle, this strictness info is a demand transformer, mapping
+a demand on the Id into a DmdType, which gives
+	a) the free vars of the Id's value
+	b) the Id's arguments
+	c) an indication of the result of applying 
+	   the Id to its arguments
 
-The list of @Demands@ specifies: (a)~the strictness properties of a
-function's arguments; and (b)~the type signature of that worker (if it
-exists); i.e. its calling convention.
+However, in fact we store in the Id an extremely emascuated demand transfomer,
+namely 
+		a single DmdType
+(Nevertheless we dignify StrictSig as a distinct type.)
 
-Note that the existence of a worker function is now denoted by the Id's
-workerInfo field.
+This DmdType gives the demands unleashed by the Id when it is applied
+to as many arguments as are given in by the arg demands in the DmdType.
 
-\begin{code}
-data StrictnessInfo
-  = NoStrictnessInfo
+For example, the demand transformer described by the DmdType
+		DmdType {x -> U(LL)} [V,A] Top
+says that when the function is applied to two arguments, it
+unleashes demand U(LL) on the free var x, V on the first arg,
+and A on the second.  
 
-  | StrictnessInfo [Demand] 	-- Demands on the arguments.
+If this same function is applied to one arg, all we can say is
+that it uses x with U*(LL), and its arg with demand L.
 
-		   Bool		-- True <=> the function diverges regardless of its arguments
-				-- Useful for "error" and other disguised variants thereof.  
-				-- BUT NB: f = \x y. error "urk"
-				-- 	   will have info  SI [SS] True
-				-- but still (f) and (f 2) are not bot; only (f 3 2) is bot
-  deriving( Eq )
+\begin{code}
+newtype StrictSig = StrictSig DmdType
+		  deriving( Eq )
 
-	-- NOTA BENE: if the arg demands are, say, [S,L], this means that
-	-- 	(f bot) is not necy bot, only (f bot x) is bot
-	-- We simply cannot express accurately the strictness of a function
-	-- like		f = \x -> case x of (a,b) -> \y -> ...
-	-- The up-side is that we don't need to restrict the strictness info
-	-- to the visible arity of the function.
+instance Outputable StrictSig where
+   ppr (StrictSig ty) = ppr ty
 
-seqStrictnessInfo :: StrictnessInfo -> ()
-seqStrictnessInfo (StrictnessInfo ds b) = b `seq` seqDemands ds
-seqStrictnessInfo _                     = ()
-\end{code}
+instance Show StrictSig where
+   show (StrictSig ty) = showSDoc (ppr ty)
 
-\begin{code}
-mkStrictnessInfo :: ([Demand], Bool) -> StrictnessInfo
+mkStrictSig :: DmdType -> StrictSig
+mkStrictSig dmd_ty = StrictSig dmd_ty
+
+splitStrictSig :: StrictSig -> ([Demand], DmdResult)
+splitStrictSig (StrictSig (DmdType _ dmds res)) = (dmds, res)
 
-mkStrictnessInfo (xs, is_bot)
-  | all totally_boring xs && not is_bot	= NoStrictnessInfo		-- Uninteresting
-  | otherwise		    	        = StrictnessInfo xs is_bot
-  where
-    totally_boring (WwLazy False) = True
-    totally_boring _              = False
+increaseStrictSigArity :: Int -> StrictSig -> StrictSig
+-- Add extra arguments to a strictness signature
+increaseStrictSigArity arity_increase (StrictSig (DmdType env dmds res))
+  = StrictSig (DmdType env (replicate arity_increase topDmd ++ dmds) res)
 
-noStrictnessInfo :: StrictnessInfo
-noStrictnessInfo = NoStrictnessInfo
+isTopSig :: StrictSig -> Bool
+isTopSig (StrictSig ty) = isTopDmdType ty
 
-isBottomingStrictness :: StrictnessInfo -> Bool
-isBottomingStrictness (StrictnessInfo _ bot) = bot
-isBottomingStrictness NoStrictnessInfo       = False
+topSig, botSig, cprSig :: StrictSig
+topSig = StrictSig topDmdType
+botSig = StrictSig botDmdType
+cprSig = StrictSig cprDmdType
+	
 
 -- appIsBottom returns true if an application to n args would diverge
-appIsBottom :: StrictnessInfo -> Int -> Bool
-appIsBottom (StrictnessInfo ds bot)   n = bot && (listLengthCmp ds n /=GT) -- not more than 'n' elts in 'ds'.
-appIsBottom  NoStrictnessInfo         _ = False
+appIsBottom :: StrictSig -> Int -> Bool
+appIsBottom (StrictSig (DmdType _ ds BotRes)) n = listLengthCmp ds n /= GT
+appIsBottom _				      _ = False
 
-ppStrictnessInfo :: StrictnessInfo -> SDoc
-ppStrictnessInfo NoStrictnessInfo		   = empty
-ppStrictnessInfo (StrictnessInfo wrapper_args bot) = hsep [pprDemands wrapper_args bot]
-\end{code}
+isBottomingSig :: StrictSig -> Bool
+isBottomingSig (StrictSig (DmdType _ _ BotRes)) = True
+isBottomingSig _				= False
 
-\begin{code}
-#endif /* OLD_STRICTNESS */
+seqStrictSig :: StrictSig -> ()
+seqStrictSig (StrictSig ty) = seqDmdType ty
+
+pprIfaceStrictSig :: StrictSig -> SDoc
+-- Used for printing top-level strictness pragmas in interface files
+pprIfaceStrictSig (StrictSig (DmdType _ dmds res))
+  = hcat (map ppr dmds) <> ppr res
 \end{code}
+    
+
diff --git a/compiler/basicTypes/Id.lhs b/compiler/basicTypes/Id.lhs
index b72d8c2..ceba599 100644
--- a/compiler/basicTypes/Id.lhs
+++ b/compiler/basicTypes/Id.lhs
@@ -67,34 +67,23 @@ module Id (
 
 	-- ** Reading 'IdInfo' fields
 	idArity, 
-	idNewDemandInfo, idNewDemandInfo_maybe,
-	idNewStrictness, idNewStrictness_maybe, 
+	idDemandInfo, idDemandInfo_maybe,
+	idStrictness, idStrictness_maybe, 
 	idUnfolding, realIdUnfolding,
 	idSpecialisation, idCoreRules, idHasRules,
 	idCafInfo,
 	idLBVarInfo,
 	idOccInfo,
 
-#ifdef OLD_STRICTNESS
-	idDemandInfo, 
-	idStrictness, 
-	idCprInfo,
-#endif
-
 	-- ** Writing 'IdInfo' fields
 	setIdUnfolding,
 	setIdArity,
-	setIdNewDemandInfo, 
-	setIdNewStrictness, zapIdNewStrictness,
+	setIdDemandInfo, 
+	setIdStrictness, zapIdStrictness,
 	setIdSpecialisation,
 	setIdCafInfo,
 	setIdOccInfo, zapIdOccInfo,
 
-#ifdef OLD_STRICTNESS
-	setIdStrictness, 
-	setIdDemandInfo, 
-	setIdCprInfo,
-#endif
     ) where
 
 #include "HsVersions.h"
@@ -114,11 +103,8 @@ import TyCon
 import Type
 import TcType
 import TysPrim
-#ifdef OLD_STRICTNESS
-import qualified Demand
-#endif
 import DataCon
-import NewDemand
+import Demand
 import Name
 import Module
 import Class
@@ -136,16 +122,11 @@ import StaticFlags
 -- infixl so you can say (id `set` a `set` b)
 infixl 	1 `setIdUnfolding`,
 	  `setIdArity`,
-	  `setIdNewDemandInfo`,
-	  `setIdNewStrictness`,
+	  `setIdDemandInfo`,
+	  `setIdStrictness`,
 	  `setIdSpecialisation`,
 	  `setInlinePragma`,
 	  `idCafInfo`
-#ifdef OLD_STRICTNESS
-	  ,`idCprInfo`
-	  ,`setIdStrictness`
-	  ,`setIdDemandInfo`
-#endif
 \end{code}
 
 %************************************************************************
@@ -469,31 +450,21 @@ idArity id = arityInfo (idInfo id)
 setIdArity :: Id -> Arity -> Id
 setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
 
-#ifdef OLD_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
-
 -- | Returns true if an application to n args would diverge
 isBottomingId :: Id -> Bool
-isBottomingId id = isBottomingSig (idNewStrictness id)
+isBottomingId id = isBottomingSig (idStrictness id)
 
-idNewStrictness_maybe :: Id -> Maybe StrictSig
-idNewStrictness :: Id -> StrictSig
+idStrictness_maybe :: Id -> Maybe StrictSig
+idStrictness :: Id -> StrictSig
 
-idNewStrictness_maybe id = newStrictnessInfo (idInfo id)
-idNewStrictness       id = idNewStrictness_maybe id `orElse` topSig
+idStrictness_maybe id = strictnessInfo (idInfo id)
+idStrictness       id = idStrictness_maybe id `orElse` topSig
 
-setIdNewStrictness :: Id -> StrictSig -> Id
-setIdNewStrictness id sig = modifyIdInfo (`setNewStrictnessInfo` Just sig) id
+setIdStrictness :: Id -> StrictSig -> Id
+setIdStrictness id sig = modifyIdInfo (`setStrictnessInfo` Just sig) id
 
-zapIdNewStrictness :: Id -> Id
-zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id
+zapIdStrictness :: Id -> Id
+zapIdStrictness id = modifyIdInfo (`setStrictnessInfo` Nothing) id
 
 -- | This predicate says whether the 'Id' has a strict demand placed on it or
 -- has a type such that it can always be evaluated strictly (e.g., an
@@ -504,7 +475,7 @@ zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id
 isStrictId :: Id -> Bool
 isStrictId id
   = ASSERT2( isId id, text "isStrictId: not an id: " <+> ppr id )
-           (isStrictDmd (idNewDemandInfo id)) || 
+           (isStrictDmd (idDemandInfo id)) || 
            (isStrictType (idType id))
 
 	---------------------------------
@@ -524,24 +495,14 @@ realIdUnfolding id = unfoldingInfo (idInfo id)
 setIdUnfolding :: Id -> Unfolding -> Id
 setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
 
-#ifdef OLD_STRICTNESS
-	---------------------------------
-	-- (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_maybe :: Id -> Maybe NewDemand.Demand
-idNewDemandInfo       :: Id -> NewDemand.Demand
+idDemandInfo_maybe :: Id -> Maybe Demand
+idDemandInfo       :: Id -> Demand
 
-idNewDemandInfo_maybe id = newDemandInfo (idInfo id)
-idNewDemandInfo       id = newDemandInfo (idInfo id) `orElse` NewDemand.topDmd
+idDemandInfo_maybe id = demandInfo (idInfo id)
+idDemandInfo       id = demandInfo (idInfo id) `orElse` topDmd
 
-setIdNewDemandInfo :: Id -> NewDemand.Demand -> Id
-setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` Just dmd) id
+setIdDemandInfo :: Id -> Demand -> Id
+setIdDemandInfo id dmd = modifyIdInfo (`setDemandInfo` Just dmd) id
 
 	---------------------------------
 	-- SPECIALISATION
@@ -563,28 +524,12 @@ setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
 	---------------------------------
 	-- CAF INFO
 idCafInfo :: Id -> CafInfo
-#ifdef OLD_STRICTNESS
-idCafInfo id = case cgInfo (idInfo id) of
-		  NoCgInfo -> pprPanic "idCafInfo" (ppr id)
-		  info     -> cgCafInfo info
-#else
 idCafInfo id = cafInfo (idInfo id)
-#endif
 
 setIdCafInfo :: Id -> CafInfo -> Id
 setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
 
 	---------------------------------
-	-- CPR INFO
-#ifdef OLD_STRICTNESS
-idCprInfo :: Id -> CprInfo
-idCprInfo id = cprInfo (idInfo id)
-
-setIdCprInfo :: Id -> CprInfo -> Id
-setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
-#endif
-
-	---------------------------------
 	-- Occcurrence INFO
 idOccInfo :: Id -> OccInfo
 idOccInfo id = occInfo (idInfo id)
@@ -751,10 +696,10 @@ transferPolyIdInfo old_id abstract_wrt new_id
     old_arity       = arityInfo old_info
     old_inline_prag = inlinePragInfo old_info
     new_arity       = old_arity + arity_increase
-    old_strictness  = newStrictnessInfo old_info
+    old_strictness  = strictnessInfo old_info
     new_strictness  = fmap (increaseStrictSigArity arity_increase) old_strictness
 
-    transfer new_info = new_info `setNewStrictnessInfo` new_strictness
+    transfer new_info = new_info `setStrictnessInfo` new_strictness
 			         `setArityInfo` new_arity
  			         `setInlinePragInfo` old_inline_prag
 \end{code}
diff --git a/compiler/basicTypes/IdInfo.lhs b/compiler/basicTypes/IdInfo.lhs
index 9b74a48..0a173d9 100644
--- a/compiler/basicTypes/IdInfo.lhs
+++ b/compiler/basicTypes/IdInfo.lhs
@@ -26,28 +26,8 @@ module IdInfo (
 	arityInfo, setArityInfo, ppArityInfo, 
 
 	-- ** Demand and strictness Info
- 	newStrictnessInfo, setNewStrictnessInfo, 
-  	newDemandInfo, setNewDemandInfo, pprNewStrictness,
-	setAllStrictnessInfo,
-
-#ifdef OLD_STRICTNESS
-	-- ** Old strictness Info
-	StrictnessInfo(..),
-	mkStrictnessInfo, noStrictnessInfo,
-	ppStrictnessInfo, isBottomingStrictness, 
-	strictnessInfo, setStrictnessInfo,
-	
-        oldStrictnessFromNew, newStrictnessFromOld,
-
-	-- ** Old demand Info
-	demandInfo, setDemandInfo, 
-	oldDemand, newDemand,
-
-        -- ** Old Constructed Product Result Info
-        CprInfo(..), 
-        cprInfo, setCprInfo, ppCprInfo, noCprInfo,
-        cprInfoFromNewStrictness,
-#endif
+ 	strictnessInfo, setStrictnessInfo, 
+  	demandInfo, setDemandInfo, pprStrictness,
 
 	-- ** Unfolding Info
 	unfoldingInfo, setUnfoldingInfo, setUnfoldingInfoLazily,
@@ -94,20 +74,13 @@ import BasicTypes
 import DataCon
 import TyCon
 import ForeignCall
-import NewDemand
+import Demand
 import Outputable	
 import Module
 import FastString
 
 import Data.Maybe
 
-#ifdef OLD_STRICTNESS
-import Demand
-import qualified Demand
-import Util
-import Data.List
-#endif
-
 -- infixl so you can say (id `set` a `set` b)
 infixl 	1 `setSpecInfo`,
 	  `setArityInfo`,
@@ -116,117 +89,12 @@ infixl 	1 `setSpecInfo`,
 	  `setLBVarInfo`,
 	  `setOccInfo`,
 	  `setCafInfo`,
-	  `setNewStrictnessInfo`,
-	  `setAllStrictnessInfo`,
-	  `setNewDemandInfo`
-#ifdef OLD_STRICTNESS
-	  , `setCprInfo`
-	  , `setDemandInfo`
-	  , `setStrictnessInfo`
-#endif
+	  `setStrictnessInfo`,
+	  `setDemandInfo`
 \end{code}
 
 %************************************************************************
 %*									*
-\subsection{New strictness info}
-%*									*
-%************************************************************************
-
-To be removed later
-
-\begin{code}
--- | Set old and new strictness information together
-setAllStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo
-setAllStrictnessInfo info Nothing
-  = info { newStrictnessInfo = Nothing
-#ifdef OLD_STRICTNESS
-         , strictnessInfo = NoStrictnessInfo
-         , cprInfo = NoCPRInfo
-#endif
-         }
-
-setAllStrictnessInfo info (Just sig)
-  = info { newStrictnessInfo = Just sig
-#ifdef OLD_STRICTNESS
-         , strictnessInfo = oldStrictnessFromNew sig
-         , cprInfo = cprInfoFromNewStrictness sig
-#endif
-         }
-
-seqNewStrictnessInfo :: Maybe StrictSig -> ()
-seqNewStrictnessInfo Nothing = ()
-seqNewStrictnessInfo (Just ty) = seqStrictSig ty
-
-pprNewStrictness :: Maybe StrictSig -> SDoc
-pprNewStrictness Nothing    = empty
-pprNewStrictness (Just sig) = ppr sig
-
-#ifdef OLD_STRICTNESS
-oldStrictnessFromNew :: StrictSig -> Demand.StrictnessInfo
-oldStrictnessFromNew sig = mkStrictnessInfo (map oldDemand dmds, isBotRes res_info)
-			 where
-			   (dmds, res_info) = splitStrictSig sig
-
-cprInfoFromNewStrictness :: StrictSig -> CprInfo
-cprInfoFromNewStrictness sig = case strictSigResInfo sig of
-				  RetCPR -> ReturnsCPR
-				  other  -> NoCPRInfo
-
-newStrictnessFromOld :: Name -> Arity -> Demand.StrictnessInfo -> CprInfo -> StrictSig
-newStrictnessFromOld name arity (Demand.StrictnessInfo ds res) cpr
-  | listLengthCmp ds arity /= GT -- length ds <= arity
-	-- Sometimes the old strictness analyser has more
-	-- demands than the arity justifies
-  = mk_strict_sig name arity $
-    mkTopDmdType (map newDemand ds) (newRes res cpr)
-
-newStrictnessFromOld name arity other cpr
-  =	-- Either no strictness info, or arity is too small
-	-- In either case we can't say anything useful
-    mk_strict_sig name arity $
-    mkTopDmdType (replicate arity lazyDmd) (newRes False cpr)
-
-mk_strict_sig name arity dmd_ty
-  = WARN( arity /= dmdTypeDepth dmd_ty, ppr name <+> (ppr arity $$ ppr dmd_ty) )
-    mkStrictSig dmd_ty
-
-newRes True  _ 	        = BotRes
-newRes False ReturnsCPR = retCPR
-newRes False NoCPRInfo  = TopRes
-
-newDemand :: Demand.Demand -> NewDemand.Demand
-newDemand (WwLazy True)      = Abs
-newDemand (WwLazy False)     = lazyDmd
-newDemand WwStrict	     = evalDmd
-newDemand (WwUnpack unpk ds) = Eval (Prod (map newDemand ds))
-newDemand WwPrim	     = lazyDmd
-newDemand WwEnum	     = evalDmd
-
-oldDemand :: NewDemand.Demand -> Demand.Demand
-oldDemand Abs	     	   = WwLazy True
-oldDemand Top	     	   = WwLazy False
-oldDemand Bot	     	   = WwStrict
-oldDemand (Box Bot)	   = WwStrict
-oldDemand (Box Abs)	   = WwLazy False
-oldDemand (Box (Eval _))   = WwStrict	-- Pass box only
-oldDemand (Defer d)        = WwLazy False
-oldDemand (Eval (Prod ds)) = WwUnpack True (map oldDemand ds)
-oldDemand (Eval (Poly _))  = WwStrict
-oldDemand (Call _)         = WwStrict
-
-#endif /* OLD_STRICTNESS */
-\end{code}
-
-
-\begin{code}
-seqNewDemandInfo :: Maybe Demand -> ()
-seqNewDemandInfo Nothing    = ()
-seqNewDemandInfo (Just dmd) = seqDemand dmd
-\end{code}
-
-
-%************************************************************************
-%*									*
                      IdDetails
 %*									*
 %************************************************************************
@@ -311,23 +179,18 @@ data IdInfo
 	arityInfo 	:: !ArityInfo,		-- ^ 'Id' arity
 	specInfo 	:: SpecInfo,		-- ^ Specialisations of the 'Id's function which exist
 			   			-- See Note [Specialisations and RULES in IdInfo]
-#ifdef OLD_STRICTNESS
-	cprInfo 	:: CprInfo,             -- ^ If the 'Id's function always constructs a product result
-	demandInfo 	:: Demand.Demand,	-- ^ Whether or not the 'Id' is definitely demanded
-	strictnessInfo	:: StrictnessInfo,	-- ^ 'Id' strictness properties
-#endif
 	unfoldingInfo	:: Unfolding,		-- ^ The 'Id's unfolding
 	cafInfo		:: CafInfo,		-- ^ 'Id' CAF info
         lbvarInfo	:: LBVarInfo,		-- ^ Info about a lambda-bound variable, if the 'Id' is one
 	inlinePragInfo	:: InlinePragma,	-- ^ Any inline pragma atached to the 'Id'
 	occInfo		:: OccInfo,		-- ^ How the 'Id' occurs in the program
 
-	newStrictnessInfo :: Maybe StrictSig,	-- ^ Id strictness information. Reason for Maybe: 
+	strictnessInfo :: Maybe StrictSig,	-- ^ Id strictness information. Reason for Maybe: 
 	                                        -- the DmdAnal phase needs to know whether
 						-- this is the first visit, so it can assign botSig.
 						-- Other customers want topSig.  So @Nothing@ is good.
 
-	newDemandInfo	  :: Maybe Demand	-- ^ Id demand information. Similarly we want to know 
+	demandInfo	  :: Maybe Demand	-- ^ Id demand information. Similarly we want to know 
 	                                        -- if there's no known demand yet, for when we are looking
 						-- for CPR info
     }
@@ -346,18 +209,20 @@ megaSeqIdInfo info
 -- some unfoldings are not calculated at all
 --    seqUnfolding (unfoldingInfo info)		`seq`
 
-    seqNewDemandInfo (newDemandInfo info)	`seq`
-    seqNewStrictnessInfo (newStrictnessInfo info) `seq`
-
-#ifdef OLD_STRICTNESS
-    Demand.seqDemand (demandInfo info)		`seq`
-    seqStrictnessInfo (strictnessInfo info)	`seq`
-    seqCpr (cprInfo info)			`seq`
-#endif
+    seqDemandInfo (demandInfo info)	`seq`
+    seqStrictnessInfo (strictnessInfo info) `seq`
 
     seqCaf (cafInfo info)			`seq`
     seqLBVar (lbvarInfo info)			`seq`
     seqOccInfo (occInfo info) 
+
+seqStrictnessInfo :: Maybe StrictSig -> ()
+seqStrictnessInfo Nothing = ()
+seqStrictnessInfo (Just ty) = seqStrictSig ty
+
+seqDemandInfo :: Maybe Demand -> ()
+seqDemandInfo Nothing    = ()
+seqDemandInfo (Just dmd) = seqDemand dmd
 \end{code}
 
 Setters
@@ -369,9 +234,6 @@ setInlinePragInfo :: IdInfo -> InlinePragma -> IdInfo
 setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }
 setOccInfo :: IdInfo -> OccInfo -> IdInfo
 setOccInfo	  info oc = oc `seq` info { occInfo = oc }
-#ifdef OLD_STRICTNESS
-setStrictnessInfo info st = st `seq` info { strictnessInfo = st }
-#endif
 	-- Try to avoid spack leaks by seq'ing
 
 setUnfoldingInfoLazily :: IdInfo -> Unfolding -> IdInfo
@@ -385,11 +247,6 @@ setUnfoldingInfo info uf
 	-- actually increases residency significantly. 
   = info { unfoldingInfo = uf }
 
-#ifdef OLD_STRICTNESS
-setDemandInfo	  info dd = info { demandInfo = dd }
-setCprInfo        info cp = info { cprInfo = cp }
-#endif
-
 setArityInfo :: IdInfo -> ArityInfo -> IdInfo
 setArityInfo	  info ar  = info { arityInfo = ar  }
 setCafInfo :: IdInfo -> CafInfo -> IdInfo
@@ -398,10 +255,11 @@ setCafInfo        info caf = info { cafInfo = caf }
 setLBVarInfo :: IdInfo -> LBVarInfo -> IdInfo
 setLBVarInfo      info lb = {-lb `seq`-} info { lbvarInfo = lb }
 
-setNewDemandInfo :: IdInfo -> Maybe Demand -> IdInfo
-setNewDemandInfo     info dd = dd `seq` info { newDemandInfo = dd }
-setNewStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo
-setNewStrictnessInfo info dd = dd `seq` info { newStrictnessInfo = dd }
+setDemandInfo :: IdInfo -> Maybe Demand -> IdInfo
+setDemandInfo     info dd = dd `seq` info { demandInfo = dd }
+
+setStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo
+setStrictnessInfo info dd = dd `seq` info { strictnessInfo = dd }
 \end{code}
 
 
@@ -412,18 +270,13 @@ vanillaIdInfo
   = IdInfo {
 	    cafInfo		= vanillaCafInfo,
 	    arityInfo		= unknownArity,
-#ifdef OLD_STRICTNESS
-	    cprInfo		= NoCPRInfo,
-	    demandInfo		= wwLazy,
-	    strictnessInfo	= NoStrictnessInfo,
-#endif
 	    specInfo		= emptySpecInfo,
 	    unfoldingInfo	= noUnfolding,
 	    lbvarInfo		= NoLBVarInfo,
 	    inlinePragInfo 	= defaultInlinePragma,
 	    occInfo		= NoOccInfo,
-	    newDemandInfo	= Nothing,
-	    newStrictnessInfo   = Nothing
+	    demandInfo	= Nothing,
+	    strictnessInfo   = Nothing
 	   }
 
 -- | More informative 'IdInfo' we can use when we know the 'Id' has no CAF references
@@ -485,6 +338,19 @@ type InlinePragInfo = InlinePragma
 
 %************************************************************************
 %*									*
+               Strictness
+%*									*
+%************************************************************************
+
+\begin{code}
+pprStrictness :: Maybe StrictSig -> SDoc
+pprStrictness Nothing    = empty
+pprStrictness (Just sig) = ppr sig
+\end{code}
+
+
+%************************************************************************
+%*									*
 	SpecInfo
 %*									*
 %************************************************************************
@@ -586,59 +452,6 @@ ppCafInfo MayHaveCafRefs = empty
 
 %************************************************************************
 %*									*
-\subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@}
-%*									*
-%************************************************************************
-
-\begin{code}
-#ifdef OLD_STRICTNESS
--- | If the @Id@ is a function then it may have Constructed Product Result 
--- (CPR) info. A CPR analysis phase detects whether:
--- 
--- 1. The function's return value has a product type, i.e. an algebraic  type 
--- with a single constructor. Examples of such types are tuples and boxed
--- primitive values.
---
--- 2. The function always 'constructs' the value that it is returning.  It
--- must do this on every path through,  and it's OK if it calls another
--- function which constructs the result.
--- 
--- If this is the case then we store a template which tells us the
--- function has the CPR property and which components of the result are
--- also CPRs.
-data CprInfo
-  = NoCPRInfo   -- ^ No, this function does not return a constructed product
-  | ReturnsCPR	-- ^ Yes, this function returns a constructed product
-		
-		-- Implicitly, this means "after the function has been applied
-		-- to all its arguments", so the worker\/wrapper builder in 
-		-- WwLib.mkWWcpr checks that that it is indeed saturated before
-		-- making use of the CPR info
-
-	-- We used to keep nested info about sub-components, but
-	-- we never used it so I threw it away
-
--- | It's always safe to assume that an 'Id' does not have the CPR property
-noCprInfo :: CprInt
-noCprInfo = NoCPRInfo
-
-seqCpr :: CprInfo -> ()
-seqCpr ReturnsCPR = ()
-seqCpr NoCPRInfo  = ()
-
-ppCprInfo NoCPRInfo  = empty
-ppCprInfo ReturnsCPR = ptext (sLit "__M")
-
-instance Outputable CprInfo where
-    ppr = ppCprInfo
-
-instance Show CprInfo where
-    showsPrec p c = showsPrecSDoc p (ppr c)
-#endif
-\end{code}
-
-%************************************************************************
-%*									*
 \subsection[lbvar-IdInfo]{Lambda-bound var info about an @Id@}
 %*									*
 %************************************************************************
@@ -690,11 +503,11 @@ instance Show LBVarInfo where
 --
 -- > (\x1. \x2. e) arg1
 zapLamInfo :: IdInfo -> Maybe IdInfo
-zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand})
+zapLamInfo info@(IdInfo {occInfo = occ, demandInfo = demand})
   | is_safe_occ occ && is_safe_dmd demand
   = Nothing
   | otherwise
-  = Just (info {occInfo = safe_occ, newDemandInfo = Nothing})
+  = Just (info {occInfo = safe_occ, demandInfo = Nothing})
   where
 	-- The "unsafe" occ info is the ones that say I'm not in a lambda
 	-- because that might not be true for an unsaturated lambda
@@ -712,8 +525,8 @@ zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand})
 \begin{code}
 -- | Remove demand info on the 'IdInfo' if it is present, otherwise return @Nothing@
 zapDemandInfo :: IdInfo -> Maybe IdInfo
-zapDemandInfo info@(IdInfo {newDemandInfo = dmd})
-  | isJust dmd = Just (info {newDemandInfo = Nothing})
+zapDemandInfo info@(IdInfo {demandInfo = dmd})
+  | isJust dmd = Just (info {demandInfo = Nothing})
   | otherwise  = Nothing
 \end{code}
 
diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 6d8df87..1eacea9 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -65,7 +65,7 @@ import DataCon
 import Id
 import Var              ( Var, TyVar, mkCoVar, mkExportedLocalVar )
 import IdInfo
-import NewDemand
+import Demand
 import CoreSyn
 import Unique
 import PrelNames
@@ -265,7 +265,7 @@ mkDataConIds wrap_name wkr_name data_con
     wkr_arity = dataConRepArity data_con
     wkr_info  = noCafIdInfo
                 `setArityInfo`          wkr_arity
-                `setAllStrictnessInfo`  Just wkr_sig
+                `setStrictnessInfo`  Just wkr_sig
                 `setUnfoldingInfo`      evaldUnfolding  -- Record that it's evaluated,
                                                         -- even if arity = 0
 
@@ -329,7 +329,7 @@ mkDataConIds wrap_name wkr_name data_con
                         -- It's important to specify the arity, so that partial
                         -- applications are treated as values
                     `setUnfoldingInfo`     wrap_unf
-                    `setAllStrictnessInfo` Just wrap_sig
+                    `setStrictnessInfo` Just wrap_sig
 
     all_strict_marks = dataConExStricts data_con ++ dataConStrictMarks data_con
     wrap_sig = mkStrictSig (mkTopDmdType arg_dmds cpr_info)
@@ -459,7 +459,7 @@ mkDictSelId no_unf name clas
 
     base_info = noCafIdInfo
                 `setArityInfo`      1
-                `setAllStrictnessInfo`  Just strict_sig
+                `setStrictnessInfo`  Just strict_sig
                 `setUnfoldingInfo`  (if no_unf then noUnfolding
 				     else mkImplicitUnfolding rhs)
 		   -- In module where class op is defined, we must add
@@ -763,7 +763,7 @@ mkPrimOpId prim_op
     info = noCafIdInfo
            `setSpecInfo`          mkSpecInfo (primOpRules prim_op name)
            `setArityInfo`         arity
-           `setAllStrictnessInfo` Just strict_sig
+           `setStrictnessInfo` Just strict_sig
 
 -- For each ccall we manufacture a separate CCallOpId, giving it
 -- a fresh unique, a type that is correct for this particular ccall,
@@ -789,7 +789,7 @@ mkFCallId uniq fcall ty
 
     info = noCafIdInfo
            `setArityInfo`         arity
-           `setAllStrictnessInfo` Just strict_sig
+           `setStrictnessInfo` Just strict_sig
 
     (_, tau)     = tcSplitForAllTys ty
     (arg_tys, _) = tcSplitFunTys tau
@@ -1158,7 +1158,7 @@ pc_bottoming_Id :: Name -> Type -> Id
 pc_bottoming_Id name ty
  = pcMiscPrelId name ty bottoming_info
  where
-    bottoming_info = vanillaIdInfo `setAllStrictnessInfo` Just strict_sig
+    bottoming_info = vanillaIdInfo `setStrictnessInfo` Just strict_sig
 				   `setArityInfo`         1
 			-- Make arity and strictness agree
 
diff --git a/compiler/basicTypes/NewDemand.lhs b/compiler/basicTypes/NewDemand.lhs
deleted file mode 100644
index e97a7db..0000000
--- a/compiler/basicTypes/NewDemand.lhs
+++ /dev/null
@@ -1,342 +0,0 @@
-%
-% (c) The University of Glasgow 2006
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[Demand]{@Demand@: the amount of demand on a value}
-
-\begin{code}
-module NewDemand(
-	Demand(..), 
-	topDmd, lazyDmd, seqDmd, evalDmd, errDmd, isStrictDmd, 
-	isTop, isAbsent, seqDemand,
-
-	DmdType(..), topDmdType, botDmdType, mkDmdType, mkTopDmdType, 
-		dmdTypeDepth, seqDmdType,
-	DmdEnv, emptyDmdEnv,
-	DmdResult(..), retCPR, isBotRes, returnsCPR, resTypeArgDmd,
-	
-	Demands(..), mapDmds, zipWithDmds, allTop, seqDemands,
-
-	StrictSig(..), mkStrictSig, topSig, botSig, cprSig,
-        isTopSig,
-	splitStrictSig, increaseStrictSigArity,
-	pprIfaceStrictSig, appIsBottom, isBottomingSig, seqStrictSig,
-     ) where
-
-#include "HsVersions.h"
-
-import StaticFlags
-import BasicTypes
-import VarEnv
-import UniqFM
-import Util
-import Outputable
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Demands}
-%*									*
-%************************************************************************
-
-\begin{code}
-data Demand
-  = Top			-- T; used for unlifted types too, so that
-			--	A `lub` T = T
-  | Abs			-- A
-
-  | Call Demand		-- C(d)
-
-  | Eval Demands	-- U(ds)
-
-  | Defer Demands	-- D(ds)
-
-  | Box Demand		-- B(d)
-
-  | Bot			-- B
-  deriving( Eq )
-	-- Equality needed for fixpoints in DmdAnal
-
-data Demands = Poly Demand	-- Polymorphic case
-	     | Prod [Demand]	-- Product case
-	     deriving( Eq )
-
-allTop :: Demands -> Bool
-allTop (Poly d)  = isTop d
-allTop (Prod ds) = all isTop ds
-
-isTop :: Demand -> Bool
-isTop Top = True
-isTop _   = False 
-
-isAbsent :: Demand -> Bool
-isAbsent Abs = True
-isAbsent _   = False 
-
-mapDmds :: (Demand -> Demand) -> Demands -> Demands
-mapDmds f (Poly d)  = Poly (f d)
-mapDmds f (Prod ds) = Prod (map f ds)
-
-zipWithDmds :: (Demand -> Demand -> Demand)
-	    -> Demands -> Demands -> Demands
-zipWithDmds f (Poly d1)  (Poly d2)  = Poly (d1 `f` d2)
-zipWithDmds f (Prod ds1) (Poly d2)  = Prod [d1 `f` d2 | d1 <- ds1]
-zipWithDmds f (Poly d1)  (Prod ds2) = Prod [d1 `f` d2 | d2 <- ds2]
-zipWithDmds f (Prod ds1) (Prod ds2) 
-  | length ds1 == length ds2 = Prod (zipWithEqual "zipWithDmds" f ds1 ds2)
-  | otherwise		     = Poly topDmd
-	-- This really can happen with polymorphism
-	-- \f. case f x of (a,b) -> ...
-	--     case f y of (a,b,c) -> ...
-	-- Here the two demands on f are C(LL) and C(LLL)!
-
-topDmd, lazyDmd, seqDmd, evalDmd, errDmd :: Demand
-topDmd  = Top			-- The most uninformative demand
-lazyDmd = Box Abs
-seqDmd  = Eval (Poly Abs)	-- Polymorphic seq demand
-evalDmd = Box seqDmd		-- Evaluate and return
-errDmd  = Box Bot		-- This used to be called X
-
-isStrictDmd :: Demand -> Bool
-isStrictDmd Bot      = True
-isStrictDmd (Eval _) = True
-isStrictDmd (Call _) = True
-isStrictDmd (Box d)  = isStrictDmd d
-isStrictDmd _        = False
-
-seqDemand :: Demand -> ()
-seqDemand (Call d)   = seqDemand d
-seqDemand (Eval ds)  = seqDemands ds
-seqDemand (Defer ds) = seqDemands ds
-seqDemand (Box d)    = seqDemand d
-seqDemand _          = ()
-
-seqDemands :: Demands -> ()
-seqDemands (Poly d)  = seqDemand d
-seqDemands (Prod ds) = seqDemandList ds
-
-seqDemandList :: [Demand] -> ()
-seqDemandList [] = ()
-seqDemandList (d:ds) = seqDemand d `seq` seqDemandList ds
-
-instance Outputable Demand where
-    ppr Top  = char 'T'
-    ppr Abs  = char 'A'
-    ppr Bot  = char 'B'
-
-    ppr (Defer ds)      = char 'D' <> ppr ds
-    ppr (Eval ds)       = char 'U' <> ppr ds
-				      
-    ppr (Box (Eval ds)) = char 'S' <> ppr ds
-    ppr (Box Abs)	= char 'L'
-    ppr (Box Bot)	= char 'X'
-    ppr d@(Box _)	= pprPanic "ppr: Bad boxed demand" (ppr d)
-
-    ppr (Call d)	= char 'C' <> parens (ppr d)
-
-
-instance Outputable Demands where
-    ppr (Poly Abs) = empty
-    ppr (Poly d)   = parens (ppr d <> char '*')
-    ppr (Prod ds)  = parens (hcat (map ppr ds))
-	-- At one time I printed U(AAA) as U, but that
-	-- confuses (Poly Abs) with (Prod AAA), and the
-	-- worker/wrapper generation differs slightly for these two
-	-- [Reason: in the latter case we can avoid passing the arg;
-	--  see notes with WwLib.mkWWstr_one.]
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Demand types}
-%*									*
-%************************************************************************
-
-\begin{code}
-data DmdType = DmdType 
-		    DmdEnv	-- Demand on explicitly-mentioned 
-				--	free variables
-		    [Demand]	-- Demand on arguments
-		    DmdResult	-- Nature of result
-
-	-- 		IMPORTANT INVARIANT
-	-- The default demand on free variables not in the DmdEnv is:
-	-- DmdResult = BotRes        <=>  Bot
-	-- DmdResult = TopRes/ResCPR <=>  Abs
-
-	-- 		ANOTHER IMPORTANT INVARIANT
-	-- The Demands in the argument list are never
-	--	Bot, Defer d
-	-- Handwavey reason: these don't correspond to calling conventions
-	-- See DmdAnal.funArgDemand for details
-
-
--- This guy lets us switch off CPR analysis
--- by making sure that everything uses TopRes instead of RetCPR
--- Assuming, of course, that they don't mention RetCPR by name.
--- They should onlyu use retCPR
-retCPR :: DmdResult
-retCPR | opt_CprOff = TopRes
-       | otherwise  = RetCPR
-
-seqDmdType :: DmdType -> ()
-seqDmdType (DmdType _env ds res) = 
-  {- ??? env `seq` -} seqDemandList ds `seq` res `seq` ()
-
-type DmdEnv = VarEnv Demand
-
-data DmdResult = TopRes	-- Nothing known	
-	       | RetCPR	-- Returns a constructed product
-	       | BotRes	-- Diverges or errors
-	       deriving( Eq, Show )
-	-- Equality for fixpoints
-	-- Show needed for Show in Lex.Token (sigh)
-
--- Equality needed for fixpoints in DmdAnal
-instance Eq DmdType where
-  (==) (DmdType fv1 ds1 res1)
-       (DmdType fv2 ds2 res2) =  ufmToList fv1 == ufmToList fv2
-			      && ds1 == ds2 && res1 == res2
-
-instance Outputable DmdType where
-  ppr (DmdType fv ds res) 
-    = hsep [text "DmdType",
-	    hcat (map ppr ds) <> ppr res,
-	    if null fv_elts then empty
-	    else braces (fsep (map pp_elt fv_elts))]
-    where
-      pp_elt (uniq, dmd) = ppr uniq <> text "->" <> ppr dmd
-      fv_elts = ufmToList fv
-
-instance Outputable DmdResult where
-  ppr TopRes = empty	  -- Keep these distinct from Demand letters
-  ppr RetCPR = char 'm'	  -- so that we can print strictness sigs as
-  ppr BotRes = char 'b'   --    dddr
-			  -- without ambiguity
-
-emptyDmdEnv :: VarEnv Demand
-emptyDmdEnv = emptyVarEnv
-
-topDmdType, botDmdType, cprDmdType :: DmdType
-topDmdType = DmdType emptyDmdEnv [] TopRes
-botDmdType = DmdType emptyDmdEnv [] BotRes
-cprDmdType = DmdType emptyVarEnv [] retCPR
-
-isTopDmdType :: DmdType -> Bool
--- Only used on top-level types, hence the assert
-isTopDmdType (DmdType env [] TopRes) = ASSERT( isEmptyVarEnv env) True	
-isTopDmdType _                       = False
-
-isBotRes :: DmdResult -> Bool
-isBotRes BotRes = True
-isBotRes _      = False
-
-resTypeArgDmd :: DmdResult -> Demand
--- TopRes and BotRes are polymorphic, so that
---	BotRes = Bot -> BotRes
---	TopRes = Top -> TopRes
--- This function makes that concrete
--- We can get a RetCPR, because of the way in which we are (now)
--- giving CPR info to strict arguments.  On the first pass, when
--- nothing has demand info, we optimistically give CPR info or RetCPR to all args
-resTypeArgDmd TopRes = Top
-resTypeArgDmd RetCPR = Top
-resTypeArgDmd BotRes = Bot
-
-returnsCPR :: DmdResult -> Bool
-returnsCPR RetCPR = True
-returnsCPR _      = False
-
-mkDmdType :: DmdEnv -> [Demand] -> DmdResult -> DmdType
-mkDmdType fv ds res = DmdType fv ds res
-
-mkTopDmdType :: [Demand] -> DmdResult -> DmdType
-mkTopDmdType ds res = DmdType emptyDmdEnv ds res
-
-dmdTypeDepth :: DmdType -> Arity
-dmdTypeDepth (DmdType _ ds _) = length ds
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Strictness signature
-%*									*
-%************************************************************************
-
-In a let-bound Id we record its strictness info.  
-In principle, this strictness info is a demand transformer, mapping
-a demand on the Id into a DmdType, which gives
-	a) the free vars of the Id's value
-	b) the Id's arguments
-	c) an indication of the result of applying 
-	   the Id to its arguments
-
-However, in fact we store in the Id an extremely emascuated demand transfomer,
-namely 
-		a single DmdType
-(Nevertheless we dignify StrictSig as a distinct type.)
-
-This DmdType gives the demands unleashed by the Id when it is applied
-to as many arguments as are given in by the arg demands in the DmdType.
-
-For example, the demand transformer described by the DmdType
-		DmdType {x -> U(LL)} [V,A] Top
-says that when the function is applied to two arguments, it
-unleashes demand U(LL) on the free var x, V on the first arg,
-and A on the second.  
-
-If this same function is applied to one arg, all we can say is
-that it uses x with U*(LL), and its arg with demand L.
-
-\begin{code}
-newtype StrictSig = StrictSig DmdType
-		  deriving( Eq )
-
-instance Outputable StrictSig where
-   ppr (StrictSig ty) = ppr ty
-
-instance Show StrictSig where
-   show (StrictSig ty) = showSDoc (ppr ty)
-
-mkStrictSig :: DmdType -> StrictSig
-mkStrictSig dmd_ty = StrictSig dmd_ty
-
-splitStrictSig :: StrictSig -> ([Demand], DmdResult)
-splitStrictSig (StrictSig (DmdType _ dmds res)) = (dmds, res)
-
-increaseStrictSigArity :: Int -> StrictSig -> StrictSig
--- Add extra arguments to a strictness signature
-increaseStrictSigArity arity_increase (StrictSig (DmdType env dmds res))
-  = StrictSig (DmdType env (replicate arity_increase topDmd ++ dmds) res)
-
-isTopSig :: StrictSig -> Bool
-isTopSig (StrictSig ty) = isTopDmdType ty
-
-topSig, botSig, cprSig :: StrictSig
-topSig = StrictSig topDmdType
-botSig = StrictSig botDmdType
-cprSig = StrictSig cprDmdType
-	
-
--- appIsBottom returns true if an application to n args would diverge
-appIsBottom :: StrictSig -> Int -> Bool
-appIsBottom (StrictSig (DmdType _ ds BotRes)) n = listLengthCmp ds n /= GT
-appIsBottom _				      _ = False
-
-isBottomingSig :: StrictSig -> Bool
-isBottomingSig (StrictSig (DmdType _ _ BotRes)) = True
-isBottomingSig _				= False
-
-seqStrictSig :: StrictSig -> ()
-seqStrictSig (StrictSig ty) = seqDmdType ty
-
-pprIfaceStrictSig :: StrictSig -> SDoc
--- Used for printing top-level strictness pragmas in interface files
-pprIfaceStrictSig (StrictSig (DmdType _ dmds res))
-  = hcat (map ppr dmds) <> ppr res
-\end{code}
-    
-
diff --git a/compiler/coreSyn/CoreArity.lhs b/compiler/coreSyn/CoreArity.lhs
index 673d619..be34b07 100644
--- a/compiler/coreSyn/CoreArity.lhs
+++ b/compiler/coreSyn/CoreArity.lhs
@@ -17,7 +17,7 @@ module CoreArity (
 import CoreSyn
 import CoreFVs
 import CoreUtils
-import NewDemand
+import Demand
 import TyCon	( isRecursiveTyCon )
 import qualified CoreSubst
 import CoreSubst ( Subst, substBndr, substBndrs, substExpr
@@ -361,7 +361,7 @@ trimArity False  (AT _ ATop) = AT 0 ATop	-- Bale out
 ---------------------------
 arityType :: Bool -> CoreExpr -> ArityType
 arityType _ (Var v)
-  | Just strict_sig <- idNewStrictness_maybe v
+  | Just strict_sig <- idStrictness_maybe v
   , (ds, res) <- splitStrictSig strict_sig
   , isBotRes res
   = AT (length ds) ABot	-- Function diverges
diff --git a/compiler/coreSyn/CoreLint.lhs b/compiler/coreSyn/CoreLint.lhs
index d6cdad8..4893885 100644
--- a/compiler/coreSyn/CoreLint.lhs
+++ b/compiler/coreSyn/CoreLint.lhs
@@ -11,7 +11,7 @@ module CoreLint ( lintCoreBindings, lintUnfolding ) where
 
 #include "HsVersions.h"
 
-import NewDemand
+import Demand
 import CoreSyn
 import CoreFVs
 import CoreUtils
@@ -204,7 +204,7 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs)
  	-- the unfolding is a SimplifiableCoreExpr. Give up for now.
    where
     binder_ty                  = idType binder
-    maybeDmdTy                 = idNewStrictness_maybe binder
+    maybeDmdTy                 = idStrictness_maybe binder
     bndr_vars                  = varSetElems (idFreeVars binder)
     lintBinder var | isId var  = lintIdBndr var $ \_ -> (return ())
 	           | otherwise = return ()
@@ -1083,7 +1083,7 @@ mkStrictMsg :: Id -> Message
 mkStrictMsg binder
   = vcat [hsep [ptext (sLit "Recursive or top-level binder has strict demand info:"),
 		     ppr binder],
-	      hsep [ptext (sLit "Binder's demand info:"), ppr (idNewDemandInfo binder)]
+	      hsep [ptext (sLit "Binder's demand info:"), ppr (idDemandInfo binder)]
 	     ]
 
 mkArityMsg :: Id -> Message
@@ -1097,7 +1097,7 @@ mkArityMsg binder
 	      hsep [ptext (sLit "Binder's strictness signature:"), ppr dmd_ty]
 
          ]
-           where (StrictSig dmd_ty) = idNewStrictness binder
+           where (StrictSig dmd_ty) = idStrictness binder
 
 mkUnboxedTupleMsg :: Id -> Message
 mkUnboxedTupleMsg binder
diff --git a/compiler/coreSyn/CorePrep.lhs b/compiler/coreSyn/CorePrep.lhs
index 36b6f5c..738bf82 100644
--- a/compiler/coreSyn/CorePrep.lhs
+++ b/compiler/coreSyn/CorePrep.lhs
@@ -20,7 +20,7 @@ import CoreSyn
 import Type
 import Coercion
 import TyCon
-import NewDemand
+import Demand
 import Var
 import VarSet
 import VarEnv
@@ -244,7 +244,7 @@ cpeBind :: TopLevelFlag
 	-> UniqSM (CorePrepEnv, Floats)
 cpeBind top_lvl env (NonRec bndr rhs)
   = do { (_, bndr1) <- cloneBndr env bndr
-       ; let is_strict   = isStrictDmd (idNewDemandInfo bndr)
+       ; let is_strict   = isStrictDmd (idDemandInfo bndr)
              is_unlifted = isUnLiftedType (idType bndr)
        ; (floats, bndr2, rhs2) <- cpePair top_lvl NonRecursive 
        	 	  	       	  	  (is_strict || is_unlifted) 
@@ -497,7 +497,7 @@ cpeApp env expr
            ; let v2 = lookupCorePrepEnv env v1
            ; return (Var v2, (Var v2, depth), idType v2, emptyFloats, stricts) }
 	where
-	  stricts = case idNewStrictness v of
+	  stricts = case idStrictness v of
 			StrictSig (DmdType _ demands _)
 			    | listLengthCmp demands depth /= GT -> demands
 			            -- length demands <= depth
diff --git a/compiler/coreSyn/CoreTidy.lhs b/compiler/coreSyn/CoreTidy.lhs
index f634197..b77186e 100644
--- a/compiler/coreSyn/CoreTidy.lhs
+++ b/compiler/coreSyn/CoreTidy.lhs
@@ -155,8 +155,8 @@ tidyLetBndr env (id,rhs)
     idinfo   = idInfo id
     new_info = idInfo new_id
 		`setArityInfo`		exprArity rhs
-		`setAllStrictnessInfo`	newStrictnessInfo idinfo
-		`setNewDemandInfo`	newDemandInfo idinfo
+		`setStrictnessInfo`	strictnessInfo idinfo
+		`setDemandInfo`	demandInfo idinfo
 		`setInlinePragInfo`	inlinePragInfo idinfo
 
     -- Override the env we get back from tidyId with the new IdInfo
diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs
index df2978e..950e37b 100644
--- a/compiler/coreSyn/PprCore.lhs
+++ b/compiler/coreSyn/PprCore.lhs
@@ -17,12 +17,7 @@ import CostCentre
 import Var
 import Id
 import IdInfo
-import NewDemand
-#ifdef OLD_STRICTNESS
-import Id
-import IdInfo
-#endif
-
+import Demand
 import DataCon
 import TyCon
 import Type
@@ -308,7 +303,7 @@ pprIdBndrInfo info
   where
     prag_info = inlinePragInfo info
     occ_info  = occInfo info
-    dmd_info  = newDemandInfo info
+    dmd_info  = demandInfo info
     lbv_info  = lbvarInfo info
 
     has_prag = not (isDefaultInlinePragma prag_info)
@@ -336,7 +331,7 @@ ppIdInfo id info
     [ (True, pp_scope <> ppr (idDetails id))
     , (has_arity,      ptext (sLit "Arity=") <> int arity)
     , (has_caf_info,   ptext (sLit "Caf=") <> ppr caf_info)
-    , (has_strictness, ptext (sLit "Str=") <> pprNewStrictness str_info)
+    , (has_strictness, ptext (sLit "Str=") <> pprStrictness str_info)
     , (has_unf,        ptext (sLit "Unf=") <> ppr unf_info)
     , (not (null rules), ptext (sLit "RULES:") <+> vcat (map pprRule rules))
     ]	-- Inline pragma, occ, demand, lbvar info
@@ -353,7 +348,7 @@ ppIdInfo id info
     caf_info = cafInfo info
     has_caf_info = not (mayHaveCafRefs caf_info)
 
-    str_info = newStrictnessInfo info
+    str_info = strictnessInfo info
     has_strictness = isJust str_info
 
     unf_info = unfoldingInfo info
diff --git a/compiler/cprAnalysis/CprAnalyse.lhs b/compiler/cprAnalysis/CprAnalyse.lhs
deleted file mode 100644
index 14c8017..0000000
--- a/compiler/cprAnalysis/CprAnalyse.lhs
+++ /dev/null
@@ -1,317 +0,0 @@
-% (c) The University of Glasgow 2006
-
-\section[CprAnalyse]{Identify functions that always return a
-constructed product result}
-
-\begin{code}
-#ifndef OLD_STRICTNESS
-module CprAnalyse ( ) where
-
-#else
-
-module CprAnalyse ( cprAnalyse ) where
-
-#include "HsVersions.h"
-
-import DynFlags
-import CoreMonad
-import CoreSyn
-import CoreUtils
-import Id
-import IdInfo
-import Demand
-import VarEnv
-import Util
-import Outputable
-
-import Maybe
-\end{code}
-
-This module performs an analysis of a set of Core Bindings for the
-Constructed Product Result (CPR) transformation.
-
-It detects functions that always explicitly (manifestly?) construct a
-result value with a product type.  A product type is a type which has
-only one constructor. For example, tuples and boxed primitive values
-have product type.
-
-We must also ensure that the function's body starts with sufficient
-manifest lambdas otherwise loss of sharing can occur.  See the comment
-in @StrictAnal.lhs@.
-
-The transformation of bindings to worker/wrapper pairs is done by the
-worker-wrapper pass.  The worker-wrapper pass splits bindings on the
-basis of both strictness and CPR info.  If an id has both then it can
-combine the transformations so that only one pair is produced.
-
-The analysis here detects nested CPR information.  For example, if a
-function returns a constructed pair, the first element of which is a
-constructed int, then the analysis will detect nested CPR information
-for the int as well.  Unfortunately, the current transformations can't
-take advantage of the nested CPR information.  They have (broken now,
-I think) code which will flatten out nested CPR components and rebuild
-them in the wrapper, but enabling this would lose laziness.  It is
-possible to make use of the nested info: if we knew that a caller was
-strict in that position then we could create a specialized version of
-the function which flattened/reconstructed that position.
-
-It is not known whether this optimisation would be worthwhile.
-
-So we generate and carry round nested CPR information, but before
-using this info to guide the creation of workers and wrappers we map
-all components of a CPRInfo to NoCprInfo.
-
-
-Data types
-~~~~~~~~~~
-
-Within this module Id's CPR information is represented by
-``AbsVal''. When adding this information to the Id's pragma info field
-we convert the ``Absval'' to a ``CprInfo'' value.
-
-Abstract domains consist of a `no information' value (Top), a function
-value (Fun) which when applied to an argument returns a new AbsVal
-(note the argument is not used in any way), , for product types, a
-corresponding length tuple (Tuple) of abstract values.  And finally,
-Bot.  Bot is not a proper abstract value but a generic bottom is
-useful for calculating fixpoints and representing divergent
-computations.  Note that we equate Bot and Fun^n Bot (n > 0), and
-likewise for Top.  This saves a lot of delving in types to keep
-everything exactly correct.
-
-Since functions abstract to constant functions we could just
-represent them by the abstract value of their result.  However,  it
-turns out (I know - I tried!) that this requires a lot of type
-manipulation and the code is more straightforward if we represent
-functions by an abstract constant function.
-
-\begin{code}
-data AbsVal = Top                -- Not a constructed product
-
-            | Fun AbsVal         -- A function that takes an argument
-                                 -- and gives AbsVal as result.
-
-            | Tuple              -- A constructed product of values
-
-            | Bot                -- Bot'tom included for convenience
-                                 -- we could use appropriate Tuple Vals
-     deriving (Eq,Show)
-
--- For pretty debugging
-instance Outputable AbsVal where
-  ppr Top       = ptext (sLit "Top")
-  ppr (Fun r)   = ptext (sLit "Fun->") <> (parens.ppr) r
-  ppr Tuple     = ptext (sLit "Tuple ")
-  ppr Bot       = ptext (sLit "Bot")
-
-
--- lub takes the lowest upper bound of two abstract values, standard.
-lub :: AbsVal -> AbsVal -> AbsVal
-lub Bot a = a
-lub a Bot = a
-lub Top a = Top
-lub a Top = Top
-lub Tuple Tuple         = Tuple
-lub (Fun l) (Fun r)     = Fun (lub l r)
-lub l r = panic "CPR Analysis tried to take the lub of a function and a tuple"
-
-
-\end{code}
-
-The environment maps Ids to their abstract CPR value.
-
-\begin{code}
-
-type CPREnv = VarEnv AbsVal
-
-initCPREnv = emptyVarEnv
-
-\end{code}
-
-Programs
-~~~~~~~~
-
-Take a list of core bindings and return a new list with CPR function
-ids decorated with their CprInfo pragmas.
-
-\begin{code}
-
-cprAnalyse :: DynFlags -> [CoreBind] -> IO [CoreBind]
-cprAnalyse dflags binds
-  = do {
-        showPass dflags "Constructed Product analysis" ;
-        let { binds_plus_cpr = do_prog binds } ;
-        endPass dflags "Constructed Product analysis"
-                Opt_D_dump_cpranal binds_plus_cpr []
-        return binds_plus_cpr
-    }
-  where
-    do_prog :: [CoreBind] -> [CoreBind]
-    do_prog binds = snd $ mapAccumL cprAnalBind initCPREnv binds
-\end{code}
-
-The cprAnal functions take binds/expressions and an environment which
-gives CPR info for visible ids and returns a new bind/expression
-with ids decorated with their CPR info.
-
-\begin{code}
--- Return environment extended with info from this binding
-cprAnalBind :: CPREnv -> CoreBind -> (CPREnv, CoreBind)
-cprAnalBind rho (NonRec b e)
-  | isImplicitId b      -- Don't touch the CPR info on constructors, selectors etc
-  = (rho, NonRec b e)
-  | otherwise
-  = (extendVarEnv rho b absval, NonRec b' e')
-  where
-    (e', absval) = cprAnalExpr rho e
-    b' = addIdCprInfo b e' absval
-
-cprAnalBind rho (Rec prs)
-  = (final_rho, Rec (map do_pr prs))
-  where
-    do_pr (b,e) = (b', e')
-                where
-                  b'           = addIdCprInfo b e' absval
-                  (e', absval) = cprAnalExpr final_rho e
-
-        -- When analyzing mutually recursive bindings the iterations to find
-        -- a fixpoint is bounded by the number of bindings in the group.
-        -- for simplicity we just iterate that number of times.
-    final_rho = nTimes (length prs) do_one_pass init_rho
-    init_rho  = rho `extendVarEnvList` [(b,Bot) | (b,e) <- prs]
-
-    do_one_pass :: CPREnv -> CPREnv
-    do_one_pass rho = foldl (\ rho (b,e) -> extendVarEnv rho b (snd (cprAnalExpr rho e)))
-                            rho prs
-
-
-cprAnalExpr :: CPREnv -> CoreExpr -> (CoreExpr, AbsVal)
-
--- If Id will always diverge when given sufficient arguments then
--- we can just set its abs val to Bot.  Any other CPR info
--- from other paths will then dominate,  which is what we want.
--- Check in rho,  if not there it must be imported, so check
--- the var's idinfo.
-cprAnalExpr rho e@(Var v)
-    | isBottomingId v = (e, Bot)
-    | otherwise       = (e, case lookupVarEnv rho v of
-                             Just a_val -> a_val
-                             Nothing    -> getCprAbsVal v)
-
--- Literals are unboxed
-cprAnalExpr rho (Lit l) = (Lit l, Top)
-
--- For apps we don't care about the argument's abs val.  This
--- app will return a constructed product if the function does. We strip
--- a Fun from the functions abs val, unless the argument is a type argument
--- or it is already Top or Bot.
-cprAnalExpr rho (App fun arg@(Type _))
-    = (App fun_cpr arg, fun_res)
-    where
-      (fun_cpr, fun_res)  = cprAnalExpr rho fun
-
-cprAnalExpr rho (App fun arg)
-    = (App fun_cpr arg_cpr, res_res)
-    where
-      (fun_cpr, fun_res)  = cprAnalExpr rho fun
-      (arg_cpr, _)        = cprAnalExpr rho arg
-      res_res             = case fun_res of
-                                Fun res_res -> res_res
-                                Top         -> Top
-                                Bot         -> Bot
-                                Tuple       -> WARN( True, ppr (App fun arg) ) Top
-                                                -- This really should not happen!
-
-
--- Map arguments to Top (we aren't constructing them)
--- Return the abstract value of the body, since functions
--- are represented by the CPR value of their result, and
--- add a Fun for this lambda..
-cprAnalExpr rho (Lam b body) | isTyVar b = (Lam b body_cpr, body_aval)
-                             | otherwise = (Lam b body_cpr, Fun body_aval)
-      where
-      (body_cpr, body_aval) = cprAnalExpr (extendVarEnv rho b Top) body
-
-cprAnalExpr rho (Let bind body)
-    = (Let bind' body', body_aval)
-    where
-      (rho', bind') = cprAnalBind rho bind
-      (body', body_aval) = cprAnalExpr rho' body
-
-cprAnalExpr rho (Case scrut bndr alts)
-    = (Case scrut_cpr bndr alts_cpr, alts_aval)
-      where
-      (scrut_cpr, scrut_aval) = cprAnalExpr rho scrut
-      (alts_cpr, alts_aval) = cprAnalCaseAlts (extendVarEnv rho bndr scrut_aval) alts
-
-cprAnalExpr rho (Note n exp)
-    = (Note n exp_cpr, expr_aval)
-      where
-      (exp_cpr, expr_aval) = cprAnalExpr rho exp
-
-cprAnalExpr rho (Type t)
-    = (Type t, Top)
-
-cprAnalCaseAlts :: CPREnv -> [CoreAlt] -> ([CoreAlt], AbsVal)
-cprAnalCaseAlts rho alts
-    = foldr anal_alt ([], Bot) alts
-      where
-      anal_alt :: CoreAlt -> ([CoreAlt], AbsVal) -> ([CoreAlt], AbsVal)
-      anal_alt (con, binds, exp)  (done, aval)
-          = ((con,binds,exp_cpr) : done, exp_aval `lub` aval)
-            where (exp_cpr, exp_aval) = cprAnalExpr rho' exp
-                  rho' = rho `extendVarEnvList` (zip binds (repeat Top))
-
-
-addIdCprInfo :: Id -> CoreExpr -> AbsVal -> Id
-addIdCprInfo bndr rhs absval
-  | useful_info && ok_to_add = setIdCprInfo bndr cpr_info
-  | otherwise                = bndr
-  where
-    cpr_info    = absToCprInfo absval
-    useful_info = case cpr_info of { ReturnsCPR -> True; NoCPRInfo -> False }
-
-    ok_to_add = case absval of
-                  Fun _ -> idArity bndr >= n_fun_tys absval
-                      -- Enough visible lambdas
-
-                  Tuple  -> exprIsHNF rhs || isStrict (idDemandInfo bndr)
-                        -- If the rhs is a value, and returns a constructed product,
-                        -- it will be inlined at usage sites, so we give it a Tuple absval
-                        -- If it isn't a value, we won't inline it (code/work dup worries), so
-                        -- we discard its absval.
-                        --
-                        -- Also, if the strictness analyser has figured out that it's strict,
-                        -- the let-to-case transformation will happen, so again it's good.
-                        -- (CPR analysis runs before the simplifier has had a chance to do
-                        --  the let-to-case transform.)
-                        -- This made a big difference to PrelBase.modInt, which had something like
-                        --      modInt = \ x -> let r = ... -> I# v in
-                        --                      ...body strict in r...
-                        -- r's RHS isn't a value yet; but modInt returns r in various branches, so
-                        -- if r doesn't have the CPR property then neither does modInt
-
-                  _ -> False
-
-    n_fun_tys :: AbsVal -> Int
-    n_fun_tys (Fun av) = 1 + n_fun_tys av
-    n_fun_tys other    = 0
-
-
-absToCprInfo :: AbsVal -> CprInfo
-absToCprInfo Tuple   = ReturnsCPR
-absToCprInfo (Fun r) = absToCprInfo r
-absToCprInfo _       = NoCPRInfo
-
-
--- Cpr Info doesn't store the number of arguments a function has,  so the caller
--- must take care to add the appropriate number of Funs.
-getCprAbsVal v = case idCprInfo v of
-                        NoCPRInfo -> Top
-                        ReturnsCPR -> nTimes arity Fun Tuple
-               where
-                 arity = idArity v
-        -- Imported (non-nullary) constructors will have the CPR property
-        -- in their IdInfo, so no need to look at their unfolding
-#endif /* OLD_STRICTNESS */
-\end{code}
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index c51405c..582534a 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -162,7 +162,6 @@ Library
         Name
         NameEnv
         NameSet
-        NewDemand
         OccName
         RdrName
         SrcLoc
@@ -266,7 +265,6 @@ Library
         MkExternalCore
         PprCore
         PprExternalCore
-        CprAnalyse
         Check
         Coverage
         Desugar
@@ -374,9 +372,6 @@ Library
         StgLint
         StgSyn
         DmdAnal
-        SaAbsInt
-        SaLib
-        StrictAnal
         WorkWrap
         WwLib
         FamInst
diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index ce023d7..beb39c0 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -17,7 +17,7 @@ import TcRnMonad
 import IfaceEnv
 import HscTypes
 import BasicTypes
-import NewDemand
+import Demand
 import Annotations
 import IfaceSyn
 import Module
@@ -335,7 +335,7 @@ data BinDictionary = BinDictionary {
 {-! for StrictnessMark derive: Binary !-}
 {-! for Activation derive: Binary !-}
 
--- NewDemand
+-- Demand
 {-! for Demand derive: Binary !-}
 {-! for Demands derive: Binary !-}
 {-! for DmdResult derive: Binary !-}
diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 4311e65..be68afe 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -28,7 +28,7 @@ module IfaceSyn (
 
 import IfaceType
 
-import NewDemand
+import Demand
 import Annotations
 import Class
 import NameSet 
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 4da21d8..f271aa5 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -54,7 +54,7 @@ import IfaceSyn
 import LoadIface
 import Id
 import IdInfo
-import NewDemand
+import Demand
 import Annotations
 import CoreSyn
 import CoreFVs
@@ -1466,7 +1466,7 @@ toIfaceIdInfo id_info
 
     ------------  Strictness  --------------
 	-- No point in explicitly exporting TopSig
-    strict_hsinfo = case newStrictnessInfo id_info of
+    strict_hsinfo = case strictnessInfo id_info of
 			Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
 			_other			      -> Nothing
 
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index e1588a1..cecfc0b 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -990,7 +990,7 @@ tcIdInfo ignore_prags name ty info
     tcPrag :: IdInfo -> IfaceInfoItem -> IfL IdInfo
     tcPrag info HsNoCafRefs        = return (info `setCafInfo`   NoCafRefs)
     tcPrag info (HsArity arity)    = return (info `setArityInfo` arity)
-    tcPrag info (HsStrictness str) = return (info `setAllStrictnessInfo` Just str)
+    tcPrag info (HsStrictness str) = return (info `setStrictnessInfo` Just str)
     tcPrag info (HsInline prag)    = return (info `setInlinePragInfo` prag)
 
 	-- The next two are lazy, so they don't transitively suck stuff in
@@ -1034,7 +1034,7 @@ tcUnfolding name ty info (IfWrapper arity wkr)
 
     	-- We are relying here on strictness info always appearing 
 	-- before worker info,  fingers crossed ....
-    strict_sig = case newStrictnessInfo info of
+    strict_sig = case strictnessInfo info of
 		   Just sig -> sig
 		   Nothing  -> pprPanic "Worker info but no strictness for" (ppr wkr)
 
@@ -1219,7 +1219,7 @@ tcIfaceLetBndr (IfLetBndr fs ty info)
     tc_info [] = vanillaIdInfo
     tc_info (HsInline p     : i) = tc_info i `setInlinePragInfo` p 
     tc_info (HsArity a      : i) = tc_info i `setArityInfo` a 
-    tc_info (HsStrictness s : i) = tc_info i `setAllStrictnessInfo` Just s 
+    tc_info (HsStrictness s : i) = tc_info i `setStrictnessInfo` Just s 
     tc_info (other          : i) = pprTrace "tcIfaceLetBndr: discarding unexpected IdInfo" 
 					    (ppr other) (tc_info i)
 
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 10ab3d0..9e61b28 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -1180,10 +1180,6 @@ getCoreToDo dflags
                 -- Don't stop now!
         simpl_phase 0 ["main"] (max max_iter 3),
 
-
-#ifdef OLD_STRICTNESS
-        CoreDoOldStrictness,
-#endif
         runWhen strictness (CoreDoPasses [
                 CoreDoStrictness,
                 CoreDoWorkerWrapper,
diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index ffe0eca..8f3a520 100644
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -26,7 +26,7 @@ import Var
 import Id
 import IdInfo
 import InstEnv
-import NewDemand
+import Demand
 import BasicTypes
 import Name hiding (varName)
 import NameSet
@@ -686,7 +686,7 @@ addExternal expose_all id = (new_needed_ids, show_unfold)
     idinfo	   = idInfo id
     dont_inline	   = isNeverActive (inlinePragmaActivation (inlinePragInfo idinfo))
     loop_breaker   = isNonRuleLoopBreaker (occInfo idinfo)
-    bottoming_fn   = isBottomingSig (newStrictnessInfo idinfo `orElse` topSig)
+    bottoming_fn   = isBottomingSig (strictnessInfo idinfo `orElse` topSig)
     spec_ids	   = specInfoFreeVars (specInfo idinfo)
 
 	-- Stuff to do with the Id's unfolding
@@ -983,7 +983,7 @@ tidyTopPair show_unfold rhs_tidy_env caf_info name' (bndr, rhs)
                         Nothing         -> True
                         Just (arity, _) -> appIsBottom str arity
         where
-          str = newStrictnessInfo idinfo `orElse` topSig
+          str = strictnessInfo idinfo `orElse` topSig
 
     bndr1   = mkGlobalId details name' ty' idinfo'
     details = idDetails bndr	-- Preserve the IdDetails
@@ -1043,14 +1043,14 @@ tidyTopIdInfo is_external idinfo unfold_info arity caf_info occ_info
         `setOccInfo`           robust_occ_info
 	`setCafInfo` 	       caf_info
 	`setArityInfo`	       arity
-	`setAllStrictnessInfo` newStrictnessInfo idinfo
+	`setStrictnessInfo` strictnessInfo idinfo
 
   | otherwise		-- Externally-visible Ids get the whole lot
   = vanillaIdInfo
         `setOccInfo`           robust_occ_info
 	`setCafInfo` 	       caf_info
 	`setArityInfo`	       arity
-	`setAllStrictnessInfo` newStrictnessInfo idinfo
+	`setStrictnessInfo` strictnessInfo idinfo
 	`setInlinePragInfo`    inlinePragInfo idinfo
 	`setUnfoldingInfo`     unfold_info
 		-- NB: we throw away the Rules
diff --git a/compiler/prelude/PrimOp.lhs b/compiler/prelude/PrimOp.lhs
index a9a8fa2..4ac1577 100644
--- a/compiler/prelude/PrimOp.lhs
+++ b/compiler/prelude/PrimOp.lhs
@@ -31,7 +31,7 @@ module PrimOp (
 import TysPrim
 import TysWiredIn
 
-import NewDemand
+import Demand
 import Var		( TyVar )
 import OccName		( OccName, pprOccName, mkVarOccFS )
 import TyCon		( TyCon, isPrimTyCon, tyConPrimRep, PrimRep(..) )
diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs
index c9b0601..c7ce066 100644
--- a/compiler/simplCore/SetLevels.lhs
+++ b/compiler/simplCore/SetLevels.lhs
@@ -64,7 +64,7 @@ import CoreSubst	( Subst, emptySubst, extendInScope, extendInScopeList,
 import Id		( idType, mkSysLocal, isOneShotLambda,
 			  zapDemandIdInfo, transferPolyIdInfo,
 			  idSpecialisation, idUnfolding, setIdInfo, 
-			  setIdNewStrictness, setIdArity
+			  setIdStrictness, setIdArity
 			)
 import IdInfo
 import Var
@@ -398,7 +398,7 @@ lvlMFE strict_ctxt ctxt_lvl env ann_expr@(fvs, _)
 		-- Note [Bottoming floats]
        let var_w_str = case exprBotStrictness_maybe expr of
 			  Just (arity,str) -> var `setIdArity` arity
-						  `setIdNewStrictness` str
+						  `setIdStrictness` str
 			  Nothing  -> var
        return (Let (NonRec (TB var_w_str dest_lvl) expr') 
                    (mkVarApps (Var var_w_str) abs_vars))
diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs
index df928f6..beb1ed0 100644
--- a/compiler/simplCore/SimplCore.lhs
+++ b/compiler/simplCore/SimplCore.lhs
@@ -55,10 +55,6 @@ import Specialise	( specProgram)
 import SpecConstr	( specConstrProgram)
 import DmdAnal		( dmdAnalPgm )
 import WorkWrap	        ( wwTopBinds )
-#ifdef OLD_STRICTNESS
-import StrictAnal	( saBinds )
-import CprAnalyse       ( cprAnalyse )
-#endif
 import Vectorise        ( vectorise )
 import FastString
 import Util
@@ -190,24 +186,8 @@ doCorePass CoreDoGlomBinds              = dontDescribePass $ doPassDM  glomBinds
 doCorePass CoreDoPrintCore              = dontDescribePass $ observe   printCore
 doCorePass (CoreDoRuleCheck phase pat)  = dontDescribePass $ ruleCheck phase pat
 
-#ifdef OLD_STRICTNESS
-doCorePass CoreDoOldStrictness          = {-# SCC "OldStrictness" #-} doOldStrictness
-#endif
-
 doCorePass CoreDoNothing                = return
 doCorePass (CoreDoPasses passes)        = doCorePasses passes
-
-#ifdef OLD_STRICTNESS
-doOldStrictness :: ModGuts -> CoreM ModGuts
-doOldStrictness guts
-  = do dfs <- getDynFlags
-       guts'  <- describePass "Strictness analysis" Opt_D_dump_stranal $ 
-                 doPassM (saBinds dfs) guts
-       guts'' <- describePass "Constructed Product analysis" Opt_D_dump_cpranal $ 
-                 doPass cprAnalyse guts'
-       return guts''
-#endif
-
 \end{code}
 
 %************************************************************************
@@ -844,7 +824,7 @@ transferIdInfo exported_id local_id
   = modifyIdInfo transfer exported_id
   where
     local_info = idInfo local_id
-    transfer exp_info = exp_info `setNewStrictnessInfo` newStrictnessInfo local_info
+    transfer exp_info = exp_info `setStrictnessInfo` strictnessInfo local_info
 				 `setUnfoldingInfo`     unfoldingInfo local_info
 				 `setInlinePragInfo`	inlinePragInfo local_info
 				 `setSpecInfo`	        addSpecInfo (specInfo exp_info) new_info
diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs
index 972c0e5..87db9a8 100644
--- a/compiler/simplCore/SimplUtils.lhs
+++ b/compiler/simplCore/SimplUtils.lhs
@@ -40,7 +40,7 @@ import CoreUnfold
 import Name
 import Id
 import Var	( isCoVar )
-import NewDemand
+import Demand
 import SimplMonad
 import Type	hiding( substTy )
 import Coercion ( coercionKind )
@@ -342,7 +342,7 @@ mkArgInfo fun rules n_val_args call_cont
     vanilla_stricts  = repeat False
 
     arg_stricts
-      = case splitStrictSig (idNewStrictness fun) of
+      = case splitStrictSig (idStrictness fun) of
 	  (demands, result_info)
 		| not (demands `lengthExceeds` n_val_args)
 		-> 	-- Enough args, use the strictness given.
diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index eb2884c..875061d 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -23,7 +23,7 @@ import Coercion
 import FamInstEnv       ( topNormaliseType )
 import DataCon          ( DataCon, dataConWorkId, dataConRepStrictness )
 import CoreSyn
-import NewDemand        ( isStrictDmd, splitStrictSig )
+import Demand           ( isStrictDmd, splitStrictSig )
 import PprCore          ( pprParendExpr, pprCoreExpr )
 import CoreUnfold       ( mkUnfolding, mkCoreUnfolding, mkInlineRule, 
                           exprIsConApp_maybe, callSiteInline, CallCtxt(..) )
@@ -442,8 +442,8 @@ prepareRhs env id (Cast rhs co)    -- Note [Float coercions]
   = do  { (env', rhs') <- makeTrivialWithInfo env sanitised_info rhs
         ; return (env', Cast rhs' co) }
   where
-    sanitised_info = vanillaIdInfo `setNewStrictnessInfo` newStrictnessInfo info
-                                   `setNewDemandInfo`     newDemandInfo info
+    sanitised_info = vanillaIdInfo `setStrictnessInfo` strictnessInfo info
+                                   `setDemandInfo`     demandInfo info
     info = idInfo id
 
 prepareRhs env0 _ rhs0
@@ -644,7 +644,7 @@ addNonRecWithUnf env new_bndr new_rhs new_unfolding
               | otherwise                      = info2
 
         final_id = new_bndr `setIdInfo` info3
-	dmd_arity = length $ fst $ splitStrictSig $ idNewStrictness new_bndr
+	dmd_arity = length $ fst $ splitStrictSig $ idStrictness new_bndr
     in
     ASSERT( isId new_bndr )
     WARN( new_arity < old_arity || new_arity < dmd_arity, 
@@ -1468,7 +1468,7 @@ rebuildCase env scrut case_bndr [(_, bndrs, rhs)] cont
   where
         -- The case binder is going to be evaluated later,
         -- and the scrutinee is a simple variable
-    var_demanded_later (Var v) = isStrictDmd (idNewDemandInfo case_bndr)
+    var_demanded_later (Var v) = isStrictDmd (idDemandInfo case_bndr)
                                  && not (isTickBoxOp v)
                                     -- ugly hack; covering this case is what
                                     -- exprOkForSpeculation was intended for.
diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs
index c545fad..5606830 100644
--- a/compiler/specialise/SpecConstr.lhs
+++ b/compiler/specialise/SpecConstr.lhs
@@ -41,7 +41,7 @@ import StaticFlags	( opt_PprStyle_Debug )
 import StaticFlags	( opt_SpecInlineJoinPoints )
 import BasicTypes	( Activation(..) )
 import Maybes		( orElse, catMaybes, isJust, isNothing )
-import NewDemand
+import Demand
 import DmdAnal		( both )
 import Serialized       ( deserializeWithData )
 import Util
@@ -1162,7 +1162,7 @@ spec_one env fn arg_bndrs body (call_pat@(qvars, pats), rule_number)
 	      spec_rhs  = mkLams spec_lam_args spec_body
 	      spec_str  = calcSpecStrictness fn spec_lam_args pats
 	      spec_id   = mkUserLocal spec_occ spec_uniq (mkPiTypes spec_lam_args body_ty) fn_loc
-	      		    `setIdNewStrictness` spec_str    	-- See Note [Transfer strictness]
+	      		    `setIdStrictness` spec_str    	-- See Note [Transfer strictness]
 			    `setIdArity` count isId spec_lam_args
 	      body_ty   = exprType spec_body
 	      rule_rhs  = mkVarApps (Var spec_id) spec_call_args
@@ -1177,7 +1177,7 @@ calcSpecStrictness fn qvars pats
   = StrictSig (mkTopDmdType spec_dmds TopRes)
   where
     spec_dmds = [ lookupVarEnv dmd_env qv `orElse` lazyDmd | qv <- qvars, isId qv ]
-    StrictSig (DmdType _ dmds _) = idNewStrictness fn
+    StrictSig (DmdType _ dmds _) = idStrictness fn
 
     dmd_env = go emptyVarEnv dmds pats
 
diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs
index 789e77a..2414aea 100644
--- a/compiler/stranal/DmdAnal.lhs
+++ b/compiler/stranal/DmdAnal.lhs
@@ -22,7 +22,7 @@ module DmdAnal ( dmdAnalPgm, dmdAnalTopRhs,
 
 import DynFlags		( DynFlags, DynFlag(..) )
 import StaticFlags	( opt_MaxWorkerArgs )
-import NewDemand	-- All of it
+import Demand	-- All of it
 import CoreSyn
 import PprCore	
 import CoreUtils	( exprIsHNF, exprIsTrivial )
@@ -31,17 +31,11 @@ import DataCon		( dataConTyCon )
 import TyCon		( isProductTyCon, isRecursiveTyCon )
 import Id		( Id, idType, idInlineActivation,
 			  isDataConWorkId, isGlobalId, idArity,
-#ifdef OLD_STRICTNESS
-			  idDemandInfo,  idStrictness, idCprInfo, idName,
-#endif
-			  idNewStrictness, idNewStrictness_maybe,
-			  setIdNewStrictness, idNewDemandInfo,
-			  idNewDemandInfo_maybe,
-			  setIdNewDemandInfo
+			  idStrictness, idStrictness_maybe,
+			  setIdStrictness, idDemandInfo,
+			  idDemandInfo_maybe,
+			  setIdDemandInfo
 			)
-#ifdef OLD_STRICTNESS
-import IdInfo 		( newStrictnessFromOld, newDemand )
-#endif
 import Var		( Var )
 import VarEnv
 import TysWiredIn	( unboxedPairDataCon )
@@ -79,12 +73,6 @@ dmdAnalPgm :: DynFlags -> [CoreBind] -> IO [CoreBind]
 dmdAnalPgm dflags binds
   = do {
 	let { binds_plus_dmds = do_prog binds } ;
-#ifdef OLD_STRICTNESS
-	-- Only if OLD_STRICTNESS is on, because only then is the old
-	-- strictness analyser run
-	let { dmd_changes = get_changes binds_plus_dmds } ;
-	printDump (text "Changes in demands" $$ dmd_changes) ;
-#endif
 	return binds_plus_dmds
     }
   where
@@ -257,7 +245,7 @@ dmdAnal sigs dmd (Case scrut case_bndr ty [alt@(DataAlt dc,bndrs,rhs)])
 	--	x = (a, absent-error)
 	-- and that'll crash.
 	-- So at one stage I had:
-	--	dead_case_bndr		 = isAbsentDmd (idNewDemandInfo case_bndr')
+	--	dead_case_bndr		 = isAbsentDmd (idDemandInfo case_bndr')
 	--	keepity | dead_case_bndr = Drop
 	--		| otherwise	 = Keep		
 	--
@@ -268,9 +256,9 @@ dmdAnal sigs dmd (Case scrut case_bndr ty [alt@(DataAlt dc,bndrs,rhs)])
 	-- The insight is, of course, that a demand on y is a demand on the
 	-- scrutinee, so we need to `both` it with the scrut demand
 
-	alt_dmd 	   = Eval (Prod [idNewDemandInfo b | b <- bndrs', isId b])
+	alt_dmd 	   = Eval (Prod [idDemandInfo b | b <- bndrs', isId b])
         scrut_dmd 	   = alt_dmd `both`
-			     idNewDemandInfo case_bndr'
+			     idDemandInfo case_bndr'
 
 	(scrut_ty, scrut') = dmdAnal sigs scrut_dmd scrut
     in
@@ -425,7 +413,7 @@ dmdFix top_lvl sigs orig_pairs
 	-- of the fixpoint algorithm.  (Cunning plan.)
 	-- Note that the cunning plan extends to the DmdEnv too,
 	-- since it is part of the strictness signature
-initialSig id = idNewStrictness_maybe id `orElse` botSig
+initialSig id = idStrictness_maybe id `orElse` botSig
 
 dmdAnalRhs :: TopLevelFlag -> RecFlag
 	-> SigEnv -> (Id, CoreExpr)
@@ -443,7 +431,7 @@ dmdAnalRhs top_lvl rec_flag sigs (id, rhs)
 				-- The RHS can be eta-reduced to just a variable, 
 				-- in which case we should not complain. 
 		       mkSigTy top_lvl rec_flag id rhs rhs_dmd_ty
-  id'		     = id `setIdNewStrictness` sig_ty
+  id'		     = id `setIdStrictness` sig_ty
   sigs'		     = extendSigEnv top_lvl sigs id sig_ty
 \end{code}
 
@@ -464,7 +452,7 @@ mkSigTy top_lvl rec_flag id rhs dmd_ty
   = mk_sig_ty never_inline thunk_cpr_ok rhs dmd_ty
   where
     never_inline = isNeverActive (idInlineActivation id)
-    maybe_id_dmd = idNewDemandInfo_maybe id
+    maybe_id_dmd = idDemandInfo_maybe id
 	-- Is Nothing the first time round
 
     thunk_cpr_ok
@@ -734,7 +722,7 @@ annotateBndr :: DmdType -> Var -> (DmdType, Var)
 -- No effect on the argument demands
 annotateBndr dmd_ty@(DmdType fv ds res) var
   | isTyVar var = (dmd_ty, var)
-  | otherwise   = (DmdType fv' ds res, setIdNewDemandInfo var dmd)
+  | otherwise   = (DmdType fv' ds res, setIdDemandInfo var dmd)
   where
     (fv', dmd) = removeFV fv var res
 
@@ -749,7 +737,7 @@ annotateLamIdBndr dmd_ty@(DmdType fv ds res) id
 -- For lambdas we add the demand to the argument demands
 -- Only called for Ids
   = ASSERT( isId id )
-    (DmdType fv' (hacked_dmd:ds) res, setIdNewDemandInfo id hacked_dmd)
+    (DmdType fv' (hacked_dmd:ds) res, setIdDemandInfo id hacked_dmd)
   where
     (fv', dmd) = removeFV fv id res
     hacked_dmd = argDemand dmd
@@ -815,7 +803,7 @@ extendSigsWithLam :: SigEnv -> Id -> SigEnv
 -- CPR results (e.g. from \x -> x!).
 
 extendSigsWithLam sigs id
-  = case idNewDemandInfo_maybe id of
+  = case idDemandInfo_maybe id of
 	Nothing	              -> extendVarEnv sigs id (cprSig, NotTopLevel)
 		-- Optimistic in the Nothing case;
 		-- See notes [CPR-AND-STRICTNESS]
@@ -835,7 +823,7 @@ dmdTransform sigs var dmd
 ------ 	DATA CONSTRUCTOR
   | isDataConWorkId var		-- Data constructor
   = let 
-	StrictSig dmd_ty    = idNewStrictness var	-- It must have a strictness sig
+	StrictSig dmd_ty    = idStrictness var	-- It must have a strictness sig
 	DmdType _ _ con_res = dmd_ty
 	arity		    = idArity var
     in
@@ -866,7 +854,7 @@ dmdTransform sigs var dmd
 
 ------ 	IMPORTED FUNCTION
   | isGlobalId var,		-- Imported function
-    let StrictSig dmd_ty = idNewStrictness var
+    let StrictSig dmd_ty = idStrictness var
   = if dmdTypeDepth dmd_ty <= call_depth then	-- Saturated, so unleash the demand
 	dmd_ty
     else
@@ -1146,88 +1134,3 @@ both d1@(Defer ds1) d2	     = d2 `both` d1
  
 boths ds1 ds2 = zipWithDmds both ds1 ds2
 \end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection{Miscellaneous
-%*									*
-%************************************************************************
-
-
-\begin{code}
-#ifdef OLD_STRICTNESS
-get_changes binds = vcat (map get_changes_bind binds)
-
-get_changes_bind (Rec pairs) = vcat (map get_changes_pr pairs)
-get_changes_bind (NonRec id rhs) = get_changes_pr (id,rhs)
-
-get_changes_pr (id,rhs) 
-  = get_changes_var id $$ get_changes_expr rhs
-
-get_changes_var var
-  | isId var  = get_changes_str var $$ get_changes_dmd var
-  | otherwise = empty
-
-get_changes_expr (Type t)     = empty
-get_changes_expr (Var v)      = empty
-get_changes_expr (Lit l)      = empty
-get_changes_expr (Note n e)   = get_changes_expr e
-get_changes_expr (App e1 e2)  = get_changes_expr e1 $$ get_changes_expr e2
-get_changes_expr (Lam b e)    = {- get_changes_var b $$ -} get_changes_expr e
-get_changes_expr (Let b e)    = get_changes_bind b $$ get_changes_expr e
-get_changes_expr (Case e b a) = get_changes_expr e $$ {- get_changes_var b $$ -} vcat (map get_changes_alt a)
-
-get_changes_alt (con,bs,rhs) = {- vcat (map get_changes_var bs) $$ -} get_changes_expr rhs
-
-get_changes_str id
-  | new_better && old_better = empty
-  | new_better	       	     = message "BETTER"
-  | old_better	       	     = message "WORSE"
-  | otherwise	       	     = message "INCOMPARABLE" 
-  where
-    message word = text word <+> text "strictness for" <+> ppr id <+> info
-    info = (text "Old" <+> ppr old) $$ (text "New" <+> ppr new)
-    new = squashSig (idNewStrictness id)	-- Don't report spurious diffs that the old
-						-- strictness analyser can't track
-    old = newStrictnessFromOld (idName id) (idArity id) (idStrictness id) (idCprInfo id)
-    old_better = old `betterStrictness` new
-    new_better = new `betterStrictness` old
-
-get_changes_dmd id
-  | isUnLiftedType (idType id) = empty	-- Not useful
-  | new_better && old_better = empty
-  | new_better	       	     = message "BETTER"
-  | old_better	       	     = message "WORSE"
-  | otherwise	       	     = message "INCOMPARABLE" 
-  where
-    message word = text word <+> text "demand for" <+> ppr id <+> info
-    info = (text "Old" <+> ppr old) $$ (text "New" <+> ppr new)
-    new = squashDmd (argDemand (idNewDemandInfo id))	-- To avoid spurious improvements
-							-- A bit of a hack
-    old = newDemand (idDemandInfo id)
-    new_better = new `betterDemand` old 
-    old_better = old `betterDemand` new
-
-betterStrictness :: StrictSig -> StrictSig -> Bool
-betterStrictness (StrictSig t1) (StrictSig t2) = betterDmdType t1 t2
-
-betterDmdType t1 t2 = (t1 `lubType` t2) == t2
-
-betterDemand :: Demand -> Demand -> Bool
--- If d1 `better` d2, and d2 `better` d2, then d1==d2
-betterDemand d1 d2 = (d1 `lub` d2) == d2
-
-squashSig (StrictSig (DmdType fv ds res))
-  = StrictSig (DmdType emptyDmdEnv (map squashDmd ds) res)
-  where
-	-- squash just gets rid of call demands
-	-- which the old analyser doesn't track
-squashDmd (Call d)   = evalDmd
-squashDmd (Box d)    = Box (squashDmd d)
-squashDmd (Eval ds)  = Eval (mapDmds squashDmd ds)
-squashDmd (Defer ds) = Defer (mapDmds squashDmd ds)
-squashDmd d          = d
-#endif
-\end{code}
diff --git a/compiler/stranal/SaAbsInt.lhs b/compiler/stranal/SaAbsInt.lhs
deleted file mode 100644
index 1fd3bb1..0000000
--- a/compiler/stranal/SaAbsInt.lhs
+++ /dev/null
@@ -1,932 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-%
-\section[SaAbsInt]{Abstract interpreter for strictness analysis}
-
-\begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
-#ifndef OLD_STRICTNESS
--- If OLD_STRICTNESS is off, omit all exports 
-module SaAbsInt () where
-
-#else
-module SaAbsInt (
-	findStrictness,
-	findDemand, findDemandAlts,
-	absEval,
-	widen,
-	fixpoint,
-	isBot
-    ) where
-
-#include "HsVersions.h"
-
-import StaticFlags	( opt_AllStrict, opt_NumbersStrict )
-import CoreSyn
-import CoreUnfold	( maybeUnfoldingTemplate )
-import Id		( Id, idType, idUnfolding, isDataConWorkId_maybe,
-			  idStrictness,
-			)
-import DataCon		( dataConTyCon, splitProductType_maybe, dataConRepArgTys )
-import IdInfo		( StrictnessInfo(..) )
-import Demand		( Demand(..), wwPrim, wwStrict, wwUnpack, wwLazy,
-			  mkStrictnessInfo, isLazy
-			)
-import SaLib
-import TyCon		( isProductTyCon, isRecursiveTyCon )
-import Type		( splitTyConApp_maybe, 
-		          isUnLiftedType, Type )
-import TyCon		( tyConUnique )
-import PrelInfo		( numericTyKeys )
-import Util		( isIn, nOfThem, zipWithEqual, equalLength )
-import Outputable	
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[AbsVal-ops]{Operations on @AbsVals@}
-%*									*
-%************************************************************************
-
-Least upper bound, greatest lower bound.
-
-\begin{code}
-lub, glb :: AbsVal -> AbsVal -> AbsVal
-
-lub AbsBot val2   = val2	
-lub val1   AbsBot = val1	
-
-lub (AbsProd xs) (AbsProd ys) = AbsProd (zipWithEqual "lub" lub xs ys)
-
-lub _		  _	      = AbsTop	-- Crude, but conservative
-					-- The crudity only shows up if there
-					-- are functions involved
-
--- Slightly funny glb; for absence analysis only;
--- AbsBot is the safe answer.
---
--- Using anyBot rather than just testing for AbsBot is important.
--- Consider:
---
---   f = \a b -> ...
---
---   g = \x y z -> case x of
---	  	     []     -> f x
---		     (p:ps) -> f p
---
--- Now, the abstract value of the branches of the case will be an
--- AbsFun, but when testing for z's absence we want to spot that it's
--- an AbsFun which can't possibly return AbsBot.  So when glb'ing we
--- mustn't be too keen to bale out and return AbsBot; the anyBot test
--- spots that (f x) can't possibly return AbsBot.
-
--- We have also tripped over the following interesting case:
---	case x of
---	  []     -> \y -> 1
---        (p:ps) -> f
---
--- Now, suppose f is bound to AbsTop.  Does this expression mention z?
--- Obviously not.  But the case will take the glb of AbsTop (for f) and
--- an AbsFun (for \y->1). We should not bale out and give AbsBot, because
--- that would say that it *does* mention z (or anything else for that matter).
--- Nor can we always return AbsTop, because the AbsFun might be something
--- like (\y->z), which obviously does mention z. The point is that we're
--- glbing two functions, and AbsTop is not actually the top of the function
--- lattice.  It is more like (\xyz -> x|y|z); that is, AbsTop returns
--- poison iff any of its arguments do.
-
--- Deal with functions specially, because AbsTop isn't the
--- top of their domain.
-
-glb v1 v2
-  | is_fun v1 || is_fun v2
-  = if not (anyBot v1) && not (anyBot v2)
-    then
-	AbsTop
-    else
-	AbsBot
-  where
-    is_fun (AbsFun _ _)       = True
-    is_fun (AbsApproxFun _ _) = True	-- Not used, but the glb works ok
-    is_fun other              = False
-
--- The non-functional cases are quite straightforward
-
-glb (AbsProd xs) (AbsProd ys) = AbsProd (zipWithEqual "glb" glb xs ys)
-
-glb AbsTop	 v2	      = v2
-glb v1           AbsTop	      = v1
-
-glb _            _            = AbsBot 		-- Be pessimistic
-\end{code}
-
-@isBot@ returns True if its argument is (a representation of) bottom.  The
-``representation'' part is because we need to detect the bottom {\em function}
-too.  To detect the bottom function, bind its args to top, and see if it
-returns bottom.
-
-Used only in strictness analysis:
-\begin{code}
-isBot :: AbsVal -> Bool
-
-isBot AbsBot = True
-isBot other  = False	-- Functions aren't bottom any more
-\end{code}
-
-Used only in absence analysis:
-
-\begin{code}
-anyBot :: AbsVal -> Bool
-
-anyBot AbsBot 		       = True	-- poisoned!
-anyBot AbsTop 		       = False
-anyBot (AbsProd vals) 	       = any anyBot vals
-anyBot (AbsFun bndr_ty abs_fn) = anyBot (abs_fn AbsTop)
-anyBot (AbsApproxFun _ val)    = anyBot val
-\end{code}
-
-@widen@ takes an @AbsVal@, $val$, and returns and @AbsVal@ which is
-approximated by $val$.  Furthermore, the result has no @AbsFun@s in
-it, so it can be compared for equality by @sameVal@.
-
-\begin{code}
-widen :: AnalysisKind -> AbsVal -> AbsVal
-
--- Widening is complicated by the fact that funtions are lifted
-widen StrAnal the_fn@(AbsFun bndr_ty _)
-  = case widened_body of
-	AbsApproxFun ds val -> AbsApproxFun (d : ds) val
-			    where
-			       d = findRecDemand str_fn abs_fn bndr_ty
-			       str_fn val = isBot (foldl (absApply StrAnal) the_fn 
-						         (val : [AbsTop | d <- ds]))
-
-	other		    -> AbsApproxFun [d] widened_body
-			    where
-			       d = findRecDemand str_fn abs_fn bndr_ty
-			       str_fn val = isBot (absApply StrAnal the_fn val)
-  where
-    widened_body = widen StrAnal (absApply StrAnal the_fn AbsTop)
-    abs_fn val   = False	-- Always says poison; so it looks as if
-				-- nothing is absent; safe
-
-{-	OLD comment... 
-	This stuff is now instead handled neatly by the fact that AbsApproxFun 
-	contains an AbsVal inside it.	SLPJ Jan 97
-
-  | isBot abs_body = AbsBot
-    -- It's worth checking for a function which is unconditionally
-    -- bottom.  Consider
-    --
-    --	f x y = let g y = case x of ...
-    --		in (g ..) + (g ..)
-    --
-    -- Here, when we are considering strictness of f in x, we'll
-    -- evaluate the body of f with x bound to bottom.  The current
-    -- strategy is to bind g to its *widened* value; without the isBot
-    -- (...) test above, we'd bind g to an AbsApproxFun, and deliver
-    -- Top, not Bot as the value of f's rhs.  The test spots the
-    -- unconditional bottom-ness of g when x is bottom.  (Another
-    -- alternative here would be to bind g to its exact abstract
-    -- value, but that entails lots of potential re-computation, at
-    -- every application of g.)
--}
-
-widen StrAnal (AbsProd vals) = AbsProd (map (widen StrAnal) vals)
-widen StrAnal other_val	     = other_val
-
-
-widen AbsAnal the_fn@(AbsFun bndr_ty _)
-  | anyBot widened_body = AbsBot
-	-- In the absence-analysis case it's *essential* to check
-	-- that the function has no poison in its body.  If it does,
-	-- anywhere, then the whole function is poisonous.
-
-  | otherwise
-  = case widened_body of
-	AbsApproxFun ds val -> AbsApproxFun (d : ds) val
-			    where
-			       d = findRecDemand str_fn abs_fn bndr_ty
-			       abs_fn val = not (anyBot (foldl (absApply AbsAnal) the_fn 
-								(val : [AbsTop | d <- ds])))
-
-	other		    -> AbsApproxFun [d] widened_body
-			    where
-			       d = findRecDemand str_fn abs_fn bndr_ty
-			       abs_fn val = not (anyBot (absApply AbsAnal the_fn val))
-  where
-    widened_body = widen AbsAnal (absApply AbsAnal the_fn AbsTop)
-    str_fn val   = True		-- Always says non-termination;
-				-- that'll make findRecDemand peer into the
-				-- structure of the value.
-
-widen AbsAnal (AbsProd vals) = AbsProd (map (widen AbsAnal) vals)
-
-	-- It's desirable to do a good job of widening for product
-	-- values.  Consider
-	--
-	--	let p = (x,y)
-	--	in ...(case p of (x,y) -> x)...
-	--
-	-- Now, is y absent in this expression?  Currently the
-	-- analyser widens p before looking at p's scope, to avoid
-	-- lots of recomputation in the case where p is a function.
-	-- So if widening doesn't have a case for products, we'll
-	-- widen p to AbsBot (since when searching for absence in y we
-	-- bind y to poison ie AbsBot), and now we are lost.
-
-widen AbsAnal other_val = other_val
-
--- WAS:	  if anyBot val then AbsBot else AbsTop
--- Nowadays widen is doing a better job on functions for absence analysis.
-\end{code}
-
-@crudeAbsWiden@ is used just for absence analysis, and always
-returns AbsTop or AbsBot, so it widens to a two-point domain
-
-\begin{code}
-crudeAbsWiden :: AbsVal -> AbsVal
-crudeAbsWiden val = if anyBot val then AbsBot else AbsTop
-\end{code}
-
-@sameVal@ compares two abstract values for equality.  It can't deal with
-@AbsFun@, but that should have been removed earlier in the day by @widen@.
-
-\begin{code}
-sameVal :: AbsVal -> AbsVal -> Bool	-- Can't handle AbsFun!
-
-#ifdef DEBUG
-sameVal (AbsFun _ _) _ = panic "sameVal: AbsFun: arg1"
-sameVal _ (AbsFun _ _) = panic "sameVal: AbsFun: arg2"
-#endif
-
-sameVal AbsBot AbsBot = True
-sameVal AbsBot other  = False	-- widen has reduced AbsFun bots to AbsBot
-
-sameVal AbsTop AbsTop = True
-sameVal AbsTop other  = False		-- Right?
-
-sameVal (AbsProd vals1) (AbsProd vals2) = and (zipWithEqual "sameVal" sameVal vals1 vals2)
-sameVal (AbsProd _)	AbsTop 		= False
-sameVal (AbsProd _)	AbsBot 		= False
-
-sameVal (AbsApproxFun str1 v1) (AbsApproxFun str2 v2) = str1 == str2 && sameVal v1 v2
-sameVal (AbsApproxFun _ _)     AbsTop		      = False
-sameVal (AbsApproxFun _ _)     AbsBot 		      = False
-
-sameVal val1 val2 = panic "sameVal: type mismatch or AbsFun encountered"
-\end{code}
-
-
-@evalStrictness@ compares a @Demand@ with an abstract value, returning
-@True@ iff the abstract value is {\em less defined} than the demand.
-(@True@ is the exciting answer; @False@ is always safe.)
-
-\begin{code}
-evalStrictness :: Demand
-	       -> AbsVal
-	       -> Bool		-- True iff the value is sure
-				-- to be less defined than the Demand
-
-evalStrictness (WwLazy _) _   = False
-evalStrictness WwStrict   val = isBot val
-evalStrictness WwEnum	  val = isBot val
-
-evalStrictness (WwUnpack _ demand_info) val
-  = case val of
-      AbsTop	   -> False
-      AbsBot	   -> True
-      AbsProd vals
-	   | not (equalLength vals demand_info) -> pprTrace "TELL SIMON: evalStrictness" (ppr demand_info $$ ppr val)
-						  False
-	   | otherwise -> or (zipWithEqual "evalStrictness" evalStrictness demand_info vals)
-
-      _	    	       -> pprTrace "evalStrictness?" empty False
-
-evalStrictness WwPrim val
-  = case val of
-      AbsTop -> False
-      AbsBot -> True	-- Can happen: consider f (g x), where g is a 
-			-- recursive function returning an Int# that diverges
-
-      other  -> pprPanic "evalStrictness: WwPrim:" (ppr other)
-\end{code}
-
-For absence analysis, we're interested in whether "poison" in the
-argument (ie a bottom therein) can propagate to the result of the
-function call; that is, whether the specified demand can {\em
-possibly} hit poison.
-
-\begin{code}
-evalAbsence (WwLazy True) _ = False	-- Can't possibly hit poison
-					-- with Absent demand
-
-evalAbsence (WwUnpack _ demand_info) val
-  = case val of
-	AbsTop	     -> False		-- No poison in here
-	AbsBot 	     -> True		-- Pure poison
-	AbsProd vals 
-	   | not (equalLength vals demand_info) -> pprTrace "TELL SIMON: evalAbsence" (ppr demand_info $$ ppr val)
-						  True
-	   | otherwise -> or (zipWithEqual "evalAbsence" evalAbsence demand_info vals)
-	_	       -> pprTrace "TELL SIMON: evalAbsence" 
-				(ppr demand_info $$ ppr val)
-			  True
-
-evalAbsence other val = anyBot val
-  -- The demand is conservative; even "Lazy" *might* evaluate the
-  -- argument arbitrarily so we have to look everywhere for poison
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[absEval]{Evaluate an expression in the abstract domain}
-%*									*
-%************************************************************************
-
-\begin{code}
--- The isBottomingId stuf is now dealt with via the Id's strictness info
--- absId anal var env | isBottomingId var
---   = case anal of
---	StrAnal -> AbsBot 	-- See discussion below
---	AbsAnal -> AbsTop	-- Just want to see if there's any poison in
-				-- error's arg
-
-absId anal var env
-  = case (lookupAbsValEnv env var, 
-	  isDataConWorkId_maybe var, 
-	  idStrictness var, 
-	  maybeUnfoldingTemplate (idUnfolding var)) of
-
-	(Just abs_val, _, _, _) ->
-			abs_val	-- Bound in the environment
-
-	(_, Just data_con, _, _) | isProductTyCon tycon &&
-				   not (isRecursiveTyCon tycon)
-		-> 	-- A product.  We get infinite loops if we don't
-			-- check for recursive products!
-			-- The strictness info on the constructor 
-			-- isn't expressive enough to contain its abstract value
-		   productAbsVal (dataConRepArgTys data_con) []
-		where
-		   tycon = dataConTyCon data_con
-
-	(_, _, NoStrictnessInfo, Just unfolding) ->
-			-- We have an unfolding for the expr
-			-- Assume the unfolding has no free variables since it
-			-- came from inside the Id
-			absEval anal unfolding env
-		-- Notice here that we only look in the unfolding if we don't
-		-- have strictness info (an unusual situation).
-		-- We could have chosen to look in the unfolding if it exists,
-		-- and only try the strictness info if it doesn't, and that would
-		-- give more accurate results, at the cost of re-abstract-interpreting
-		-- the unfolding every time.
-		-- We found only one place where the look-at-unfolding-first
-		-- method gave better results, which is in the definition of
-		-- showInt in the Prelude.  In its defintion, fromIntegral is
-		-- not inlined (it's big) but ab-interp-ing its unfolding gave
-		-- a better result than looking at its strictness only.
-		--  showInt :: Integral a => a -> [Char] -> [Char]
-		-- !       {-# GHC_PRAGMA _A_ 1 _U_ 122 _S_
-		--         "U(U(U(U(SA)AAAAAAAAL)AA)AAAAASAAASA)" {...} _N_ _N_ #-}
-		-- --- 42,44 ----
-		--   showInt :: Integral a => a -> [Char] -> [Char]
-		-- !       {-# GHC_PRAGMA _A_ 1 _U_ 122 _S_
-		--        "U(U(U(U(SL)LLLLLLLLL)LL)LLLLLSLLLLL)" _N_ _N_ #-}
-
-
-	(_, _, strictness_info, _) ->
-			-- Includes NoUnfolding
-			-- Try the strictness info
-			absValFromStrictness anal strictness_info
-
-productAbsVal []                 rev_abs_args = AbsProd (reverse rev_abs_args)
-productAbsVal (arg_ty : arg_tys) rev_abs_args = AbsFun arg_ty (\ abs_arg -> productAbsVal arg_tys (abs_arg : rev_abs_args))
-\end{code}
-
-\begin{code}
-absEval :: AnalysisKind -> CoreExpr -> AbsValEnv -> AbsVal
-
-absEval anal (Type ty) env = AbsTop
-absEval anal (Var var) env = absId anal var env
-\end{code}
-
-Discussion about error (following/quoting Lennart): Any expression
-'error e' is regarded as bottom (with HBC, with the -ffail-strict
-flag, on with -O).
-
-Regarding it as bottom gives much better strictness properties for
-some functions.	 E.g.
-
-	f [x] y = x+y
-	f (x:xs) y = f xs (x+y)
-i.e.
-	f [] _ = error "no match"
-	f [x] y = x+y
-	f (x:xs) y = f xs (x+y)
-
-is strict in y, which you really want.  But, it may lead to
-transformations that turn a call to \tr{error} into non-termination.
-(The odds of this happening aren't good.)
-
-Things are a little different for absence analysis, because we want
-to make sure that any poison (?????)
-
-\begin{code}
-absEval anal (Lit _) env = AbsTop
-  	-- Literals terminate (strictness) and are not poison (absence)
-\end{code}
-
-\begin{code}
-absEval anal (Lam bndr body) env
-  | isTyVar bndr = absEval anal body env	-- Type lambda
-  | otherwise    = AbsFun (idType bndr) abs_fn	-- Value lambda
-  where
-    abs_fn arg = absEval anal body (addOneToAbsValEnv env bndr arg)
-
-absEval anal (App expr (Type ty)) env
-  = absEval anal expr env			-- Type appplication
-absEval anal (App f val_arg) env
-  = absApply anal (absEval anal f env) 		-- Value applicationn
-		  (absEval anal val_arg env)
-\end{code}
-
-\begin{code}
-absEval anal expr@(Case scrut case_bndr alts) env
-  = let
-	scrut_val  = absEval anal scrut env
-	alts_env   = addOneToAbsValEnv env case_bndr scrut_val
-    in
-    case (scrut_val, alts) of
-	(AbsBot, _) -> AbsBot
-
-	(AbsProd arg_vals, [(con, bndrs, rhs)])
-		| con /= DEFAULT ->
-		-- The scrutinee is a product value, so it must be of a single-constr
-		-- type; so the constructor in this alternative must be the right one
-		-- so we can go ahead and bind the constructor args to the components
-		-- of the product value.
-	    ASSERT(equalLength arg_vals val_bndrs)
-	    absEval anal rhs rhs_env
-	  where
-	    val_bndrs = filter isId bndrs
-	    rhs_env   = growAbsValEnvList alts_env (val_bndrs `zip` arg_vals)
-
-	other -> absEvalAlts anal alts alts_env
-\end{code}
-
-For @Lets@ we widen the value we get.  This is nothing to
-do with fixpointing.  The reason is so that we don't get an explosion
-in the amount of computation.  For example, consider:
-\begin{verbatim}
-      let
-	g a = case a of
-		q1 -> ...
-		q2 -> ...
-	f x = case x of
-		p1 -> ...g r...
-		p2 -> ...g s...
-      in
-	f e
-\end{verbatim}
-If we bind @f@ and @g@ to their exact abstract value, then we'll
-``execute'' one call to @f@ and {\em two} calls to @g@.  This can blow
-up exponentially.  Widening cuts it off by making a fixed
-approximation to @f@ and @g@, so that the bodies of @f@ and @g@ are
-not evaluated again at all when they are called.
-
-Of course, this can lose useful joint strictness, which is sad.  An
-alternative approach would be to try with a certain amount of ``fuel''
-and be prepared to bale out.
-
-\begin{code}
-absEval anal (Let (NonRec binder e1) e2) env
-  = let
-	new_env = addOneToAbsValEnv env binder (widen anal (absEval anal e1 env))
-    in
-	-- The binder of a NonRec should *not* be of unboxed type,
-	-- hence no need to strictly evaluate the Rhs.
-    absEval anal e2 new_env
-
-absEval anal (Let (Rec pairs) body) env
-  = let
-	(binders,rhss) = unzip pairs
-	rhs_vals = cheapFixpoint anal binders rhss env	-- Returns widened values
-	new_env  = growAbsValEnvList env (binders `zip` rhs_vals)
-    in
-    absEval anal body new_env
-
-absEval anal (Note (Coerce _ _) expr) env = AbsTop
-	-- Don't look inside coerces, becuase they
-	-- are usually recursive newtypes
-	-- (Could improve, for the error case, but we're about
-	-- to kill this analyser anyway.)
-absEval anal (Note note expr) env = absEval anal expr env
-\end{code}
-
-\begin{code}
-absEvalAlts :: AnalysisKind -> [CoreAlt] -> AbsValEnv -> AbsVal
-absEvalAlts anal alts env
-  = combine anal (map go alts)
-  where
-    combine StrAnal = foldr1 lub	-- Diverge only if all diverge
-    combine AbsAnal = foldr1 glb	-- Find any poison
-
-    go (con, bndrs, rhs)
-      = absEval anal rhs rhs_env
-      where
-	rhs_env = growAbsValEnvList env (filter isId bndrs `zip` repeat AbsTop)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[absApply]{Apply an abstract function to an abstract argument}
-%*									*
-%************************************************************************
-
-Easy ones first:
-
-\begin{code}
-absApply :: AnalysisKind -> AbsVal -> AbsVal -> AbsVal
-
-absApply anal AbsBot arg = AbsBot
-  -- AbsBot represents the abstract bottom *function* too
-
-absApply StrAnal AbsTop	arg = AbsTop
-absApply AbsAnal AbsTop	arg = if anyBot arg
-			      then AbsBot
-			      else AbsTop
-	-- To be conservative, we have to assume that a function about
-	-- which we know nothing (AbsTop) might look at some part of
-	-- its argument
-\end{code}
-
-An @AbsFun@ with only one more argument needed---bind it and eval the
-result.	 A @Lam@ with two or more args: return another @AbsFun@ with
-an augmented environment.
-
-\begin{code}
-absApply anal (AbsFun bndr_ty abs_fn) arg = abs_fn arg
-\end{code}
-
-\begin{code}
-absApply StrAnal (AbsApproxFun (d:ds) val) arg
-  = case ds of 
-	[]    -> val'
-	other -> AbsApproxFun ds val'	-- Result is non-bot if there are still args
-  where
-    val' | evalStrictness d arg = AbsBot
-	 | otherwise		= val
-
-absApply AbsAnal (AbsApproxFun (d:ds) val) arg
-  = if evalAbsence d arg
-    then AbsBot		-- Poison in arg means poison in the application
-    else case ds of
-		[]    -> val
-		other -> AbsApproxFun ds val
-
-#ifdef DEBUG
-absApply anal f@(AbsProd _) arg 
-  = pprPanic ("absApply: Duff function: AbsProd." ++ show anal) ((ppr f) <+> (ppr arg))
-#endif
-\end{code}
-
-
-
-
-%************************************************************************
-%*									*
-\subsection[findStrictness]{Determine some binders' strictness}
-%*									*
-%************************************************************************
-
-\begin{code}
-findStrictness :: Id
-	       -> AbsVal 		-- Abstract strictness value of function
-	       -> AbsVal		-- Abstract absence value of function
-	       -> StrictnessInfo	-- Resulting strictness annotation
-
-findStrictness id (AbsApproxFun str_ds str_res) (AbsApproxFun abs_ds _)
-  	-- You might think there's really no point in describing detailed
-	-- strictness for a divergent function; 
-	-- If it's fully applied we get bottom regardless of the
-	-- argument.  If it's not fully applied we don't get bottom.
-	-- Finally, we don't want to regard the args of a divergent function
-	-- as 'interesting' for inlining purposes (see Simplify.prepareArgs)
-	--
-	-- HOWEVER, if we make diverging functions appear lazy, they
-	-- don't get wrappers, and then we get dreadful reboxing.
-	-- See notes with WwLib.worthSplitting
-  = find_strictness id str_ds str_res abs_ds
-
-findStrictness id str_val abs_val 
-  | isBot str_val = mkStrictnessInfo ([], True)
-  | otherwise     = NoStrictnessInfo
-
--- The list of absence demands passed to combineDemands 
--- can be shorter than the list of absence demands
---
---	lookup = \ dEq -> letrec {
---			     lookup = \ key ds -> ...lookup...
---			  }
---			  in lookup
--- Here the strictness value takes three args, but the absence value
--- takes only one, for reasons I don't quite understand (see cheapFixpoint)
-
-find_strictness id orig_str_ds orig_str_res orig_abs_ds
-  = mkStrictnessInfo (go orig_str_ds orig_abs_ds, res_bot)
-  where
-    res_bot = isBot orig_str_res
-
-    go str_ds abs_ds = zipWith mk_dmd str_ds (abs_ds ++ repeat wwLazy)
-
-    mk_dmd str_dmd (WwLazy True)
-	 = WARN( not (res_bot || isLazy str_dmd),
-		 ppr id <+> ppr orig_str_ds <+> ppr orig_abs_ds )
-		-- If the arg isn't used we jolly well don't expect the function
-		-- to be strict in it.  Unless the function diverges.
-	   WwLazy True	-- Best of all
-
-    mk_dmd (WwUnpack u str_ds) 
-	   (WwUnpack _ abs_ds) = WwUnpack u (go str_ds abs_ds)
-
-    mk_dmd str_dmd abs_dmd = str_dmd
-\end{code}
-
-
-\begin{code}
-findDemand dmd str_env abs_env expr binder
-  = findRecDemand str_fn abs_fn (idType binder)
-  where
-    str_fn val = evalStrictness   dmd (absEval StrAnal expr (addOneToAbsValEnv str_env binder val))
-    abs_fn val = not (evalAbsence dmd (absEval AbsAnal expr (addOneToAbsValEnv abs_env binder val)))
-
-findDemandAlts dmd str_env abs_env alts binder
-  = findRecDemand str_fn abs_fn (idType binder)
-  where
-    str_fn val = evalStrictness   dmd (absEvalAlts StrAnal alts (addOneToAbsValEnv str_env binder val))
-    abs_fn val = not (evalAbsence dmd (absEvalAlts AbsAnal alts (addOneToAbsValEnv abs_env binder val)))
-\end{code}
-
-@findRecDemand@ is where we finally convert strictness/absence info
-into ``Demands'' which we can pin on Ids (etc.).
-
-NOTE: What do we do if something is {\em both} strict and absent?
-Should \tr{f x y z = error "foo"} says that \tr{f}'s arguments are all
-strict (because of bottoming effect of \tr{error}) or all absent
-(because they're not used)?
-
-Well, for practical reasons, we prefer absence over strictness.  In
-particular, it makes the ``default defaults'' for class methods (the
-ones that say \tr{defm.foo dict = error "I don't exist"}) come out
-nicely [saying ``the dict isn't used''], rather than saying it is
-strict in every component of the dictionary [massive gratuitious
-casing to take the dict apart].
-
-But you could have examples where going for strictness would be better
-than absence.  Consider:
-\begin{verbatim}
-	let x = something big
-	in
-	f x y z + g x
-\end{verbatim}
-
-If \tr{x} is marked absent in \tr{f}, but not strict, and \tr{g} is
-lazy, then the thunk for \tr{x} will be built.  If \tr{f} was strict,
-then we'd let-to-case it:
-\begin{verbatim}
-	case something big of
-	  x -> f x y z + g x
-\end{verbatim}
-Ho hum.
-
-\begin{code}
-findRecDemand :: (AbsVal -> Bool)	-- True => function applied to this value yields Bot
-	      -> (AbsVal -> Bool)	-- True => function applied to this value yields no poison
-	      -> Type 	    -- The type of the argument
-	      -> Demand
-
-findRecDemand str_fn abs_fn ty
-  = if isUnLiftedType ty then -- It's a primitive type!
-       wwPrim
-
-    else if abs_fn AbsBot then -- It's absent
-       -- We prefer absence over strictness: see NOTE above.
-       WwLazy True
-
-    else if not (opt_AllStrict ||
-		 (opt_NumbersStrict && is_numeric_type ty) ||
-		 str_fn AbsBot) then
-	WwLazy False -- It's not strict and we're not pretending
-
-    else -- It's strict (or we're pretending it is)!
-
-       case splitProductType_maybe ty of
-
-	 Nothing -> wwStrict	-- Could have a test for wwEnum, but
-				-- we don't exploit it yet, so don't bother
-
-	 Just (tycon,_,data_con,cmpnt_tys) 	-- Single constructor case
-	   | isRecursiveTyCon tycon		-- Recursive data type; don't unpack
-	   ->	wwStrict			-- 	(this applies to newtypes too:
-						--	e.g.  data Void = MkVoid Void)
-
-	   |  null compt_strict_infos 		-- A nullary data type
-	   ->	wwStrict
-
-	   | otherwise				-- Some other data type
-	   ->	wwUnpack compt_strict_infos
-
-	   where
-	      prod_len = length cmpnt_tys
-	      compt_strict_infos
-		= [ findRecDemand
-			 (\ cmpnt_val ->
-			       str_fn (mkMainlyTopProd prod_len i cmpnt_val)
-			 )
-			 (\ cmpnt_val ->
-			       abs_fn (mkMainlyTopProd prod_len i cmpnt_val)
-			 )
-		     cmpnt_ty
-		  | (cmpnt_ty, i) <- cmpnt_tys `zip` [1..] ]
-
-  where
-    is_numeric_type ty
-      = case (splitTyConApp_maybe ty) of -- NB: duplicates stuff done above
-	  Nothing	  -> False
-	  Just (tycon, _) -> tyConUnique tycon `is_elem` numericTyKeys
-      where
-	is_elem = isIn "is_numeric_type"
-
-    -- mkMainlyTopProd: make an AbsProd that is all AbsTops ("n"-1 of
-    -- them) except for a given value in the "i"th position.
-
-    mkMainlyTopProd :: Int -> Int -> AbsVal -> AbsVal
-
-    mkMainlyTopProd n i val
-      = let
-	    befores = nOfThem (i-1) AbsTop
-	    afters  = nOfThem (n-i) AbsTop
-    	in
-	AbsProd (befores ++ (val : afters))
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[fixpoint]{Fixpointer for the strictness analyser}
-%*									*
-%************************************************************************
-
-The @fixpoint@ functions take a list of \tr{(binder, expr)} pairs, an
-environment, and returns the abstract value of each binder.
-
-The @cheapFixpoint@ function makes a conservative approximation,
-by binding each of the variables to Top in their own right hand sides.
-That allows us to make rapid progress, at the cost of a less-than-wonderful
-approximation.
-
-\begin{code}
-cheapFixpoint :: AnalysisKind -> [Id] -> [CoreExpr] -> AbsValEnv -> [AbsVal]
-
-cheapFixpoint AbsAnal [id] [rhs] env
-  = [crudeAbsWiden (absEval AbsAnal rhs new_env)]
-  where
-    new_env = addOneToAbsValEnv env id AbsTop	-- Unsafe starting point!
-		    -- In the just-one-binding case, we guarantee to
-		    -- find a fixed point in just one iteration,
-		    -- because we are using only a two-point domain.
-		    -- This improves matters in cases like:
-		    --
-		    --	f x y = letrec g = ...g...
-		    --		in g x
-		    --
-		    -- Here, y isn't used at all, but if g is bound to
-		    -- AbsBot we simply get AbsBot as the next
-		    -- iteration too.
-
-cheapFixpoint anal ids rhss env
-  = [widen anal (absEval anal rhs new_env) | rhs <- rhss]
-		-- We do just one iteration, starting from a safe
-		-- approximation.  This won't do a good job in situations
-		-- like:
-		--	\x -> letrec f = ...g...
-		--		     g = ...f...x...
-		--	      in
-		--	      ...f...
-		-- Here, f will end up bound to Top after one iteration,
-		-- and hence we won't spot the strictness in x.
-		-- (A second iteration would solve this.  ToDo: try the effect of
-		--  really searching for a fixed point.)
-  where
-    new_env = growAbsValEnvList env [(id,safe_val) | id <- ids]
-
-    safe_val
-      = case anal of	-- The safe starting point
-	  StrAnal -> AbsTop
-	  AbsAnal -> AbsBot
-\end{code}
-
-\begin{code}
-fixpoint :: AnalysisKind -> [Id] -> [CoreExpr] -> AbsValEnv -> [AbsVal]
-
-fixpoint anal [] _ env = []
-
-fixpoint anal ids rhss env
-  = fix_loop initial_vals
-  where
-    initial_val id
-      = case anal of	-- The (unsafe) starting point
-	  AbsAnal -> AbsTop
-	  StrAnal -> AbsBot
-		-- At one stage for StrAnal we said:
-		--   if (returnsRealWorld (idType id))
-		--   then AbsTop -- this is a massively horrible hack (SLPJ 95/05)
-		-- but no one has the foggiest idea what this hack did,
-		-- and returnsRealWorld was a stub that always returned False
-		-- So this comment is all that is left of the hack!
-
-    initial_vals = [ initial_val id | id <- ids ]
-
-    fix_loop :: [AbsVal] -> [AbsVal]
-
-    fix_loop current_widened_vals
-      = let
-	    new_env  = growAbsValEnvList env (ids `zip` current_widened_vals)
-	    new_vals = [ absEval anal rhs new_env | rhs <- rhss ]
-	    new_widened_vals = map (widen anal) new_vals
-	in
-	if (and (zipWith sameVal current_widened_vals new_widened_vals)) then
-	    current_widened_vals
-
-	    -- NB: I was too chicken to make that a zipWithEqual,
-	    -- lest I jump into a black hole.  WDP 96/02
-
-	    -- Return the widened values.  We might get a slightly
-	    -- better value by returning new_vals (which we used to
-	    -- do, see below), but alas that means that whenever the
-	    -- function is called we have to re-execute it, which is
-	    -- expensive.
-
-	    -- OLD VERSION
-	    -- new_vals
-	    -- Return the un-widened values which may be a bit better
-	    -- than the widened ones, and are guaranteed safe, since
-	    -- they are one iteration beyond current_widened_vals,
-	    -- which itself is a fixed point.
-	else
-	    fix_loop new_widened_vals
-\end{code}
-
-For absence analysis, we make do with a very very simple approach:
-look for convergence in a two-point domain.
-
-We used to use just one iteration, starting with the variables bound
-to @AbsBot@, which is safe.
-
-Prior to that, we used one iteration starting from @AbsTop@ (which
-isn't safe).  Why isn't @AbsTop@ safe?  Consider:
-\begin{verbatim}
-	letrec
-	  x = ...p..d...
-	  d = (x,y)
-	in
-	...
-\end{verbatim}
-Here, if p is @AbsBot@, then we'd better {\em not} end up with a ``fixed
-point'' of @d@ being @(AbsTop, AbsTop)@!  An @AbsBot@ initial value is
-safe because it gives poison more often than really necessary, and
-thus may miss some absence, but will never claim absence when it ain't
-so.
-
-Anyway, one iteration starting with everything bound to @AbsBot@ give
-bad results for
-
-	f = \ x -> ...f...
-
-Here, f would always end up bound to @AbsBot@, which ain't very
-clever, because then it would introduce poison whenever it was
-applied.  Much better to start with f bound to @AbsTop@, and widen it
-to @AbsBot@ if any poison shows up. In effect we look for convergence
-in the two-point @AbsTop@/@AbsBot@ domain.
-
-What we miss (compared with the cleverer strictness analysis) is
-spotting that in this case
-
-	f = \ x y -> ...y...(f x y')...
-
-\tr{x} is actually absent, since it is only passed round the loop, never
-used.  But who cares about missing that?
-
-NB: despite only having a two-point domain, we may still have many
-iterations, because there are several variables involved at once.
-
-\begin{code}
-#endif /* OLD_STRICTNESS */
-\end{code}
diff --git a/compiler/stranal/SaLib.lhs b/compiler/stranal/SaLib.lhs
deleted file mode 100644
index 2561d97..0000000
--- a/compiler/stranal/SaLib.lhs
+++ /dev/null
@@ -1,137 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-%
-\section[SaLib]{Basic datatypes, functions for the strictness analyser}
-
-See also: the ``library'' for the ``back end'' (@SaBackLib@).
-
-\begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
-#ifndef OLD_STRICTNESS
-module SaLib () where
-#else
-
-module SaLib (
-	AbsVal(..),
-	AnalysisKind(..),
-	AbsValEnv{-abstract-}, StrictEnv, AbsenceEnv,
-	mkAbsApproxFun,
-	nullAbsValEnv, addOneToAbsValEnv, growAbsValEnvList,
-	lookupAbsValEnv,
-	absValFromStrictness
-    ) where
-
-#include "HsVersions.h"
-
-import Type		( Type )
-import VarEnv
-import IdInfo		( StrictnessInfo(..) )
-import Demand		( Demand )
-import Outputable
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[AbsVal-datatype]{@AbsVal@: abstract values (and @AbsValEnv@)}
-%*									*
-%************************************************************************
-
-@AnalysisKind@ tells what kind of analysis is being done.
-
-\begin{code}
-data AnalysisKind
-  = StrAnal 	-- We're doing strictness analysis
-  | AbsAnal	-- We're doing absence analysis
-  deriving Show
-\end{code}
-
-@AbsVal@ is the data type of HNF abstract values.
-
-\begin{code}
-data AbsVal
-  = AbsTop		    -- AbsTop is the completely uninformative
-			    -- value
-
-  | AbsBot		    -- An expression whose abstract value is
-			    -- AbsBot is sure to fail to terminate.
-			    -- AbsBot represents the abstract
-			    --  *function* bottom too.
-
-  | AbsProd [AbsVal]	    -- (Lifted) product of abstract values
-			    -- "Lifted" means that AbsBot is *different* from
-			    --    AbsProd [AbsBot, ..., AbsBot]
-
-  | AbsFun	    	    -- An abstract function, with the given:
-	    Type	   	 -- Type of the *argument* to the function
-	    (AbsVal -> AbsVal)	-- The function
-
-  | AbsApproxFun	    -- This is used to represent a coarse
-	    [Demand]	    -- approximation to a function value.  It's an
-	    AbsVal	    -- abstract function which is strict in its
-			    -- arguments if the  Demand so indicates.
-	-- INVARIANT: the [Demand] is non-empty
-
-	-- AbsApproxFun has to take a *list* of demands, no just one,
-	-- because function spaces are now lifted.  Hence, (f bot top)
-	-- might be bot, but the partial application (f bot) is a *function*,
-	-- not bot.
-
-mkAbsApproxFun :: Demand -> AbsVal -> AbsVal
-mkAbsApproxFun d (AbsApproxFun ds val) = AbsApproxFun (d:ds) val
-mkAbsApproxFun d val	   	       = AbsApproxFun [d]    val
-
-instance Outputable AbsVal where
-    ppr AbsTop = ptext (sLit "AbsTop")
-    ppr AbsBot = ptext (sLit "AbsBot")
-    ppr (AbsProd prod) = hsep [ptext (sLit "AbsProd"), ppr prod]
-    ppr (AbsFun bndr_ty body) = ptext (sLit "AbsFun")
-    ppr (AbsApproxFun demands val)
-      = ptext (sLit "AbsApprox") <+> brackets (interpp'SP demands) <+> ppr val
-\end{code}
-
-%-----------
-
-An @AbsValEnv@ maps @Ids@ to @AbsVals@.  Any unbound @Ids@ are
-implicitly bound to @AbsTop@, the completely uninformative,
-pessimistic value---see @absEval@ of a @Var@.
-
-\begin{code}
-newtype AbsValEnv = AbsValEnv (IdEnv AbsVal)
-
-type StrictEnv  = AbsValEnv	-- Environment for strictness analysis
-type AbsenceEnv = AbsValEnv	-- Environment for absence analysis
-
-nullAbsValEnv -- this is the one and only way to create AbsValEnvs
-  = AbsValEnv emptyVarEnv
-
-addOneToAbsValEnv (AbsValEnv idenv) y z = AbsValEnv (extendVarEnv idenv y z)
-growAbsValEnvList (AbsValEnv idenv) ys  = AbsValEnv (extendVarEnvList idenv ys)
-
-lookupAbsValEnv (AbsValEnv idenv) y
-  = lookupVarEnv idenv y
-\end{code}
-
-\begin{code}
-absValFromStrictness :: AnalysisKind -> StrictnessInfo -> AbsVal
-
-absValFromStrictness anal NoStrictnessInfo = AbsTop
-absValFromStrictness anal (StrictnessInfo args_info bot_result)
-  = case args_info of	-- Check the invariant that the arg list on 
-	[] -> res	-- AbsApproxFun is non-empty
-	_  -> AbsApproxFun args_info res
-  where
-    res | not bot_result = AbsTop
-	| otherwise      = case anal of
-				StrAnal -> AbsBot
-				AbsAnal -> AbsTop
-\end{code}
-
-\begin{code}
-#endif /* OLD_STRICTNESS */
-\end{code}
diff --git a/compiler/stranal/StrictAnal.lhs b/compiler/stranal/StrictAnal.lhs
deleted file mode 100644
index 920f841..0000000
--- a/compiler/stranal/StrictAnal.lhs
+++ /dev/null
@@ -1,464 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-%
-\section[StrictAnal]{``Simple'' Mycroft-style strictness analyser}
-
-The original version(s) of all strictness-analyser code (except the
-Semantique analyser) was written by Andy Gill.
-
-\begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
-#ifndef OLD_STRICTNESS
-module StrictAnal ( ) where
-
-#else
-
-module StrictAnal ( saBinds ) where
-
-#include "HsVersions.h"
-
-import DynFlags	( DynFlags, DynFlag(..) )
-import CoreSyn
-import Id		( setIdStrictness, setInlinePragma, 
-			  idDemandInfo, setIdDemandInfo, isBottomingId,
-			  Id
-			)
-import ErrUtils		( dumpIfSet_dyn )
-import SaAbsInt
-import SaLib
-import Demand		( Demand, wwStrict, isStrict, isLazy )
-import Util		( zipWith3Equal, stretchZipWith, compareLength )
-import BasicTypes	( Activation( NeverActive ) )
-import Outputable
-import FastTypes
-import State
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[Thoughts]{Random thoughts}
-%*									*
-%************************************************************************
-
-A note about worker-wrappering.  If we have
-
-	f :: Int -> Int
-	f = let v = <expensive>
-	    in \x -> <body>
-
-and we deduce that f is strict, it is nevertheless NOT safe to worker-wapper to
-
-	f = \x -> case x of Int x# -> fw x#
-	fw = \x# -> let x = Int x#
-		    in
-		    let v = <expensive>
-		    in <body>
-
-because this obviously loses laziness, since now <expensive>
-is done each time.  Alas.
-
-WATCH OUT!  This can mean that something is unboxed only to be
-boxed again. For example
-
-	g x y = f x
-
-Here g is strict, and *will* split into worker-wrapper.  A call to
-g, with the wrapper inlined will then be
-
-	case arg of Int a# -> gw a#
-
-Now g calls f, which has no wrapper, so it has to box it.
-
-	gw = \a# -> f (Int a#)
-
-Alas and alack.
-
-
-%************************************************************************
-%*									*
-\subsection[iface-StrictAnal]{Interface to the outside world}
-%*									*
-%************************************************************************
-
-@saBinds@ decorates bindings with strictness info.  A later 
-worker-wrapper pass can use this info to create wrappers and
-strict workers.
-
-\begin{code}
-saBinds :: DynFlags -> [CoreBind] -> IO [CoreBind]
-saBinds dflags binds
-  = do {
-	-- Mark each binder with its strictness
-#ifndef OMIT_STRANAL_STATS
-	let { (binds_w_strictness, sa_stats) = runState $ (saTopBinds binds) nullSaStats };
-	dumpIfSet_dyn dflags Opt_D_dump_simpl_stats "Strictness analysis statistics"
-		  (pp_stats sa_stats);
-#else
-	let { binds_w_strictness = unSaM $ saTopBindsBinds binds };
-#endif
-
-	return binds_w_strictness
-    }
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[saBinds]{Strictness analysis of bindings}
-%*									*
-%************************************************************************
-
-[Some of the documentation about types, etc., in \tr{SaLib} may be
-helpful for understanding this module.]
-
-@saTopBinds@ tags each binder in the program with its @Demand@.
-That tells how each binder is {\em used}; if @Strict@, then the binder
-is sure to be evaluated to HNF; if @NonStrict@ it may or may not be;
-if @Absent@, then it certainly is not used. [DATED; ToDo: update]
-
-(The above info is actually recorded for posterity in each binder's
-IdInfo, notably its @DemandInfo@.)
-
-We proceed by analysing the bindings top-to-bottom, building up an
-environment which maps @Id@s to their abstract values (i.e., an
-@AbsValEnv@ maps an @Id@ to its @AbsVal@).
-
-\begin{code}
-saTopBinds :: [CoreBind] -> SaM [CoreBind] -- not exported
-
-saTopBinds binds
-  = let
-	starting_abs_env = nullAbsValEnv
-    in
-    do_it starting_abs_env starting_abs_env binds
-  where
-    do_it _    _    [] = return []
-    do_it senv aenv (b:bs) = do
-        (senv2, aenv2, new_b) <- saTopBind senv  aenv  b
-        new_bs                <- do_it     senv2 aenv2 bs
-        return (new_b : new_bs)
-\end{code}
-
-@saTopBind@ is only used for the top level.  We don't add any demand
-info to these ids because we can't work it out.  In any case, it
-doesn't do us any good to know whether top-level binders are sure to
-be used; we can't turn top-level @let@s into @case@s.
-
-\begin{code}
-saTopBind :: StrictEnv -> AbsenceEnv
-	  -> CoreBind
-	  -> SaM (StrictEnv, AbsenceEnv, CoreBind)
-
-saTopBind str_env abs_env (NonRec binder rhs) = do
-    new_rhs <- saExpr minDemand str_env abs_env rhs
-    let
-	str_rhs = absEval StrAnal rhs str_env
-	abs_rhs = absEval AbsAnal rhs abs_env
-
-	widened_str_rhs = widen StrAnal str_rhs
-	widened_abs_rhs = widen AbsAnal abs_rhs
-		-- The widening above is done for efficiency reasons.
-		-- See notes on Let case in SaAbsInt.lhs
-
-	new_binder
-	  = addStrictnessInfoToTopId
-		widened_str_rhs widened_abs_rhs
-		binder
-
-	  -- Augment environments with a mapping of the
-	  -- binder to its abstract values, computed by absEval
-      	new_str_env = addOneToAbsValEnv str_env binder widened_str_rhs
-      	new_abs_env = addOneToAbsValEnv abs_env binder widened_abs_rhs
-    
-    return (new_str_env, new_abs_env, NonRec new_binder new_rhs)
-
-saTopBind str_env abs_env (Rec pairs)
-  = let
-	(binders,rhss) = unzip pairs
-	str_rhss    = fixpoint StrAnal binders rhss str_env
-	abs_rhss    = fixpoint AbsAnal binders rhss abs_env
-		      -- fixpoint returns widened values
-      	new_str_env = growAbsValEnvList str_env (binders `zip` str_rhss)
-      	new_abs_env = growAbsValEnvList abs_env (binders `zip` abs_rhss)
-	new_binders = zipWith3Equal "saTopBind" addStrictnessInfoToTopId
-				    str_rhss abs_rhss binders
-    
-    new_rhss <- mapM (saExpr minDemand new_str_env new_abs_env) rhss
-    let
-	new_pairs   = new_binders `zip` new_rhss
-    
-    return (new_str_env, new_abs_env, Rec new_pairs)
-
--- Hack alert!
--- Top level divergent bindings are marked NOINLINE
--- This avoids fruitless inlining of top level error functions
-addStrictnessInfoToTopId str_val abs_val bndr
-  = if isBottomingId new_id then
-	new_id `setInlinePragma` NeverActive
-    else
-	new_id
-  where
-    new_id = addStrictnessInfoToId str_val abs_val bndr
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[saExpr]{Strictness analysis of an expression}
-%*									*
-%************************************************************************
-
-@saExpr@ computes the strictness of an expression within a given
-environment.
-
-\begin{code}
-saExpr :: Demand -> StrictEnv -> AbsenceEnv -> CoreExpr -> SaM CoreExpr
-	-- The demand is the least demand we expect on the
-	-- expression.  WwStrict is the least, because we're only
-	-- interested in the expression at all if it's being evaluated,
-	-- but the demand may be more.  E.g.
-	--	f E
-	-- where f has strictness u(LL), will evaluate E with demand u(LL)
-
-minDemand = wwStrict 
-minDemands = repeat minDemand
-
--- When we find an application, do the arguments
--- with demands gotten from the function
-saApp str_env abs_env (fun, args) = do
-    args' <- sequence sa_args
-    fun' <- saExpr minDemand str_env abs_env fun
-    return (mkApps fun' args')
-  where
-    arg_dmds = case fun of
-		 Var var -> case lookupAbsValEnv str_env var of
-				Just (AbsApproxFun ds _) 
-				   | compareLength ds args /= LT 
-				              -- 'ds' is at least as long as 'args'.
-					-> ds ++ minDemands
-				other   -> minDemands
-		 other -> minDemands
-
-    sa_args = stretchZipWith isTypeArg (error "saApp:dmd") 
-			     sa_arg args arg_dmds 
-	-- The arg_dmds are for value args only, we need to skip
-	-- over the type args when pairing up with the demands
-	-- Hence the stretchZipWith
-
-    sa_arg arg dmd = saExpr dmd' str_env abs_env arg
-		   where
-			-- Bring arg demand up to minDemand
-			dmd' | isLazy dmd = minDemand
-			     | otherwise  = dmd
-
-saExpr _ _ _ e@(Var _)	= return e
-saExpr _ _ _ e@(Lit _)	= return e
-saExpr _ _ _ e@(Type _)	= return e
-
-saExpr dmd str_env abs_env (Lam bndr body)
-  = do	-- Don't bother to set the demand-info on a lambda binder
-	-- We do that only for let(rec)-bound functions
-    new_body <- saExpr minDemand str_env abs_env body
-    return (Lam bndr new_body)
-
-saExpr dmd str_env abs_env e@(App fun arg)
-  = saApp str_env abs_env (collectArgs e)
-
-saExpr dmd str_env abs_env (Note note expr) = do
-    new_expr <- saExpr dmd str_env abs_env expr
-    return (Note note new_expr)
-
-saExpr dmd str_env abs_env (Case expr case_bndr alts) = do
-    new_expr <- saExpr minDemand str_env abs_env expr
-    new_alts <- mapM sa_alt alts
-    let
-	new_case_bndr = addDemandInfoToCaseBndr dmd str_env abs_env alts case_bndr
-    return (Case new_expr new_case_bndr new_alts)
-  where
-    sa_alt (con, binders, rhs) = do
-        new_rhs <- saExpr dmd str_env abs_env rhs
-	let
-	    new_binders = map add_demand_info binders
-	    add_demand_info bndr | isTyVar bndr = bndr
-			  	 | otherwise	= addDemandInfoToId dmd str_env abs_env rhs bndr
-	
-	tickCases new_binders -- stats
-	return (con, new_binders, new_rhs)
-
-saExpr dmd str_env abs_env (Let (NonRec binder rhs) body) = do
-	-- Analyse the RHS in the environment at hand
-    let
-	-- Find the demand on the RHS
-	rhs_dmd = findDemand dmd str_env abs_env body binder
-
-	-- Bind this binder to the abstract value of the RHS; analyse
-	-- the body of the `let' in the extended environment.
-      	str_rhs_val  	= absEval StrAnal rhs str_env
-      	abs_rhs_val  	= absEval AbsAnal rhs abs_env
-
-	widened_str_rhs = widen StrAnal str_rhs_val
-	widened_abs_rhs = widen AbsAnal abs_rhs_val
-		-- The widening above is done for efficiency reasons.
-		-- See notes on Let case in SaAbsInt.lhs
-
-      	new_str_env	= addOneToAbsValEnv str_env binder widened_str_rhs
-      	new_abs_env	= addOneToAbsValEnv abs_env binder widened_abs_rhs
-
-	-- Now determine the strictness of this binder; use that info
-	-- to record DemandInfo/StrictnessInfo in the binder.
-	new_binder = addStrictnessInfoToId
-			widened_str_rhs widened_abs_rhs
-			(binder `setIdDemandInfo` rhs_dmd)
-    
-    tickLet new_binder		 -- stats
-    new_rhs <- saExpr rhs_dmd str_env abs_env rhs
-    new_body <- saExpr dmd new_str_env new_abs_env body
-    return (Let (NonRec new_binder new_rhs) new_body)
-
-saExpr dmd str_env abs_env (Let (Rec pairs) body) = do
-    let
-	(binders,rhss) = unzip pairs
-	str_vals       = fixpoint StrAnal binders rhss str_env
-	abs_vals       = fixpoint AbsAnal binders rhss abs_env
-			 -- fixpoint returns widened values
-      	new_str_env    = growAbsValEnvList str_env (binders `zip` str_vals)
-      	new_abs_env    = growAbsValEnvList abs_env (binders `zip` abs_vals)
-    
-    new_body <- saExpr dmd new_str_env new_abs_env body
-    new_rhss <- mapM (saExpr minDemand new_str_env new_abs_env) rhss
-    let
--- 		DON'T add demand info in a Rec!
---		a) it's useless: we can't do let-to-case
---		b) it's incorrect.  Consider
---			letrec x = ...y...
---			       y = ...x...
---			in ...x...
---		   When we ask whether y is demanded we'll bind y to bottom and
---		   evaluate the body of the letrec.  But that will result in our
---		   deciding that y is absent, which is plain wrong!
---		It's much easier simply not to do this.
-
-	improved_binders = zipWith3Equal "saExpr" addStrictnessInfoToId
-				         str_vals abs_vals binders
-
-      	new_pairs   = improved_binders `zip` new_rhss
-    
-    return (Let (Rec new_pairs) new_body)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[computeInfos]{Add computed info to binders}
-%*									*
-%************************************************************************
-
-Important note (Sept 93).  @addStrictnessInfoToId@ is used only for
-let(rec) bound variables, and is use to attach the strictness (not
-demand) info to the binder.  We are careful to restrict this
-strictness info to the lambda-bound arguments which are actually
-visible, at the top level, lest we accidentally lose laziness by
-eagerly looking for an "extra" argument.  So we "dig for lambdas" in a
-rather syntactic way.
-
-A better idea might be to have some kind of arity analysis to
-tell how many args could safely be grabbed.
-
-\begin{code}
-addStrictnessInfoToId
-	:: AbsVal 		-- Abstract strictness value
-	-> AbsVal		-- Ditto absence
-	-> Id 			-- The id
-	-> Id			-- Augmented with strictness
-
-addStrictnessInfoToId str_val abs_val binder
-  = binder `setIdStrictness` findStrictness binder str_val abs_val
-\end{code}
-
-\begin{code}
-addDemandInfoToId :: Demand -> StrictEnv -> AbsenceEnv
-		  -> CoreExpr 	-- The scope of the id
-		  -> Id
-		  -> Id			-- Id augmented with Demand info
-
-addDemandInfoToId dmd str_env abs_env expr binder
-  = binder `setIdDemandInfo` (findDemand dmd str_env abs_env expr binder)
-
-addDemandInfoToCaseBndr dmd str_env abs_env alts binder
-  = binder `setIdDemandInfo` (findDemandAlts dmd str_env abs_env alts binder)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Monad used herein for stats}
-%*									*
-%************************************************************************
-
-\begin{code}
-data SaStats
-  = SaStats FastInt FastInt	-- total/marked-demanded lambda-bound
-	    FastInt FastInt	-- total/marked-demanded case-bound
-	    FastInt FastInt	-- total/marked-demanded let-bound
-				-- (excl. top-level; excl. letrecs)
-
-nullSaStats = SaStats
-   (_ILIT(0)) (_ILIT(0))
-   (_ILIT(0)) (_ILIT(0))
-   (_ILIT(0)) (_ILIT(0))
-
-tickLambda :: Id   -> SaM ()
-tickCases  :: [CoreBndr] -> SaM ()
-tickLet    :: Id   -> SaM ()
-
-#ifndef OMIT_STRANAL_STATS
-type SaM a = State SaStats a
-
-tickLambda var = modify $ \(SaStats tlam dlam tc dc tlet dlet)
-  -> case (tick_demanded var (0,0)) of { (totB, demandedB) ->
-     let tot = iUnbox totB ; demanded = iUnbox demandedB 
-     in SaStats (tlam +# tot) (dlam +# demanded) tc dc tlet dlet)
-
-tickCases vars = modify $ \(SaStats tlam dlam tc dc tlet dlet)
-  = case (foldr tick_demanded (0,0) vars) of { (totB, demandedB) ->
-    let tot = iUnbox totB ; demanded = iUnbox demandedB 
-    in  SaStats tlam dlam (tc +# tot) (dc +# demanded) tlet dlet)
-
-tickLet var = modify $ \(SaStats tlam dlam tc dc tlet dlet)
-  = case (tick_demanded var (0,0))        of { (totB, demandedB) ->
-    let tot = iUnbox totB ; demanded = iUnbox demandedB 
-    in SaStats tlam dlam tc dc (tlet +# tot) (dlet +# demanded))
-
-tick_demanded var (tot, demanded)
-  | isTyVar var = (tot, demanded)
-  | otherwise
-  = (tot + 1,
-     if (isStrict (idDemandInfo var))
-     then demanded + 1
-     else demanded)
-
-pp_stats (SaStats tlam dlam tc dc tlet dlet)
-      = hcat [ptext (sLit "Lambda vars: "), int (iBox dlam), char '/', int (iBox tlam),
-	      ptext (sLit "; Case vars: "), int (iBox dc),   char '/', int (iBox tc),
-	      ptext (sLit "; Let vars: "),  int (iBox dlet), char '/', int (iBox tlet)
-	]
-
-#else /* OMIT_STRANAL_STATS */
--- identity monad
-newtype SaM a = SaM { unSaM :: a }
-
-instance Monad SaM where
-    return x    = SaM x
-    SaM x >>= f = f x
-
-tickLambda var  = panic "OMIT_STRANAL_STATS: tickLambda"
-tickCases  vars = panic "OMIT_STRANAL_STATS: tickCases"
-tickLet    var  = panic "OMIT_STRANAL_STATS: tickLet"
-
-#endif /* OMIT_STRANAL_STATS */
-
-#endif /* OLD_STRICTNESS */
-\end{code}
diff --git a/compiler/stranal/WorkWrap.lhs b/compiler/stranal/WorkWrap.lhs
index d23e83e..4e7a494 100644
--- a/compiler/stranal/WorkWrap.lhs
+++ b/compiler/stranal/WorkWrap.lhs
@@ -12,12 +12,12 @@ import CoreUtils	( exprType, exprIsHNF )
 import CoreArity	( exprArity )
 import Var
 import Id		( idType, isOneShotLambda, idUnfolding,
-			  setIdNewStrictness, mkWorkerId,
+			  setIdStrictness, mkWorkerId,
 			  setInlineActivation, setIdUnfolding,
 			  setIdArity )
 import Type		( Type )
 import IdInfo
-import NewDemand        ( Demand(..), StrictSig(..), DmdType(..), DmdResult(..), 
+import Demand           ( Demand(..), StrictSig(..), DmdType(..), DmdResult(..), 
 			  Demands(..), mkTopDmdType, isBotRes, returnsCPR, topSig, isAbsent
 			)
 import UniqSupply
@@ -225,12 +225,12 @@ tryWW is_rec fn_id rhs
 
   where
     fn_info   	 = idInfo fn_id
-    maybe_fn_dmd = newDemandInfo fn_info
+    maybe_fn_dmd = demandInfo fn_info
     inline_act   = inlinePragmaActivation (inlinePragInfo fn_info)
 
 	-- In practice it always will have a strictness 
 	-- signature, even if it's a uninformative one
-    strict_sig  = newStrictnessInfo fn_info `orElse` topSig
+    strict_sig  = strictnessInfo fn_info `orElse` topSig
     StrictSig (DmdType env wrap_dmds res_info) = strict_sig
 
 	-- new_fn_id has the DmdEnv zapped.  
@@ -239,7 +239,7 @@ tryWW is_rec fn_id rhs
 	--	(c) it becomes incorrect as things are cloned, because
 	--	    we don't push the substitution into it
     new_fn_id | isEmptyVarEnv env = fn_id
-	      | otherwise	  = fn_id `setIdNewStrictness` 
+	      | otherwise	  = fn_id `setIdStrictness` 
 				     StrictSig (mkTopDmdType wrap_dmds res_info)
 
     is_fun    = notNull wrap_dmds
@@ -283,7 +283,7 @@ splitFun fn_id fn_info wrap_dmds res_info inline_act rhs
 				-- can't think of a compelling reason. (In ptic, INLINE things are 
 				-- not w/wd). However, the RuleMatchInfo is not transferred since
                                 -- it does not make sense for workers to be constructorlike.
-			`setIdNewStrictness` StrictSig (mkTopDmdType work_demands work_res_info)
+			`setIdStrictness` StrictSig (mkTopDmdType work_demands work_res_info)
 				-- Even though we may not be at top level, 
 				-- it's ok to give it an empty DmdEnv
                         `setIdArity` (exprArity work_rhs)
diff --git a/compiler/stranal/WwLib.lhs b/compiler/stranal/WwLib.lhs
index 2c3581c..611c4d4 100644
--- a/compiler/stranal/WwLib.lhs
+++ b/compiler/stranal/WwLib.lhs
@@ -10,13 +10,13 @@ module WwLib ( mkWwBodies, mkWWstr, mkWorkerArgs ) where
 
 import CoreSyn
 import CoreUtils	( exprType )
-import Id		( Id, idType, mkSysLocal, idNewDemandInfo, setIdNewDemandInfo,
+import Id		( Id, idType, mkSysLocal, idDemandInfo, setIdDemandInfo,
 			  isOneShotLambda, setOneShotLambda, setIdUnfolding,
                           setIdInfo
 			)
 import IdInfo		( vanillaIdInfo )
 import DataCon
-import NewDemand	( Demand(..), DmdResult(..), Demands(..) ) 
+import Demand		( Demand(..), DmdResult(..), Demands(..) ) 
 import MkId		( realWorldPrimId, voidArgId, mkRuntimeErrorApp, rUNTIME_ERROR_ID,
                           mkUnpackCase, mkProductBox )
 import TysWiredIn	( tupleCon )
@@ -133,7 +133,7 @@ mkWwBodies fun_ty demands res_info one_shots
 	             return (id, id, res_ty)
 
 	; let (work_lam_args, work_call_args) = mkWorkerArgs work_args res_ty
-	; return ([idNewDemandInfo v | v <- work_call_args, isId v],
+	; return ([idDemandInfo v | v <- work_call_args, isId v],
                   wrap_fn_args . wrap_fn_cpr . wrap_fn_str . applyToVars work_call_args . Var,
                   mkLams work_lam_args. work_fn_str . work_fn_cpr . work_fn_args) }
         -- We use an INLINE unconditionally, even if the wrapper turns out to be
@@ -278,9 +278,9 @@ mkWWargs subst fun_ty arg_info
 applyToVars :: [Var] -> CoreExpr -> CoreExpr
 applyToVars vars fn = mkVarApps fn vars
 
-mk_wrap_arg :: Unique -> Type -> NewDemand.Demand -> Bool -> Id
+mk_wrap_arg :: Unique -> Type -> Demand -> Bool -> Id
 mk_wrap_arg uniq ty dmd one_shot 
-  = set_one_shot one_shot (setIdNewDemandInfo (mkSysLocal (fsLit "w") uniq ty) dmd)
+  = set_one_shot one_shot (setIdDemandInfo (mkSysLocal (fsLit "w") uniq ty) dmd)
   where
     set_one_shot True  id = setOneShotLambda id
     set_one_shot False id = id
@@ -340,7 +340,7 @@ mkWWstr_one arg
   = return ([arg],  nop_fn, nop_fn)
 
   | otherwise
-  = case idNewDemandInfo arg of
+  = case idDemandInfo arg of
 
 	-- Absent case.  We don't deal with absence for unlifted types,
 	-- though, because it's not so easy to manufacture a placeholder
@@ -392,7 +392,7 @@ mkWWstr_one arg
 	-- If the wrapper argument is a one-shot lambda, then
 	-- so should (all) the corresponding worker arguments be
 	-- This bites when we do w/w on a case join point
-    set_worker_arg_info worker_arg demand = set_one_shot (setIdNewDemandInfo worker_arg demand)
+    set_worker_arg_info worker_arg demand = set_one_shot (setIdDemandInfo worker_arg demand)
 
     set_one_shot | isOneShotLambda arg = setOneShotLambda
 		 | otherwise	       = \x -> x
-- 
1.7.10.4