[Git][ghc/ghc][wip/spj-unf-size] Be consistent about call sizes

[Simon Peyton Jones (@simonpj)]

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


Commits:
fa3fd712 by Simon Peyton Jones at 2024-01-15T12:50:21+00:00
Be consistent about call sizes

- - - - -


2 changed files:

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


Changes:

=====================================
compiler/GHC/Core/Opt/Simplify/Inline.hs
=====================================
@@ -247,15 +247,15 @@ tryUnfolding logger env fn cont unf_template unf_cache guidance
                         -> exprDigest env expr
                 _ -> ArgNoInfo
 
-          -------- Size adjustements ----------------
+          -------- Size adjustments ----------------
           -- Subtract size of the call, because the result replaces the call
-          -- We count 10 for the function itself, 10 for each arg supplied,
-          -- plus an extra discount of 10 for each argument which has
-          -- interesting info, regardless of the function body.
-          call_size_discount = 10 + args_discount
-          args_discount = foldr ((+) . arg_discount) 0 (take n_bndrs arg_infos)
-          arg_discount arg_info | hasArgInfo arg_info = 20
-                                | otherwise           = 10
+          -- We count 2 for the function itself, 2 for each arg supplied,
+          -- plus a rather-arbitrary extra discount of 10 for each argument which
+          -- has interesting info, regardless of the function body.
+          -- Should line up with GHC.Core.Unfold.vanillaCallSize
+          call_size_discount = foldr ((+) . arg_discount) 2 (take n_bndrs arg_infos)
+          arg_discount arg_info | hasArgInfo arg_info = 10
+                                | otherwise           = 2
 
           actual_ret_discount | n_bndrs < n_val_args
                               = ret_discount


=====================================
compiler/GHC/Core/Unfold.hs
=====================================
@@ -761,16 +761,20 @@ litSize _other = 0    -- Must match size of nullary constructors
 
 ----------------------------
 callTree :: UnfoldingOpts -> ETVars -> Id -> [CoreExpr] -> ExprTree
+-- Caller accounts for the size of the arguments,
+-- but not for the cost of building a closure
 callTree opts vs fun val_args
   = case idDetails fun of
       FCallId _        -> exprTreeS (vanillaCallSize val_args)
       JoinId {}        -> exprTreeS (jumpSize        val_args)
       PrimOpId op _    -> exprTreeS (primOpSize op   val_args)
-      DataConWorkId dc -> conAppET dc val_args
+      DataConWorkId dc -> exprTreeS (conAppSize dc val_args)
       ClassOpId {}     -> classOpAppET opts vs fun val_args
       _                -> genAppET opts vs fun val_args
 
 -- | The size of a function call
+-- Caller accounts for the size of the arguments,
+-- but not for the cost of building a closure
 vanillaCallSize :: [CoreExpr] -> Size
 vanillaCallSize val_args = foldl' arg_sz 2 val_args
   where
@@ -782,6 +786,33 @@ vanillaCallSize val_args = foldl' arg_sz 2 val_args
         -- The 1+ is for the function itself
         -- Add 1 for each non-trivial value arg
 
+conAppSize :: DataCon -> [CoreExpr] -> Size
+-- Smaller than vanillaCallSize; don't charge for the call
+-- itself, just for the closures it builds
+conAppSize _dc val_args = foldl' arg_sz 0 val_args
+  where
+    arg_sz n arg
+      | exprIsTrivial arg = n
+      | otherwise         = n+closureSize
+{-
+  | isUnboxedTupleDataCon dc
+  = etZero     -- See Note [Unboxed tuple size and result discount]
+  | n_val_args == 0    -- Like variables
+  = etZero
+  | otherwise  -- See Note [Constructor size and result discount]
+  = ExprTree { et_size = 10, et_wc_tot = 10
+             , et_cases = emptyBag, et_ret = 10 }
+-}
+
+primOpSize :: PrimOp -> [CoreExpr] -> Size
+-- Args are almost always strict, so we don't charge for arg
+-- closures, unlike vanillaCallSize, conAppSize
+primOpSize op val_args
+  | primOpOutOfLine op = op_size + length val_args
+  | otherwise          = op_size
+ where
+   op_size = primOpCodeSize op
+
 -- | The size of a jump to a join point
 jumpSize :: [CoreExpr] -> Size
 jumpSize val_args = vanillaCallSize val_args
@@ -811,6 +842,8 @@ classOpAppET opts vs fn val_args
 genAppET :: UnfoldingOpts -> ETVars -> Id -> [CoreExpr] -> ExprTree
 -- Size for function calls that are not constructors or primops
 -- Note [Function applications]
+-- Caller accounts for the size of the arguments,
+-- but not for the cost of building a closure
 genAppET opts (avs,_) fun val_args
   | fun `hasKey` buildIdKey   = etZero  -- We want to inline applications of build/augment
   | fun `hasKey` augmentIdKey = etZero  -- so we give size zero to the whole call
@@ -838,25 +871,6 @@ lamSize :: UnfoldingOpts -> ExprTree
 -- Does not include the size of the body, just the lambda itself
 lamSize _ = etZero  -- Lambdas themselves cost nothing
 
-conAppET :: DataCon -> [CoreExpr] -> ExprTree
--- Does not need to include the size of the arguments themselves
-conAppET _dc _n_val_args = etZero
-{-
-  | isUnboxedTupleDataCon dc
-  = etZero     -- See Note [Unboxed tuple size and result discount]
-  | n_val_args == 0    -- Like variables
-  = etZero
-  | otherwise  -- See Note [Constructor size and result discount]
-  = ExprTree { et_size = 10, et_wc_tot = 10
-             , et_cases = emptyBag, et_ret = 10 }
--}
-
-primOpSize :: PrimOp -> [CoreExpr] -> Size
-primOpSize op val_args
-  | primOpOutOfLine op = op_size + length val_args
-  | otherwise          = op_size
- where
-   op_size = primOpCodeSize op
 
 closureSize :: Size  -- Size for a heap-allocated closure
 closureSize = 15



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa3fd7122c76e884a700511c971a9160957b75f8
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/20240115/c4be059e/attachment-0001.html>