diff options
| -rw-r--r-- | libraries/base/Control/Arrow.hs | 3 | ||||
| -rw-r--r-- | libraries/base/Control/Category.hs | 3 | ||||
| -rw-r--r-- | libraries/base/GHC/Base.hs | 7 | ||||
| -rw-r--r-- | libraries/base/GHC/Enum.hs | 60 | ||||
| -rw-r--r-- | mk/warnings.mk | 3 |
5 files changed, 61 insertions, 15 deletions
diff --git a/libraries/base/Control/Arrow.hs b/libraries/base/Control/Arrow.hs index e9dd781672..9d09544eeb 100644 --- a/libraries/base/Control/Arrow.hs +++ b/libraries/base/Control/Arrow.hs @@ -1,5 +1,8 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-} + -- The RULES for the methods of class Arrow may never fire + -- e.g. compose/arr; see Trac #10528 ----------------------------------------------------------------------------- -- | diff --git a/libraries/base/Control/Category.hs b/libraries/base/Control/Category.hs index ab7740b559..8616a17cdd 100644 --- a/libraries/base/Control/Category.hs +++ b/libraries/base/Control/Category.hs @@ -2,6 +2,9 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE PolyKinds #-} +{-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-} + -- The RULES for the methods of class Category may never fire + -- e.g. identity/left, identity/right, association; see Trac #10528 ----------------------------------------------------------------------------- -- | diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs index e15519d1fc..9bd6124e6a 100644 --- a/libraries/base/GHC/Base.hs +++ b/libraries/base/GHC/Base.hs @@ -853,9 +853,10 @@ augment g xs = g (:) xs -- > map f [x1, x2, ...] == [f x1, f x2, ...] map :: (a -> b) -> [a] -> [b] -{-# NOINLINE [1] map #-} -- We want the RULE to fire first. - -- It's recursive, so won't inline anyway, - -- but saying so is more explicit +{-# NOINLINE [0] map #-} + -- We want the RULEs "map" and "map/coerce" to fire first. + -- map is recursive, so won't inline anyway, + -- but saying so is more explicit, and silences warnings map _ [] = [] map f (x:xs) = f x : map f xs diff --git a/libraries/base/GHC/Enum.hs b/libraries/base/GHC/Enum.hs index b634516820..2ba6ddad19 100644 --- a/libraries/base/GHC/Enum.hs +++ b/libraries/base/GHC/Enum.hs @@ -344,6 +344,7 @@ instance Enum Char where {-# INLINE enumFromThenTo #-} enumFromThenTo (C# x1) (C# x2) (C# y) = efdtChar (ord# x1) (ord# x2) (ord# y) +-- See Note [How the Enum rules work] {-# RULES "eftChar" [~1] forall x y. eftChar x y = build (\c n -> eftCharFB c n x y) "efdChar" [~1] forall x1 x2. efdChar x1 x2 = build (\ c n -> efdCharFB c n x1 x2) @@ -482,6 +483,13 @@ instance Enum Int where "eftIntList" [1] eftIntFB (:) [] = eftInt #-} +{- Note [How the Enum rules work] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +* Phase 2: eftInt ---> build . eftIntFB +* Phase 1: inline build; eftIntFB (:) --> eftInt +* Phase 0: optionally inline eftInt +-} + {-# NOINLINE [1] eftInt #-} eftInt :: Int# -> Int# -> [Int] -- [x1..x2] @@ -510,6 +518,7 @@ eftIntFB c n x0 y | isTrue# (x0 ># y) = n -- efdInt and efdtInt deal with [a,b..] and [a,b..c]. -- The code is more complicated because of worries about Int overflow. +-- See Note [How the Enum rules work] {-# RULES "efdtInt" [~1] forall x1 x2 y. efdtInt x1 x2 y = build (\ c n -> efdtIntFB c n x1 x2 y) @@ -667,13 +676,32 @@ instance Enum Integer where enumFromTo x lim = enumDeltaToInteger x 1 lim enumFromThenTo x y lim = enumDeltaToInteger x (y-x) lim +-- See Note [How the Enum rules work] {-# RULES -"enumDeltaInteger" [~1] forall x y. enumDeltaInteger x y = build (\c _ -> enumDeltaIntegerFB c x y) -"efdtInteger" [~1] forall x y l.enumDeltaToInteger x y l = build (\c n -> enumDeltaToIntegerFB c n x y l) -"enumDeltaInteger" [1] enumDeltaIntegerFB (:) = enumDeltaInteger -"enumDeltaToInteger" [1] enumDeltaToIntegerFB (:) [] = enumDeltaToInteger +"enumDeltaInteger" [~1] forall x y. enumDeltaInteger x y = build (\c _ -> enumDeltaIntegerFB c x y) +"efdtInteger" [~1] forall x d l. enumDeltaToInteger x d l = build (\c n -> enumDeltaToIntegerFB c n x d l) +"efdtInteger1" [~1] forall x l. enumDeltaToInteger x 1 l = build (\c n -> enumDeltaToInteger1FB c n x l) + +"enumDeltaToInteger1FB" [1] forall c n x. enumDeltaToIntegerFB c n x 1 = enumDeltaToInteger1FB c n x + +"enumDeltaInteger" [1] enumDeltaIntegerFB (:) = enumDeltaInteger +"enumDeltaToInteger" [1] enumDeltaToIntegerFB (:) [] = enumDeltaToInteger +"enumDeltaToInteger1" [1] enumDeltaToInteger1FB (:) [] = enumDeltaToInteger1 #-} +{- +The "1" rules above specialise for the common case where delta = 1, +so that we can avoid the delta>=0 test in enumDeltaToIntegerFB. +Then enumDeltaToInteger1FB is nice and small and can be inlined, +which would allow the constructor to be inlined and good things to happen. + +We match on the literal "1" both in phase 2 (rule "efdtInteger1") and +phase 1 (rule "enumDeltaToInteger1FB"), just for belt and braces + +We do not do it for Int this way because hand-tuned code already exists, and +the special case varies more from the general case, due to the issue of overflows. +-} + {-# NOINLINE [0] enumDeltaIntegerFB #-} enumDeltaIntegerFB :: (Integer -> b -> b) -> Integer -> Integer -> b enumDeltaIntegerFB c x d = x `seq` (x `c` enumDeltaIntegerFB c (x+d) d) @@ -693,14 +721,14 @@ enumDeltaToIntegerFB c n x delta lim | delta >= 0 = up_fb c n x delta lim | otherwise = dn_fb c n x delta lim -{-# RULES -"enumDeltaToInteger1" [0] forall c n x . enumDeltaToIntegerFB c n x 1 = up_fb c n x 1 - #-} --- This rule ensures that in the common case (delta = 1), we do not do the check here, --- and also that we have the chance to inline up_fb, which would allow the constructor to be --- inlined and good things to happen. --- We do not do it for Int this way because hand-tuned code already exists, and --- the special case varies more from the general case, due to the issue of overflows. +{-# NOINLINE [0] enumDeltaToInteger1FB #-} +-- Don't inline this until RULE "enumDeltaToInteger" has had a chance to fire +enumDeltaToInteger1FB :: (Integer -> a -> a) -> a + -> Integer -> Integer -> a +enumDeltaToInteger1FB c n x0 lim = go (x0 :: Integer) + where + go x | x > lim = n + | otherwise = x `c` go (x+1) {-# NOINLINE [1] enumDeltaToInteger #-} enumDeltaToInteger :: Integer -> Integer -> Integer -> [Integer] @@ -708,6 +736,14 @@ enumDeltaToInteger x delta lim | delta >= 0 = up_list x delta lim | otherwise = dn_list x delta lim +{-# NOINLINE [1] enumDeltaToInteger1 #-} +enumDeltaToInteger1 :: Integer -> Integer -> [Integer] +-- Special case for Delta = 1 +enumDeltaToInteger1 x0 lim = go (x0 :: Integer) + where + go x | x > lim = [] + | otherwise = x : go (x+1) + up_fb :: (Integer -> a -> a) -> a -> Integer -> Integer -> Integer -> a up_fb c n x0 delta lim = go (x0 :: Integer) where diff --git a/mk/warnings.mk b/mk/warnings.mk index 22acf9a698..2e824288c8 100644 --- a/mk/warnings.mk +++ b/mk/warnings.mk @@ -37,6 +37,9 @@ utils/hpc_dist-install_EXTRA_HC_OPTS += -fwarn-tabs ###################################################################### # Disable some warnings in packages we use +# Libraries that have dubious RULES +libraries/bytestring_dist-install_EXTRA_HC_OPTS += -fno-warn-inline-rule-shadowing + # Cabal doesn't promise to be warning-free utils/ghc-cabal_dist_EXTRA_HC_OPTS += -w libraries/Cabal/Cabal_dist-boot_EXTRA_HC_OPTS += -w |