Unrolling recursive functions at static arguments using church numerals

0-InlineFix.hs

{-# LANGUAGE BlockArguments #-}

module InlineFix (
  Rec,
  inlineFix,
  Church, (|&), _0, _1, _2, _3, _4, _5, _6, _7, _8, _9,
) where

import GHC.Exts (inline)
import Data.Function (fix)


type Rec a = a -> a

{-# INLINE inlineFix #-}
inlineFix :: Church -> Rec a -> a
inlineFix m f = (m `times` inline f) (fix f)


newtype Church = Church{ times :: forall x. (x -> x) -> x -> x }

{-# INLINE succC #-}
succC :: Church -> Church
succC n = Church \s z -> s (times n s z)

{-# INLINE addC #-}
{-# INLINE mulC #-}
addC, mulC :: Church -> Church -> Church
addC m n = n `times`  succC   $  m
mulC m n = n `times` (addC m) $ _0
infixl 6 `addC`
infixl 7 `mulC`

{-# INLINE _0 #-}
{-# INLINE _1 #-}
{-# INLINE _2 #-}
{-# INLINE _3 #-}
{-# INLINE _4 #-}
{-# INLINE _5 #-}
{-# INLINE _6 #-}
{-# INLINE _7 #-}
{-# INLINE _8 #-}
{-# INLINE _9 #-}
{-# INLINE _10 #-}
_0, _1, _2, _3, _4, _5, _6, _7, _8, _9, _10 :: Church
_0  = Church \_ z -> z
_1  = succC _0
_2  = succC _1
_3  = succC _2
_4  = succC _3
_5  = succC _4
_6  = succC _5
_7  = succC _6
_8  = succC _7
_9  = succC _8
_10 = succC _9

{-# INLINE base #-}
base :: Church -> Church -> Church -> Church
base b m n = b `mulC` m `addC` n

{-# INLINE (|&) #-}
(|&) :: Church -> Church -> Church
(|&) = base _10
infixl 9 |&

1-InlineTest.hs

module InlineTest where

import InlineFix


sumExample :: Int
sumExample = inlineFix _6 simpleSum [1,2,3,4,5]

simpleSum :: Rec ([Int] -> Int)
simpleSum rec [    ] = 0
simpleSum rec (x:xs) = x + rec xs


findFirstExample :: Int -> Maybe String
findFirstExample = inlineFix _4 findFirst [(10, "a"), (20, "b"), (30, "c")]

findFirst :: Eq k => Rec ([(k, v)] -> k -> Maybe v)
findFirst rec [        ] _      = Nothing
findFirst rec ((k,v):xs) needle = if k == needle
  then Just v
  else rec xs needle

2-InlineTest.core

sumExample = I# 15#

findFirstExample
  = \ ds_Xa ->
      case ds_Xa of { I# y_a1hw ->
      case y_a1hw of {
        __DEFAULT -> Nothing;
        10# -> lvl_r1im;
        20# -> lvl1_r1in;
        30# -> lvl2_r1io
      }
      }