Demand.lhs 6.22 KB
Newer Older
1
%
Simon Marlow's avatar
Simon Marlow committed
2
% (c) The University of Glasgow 2006
3
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 5 6 7
%
\section[Demand]{@Demand@: the amount of demand on a value}

\begin{code}
8
{-# OPTIONS -w #-}
9 10 11
-- 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
12
--     http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings
13 14
-- for details

15 16 17 18
#ifndef OLD_STRICTNESS
module Demand () where
#else

sof's avatar
sof committed
19 20
module Demand(
	Demand(..),
21

22
	wwLazy, wwStrict, wwUnpack, wwPrim, wwEnum, 
23
	isStrict, isLazy, isPrim,
sof's avatar
sof committed
24

25 26 27 28 29 30 31
	pprDemands, seqDemand, seqDemands,

	StrictnessInfo(..),	
	mkStrictnessInfo,
	noStrictnessInfo,
	ppStrictnessInfo, seqStrictnessInfo,
	isBottomingStrictness, appIsBottom,
32

sof's avatar
sof committed
33 34
     ) where

35 36
#include "HsVersions.h"

37
import Outputable
Simon Marlow's avatar
Simon Marlow committed
38
import Util
39 40 41 42 43 44 45 46 47 48 49 50 51 52
\end{code}


%************************************************************************
%*									*
\subsection{The @Demand@ data type}
%*									*
%************************************************************************

\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
53
			--  *definitely* lazy.  (NB: Absence implies
54 55 56 57 58 59
			-- a worker...)

  | WwStrict		-- Argument is strict but that's all we know
			-- (does not imply worker's existence or any
			-- calling-convention magic)

sof's avatar
sof committed
60
  | WwUnpack		-- Argument is strict & a single-constructor type
61
	Bool		-- True <=> wrapper unpacks it; False <=> doesn't
sof's avatar
sof committed
62
	[Demand]	-- Its constituent parts (whose StrictInfos
63 64 65 66 67 68 69 70 71 72
			-- 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.
sof's avatar
sof committed
73
  deriving( Eq )
74 75 76 77 78 79

type MaybeAbsent = Bool -- True <=> not even used

-- versions that don't worry about Absence:
wwLazy	    = WwLazy 	  False
wwStrict    = WwStrict
80
wwUnpack xs = WwUnpack False xs
81 82
wwPrim	    = WwPrim
wwEnum	    = WwEnum
83 84

seqDemand :: Demand -> ()
85 86 87
seqDemand (WwLazy a)      = a `seq` ()
seqDemand (WwUnpack b ds) = b `seq` seqDemands ds
seqDemand other		  = ()
88 89 90

seqDemands [] = ()
seqDemands (d:ds) = seqDemand d `seq` seqDemands ds
91 92 93 94 95 96 97 98 99 100
\end{code}


%************************************************************************
%*									*
\subsection{Functions over @Demand@}
%*									*
%************************************************************************

\begin{code}
101 102 103 104
isLazy :: Demand -> Bool
isLazy (WwLazy _) = True
isLazy _	  = False

105
isStrict :: Demand -> Bool
106
isStrict d = not (isLazy d)
107 108 109 110

isPrim :: Demand -> Bool
isPrim WwPrim = True
isPrim other  = False
111 112
\end{code}

113 114 115 116 117 118 119

%************************************************************************
%*									*
\subsection{Instances}
%*									*
%************************************************************************

120

121
\begin{code}
122 123 124 125 126 127 128 129 130 131 132
pprDemands demands bot = hcat (map pprDemand demands) <> pp_bot
		       where
			 pp_bot | bot       = ptext SLIT("B")
				| otherwise = empty


pprDemand (WwLazy False)  	 = char 'L'
pprDemand (WwLazy True)   	 = char 'A'
pprDemand WwStrict	      	 = char 'S'
pprDemand WwPrim	      	 = char 'P'
pprDemand WwEnum	      	 = char 'E'
133
pprDemand (WwUnpack wu args)     = char ch <> parens (hcat (map pprDemand args))
134
				      where
135
					ch = if wu then 'U' else 'u'
136 137 138 139 140 141 142

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)
143 144

-- Reading demands is done in Lex.lhs
145 146 147
\end{code}


148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176
%************************************************************************
%*									*
\subsection[strictness-IdInfo]{Strictness info about an @Id@}
%*									*
%************************************************************************

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

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.

Note that the existence of a worker function is now denoted by the Id's
workerInfo field.

\begin{code}
data StrictnessInfo
  = NoStrictnessInfo

  | StrictnessInfo [Demand] 	-- Demands on the arguments.

		   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
177
  deriving( Eq )
178 179 180 181 182 183 184 185 186 187 188 189 190

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

seqStrictnessInfo :: StrictnessInfo -> ()
seqStrictnessInfo (StrictnessInfo ds b) = b `seq` seqDemands ds
seqStrictnessInfo other		        = ()
\end{code}

191
\begin{code}
192
mkStrictnessInfo :: ([Demand], Bool) -> StrictnessInfo
193

194
mkStrictnessInfo (xs, is_bot)
195 196 197 198 199
  | all totally_boring xs && not is_bot	= NoStrictnessInfo		-- Uninteresting
  | otherwise		    	        = StrictnessInfo xs is_bot
  where
    totally_boring (WwLazy False) = True
    totally_boring other	  = False
sof's avatar
sof committed
200

201
noStrictnessInfo = NoStrictnessInfo
202

203 204
isBottomingStrictness (StrictnessInfo _ bot) = bot
isBottomingStrictness NoStrictnessInfo       = False
sof's avatar
sof committed
205

206
-- appIsBottom returns true if an application to n args would diverge
sof's avatar
sof committed
207
appIsBottom (StrictnessInfo ds bot)   n = bot && (listLengthCmp ds n /=GT) -- not more than 'n' elts in 'ds'.
208
appIsBottom  NoStrictnessInfo	      n	= False
209

210 211
ppStrictnessInfo NoStrictnessInfo		   = empty
ppStrictnessInfo (StrictnessInfo wrapper_args bot) = hsep [pprDemands wrapper_args bot]
212
\end{code}
213

214 215 216
\begin{code}
#endif /* OLD_STRICTNESS */
\end{code}