projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Make UniqFM strict in its elements
[ghc-hetmet.git]
/
compiler
/
basicTypes
/
Demand.lhs
diff --git
a/compiler/basicTypes/Demand.lhs
b/compiler/basicTypes/Demand.lhs
index
50bb0c6
..
df2758a
100644
(file)
--- a/
compiler/basicTypes/Demand.lhs
+++ b/
compiler/basicTypes/Demand.lhs
@@
-1,4
+1,5
@@
%
%
+% (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}
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[Demand]{@Demand@: the amount of demand on a value}
@@
-27,7
+28,7
@@
module Demand(
#include "HsVersions.h"
import Outputable
#include "HsVersions.h"
import Outputable
-import Util ( listLengthCmp )
+import Util
\end{code}
\end{code}
@@
-67,6
+68,9
@@
data Demand
type MaybeAbsent = Bool -- True <=> not even used
-- versions that don't worry about Absence:
type MaybeAbsent = Bool -- True <=> not even used
-- versions that don't worry about Absence:
+wwLazy, wwStrict, wwPrim, wwEnum :: Demand
+wwUnpack :: [Demand] -> Demand
+
wwLazy = WwLazy False
wwStrict = WwStrict
wwUnpack xs = WwUnpack False xs
wwLazy = WwLazy False
wwStrict = WwStrict
wwUnpack xs = WwUnpack False xs
@@
-76,8
+80,9
@@
wwEnum = WwEnum
seqDemand :: Demand -> ()
seqDemand (WwLazy a) = a `seq` ()
seqDemand (WwUnpack b ds) = b `seq` seqDemands ds
seqDemand :: Demand -> ()
seqDemand (WwLazy a) = a `seq` ()
seqDemand (WwUnpack b ds) = b `seq` seqDemands ds
-seqDemand other = ()
+seqDemand _ = ()
+seqDemands :: [Demand] -> ()
seqDemands [] = ()
seqDemands (d:ds) = seqDemand d `seq` seqDemands ds
\end{code}
seqDemands [] = ()
seqDemands (d:ds) = seqDemand d `seq` seqDemands ds
\end{code}
@@
-99,7
+104,7
@@
isStrict d = not (isLazy d)
isPrim :: Demand -> Bool
isPrim WwPrim = True
isPrim :: Demand -> Bool
isPrim WwPrim = True
-isPrim other = False
+isPrim _ = False
\end{code}
\end{code}
@@
-111,12
+116,14
@@
isPrim other = False
\begin{code}
\begin{code}
+pprDemands :: [Demand] -> Bool -> SDoc
pprDemands demands bot = hcat (map pprDemand demands) <> pp_bot
where
pp_bot | bot = ptext SLIT("B")
| otherwise = empty
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 (WwLazy False) = char 'L'
pprDemand (WwLazy True) = char 'A'
pprDemand WwStrict = char 'S'
@@
-177,7
+184,7
@@
data StrictnessInfo
seqStrictnessInfo :: StrictnessInfo -> ()
seqStrictnessInfo (StrictnessInfo ds b) = b `seq` seqDemands ds
seqStrictnessInfo :: StrictnessInfo -> ()
seqStrictnessInfo (StrictnessInfo ds b) = b `seq` seqDemands ds
-seqStrictnessInfo other = ()
+seqStrictnessInfo _ = ()
\end{code}
\begin{code}
\end{code}
\begin{code}
@@
-188,17
+195,21
@@
mkStrictnessInfo (xs, is_bot)
| otherwise = StrictnessInfo xs is_bot
where
totally_boring (WwLazy False) = True
| otherwise = StrictnessInfo xs is_bot
where
totally_boring (WwLazy False) = True
- totally_boring other = False
+ totally_boring _ = False
+noStrictnessInfo :: StrictnessInfo
noStrictnessInfo = NoStrictnessInfo
noStrictnessInfo = NoStrictnessInfo
+isBottomingStrictness :: StrictnessInfo -> Bool
isBottomingStrictness (StrictnessInfo _ bot) = bot
isBottomingStrictness NoStrictnessInfo = False
-- appIsBottom returns true if an application to n args would diverge
isBottomingStrictness (StrictnessInfo _ bot) = bot
isBottomingStrictness NoStrictnessInfo = False
-- 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 (StrictnessInfo ds bot) n = bot && (listLengthCmp ds n /=GT) -- not more than 'n' elts in 'ds'.
-appIsBottom NoStrictnessInfo n = False
+appIsBottom NoStrictnessInfo _ = False
+ppStrictnessInfo :: StrictnessInfo -> SDoc
ppStrictnessInfo NoStrictnessInfo = empty
ppStrictnessInfo (StrictnessInfo wrapper_args bot) = hsep [pprDemands wrapper_args bot]
\end{code}
ppStrictnessInfo NoStrictnessInfo = empty
ppStrictnessInfo (StrictnessInfo wrapper_args bot) = hsep [pprDemands wrapper_args bot]
\end{code}