trampolineでバックトラックパーサを作る

shift/resetと、(fnで囲った)closure/trampolineは、なんとなく似てます。

trampoline

trampolineは、末尾再帰をエミュレートする為の関数です。

clojureは、末尾再帰ができないので、loop-recur特殊形式で
ループを記述するのですが、これは、ほとんどJavaやCのwhile文か、
それ以下の表現力しかありません。
なので、相互再帰とか、複雑な末尾再帰は表現できません。

その代替手段としてtrampolineという関数があります。
以下のように使います。

1. まず、普通に末尾呼出形式で関数型言語風のプログラムを書きます。
2. 次に、その末尾呼出を全部無名関数で囲ってクロージャにします。
3. トランポリン関数の上で、相互再帰の関数を呼び出します。

トランポリンは、与えられた関数とその引数を起動して、関数を実行します。
関数の実行結果として、

1. クロージャが戻ってきたら、(それは、末尾呼出なので)そのクロージャを再び実行。
2. それ以外の値が戻ってきたら、終了。

これで、スタックを消費せずに、末尾再帰が、特に相互再帰のような
複雑な末尾再帰も実現できるという事で、非常にめでたいのですが。

この末尾呼出で戻ってきたクロージャってもしかして、
trampolineが終了するまでの残りの計算　 ... .... (限定)継続!?

というわけで、概念的に、というか理論的にどうなのかはわかりませんが、
直感的には、かなり似たものだという印象です。

trampolineがresetに対応していて、
「shiftが呼ぶ限定継続」が、「末尾再帰で送り出されるレキシカルクロージャ」に対応している、
と、考えます。

その証拠というか、例として、shift/resetの得意なバックトラックを
trampolineを使って簡単に書くことができます。
その例として、パーサ(構文解析器)を書きました。

バックトラックパーサ

バックトラックとは、その名の通り(?)後戻りをする機構のことです。構文解析とは、結局のところ、文法法則を(終端)記号列に対してうまく当てはまるかどうかを試すアルゴリズムに過ぎません。なので、当てはまりそうだったら、適当に当てはめてみて、ダメだったら、元に戻すというやり方でもOKなのです。(もちろん、それ相応の計算量がかかりますが。)
なので、適当にパターンマッチを繰り返して、辻褄があわなくなったらその時点まで戻るようなパーサを書くことができます。それがバックトラックパーサです。
で、今回のこの末尾呼出のクロージャを限定継続に見立てて、パターンマッチに失敗したら、この限定継続もどきを呼び出すことでバックトラックを実現します。

次の文法をParseするプログラムにしました。

E → T '+' E
T → F '*' T
E → T
T → F
F → num

backtracparser.clj

	(defn trampoline-condition [cc-name statements]
	(list 'fn []
	(if (= (first statements) :else)
	(second statements)
	(list 'let [cc-name
	(trampoline-condition cc-name
	(rest (rest statements)))]
	(list 'if
	(first statements)
	(list 'fn [] (second statements))
	cc-name)))))
	(defmacro tcond [cc-name & statements]
	(list 'trampoline
	(list 'fn []
	(trampoline-condition cc-name statements))))
	(defmacro ccond [cc-name & statements]
	(list 'fn []
	(trampoline-condition cc-name statements)))
	(defmacro caar [ls]
	`(first (first ~ls)))
	(defn st-equals
	"stack top equals ls "
	[stack ls]
	(loop [stack stack ls (reverse ls)]
	(cond
	(empty? ls)
	,true
	(= (caar stack) (first ls))
	,(recur (rest stack) (rest ls))
	:else
	false)))
	(defn parser [stack-trace tokens]
	"backtrack parser"
	(defn lecur [stack tokens cc]
	(if stack-trace (println (str stack)))
	(ccond
	c-cont
	(empty? tokens)
	,(if (= 2 (count stack))
	(second stack)
	(do
	(if stack-trace (println "back track !!"))
	cc))
	(st-equals stack [:num])
	,(lecur (cons [:F (first stack)] (drop 1 stack)) tokens c-cont)
	(st-equals stack [:F])
	,(lecur (cons [:T (first stack)] (drop 1 stack)) tokens c-cont)
	(st-equals stack [:T])
	,(lecur (cons [:E (first stack)] (drop 1 stack)) tokens c-cont)
	(st-equals stack [:F :* :T])
	,(lecur (cons [:T :* (first stack) (nth stack 2)] (drop 3 stack))
	tokens c-cont)
	(st-equals stack [:T :+ :E])
	,(lecur (cons [:E :+ (first stack) (nth stack 2)] (drop 3 stack))
	tokens c-cont)
	:else
	(lecur (cons (first tokens) stack) (rest tokens) cc)))
	(trampoline #(lecur [] tokens (fn[] "not-parsable"))))
	(defn parse [tokens]
	(parser false tokens))
	(defn parse-with-stack-trace [tokens]
	(parser true tokens))

view raw backtrackparser.clj hosted with ❤ by GitHub

実行結果と利用例は、こんな感じ。
ちゃんと構文解析しています。
parse-with-stack-traceで、バックトラックしていることも確認出来ます。

user=> (load-file "backtrackparser.clj")
#'user/parse-with-stack-trace
user=> (parse [[:num] [:+] [:num] [:*] [:num] [:$]])
[:E :+ [:E [:T :* [:T [:F [:num]]] [:F [:num]]]] [:T [:F [:num]]]]
user=> (parse-with-stack-trace [[:num] [:+] [:num] [:*] [:num] [:$]])
[]
([:num])
([:F [:num]])
... ...
([:$] [:E [:T [:F [:num]]]] [:*] [:F [:num]] [:+] [:T [:F [:num]]])
back track !!
([:T :* [:T [:F [:num]]] [:F [:num]]] [:+] [:T [:F [:num]]])
([:E [:T :* [:T [:F [:num]]] [:F [:num]]]] [:+] [:T [:F [:num]]])
([:E :+ [:E [:T :* [:T [:F [:num]]] [:F [:num]]]] [:T [:F [:num]]]])
([:$] [:E :+ [:E [:T :* [:T [:F [:num]]] [:F [:num]]]] [:T [:F [:num]]]])
[:E :+ [:E [:T :* [:T [:F [:num]]] [:F [:num]]]] [:T [:F [:num]]]]

うーん、gistとブログの色合いが微妙......