[project @ 2004-11-10 04:17:50 by wolfgang]

[ghc-hetmet.git] / ghc / compiler / basicTypes / Demand.lhs

diff --git a/ghc/compiler/basicTypes/Demand.lhs b/ghc/compiler/basicTypes/Demand.lhs
index 17d13dc..a038a23 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}
+#ifndef OLD_STRICTNESS
+module Demand () where
+#else
+
 module Demand(
        Demand(..),
 
-       wwLazy, wwStrict, wwUnpackData, wwUnpackNew, wwPrim, wwEnum, 
+       wwLazy, wwStrict, wwUnpack, wwPrim, wwEnum, 
        isStrict, isLazy, isPrim,
 
        pprDemands, seqDemand, seqDemands,
@@ -18,13 +22,12 @@ module Demand(
        ppStrictnessInfo, seqStrictnessInfo,
        isBottomingStrictness, appIsBottom,
 
-       StrictnessMark(..), isMarkedUnboxed, isMarkedStrict
      ) where
 
 #include "HsVersions.h"
 
-import BasicTypes      ( NewOrData(..) )
 import Outputable
+import Util ( listLengthCmp )
 \end{code}
 
 
@@ -47,7 +50,6 @@ data Demand
                        -- 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
@@ -67,16 +69,14 @@ type MaybeAbsent = Bool -- True <=> not even used
 -- 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 -> ()
-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
@@ -91,8 +91,6 @@ seqDemands (d:ds) = seqDemand d `seq` seqDemands ds
 
 \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
 
@@ -124,13 +122,9 @@ pprDemand (WwLazy True)     = char 'A'
 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
-                                       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
@@ -202,42 +196,13 @@ isBottomingStrictness (StrictnessInfo _ bot) = bot
 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}
 
-
-%************************************************************************
-%*                                                                     *
-\subsection{Strictness indication}
-%*                                                                     *
-%************************************************************************
-
-The strictness annotations on types in data type declarations
-e.g.   data T = MkT !Int !(Bool,Bool)
-
 \begin{code}
-data StrictnessMark
-   = MarkedUserStrict  -- "!"  in a source decl
-   | MarkedStrict      -- "!"  in an interface decl: strict but not unboxed
-   | MarkedUnboxed     -- "!!" in an interface decl: unboxed 
-   | NotMarkedStrict   -- No annotation at all
-   deriving( Eq )
-
-isMarkedUnboxed MarkedUnboxed = True
-isMarkedUnboxed other        = False
-
-isMarkedStrict NotMarkedStrict = False
-isMarkedStrict other          = True   -- All others are strict
-
-instance Outputable StrictnessMark where
-  ppr MarkedUserStrict = ptext SLIT("!u")
-  ppr MarkedStrict     = ptext SLIT("!")
-  ppr MarkedUnboxed    = ptext SLIT("! !")
-  ppr NotMarkedStrict  = empty
+#endif /* OLD_STRICTNESS */
 \end{code}
-
-