code golfing to increase the speed of tight loops and simple expressions in prolog programs

parent c92dbb21
This diff is collapsed.
......@@ -112,8 +112,7 @@ get_post(S,C,Cplx,Tail,X,XX) :-
(
Cplx==#f ->
(
tr(pop,Pop),
X=[[Pop,3]|XX]
X=[[pop,3]|XX]
) ;
X=XX
);
......@@ -138,8 +137,7 @@ caller(cc,Args,label(G,N),V,[L,LL]) :- !,
get_S(V,S),
set_S(V,0),
push_v(2,V),
tr(seek,Seek),
L2=[[Seek,3]|L4],
L2=[[seek,3]|L4],
push_args_args(#f,Args,V,L4,LL2,_,_),
tr('goto-inst', Goto),
LL2 = [[Goto,G]|LL].
......@@ -153,8 +151,7 @@ caller(cc,Args,Tail,V,[L,LL]) :- !,
set_S(V,0),
push_args(F,V,L2,L3),
push_v(2,V),
tr(seek,Seek),
L3=[[Seek,2]|L4],
L3=[[seek,2]|L4],
push_args_args(#f,Args,V,L4,LL2,_,_),
set_FS(V,F,S),
tr('tail-cc', Call),
......@@ -170,8 +167,7 @@ caller(F,Args,Tail,V,[L,LL]) :-
set_S(V,0),
push_args(F,V,L2,L3),
push_v(3,V),
tr(seek,Seek),
L3=[[Seek,3]|L4],
L3=[[seek,3]|L4],
argkind(F,K),
push_args_args(K,Args,V,L4,LL2,LW,LL),
touch_A(V),
......
......@@ -58,7 +58,7 @@ compile_goal(Code,Iout,StackSize,Narg,Constants,Pretty) :- !,
(var(Constants) -> init_const ; true),
b_setval(pretty,#t),
make_state(0,[[0,_,_]],[0],0,0,0,0,[HC,HV],[],V),
wrap(compile_goal(Code,#t,V,[L,[]]),[L,[]]),
wrap(compile_goal(Code,#t,V,[L,[]]),[L,[]]),!,
get_M(V,StackSize),
handle_all(L,LL),
(var(Constants)->Constants=scm[(get-consts)];true),
......@@ -123,11 +123,10 @@ compile_goal(end_att,Tail,V,[L,LL]) :- !,
compile_goal(pop(N),Tail,V,[L,LL]) :- !,
check_tail(Tail),
tr(pop,Pop),
M is -N,
push_v(M,V),
tail(Tail,LL,LLL),
L=[[Pop,N]|LLL].
L=[[pop,N]|LLL].
compile_goal((Args <= Goal),Tail,V,L) :- !,
......@@ -191,15 +190,23 @@ compile_goal(';'(|X),Tail,V,[L,LL]) :- !,
XX=[] -> L=[[false]|LL] ;
XX=[Z] -> compile_goal(Z,Tail,V,[L,LL]) ;
(
get_AESM(V,Aq,E,S,M),
get_AESM(V,Aq,E,S,M),
get_F(V,F),
label(Lab),label(Out),
push_Q(V,Q),
compile_disjunction(XX,#t,Aq,Ae,Out,Lab,Lab,Tail,S,U,V,LM),!,
compile_disjunction(XX,#t,Aq,Ae,Out,Lab,LabA,Tail,S,U,V,LM),!,
(zero(V) -> Tp is 0 ; Tp is 1),
(
var(Q) ->
L = [['newframe-light',Lab ] | LX];
L = [[newframe ,Lab,Tp] | LX]
(
var_p(Var),
add_var_f(Var,V,F,LabA),
L = [['newframe-light',LabA ] | LX]
);
(
Lab=LabA,
L = [[newframe ,LabA,Tp] | LX]
)
),
LM = [LX, [[label,Out] | LL]],
get_EBH(V,Ed,B,H),
......
......@@ -214,6 +214,8 @@ t(icons).
t('unify-2').
t('unify').
t('sp-move').
t('sp-move-s').
t('icurly!').
t('ifkn!').
......@@ -241,6 +243,12 @@ t('post-unicall').
t('push-constant').
t('push-instruction').
t('push-variable-s').
t('push-variable-v').
t('push-2variables-s').
t('push-2variables-x').
t('push-3variables-s').
t('push-3variables-x').
t('push-variable').
t('push-variable-scm').
t('pop-variable').
......@@ -255,6 +263,22 @@ t(dup).
t(=..).
t('ss-add-s').
t('is-addi-s').
t('xx-add-x').
t('xx-uadd-x').
t('ss-gt').
t('ss-lt').
t('ss-ge').
t('ss-le').
t('ss-e').
t('ss-ne').
t('xx-gt').
t('xx-lt').
t('xx-ge').
t('xx-le').
t('xx-e').
t('xx-ne').
bin1(>,gtL,gtR).
bin1(< ,ltL,ltR).
bin1(>=,geL,geR).
......@@ -301,6 +325,21 @@ un('op1_-').
un('op1_+').
un(\\).
un(ᶜ).
binss(> ,'ss-gt').
binss(< ,'ss-lt').
binss(>= ,'ss-ge').
binss(=< ,'ss-le').
binss(=:= ,'ss-e' ).
binss(=\\= ,'ss-ne').
binxx(> ,'xx-gt').
binxx(< ,'xx-lt').
binxx(>= ,'xx-ge').
binxx(=< ,'xx-le').
binxx(=:= ,'xx-e' ).
binxx(=\\= ,'xx-ne').
")
......
......@@ -327,6 +327,24 @@ get_tags_from_bits((H,[HC,HV]),N,LL) :-
m((Q,F(H)),[X|L]) :- F(H,X),m(Q,L).
m(_,[]).
add_var_f(X,V,F,Tag) :-
add_var_f(X,0,V,F,Tag).
add_var_f(X,S,V,FF,Tag) :-
get_FEBH(V,F,E,B,H),
get_e_tag(X,H,FF,Ex,Tag,Etags),
EE is E \\/ Ex,
BB is B \\/ Ex,
set_EB(V,EE,BB),
reference(H,Tag),
(0 =:= Ex /\\ S -> true ; force_variable(Tag)),
(0 =:= Ex /\\ B -> first(Tag) ; true),
Edeps is Etags /\\ B,
get_tags_from_bits(H,Edeps,Deps),
m(reference(H),Deps).
add_var(X,V,Tag) :-
add_var(X,0,V,Tag).
......
......@@ -4046,6 +4046,39 @@ SCM inline gp_cons_simple(SCM x, SCM y, SCM s)
return GP_UNREF(f);
}
SCM inline car(SCM x)
{
return GP_GETREF(x)[1];
}
SCM inline cdr(SCM x)
{
return GP_GETREF(x)[2];
}
int inline consp(SCM x)
{
return GP_CONSP(x);
}
SCM inline lookup(SCM x, SCM s)
{
if(GP(x) || SCM_VARIABLEP(x))
return gp_gp_lookup(x,s);
else
return x;
}
ulong inline scm2ulong(SCM x)
{
return SCM_UNPACK(x) >> 2;
}
int inline scm2int(SCM x)
{
return (int) (((long) SCM_UNPACK(x)) >> 2);
}
typedef struct gp_vm
{
scm_t_uint32 *ip; /* instruction pointer */
......
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment