[commit: ghc] master: Fallout from more assiduous RULE warnings (a1dd7dd)
git at git.haskell.org
git at git.haskell.org
Tue Jul 28 16:45:36 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/a1dd7dd6ea276832aef0caaf805f0ab9f4e16262/ghc
>---------------------------------------------------------------
commit a1dd7dd6ea276832aef0caaf805f0ab9f4e16262
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Tue Jul 28 16:00:20 2015 +0100
Fallout from more assiduous RULE warnings
GHC now warns if rules compete, so that it's not predicatable
which will work and which will not. E.g.
{-# RULES
f (g x) = ...
g True = ...
#-}
If we had (f (g True)) it's not clear which rule would fire.
This showed up fraility in the libraries.
* Suppress warnigns in Control.Arrow, Control.Category for class
methods. At the moment we simply don't have a good way to write a
RULE with a class method in the LHS. See Trac #1595. Arrow and
Category attempt to do so; I have silenced the complaints with
-fno-warn-inline-rule-shadowing, but it's not a great solution.
* Adjust the NOINLINE pragma on 'GHC.Base.map' to account for the
map/coerce rule
* Adjust the rewrite rules in Enum, especially for the "literal 1"
case. See Note [Enum Integer rules for literal 1].
* Suppress warnings for 'bytestring' e.g.
libraries/bytestring/Data/ByteString.hs:895:1: warning:
Rule "ByteString specialise break (x==)" may never fire
because rule "Class op ==" for ‘==’ might fire first
Probable fix: add phase [n] or [~n] to the competing rule
>---------------------------------------------------------------
a1dd7dd6ea276832aef0caaf805f0ab9f4e16262
libraries/base/Control/Arrow.hs | 3 ++
libraries/base/Control/Category.hs | 3 ++
libraries/base/GHC/Base.hs | 7 +++--
libraries/base/GHC/Enum.hs | 60 ++++++++++++++++++++++++++++++--------
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 e9dd781..9d09544 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 ab7740b..8616a17 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 e15519d..9bd6124 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 b634516..2ba6dda 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 22acf9a..2e82428 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
More information about the ghc-commits
mailing list