120行で書いた CPS変換/Prolog出力 while言語コンパイラ

1. はじめに

ここでは基本ブロックへ変換し生存解析を用いて CPS 形式の Prolog を出力するコンパイラを紹介します。
なんと Prolog の知識だけでかなり本格的なコンパイラバックエンドの世界に入門することが出来ます。
コンパイラは Prolog のみで完結しており、ソースコードの長さはたったの120行です。
CPS 形式は SSA (静的単一代入) 形式と似ていますがより簡単なため SSA 形式の理解の助けにもなるでしょう。
今更 Prolog と思う方も多いでしょうが、型理論や操作的意味論を理解するには論理型言語である Prolog を使うことで一階述語論理の世界のネイティブユーザーとなることが出来ます。今回作成するプログラムの例はint型しかないので型検査も操作的意味論もありませんが、BNFスタイルの構文定義を使う例としても有用でしょう。

1.1. プログラム例:

プログラムの例を見てみましょう:

input.mc

add(a,b,c)=[
  return(a+b+c)
].
add2(a,b)=[
  return(a+b)
].
main()=[
  if(0,[
    a=0
  ],[
    a=50000+5000-1000
  ]),
  print(a+add(300,20,1)),
  print(sum(10))
].
sum(n)=[
  if(n,[return(sum(n-1)+n)],[]),
  return(n)
].

至って普通の言語が何やら若干 Prolog っぽいドットで終わる言語であることがおわかりかと思います。この言語はPrologのエジンバラ記法をXMLやJSONのように用いることでテキスト文字列の構文解析をせずに、木文法として構文定義されています。

実行結果は以下のようになります:

55
3

コンパイル後のPrologコードは以下のようになります:

output.pl

add(_1,_2,_3,_0):-enter0(_1,_2,_3,_0).
enter0(_1,_2,_3,_0):-!,_4 is _1+_2,_5 is _4+_3,_0=_5.
add2(_1,_2,_0):-enter3(_1,_2,_0).
enter3(_1,_2,_0):-!,_3 is _1+_2,_0=_3.
main(_0):-enter5(_0).
enter5(_0):-!,(0\=0->then6(_0);else7(_0)).
then6(_0):-!,_1=0,cont8(_1,_0).
else7(_0):-!,_2 is 50000+5000,_3 is _2-1000,cont8(_3,_0).
cont8(_3,_0):-!,add(300,20,1,_4),_5 is _3+_4,print(_5,_6),sum(10,_7),print(_7,_8),_0=0.
sum(_1,_0):-enter15(_1,_0).
enter15(_1,_0):-!,(_1\=0->then16(_1,_0);else17(_1,_0)).
then16(_1,_0):-!,_2 is _1-1,sum(_2,_3),_4 is _3+_1,_0=_4.
else17(_1,_0):-!,cont18(_1,_0).
cont18(_1,_0):-!,_0=_1.
print(I,0):-writeln(I).
:-main(_).
:-halt.

2. 構文とメイン処理 syntax.pl, main.pl

e ::= i | x | e + e | e - e | x = e | x(e1,...,en)
s ::= return(e) | if(e,s*,s*) | while(e,s*) | e
d ::= x(x1,...,xn)=s*
p ::= d*

o  ::= addq | subq
ae ::= i | x | bin(o,ae,ae) | mov(ae,x) | call(x,ae*)
as ::= ret(ae) | if(ae,as*,as*) | while(ae,as*) | ae
af ::= x:x* = as*
a  ::= af*

cr ::= x | $i
l  ::= x
cc ::= bin(o,cr,cr,cr) | mov(cr,cr) | call(cr,cr*,cr) | bne(cr,l,l) | br(l) | ret(cr)
cf ::= x:x* = (l:cc*)*
c  ::= cf*

プログラミング言語 p は main.pl 内の parse により内部コードの a に変換され genCode によって疑似アセンブラ c に変換された後、liveness.pl で生存解析を行い cps.pl で生存情報を元に Prolog を生成します。

main.pl

% p -> a -> c -> Prolog
main([S]):- readFile(S,P),syntax(p,P),parse(P,A),syntax(a,A),genCode(A,C),
            syntax(c,C),cps('output.pl',C).

