[Git][ghc/ghc][wip/spj-unf-size] Be a little bit more eager

[Simon Peyton Jones (@simonpj)]

Simon Peyton Jones pushed to branch wip/spj-unf-size at Glasgow Haskell Compiler / GHC


Commits:
1fe57484 by Simon Peyton Jones at 2023-10-23T20:45:44+01:00
Be a little bit more eager

- - - - -


2 changed files:

- compiler/GHC/Core/Opt/Simplify/Inline.hs
- compiler/GHC/Core/Unfold.hs


Changes:

=====================================
compiler/GHC/Core/Opt/Simplify/Inline.hs
=====================================
@@ -615,7 +615,8 @@ exprSummary env e = go env e []
       where
         env' = modifyInScope env b  -- Tricky corner here
 
-    go _ _ _ = ArgNoInfo
+    go _ _ _ = ArgIsNot []    -- Some structure; not all boring
+                              -- Example of improvement: base/tests/T9848
 
     go_var :: SimplEnv -> Id
            -> [CoreExpr]   -- Value args only
@@ -624,12 +625,16 @@ exprSummary env e = go env e []
       | Just con <- isDataConWorkId_maybe f
       = ArgIsCon (DataAlt con) (map (exprSummary env) val_args)
 
-      | OtherCon cs <- unfolding
-      = ArgIsNot cs
+      | DFunUnfolding {} <- unfolding
+      = ArgIsNot []  -- Says "this is a data con" without saying which
+                     -- Will also return this for ($df d1 .. dn)
 
       | Just rhs <- expandUnfolding_maybe unfolding
       = go (zapSubstEnv env) rhs val_args
 
+      | OtherCon cs <- unfolding
+      = ArgIsNot cs
+
       | idArity f > length val_args
       = ArgIsLam
 


=====================================
compiler/GHC/Core/Unfold.hs
=====================================
@@ -562,9 +562,9 @@ exprTree opts args expr
     -----------------------------
     -- size_up_app is used when there's ONE OR MORE value args
     go_app :: ETVars -> CoreExpr -> [CoreExpr] -> ExprTree
-                   -- args are the non-void value args
+                   -- args are the value args
     go_app vs (App fun arg) args
-               | arg_is_free arg = go_app vs fun args
+               | isTypeArg arg   = go_app vs fun args
                | otherwise       = go vs arg `et_add`
                                    go_app vs fun (arg:args)
     go_app vs (Var fun)     args = callTree opts vs fun args
@@ -1089,7 +1089,8 @@ caseTreeSize :: InlineContext -> CaseTree -> Size
 caseTreeSize ic (ScrutOf bndr disc)
   = case lookupBndr ic bndr of
       ArgNoInfo   -> sizeN 0
-      ArgIsNot {} -> sizeN 0
+      ArgIsNot {} -> sizeN (-disc)  -- E.g. bndr is a DFun application
+                                    --      T8732 need to inline mapM_
       ArgIsLam    -> sizeN (-disc)  -- Apply discount
       ArgIsCon {} -> sizeN (-disc)  -- Apply discount
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1fe57484a32e5c5e24d67457412df83cf095eb05

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1fe57484a32e5c5e24d67457412df83cf095eb05
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/20231023/71335a22/attachment-0001.html>