[Git][ghc/ghc][wip/refactor-demand] Smart constructor for product demands

[Sebastian Graf]

Sebastian Graf pushed to branch wip/refactor-demand at Glasgow Haskell Compiler / GHC


Commits:
3b237ed9 by Sebastian Graf at 2020-10-30T15:50:51+01:00
Smart constructor for product demands

- - - - -


2 changed files:

- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Types/Demand.hs


Changes:

=====================================
compiler/GHC/Core/Opt/DmdAnal.hs
=====================================
@@ -244,7 +244,7 @@ dmdAnal' env dmd (Case scrut case_bndr ty [(DataAlt dc, bndrs, rhs)])
 
         -- Compute demand on the scrutinee
         -- See Note [Demand on scrutinee of a product case]
-        scrut_dmd          = Prod id_dmds
+        scrut_dmd          = mkProd id_dmds
         (scrut_ty, scrut') = dmdAnal env scrut_dmd scrut
         res_ty             = alt_ty3 `plusDmdType` toBothDmdArg scrut_ty
         case_bndr'         = setIdDemandInfo case_bndr case_bndr_dmd


=====================================
compiler/GHC/Types/Demand.hs
=====================================
@@ -12,7 +12,7 @@
 -}
 
 module GHC.Types.Demand (
-        Card(..), Demand(..), CleanDemand(Prod), viewProd,
+        Card(..), Demand(..), CleanDemand(Prod), mkProd, viewProd,
         oneifyDmd, oneifyCard,
         absDmd, topDmd, botDmd, seqDmd,
         lubCard, lubDmd, lubCleanDmd,
@@ -480,7 +480,7 @@ data CleanDemand
   deriving ( Eq, Show )
 
 poly00, poly01, poly0N, poly11, poly1N, poly10 :: CleanDemand
-topCleanDmd, _botCleanDmd, seqCleanDmd :: CleanDemand
+topCleanDmd, botCleanDmd, seqCleanDmd :: CleanDemand
 poly00 = Poly C_00
 poly01 = Poly C_01
 poly0N = Poly C_0N
@@ -488,7 +488,7 @@ poly11 = Poly C_11
 poly1N = Poly C_1N
 poly10 = Poly C_10
 topCleanDmd = poly0N
-_botCleanDmd = poly10
+botCleanDmd = poly10
 seqCleanDmd = poly00
 
 polyDmd :: Card -> Demand
@@ -512,6 +512,21 @@ lazyApply1Dmd   = C_01 :* Call C_01 topCleanDmd
 --    but is lazy (might not be called at all)
 lazyApply2Dmd = C_01 :* Call C_01 (Call C_01 topCleanDmd)
 
+-- | A smart constructor for 'Prod', applying rewrite rules along the semantic
+-- equalities @Prod [polyDmd n, ...] === polyDmd n@, simplifying to polymorphic
+-- demands when possible. Note that this degrades boxity information! E.g. a
+-- polymorphic demand will never unbox.
+mkProd :: [Demand] -> CleanDemand
+mkProd [] = botCleanDmd
+mkProd ds@(n:*cd : _)
+  | want_to_simplify n, all (== polyDmd n) ds = cd
+  | otherwise                                 = Prod ds
+  where
+    -- we only want to simplify absent and bottom demands
+    want_to_simplify C_00 = True
+    want_to_simplify C_10 = True
+    want_to_simplify _    = False
+
 viewProd :: Arity -> CleanDemand -> Maybe [Demand]
 viewProd n (Prod ds)     | ds `lengthIs` n = Just ds
 viewProd n (Poly card)                     = Just (replicate n (polyDmd card))



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3b237ed92121a9ecb884879c5b2da2b3f5f56437

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3b237ed92121a9ecb884879c5b2da2b3f5f56437
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20201030/6c943dd7/attachment-0001.html>