[project @ 2001-10-03 16:20:57 by simonpj]

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

diff --git a/ghc/compiler/basicTypes/NewDemand.lhs b/ghc/compiler/basicTypes/NewDemand.lhs
index d496c96..2c83d95 100644 (file)
--- a/ghc/compiler/basicTypes/NewDemand.lhs
+++ b/ghc/compiler/basicTypes/NewDemand.lhs
@@ -13,7 +13,7 @@ module NewDemand(
        DmdEnv, emptyDmdEnv,
        DmdResult(..), isBotRes, returnsCPR,
 
-       StrictSig(..), mkStrictSig, topSig, botSig, 
+       StrictSig(..), mkStrictSig, topSig, botSig, isTopSig,
        splitStrictSig, strictSigResInfo,
        pprIfaceStrictSig, appIsBottom, isBottomingSig
      ) where
@@ -80,6 +80,11 @@ emptyDmdEnv = emptyVarEnv
 topDmdType = DmdType emptyDmdEnv [] TopRes
 botDmdType = DmdType emptyDmdEnv [] BotRes
 
+isTopDmdType :: DmdType -> Bool
+-- Only used on top-level types, hence the assert
+isTopDmdType (DmdType _ [] TopRes) = ASSERT( isEmptyVarEnv env) True   
+isTopDmdType other                = False
+
 isBotRes :: DmdResult -> Bool
 isBotRes BotRes = True
 isBotRes other  = False
@@ -152,6 +157,8 @@ splitStrictSig (StrictSig (DmdType _ dmds res)) = (dmds, res)
 strictSigResInfo :: StrictSig -> DmdResult
 strictSigResInfo (StrictSig (DmdType _ _ res)) = res
 
+isTopSig (StrictSig ty) = isTopDmdType ty
+
 topSig = StrictSig topDmdType
 botSig = StrictSig botDmdType