Do not export DmdResult constructors in Demand.lhs
authorJoachim Breitner <mail@joachim-breitner.de>
Mon, 9 Dec 2013 16:56:32 +0000 (16:56 +0000)
committerJoachim Breitner <mail@joachim-breitner.de>
Mon, 16 Dec 2013 20:30:00 +0000 (21:30 +0100)
compiler/basicTypes/Demand.lhs
compiler/basicTypes/MkId.lhs

index 3d393f1..3ca8466 100644 (file)
@@ -25,7 +25,7 @@ module Demand (
         DmdEnv, emptyDmdEnv,
         peelFV,
 
-        DmdResult(..), CPRResult(..),
+        DmdResult, CPRResult,
         isBotRes, isTopRes, resTypeArgDmd, 
         topRes, botRes, cprProdRes, vanillaCprProdRes, cprSumRes,
         appIsBottom, isBottomingSig, pprIfaceStrictSig, 
@@ -768,19 +768,19 @@ topRes, botRes :: DmdResult
 topRes = Dunno NoCPR
 botRes = Diverges
 
-cprSumRes :: ConTag -> CPRResult
-cprSumRes tag | opt_CprOff = NoCPR
-              | otherwise  = RetSum tag
+cprSumRes :: ConTag -> DmdResult
+cprSumRes tag | opt_CprOff = topRes
+              | otherwise  = Dunno $ RetSum tag
 
-cprProdRes :: [DmdType] -> CPRResult
+cprProdRes :: [DmdType] -> DmdResult
 cprProdRes _arg_tys
-  | opt_CprOff = NoCPR
-  | otherwise  = RetProd
+  | opt_CprOff = topRes
+  | otherwise  = Dunno $ RetProd
 
-vanillaCprProdRes :: Arity -> CPRResult
+vanillaCprProdRes :: Arity -> DmdResult
 vanillaCprProdRes _arity
-  | opt_CprOff = NoCPR
-  | otherwise  = RetProd
+  | opt_CprOff = topRes
+  | otherwise  = Dunno $ RetProd
 
 isTopRes :: DmdResult -> Bool
 isTopRes (Dunno NoCPR) = True
index 6120b56..604163f 100644 (file)
@@ -434,8 +434,8 @@ dataConCPR con
   , isVanillaDataCon con  -- No existentials 
   , wkr_arity > 0
   , wkr_arity <= mAX_CPR_SIZE
-  = if is_prod then Dunno (vanillaCprProdRes (dataConRepArity con))
-               else Dunno (cprSumRes (dataConTag con))
+  = if is_prod then vanillaCprProdRes (dataConRepArity con)
+               else cprSumRes (dataConTag con)
   | otherwise
   = topRes
   where