BNF スタイルの構文定義は Prolog ではXML Schema や JSON Schema のように木のデータに対する木文法として定義できます。
構文検査は以下のような述語 syntax/2 を用いて行うことが出来ます:

syntax.pl

:- op(1200,xfx,::=),op(650,xfx,∈),op(250,yf,*).
G∈{G}. G∈(G|_). G∈(_|G1):-G∈G1. G∈G.
syntax(S/[S2],AEs) :- compound_name_arguments(AEs,A,Es),syntax(S,A),syntax(S2,Es).
syntax(G,E):-G=..[O|Gs],E=..[O|Es],maplist(syntax,Gs,Es),!.
syntax(G,E):-(G::=Gs),!,G1∈Gs,syntax(G1,E),!.
syntax(i,I):-integer(I),!.
syntax(x,I):- atom(I),!.
syntax(E*,Ls) :- maplist(syntax(E),Ls).

3. 操作的意味

大ステップの操作的意味論は Prolog で以下のようになります:

inter.pl

e(I,I,Γ,Γ):- integer(I).
e(I,X,Γ,Γ):- member(X:I,Γ),!.
e(I,E1+E2,Γ,Γ_):- e(I1,E1,Γ,Γ1),e(I2,E2,Γ1,Γ_),I is I1+I2.
e(I,E1-E2,Γ,Γ_):- e(I1,E1,Γ,Γ1),e(I2,E2,Γ1,Γ_),I is I1-I2.
e(I,X=E,Γ,[X:I|Γ_]):- e(I,E,Γ,Γ_).
e(0,C,Γ,Γ_):- compound_name_arguments(C,print,Ps),es([I|_],Ps,Γ,Γ_),writeln(I).
e(I,C,Γ,Γ_):- compound_name_arguments(C,N,Ps), es(Is,Ps,Γ,Γ_),callf(Γ,N,Is,I).
es([],[],Γ,Γ) :- !.
es([I|Is],[P|Ps],Γ,Γ_):-e(I,P,Γ,Γ1),es(Is,Ps,Γ1,Γ_).
s(R,if(E,Ss1,Ss2),Γ,Γ_) :- !,(e(R1,E,Γ,Γ1),(R1\=0->ss(R,Ss1,Γ1,Γ_);ss(R,Ss2,Γ1,Γ_))).
s(0,while(E,Ss),Γ,Γ_) :- !,e(R,E,Γ,Γ1),(R\=0->ss(_,Ss,Γ1,Γ2),s(_,while(E,Ss),Γ2,Γ_);Γ_=Γ1).
s(0,return(E),Γ,_):- !,e(R,E,Γ,_),throw(R).
s(R,E,Γ,Γ_) :- e(R,E,Γ,Γ_).

ss(0,[],Γ,Γ).
ss(R,[S],Γ,Γ_) :- !,s(R,S,Γ,Γ_).
ss(R,[S|Ss],Γ,Γ_) :- s(_,S,Γ,Γ1),ss(R,Ss,Γ1,Γ_).

genΓ(P,I,P:I):- !.
callf(Γ,N,Is,R) :- member(Xs=Ss,Γ),compound_name_arguments(Xs,N,Ps),
maplist(genΓ,Ps,Is,Γ1),append(Γ1,Γ,Γ2),
catch(ss(R,Ss,Γ2,_),R1,(R1=R)).

interp(Γ) :- callf(Γ,main,[],_).
readFile(File,Fs) :- read_file_to_terms(File,Fs,[]).
main([S]):- readFile(S,P),interp(P).

:- current_prolog_flag(argv,Argv),
   catch(main(Argv),E,(format('\033[0;41m~w\033[0;39m\n',[E]),halt(-1))),halt.

このインタプリタはコンパイラの120行の中には含まれていません。returnはTAPLのエラーを扱うように展開すると複雑になるのでSWI-Prologの例外を使いスッキリさせました。
図に書着替えればよりわかりやすくなりますが省略します。

4. 実装の詳細

4.1. p から a への変換 parser.pl

parser.pl

