Haskellで「ものまねどり Mocking Bird」

自己言及がはいるとHaskellでは型付けができないので,無理かなとおもったら,unsafeCoerceという邪悪なものを使う方法があるそうです.これで,いろいろ遊べそう.

module Birds where
import Control.Applicative
import Unsafe.Coerce

-- Haskellで定義済みのもの
s = (<*>)              -- starlingbird
k = const              -- kestrel
i = id                 -- identity bird
b = (.)                -- bluebird
c = flip               -- cardinal
-- コンビネータで定義したコンビネータ
b1 = b b b             -- blackbird
b2 = b b1 b            -- buting
b3 = b d b             -- becard
cc = b c               -- cardinal once removed
ccc = b cc             -- cardinal twice removed
d = b b                -- dove
d1 = b d               -- dickcissel
d2 = d d               -- dovekies
e = b b1               -- eagle
e'' = e e              -- baid eagle
f = e t t e t          -- finch
ff = b cc rr           -- finch once removed
fff = b ff             -- finch twice removed
g = b b c              -- gold finch
h = b w cc             -- hummingbird
iii = s (s' k)         -- identity bird twice removed
i' = unsafeCoerce i    -- pseudo? i
j = b cc (w (cc e))    -- jay
l  = c b m'            -- lark
m = s i i'             -- mockingbird
m' = unsafeCoerce m    -- pseudo? m
m2 = b m               -- double mockingbird
o = s i                -- owl
q = c b                -- queer bird
q1 = b c b             -- quixotic bird
q2 = c q1              -- quizzical bird
q3 = b t               -- quirky bird
q4 = ff b              -- quacky bird
r = b b t              -- robin
rr = cc cc             -- robin once removed
s' = unsafeCoerce s    -- pseudo? s
t = c i                -- thrush 
u = l o                -- turing
v = b c t              -- vireo
vv = cc ff             -- vireo once removed
vvv = b vv             -- vireo twice removed
w = c (b m' r)         -- warbler
w1 = c w               -- converse Warbler
ww = b w               -- warbler once removed
www = b ww             -- warbler twice removed
y = s l l              -- why bird (a.k.a sage bird)

unsafeCoerceの使いどころが微妙ではありますが.こんな感じでひとおとりの鳥を定義できます.Υコンビネータを使ってフィボナッチ関数を定義すると以下のとおり.

fib :: Integer -> Integer
fib = y (\ f n -> if n < 2 then n else f (n-1) + f (n-2))