jitあれこれ https://keens.github.io/blog/2018/12/01/jitarekore/ を見て、 tracing-jit をPrologで作る記事が書いてあったのでコピペして動かしてみました。
Part1 部分評価とトレーシングの比較
ソースコード:
% trace-jit.pl
lookup(X, [], _) :- throw(key_not_found(X)).
lookup(Key, [Key/Value | _], Value) :- !.
lookup(Key, [_ | Rest], Value) :- lookup(Key, Rest, Value).
write_env([], X, V, [X/V]).
write_env([Key/_ | Rest], Key, Value, [Key/Value | Rest]) :- !.
write_env([Pair | Rest], Key, Value, [Pair | NewRest]) :- write_env(Rest, Key, Value, NewRest).
remove_env([], _, []).
remove_env([Key/_ | Rest], Key, Rest) :- !.
remove_env([Pair | Rest], Key, [Pair | NewRest]) :- remove_env(Rest, Key, NewRest).
resolve(const(X), _, X).
resolve(var(X), Env, Y) :- lookup(X, Env, Y).
do_op(same, X, X).
do_op(mul, X, Y, Z) :- Z is X * Y.
do_op(add, X, Y, Z) :- Z is X + Y.
do_op(sub, X, Y, Z) :- Z is X - Y.
do_op(eq, X, Y, Z) :- X == Y -> Z = 1; Z = 0.
do_op(ge, X, Y, Z) :- X >= Y -> Z = 1; Z = 0.
do_op(readlist, L, I, X) :- nth0(I, L, X).
do_op(Op, _, _, _) :- throw(missing_op(Op)).
interp(op1(ResultVar, Op, Arg, Rest), Env) :-
resolve(Arg, Env, RArg),
do_op(Op, RArg, Res),
write_env(Env, ResultVar, Res, NEnv),
interp(Rest, NEnv).
interp(op2(ResultVar, Op, Arg1, Arg2, Rest), Env) :-
resolve(Arg1, Env, RArg1),
resolve(Arg2, Env, RArg2),
do_op(Op, RArg1, RArg2, Res),
write_env(Env, ResultVar, Res, NEnv),
interp(Rest, NEnv).
interp(jump(L), Env) :-
block(L, Block),
interp(Block, Env).
interp(print_and_stop(Arg), Env) :-
resolve(Arg, Env, Val),
print(Val), nl.
interp(if(V, L1, L2), Env) :-
lookup(V, Env, Val),
(Val == 0 -> block(L2, Block)
; block(L1, Block)),
interp(Block, Env).
block(power, op1(res, same, const(1),
if(y, power_rec, power_done))).
block(power_rec, op2(res, mul, var(res), var(x),
op2(y, sub, var(y), const(1),
if(y, power_rec, power_done)))).
block(power_done, print_and_stop(var(res))).
:- block(power, Block), interp(Block, [x/10, y/10]).
plookup(Key, [], var(Key)).
plookup(Key, [Key/Value | _], const(Value)) :- !.
plookup(Key, [_ | Rest], Value) :- plookup(Key, Rest, Value).
presolve(const(X), _, const(X)).
presolve(var(V), PEnv, X) :- plookup(V, PEnv, X).
pe(op1(ResultVar, Op, Arg, Rest), PEnv, NewOp) :-
presolve(Arg, PEnv, RArg),
(RArg = const(C) ->
do_op(Op, C, Res),
write_env(PEnv, ResultVar, Res, NEnv),
RestResidual = NewOp
; remove_env(PEnv, ResultVar, NEnv),
NewOp = op1(ResultVar, Op, RArg, RestResidual)
),
pe(Rest, NEnv, RestResidual).
pe(op2(ResultVar, Op, Arg1, Arg2, Rest), PEnv, NewOp) :-
presolve(Arg1, PEnv, RArg1),
presolve(Arg2, PEnv, RArg2),
(RArg1 = const(C1), RArg2 = const(C2) ->
do_op(Op, C1, C2, Res),
write_env(PEnv, ResultVar, Res, NEnv),
RestResidual = NewOp
; remove_env(PEnv, ResultVar, NEnv),
NewOp = op2(ResultVar, Op, RArg1, RArg2, RestResidual)
),
pe(Rest, NEnv, RestResidual).
pe(jump(L), PEnv, jump(LR)) :-
do_pe(L, PEnv, LR).
pe(print_and_stop(Arg), Env, print_and_stop(RArg)) :-
presolve(Arg, Env, RArg).
pe(if(V, L1, L2), PEnv, NewOp) :-
plookup(V, PEnv, Val),
(Val = const(C) ->
(C = 0 -> L = L2
; L = L1),
do_pe(L, PEnv, LR),
NewOp = jump(LR)
; do_pe(L1, PEnv, L1R),
do_pe(L2, PEnv, L2R),
NewOp = if(V, L1R, L2R)
).
do_pe(L, PEnv, LR) :-
(code_cache(L, PEnv, LR) ->
true
; gensym(L, LR),
assert(code_cache(L, PEnv, LR)),
block(L, Code),
pe(Code, PEnv, Residual),
assert(block(LR, Residual))
).
:- dynamic(code_cache/3),
findall(block(A,B),block(A,B),Old),
do_pe(power, [y/5], LR),
writeln(LR),
findall(code_cache(A,B,C),code_cache(A,B,C),L),
maplist(writeln,L),
maplist(retract,Old),maplist(retract,L),
findall(block(A,B),block(A,B),L2),
maplist(writeln,L2),
block(LR, Block), interp(Block, [x/10]).
:- halt.
実行方法と結果:
$ swipl trace-jit.pl
10000000000
power1
code_cache(power,[y/5],power1)
code_cache(power_rec,[y/5,res/1],power_rec1)
code_cache(power_rec,[y/4],power_rec2)
code_cache(power_rec,[y/3],power_rec3)
code_cache(power_rec,[y/2],power_rec4)
code_cache(power_rec,[y/1],power_rec5)
code_cache(power_done,[y/0],power_done1)
block(power_done1,print_and_stop(var(res)))
block(power_rec5,op2(res,mul,var(res),var(x),jump(power_done1)))
block(power_rec4,op2(res,mul,var(res),var(x),jump(power_rec5)))
block(power_rec3,op2(res,mul,var(res),var(x),jump(power_rec4)))
block(power_rec2,op2(res,mul,var(res),var(x),jump(power_rec3)))
block(power_rec1,op2(res,mul,const(1),var(x),jump(power_rec2)))
block(power1,jump(power_rec1))
100000
dynamicを付けないとうまくいかないあたりの話が Prolog に慣れてないとわからない話かもしれません。
yについて部分評価すると速いみたいな話のようです。
結果が異なるのはy=10かy=5の違いです。
Part2 FlowGraph 言語のための単純なトレーサ
% trace-jit2.pl
lookup(X, [], _) :- throw(key_not_found(X)).
lookup(Key, [Key/Value | _], Value) :- !.
lookup(Key, [_ | Rest], Value) :- lookup(Key, Rest, Value).
write_env([], X, V, [X/V]).
write_env([Key/_ | Rest], Key, Value, [Key/Value | Rest]) :- !.
write_env([Pair | Rest], Key, Value, [Pair | NewRest]) :- write_env(Rest, Key, Value, NewRest).
remove_env([], _, []).
remove_env([Key/_ | Rest], Key, Rest) :- !.
remove_env([Pair | Rest], Key, [Pair | NewRest]) :- remove_env(Rest, Key, NewRest).
resolve(const(X), _, X).
resolve(var(X), Env, Y) :- lookup(X, Env, Y).
do_op(same, X, X).
do_op(mul, X, Y, Z) :- Z is X * Y.
do_op(add, X, Y, Z) :- Z is X + Y.
do_op(sub, X, Y, Z) :- Z is X - Y.
do_op(eq, X, Y, Z) :- X == Y -> Z = 1; Z = 0.
do_op(ge, X, Y, Z) :- X >= Y -> Z = 1; Z = 0.
do_op(readlist, L, I, X) :- nth0(I, L, X).
do_op(Op, _, _, _) :- throw(missing_op(Op)).
interp(op1(ResultVar, Op, Arg, Rest), Env) :-
resolve(Arg, Env, RArg),
do_op(Op, RArg, Res),
write_env(Env, ResultVar, Res, NEnv),
interp(Rest, NEnv).
interp(op2(ResultVar, Op, Arg1, Arg2, Rest), Env) :-
resolve(Arg1, Env, RArg1),
resolve(Arg2, Env, RArg2),
do_op(Op, RArg1, RArg2, Res),
write_env(Env, ResultVar, Res, NEnv),
interp(Rest, NEnv).
interp(jump(L), Env) :-
block(L, Block),
interp(Block, Env).
interp(print_and_stop(Arg), Env) :-
resolve(Arg, Env, Val),
print(Val), nl.
interp(if(V, L1, L2), Env) :-
lookup(V, Env, Val),
(Val == 0 -> block(L2, Block)
; block(L1, Block)),
interp(Block, Env).
interp(promote(_, L), Env) :-
interp(jump(L), Env).
plookup(Key, [], var(Key)).
plookup(Key, [Key/Value | _], const(Value)) :- !.
plookup(Key, [_ | Rest], Value) :- plookup(Key, Rest, Value).
presolve(const(X), _, const(X)).
presolve(var(V), PEnv, X) :- plookup(V, PEnv, X).
pe(op1(ResultVar, Op, Arg, Rest), PEnv, NewOp) :-
presolve(Arg, PEnv, RArg),
(RArg = const(C) ->
do_op(Op, C, Res),
write_env(PEnv, ResultVar, Res, NEnv),
RestResidual = NewOp
; remove_env(PEnv, ResultVar, NEnv),
NewOp = op1(ResultVar, Op, RArg, RestResidual)
),
pe(Rest, NEnv, RestResidual).
pe(op2(ResultVar, Op, Arg1, Arg2, Rest), PEnv, NewOp) :-
presolve(Arg1, PEnv, RArg1),
presolve(Arg2, PEnv, RArg2),
(RArg1 = const(C1), RArg2 = const(C2) ->
do_op(Op, C1, C2, Res),
write_env(PEnv, ResultVar, Res, NEnv),
RestResidual = NewOp
; remove_env(PEnv, ResultVar, NEnv),
NewOp = op2(ResultVar, Op, RArg1, RArg2, RestResidual)
),
pe(Rest, NEnv, RestResidual).
pe(jump(L), PEnv, jump(LR)) :-
do_pe(L, PEnv, LR).
pe(print_and_stop(Arg), Env, print_and_stop(RArg)) :-
presolve(Arg, Env, RArg).
pe(if(V, L1, L2), PEnv, NewOp) :-
plookup(V, PEnv, Val),
(Val = const(C) ->
(C = 0 -> L = L2
; L = L1),
do_pe(L, PEnv, LR),
NewOp = jump(LR)
; do_pe(L1, PEnv, L1R),
do_pe(L2, PEnv, L2R),
NewOp = if(V, L1R, L2R)
).
do_pe(L, PEnv, LR) :-
(code_cache(L, PEnv, LR) ->
true
; gensym(L, LR),
assert(code_cache(L, PEnv, LR)),
block(L, Code),
pe(Code, PEnv, Residual),
assert(block(LR, Residual))
).
% part 2
trace(op1(ResultVar, Op, Arg, Rest), Env, op1(ResultVar, Op, Arg, T), TraceAnchor) :-
resolve(Arg, Env, RArg),
do_op(Op, RArg, Res),
write_env(Env, ResultVar, Res, NEnv),
trace(Rest, NEnv, T, TraceAnchor).
trace(op2(ResultVar, Op, Arg1, Arg2, Rest), Env, op2(ResultVar, Op, Arg1, Arg2, T), TraceAnchor) :-
resolve(Arg1, Env, RArg1),
resolve(Arg2, Env, RArg2),
do_op(Op, RArg1, RArg2, Res),
write_env(Env, ResultVar, Res, NEnv),
trace(Rest, NEnv, T, TraceAnchor).
trace(print_and_stop(V), Env, print_and_stop(V), _) :-
resolve(V, Env, Val),
print(Val), nl.
trace(jump(L), Env, T, TraceAnchor) :-
(TraceAnchor = traceanchor(L, FullTrace) ->
T = loop,
write(trace), nl, write(FullTrace), nl,
do_optimize(FullTrace, OptTrace),
write(opttrace), nl, write(OptTrace), nl,
runtrace(OptTrace, Env, OptTrace)
;
block(L, Block),
trace(Block, Env, T, TraceAnchor)
).
trace(if(V, L1, L2), Env, T, TraceAnchor) :-
lookup(V, Env, Val),
(Val == 0 ->
L = L2, T = guard_false(V, [], L1, NT)
;
L = L1, T = guard_true(V, [], L2, NT)
),
trace(jump(L), Env, NT, TraceAnchor).
trace(promote(V, L), Env, guard_value(V, Val, [], L, T), TraceAnchor) :-
lookup(V, Env, Val),
trace(jump(L), Env, T, TraceAnchor).
do_optimize(FullTrace, FullTrace).
do_trace(L, Env) :-
block(L, StartBlock),
trace(StartBlock, Env, ProducedTrace, traceanchor(L, ProducedTrace)).
runtrace(op1(ResultVar, Op, Arg, Rest), Env, TraceFromStart) :-
resolve(Arg, Env, RArg),
do_op(Op, RArg, Res),
write_env(Env, ResultVar, Res, NEnv),
runtrace(Rest, NEnv, TraceFromStart).
runtrace(op2(ResultVar, Op, Arg1, Arg2, Rest), Env, TraceFromStart) :-
resolve(Arg1, Env, RArg1),
resolve(Arg2, Env, RArg2),
do_op(Op, RArg1, RArg2, Res),
write_env(Env, ResultVar, Res, NEnv),
runtrace(Rest, NEnv, TraceFromStart).
runtrace(loop, Env, TraceFromStart) :-
runtrace(TraceFromStart, Env, TraceFromStart).
runtrace(guard_true(V, ResumeVars, L, Rest), Env, TraceFromStart) :-
lookup(V, Env, Val),
(Val == 0 ->
resume_interp(Env, ResumeVars, L)
;
runtrace(Rest, Env, TraceFromStart)
).
runtrace(guard_false(V, ResumeVars, L, Rest), Env, TraceFromStart) :-
lookup(V, Env, Val),
(Val == 0 ->
runtrace(Rest, Env, TraceFromStart)
;
resume_interp(Env, ResumeVars, L)
).
runtrace(guard_value(V, FVal, ResumeVars, L, Rest), Env, TraceFromStart) :-
lookup(V, Env, Val),
(Val == FVal ->
runtrace(Rest, Env, TraceFromStart)
;
resume_interp(Env, ResumeVars, L)
).
resume_interp(Env, [], L) :-
block(L, Block),
interp(Block, Env).
block(power, op1(res, same, const(1),
if(y, power_rec, power_done))).
block(power_rec, op2(res, mul, var(res), var(x),
op2(y, sub, var(y), const(1),
if(y, power_rec, power_done)))).
block(power_done, print_and_stop(var(res))).
% --- promote
block(l, op2(c, ge, var(i), const(0),
if(c, b, l_done))).
block(l_done, print_and_stop(var(i))).
block(b, promote(x, b2)).
block(b2, op2(x2, mul, var(x), const(2),
op2(x3, add, var(x2), const(1),
op2(i, sub, var(i), var(x3),
jump(l))))).
:- do_trace(power_rec, [res/1, x/10, y/20]).
:- do_trace(b, [i/100, x/5]).
:- halt.
実行方法と結果:
$ swipl trace-jit2.pl
trace
op2(res,mul,var(res),var(x),op2(y,sub,var(y),const(1),guard_true(y,[],power_done,loop)))
opttrace
op2(res,mul,var(res),var(x),op2(y,sub,var(y),const(1),guard_true(y,[],power_done,loop)))
100000000000000000000
trace
guard_value(x,5,[],b2,op2(x2,mul,var(x),const(2),op2(x3,add,var(x2),const(1),op2(i,sub,var(i),var(x3),op2(c,ge,var(i),const(0),guard_true(c,[],l_done,loop))))))
opttrace
guard_value(x,5,[],b2,op2(x2,mul,var(x),const(2),op2(x3,add,var(x2),const(1),op2(i,sub,var(i),var(x3),op2(c,ge,var(i),const(0),guard_true(c,[],l_done,loop))))))
-10
Part3 FlowGraph 言語のトレースの最適化
% trace-jit3.pl
lookup(X, [], _) :- throw(key_not_found(X)).
lookup(Key, [Key/Value | _], Value) :- !.
lookup(Key, [_ | Rest], Value) :- lookup(Key, Rest, Value).
write_env([], X, V, [X/V]).
write_env([Key/_ | Rest], Key, Value, [Key/Value | Rest]) :- !.
write_env([Pair | Rest], Key, Value, [Pair | NewRest]) :- write_env(Rest, Key, Value, NewRest).
remove_env([], _, []).
remove_env([Key/_ | Rest], Key, Rest) :- !.
remove_env([Pair | Rest], Key, [Pair | NewRest]) :- remove_env(Rest, Key, NewRest).
resolve(const(X), _, X).
resolve(var(X), Env, Y) :- lookup(X, Env, Y).
do_op(same, X, X).
do_op(mul, X, Y, Z) :- Z is X * Y.
do_op(add, X, Y, Z) :- Z is X + Y.
do_op(sub, X, Y, Z) :- Z is X - Y.
do_op(eq, X, Y, Z) :- X == Y -> Z = 1; Z = 0.
do_op(ge, X, Y, Z) :- X >= Y -> Z = 1; Z = 0.
do_op(readlist, L, I, X) :- nth0(I, L, X).
do_op(Op, _, _, _) :- throw(missing_op(Op)).
interp(op1(ResultVar, Op, Arg, Rest), Env) :-
resolve(Arg, Env, RArg),
do_op(Op, RArg, Res),
write_env(Env, ResultVar, Res, NEnv),
interp(Rest, NEnv).
interp(op2(ResultVar, Op, Arg1, Arg2, Rest), Env) :-
resolve(Arg1, Env, RArg1),
resolve(Arg2, Env, RArg2),
do_op(Op, RArg1, RArg2, Res),
write_env(Env, ResultVar, Res, NEnv),
interp(Rest, NEnv).
interp(jump(L), Env) :-
block(L, Block),
interp(Block, Env).
interp(print_and_stop(Arg), Env) :-
resolve(Arg, Env, Val),
print(Val), nl.
interp(if(V, L1, L2), Env) :-
lookup(V, Env, Val),
(Val == 0 -> block(L2, Block)
; block(L1, Block)),
interp(Block, Env).
interp(promote(_, L), Env) :-
interp(jump(L), Env).
plookup(Key, [], var(Key)).
plookup(Key, [Key/Value | _], const(Value)) :- !.
plookup(Key, [_ | Rest], Value) :- plookup(Key, Rest, Value).
presolve(const(X), _, const(X)).
presolve(var(V), PEnv, X) :- plookup(V, PEnv, X).
pe(op1(ResultVar, Op, Arg, Rest), PEnv, NewOp) :-
presolve(Arg, PEnv, RArg),
(RArg = const(C) ->
do_op(Op, C, Res),
write_env(PEnv, ResultVar, Res, NEnv),
RestResidual = NewOp
; remove_env(PEnv, ResultVar, NEnv),
NewOp = op1(ResultVar, Op, RArg, RestResidual)
),
pe(Rest, NEnv, RestResidual).
pe(op2(ResultVar, Op, Arg1, Arg2, Rest), PEnv, NewOp) :-
presolve(Arg1, PEnv, RArg1),
presolve(Arg2, PEnv, RArg2),
(RArg1 = const(C1), RArg2 = const(C2) ->
do_op(Op, C1, C2, Res),
write_env(PEnv, ResultVar, Res, NEnv),
RestResidual = NewOp
; remove_env(PEnv, ResultVar, NEnv),
NewOp = op2(ResultVar, Op, RArg1, RArg2, RestResidual)
),
pe(Rest, NEnv, RestResidual).
pe(jump(L), PEnv, jump(LR)) :-
do_pe(L, PEnv, LR).
pe(print_and_stop(Arg), Env, print_and_stop(RArg)) :-
presolve(Arg, Env, RArg).
pe(if(V, L1, L2), PEnv, NewOp) :-
plookup(V, PEnv, Val),
(Val = const(C) ->
(C = 0 -> L = L2
; L = L1),
do_pe(L, PEnv, LR),
NewOp = jump(LR)
; do_pe(L1, PEnv, L1R),
do_pe(L2, PEnv, L2R),
NewOp = if(V, L1R, L2R)
).
do_pe(L, PEnv, LR) :-
(code_cache(L, PEnv, LR) ->
true
; gensym(L, LR),
assert(code_cache(L, PEnv, LR)),
block(L, Code),
pe(Code, PEnv, Residual),
assert(block(LR, Residual))
).
% part 2
trace(op1(ResultVar, Op, Arg, Rest), Env, op1(ResultVar, Op, Arg, T), TraceAnchor) :-
resolve(Arg, Env, RArg),
do_op(Op, RArg, Res),
write_env(Env, ResultVar, Res, NEnv),
trace(Rest, NEnv, T, TraceAnchor).
trace(op2(ResultVar, Op, Arg1, Arg2, Rest), Env, op2(ResultVar, Op, Arg1, Arg2, T), TraceAnchor) :-
resolve(Arg1, Env, RArg1),
resolve(Arg2, Env, RArg2),
do_op(Op, RArg1, RArg2, Res),
write_env(Env, ResultVar, Res, NEnv),
trace(Rest, NEnv, T, TraceAnchor).
trace(print_and_stop(V), Env, print_and_stop(V), _) :-
resolve(V, Env, Val),
print(Val), nl.
trace(jump(L), Env, T, TraceAnchor) :-
(TraceAnchor = traceanchor(L, FullTrace) ->
T = loop,
write(trace), nl, write(FullTrace), nl,
do_optimize(FullTrace, OptTrace),
write(opttrace), nl, write(OptTrace), nl,
runtrace(OptTrace, Env, OptTrace)
;
block(L, Block),
trace(Block, Env, T, TraceAnchor)
).
trace(if(V, L1, L2), Env, T, TraceAnchor) :-
lookup(V, Env, Val),
(Val == 0 ->
L = L2, T = guard_false(V, [], L1, NT)
;
L = L1, T = guard_true(V, [], L2, NT)
),
trace(jump(L), Env, NT, TraceAnchor).
trace(promote(V, L), Env, guard_value(V, Val, [], L, T), TraceAnchor) :-
lookup(V, Env, Val),
trace(jump(L), Env, T, TraceAnchor).
do_optimize(FullTrace, OptTrace) :-
optimize(FullTrace, [], OptTrace).
do_trace(L, Env) :-
block(L, StartBlock),
trace(StartBlock, Env, ProducedTrace, traceanchor(L, ProducedTrace)).
runtrace(op1(ResultVar, Op, Arg, Rest), Env, TraceFromStart) :-
resolve(Arg, Env, RArg),
do_op(Op, RArg, Res),
write_env(Env, ResultVar, Res, NEnv),
runtrace(Rest, NEnv, TraceFromStart).
runtrace(op2(ResultVar, Op, Arg1, Arg2, Rest), Env, TraceFromStart) :-
resolve(Arg1, Env, RArg1),
resolve(Arg2, Env, RArg2),
do_op(Op, RArg1, RArg2, Res),
write_env(Env, ResultVar, Res, NEnv),
runtrace(Rest, NEnv, TraceFromStart).
runtrace(loop, Env, TraceFromStart) :-
runtrace(TraceFromStart, Env, TraceFromStart).
runtrace(guard_true(V, ResumeVars, L, Rest), Env, TraceFromStart) :-
lookup(V, Env, Val),
(Val == 0 ->
resume_interp(Env, ResumeVars, L)
;
runtrace(Rest, Env, TraceFromStart)
).
runtrace(guard_false(V, ResumeVars, L, Rest), Env, TraceFromStart) :-
lookup(V, Env, Val),
(Val == 0 ->
runtrace(Rest, Env, TraceFromStart)
;
resume_interp(Env, ResumeVars, L)
).
runtrace(guard_value(V, FVal, ResumeVars, L, Rest), Env, TraceFromStart) :-
lookup(V, Env, Val),
(Val == FVal ->
runtrace(Rest, Env, TraceFromStart)
;
resume_interp(Env, ResumeVars, L)
).
write_resumevars([], Env, Env).
write_resumevars([Key / Value | Rest], Env, NEnv) :-
write_env(Env, Key, Value, Env1),
write_resumevars(Rest, Env1, NEnv).
resume_interp(Env, ResumeVars, L) :-
write_resumevars(ResumeVars, Env, NEnv),
block(L, Block),
interp(Block, NEnv).
optimize(op1(ResultVar, Op, Arg, Rest), PEnv, NewOp) :-
presolve(Arg, PEnv, RArg),
(RArg = const(C) ->
do_op(Op, C, Res),
write_env(PEnv, ResultVar, Res, NEnv),
NewOp = RestResidual
;
remove_env(PEnv, ResultVar, NEnv),
NewOp = op1(ResultVar, Op, RArg, RestResidual)
),
optimize(Rest, NEnv, RestResidual).
optimize(op2(ResultVar, Op, Arg1, Arg2, Rest), PEnv, NewOp) :-
presolve(Arg1, PEnv, RArg1),
presolve(Arg2, PEnv, RArg2),
(RArg1 = const(C1), RArg2 = const(C2) ->
do_op(Op, C1, C2, Res),
write_env(PEnv, ResultVar, Res, NEnv),
NewOp = RestResidual
;
remove_env(PEnv, ResultVar, NEnv),
NewOp = op2(ResultVar, Op, RArg1, RArg2, RestResidual)
),
optimize(Rest, NEnv, RestResidual).
optimize(guard_true(V, [], L, Rest), PEnv, NewOp) :-
plookup(V, PEnv, Val),
(Val = const(_) ->
NewOp = RestResidual
;
NewOp = guard_true(V, PEnv, L, RestResidual)
),
optimize(Rest, PEnv, RestResidual).
optimize(guard_false(V, [], L, Rest), PEnv, NewOp) :-
plookup(V, PEnv, Val),
(Val = const(_) ->
NewOp = RestResidual,
NEnv = PEnv
;
write_env(PEnv, V, 0, NEnv),
NewOp = guard_false(V, PEnv, L, RestResidual)
),
optimize(Rest, NEnv, RestResidual).
optimize(guard_value(V, C, [], L, Rest), PEnv, NewOp) :-
plookup(V, PEnv, Val),
(Val = const(_) ->
NewOp = RestResidual,
NEnv = PEnv
;
write_env(PEnv, V, C, NEnv),
NewOp = guard_value(V, C, PEnv, L, RestResidual)
),
optimize(Rest, NEnv, RestResidual).
optimize(loop, PEnv, T) :-
generate_assignments(PEnv, T).
generate_assignments([], loop).
generate_assignments([Var/Val | Tail], op1(Var, same, const(Val), T)) :-
generate_assignments(Tail, T).
:- generate_assignments([x/5, y/10], Out),Out = op1(x, same, const(5), op1(y, same, const(10), loop)).
:- optimize(
guard_value(x,3,[],b2,
op2(x2,mul,var(x),const(2),
op2(x3,add,var(x2),const(1),
op2(i,sub,var(i),var(x3),
op2(c,ge,var(i),const(0),
guard_true(c,[],l_done, loop)))))),
[],
LoopOut),LoopOut = guard_value(x, 3, [], b2, op2(i, sub, var(i), const(7), op2(c, ge, var(i), const(0), guard_true(c, [x/3, x2/6, x3/7], l_done, op1(x, same, const(3), op1(x2, same, const(6), op1(x3, same, const(7), loop))))))).
block(power, op1(res, same, const(1),
if(y, power_rec, power_done))).
block(power_rec, op2(res, mul, var(res), var(x),
op2(y, sub, var(y), const(1),
if(y, power_rec, power_done)))).
block(power_done, print_and_stop(var(res))).
% --- promote
block(l, op2(c, ge, var(i), const(0),
if(c, b, l_done))).
block(l_done, print_and_stop(var(i))).
block(b, promote(x, b2)).
block(b2, op2(x2, mul, var(x), const(2),
op2(x3, add, var(x2), const(1),
op2(i, sub, var(i), var(x3),
jump(l))))).
:- do_trace(power_rec, [res/1, x/10, y/20]).
:- do_trace(b, [i/100, x/5]).
:- halt.
$ swipl trace-jit3.pl
trace
op2(res,mul,var(res),var(x),op2(y,sub,var(y),const(1),guard_true(y,[],power_done,loop)))
opttrace
op2(res,mul,var(res),var(x),op2(y,sub,var(y),const(1),guard_true(y,[],power_done,loop)))
100000000000000000000
trace
guard_value(x,5,[],b2,op2(x2,mul,var(x),const(2),op2(x3,add,var(x2),const(1),op2(i,sub,var(i),var(x3),op2(c,ge,var(i),const(0),guard_true(c,[],l_done,loop))))))
opttrace
guard_value(x,5,[],b2,op2(i,sub,var(i),const(11),op2(c,ge,var(i),const(0),guard_true(c,[x/5,x2/10,x3/11],l_done,op1(x,same,const(5),op1(x2,same,const(10),op1(x3,same,const(11),loop)))))))
-10