[commit: ghc] cardinality: Use mkSProd consistently (998cc10)

Simon Peyton Jones simonpj at microsoft.com
Fri Mar 22 15:36:42 CET 2013


Repository : http://darcs.haskell.org/ghc.git/

On branch  : cardinality

https://github.com/ghc/ghc/commit/998cc100017563768e97bfb18a562dc258c3dafb

>---------------------------------------------------------------

commit 998cc100017563768e97bfb18a562dc258c3dafb
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri Mar 22 14:35:46 2013 +0000

    Use mkSProd consistently

>---------------------------------------------------------------

 compiler/basicTypes/Demand.lhs | 44 +++++++++++++++++++++---------------------
 1 file changed, 22 insertions(+), 22 deletions(-)

diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs
index e4f1679..f1fec34 100644
--- a/compiler/basicTypes/Demand.lhs
+++ b/compiler/basicTypes/Demand.lhs
@@ -105,12 +105,12 @@ strBot, strTop :: MaybeStr
 strBot = Str HyperStr
 strTop = Lazy
 
-strCall :: StrDmd -> StrDmd
-strCall HyperStr = HyperStr
-strCall s        = SCall s
+mkSCall :: StrDmd -> StrDmd
+mkSCall HyperStr = HyperStr
+mkSCall s        = SCall s
 
-strProd :: [MaybeStr] -> StrDmd
-strProd sx
+mkSProd :: [MaybeStr] -> StrDmd
+mkSProd sx
   | any isHyperStr sx = HyperStr
   | all isLazy     sx = HeadStr
   | otherwise         = SProd sx
@@ -148,7 +148,7 @@ lubStr (SCall _)  (SProd _)    = HeadStr
 lubStr (SProd sx) HyperStr     = SProd sx
 lubStr (SProd _)  HeadStr      = HeadStr
 lubStr (SProd s1) (SProd s2)
-    | length s1 == length s2   = SProd (zipWith lubMaybeStr s1 s2)
+    | length s1 == length s2   = mkSProd (zipWith lubMaybeStr s1 s2)
     | otherwise                = HeadStr
 lubStr (SProd _) (SCall _)     = HeadStr
 lubStr HeadStr   _             = HeadStr
@@ -169,7 +169,7 @@ bothStr (SCall _)  (SProd _)   = HyperStr  -- Weird
 bothStr (SProd _)  HyperStr    = HyperStr
 bothStr (SProd s1) HeadStr     = SProd s1
 bothStr (SProd s1) (SProd s2) 
-    | length s1 == length s2   = SProd (zipWith bothMaybeStr s1 s2)
+    | length s1 == length s2   = mkSProd (zipWith bothMaybeStr s1 s2)
     | otherwise                = HyperStr  -- Weird
 bothStr (SProd _) (SCall _)    = HyperStr
 
@@ -271,12 +271,12 @@ useBot, useTop :: MaybeUsed
 useBot     = Abs
 useTop     = Use Many Used
 
-useCall :: Count -> UseDmd -> UseDmd
---useCall c Used = Used c 
-useCall c a  = UCall c a
+mkUCall :: Count -> UseDmd -> UseDmd
+--mkUCall c Used = Used c 
+mkUCall c a  = UCall c a
 
-useProd :: [MaybeUsed] -> UseDmd
-useProd ux 
+mkUProd :: [MaybeUsed] -> UseDmd
+mkUProd ux 
   | all (== Abs) ux    = UHead
   | otherwise          = UProd ux
 
@@ -599,12 +599,12 @@ mkProdDmd :: [JointDmd] -> CleanDemand
 mkProdDmd dx 
   = mkCleanDmd sp up 
   where
-    sp = strProd $ map strd dx
-    up = useProd $ map absd dx   
+    sp = mkSProd $ map strd dx
+    up = mkUProd $ map absd dx   
 
 mkCallDmd :: CleanDemand -> CleanDemand
 mkCallDmd (CD {sd = d, ud = u}) 
-  = mkCleanDmd (strCall d) (useCall One u)
+  = mkCleanDmd (mkSCall d) (mkUCall One u)
 
 -- Returns result demand * strictness flag * one-shotness of the call 
 peelCallDmd :: CleanDemand 
@@ -634,8 +634,8 @@ peelCallDmd (CD {sd = s, ud = u})
 vanillaCall :: Arity -> CleanDemand
 vanillaCall 0 = cleanEvalDmd
 vanillaCall n =
-  let strComp = nTimes n strCall       HeadStr
-      absComp = nTimes n (useCall One) Used
+  let strComp = nTimes n mkSCall       HeadStr
+      absComp = nTimes n (mkUCall One) Used
    in mkCleanDmd strComp absComp
 
 cleanEvalDmd :: CleanDemand
@@ -652,7 +652,7 @@ isSingleUsed (JD {absd=a}) = is_used_once a
 -- mkThresholdDmd :: Arity -> JointDmd
 -- mkThresholdDmd 0 = topDmd
 -- mkThresholdDmd n =
---   let absComp = (iterate (useCall One) useTop) !! n
+--   let absComp = (iterate (mkUCall One) useTop) !! n
 --    in mkJointDmd Lazy absComp
 
 
@@ -1349,9 +1349,9 @@ instance Binary StrDmd where
            0 -> do return HyperStr
            1 -> do return HeadStr
            2 -> do s  <- get bh
-                   return $ strCall s
+                   return (SCall s)
            _ -> do sx <- get bh
-                   return $ strProd sx
+                   return (SProd sx)
 
 instance Binary MaybeStr where
     put_ bh Lazy         = do 
@@ -1412,9 +1412,9 @@ instance Binary UseDmd where
               1 -> return $ UHead
               2 -> do c <- get bh
                       u <- get bh
-                      return $ useCall c u  
+                      return (UCall c u)
               _ -> do ux <- get bh
-                      return $ useProd ux
+                      return (UProd ux)
 
 instance Binary JointDmd where
     put_ bh (JD {strd = x, absd = y}) = do put_ bh x; put_ bh y





More information about the ghc-commits mailing list