[project @ 2001-07-31 11:06:00 by simonmar]

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

diff --git a/ghc/compiler/basicTypes/NewDemand.lhs b/ghc/compiler/basicTypes/NewDemand.lhs
index 0dcb69a..735c5ef 100644 (file)
--- a/ghc/compiler/basicTypes/NewDemand.lhs
+++ b/ghc/compiler/basicTypes/NewDemand.lhs
@@ -6,7 +6,7 @@
 \begin{code}
 module NewDemand(
        Demand(..), Keepity(..), Deferredness(..), 
-       topDmd, lazyDmd, seqDmd, evalDmd, isStrictDmd,
+       topDmd, lazyDmd, seqDmd, evalDmd, isStrictDmd, isAbsentDmd,
 
        DmdType(..), topDmdType, mkDmdType, mkTopDmdType, 
                dmdTypeDepth, dmdTypeRes,
@@ -66,9 +66,11 @@ instance Outputable DmdType where
   ppr (DmdType fv ds res) 
     = hsep [text "DmdType",
            hcat (map ppr ds) <> ppr res,
-           braces (fsep (map pp_elt (ufmToList fv)))]
+           if null fv_elts then empty
+           else braces (fsep (map pp_elt fv_elts))]
     where
       pp_elt (uniq, dmd) = ppr uniq <> text "->" <> ppr dmd
+      fv_elts = ufmToList fv
 
 instance Outputable DmdResult where
   ppr TopRes = empty     -- Keep these distinct from Demand letters
@@ -212,6 +214,12 @@ isStrictDmd Eval     = True
 isStrictDmd (Call _)     = True
 isStrictDmd other        = False
 
+isAbsentDmd :: Demand -> Bool
+isAbsentDmd Bot          = True
+isAbsentDmd Err          = True
+isAbsentDmd Abs          = True
+isAbsentDmd other = False
+
 instance Outputable Demand where
     ppr Lazy        = char 'L'
     ppr Abs         = char 'A'