projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix free-variable finder
[ghc-hetmet.git]
/
ghc
/
compiler
/
basicTypes
/
Demand.lhs
diff --git
a/ghc/compiler/basicTypes/Demand.lhs
b/ghc/compiler/basicTypes/Demand.lhs
index
546e3a2
..
50bb0c6
100644
(file)
--- a/
ghc/compiler/basicTypes/Demand.lhs
+++ b/
ghc/compiler/basicTypes/Demand.lhs
@@
-4,10
+4,14
@@
\section[Demand]{@Demand@: the amount of demand on a value}
\begin{code}
\section[Demand]{@Demand@: the amount of demand on a value}
\begin{code}
+#ifndef OLD_STRICTNESS
+module Demand () where
+#else
+
module Demand(
Demand(..),
module Demand(
Demand(..),
- wwLazy, wwStrict, wwUnpackData, wwUnpackNew, wwPrim, wwEnum,
+ wwLazy, wwStrict, wwUnpack, wwPrim, wwEnum,
isStrict, isLazy, isPrim,
pprDemands, seqDemand, seqDemands,
isStrict, isLazy, isPrim,
pprDemands, seqDemand, seqDemands,
@@
-17,12
+21,13
@@
module Demand(
noStrictnessInfo,
ppStrictnessInfo, seqStrictnessInfo,
isBottomingStrictness, appIsBottom,
noStrictnessInfo,
ppStrictnessInfo, seqStrictnessInfo,
isBottomingStrictness, appIsBottom,
+
) where
#include "HsVersions.h"
) where
#include "HsVersions.h"
-import BasicTypes ( NewOrData(..) )
import Outputable
import Outputable
+import Util ( listLengthCmp )
\end{code}
\end{code}
@@
-37,7
+42,7
@@
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
= 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
+ -- *definitely* lazy. (NB: Absence implies
-- a worker...)
| WwStrict -- Argument is strict but that's all we know
-- a worker...)
| WwStrict -- Argument is strict but that's all we know
@@
-45,7
+50,6
@@
data Demand
-- calling-convention magic)
| WwUnpack -- Argument is strict & a single-constructor type
-- calling-convention magic)
| WwUnpack -- Argument is strict & a single-constructor type
- NewOrData
Bool -- True <=> wrapper unpacks it; False <=> doesn't
[Demand] -- Its constituent parts (whose StrictInfos
-- are in the list) should be passed
Bool -- True <=> wrapper unpacks it; False <=> doesn't
[Demand] -- Its constituent parts (whose StrictInfos
-- are in the list) should be passed
@@
-65,16
+69,14
@@
type MaybeAbsent = Bool -- True <=> not even used
-- versions that don't worry about Absence:
wwLazy = WwLazy False
wwStrict = WwStrict
-- versions that don't worry about Absence:
wwLazy = WwLazy False
wwStrict = WwStrict
-wwUnpackData xs = WwUnpack DataType False xs
-wwUnpackNew x = ASSERT( isStrict x) -- Invariant
- WwUnpack NewType False [x]
+wwUnpack xs = WwUnpack False xs
wwPrim = WwPrim
wwEnum = WwEnum
seqDemand :: Demand -> ()
wwPrim = WwPrim
wwEnum = WwEnum
seqDemand :: Demand -> ()
-seqDemand (WwLazy a) = a `seq` ()
-seqDemand (WwUnpack nd b ds) = nd `seq` b `seq` seqDemands ds
-seqDemand other = ()
+seqDemand (WwLazy a) = a `seq` ()
+seqDemand (WwUnpack b ds) = b `seq` seqDemands ds
+seqDemand other = ()
seqDemands [] = ()
seqDemands (d:ds) = seqDemand d `seq` seqDemands ds
seqDemands [] = ()
seqDemands (d:ds) = seqDemand d `seq` seqDemands ds
@@
-89,8
+91,6
@@
seqDemands (d:ds) = seqDemand d `seq` seqDemands ds
\begin{code}
isLazy :: Demand -> Bool
\begin{code}
isLazy :: Demand -> Bool
- -- Even a demand of (WwUnpack NewType _ _) is strict
- -- We don't create such a thing unless the demand inside is strict
isLazy (WwLazy _) = True
isLazy _ = False
isLazy (WwLazy _) = True
isLazy _ = False
@@
-122,13
+122,9
@@
pprDemand (WwLazy True) = char 'A'
pprDemand WwStrict = char 'S'
pprDemand WwPrim = char 'P'
pprDemand WwEnum = char 'E'
pprDemand WwStrict = char 'S'
pprDemand WwPrim = char 'P'
pprDemand WwEnum = char 'E'
-pprDemand (WwUnpack nd wu args) = char ch <> parens (hcat (map pprDemand args))
+pprDemand (WwUnpack wu args) = char ch <> parens (hcat (map pprDemand args))
where
where
- ch = case nd of
- DataType | wu -> 'U'
- | otherwise -> 'u'
- NewType | wu -> 'N'
- | otherwise -> 'n'
+ ch = if wu then 'U' else 'u'
instance Outputable Demand where
ppr (WwLazy False) = empty
instance Outputable Demand where
ppr (WwLazy False) = empty
@@
-200,10
+196,13
@@
isBottomingStrictness (StrictnessInfo _ bot) = bot
isBottomingStrictness NoStrictnessInfo = False
-- appIsBottom returns true if an application to n args would diverge
isBottomingStrictness NoStrictnessInfo = False
-- appIsBottom returns true if an application to n args would diverge
-appIsBottom (StrictnessInfo ds bot) n = bot && (n >= length ds)
+appIsBottom (StrictnessInfo ds bot) n = bot && (listLengthCmp ds n /=GT) -- not more than 'n' elts in 'ds'.
appIsBottom NoStrictnessInfo n = False
ppStrictnessInfo NoStrictnessInfo = empty
ppStrictnessInfo (StrictnessInfo wrapper_args bot) = hsep [pprDemands wrapper_args bot]
\end{code}
appIsBottom NoStrictnessInfo n = False
ppStrictnessInfo NoStrictnessInfo = empty
ppStrictnessInfo (StrictnessInfo wrapper_args bot) = hsep [pprDemands wrapper_args bot]
\end{code}
+\begin{code}
+#endif /* OLD_STRICTNESS */
+\end{code}