[Git][ghc/ghc][wip/spj-unf-size] 2 commits: Better eqString/eqList stuff
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Thu Dec 7 15:49:51 UTC 2023
Simon Peyton Jones pushed to branch wip/spj-unf-size at Glasgow Haskell Compiler / GHC
Commits:
ba3e72ea by Simon Peyton Jones at 2023-12-07T15:45:12+00:00
Better eqString/eqList stuff
- - - - -
97e35465 by Simon Peyton Jones at 2023-12-07T15:49:08+00:00
Adjust
* Reduce caseElimDiscount to 10
Example: f_nand in spectral/hartel/event is quite big but was still
getting inlined; that make f_simulate too big for SpecConstr
* Increase jumpSize. Not so much cheaper than tail calls.
I'm trying making them the same size.
- - - - -
4 changed files:
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/Core/Unfold.hs
- libraries/base/src/GHC/Base.hs
- libraries/ghc-prim/GHC/Classes.hs
Changes:
=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -1018,7 +1018,7 @@ unpackCStringName, unpackCStringFoldrName,
unpackCStringAppendName, unpackCStringAppendUtf8Name,
eqStringName, cstringLengthName :: Name
cstringLengthName = varQual gHC_CSTRING (fsLit "cstringLength#") cstringLengthIdKey
-eqStringName = varQual gHC_BASE (fsLit "eqString") eqStringIdKey
+eqStringName = varQual gHC_CLASSES (fsLit "eqString") eqStringIdKey
unpackCStringName = varQual gHC_CSTRING (fsLit "unpackCString#") unpackCStringIdKey
unpackCStringAppendName = varQual gHC_CSTRING (fsLit "unpackAppendCString#") unpackCStringAppendIdKey
=====================================
compiler/GHC/Core/Unfold.hs
=====================================
@@ -207,7 +207,7 @@ defaultUnfoldingOpts = UnfoldingOpts
-- into the interface file.)
, unfoldingUseThreshold = 75
- -- Adjusted 90 -> 80 when adding discounts for free variables which
+ -- Adjusted 90 -> 75 when adding discounts for free variables which
-- generally make things more likely to inline. Reducing the threshold
-- eliminates some undesirable compile-time regressions (e.g. T10412a)
--
@@ -823,7 +823,9 @@ vanillaCallSize n_val_args voids = 10 * (1 + n_val_args - voids)
-- | The size of a jump to a join point
jumpSize :: Int -> Int -> Size
-jumpSize n_val_args voids = 2 * (1 + n_val_args - voids)
+jumpSize n_val_args voids = 10 * (n_val_args - voids)
+ -- Not so much smaller than an ordinary call;
+ -- Trying the effect of not charging for the function head itself
-- A jump is 20% the size of a function call. Making jumps free reopens
-- bug #6048, but making them any more expensive loses a 21% improvement in
-- spectral/puzzle. TODO Perhaps adjusting the default threshold would be a
@@ -913,7 +915,7 @@ caseSize scrut_id alts
caseElimDiscount :: Discount
-- Bonus for eliminating a case
-caseElimDiscount = 15
+caseElimDiscount = 10
{- Note [Bale out on very wide case expressions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
libraries/base/src/GHC/Base.hs
=====================================
@@ -1666,17 +1666,6 @@ unsafeChr (I# i#) = C# (chr# i#)
ord :: Char -> Int
ord (C# c#) = I# (ord# c#)
--- | This 'String' equality predicate is used when desugaring
--- pattern-matches against strings.
-eqString :: String -> String -> Bool
-eqString [] [] = True
-eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2
-eqString _ _ = False
-
-{-# RULES "eqString" (==) = eqString #-}
--- eqString also has a BuiltInRule in GHC.Core.Opt.ConstantFold:
--- eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2)) = s1==s2
-
----------------------------------------------
-- 'Int' related definitions
=====================================
libraries/ghc-prim/GHC/Classes.hs
=====================================
@@ -47,7 +47,8 @@ module GHC.Classes(
eqInt, neInt,
eqWord, neWord,
eqChar, neChar,
- eqFloat, eqDouble,
+ eqFloat, eqDouble, eqString,
+
-- ** Monomorphic comparison operators
gtInt, geInt, leInt, ltInt, compareInt, compareInt#,
gtWord, geWord, leWord, ltWord, compareWord, compareWord#,
@@ -146,10 +147,8 @@ class Eq a where
{-# INLINE (/=) #-}
{-# INLINE (==) #-}
- -- Write these with no arg, so that they inline even as the argument of
- -- the DFun. Then the RULES for eqList can fire.
- (/=) = \x y -> not (x == y)
- (==) = \x y -> not (x /= y)
+ (/=) x y = not (x == y)
+ (==) x y = not (x /= y)
{-# MINIMAL (==) | (/=) #-}
deriving instance Eq ()
@@ -187,6 +186,7 @@ deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
Eq h, Eq i, Eq j, Eq k, Eq l, Eq m, Eq n, Eq o)
=> Eq (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
+----------------------------------------------
instance (Eq a) => Eq [a] where
{-# SPECIALISE instance Eq [[Char]] #-}
{-# SPECIALISE instance Eq [Char] #-}
@@ -196,18 +196,47 @@ instance (Eq a) => Eq [a] where
-- These rules avoid the recursive function when
-- one of the arguments is the empty list. We want
-- good code for xs == [] or xs /= []
+-- The sequence is this:
+-- (/=) @ty ($dEqList d) xs []
+-- -->{ClassOp rule} $dm/= @ty d xs []
+-- -->{inline $dm/=} not (eqList d xs [])
+-- and now the eqList1 rule can fire
{-# RULES
-"eqList1" forall xs. eqList xs [] = case xs of { [] -> True; _ -> False }
-"eqList2" forall ys. eqList [] ys = case ys of { [] -> True; _ -> False }
+"eqList1" forall xs. eqList xs [] = null xs
+"eqList2" forall xs. eqList [] xs = null xs
#-}
eqList :: Eq a => [a] -> [a] -> Bool
-{-# NOINLINE [1] eqList #-} -- Give the RULES eqList1/eqList2 a chance to fire
-- eqList should auto-specialise for the same types as specialise instance Eq above
eqList [] [] = True
eqList (x:xs) (y:ys) = x == y && eqList xs ys
-eqList _xs _ys = False
-
+eqList _xs _ys = False
+
+-- We give a manual specialisation for eqList @Char = eqString, so that we can give
+-- eqString a BuiltInRule in GHC.Core.Opt.ConstantFold:
+-- eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2)) = s1==s2
+-- Tiresomely, we have to duplicate rules eqList1 and eqList2
+-- (The manual specialistion RULE "eqString" should mean that we don't
+-- auto-specialise eqList @String.)
+{-# RULES
+"eqString" eqList = eqString
+"eqString1" forall xs. eqString xs [] = null xs
+"eqString2" forall xs. eqString [] xs = null xs
+ #-}
+
+null :: [a] -> Bool
+-- Defined in base:Data.List but we need it here
+null [] = True
+null (_:_) = False
+
+-- | This 'String' equality predicate is used when desugaring
+-- pattern-matches against strings.
+eqString :: [Char] -> [Char] -> Bool
+eqString [] [] = True
+eqString (c1:cs1) (c2:cs2) = c1 == c2 && cs1 `eqString` cs2
+eqString _ _ = False
+
+----------------------------------------------
deriving instance Eq Module
instance Eq TrName where
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2543041d905315f7ab7adb207640ca827d25b0ff...97e35465d3e6897c96dea6d256eaf46e678b5f8f
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2543041d905315f7ab7adb207640ca827d25b0ff...97e35465d3e6897c96dea6d256eaf46e678b5f8f
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/20231207/34f2c5ef/attachment-0001.html>
More information about the ghc-commits
mailing list