expr(I,I) :- integer(I),!.
expr(A,A) :- atom(A),!.
expr(E1+E2,bin(add,E1_,E2_)) :- expr(E1,E1_),expr(E2,E2_).
expr(E1-E2,bin(sub,E1_,E2_)) :- expr(E1,E1_),expr(E2,E2_).
expr(A=E,mov(E_,A)) :- atom(A),expr(E,E_).
expr(AEs,call(A,Es_)) :- compound_name_arguments(AEs,A,Es),maplist(expr,Es,Es_).
expr(E,_) :- throw(main(expr(E))).
stmt(return(E),ret(E_)) :- expr(E,E_).
stmt(if(E,S1,S2),if(E_,S1_,S2_)) :- expr(E,E_),maplist(stmt,S1,S1_),maplist(stmt,S2,S2_).
stmt(while(E,S),while(E_,S_)) :- expr(E,E_),maplist(stmt,S,S_).
stmt(S,S_) :- expr(S,S_).
func(NP=B,N:P=B_) :- compound_name_arguments(NP,N,P),maplist(stmt,B,B_).
parse(Fs,Fs_) :- maplist(func,Fs,Fs_),!.

木構造を再帰的にトラバースして変換します。XMLやJSONからASTに書き換えるようなイメージです。
パーサなのかという気もしますが、具象構文を解析して抽象構文に書き換える仕事をするのは誰なのかを考えてパーサと呼ぶことにしました。

4.2. 基本ブロックへの変換 genCode.pl

genid/2 でユニークな識別子を生成し、label/1 で基本ブロックのラベル名を指定し、 add/1 で基本ブロックに命令を追加し、 get/1 で基本ブロックリストを取得します。

resetid   :- retractall(id(_)),assert(id(0)).
genid(S,A):- retract(id(C)),C1 is C+1,assert(id(C1)),format(atom(A),'~w~w',[S,C]).
label(L):- asserta(l(L)).
add(C):- l(L),(c(L,ret(_));assert(c(L,C))).
get(BBs):- findall(L:BB,(retract(l(L)),bagof(C,retract(c(L,C)),BB)),R),reverse(R,BBs).

これらの述語を用いて a の構文木をトラバースし基本ブロック c に変換します。
式の変換 expr/2 の戻り値はレジスタとなる識別子を返却することで、式を平たくします。

expr(mov(bin(Op,A,B),R),R):- expr(A,A1),expr(B,B1),add(bin(Op,A1,B1,R)).
expr(mov(A,R),R):-    expr(A,R1),add(mov(R1,R)).
expr(bin(Op,A,B),R):- genid(r,R),expr(A,A1),expr(B,B1),add(bin(Op,A1,B1,R)).
expr(call(A,B),R):-   genid(r,R),maplist(expr,B,Rs),add(call(A,Rs,R)).
expr(R,R):-           atom(R),!.
expr(I,$I):-          integer(I),!.
expr(E,_):-           throw(genCode(expr(E))).

文のコンパイルは if文やwhile文では分岐が生じるためgenid/2でラベル名を生成し、bne,brなどの命令で分岐します。
分岐命令を生成した後はlabel/1でラベル名を設定して新たな基本ブロックを作りコンパイルを続けます。

stmt(if(A,B,D)):-     genid(then,T),genid(else,E),
                      expr(A,R1),add(bne(R1,T,E)),genid(cont,C),
                      label(T),stmt(B),add(br(C)),
                      label(E),stmt(D),add(br(C)),label(C).
stmt(while(A,B)):-    genid(while,W),genid(then,T),genid(cont,C),add(br(W)),
                      label(W),expr(A,R1),add(bne(R1,T,C)),
                      label(T),stmt(B),add(br(W)),label(C).
stmt(ret(E)):-        expr(E,R),add(ret(R)).
stmt(B):-             is_list(B),!,forall(member(S,B),stmt(S)).
stmt(E):-             expr(E,_).

関数を処理する述語では初期の基本ブロックを作りコンパイルした後、get/1 により基本ブロック列を取り出して返します。

func(N:A=B,N:A=BBs):- genid(enter,L),label(L),stmt(B),add(ret($0)),get(BBs).

プログラム全体のコンパイルは genCode/2 で行い、resetidを呼び出して初期化したあと、 func/2 をループして呼び出します:

genCode(P,R):-        resetid,dynamic(c/2),maplist(func,P,R),!.

