Implement cheap build

See also

• #24663

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