コンビネータ版チャーチ数の加減乗除

たった１つの関数から出発して昨日やったチャーチ数の加減乗除 - MEMO:はてな支店を再現する。
最初に生成している各種コンビネータはコメントをつけているが、m=のところからは基本的に昨日と同じなので省略。
最初の関数x(Fokker版の一点基底コンビネータ)だけは普通の関数定義だが、
それ以降は関数xの適用のみのため、unsafeCoerceもx内で１度使うだけで済む。

import Unsafe.Coerce
x f = f (\x y z -> x z $ y $ unsafeCoerce z) (\x y z -> x)

k  = x x            -- k  x y     = x
s  = x k            -- s  f g x   = f x (g x)
ki = s k            -- ki x y     = y
i  = ki x           -- i  x       = x
b  = s (k s) k      -- b  f g x   = f (g x)
d  = b b            -- d  f x g y = f x (g y)
c  = s (d s) (k k)  -- c  f x y   = f y x
t  = c i            -- t  x f     = f x 
v  = b c t          -- v  x y f   = f x y
s' = b (b s) b      -- s' f g h x = f (g x) (h x)
b' = b (b b) b      -- b' f g h x = f (g (h x))
c' = b (b c) b      -- c' f g x y = f (g y) x

m = s i i
y = b m (c b m)

true  = k
false = ki
not'  = v false true
and'  = c c false
or'   = t true

cons = v
car  = t true
cdr  = t false

inc  = s b
incs = s (b cons cdr) (b inc cdr)
dec  = b car (c (t incs) (k n0))

n0 = ki
n1 = i
n2 = inc n1
n4 = n2 n2
n5 = inc n4

add = b s d
mul = b
pow = t
sub = c (t dec)

is0 = v (k false) true
le  = d b is0 sub
ge  = c le
lt  = d b not' ge
gt  = c lt

rsub = c (c' c' s' sub) i     -- rsub f m n = f (sub m n) n
mod' = y $ b  (s' s (s' c lt i)) rsub
div' = y $ b' (s' s (c' c lt n0)) (d b inc) rsub

num n = n (+1) 0 :: Int
main = print $ map (\f -> num $ f n5 n2) [add,mul,pow,sub,mod',div']

実行結果
それぞれ5+2, 5*2, 5^2, 5-2, 5%2, 5/2の計算結果になっている。

[7,10,25,3,1,2]

おまけ

上記のソースは段階的に適用結果を変数に入れていてxだけで動いているという実感がわかないが、
例えばn2とmulをxだけで書くと以下のとおり。

import Unsafe.Coerce
x f = f (\x y z -> x z $ y $ unsafeCoerce z) (\x y z -> x)

n2  = x (x x) (x (x x) (x x (x (x x))) (x x)) (x (x x) (x x) x)
mul = x (x x) (x x (x (x x))) (x x)

num n = n (+1) 0 :: Int
main = print $ map num [n2,mul n2 n2,mul n2 (mul n2 n2)]

実行結果
それぞれ2, 2*2, 2*2*2の表示結果

[2,4,8]