Implement cheap build
We sometimes see stuff like this:
f n ps = let ys = [1..x]
in map (\zs. ys ++ zs) ps
You might think the (++)
would fuse with the [1..x]
, via foldr/build fusion, but it doesn't. Why not? Because it would be WRONG to do so in this case:
f ns ps = let ys = map expensive ns
in map (\zs. ys ++ zs) ps
If we fused the (++)
with the map
we might call expensive
once for each element of ps
.
This is fairly easy to fix. The point is that [1..x]
is cheap; we'd prefer to fuse it even if doing so involves computing 1, 1+1, 2+1, etc multiple times. Suppose we express this fact thusly:
enumFromTo lo hi = cheapBuild (\cn. ....lo...hi...)
map f xs = build (\cn. ...f...xs...)
Now we want the foldr/cheapBuild
rule to fire even if that would involve duplicating the call to cheapBuild
. And we already have a way to do that: we make cheapBuild
into a CONLIKE
function.
Happily it's almost all simply a change to the libraries, not the compiler itself.
I just need to execute on this, but I keep failing to get round to it. Below is the beginning. One missing piece is that I need to replace the hack for build
in the occurrence analyser, so that it works for cheapBuild
too. (At least until we have Ilya's cardinality analyser.)
Simon
diff --git a/GHC/Base.lhs b/GHC/Base.lhs
index 6a36eb5..b78edf5 100644
--- a/GHC/Base.lhs
+++ b/GHC/Base.lhs
@@ -304,6 +304,12 @@ build :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build g = g (:) []
+cheapBuild :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
+{-# INLINE CONLIKE [1] cheapBuild #-}
+-- cheapBuild is just like build, except that it is CONLIKE
+-- See Note [cheapBuild]
+cheapBuild g = g (:) []
+
-- | A list producer that can be fused with 'foldr'.
-- This function is merely
--
@@ -320,6 +326,8 @@ augment g xs = g (:) xs
{-# RULES
"fold/build" forall k z (g::forall b. (a->b->b) -> b -> b) .
foldr k z (build g) = g k z
+"fold/cheapBuild" forall k z (g::forall b. (a->b->b) -> b -> b) .
+ foldr k z (cheapBuild g) = g k z
"foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) .
foldr k z (augment g xs) = g k (foldr k z xs)
@@ -343,6 +351,12 @@ augment g xs = g (:) xs
"augment/build" forall (g::forall b. (a->b->b) -> b -> b)
(h::forall b. (a->b->b) -> b -> b) .
augment g (build h) = build (\c n -> g c (h c n))
+
+"augment/cheapBuild" forall (g::forall b. (a->b->b) -> b -> b)
+ (h::forall b. (a->b->b) -> b -> b) .
+ augment g (cheapBuild h) = build (\c n -> g c (h c n))
+ -- 'augment' doesn't necessarily have a cheap argument, so we revert to 'build'
+
"augment/nil" forall (g::forall b. (a->b->b) -> b -> b) .
augment g [] = build g
#-}
@@ -351,6 +365,20 @@ augment g xs = g (:) xs
-- augment g (augment h t) = augment (\cn -> g c (h c n)) t
\end{code}
+Note [cheapBuild]
+~~~~~~~~~~~~~~~~~
+cheapBuild is just like build, except that it is CONLIKE
+
+It is used in situations where fusion is more imortant than sharing,
+ie in situation where its argument function 'g' in (cheapBuild g) is
+cheap.
+
+Main example: enumerations of one kind or another:
+ f x = let xs = [x..]
+ go = \y. ....go y'....(map (h y) xs)...
+ in ...
+Here we woud like to fuse the map with the [x..]
+
----------------------------------------------
-- map
@@ -831,7 +859,7 @@ a `iShiftRL#` b | b >=# WORD_SIZE_IN_BITS# = 0#
-- Rules for C strings (the functions themselves are now in GHC.CString)
{-# RULES
-"unpack" [~1] forall a . unpackCString# a = build (unpackFoldrCString# a)
+"unpack" [~1] forall a . unpackCString# a = cheapBuild (unpackFoldrCString# a)
"unpack-list" [1] forall a . unpackFoldrCString# a (:) [] = unpackCString# a
"unpack-append" forall a n . unpackFoldrCString# a (:) n = unpackAppendCString# a n
diff --git a/GHC/Enum.lhs b/GHC/Enum.lhs
index cea3ced..561a995 100644
--- a/GHC/Enum.lhs
+++ b/GHC/Enum.lhs
@@ -376,9 +376,9 @@ instance Enum Char where
enumFromThenTo (C# x1) (C# x2) (C# y) = efdtChar (ord# x1) (ord# x2) (ord# y)
{-# 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)
-"efdtChar" [~1] forall x1 x2 l. efdtChar x1 x2 l = build (\ c n -> efdtCharFB c n x1 x2 l)
+"eftChar" [~1] forall x y. eftChar x y = cheapBuild (\c n -> eftCharFB c n x y)
+"efdChar" [~1] forall x1 x2. efdChar x1 x2 = cheapBuild (\ c n -> efdCharFB c n x1 x2)
+"efdtChar" [~1] forall x1 x2 l. efdtChar x1 x2 l = cheapBuild (\ c n -> efdtCharFB c n x1 x2 l)
"eftCharList" [1] eftCharFB (:) [] = eftChar
"efdCharList" [1] efdCharFB (:) [] = efdChar
"efdtCharList" [1] efdtCharFB (:) [] = efdtChar
@@ -510,7 +510,7 @@ instance Enum Int where
-- In particular, we have rules for deforestation
{-# RULES
-"eftInt" [~1] forall x y. eftInt x y = build (\ c n -> eftIntFB c n x y)
+"eftInt" [~1] forall x y. eftInt x y = cheapBuild (\ c n -> eftIntFB c n x y)
"eftIntList" [1] eftIntFB (:) [] = eftInt
#-}
@@ -539,7 +539,7 @@ eftIntFB c n x0 y | x0 ># y = n
{-# RULES
"efdtInt" [~1] forall x1 x2 y.
- efdtInt x1 x2 y = build (\ c n -> efdtIntFB c n x1 x2 y)
+ efdtInt x1 x2 y = cheapBuild (\ c n -> efdtIntFB c n x1 x2 y)
"efdtIntUpList" [1] efdtIntFB (:) [] = efdtInt
#-}
@@ -646,8 +646,8 @@ instance Enum Integer where
enumFromThenTo x y lim = enumDeltaToInteger x (y-x) lim
{-# 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] forall x y. enumDeltaInteger x y = cheapBuild (\c _ -> enumDeltaIntegerFB c x y)
+"efdtInteger" [~1] forall x y l.enumDeltaToInteger x y l = cheapBuild (\c n -> enumDeltaToIntegerFB c n x y l)
"enumDeltaInteger" [1] enumDeltaIntegerFB (:) = enumDeltaInteger
"enumDeltaToInteger" [1] enumDeltaToIntegerFB (:) [] = enumDeltaToInteger
#-}
Trac metadata
Trac field | Value |
---|---|
Version | 7.4.2 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | Compiler |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |