[Haskell-cafe] Fusion for fun and profi (Was: newbie optimization question)

Don Stewart dons at galois.com
Sun Oct 28 17:07:08 EDT 2007


dons:
> stefanor:
> > On Sun, Oct 28, 2007 at 01:25:19PM -0700, Don Stewart wrote:
> > > Finally, we can manually translate the C code into a confusing set of nested
> > > loops with interleaved IO,
> > > 
> > >     main = loop 1 
> > >       where
> > >         loop !i | i > 10000 = return ()
> > >                 | otherwise = if i == go i 0 1 then print i >> loop (i+1) 
> > >                                                else loop (i+1)
> > > 
> > >         go !i !s !j | j <= i-1 = if i `rem` j == 0 then go i (s+j) (j+1)
> > >                                                 else go i s (j+1)
> > >                  | otherwise = s
> > > 
> > > And we get *no speed benefit* at all!
> > > 
> > >     time ./A-loop  1.24s user 0.00s system 98% cpu 1.256 total
> > > 
> > > So the lesson is: write in a high level style, and the compiler can do the work
> > > for you. Or, GHC is pretty smart on high level code.
> > 

Oh, and we can fuse with the print loop too, yielding an entire program
of type Int# -> IO (), and really no intermediate lists (even for the return
list).

Again, we need to use the fusible version of mapM_:

    import Prelude hiding (filter,sum,enumFromTo,mapM_,sequence_,map,foldr)
    import Data.List.Stream
    import Data.Stream (enumFromToInt,unstream)

    enumFromTo i j = unstream (enumFromToInt i j)

    mapM_ f as     =  sequence_ (map f as)
    sequence_ ms   =  foldr (>>) (return ()) ms
    -- ^ fuse happily

    default(Int)


    main = mapM_ print $ filter (\i -> i == sum (divisors i)) (enumFromTo 1 10000)
    divisors i = filter (\j -> i `rem`j == 0) (enumFromTo 1 (i-1))

And we see the map and foldr fuse in sequence, which in turn fuses with the 
filter (and rest of the program):

    18 RuleFired
        5 STREAM stream/unstream fusion
        2 filter -> fusible
        1 foldr -> fusible
        1 map -> fusible
        1 sumInt -> fusible

The program flattens to a single nested loop,

    Main.$wloop_foldr :: GHC.Prim.Int#
                     -> GHC.Prim.State# GHC.Prim.RealWorld
                     -> (# GHC.Prim.State# GHC.Prim.RealWorld, () #)

which really is equivalent in terms of control flow and intermediate structures
to the C program.

-- Don


More information about the Haskell-Cafe mailing list