λeffをPrologに移植したら133行で書けた。
代数的効果は継続のようであるけど様々なエフェクトに使えるので今後期待されている技術です。 λeff はそのエッセンスを取り出した言語ですがそれなりに代数的効果を実験できるのでいろいろな言語に実装してみています。 今回はλeff を Prolog に移植してどの程度短くなるのか見てみました。
まずは字句解析器です。Prolog の場合は DCG 記法を使うと綺麗にパーサや字句解析器が書けます。パーサコンビネータで必要になるバックトラックや分岐、文脈を隠す機能などが揃っているのでかなり便利に使えます。値を返すパーサは文法名に返す変数名を入れないといけないのがやや冗長になりますが以下のような感じになりました:
lexer.pl
:- module(lexer,[tokens/3]). :- set_prolog_flag(double_quotes, chars). rep1(F,[C|Cs]) --> call(F,C),rep1(F,Cs). rep1(F,[C]) --> call(F,C). rep0(F,Cs) --> rep1(F,Cs) | [],{Cs=[]}. digit(C) --> [C], { code_type(C, digit) }. paren(C) --> [C], { member(C,"()[]{}") }. punct(C) --> [C], { code_type(C, punct),not(paren(C,[C],[])) }. alpha(C) --> [C], { code_type(C, lower);code_type(C, upper);C='_' }. alnum(C) --> alpha(C); digit(C). digits(Cs) --> rep1(digit,Cs). ident([C|Cs]) --> alpha(C),rep0(alnum,Cs). puncts(R) --> rep1(punct, R). tok(T) --> digits(Cs), { number_chars(I, Cs),!,T=int(I) } | ident(C), { atom_codes(A,C),!,(member(A,[let,in,handler,val,with,handle,inst,perform,fun])->T=A;T=id(A)) } | paren(C), { atom_codes(T,[C]) } | puncts(C), { atom_codes(T,C) }. tokens(Ts) --> (" "|"\r"|"\n"|"\t"), tokens(Ts). tokens([T|Ts]) --> tok(T), !, tokens(Ts). tokens([]) --> "".
パーサもDCGと字句解析器を使って書きました:
parser.pl
:- module(parser,[parse/2,parseFile/2]). :- use_module(lexer,[tokens/3]). readAll(File, Str) :- setup_call_cleanup(open(File, read, In), read_string(In, _, Str), close(In)). parseFile(F,R):- readAll(F,S),string_chars(S,C),parse(C,R). parse(C,R):- tokens(Ts,C,[]), expr(R,Ts,_). rep1(F,[C|Cs]) --> call(F,C),(rep1(F,Cs);{Cs=[]}). rep0(F,Cs) --> rep1(F,Cs) | [],{Cs=[]}. expr(R)-->[let],id(A),[=],expr(B),[in],expr(C), {R=(let(A=B);C)} | [handler],id(A),['('],[val],id(B),[->],expr(C),[')'], ['('],['('],id(D),[','],id(E),[')'],[->],expr(F),[')'], {R=handler(A,B->C,(D,E)->F)} | [with],expr(A),[handle],expr(B), {R=with(A,B)} | [inst],['('],[')'], {R=inst()} | [perform],id(A),expr(B), {R=perform(A,B)} | [fun],id(A),[->],expr(B),{R=fun(A->B)} | term(A), {R=A}. term(R)-->fact(A),rep0(t1,As), {foldl([(Op,C),B,D]>>(D=..[Op,B,C]),As,A,R)}. t1(R) -->[+],fact(A), {R=(+,A)} | [-],fact(A), {R=(-,A)}. fact(R)-->app(A),rep0(f1,As), {foldl([(Op,C),B,D]>>(D=..[Op,B,C]),As,A,R)}. f1(R) -->[*],app(A), {R=(*,A)} | [/],app(A), {R=(/,A)}. app(R) -->rep1(atm,[A|As]), {foldl([B,C,$(C,B)]>>!,As,A,R)}. atm(R) -->['('],expr(A),[')'], {R=A} | id(A), {R=A} | int(A), {R=A}. int(A) -->[int(A)]. id(A) -->[id(A)].
LLなパーサなので左再帰がある文法はループにしてfoldlで展開する感じに書き換えが必要ですが後は悩まず書けました。
評価器は構文をタグレスな形で扱うことで短く書けました。値の判定は値を返さない唯の述語として書いたり、数式演算の関数というか述語も消してしまえたのでより短くなりました。パターンマッチの分岐も評価規則ごとに分けて書けるので綺麗と思えば綺麗にかけます。パターンマッチのほうが好きな人もいると思いますけど。スモールステップ評価器は評価文脈を使うとよりきれいに書けるのですが今回は展開した状態で書いてあります。穴空きの数式をスタックにためて継続として扱う箇所はcopy_termを使ってみました:
eval.pl
:- module(eval,[run/2]).
:- op(800,xfx,[==>,$]).
i(I):- integer(I).
v(X):- atom(X).
v(handler(_,_,_)).
v(fun(_->_)).
v(eff(_)).
v(abort()).
v(I):- i(I).
subst(Y,Y,T,T):- atom(Y),!.
subst(fun(A->B),Y,T,fun(A->T1)):- A \= Y,subst(B,Y,T,T1).
subst(A$B,Y,T,T1$T2):- subst(A,Y,T,T1),subst(B,Y,T,T2).
subst(perform(A,B),Y,T,perform(T1,T2)):- subst(A,Y,T,T1),subst(B,Y,T,T2).
subst(let(Y=B);C,Y,T,let(Y=T1);C):- subst(B,Y,T,T1).
subst(let(A=B);C,Y,T,let(A=T1);T2):- subst(B,Y,T,T1),subst(C,Y,T,T2).
subst(with(A,B),Y,T,with(T1,T2)):- subst(A,Y,T,T1),subst(B,Y,T,T2).
subst(handler(A,B->C,(D,E)->F),Y,T,handler(A_,B->C_,(D,E)->F_)):-
subst(A,Y,T,A_),(B=Y->C_=C;subst(C,Y,T,C_)),
((D = Y; E = Y)-> F_=F;subst(F,Y,T,F_)).
subst(L+R,Y,T,L_+R_):- subst(L,Y,T,L_),subst(R,Y,T,R_).
subst(L-R,Y,T,L_-R_):- subst(L,Y,T,L_),subst(R,Y,T,R_).
subst(L*R,Y,T,L_*R_):- subst(L,Y,T,L_),subst(R,Y,T,R_).
subst(L/R,Y,T,L_/R_):- subst(L,Y,T,L_),subst(R,Y,T,R_).
subst(T,_,_,T):- !.
substs(T,List,T_):- foldl([X/U,Acc,V]>>subst(Acc,X,U,V),List,T,T_).
cp(A,B) :- copy_term(A,B).
flatfn([],X,X).
flatfn([F|Fs],X,A):- flatfn(Fs,X,A1),cp(F,A1/A).
kfunc(Stack,fun(◇ ->R)):- flatfn(Stack,◇,R).
vh(handler(_,X->T,_),(X,T)).
vh(_,_):- throw('Handler only!').
p(_,_,_,[],Es,(abort(),[],Es)):- !.
p(Eff,E,V,[F|S],Es,R):- cp(F,□ /F1),p1(Eff,E,V,[F|S],Es,F1,R).
p1(Eff,_,V,[F|S],Es,with(handler(Eff,_,(X,K)->E1),□),(E_,[F|S],[])):- !,
kfunc(Es,Es_),!,substs(E1,[X/V,K/Es_],E_),!.
p1(Eff,_,_,[F|S],Es,with(handler(_,_,(_,_)->Ee),□),(perform(Eff,Ee),S,[F|Es])):- !.
p1(Eff,E,_,[F|S],Es,_,(perform(Eff,E),S,[F|Es])):- !.
%==>((_,(T,S,_)),_):-length(S,L),writeln(T;L),fail.
{P,inst(),S,Es}==>{P1,eff(P1),S,Es}:- P1 is P+1,!.
{P,fun(A->B)$E,S,Es}==>{P,B_,S,Es}:- v(E),subst(B,A,E,B_),!.
{P,F$E,S,Es}==>{P,E,[T/(F$T)|S],Es}:- v(F),!.
{P,F$E,S,Es}==>{P,F,[T/(T$E)|S],Es}:- !.
{P,E1+E2,S,Es}==>{P,E,S,Es}:- v(E1),v(E2),E is E1+E2,!.
{P,E1+E2,S,Es}==>{P,E2,[T/(E1+T)|S],Es}:- v(E1),!.
{P,E1+E2,S,Es}==>{P,E1,[T/(T+E2)|S],Es}:- !.
{P,E1-E2,S,Es}==>{P,E,S,Es}:- v(E1),v(E2),E is E1-E2,!.
{P,E1-E2,S,Es}==>{P,E2,[T/(E1-T)|S],Es}:- v(E1),!.
{P,E1-E2,S,Es}==>{P,E1,[T/(T-E2)|S],Es}:- !.
{P,E1*E2,S,Es}==>{P,E,S,Es}:- v(E1),v(E2),E is E1*E2,!.
{P,E1*E2,S,Es}==>{P,E2,[T/(E1*T)|S],Es}:- v(E1),!.
{P,E1*E2,S,Es}==>{P,E1,[T/(T*E2)|S],Es}:- !.
{P,E1/E2,S,Es}==>{P,E,S,Es}:- v(E1),v(E2),E is E1 div E2,!.
{P,E1/E2,S,Es}==>{P,E2,[T/(E1/T)|S],Es}:- v(E1).
{P,E1/E2,S,Es}==>{P,E1,[T/(T/E2)|S],Es}:- !.
{P,(let(X=E);E2),S,Es}==>{P,B,S,Es}:- v(E),subst(E2,X,E,B),!.
{P,(let(X=E);E2),S,Es}==>{P,E,[T/(let(X=T);E2)|S],Es}:- !.
{P,with(H,E),S,Es}==>{P,Ev_,S,Es}:- v(E),vh(H,(X,Ev)),subst(Ev,X,E,Ev_),!.
{P,with(H,E),S,Es}==>{P,E,[T/with(H,T)|S],Es}:- !.
{P,perform(Eff,E),S,Es}==>{P,Eff_}:- v(Eff),v(E),p(Eff,E,E,S,Es,Eff_),!.
{P,perform(Eff,E),S,Es}==>{P,E,[T/perform(Eff,T)|S],Es}:- v(Eff),!.
{P,perform(Eff,E),S,Es}==>{P,Eff,[T/perform(T,E)|S],Es}:- !.
{P,V,[],Es}==>{P,V,[],Es}:- v(V).
{P,V,[F|S],Es}==>{P,V_,S,Es}:- v(V),!,cp(F,V/V_),!.
{_,E,_,_}==>_:- throw(error(eval(E))).
go({_,V,[],_},V):- v(V),!.
go(W,M2):- W==>W2, go(W2,M2).
run(T,V):- go({0,T,[],[]},V).
メインの処理は引数を引っ張り出しパース後に実行するだけです:
main.pl
:- use_module(parser,[parse/2,parseFile/2]). :- use_module(eval,[run/2]). :- current_prolog_flag(os_argv, [_,_,F|_]),parseFile(F,T),!,run(T,R),!,writeln(R). :- halt.
collect.txt
let collect = inst () in
let h = handler collect (val x -> x) ((x, k) -> let v=k x in v*100+x) in
with h handle
let a = (perform collect 1) in
let b = (perform collect 2) in
let c = (perform collect 3) in
let d = (perform collect 4) in
0
実行方法
$ swipl main.pl collect.txt 10203040
な感じで動かせます。
$ wc *.pl
73 148 3137 eval.pl
20 93 970 lexer.pl
4 9 166 main.pl
36 79 1542 parser.pl
133 329 5815 total
全部で133行でかなり簡潔に理解出来た気がします。