4.3. 基本ブロックの生存解析 libveness.pl

生存解析は liveness/2で行い、funcをループで呼び出して各関数の解析を行います。

liveness(Funcs,Livess):- maplist(func,Funcs,Livess).

関数の解析は、io_bbs/2を用いて基本ブロック内のレジスタの読み込みと出力のみを取り出し、次にlive_bbs/2 を用いて基本ブロックごとの入出力情報を生成します。

func(_:_=BBs,Lives):- io_bbs(BBs,IOs),live_bbs(IOs,Lives).

まず、入出力情報の取得は以下のように行います:

io_imm(Is,Is_):- findall(R,(member(R,Is),atom(R),($_\=R,\_\=R)),Is_).
io_cc(mov(I,R),Is>[R]):- io_imm([I],Is),!.
io_cc(bin(_,I1,I2,R),Is>[R]):- io_imm([I1,I2],Is),!.
io_cc(ret(I),Is>[]):- io_imm([I],Is),!.
io_cc(br(_),[]>[]):-!.
io_cc(bne(R,_,_),Is>[]):- io_imm([R],Is),!.
io_cc(call(_,Is,R),Is_>[R]):- io_imm(Is,Is_),!.
io_br([br(L)|_],[L]):-!.
io_br([bne(_,L1,L2)|_],[L1,L2]):-!.
io_br(_,[]):-!.
io_bb(L:BB,L:([],[],IO,Br)):- reverse(BB,RB),maplist(io_cc,RB,IO),io_br(RB,Br).
io_bbs(BBs,IOs):- maplist(io_bb,BBs,IOs).

io_bb/2 で各基本ブロックの収集を行いますが、reverseで逆順にした後、io_cc/2をループで呼び出し入力を収集し、io_brで飛び先のラベルを収集します。
io_cc/2 は各命令の入力レジスタと出力レジスタをio_imm/2を呼び出して、レジスタのみをフィルタして返します。

基本ブロック同士の生存解析は、live_bbs/2 で行います:

:- module(liveness,[liveness/2]).
live_br(G,B,I>O,I2>O2):- member(B:(I1,_,_,_),G),union(I1,O,O2),union(I1,I,I2).
live_cc(I>O,I1,I3):- subtract(I1,O,I2),union(I,I2,I3).
live_bb(G,L:(_,_,RBB,Br),L:(I_,O,RBB,Br)):- foldl(live_br(G),Br,[]>[],I>O),
                                            foldl(live_cc,RBB,I,I_).
live_bbs(G,R):- maplist(live_bb(G),G,G2),(G=G2->R=G;live_bbs(G2,R)).

live_bbs/2 では live_bb/3 をループで呼び出して生存情報 G2 を計算し、元の生存情報 G と変わりがなくなるまで計算し続けます。
libe_bb/3 はまず、live_br/4 を呼び出してラベル名から後続の基本ブロックの入力情報をとりだして、出力および入力に加えて返します。
出力は決まったので、前方に走査してlive_cc/4を用いて入力情報から出力を差し引き、次に入力を入力情報に加えます。

4.4. 生存解析結果を使った CPS 変換 cps.pl

CPS 変換は cps/2 で行います。基本的には cps/2 でまず生存情報を計算した後に、ループして func/3 を生存情報を付加してよびだし、

cps(Fs,R):- liveness(Fs,Lives),!,maplist(func,Fs,Lives,Fs_),append(Fs_,R1),
            append(R1,[printInt(I,0):-writeln(I),:-main(_),:-halt],R).

印字述語や、メイン述語の呼び出し、終了コードを加えて返却します。

a/2 でレジスタ名をテーブルを検索して返却し、なければa1/2 を用いて新たなレジスタ名を生成して返します。
as/2 は複数のレジスタ名を処理します。
ap/2 は述語名で述語の呼び出し用の述語を生成して返します。

:- module(cps,[cps/2]).
:- use_module([liveness,genCode]).
a(A,N):- ($N=A),!;nb_getval(m,L),member(A:N,L),!;a1(A,N).
a1(A,N):- nb_getval(m,L),genid('_',N),nb_linkval(m,[A:N|L]).
as(A,A1):- maplist(a,A,A1).
ap(A,C):- live(A,L),as(L,V1),a(return,R),append(V1,[R],V2),C=..[A|V2].

