文字列リテラルが無いLazy Kで黒魔術も力技も使わずにクワイン

Lazy Kで素直にクワインを作ったときのメモ。

Lazy Kとは

Lazy Kは、あのHaskellと同じ純粋(Pure)関数型(Functional)言語である。

`fxで、xにfを適用する。
関数はi、k、sの3つ。

  • `ix=x
  • ``kxy=x
  • ```sxyz=``xz`yz

入出力は、0~255までのチャーチ数のリストで表現する。ストリームの終端は256。
入力にプログラムを適用した結果を出力とする。

実験に使用したインタプリタ
https://gist.github.com/2281119

クワインについて

クワインとは、自分自身のソースコードを出力するプログラムのこと。
自分自身のソースコードソースコードの一部に埋め込むことはできないので、難しく感じるだろう。

そこで、「クワイン化」という操作を定義する。「Aをクワイン化する」とは、"Aをクワイン化する"という文字列を生成することである。「Aをクワイン化する」とは、Aの自由変数を自身の引用で置換することである。ここで、"Aをクワイン化する"をクワイン化すると、"「Aをクワイン化する」をクワイン化する"となる。この文字列を解釈すると、「解釈する文字列(プログラム)」と、「解釈の結果(出力)」がまったく等しくなる。これがクワインである。

実装の前に

クワインはこのような形になる。
`[quine]"quine"

quineは、前述のクワイン化を行う関数である。しかし、Lazy Kには文字列リテラルは存在しないため、実際はこのような形になる。
`[quine][code]

quineは"codeにquineを適用する"という文字列を生成する関数。codeはLazy Kのコードで、かつcodeから構文解析する前のcodeを再現できることが要求される。

それを満たすのが、チャーチ数のリストである。「`」、「s」、「k」、「i」に0~3のチャーチ数を対応させる。
全体のコード量を減らすために、最もよく出てくる「`」に最もコードが短い1、「s」に0、kに2、そして最も出現しにくいiに最もコードが長い3を割り当てている。

実際に作る

