厨二病患者のプログラミング入門

ラムダ関数→SKI変換器作った

プログラミング, Haskell

前に買った某イカの本の影響でここ数日間SKI計算をやっていたのですが、まだSKI初心者な僕はうまく思い通りのSKI関数を作ることができません。
λカ娘の1章にはラムダ関数をSKIに変換できる公式のようなものが載っています。これを使うと、ラムダ関数さえ自分で用意しておけば、あとは何も考えずに手を動かしているだけでSKIになってしまうという優れものです。しかし、この方法はとても面倒臭いです。簡単なラムダ関数を変換するだけでもかなり時間がかかります。現に、僕は

λfgx.g(fx)

というラムダ関数(Haskellでいうところのflip)を、

S(S(KS)(S(S(KS)(S(KK)(KS)))(S(S(KS)(S(KK)(KK)))(KI))))(S(S(KS)(S(S(KS)(S(KK)(KS)))(S(S(KS)(S(KK)(KK)))(S(KK)I))))(S(KK)(KI)))

このSKI式に変換するのに1時間近くかかってしまいました。これではとてもじゃないですがSKI計算なんてやってられません…。

しかし、面倒なものは目の前にある箱に自動でやらせてしまえばいいのです。ということで、ラムダ関数をSKI式に自動で変換するプログラムを書いてみました。ソースは長くなるので、記事の最後に載せてあります。

GHCi上で対話的に実行する前提で書かれているので、このプログラム自体は実行したりはできません。

まずはラムダ関数を作りましょう。このプログラムにはLambdaFunc型というものがあり、これはRead型クラスのインスタンスになっているので、

ghci> read "\\fgx.f(gx)" :: LambdaFunc
\fgx.f(gx)

とするだけで作ることができます。また、LambdaFuncはShow型クラスのインスタンスにもなっているので、showすればどのようなラムダ関数なのかが分かるようになっています。
「λ」という文字はいちいち出すのが面倒なので、Haskellと同じく「\」を代用しています。
変数名は1文字限定で、後述するソースの上のほうで定義されているinvalidNamesに含まれていないものは全て使うことができます。

ghci> read "\\x,.x" :: LambdaFunc
\x*** Exception: no parse

また、「λx.λy.xy」のようなラムダ関数は、「λxy.xy」のように変換されます。

ghci> read "\\x.\\y.xy" :: LambdaFunc
\xy.xy

できたラムダ関数をlambdaToSKI関数に渡すと、SKI式に変換してくれます。

ghci> let lambda = read "\\fgx.f(gx)" :: LambdaFunc
ghci> lambdaToSKI lambda
S(S(KS)(S(S(KS)(S(KK)(KS)))(S(S(KS)(S(KK)(KK)))(S(KK)I))))(S(S(KS)(S(S(KS)(S(KK)(KS)))(S(S(KS)(S(KK)(KK)))(KI))))(S(KK)(KI)))
ghci> lambdaToSKI $ read "\\f.\\x.\\y.fyx"
S(S(KS)(S(S(KS)(S(KK)(KS)))(S(S(KS)(S(S(KS)(S(KK)(KS)))(S(S(KS)(S(KK)(KK)))(S(KK)I))))(S(KK)(KI)))))(S(S(KS)(S(KK)(KK)))(KI))

この変換にはλカ娘1期の1章に載っていた方法を使っています。詳しく知りたい方はλカ娘を読んで下さい。持っていない方はhttp://www.icfpcontest.org/に載っているようなので探してみて下さい。
とにかく、これで簡単にSKI式を書くことができるようになりました。



さらに、このプログラムにはTemplateHaskellを使ってSKI式からHaskellの関数を生成する機能が付いています。

ghci> let lambda = read "\\fgx.f(gx)" :: LambdaFunc -- Haskellでいうところの.演算子
ghci> lambdaToSKI lambda
S(S(KS)(S(S(KS)(S(KK)(KS)))(S(S(KS)(S(KK)(KK)))(S(KK)I))))(S(S(KS)(S(S(KS)(S(KK)(KS)))(S(S(KS)(S(KK)(KK)))(KI))))(S(KK)(KI)))
ghci> let f = $(execSKI $ lambdaToSKI lambda) putStrLn ("Hello, "++)
ghci> f "world"
Hello, world!
ghci> f "SKI"
Hello, SKI

当たり前ですが、変なラムダ関数を渡すとエラーになります。

ghci> let lambda = read "\\xy.z" :: LambdaFunc -- zは存在しない変数
ghci> let f = $(execSKI $ lambdaToSKI lambda)

<interactive>:1:11:
    unknown variable `z'
    In the expression: $(execSKI $ lambdaToSKI lambda)
    In an equation for `f': f = $(execSKI $ lambdaToSKI lambda)

もちろんHaskellなので本物のSKI式とは違い型の制約があります。
例えば、λカ娘に出てきたM関数は、このような定義になっています。

M = λx.xx

しかし、Haskellでは型の定義が無限に続いてしまうため、このような関数は作ることができません。したがって、Haskellでは輝かしい地上の支配者であるIKMSMの名を記すことはできないのです。



以下はソースです。