各関数ごとの処理は、生存情報をラベル名から引けるようにしておき、レジスタの変換テーブル m を用いて破壊不可能なレジスタ名をつけて保存し直します。

code(mov(A,B),R)       :- a(A,A1),a1(B,B1),R=(B1=A1).
code(bin(addq,A,B,C),R):- a(A,A1),a(B,B1),a1(C,C1),R=(C1 is A1+B1).
code(bin(subq,A,B,C),R):- a(A,A1),a(B,B1),a1(C,C1),R=(C1 is A1-B1).
code(call(A,B,C),R)    :- as(B,B1),a1(C,C1),append(B1,[C1],P),R=..[A|P].
code(ret(A),R)         :- a(A,A1),a(return,RT),R=(RT=A1).
code(bne(A,B,C),R)     :- a(A,A1),ap(B,B_),ap(C,C_),R=(A1\=0->B_;C_).
code(br(A),R)          :- ap(A,R).
get(Cs,C) :- reverse(Cs,Cs1),foldl(get1,Cs1,!,C).
get1(C,C1,C_):- C1=!->C_=C;C_=(C,C1).
bb(L:BB,N:-C):- ap(L,N),maplist(code,BB,Cs),get(Cs,C).
func(N:P=BBs,Lives,[N_:-M_,M:-Cs|BBs1]):-
  resetid,nb_setval(m,[]),a1(return,R),as(P,P1),append(P1,[R],P_),N_=..[N|P_],
  retractall(live(_,_)),forall(member(L:(I,_),Lives),assert(live(L,I))),
  maplist(bb,BBs,[M:-Cs|BBs1]),M=..[NN|_],ap(NN,M_).

func/3 で初期化したあと、bb/2 をループで呼び出し、最初の述語Mを呼び出すコードを加えて返します。
bb/2 は基本ブロックのヘッド部分をap/2で作り、code/2をループで呼び出してコードを生成したあとget/2で変換してPrologのプログラムを返します。
code/2 は各命令を受け取ってレジスタ名を変数名に変えた後、Prologの述語呼び出しコードを生成して返却します。

5. まとめ

Prolog を出力する Prolog 製のコンパイラを紹介しました。
main.pl で全体を制御しparser.plで入力コードを内部コードに変換した後、genCode.plで基本ブロックに変換し、liveness.plで生存解析、その生存解析結果を用いてcps.plでPrologに変換する一連の流れを説明しました。

ギュウギュウ詰めのコードとは言え、120行程度でのCPS変換によるPrologコードへのコンパイラは生存解析やSSA形式のコンパイラ制作への足がかりとして参考となるでしょう。

6. 今後の研究

LLVM の論文 Formal verification of SSA-based optimizations for LLVM のVminus は同様に小さな言語を実装しており、これに加えて mem2reg を考えた Vellvm の拡張があります。Vminus は int 型を持ちますが、今回のコンパイラは型を持たないためよりシンプルです。Vellvm への同様の拡張を行うことで、 mem2reg のアルゴリズムが動く簡潔な例として示すことができるでしょう。Vminus が完全性の証明がされているようにここで実装した言語についても様々な性質を証明できればより信頼性の高い処理系と言えるようになるはずです。

参考文献

• 中田先生の最適化の本
• COINS の解説記事
• タイガーブック
• LLVM

Formal verification of SSA-based optimizations for LLVM
https://dl.acm.org/doi/abs/10.1145/2491956.2462164

• 9cc コンパイラのソース

A.1. 付録

main.pl

:- use_module([parser,syntax,genCode,cps]).
main([S]):- readFile(S,P),syntax(p,P),parse(P,A),syntax(a,A),genCode(A,C),
            syntax(c,C),cps('output.pl',C).
:- current_prolog_flag(argv,Argv),
   catch(main(Argv),E,(format('\033[0;41m~w\033[0;39m\n',[E]),halt(-1))),halt.

syntax.pl