Scheme→Lazy Kのコンパイラを使用する。(http://esoteric.sange.fi/essie2/download/からダウンロードしよう)

(load "lazier.scm")
(load "prelude.scm")
(load "prelude-numbers.scm")

文字列を結合する関数をあらかじめ定義しておく。

(lazy-def '(++ self xs ys) '(s (null? xs) (o (cons (car xs)) (self (cdr xs))) ys))

main

(lazy-def '(main input) '(s (o (Y ++) (Y show)) (Y quote-show) code))

codeにshowとquote-showを適用してくっつけるだけ。

`k```s``s`k```sii``s`k``s`k`s``s`ks``si`k`k`k`ki``s`k`s``s`ks```ss`s``s`ks``s`kk
``s`ks``s`k`si```ss`si`kk`kk``s``s`ksk`k``si`k`ki``sii```sii``s`k[show]``sii```s
ii``s`k[quote-show]``sii[code]

showはチャーチ数のリストを`、s、k、iの列にする。

(lazy-def 'syms '(cons 115 (cons 96 (cons 107 (cons 105 ())))))

(lazy-def '(show self input) '(if (null? input) () (cons (nth (car input) syms) (self (cdr input)))))
``s`k`s``s``si`k`k`k`ki`k`kk``s`k`s``s`ks``s`k`si``s`kk``s`k``si`kk``s``s``si`kk
`k``si`k`ki`k``s``si`k``s``s`ksk``s`k``s``s`kski``s``s`ksk``s`k``s``s`kski``s``s
`ksk```sii``s``s`ksk``s``s`kski`k``s``si`k``s`k``s`k``s``s`kski``s``s`ksk``s``s`
kski```s``siii``s``s`kski`k``s``si`k`````sii``s``s`ksk``s``s`kski`s``s`ksk``s`k`
`s``s`ksk```sii``s``s`kski```s``siii``s``s`kski`k``s``si`k``s``s`ksk``s`k```sii`
`s``s`kski``s``s`ksk```s``s`kski``s``s`ksk```sii``s``s`kski`k`kk``s`k`s`kk``s``s
`ksk`k``si`k`ki

quote-showは、チャーチ数のリストをチャーチ数のリストの表現に変換する。

(lazy-def 'f '(s o i (o (s o i (cons 96)) (cons 115)))) ; ``s``s
(lazy-def 'g '(o (cons 96) (cons 107))) ;`k
(lazy-def 'h '(s (o o (o (cons 96))) (o (cons 115)) (cons 107))) ;`ksk

;``s``si`k[a]`k[b]
(lazy-def '(cons-show a b) '(o f (cons 105) (Y ++ (g a) (g b))))

(lazy-def 'quote-unit '(cons 96 ((s o i (cons 107)) end-of-output))
(lazy-def '(quote-n self origin) '(s cons (o self (o f h)) origin))
(lazy-def 'quote-nums '(s (o cons g) (Y quote-n) (cons 105 ())))

(lazy-def '(quote-show self input) '(if (null? input) quote-unit (cons-show (nth (car input) quote-nums) (self (cdr input)))))
``s`k`s``s``si`k`k`k`ki`k``s``si`k``s`k``s`k``s``s`kski``s``s`ksk``s``s`kski```s
``siii``s``s`kski`k````s``s`kski``s`k`s``si`k`````sii``s``s`ksk``s``s`kski`s``s`
ksk``s`k``s``s`ksk```sii``s``s`kski```s``siii``s``s`kskik`k```sii```sii``s``s`ks
ki``s`k`s`k``s`k```s``s`kski``s`k```s``s`kski``s`k`s``si`k``s`k``s`k``s``s`kski`
`s``s`ksk``s``s`kski```s``siii``s``s`kskik``s`k`s``si`k``s``s`ksk``s`k``s``s`ksk
i``s``s`ksk``s`k``s``s`kski``s``s`ksk```sii``s``s`ksk``s``s`kskik``s`k`s``si`k``
s``s`ksk``s`k```sii``s``s`kski``s``s`ksk```s``s`kski``s``s`ksk```sii``s``s`kskik
``s`k`s``s`k```sii``s`k``s`k`s``s`ks``si`k`k`k`ki``s`k`s``s`ks```ss`s``s`ks``s`k
k``s`ks``s`k`si```ss`si`kk`kk``s``s`ksk`k``si`k`ki``sii``s`k``s`k`s``si`k``s`k``
s`k``s``s`kski``s``s`ksk``s``s`kski```s``siii``s``s`kskik``s`k``s`k`s``si`k`````
sii``s``s`ksk``s``s`kski`s``s`ksk``s`k``s``s`ksk```sii``s``s`kski```s``siii``s``
s`kskik``s`k``si`kk``s``s``si`kk`k``si`k`ki`k```s``s`k``s``s`ks``s`kk``s`ks``s`k
`sik`kk``s`k``s`k`s``si`k``s`k``s`k``s``s`kski``s``s`ksk``s``s`kski```s``siii``s
``s`kskik``s`k`s``si`k`````sii``s``s`ksk``s``s`kski`s``s`ksk``s`k``s``s`ksk```si
i``s``s`kski```s``siii``s``s`kskik```sii``s`k``s`k`s``s``s`ks``s`kk``s`ks``s`k`s
ik`kk``s``s`ksk`k``s`k```s``s`kski``s`k```s``s`kski``s`k`s``si`k``s`k``s`k``s``s
`kski``s``s`ksk``s``s`kski```s``siii``s``s`kskik``s`k`s``si`k``s``s`ksk``s`k``s`
`s`kski``s``s`ksk``s`k``s``s`kski``s``s`ksk```sii``s``s`ksk``s``s`kskik```s``s`k
``s`ksk`s`k``s`k`s``si`k``s`k``s`k``s``s`kski``s``s`ksk``s``s`kski```s``siii``s`
`s`kskik`s`k``s`k`s``si`k``s``s`ksk``s`k``s``s`kski``s``s`ksk``s`k``s``s`kski``s
``s`ksk```sii``s``s`ksk``s``s`kskik``s`k`s``si`k`````sii``s``s`ksk``s``s`kski`s`
`s`ksk``s`k``s``s`ksk```sii``s``s`kski```s``siii``s``s`kskik``sii``s``si`k``s``s
`ksk``s`k```sii``s``s`kski``s``s`ksk```s``s`kski``s``s`ksk```sii``s``s`kski`k`kk
``s`k`s`k``s`k`s``si`k``s`k``s`k``s``s`kski``s``s`ksk``s``s`kski```s``siii``s``s
`kskik``s`k`s`k``s`k`s``si`k`````sii``s``s`ksk``s``s`kski`s``s`ksk``s`k``s``s`ks
k```sii``s``s`kski```s``siii``s``s`kskik``s``s`ksk`k``si`k`ki

組み合わせるとこのようになる。

quine.scm

(load "lazier.scm")
(load "prelude.scm")
(load "prelude-numbers.scm")

(lazy-def '(++ self xs ys) '(s (null? xs) (o (cons (car xs)) (self (cdr xs))) ys))

(lazy-def 'syms '(cons 115 (cons 96 (cons 107 (cons 105 ()))))) ; ['s', '`', 'k', 'i']

(lazy-def 'f '(s o i (o (s o i (cons 96)) (cons 115)))) ; ``s``s
(lazy-def 'g '(o (cons 96) (cons 107))) ;`k
(lazy-def 'h '(s (o o (o (cons 96))) (o (cons 115)) (cons 107))) ;`ksk

;``s``si`k[a]`k[b]
(lazy-def '(cons-show a b) '(o f (cons 105) (Y ++ (g a) (g b))))

(lazy-def 'quote-unit '(cons 96 ((s o i (cons 107)) end-of-output)))
(lazy-def '(quote-n self origin) '(s cons (o self (o f h)) origin))
(lazy-def 'quote-nums '(s (o cons g) (Y quote-n) (cons 105 ())))

(lazy-def '(quote-show self input) '(if (null? input) quote-unit (cons-show (nth (car input) quote-nums) (self (cdr input)))))

(lazy-def '(show self input) '(if (null? input) () (cons (nth (car input) syms) (self (cdr input)))))

(lazy-def '(main input) '(s (o (Y ++) (Y show)) (Y quote-show) code))

(print-as-unlambda (laze 'main))
`k```s``s`k```sii``s`k``s`k`s``s`ks``si`k`k`k`ki``s`k`s``s`ks```ss`s``s`ks``s`kk
``s`ks``s`k`si```ss`si`kk`kk``s``s`ksk`k``si`k`ki``sii```sii``s`k``s`k`s``s``si`
k`k`k`ki`k`kk``s`k`s``s`ks``s`k`si``s`kk``s`k``si`kk``s``s``si`kk`k``si`k`ki`k``
s``si`k``s``s`ksk``s`k``s``s`kski``s``s`ksk``s`k``s``s`kski``s``s`ksk```sii``s``
s`ksk``s``s`kski`k``s``si`k``s`k``s`k``s``s`kski``s``s`ksk``s``s`kski```s``siii`
`s``s`kski`k``s``si`k`````sii``s``s`ksk``s``s`kski`s``s`ksk``s`k``s``s`ksk```sii
``s``s`kski```s``siii``s``s`kski`k``s``si`k``s``s`ksk``s`k```sii``s``s`kski``s``
s`ksk```s``s`kski``s``s`ksk```sii``s``s`kski`k`kk``s`k`s`kk``s``s`ksk`k``si`k`ki
``sii```sii``s`k``s`k`s``s``si`k`k`k`ki`k``s``si`k``s`k``s`k``s``s`kski``s``s`ks
k``s``s`kski```s``siii``s``s`kski`k````s``s`kski``s`k`s``si`k`````sii``s``s`ksk`
`s``s`kski`s``s`ksk``s`k``s``s`ksk```sii``s``s`kski```s``siii``s``s`kskik`k```si
i```sii``s``s`kski``s`k`s`k``s`k```s``s`kski``s`k```s``s`kski``s`k`s``si`k``s`k`
`s`k``s``s`kski``s``s`ksk``s``s`kski```s``siii``s``s`kskik``s`k`s``si`k``s``s`ks
k``s`k``s``s`kski``s``s`ksk``s`k``s``s`kski``s``s`ksk```sii``s``s`ksk``s``s`kski
k``s`k`s``si`k``s``s`ksk``s`k```sii``s``s`kski``s``s`ksk```s``s`kski``s``s`ksk``
`sii``s``s`kskik``s`k`s``s`k```sii``s`k``s`k`s``s`ks``si`k`k`k`ki``s`k`s``s`ks``
`ss`s``s`ks``s`kk``s`ks``s`k`si```ss`si`kk`kk``s``s`ksk`k``si`k`ki``sii``s`k``s`
k`s``si`k``s`k``s`k``s``s`kski``s``s`ksk``s``s`kski```s``siii``s``s`kskik``s`k``
s`k`s``si`k`````sii``s``s`ksk``s``s`kski`s``s`ksk``s`k``s``s`ksk```sii``s``s`ksk
i```s``siii``s``s`kskik``s`k``si`kk``s``s``si`kk`k``si`k`ki`k```s``s`k``s``s`ks`
`s`kk``s`ks``s`k`sik`kk``s`k``s`k`s``si`k``s`k``s`k``s``s`kski``s``s`ksk``s``s`k
ski```s``siii``s``s`kskik``s`k`s``si`k`````sii``s``s`ksk``s``s`kski`s``s`ksk``s`
k``s``s`ksk```sii``s``s`kski```s``siii``s``s`kskik```sii``s`k``s`k`s``s``s`ks``s
`kk``s`ks``s`k`sik`kk``s``s`ksk`k``s`k```s``s`kski``s`k```s``s`kski``s`k`s``si`k
``s`k``s`k``s``s`kski``s``s`ksk``s``s`kski```s``siii``s``s`kskik``s`k`s``si`k``s
``s`ksk``s`k``s``s`kski``s``s`ksk``s`k``s``s`kski``s``s`ksk```sii``s``s`ksk``s``
s`kskik```s``s`k``s`ksk`s`k``s`k`s``si`k``s`k``s`k``s``s`kski``s``s`ksk``s``s`ks
ki```s``siii``s``s`kskik`s`k``s`k`s``si`k``s``s`ksk``s`k``s``s`kski``s``s`ksk``s
`k``s``s`kski``s``s`ksk```sii``s``s`ksk``s``s`kskik``s`k`s``si`k`````sii``s``s`k
sk``s``s`kski`s``s`ksk``s`k``s``s`ksk```sii``s``s`kski```s``siii``s``s`kskik``si
i``s``si`k``s``s`ksk``s`k```sii``s``s`kski``s``s`ksk```s``s`kski``s``s`ksk```sii
``s``s`kski`k`kk``s`k`s`k``s`k`s``si`k``s`k``s`k``s``s`kski``s``s`ksk``s``s`kski
```s``siii``s``s`kskik``s`k`s`k``s`k`s``si`k`````sii``s``s`ksk``s``s`kski`s``s`k
sk``s`k``s``s`ksk```sii``s``s`kski```s``siii``s``s`kskik``s``s`ksk`k``si`k`ki``s
ii[code]

[code]を、コードのチャーチ数のリストによる表現に置き換えればクワインの完成だ。
encode.hs

data Expr = Expr :$ Expr | I | K | S

cons :: Expr -> Expr -> Expr
cons a b = S :$ (S :$ I :$ (K :$ a)) :$ (K :$ b)

church 's' = K :$ I
church '`' = I
church 'k' = S :$ (S :$ (K :$ S) :$ K) :$ I
church 'i' = S :$ (S :$ (K :$ S) :$ K) :$ (S :$ (S :$ (K :$ S) :$ K) :$ I)

end = (K :$ K)

showUnlambda I = "i"
showUnlambda K = "k"
showUnlambda S = "s"
showUnlambda (a :$ b) = "`" ++ showUnlambda a ++ showUnlambda b

main = getContents >>= putStr . showUnlambda . foldr cons end . map church . filter (`elem` "`iks") 

$ gosh -I./ quine.scm | tr -d "\n" | sed s/\\[code\\]// > prog.lazy
$ runhaskell encode.hs < prog.lazy | cat prog.lazy - > quine.lazy
$ ./lazyk quine.lazy > quine.lazy.out
$ md5sum quine.lazy quine.lazy.out

ハッシュ値が一致すれば成功。

ideoneで動くサンプル
http://ideone.com/ST3kF