{-# LANGUAGE TemplateHaskell #-}

module LambdaSKI (
      lambdaToSKI
    , execSKI
    , s
    , k
    , i
    )where

import Language.Haskell.TH

-- ラムダ関数の式の部分
data LambdaExpr = LVarE Char
                | LAppE LambdaExpr LambdaExpr
                deriving (Eq)

-- 変数名として使えない文字
invalidNames = ",.[]()\\"

-- 有効な文字か確かめてからLVar[PE]に変換
-- 有効でない文字の場合はerror吐く
toVarIfValid :: (Char -> a) -> Char -> a
toVarIfValid f c
    | c `elem` invalidNames = error $ "invalid name `" ++ [c] ++ "'"
    | otherwise = f c

lVarE = toVarIfValid LVarE
lVarP = toVarIfValid LVarP

instance Show LambdaExpr where
    show (LVarE v) = [v]
    show (LAppE x y) = show x ++ y'
        where y' | length (show y) <= 1 = show y
                 | otherwise = "(" ++ show y ++ ")"

-- ラムダ関数の引数の部分
data LambdaPat = LVarP Char
    deriving (Eq)

instance Show LambdaPat where
    show (LVarP v) = [v]

-- ラムダ関数本体
data LambdaFunc = LambdaFunc {
      lambdaArgs :: [LambdaPat]
    , lambdaExpr :: LambdaExpr
    } deriving (Eq)

instance Show LambdaFunc where
    show f = '\\' : args ++ "." ++ expr
        where
        args = concatMap show $ lambdaArgs f
        expr = show $ lambdaExpr f

instance Read LambdaFunc where
    readsPrec _ ('\\':s) | '.' `elem` s = [(lambda, rest)]
                         | otherwise = [] -- "\x.M"の'.'が入ってないとエラー
        where
        lambda = case expr of
            -- 戻り値がラムダ関数になっていた場合は、
            -- 戻り値を先にreadして、1つのラムダ関数に合成
            '\\':s -> let (LambdaFunc args' expr') = read $ '\\':s
                      in LambdaFunc (map lVarP args ++ args') expr'
            s      -> LambdaFunc (map lVarP args) $ ap $ reverse expr
        (args, '.':expr) = span (/='.') value
        (value, rest) = span (/=' ') s
        -- ラムダ関数の式を解析
        -- 処理しやすいように文字列は逆順になっている
        ap (x:[]) = lVarE x
        -- 括弧の開始。xsは逆順になっているため。
        ap (')':xs) = LAppE (ap $ tail (dropWhile (/='(') xs)) $ ap xs
        -- 括弧の終了
        ap (x:'(':_) = lVarE x
        ap (x:xs) = LAppE (ap xs) $ lVarE x
        ap _ = error "parse error"
    readsPrec _ _ = []

-- ラムダ関数からSKIに変換するためのデータ構造
-- 詳しくは「簡約! λカ娘」1章を参照
data SKIConverter =
      T LambdaFunc
    | A Char SKIConverter
    | Var Char
    | S
    | K
    | I
    | Ap SKIConverter SKIConverter
    deriving (Eq)

instance Show SKIConverter where
    show (T f) = "T{" ++ show f ++ "}"
    show (A x y) = "A{" ++ [x] ++ ", " ++ show y ++ "}"
    show (Var x) = [x]
    show S = "S"
    show K = "K"
    show I = "I"
    show (Ap x y) = show x ++ y'
        where y' | length (show y) <= 1 = show y
                 | otherwise = "(" ++ show y ++ ")"

-- SKIConverter型を関数に
execSKI :: SKIConverter -> Q Exp
execSKI S = varE 's
execSKI K = varE 'k
execSKI I = varE 'i
execSKI (Ap x y) = appE (execSKI x) (execSKI y)
execSKI (Var x) = fail $ "unknown variable `" ++ [x] ++ "'"
execSKI x = fail $ "can't convert to Haskell code: " ++ show x

-- SKIConverterを使いラムダ関数をSKIのみの式に変換
-- 何回か実行すると式がSKIのみになる
convert :: SKIConverter -> SKIConverter
convert (T (LambdaFunc (LVarP x:xs) f))
    = A x $ T $ LambdaFunc xs f
convert (T (LambdaFunc [] (LAppE x y)))
    = Ap (T $ LambdaFunc [] x) (T $ LambdaFunc [] y)
convert (T (LambdaFunc [] (LVarE x)))
    = Var x

convert (A x (Var y))
    | x == y = I
    | otherwise = Ap K $ Var y
convert (A x (Ap p q)) = Ap (Ap S (A x p)) (A x q)
convert (A x t@(T _)) = A x $ convert t
convert (A x a@(A _ _)) = A x $ convert a
convert (A x y) = Ap K $ convert y

convert (Ap (Ap (Ap S x) y) z) = Ap (Ap x' z') (Ap y' z')
    where x' = convert x
          y' = convert y
          z' = convert z
convert (Ap (Ap K x) _) = convert x
convert (Ap I x) = convert x
convert (Ap x y) = Ap (convert x) (convert y)

convert x = x

-- それ以上変化しなくなるまでconvertを実行
runConverter :: SKIConverter -> SKIConverter
runConverter s | s' == s = s
               | otherwise = runConverter s'
    where s' = convert s

-- ラムダ関数をSKIに変換
lambdaToSKI :: LambdaFunc -> SKIConverter
lambdaToSKI = runConverter . T

-- SKIそれぞれの関数
s :: (a -> b -> c) -> (a -> b) -> a -> c
s x y z = (x z) (y z)

k :: a -> b -> a
k x _ = x

i :: a -> a
i x = x

ツイートする

Permalink | コメント(0) | トラックバック(0) | 21:14