GCD inlining strictness and CSE

An example of how you need to do CSE, when using seq for strictness tricks in recursive loops. And how suitable inlining will give you the same result for free, with foldl'.

{-# OPTIONS -O2 -fbang-patterns #-}

module M (gcdmany, gcdmany_poly) where

-- 
-- Given gcd1 defined as:
--
gcd1 :: Integral a => a -> a -> a
gcd1 a b = gcd1' (abs a) (abs b)
    where gcd1' a 0 = a
          gcd1' a b = gcd1' b (a `rem` b)

--
-- then we can write a reasonable gcdmany, as long as we do our own strictness
-- hint, and CSE:
--
gcdmany :: Integral a => [a] -> a
gcdmany xs = gcdmany' 0 xs
    where gcdmany' p []     = p
          gcdmany' p (x:xs) = v `seq` gcdmany' v xs where v = gcd1 p x

{-# SPECIALISE gcdmany :: [Int]     -> Int #-}

-- Which yields the following code from GHC:

{-

    wgcdmany' (ww_sRL :: Int#) (w_sRN :: [Int]) =
        case w_sRN of
          []             -> ww_sRL
          x_agx : xs_agy -> case x_agx of
                I# x1_XQz -> case >=# ww_sRL 0 of {
                    False ->
                        case >=# x1_XQz 0 of
                          False ->
                            case $wgcd1'_rU7 (negateInt# ww_sRL) (negateInt# x1_XQz) of
                                _ -> wgcdmany' ww1_sRp xs_agy
                          True ->
                            case $wgcd1'_rU7 (negateInt# ww_sRL) x1_XQz of {
                                _ -> wgcdmany' ww1_sRp xs_agy

                    True -> case >=# x1_XQz 0 of
                          False ->
                            case $wgcd1'_rU7 ww_sRL (negateInt# x1_XQz) of
                                    _ -> wgcdmany' ww1_sRp xs_agy
                          True ->
                            case $wgcd1'_rU7 ww_sRL x1_XQz of
                                    _ -> wgcdmany' ww1_sRp xs_agy


-}

-- Good
--
-- now, GHC is a pretty smart compiler, so you should get *the same* 
-- code from a higher level version:

gcdmany_poly :: Integral a => [a] -> a
gcdmany_poly = foldl' gcd1 0

{-# SPECIALISE gcdmany_poly :: [Int]     -> Int #-}

--
-- First though, we must ensure foldl' is inlined. GHC won't tend to inline foldl'
-- across package boundaries (hmm) , so we can put our own definition in here:

foldl' :: (a -> b -> a) -> a -> [b] -> a
foldl' f z0 xs0 = go z0 xs0
  where
    go !z []     = z
    go !z (x:xs) = go (f z x) xs
{-# INLINE foldl' #-}

--
-- which indeed yields *exactly* the same loop as the explcit CSE/strict version:
--

{-

    wgo :: GHC.Prim.Int# -> [GHC.Base.Int] -> GHC.Prim.Int#
    wgo (ww_sQq :: Int#) (w_sQs :: [Int]) =
        case w_sQs of {
          []             -> ww_sQq
          x_ajw : xs_ajx -> case x_ajw of
             I# x1_aNs -> case >=# ww_sQq 0 of {
                  False ->
                    case >=# x1_aNs 0 of {
                      False ->
                        case $wgcd1'_rTN (negateInt# ww_sQq) (negateInt# x1_aNs) of
                            _ -> wgo ww1_sQ4 xs_ajx
                      True ->
                        case $wgcd1'_rTN (negateInt# ww_sQq) x1_aNs of
                            _ -> wgo ww1_sQ4 xs_ajx

                  True -> case >=# x1_aNs 0 of
                      False ->
                        case $wgcd1'_rTN ww_sQq (GHC.Prim.negateInt# x1_aNs) of
                            _ -> $wgo ww1_sQ4 xs_ajx
                      True ->
                        case $wgcd1'_rTN ww_sQq x1_aNs of
                            _ -> $wgo ww1_sQ4 xs_ajx

-}

--
-- Know your compiler, and you'll know your code.
--