#7206: Implement cheap build
---------------------------------+------------------------------------------
Reporter: simonpj | Owner:
Type: bug | Status: new
Priority: normal | Milestone:
Component: Compiler | Version: 7.4.2
Keywords: | Os: Unknown/Multiple
Architecture: Unknown/Multiple | Failure: None/Unknown
Difficulty: Unknown | Testcase:
Blockedby: | Blocking:
Related: |
---------------------------------+------------------------------------------
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
#-}
}}}
--
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/7206>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
_______________________________________________
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs
