Ticket #7206: cheap-build-base.patch

File cheap-build-base.patch, 4.9 KB (added by simonpj, 3 years ago)

Patch for base library

  • GHC/Base.lhs

    commit 640b50f710df5310d6e3f6cede66b776d9c09cc2
    Author: Simon Peyton Jones <[email protected]>
    Date:   Fri Jan 18 17:39:33 2013 +0000
    
        Use cheapBuild for enumerations; and fusion rules for cheapBuild
    
    	Modified GHC/Base.lhs
    diff --git a/GHC/Base.lhs b/GHC/Base.lhs
    index 075f21d..fe3dc23 100644
    a b build :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a] 
    306306
    307307build g = g (:) []
    308308
     309cheapBuild   :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
     310{-# INLINE CONLIKE [1] cheapBuild #-}
     311-- cheapBuild is just like build, except that it is CONLIKE
     312-- See Note [cheapBuild]
     313cheapBuild g = g (:) []
     314
    309315-- | A list producer that can be fused with 'foldr'.
    310316-- This function is merely
    311317--
    augment g xs = g (:) xs 
    322328{-# RULES
    323329"fold/build"    forall k z (g::forall b. (a->b->b) -> b -> b) .
    324330                foldr k z (build g) = g k z
     331"fold/cheapBuild"    forall k z (g::forall b. (a->b->b) -> b -> b) .
     332                     foldr k z (cheapBuild g) = g k z
    325333
    326334"foldr/augment" forall k z xs (g::forall b. (a->b->b) -> b -> b) .
    327335                foldr k z (augment g xs) = g k (foldr k z xs)
    328336
     337"augment/cheapBuild" forall (g::forall b. (a->b->b) -> b -> b)
     338                     (h::forall b. (a->b->b) -> b -> b) .
     339                     augment g (cheapBuild h) = build (\c n -> g c (h c n))
     340 -- 'augment' doesn't necessarily have a cheap argument, so we revert to 'build'
     341
    329342"foldr/id"                        foldr (:) [] = \x  -> x
    330343"foldr/app"     [1] forall ys. foldr (:) ys = \xs -> xs ++ ys
    331344        -- Only activate this from phase 1, because that's
    augment g xs = g (:) xs 
    353366--      augment g (augment h t) = augment (\cn -> g c (h c n)) t
    354367\end{code}
    355368
     369Note [cheapBuild]
     370~~~~~~~~~~~~~~~~~
     371cheapBuild is just like build, except that it is CONLIKE
     372
     373It is used in situations where fusion is more imortant than sharing,
     374ie in situation where its argument function 'g' in (cheapBuild g) is
     375cheap.
     376
     377Main example: enumerations of one kind or another:
     378    f x = let xs = [x..]
     379              go = \y. ....go y'....(map (h y) xs)...
     380          in ...
     381Here we woud like to fuse the map with the [x..]
    356382
    357383----------------------------------------------
    358384--              map
    a `iShiftRL#` b | b >=# WORD_SIZE_IN_BITS# = 0# 
    715741
    716742-- Rules for C strings (the functions themselves are now in GHC.CString)
    717743{-# RULES
    718 "unpack"       [~1] forall a   . unpackCString# a             = build (unpackFoldrCString# a)
     744"unpack"       [~1] forall a   . unpackCString# a             = cheapBuild (unpackFoldrCString# a)
    719745"unpack-list"  [1]  forall a   . unpackFoldrCString# a (:) [] = unpackCString# a
    720746"unpack-append"     forall a n . unpackFoldrCString# a (:) n  = unpackAppendCString# a n
    721747
  • GHC/Enum.lhs

    	Modified GHC/Enum.lhs
    diff --git a/GHC/Enum.lhs b/GHC/Enum.lhs
    index 625214a..928fd6c 100644
    a b instance Enum Char where 
    376376    enumFromThenTo (C# x1) (C# x2) (C# y) = efdtChar (ord# x1) (ord# x2) (ord# y)
    377377
    378378{-# RULES
    379 "eftChar"       [~1] forall x y.        eftChar x y       = build (\c n -> eftCharFB c n x y)
    380 "efdChar"       [~1] forall x1 x2.      efdChar x1 x2     = build (\ c n -> efdCharFB c n x1 x2)
    381 "efdtChar"      [~1] forall x1 x2 l.    efdtChar x1 x2 l  = build (\ c n -> efdtCharFB c n x1 x2 l)
     379"eftChar"       [~1] forall x y.        eftChar x y       = cheapBuild (\c n -> eftCharFB c n x y)
     380"efdChar"       [~1] forall x1 x2.      efdChar x1 x2     = cheapBuild (\ c n -> efdCharFB c n x1 x2)
     381"efdtChar"      [~1] forall x1 x2 l.    efdtChar x1 x2 l  = cheapBuild (\ c n -> efdtCharFB c n x1 x2 l)
    382382"eftCharList"   [1]  eftCharFB  (:) [] = eftChar
    383383"efdCharList"   [1]  efdCharFB  (:) [] = efdChar
    384384"efdtCharList"  [1]  efdtCharFB (:) [] = efdtChar
    instance Enum Int where 
    511511-- In particular, we have rules for deforestation
    512512
    513513{-# RULES
    514 "eftInt"        [~1] forall x y. eftInt x y = build (\ c n -> eftIntFB c n x y)
     514"eftInt"        [~1] forall x y. eftInt x y = cheapBuild (\ c n -> eftIntFB c n x y)
    515515"eftIntList"    [1] eftIntFB  (:) [] = eftInt
    516516 #-}
    517517
    eftIntFB c n x0 y | x0 ># y = n 
    541541
    542542{-# RULES
    543543"efdtInt"       [~1] forall x1 x2 y.
    544                      efdtInt x1 x2 y = build (\ c n -> efdtIntFB c n x1 x2 y)
     544                     efdtInt x1 x2 y = cheapBuild (\ c n -> efdtIntFB c n x1 x2 y)
    545545"efdtIntUpList" [1]  efdtIntFB (:) [] = efdtInt
    546546 #-}
    547547
    instance Enum Integer where 
    669669    enumFromThenTo x y lim = enumDeltaToInteger x (y-x) lim
    670670
    671671{-# RULES
     672-- We don't use cheapBuild for Integer
    672673"enumDeltaInteger"      [~1] forall x y.  enumDeltaInteger x y     = build (\c _ -> enumDeltaIntegerFB c x y)
    673674"efdtInteger"           [~1] forall x y l.enumDeltaToInteger x y l = build (\c n -> enumDeltaToIntegerFB c n x y l)
    674675"enumDeltaInteger"      [1] enumDeltaIntegerFB   (:)    = enumDeltaInteger