:- module(syntax,[syntax/2]).
:- op(1200,xfx,::=),op(650,xfx,∈),op(250,yf,*).
G∈{G}. G∈(G|_). G∈(_|G1):-G∈G1. G∈G.
syntax(S/[S2],AEs) :- compound_name_arguments(AEs,A,Es),syntax(S,A),syntax(S2,Es).
syntax(G,E):-G=..[O|Gs],E=..[O|Es],maplist(syntax,Gs,Es),!.
syntax(G,E):-(G::=Gs),!,G1∈Gs,syntax(G1,E),!.
syntax(i,I):-integer(I),!.
syntax(x,I):- atom(I),!.
syntax(E*,Ls) :- maplist(syntax(E),Ls).

e ::= i | x | e + e | e - e | x = e | x/[e*].
s ::= return(e) | if(e,s*,s*) | while(e,s*) | e.
d ::= x/[x*]=s* .
p ::= d* .

o  ::= add | sub.
ae ::= i | x | bin(o,ae,ae) | mov(ae,x) | call(x,ae*).
as ::= ret(ae) | if(ae,as*,as*) | while(ae,as*) | ae.
af ::= x:x* = as* .
a  ::= af* .

cr ::= x | $i.
cc ::= bin(o,cr,cr,cr) | mov(cr,cr) | call(cr,cr*,cr) | bne(cr,x,x) | br(x) | ret(cr).
cf ::= x:x* = (x:cc*)* .
c  ::= cf* .

parser.pl

:- module(parser,[parse/2,readFile/2]).
expr(I,I) :- integer(I),!.
expr(A,A) :- atom(A),!.
expr(E1+E2,bin(add,E1_,E2_)) :- expr(E1,E1_),expr(E2,E2_).
expr(E1-E2,bin(sub,E1_,E2_)) :- expr(E1,E1_),expr(E2,E2_).
expr(A=E,mov(E_,A)) :- atom(A),expr(E,E_).
expr(AEs,call(A,Es_)) :- compound_name_arguments(AEs,A,Es),maplist(expr,Es,Es_).
expr(E,_) :- throw(main(expr(E))).
stmt(return(E),ret(E_)) :- expr(E,E_).
stmt(if(E,S1,S2),if(E_,S1_,S2_)) :- expr(E,E_),maplist(stmt,S1,S1_),maplist(stmt,S2,S2_).
stmt(while(E,S),while(E_,S_)) :- expr(E,E_),maplist(stmt,S,S_).
stmt(S,S_) :- expr(S,S_).
func(NP=B,N:P=B_) :- compound_name_arguments(NP,N,P),maplist(stmt,B,B_).
parse(Fs,Fs_) :- maplist(func,Fs,Fs_),!.
readFile(File,Fs) :- read_file_to_terms(File,Fs,[]).

genCode.pl

:- module(genCode,[genCode/2,resetid/0,genid/2]).
resetid   :- retractall(id(_)),assert(id(0)).
genid(S,A):- retract(id(C)),C1 is C+1,assert(id(C1)),format(atom(A),'~w~w',[S,C]).
label(L):- asserta(l(L)).
add(C):- l(L),(c(L,ret(_));assert(c(L,C))).
get(BBs):- findall(L:BB,(retract(l(L)),bagof(C,retract(c(L,C)),BB)),R),reverse(R,BBs).
expr(mov(bin(Op,A,B),R),R):- expr(A,A1),expr(B,B1),add(bin(Op,A1,B1,R)).
expr(mov(A,R),R):-    expr(A,R1),add(mov(R1,R)).
expr(bin(Op,A,B),R):- genid(r,R),expr(A,A1),expr(B,B1),add(bin(Op,A1,B1,R)).
expr(call(A,B),R):-   genid(r,R),maplist(expr,B,Rs),add(call(A,Rs,R)).
expr(R,R):-           atom(R),!.
expr(I,$I):-          integer(I),!.
expr(E,_):-           throw(genCode(expr(E))).
stmt(if(A,B,D)):-     genid(then,T),genid(else,E),
                      expr(A,R1),add(bne(R1,T,E)),genid(cont,C),
                      label(T),stmt(B),add(br(C)),
                      label(E),stmt(D),add(br(C)),label(C).
stmt(while(A,B)):-    genid(while,W),genid(then,T),genid(cont,C),add(br(W)),
                      label(W),expr(A,R1),add(bne(R1,T,C)),
                      label(T),stmt(B),add(br(W)),label(C).
