> {-# LANGUAGE MagicHash #-}
> module WorkerWrapper where
> import Prelude hiding (replicate, abs)
> import GHC.Prim (Int#)
> import GHC.Exts (Int(I#), (==#), (-#), (*#))
> import Data.Function (fix)

> fac :: Int -> Int
> fac 0 = 1
> fac n = n * fac (n - 1)

このfacはunboxingとboxingで非効率。nに対して正格なので、Int#に置き換えても良い。
まずはfacを最小不動点で書き直す。これはInt -> Intな関数をInt# -> Int#に書き直す
ことが目的である。

> fac1 :: Int -> Int
> fac1 = fix body
>
> body :: (Int -> Int) -> (Int -> Int)
> body f 0 = 1
> body f n = n * f (n - 1)

次に変換関数を書く。

> rep :: Int -> Int#
> rep x = case x of
>   I# y# -> y#
>
> abs :: Int# -> Int
> abs y# = I# y#

> unwrap :: (Int -> Int) -> Int# -> Int#
> unwrap f y# = rep (f (abs y#))
>
> wrap :: (Int# -> Int#) -> Int -> Int
> wrap g# x = abs (g# (rep x))

f :: Int -> Intが正格なら、
  wrap . unwrap = id
を満たす。body1は引数nに対して正格なので、
  wrap . unwrap . body1 = body1
がいえる。

これをfac1に適用する。

 fix body1
= { idを差し込む }
 fix (id . body1)
= { wrap . unwrap = id }
 fix (wrap . unwrap . body1)
= { rolling rule }
 wrap (fix (unwrap . body1 . wrap))
= { fix (unwrap . body . wrap)をwork2と定義する
 wrap work2

> fac2 :: Int -> Int
> fac2 = wrap work2
>
> work2 :: Int# -> Int#
> work2 = unwrap (body (wrap work2))

続いてfac2のwrapを展開する。

> fac' :: Int -> Int
> fac' n = case n of
>   I# y# -> I# (work' y#)

worker関数も展開する。

 work
=> { workの定義 }
 unwrap (body (wrap work)) n#
=> { unwrapを展開 }
 rep (body (wrap work) (abs n#))
=> { bodyを展開 }
 rep (case abs n# of
       0 -> 1
       n -> n * (wrap work) (n - 1))
=> { repをcaseで分配 }
 case abs n# of
   0 -> rep 1
   n -> rep (n * (wrap work) (n - 1))
=> { 最適化してabs/repの除去 }
 case n# of
   0# -> 1#
   n# -> n# *# work (n# -# 1#)

> work' :: Int# -> Int#
> work' 0# = 1#
> work' n# = n# *# work' (n# -# 1#)


replicateの場合も考える。

> replicate :: Int -> a -> [a]
> replicate 0 _ = []
> replicate n x = x : replicate (n - 1) x

まずは最小不動点で書き直す。

> replicate1 :: Int -> a -> [a]
> replicate1 = fix body'
>
> body' :: (Int -> a -> [a]) -> Int -> a -> [a]
> body' _ 0 _ = []
> body' f n x = x : f (n - 1) x

wrap/unwrapを定義する。

> unwrap' :: (Int -> a -> [a]) -> Int# -> a -> [a]
> unwrap' f n# = f (abs n#)
>
> wrap' :: (Int# -> a -> [a]) -> Int -> a -> [a]
> wrap' f n = f (rep n)

workerとwrapperに分割する。

> replicate2 :: Int -> a -> [a]
> replicate2 = wrap' work'2
>
> work'2 :: Int# -> a -> [a]
> work'2 = unwrap' (body' (wrap' work'2))

展開しておしまい。

> replicate' :: Int -> a -> [a]
> replicate' n x = case n of
>   I# n# -> work'' n# x
>
> work'' :: Int# -> a -> [a]
> work'' n# x = case n# of
>   0# -> []
>   n# -> x : work'' (n# -# 1#) x