# GCD inlining strictness and CSE

(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)

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

-}

--