stmt(ret(E)):-        expr(E,R),add(ret(R)).
stmt(B):-             is_list(B),!,forall(member(S,B),stmt(S)).
stmt(E):-             expr(E,_).
func(N:A=B,N:A=BBs):- genid(enter,L),label(L),stmt(B),add(ret($0)),get(BBs).
genCode(P,R):-        resetid,dynamic(c/2),maplist(func,P,R),!.

liveness.pl

:- module(liveness,[live/2]).
io_imm(Is,Is_):- findall(R,(member(R,Is),atom(R),$_\=R),Is_).
io_cc(mov(I,R),Is>[R]):- io_imm([I],Is),!.
io_cc(bin(_,I1,I2,R),Is>[R]):- io_imm([I1,I2],Is),!.
io_cc(ret(I),Is>[]):- io_imm([I],Is),!.
io_cc(br(_),[]>[]):-!.
io_cc(bne(R,_,_),Is>[]):- io_imm([R],Is),!.
io_cc(call(_,Is,R),Is_>[R]):- io_imm(Is,Is_),!.
io_br([br(L)|_],[L]):-!.
io_br([bne(_,L1,L2)|_],[L1,L2]):-!.
io_br(_,[]):-!.
io_bb(L:BB,L:([],[],IO,Br)):- reverse(BB,RB),maplist(io_cc,RB,IO),io_br(RB,Br).
io_bbs(BBs,IOs):- maplist(io_bb,BBs,IOs).
live_br(G,B,I>O,I2>O2):- member(B:(I1,_,_,_),G),union(I1,O,O2),union(I1,I,I2).
live_cc(I>O,I1,I3):- subtract(I1,O,I2),union(I,I2,I3).
live_bb(G,L:(_,_,RBB,Br),L:(I_,O,RBB,Br)):- foldl(live_br(G),Br,[]>[],I>O),
                                            foldl(live_cc,RBB,I,I_).
live_bbs(G,R):- maplist(live_bb(G),G,G2),(G=G2->R=G;live_bbs(G2,R)).
live(BBs,R):- io_bbs(BBs,IOs),live_bbs(IOs,G),findall(L:I,member(L:(I,_),G),R).

cps.pl

:- module(cps,[cps/2]).
:- use_module([liveness,genCode]).
a(A,N):- ($N=A),!;e(A:N),!;a1(A,N).
a1(A,N):- genid('_',N),asserta(e(A:N)).
as(A,A1):- maplist(a,A,A1).
ap(G,A,C):- member(A:L,G),as(L,V1),a(return,R),append(V1,[R],V2),C=..[A|V2].
cc(_,mov(A,B))      :- a(A,A1),a1(B,B1),f(',~w',[B1=A1]).
cc(_,bin(add,A,B,C)):- a(A,A1),a(B,B1),a1(C,C1),f(',~w',[C1 is A1+B1]).
cc(_,bin(sub,A,B,C)):- a(A,A1),a(B,B1),a1(C,C1),f(',~w',[C1 is A1-B1]).
cc(_,call(A,B,C))   :- as(B,X),a1(C,Y),append(X,[Y],P),R=..[A|P],f(',~w',[R]).
cc(_,ret(A))        :- a(A,A1),a(return,RT),f(',~w',[RT=A1]).
cc(G,bne(A,B,C))    :- a(A,X),ap(G,B,Y),ap(G,C,Z),f(',(~w)',[X\=0->Y;Z]).
cc(G,br(A))         :- ap(G,A,R),f(',~w',[R]).
f(S,P):- format(S,P).
bb(G,L:BB):- ap(G,L,N),write(N:-!),maplist(cc(G),BB),f('.\n',[]).
func(N:P=BBs):-
  resetid,retractall(e(_)),a1(return,R),as(P,P1),append(P1,[R],P_),N_=..[N|P_],
  live(BBs,G),[L:_|_]=BBs,ap(G,L,M),f('~w.\n',[N_:-M]),maplist(bb(G),BBs).
cps(File,C):-
  setup_call_cleanup((telling(O),open(File,write,F),tell(F)),
    (maplist(func,C),f('print(I,0):-writeln(I).\n:-main(_).\n:-halt.\n',[])),
    (close(F),tell(O))).