[Git][ghc/ghc][wip/andreask/deep_discounts] Make ppr prettier, fix docs maybe

[Andreas Klebinger (@AndreasK)]

Andreas Klebinger pushed to branch wip/andreask/deep_discounts at Glasgow Haskell Compiler / GHC


Commits:
74efca8f by Andreas Klebinger at 2022-08-08T00:19:08+02:00
Make ppr prettier, fix docs maybe

- - - - -


3 changed files:

- compiler/GHC/Core.hs
- compiler/GHC/Core/Unfold.hs
- docs/users_guide/using-optimisation.rst


Changes:

=====================================
compiler/GHC/Core.hs
=====================================
@@ -1390,9 +1390,9 @@ data ArgDiscount
             -- they will select, and provide a generic discount if we know the arg
             -- is a value but not what value exactly.
             -- Only of the the two discounts might be applied for the same argument.
-            | DiscSeq { ad_seq_discount :: !Int
-                      -- , ad_app_discount :: !Int
-                      , ad_con_discount :: !(ConMap ConDiscount)}
+            | DiscSeq { ad_seq_discount :: !Int -- ^ Discount if no specific constructor discount matches
+                      , ad_con_discount :: !(ConMap ConDiscount) -- ^ Discounts for specific constructors
+                      }
             -- A discount for the use of a function.
             | FunDisc { ad_seq_discount :: !Int, ad_fun :: Id}
             | NoSeqUse
@@ -1402,8 +1402,10 @@ instance Outputable ArgDiscount where
   ppr (SomeArgUse n)= text "seq:" <> ppr n
   ppr (NoSeqUse)= text "lazy use"
   ppr (FunDisc d f ) = text "fun-"<>ppr f<>text ":"<> ppr d
-  ppr (DiscSeq d_seq m) =
-    hang (text "disc:"<> ppr d_seq) 2 $ braces (pprUFM m ppr)
+  ppr (DiscSeq d_seq m)
+    | isNullUFM m = text "disc:"<> ppr d_seq
+    | otherwise = sep (punctuate comma ((text "some_con:"<> ppr d_seq) : map ppr (nonDetEltsUFM m)))
+      -- (text "some_con:"<> ppr d_seq) <> text "||" <> braces (pprUFM m ppr)
 
 -- | 'UnfoldingGuidance' says when unfolding should take place
 data UnfoldingGuidance


=====================================
compiler/GHC/Core/Unfold.hs
=====================================
@@ -283,14 +283,6 @@ calcUnfoldingGuidance opts is_top_bottoming expr
                          , ug_res   = scrut_discount }
 
   where
-    -- interesting_cased cased
-    --   | null cased = False
-    --   | otherwise = any (interesting_use . snd) cased
-    -- interesting_use NoSeqUse = False
-    -- interesting_use SomeArgUse{} = False
-    -- interesting_use (DiscSeq _d m) = sizeUFM m >= 1 -- True
-
-
     (bndrs, body) = collectBinders expr
     bOMB_OUT_SIZE = unfoldingCreationThreshold opts
            -- Bomb out if size gets bigger than this


=====================================
docs/users_guide/using-optimisation.rst
=====================================
@@ -1664,7 +1664,8 @@ by saying ``-fno-wombat``.
 
     If we have a function application `f (Succ (Succ Zero))` with the function `f`:
 
-    .. code-block:: haskell
+    .. code-block:: hs
+
         f x =
             case x of
                 Zero -> 0
@@ -1691,7 +1692,8 @@ by saying ``-fno-wombat``.
 
     If we have a function f:
 
-    .. code-block:: haskell
+    .. code-block:: hs
+
         f x =
             case x of
                 Zero -> 0



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74efca8f7bd539e8a9c020d5cb491abb43199729

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74efca8f7bd539e8a9c020d5cb491abb43199729
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/20220807/12ff3f94/attachment-0001.html>