improve code for disjunctions by trying to avoid permanent variables.
This commit is contained in:
Vitor Santos Costa
parent
e4d6b529c7
commit
fc2e01f320
18
C/compiler.c
18
C/compiler.c
@ -1383,18 +1383,6 @@ IsTrueGoal(Term t) {
|
||||
return(t == MkAtomTerm(AtomTrue));
|
||||
}
|
||||
|
||||
static void
|
||||
c_p_put(Term Goal, op_numbers op_var, op_numbers op_val, compiler_struct * cglobs)
|
||||
{
|
||||
Term t = Deref(ArgOfTerm(2, Goal));
|
||||
int new = check_var(t, 1, 0, cglobs);
|
||||
t = Deref(t);
|
||||
Yap_emit((new ?
|
||||
(++cglobs->nvars,op_var) : op_val), t, IntegerOfTerm(ArgOfTerm(1, Goal)), &cglobs->cint);
|
||||
tag_var(t, new, cglobs);
|
||||
}
|
||||
|
||||
|
||||
static void
|
||||
emit_special_label(Term Goal, compiler_struct *cglobs)
|
||||
{
|
||||
@ -1814,6 +1802,12 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
|
||||
}
|
||||
return;
|
||||
}
|
||||
else if (f == FunctorSafe) {
|
||||
Ventry *v = (Ventry *)ArgOfTerm(1, Goal);
|
||||
/* This variable must be known before */
|
||||
v->FlagsOfVE |= SafeVar;
|
||||
return;
|
||||
}
|
||||
else if (p->PredFlags & AsmPredFlag) {
|
||||
int op = p->PredFlags & 0x7f;
|
||||
|
||||
|
||||
@ -212,6 +212,7 @@
|
||||
AtomRestoreRegs = Yap_FullLookupAtom("$restore_regs");
|
||||
AtomRetryCounter = Yap_LookupAtom("retry_counter");
|
||||
AtomRTree = Yap_LookupAtom("rtree");
|
||||
AtomSafe = Yap_FullLookupAtom("$safe");
|
||||
AtomSame = Yap_LookupAtom("==");
|
||||
AtomSemic = Yap_LookupAtom(";");
|
||||
AtomShiftCountOverflow = Yap_LookupAtom("shift_count_overflow");
|
||||
@ -361,6 +362,7 @@
|
||||
FunctorResourceError = Yap_MkFunctor(AtomResourceError,1);
|
||||
FunctorRestoreRegs = Yap_MkFunctor(AtomRestoreRegs,2);
|
||||
FunctorRestoreRegs1 = Yap_MkFunctor(AtomRestoreRegs,1);
|
||||
FunctorSafe = Yap_MkFunctor(AtomSafe,1);
|
||||
FunctorSame = Yap_MkFunctor(AtomSame,2);
|
||||
FunctorSlash = Yap_MkFunctor(AtomSlash,2);
|
||||
FunctorStaticClause = Yap_MkFunctor(AtomStaticClause,1);
|
||||
|
||||
@ -214,6 +214,7 @@
|
||||
AtomRestoreRegs = AtomAdjust(AtomRestoreRegs);
|
||||
AtomRetryCounter = AtomAdjust(AtomRetryCounter);
|
||||
AtomRTree = AtomAdjust(AtomRTree);
|
||||
AtomSafe = AtomAdjust(AtomSafe);
|
||||
AtomSame = AtomAdjust(AtomSame);
|
||||
AtomSemic = AtomAdjust(AtomSemic);
|
||||
AtomShiftCountOverflow = AtomAdjust(AtomShiftCountOverflow);
|
||||
@ -363,6 +364,7 @@
|
||||
FunctorResourceError = FuncAdjust(FunctorResourceError);
|
||||
FunctorRestoreRegs = FuncAdjust(FunctorRestoreRegs);
|
||||
FunctorRestoreRegs1 = FuncAdjust(FunctorRestoreRegs1);
|
||||
FunctorSafe = FuncAdjust(FunctorSafe);
|
||||
FunctorSame = FuncAdjust(FunctorSame);
|
||||
FunctorSlash = FuncAdjust(FunctorSlash);
|
||||
FunctorStaticClause = FuncAdjust(FunctorStaticClause);
|
||||
|
||||
@ -430,6 +430,8 @@
|
||||
#define AtomRetryCounter Yap_heap_regs->AtomRetryCounter_
|
||||
Atom AtomRTree_;
|
||||
#define AtomRTree Yap_heap_regs->AtomRTree_
|
||||
Atom AtomSafe_;
|
||||
#define AtomSafe Yap_heap_regs->AtomSafe_
|
||||
Atom AtomSame_;
|
||||
#define AtomSame Yap_heap_regs->AtomSame_
|
||||
Atom AtomSemic_;
|
||||
@ -728,6 +730,8 @@
|
||||
#define FunctorRestoreRegs Yap_heap_regs->FunctorRestoreRegs_
|
||||
Functor FunctorRestoreRegs1_;
|
||||
#define FunctorRestoreRegs1 Yap_heap_regs->FunctorRestoreRegs1_
|
||||
Functor FunctorSafe_;
|
||||
#define FunctorSafe Yap_heap_regs->FunctorSafe_
|
||||
Functor FunctorSame_;
|
||||
#define FunctorSame Yap_heap_regs->FunctorSame_
|
||||
Functor FunctorSlash_;
|
||||
|
||||
@ -223,6 +223,7 @@ A ResourceError N "resource_error"
|
||||
A RestoreRegs F "$restore_regs"
|
||||
A RetryCounter N "retry_counter"
|
||||
A RTree N "rtree"
|
||||
A Safe F "$safe"
|
||||
A Same N "=="
|
||||
A Semic N ";"
|
||||
A ShiftCountOverflow N "shift_count_overflow"
|
||||
@ -372,6 +373,7 @@ F RepresentationError RepresentationError 1
|
||||
F ResourceError ResourceError 1
|
||||
F RestoreRegs RestoreRegs 2
|
||||
F RestoreRegs1 RestoreRegs 1
|
||||
F Safe Safe 1
|
||||
F Same Same 2
|
||||
F Slash Slash 2
|
||||
F StaticClause StaticClause 1
|
||||
|
||||
686
pl/eval.yap
686
pl/eval.yap
@ -11,611 +11,109 @@
|
||||
* File: eval.yap *
|
||||
* Last rev: *
|
||||
* mods: *
|
||||
* comments: arithmetical optimization *
|
||||
* comments: optimise disjunction handling *
|
||||
* *
|
||||
*************************************************************************/
|
||||
|
||||
%, portray_clause((H:-BF))
|
||||
'$full_clause_optimisation'(H, M, B0, BF) :-
|
||||
'$localise_vars_opt'(H, M, B0, BF), !.
|
||||
|
||||
:- module('$eval',
|
||||
['$compile_arithmetic'/2]).
|
||||
% the idea here is to make global variables in disjunctions
|
||||
% local.
|
||||
'$localise_vars_opt'(H, M, (B1;B2), (NB1;NB2)) :-
|
||||
'$variables_in_term'(H, [], LV),
|
||||
'$localise_vars'(B1, M, NB1, LV, LV, []),
|
||||
'$localise_disj_vars'(B2, M, NB2, LV, LV, []).
|
||||
|
||||
'$compile_arithmetic'((Head :- Body), (Head :- NBody)) :-
|
||||
term_variables(Head, LVs),
|
||||
process_body(Body, LVs, NBody), !.
|
||||
'$compile_arithmetic'(G, G).
|
||||
'$localise_disj_vars'((B;B2), M, (NB ; NB2), LV, LV0, LEqs) :- !,
|
||||
'$localise_vars'(B, M, NB, LV, LV0, LEqs),
|
||||
'$localise_disj_vars'(B2, M, NB2, LV, LV0, LEqs).
|
||||
'$localise_disj_vars'(B2, M, NB, LV, LV0, LEqs) :-
|
||||
'$localise_vars'(B2, M, NB, LV, LV0, LEqs).
|
||||
|
||||
process_body((G,Body), InputVs, NewBody) :-
|
||||
arithmetic_exp(G), !,
|
||||
term_variables(G, UnsortedExpVs),
|
||||
'$sort'(UnsortedExpVs, ExpVs),
|
||||
fetch_more(Body, ExpVs, LGs, Gs, _, RBody),
|
||||
term_variables(RBody, ExtraVs),
|
||||
compile_arith([G|LGs], InputVs, ExtraVs, (G,Gs), ArithComp),
|
||||
(
|
||||
RBody = true
|
||||
->
|
||||
NewBody = ArithComp
|
||||
;
|
||||
NewBody = (ArithComp,MBody),
|
||||
term_variables(InputVs+G, NewInputVs),
|
||||
process_body(RBody, NewInputVs, MBody)
|
||||
).
|
||||
process_body((G,Body), InputVs, (G,NewBody)) :- !,
|
||||
term_variables(InputVs+G, NewInputVs),
|
||||
process_body(Body, NewInputVs, NewBody).
|
||||
process_body(G, InputVs, NewBody) :-
|
||||
arithmetic_exp(G), !,
|
||||
term_variables(G, _),
|
||||
compile_arith([G], InputVs, [], G, ArithComp),
|
||||
NewBody = (ArithComp,true).
|
||||
process_body(G, _, G).
|
||||
'$localise_vars'((A->B), M, (A->NB), LV, LV0, LEqs) :-
|
||||
'$safe_guard'(A, M), !,
|
||||
'$variables_in_term'(A, LV, LV1),
|
||||
'$localise_vars'(B, M, NB, LV1, LV0, LEqs).
|
||||
'$localise_vars'((A;B), M, (NA;NB), LV1, LV0, LEqs) :- !,
|
||||
'$localise_vars'(A, M, NA, LV1, LV0, LEqs),
|
||||
'$localise_disj_vars'(B, M, NB, LV1, LV0, LEqs).
|
||||
'$localise_vars'(((A,B),C), M, NG, LV, LV0, LEqs) :- !,
|
||||
'$flatten_bd'((A,B),C,NB),
|
||||
'$localise_vars'(NB, M, NG, LV, LV0, LEqs).
|
||||
'$localise_vars'((!,B), M, (!,NB), LV, LV0, LEqs) :- !,
|
||||
'$localise_vars'(B, M, NB, LV, LV0, LEqs).
|
||||
'$localise_vars'((X=Y,B), M, (X=Y,NB1), LV, LV0, LEqs) :-
|
||||
var(X), var(Y), !,
|
||||
'$localise_vars'(B, M, NB1, LV, LV0, [X,Y|LEqs]).
|
||||
'$localise_vars'((G,B), M, (G,NB1), LV, LV0, LEqs) :-
|
||||
'$safe_builtin'(G, M), !,
|
||||
'$variables_in_term'(G, LV, LV1),
|
||||
'$add_extra_safe'(G, NLV0, LV0),
|
||||
'$localise_vars'(B, M, NB1, LV1, NLV0, LEqs).
|
||||
'$localise_vars'((G1,B1), _, O, LV, LV0, LEqs) :- !,
|
||||
terms:variables_within_term(LV, B1, Commons),
|
||||
terms:new_variables_in_term(LV, B1, New),
|
||||
copy_term(Commons+New+LEqs+B1, NCommons+NNew+NLEqs+NB1),
|
||||
NNew = New,
|
||||
NLEqs = LEqs,
|
||||
'$gen_equals'(Commons, NCommons, LV0, (G1,NB1), O).
|
||||
'$localise_vars'(G, _, G, _, _, _).
|
||||
|
||||
fetch_more((G,Gs), ExpVs, [G|LGs], (G,AGs), AllExpVs, RGs) :-
|
||||
arithmetic_exp(G),
|
||||
term_variables(G,Vs),
|
||||
'$sort'(Vs, SVs),
|
||||
intersect_vars(SVs,ExpVs), !,
|
||||
join_vars(ExpVs,SVs,MoreExpVs),
|
||||
fetch_more(Gs, MoreExpVs, LGs, AGs, AllExpVs, RGs).
|
||||
fetch_more((G,Gs), ExpVs, [], true, ExpVs, (G,Gs)) :- !.
|
||||
fetch_more(G, ExpVs, [G], (G), MoreExpVs, true) :-
|
||||
arithmetic_exp(G),
|
||||
term_variables(G,Vs),
|
||||
'$sort'(Vs,SVs),
|
||||
intersect_vars(SVs,ExpVs), !,
|
||||
join_vars(ExpVs,SVs,MoreExpVs).
|
||||
fetch_more(G, ExpVs, [], true, ExpVs, G).
|
||||
'$gen_equals'([], [], _, O, O).
|
||||
'$gen_equals'([V|Commons],[NV|NCommons], LV0, O, NO) :- V == NV, !,
|
||||
'$gen_equals'(Commons,NCommons, LV0, O, NO).
|
||||
'$gen_equals'([V|Commons],[NV|NCommons], LV0, O, OO) :-
|
||||
'$vmember'(V,LV0),
|
||||
OO = (V=NV,'$safe'(NV),NO),
|
||||
'$gen_equals'(Commons,NCommons, LV0, O, NO).
|
||||
'$gen_equals'([V|Commons],[NV|NCommons], LV0, O, OO) :-
|
||||
OO = (V=NV,NO),
|
||||
'$gen_equals'(Commons,NCommons, LV0, O, NO).
|
||||
|
||||
arithmetic_exp((_ is _)).
|
||||
arithmetic_exp((_ =:= _)).
|
||||
arithmetic_exp((_ < _)).
|
||||
arithmetic_exp((_ > _)).
|
||||
arithmetic_exp((_ >= _)).
|
||||
arithmetic_exp((_ =< _)).
|
||||
'$safe_guard'((A,B), M) :- !,
|
||||
'$safe_guard'(A, M),
|
||||
'$safe_guard'(B, M).
|
||||
'$safe_guard'((A;B), M) :- !,
|
||||
'$safe_guard'(A, M),
|
||||
'$safe_guard'(B, M).
|
||||
'$safe_guard'(A, M) :- !,
|
||||
'$safe_builtin'(A, M).
|
||||
|
||||
intersect_vars([V1|R1],[V2|R2]) :-
|
||||
(
|
||||
V1 == V2
|
||||
->
|
||||
true
|
||||
;
|
||||
V1 @< V2
|
||||
->
|
||||
intersect_vars(R1,[V2|R2])
|
||||
;
|
||||
intersect_vars([V1|R1],R2)
|
||||
).
|
||||
'$safe_builtin'(G, Mod) :-
|
||||
'$flags'(G, Mod, Fl, Fl),
|
||||
Fl /\ 0x00008880 =\= 0.
|
||||
|
||||
join_vars([],[],[]).
|
||||
join_vars([],[V2|R2],[V2|R2]).
|
||||
join_vars([V1|R1],[],[V1|R1]).
|
||||
join_vars([V1|R1],[V2|R2],O) :-
|
||||
(
|
||||
V1 == V2
|
||||
->
|
||||
O = [V1|RO],
|
||||
join_vars(R1, R2, RO)
|
||||
;
|
||||
V1 @< V2
|
||||
->
|
||||
O = [V1|RO],
|
||||
join_vars(R1,[V2|R2], RO)
|
||||
;
|
||||
O = [V2|RO],
|
||||
join_vars([V1|R1],R2, RO)
|
||||
).
|
||||
'$vmember'(V,[V1|_]) :- V == V1, !.
|
||||
'$vmember'(V,[_|LV0]) :-
|
||||
'$vmember'(V,LV0).
|
||||
|
||||
compile_arith(LGs, InputVs, ExtraVs, Gs, ArithComp) :-
|
||||
add_type_slots(InputVs,TypedVs),
|
||||
'$sort'(InputVs,S1),
|
||||
'$sort'(ExtraVs,S2),
|
||||
join_vars(S1, S2, S),
|
||||
visit(LGs, TypedVs, NewTypedVs, S, FlatExps, []),
|
||||
FlatExps = [_,_|_],
|
||||
alloc_regs(NewTypedVs,0,Regs),
|
||||
Regs < 32,
|
||||
compile_ops([init_label(exception_label),init_label(success_label)|FlatExps], Gs, ArithComp), !.
|
||||
compile_arith(_, _, _, Gs, Gs).
|
||||
'$flatten_bd'((A,B),R,NB) :- !,
|
||||
'$flatten_bd'(B,R,R1),
|
||||
'$flatten_bd'(A,R1,NB).
|
||||
'$flatten_bd'(A,R,(A,R)).
|
||||
|
||||
add_type_slots([],[]).
|
||||
add_type_slots([V|ExpVs],[t(V,_,_)|TypesVs]) :-
|
||||
add_type_slots(ExpVs,TypesVs).
|
||||
|
||||
visit([], TypedVs, TypedVs, _) --> [].
|
||||
visit([Exp|Exps], TypedVs, NewTypedVs, ExtraVs) -->
|
||||
visit_pred(Exp, TypedVs, ITypedVs, ExtraVs),
|
||||
add_success_label(Exps),
|
||||
visit(Exps, ITypedVs, NewTypedVs, ExtraVs).
|
||||
|
||||
add_success_label([]) --> [].
|
||||
add_success_label([_|_]) --> [set_label(success_label)].
|
||||
|
||||
visit_pred((X is _), _, _, _) -->
|
||||
{ nonvar(X) }, !,
|
||||
{ fail }.
|
||||
visit_pred((_ is T), _, _, _) -->
|
||||
{ var(T) }, !,
|
||||
fail.
|
||||
visit_pred((X is T), TypedVs, ExtraTypedVs, LeftBodyVars) -->
|
||||
% check the expression
|
||||
visit_exp(T, TypedVs, NewTypedVs, TMP, Type),
|
||||
({ tmember(X, TypedVs, Type, TMP) }
|
||||
->
|
||||
{ NewTypedVs = ExtraTypedVs }
|
||||
;
|
||||
{ ExtraTypedVs = [t(X,Type,TMP)|NewTypedVs] }
|
||||
),
|
||||
% final code
|
||||
( { vmember(X, LeftBodyVars) } ->
|
||||
[init_label(success_label), export(TMP,X,Type)]
|
||||
;
|
||||
[]
|
||||
).
|
||||
visit_pred((X =:= T), TypedVs, NewTypedVs, _) -->
|
||||
% check the expression
|
||||
visit_exp(X, TypedVs, ITypedVs, TMP1, Type),
|
||||
visit_exp(T, ITypedVs, NewTypedVs, TMP2, Type),
|
||||
% assign the type to X, if any
|
||||
% final code
|
||||
[init_label(success_label), eq(TMP1,TMP2)].
|
||||
visit_pred((X < T), TypedVs, NewTypedVs, _) -->
|
||||
% check the expression
|
||||
visit_exp(X, TypedVs, ITypedVs, TMP1, _),
|
||||
visit_exp(T, ITypedVs, NewTypedVs, TMP2, _),
|
||||
% assign the type to X, if any
|
||||
% final code
|
||||
[init_label(success_label), lt(TMP1,TMP2)].
|
||||
visit_pred((X > T), TypedVs, NewTypedVs, _) -->
|
||||
% check the expression
|
||||
visit_exp(X, TypedVs, ITypedVs, TMP1, _),
|
||||
visit_exp(T, ITypedVs, NewTypedVs, TMP2, _),
|
||||
% assign the type to X, if any
|
||||
% final code
|
||||
[init_label(success_label), lt(TMP2,TMP1)].
|
||||
|
||||
visit_exp(V, TypedVs, TypedVs, TMP, Type) -->
|
||||
{
|
||||
var(V), !,
|
||||
tmember(V, TypedVs, Type, TMP)
|
||||
% must have been defined before
|
||||
},
|
||||
(
|
||||
{ var(TMP) } ->
|
||||
{ TMP = x(_) },
|
||||
[get(TMP,V,Type)]
|
||||
;
|
||||
[]
|
||||
).
|
||||
visit_exp(V, TypedVs, TypedVs, V, Type) -->
|
||||
{
|
||||
float(V)
|
||||
}, !,
|
||||
{ Type = float }.
|
||||
visit_exp(V, TypedVs, TypedVs, V, Type) -->
|
||||
{
|
||||
integer(V)
|
||||
}, !,
|
||||
{ Type = int }.
|
||||
visit_exp(V, TypedVs, NewTypedVs, TMP, Type) -->
|
||||
{
|
||||
ground(V),
|
||||
noatoms(V),
|
||||
!,
|
||||
NV is V
|
||||
},
|
||||
visit_exp(NV, TypedVs, NewTypedVs, TMP, Type).
|
||||
visit_exp(X, TypedVs, TypedVs, TMP, Type) -->
|
||||
{
|
||||
atom(X), !,
|
||||
add_type(X,Type)
|
||||
},
|
||||
[zerop(TMP,X)].
|
||||
visit_exp(X+Y, TypedVs, [t(_,Type,TMP)|NewTypedVs], TMP, Type) -->
|
||||
!,
|
||||
visit_exp(X, TypedVs, ITypedVs, V1, T1),
|
||||
visit_exp(Y, ITypedVs, NewTypedVs, V2, T2),
|
||||
{ forward_type(T1, T2, Type) },
|
||||
{ TMP = x(_) },
|
||||
[add(TMP,V1,V2)].
|
||||
visit_exp(X-Y, TypedVs, [t(_,Type,TMP)|NewTypedVs], TMP, Type) -->
|
||||
!,
|
||||
visit_exp(X, TypedVs, ITypedVs, V1, T1),
|
||||
visit_exp(Y, ITypedVs, NewTypedVs, V2, T2),
|
||||
{ forward_type(T1, T2, Type) },
|
||||
{ TMP = x(_) },
|
||||
[sub(TMP,V1,V2)].
|
||||
visit_exp(X*Y, TypedVs, [t(_,Type,TMP)|NewTypedVs], TMP, Type) -->
|
||||
!,
|
||||
visit_exp(X, TypedVs, ITypedVs, V1, T1),
|
||||
visit_exp(Y, ITypedVs, NewTypedVs, V2, T2),
|
||||
{ forward_type(T1, T2, Type) },
|
||||
{ TMP = x(_) },
|
||||
[mul(TMP,V1,V2)].
|
||||
visit_exp(X/Y, TypedVs, [t(_,float,TMP)|NewTypedVs], TMP, float) -->
|
||||
!,
|
||||
visit_exp(X, TypedVs, ITypedVs, V1, _),
|
||||
visit_exp(Y, ITypedVs, NewTypedVs, V2, _),
|
||||
[fdiv(TMP,V1,V2)].
|
||||
visit_exp(X//Y, TypedVs, [t(_,int,TMP)|NewTypedVs], TMP, int) -->
|
||||
{ Y\== 0},
|
||||
!,
|
||||
visit_exp(X, TypedVs, ITypedVs, V1, int),
|
||||
visit_exp(Y, ITypedVs, NewTypedVs, V2, int),
|
||||
{ TMP = x(_) },
|
||||
[idiv(TMP,V1,V2)].
|
||||
visit_exp(X mod Y, TypedVs, [t(_,int,TMP)|NewTypedVs], TMP, int) -->
|
||||
{ Y\== 0},
|
||||
!,
|
||||
visit_exp(X, TypedVs, ITypedVs, V1, int),
|
||||
visit_exp(Y, ITypedVs, NewTypedVs, V2, int),
|
||||
{ TMP = x(_) },
|
||||
[mod(TMP,V1,V2)].
|
||||
visit_exp(X rem Y, TypedVs, [t(_,int,TMP)|NewTypedVs], TMP, int) -->
|
||||
{ Y\== 0},
|
||||
!,
|
||||
visit_exp(X, TypedVs, ITypedVs, V1, int),
|
||||
visit_exp(Y, ITypedVs, NewTypedVs, V2, int),
|
||||
{ TMP = x(_) },
|
||||
[rem(TMP,V1,V2)].
|
||||
visit_exp(X /\ Y, TypedVs, [t(_,int,TMP)|NewTypedVs], TMP, int) -->
|
||||
!,
|
||||
visit_exp(X, TypedVs, ITypedVs, V1, int),
|
||||
visit_exp(Y, ITypedVs, NewTypedVs, V2, int),
|
||||
{ TMP = x(_) },
|
||||
[and(TMP,V1,V2)].
|
||||
visit_exp(X \/ Y, TypedVs, [t(_,int,TMP)|NewTypedVs], TMP, int) -->
|
||||
!,
|
||||
visit_exp(X, TypedVs, ITypedVs, V1, int),
|
||||
visit_exp(Y, ITypedVs, NewTypedVs, V2, int),
|
||||
{ TMP = x(_) },
|
||||
[or(TMP,V1,V2)].
|
||||
visit_exp(X # Y, TypedVs, [t(_,int,TMP)|NewTypedVs], TMP, int) -->
|
||||
!,
|
||||
visit_exp(X, TypedVs, ITypedVs, V1, int),
|
||||
visit_exp(Y, ITypedVs, NewTypedVs, V2, int),
|
||||
{ TMP = x(_) },
|
||||
[xor(TMP,V1,V2)].
|
||||
visit_exp(X << Y, TypedVs, [t(_,int,TMP)|NewTypedVs], TMP, int) -->
|
||||
!,
|
||||
visit_exp(X, TypedVs, ITypedVs, V1, int),
|
||||
visit_exp(Y, ITypedVs, NewTypedVs, V2, int),
|
||||
{ TMP = x(_) },
|
||||
[sl(TMP,V1,V2)].
|
||||
visit_exp(X >> Y, TypedVs, [t(_,int,TMP)|NewTypedVs], TMP, int) -->
|
||||
!,
|
||||
visit_exp(X, TypedVs, ITypedVs, V1, int),
|
||||
visit_exp(Y, ITypedVs, NewTypedVs, V2, int),
|
||||
{ TMP = x(_) },
|
||||
[sr(TMP,V1,V2)].
|
||||
visit_exp(X ^ Y, TypedVs, [t(_,int,TMP)|NewTypedVs], TMP, float) -->
|
||||
!,
|
||||
visit_exp(X, TypedVs, ITypedVs, V1, _),
|
||||
visit_exp(Y, ITypedVs, NewTypedVs, V2, _),
|
||||
{ TMP = x(_) },
|
||||
[exp(TMP,V1,V2)].
|
||||
visit_exp(X ** Y, TypedVs, [t(_,int,TMP)|NewTypedVs], TMP, float) -->
|
||||
!,
|
||||
visit_exp(X, TypedVs, ITypedVs, V1, _),
|
||||
visit_exp(Y, ITypedVs, NewTypedVs, V2, _),
|
||||
[exp(TMP,V1,V2)].
|
||||
visit_exp(exp(X,Y), TypedVs, [t(_,int,TMP)|NewTypedVs], TMP, float) -->
|
||||
!,
|
||||
visit_exp(X, TypedVs, ITypedVs, V1, _),
|
||||
visit_exp(Y, ITypedVs, NewTypedVs, V2, _),
|
||||
{ TMP = x(_) },
|
||||
[exp(TMP,V1,V2)].
|
||||
visit_exp(max(X,Y), TypedVs, [t(_,int,TMP)|NewTypedVs], TMP, float) -->
|
||||
!,
|
||||
visit_exp(X, TypedVs, ITypedVs, V1, _),
|
||||
visit_exp(Y, ITypedVs, NewTypedVs, V2, _),
|
||||
[max(TMP,V1,V2)].
|
||||
visit_exp(min(X,Y), TypedVs, [t(_,int,TMP)|NewTypedVs], TMP, float) -->
|
||||
!,
|
||||
visit_exp(X, TypedVs, ITypedVs, V1, _),
|
||||
visit_exp(Y, ITypedVs, NewTypedVs, V2, _),
|
||||
{ TMP = x(_) },
|
||||
[min(TMP,V1,V2)].
|
||||
visit_exp(gcd(X,Y), TypedVs, [t(_,int,TMP)|NewTypedVs], TMP, float) -->
|
||||
!,
|
||||
visit_exp(X, TypedVs, ITypedVs, V1, _),
|
||||
visit_exp(Y, ITypedVs, NewTypedVs, V2, _),
|
||||
[gcd(TMP,V1,V2)].
|
||||
visit_exp(+X, TypedVs, NewTypedVs, TMP, T) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP, T).
|
||||
visit_exp(-X, TypedVs, [t(_,T,TMP)|NewTypedVs], TMP, T) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, T),
|
||||
{ TMP = x(_) },
|
||||
[uminus(TMP,TMP1)].
|
||||
visit_exp(\(X), TypedVs, [t(_,int,TMP)|NewTypedVs], TMP, int) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, int),
|
||||
{ TMP = x(_) },
|
||||
[unot(TMP,TMP1)].
|
||||
visit_exp(exp(X), TypedVs, [t(_,float,TMP)|NewTypedVs], TMP, float) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, _),
|
||||
{ TMP = x(_) },
|
||||
[exp1(TMP,TMP1)].
|
||||
visit_exp(log(X), TypedVs, [t(_,float,TMP)|NewTypedVs], TMP, float) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, _),
|
||||
{ TMP = x(_) },
|
||||
[log(TMP,TMP1)].
|
||||
visit_exp(log10(X), TypedVs, [t(_,float,TMP)|NewTypedVs], TMP, float) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, _),
|
||||
{ TMP = x(_) },
|
||||
[log10(TMP,TMP1)].
|
||||
visit_exp(sqrt(X), TypedVs, [t(_,float,TMP)|NewTypedVs], TMP, float) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, _),
|
||||
{ TMP = x(_) },
|
||||
[sqrt(TMP,TMP1)].
|
||||
visit_exp(sin(X), TypedVs, [t(_,float,TMP)|NewTypedVs], TMP, float) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, _),
|
||||
{ TMP = x(_) },
|
||||
[sin(TMP,TMP1)].
|
||||
visit_exp(cos(X), TypedVs, [t(_,float,TMP)|NewTypedVs], TMP, float) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, _),
|
||||
{ TMP = x(_) },
|
||||
[cos(TMP,TMP1)].
|
||||
visit_exp(tan(X), TypedVs, [t(_,float,TMP)|NewTypedVs], TMP, float) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, _),
|
||||
{ TMP = x(_) },
|
||||
[tan(TMP,TMP1)].
|
||||
visit_exp(asin(X), TypedVs, [t(_,float,TMP)|NewTypedVs], TMP, float) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, _),
|
||||
{ TMP = x(_) },
|
||||
[asin(TMP,TMP1)].
|
||||
visit_exp(atan(X), TypedVs, [t(_,float,TMP)|NewTypedVs], TMP, float) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, _),
|
||||
{ TMP = x(_) },
|
||||
[atan(TMP,TMP1)].
|
||||
visit_exp(atan2(X), TypedVs, [t(_,float,TMP)|NewTypedVs], TMP, float) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, _),
|
||||
{ TMP = x(_) },
|
||||
[atan2(TMP,TMP1)].
|
||||
visit_exp(acos(X), TypedVs, [t(_,float,TMP)|NewTypedVs], TMP, float) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, _),
|
||||
{ TMP = x(_) },
|
||||
[acos(TMP,TMP1)].
|
||||
visit_exp(sinh(X), TypedVs, [t(_,float,TMP)|NewTypedVs], TMP, float) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, _),
|
||||
{ TMP = x(_) },
|
||||
[sinh(TMP,TMP1)].
|
||||
visit_exp(cosh(X), TypedVs, [t(_,float,TMP)|NewTypedVs], TMP, float) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, _),
|
||||
{ TMP = x(_) },
|
||||
[cosh(TMP,TMP1)].
|
||||
visit_exp(tanh(X), TypedVs, [t(_,float,TMP)|NewTypedVs], TMP, float) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, _),
|
||||
{ TMP = x(_) },
|
||||
[tanh(TMP,TMP1)].
|
||||
visit_exp(asinh(X), TypedVs, [t(_,float,TMP)|NewTypedVs], TMP, float) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, _),
|
||||
{ TMP = x(_) },
|
||||
[asinh(TMP,TMP1)].
|
||||
visit_exp(acosh(X), TypedVs, [t(_,float,TMP)|NewTypedVs], TMP, float) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, _),
|
||||
{ TMP = x(_) },
|
||||
[acosh(TMP,TMP1)].
|
||||
visit_exp(atanh(X), TypedVs, [t(_,float,TMP)|NewTypedVs], TMP, float) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, _),
|
||||
{ TMP = x(_) },
|
||||
[atanh(TMP,TMP1)].
|
||||
visit_exp(floor(X), TypedVs, [t(_,float,TMP)|NewTypedVs], TMP, float) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, _),
|
||||
{ TMP = x(_) },
|
||||
[floor(TMP,TMP1)].
|
||||
visit_exp(abs(X), TypedVs, [t(_,T,TMP)|NewTypedVs], TMP, T) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, T),
|
||||
{ TMP = x(_) },
|
||||
[abs(TMP,TMP1)].
|
||||
visit_exp(integer(X), TypedVs, [t(_,int,TMP)|NewTypedVs], TMP, int) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, _),
|
||||
{ TMP = x(_) },
|
||||
[integer(TMP,TMP1)].
|
||||
visit_exp(truncate(X), TypedVs, [t(_,float,TMP)|NewTypedVs], TMP, float) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, _),
|
||||
{ TMP = x(_) },
|
||||
[truncate(TMP,TMP1)].
|
||||
visit_exp(round(X), TypedVs, [t(_,float,TMP)|NewTypedVs], TMP, float) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, _),
|
||||
{ TMP = x(_) },
|
||||
[round(TMP,TMP1)].
|
||||
visit_exp(ceiling(X), TypedVs, [t(_,float,TMP)|NewTypedVs], TMP, float) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, _),
|
||||
{ TMP = x(_) },
|
||||
[ceiling(TMP,TMP1)].
|
||||
visit_exp(msb(X), TypedVs, [t(_,int,TMP)|NewTypedVs], TMP, int) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, int),
|
||||
{ TMP = x(_) },
|
||||
[msb(TMP,TMP1)].
|
||||
visit_exp(random(X), TypedVs, [t(_,int,TMP)|NewTypedVs], TMP, int) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, int),
|
||||
{ TMP = x(_) },
|
||||
[random(TMP,TMP1)].
|
||||
visit_exp(lgamma(X), TypedVs, [t(_,float,TMP)|NewTypedVs], TMP, float) -->
|
||||
visit_exp(X, TypedVs, NewTypedVs, TMP1, _),
|
||||
{ TMP = x(_) },
|
||||
[lgamma(TMP,TMP1)].
|
||||
|
||||
forward_type(T1, _, Type) :- T1 == float, !, Type = float.
|
||||
forward_type(_, T2, Type) :- T2 == float, !, Type = float.
|
||||
forward_type(T1, T2, Type) :- T1 == int, T2 == int, !, Type = int.
|
||||
forward_type(_, _, _).
|
||||
'$add_extra_safe'('$plus'(_,_,V)) --> !, [V].
|
||||
'$add_extra_safe'('$minus'(_,_,V)) --> !, [V].
|
||||
'$add_extra_safe'('$times'(_,_,V)) --> !, [V].
|
||||
'$add_extra_safe'('$div'(_,_,V)) --> !, [V].
|
||||
'$add_extra_safe'('$and'(_,_,V)) --> !, [V].
|
||||
'$add_extra_safe'('$or'(_,_,V)) --> !, [V].
|
||||
'$add_extra_safe'('$sll'(_,_,V)) --> !, [V].
|
||||
'$add_extra_safe'('$slr'(_,_,V)) --> !, [V].
|
||||
'$add_extra_safe'(C=D,A,B) :-
|
||||
!,
|
||||
( compound(C) ->
|
||||
'$variables_in_term'(C,E,A)
|
||||
;
|
||||
E=A
|
||||
),
|
||||
( compound(D) ->
|
||||
'$variables_in_term'(D,B,E)
|
||||
;
|
||||
B=E
|
||||
).
|
||||
'$add_extra_safe'(_) --> [].
|
||||
|
||||
|
||||
tmember(X, [t(X1,Type,Tmp)|_], Type, Tmp) :-
|
||||
X == X1, !.
|
||||
tmember(X, [_|TypesVs], Type, Tmp) :-
|
||||
tmember(X, TypesVs, Type, Tmp).
|
||||
|
||||
stmember(X, [t(X,Type,Tmp1)|_], Type, Tmp) :-
|
||||
Tmp == Tmp1, !.
|
||||
stmember(X, [_|TypesVs], Type, Tmp) :-
|
||||
stmember(X, TypesVs, Type, Tmp).
|
||||
|
||||
vmember(X, [X1|_]) :-
|
||||
X == X1, !.
|
||||
vmember(X, [_|Vs]) :-
|
||||
vmember(X, Vs).
|
||||
|
||||
add_type(random, float).
|
||||
add_type(pi, float).
|
||||
add_type(inf, float).
|
||||
add_type(nan, float).
|
||||
add_type(random, float).
|
||||
add_type(cputime, float).
|
||||
add_type(heapused, int).
|
||||
add_type(local_sp, int).
|
||||
add_type(global_sp, int).
|
||||
add_type(stackfree, int).
|
||||
|
||||
noatoms(N) :-
|
||||
N =.. [_|Ns],
|
||||
noatom_in_list(Ns).
|
||||
|
||||
noatom_in_list([]).
|
||||
noatom_in_list([El|Els]) :-
|
||||
\+ atom(El),
|
||||
El =.. [_|LEl],
|
||||
noatom_in_list(LEl),
|
||||
noatom_in_list(Els).
|
||||
|
||||
alloc_regs([],R,R).
|
||||
alloc_regs([t(_,_,no)|NewTypedVs], R0, RF) :- !,
|
||||
alloc_regs(NewTypedVs, R0, RF).
|
||||
alloc_regs([t(_,_,x(R0))|NewTypedVs], R0, RF) :- !,
|
||||
R1 is R0+1,
|
||||
alloc_regs(NewTypedVs, R1, RF).
|
||||
alloc_regs([t(_,_,x(_))|NewTypedVs], R0, RF) :-
|
||||
alloc_regs(NewTypedVs, R0, RF).
|
||||
|
||||
compile_ops([], Gs, Tail) :-
|
||||
compile_tail(Gs, Tail).
|
||||
compile_ops([Op|Exps], Gs, (COp,More)) :-
|
||||
compile_op(Op , COp),
|
||||
compile_ops(Exps, Gs, More).
|
||||
|
||||
compile_tail(Gs,(E1,Gs,E2,E3,E4)) :-
|
||||
compile_op(set_label(exception_label),E1),
|
||||
compile_op(set_label(success_label),E2),
|
||||
compile_op(clear_label(exception_label),E3),
|
||||
compile_op(clear_label(success_label),E4).
|
||||
|
||||
|
||||
compile_op(init_label(exception_label), '$label_ctl'(0,2)).
|
||||
compile_op(init_label(fail_label), '$label_ctl'(0,1)).
|
||||
compile_op(init_label(success_label), '$label_ctl'(0,0)).
|
||||
compile_op(set_label(exception_label), '$label_ctl'(1,2)).
|
||||
compile_op(set_label(fail_label), '$label_ctl'(1,1)).
|
||||
compile_op(set_label(success_label), '$label_ctl'(1,0)).
|
||||
compile_op(clear_label(exception_label), '$label_ctl'(2,2)).
|
||||
compile_op(clear_label(fail_label), '$label_ctl'(2,1)).
|
||||
compile_op(clear_label(success_label), '$label_ctl'(2,0)).
|
||||
compile_op(export(x(A),V,any), '$put_fi'(A,V)) :- !.
|
||||
compile_op(export(x(A),V,int), '$put_i'(A,V)).
|
||||
compile_op(export(x(A),V,float), '$put_f'(A,V)).
|
||||
compile_op(eq(x(A),F), '$a_eq_float'(A,F)) :- float(F), !.
|
||||
compile_op(eq(x(A),I), '$a_eq_int'(A,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(eq(x(A),x(B)), '$a_eq'(A,B)).
|
||||
compile_op(lt(x(A),F), '$ltc_float'(A,F)) :- float(F), !.
|
||||
compile_op(lt(x(A),I), '$ltc_int'(A,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(lt(F,x(A)), '$gtc_float'(A,F)) :- float(F), !.
|
||||
compile_op(lt(I,x(A)), '$gtc_int'(A,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(lt(x(A),x(B)), '$lt'(A,B)).
|
||||
compile_op(get(x(A),V,any), '$get_fi'(A,V)) :- !.
|
||||
compile_op(get(x(A),V,int), '$get_i'(A,V)) :- !.
|
||||
compile_op(get(x(A),V,float), '$get_f'(A,V)).
|
||||
compile_op(add(x(A),F,x(B)), '$add_float_c'(A,B,F)) :- float(F), !.
|
||||
compile_op(add(x(A),I,x(B)), '$add_int_c'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(add(x(A),x(B),F), '$add_float_c'(A,B,F)) :- float(F), !.
|
||||
compile_op(add(x(A),x(B),I), '$add_int_c'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(add(x(A),x(B),x(C)), '$add'(A,B,C)).
|
||||
compile_op(sub(x(A),F,x(B)), '$sub_float_c'(A,B,F)) :- float(F), !.
|
||||
compile_op(sub(x(A),I,x(B)), '$sub_int_c'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(sub(x(A),x(B),F), '$add_float_c'(A,B,F1)) :- float(F), !, F1 is -F.
|
||||
compile_op(sub(x(A),x(B),I), '$add_int_c'(A,B,I1)) :- integer(I), !, I1 is -I, \+ '$bignum'(I1).
|
||||
compile_op(sub(x(A),x(B),x(C)), '$sub'(A,B,C)).
|
||||
compile_op(mul(x(A),F,x(B)), '$mul_float_c'(A,B,F)) :- float(F), !.
|
||||
compile_op(mul(x(A),I,x(B)), '$mul_int_c'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(mul(x(A),x(B),F), '$mul_float_c'(A,B,F)) :- float(F), !.
|
||||
compile_op(mul(x(A),x(B),I), '$mul_int_c'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(mul(x(A),x(B),x(C)), '$mul'(A,B,C)).
|
||||
compile_op(fdiv(x(A),F,x(B)), '$fdiv_c1'(A,B,F)) :- float(F), !.
|
||||
compile_op(fdiv(x(A),I,x(B)), '$fdiv_c1'(A,B,F)) :- integer(I), !, \+ '$bignum'(I), F is truncate(I).
|
||||
compile_op(fdiv(x(A),x(B),F), '$fdiv_c2'(A,B,F)) :- float(F), !.
|
||||
compile_op(fdiv(x(A),x(B),I), '$fdiv_c2'(A,B,F)) :- integer(I), !, \+ '$bignum'(I), F is truncate(I).
|
||||
compile_op(fdiv(x(A),x(B),x(C)), '$fdiv'(A,B,C)).
|
||||
compile_op(idiv(x(A),I,x(B)), '$idiv_c1'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(idiv(x(A),x(B),I), '$idiv_c2'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(idiv(x(A),x(B),x(C)), '$idiv'(A,B,C)).
|
||||
compile_op(mod(x(A),I,x(B)), '$mod_c1'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(mod(x(A),x(B),I), '$mod_c2'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(mod(x(A),x(B),x(C)), '$mod'(A,B,C)).
|
||||
compile_op(rem(x(A),I,x(B)), '$rem_c1'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(rem(x(A),x(B),I), '$rem_c2'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(rem(x(A),x(B),x(C)), '$rem'(A,B,C)).
|
||||
compile_op(and(x(A),I,x(B)), '$land_c'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(and(x(A),x(B),I), '$land_c'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(and(x(A),x(B),x(C)), '$land'(A,B,C)).
|
||||
compile_op(or(x(A),I,x(B)), '$lor_c'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(or(x(A),x(B),I), '$lor_c'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(or(x(A),x(B),x(C)), '$lor'(A,B,C)).
|
||||
compile_op(xor(x(A),I,x(B)), '$xor_c'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(xor(x(A),x(B),I), '$xor_c'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(xor(x(A),x(B),x(C)), '$xor'(A,B,C)).
|
||||
compile_op(uminus(x(A),x(B)), '$uminus'(A,B)).
|
||||
compile_op(sr(x(A),I,x(B)), '$sr_c1'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(sr(x(A),x(B),I), '$sr_c2'(A,B,I)) :- integer(I), I >=0, !, \+ '$bignum'(I).
|
||||
compile_op(sr(x(A),x(B),I), '$sl_c2'(A,B,NI)) :- integer(I), !, NI is -I, \+ '$bignum'(NI).
|
||||
compile_op(sr(x(A),x(B),x(C)), '$sr'(A,B,C)).
|
||||
compile_op(sl(x(A),I,x(B)), '$sl_c1'(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(sl(x(A),x(B),I), '$sl_c2'(A,B,I)) :- integer(I), I >= 0, !, \+ '$bignum'(I).
|
||||
compile_op(sl(x(A),x(B),I), '$sr_c2'(A,B,NI)) :- integer(I), !, NI is -I, \+ '$bignum'(NI).
|
||||
compile_op(sl(x(A),x(B),x(C)), '$sl'(A,B,C)).
|
||||
/*
|
||||
compile_op(zerop(x(A),Op), '$zerop'(A,Op)).
|
||||
compile_op(exp(x(A),F,x(B)), exp_c(A,B,F)) :- float(F), !.
|
||||
compile_op(exp(x(A),I,x(B)), exp_c(A,B,F)) :- integer(I), !, \+ '$bignum'(I), F is truncate(I).
|
||||
compile_op(exp(x(A),x(B),F), exp_c(A,B,F)) :- float(F), !.
|
||||
compile_op(exp(x(A),x(B),I), exp_c(A,B,F)) :- integer(I), !, \+ '$bignum'(I), F is truncate(I).
|
||||
compile_op(exp(x(A),x(B),x(C)), exp(A,B,C)).
|
||||
compile_op(max(x(A),F,x(B)), max_float_c(A,B,F)) :- float(F), !.
|
||||
compile_op(max(x(A),I,x(B)), max_int_c(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(max(x(A),x(B),F), max_float_c(A,B,F)) :- float(F), !.
|
||||
compile_op(max(x(A),x(B),I), max_int_c(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(max(x(A),x(B),x(C)), max(A,B,C)).
|
||||
compile_op(min(x(A),F,x(B)), min_float_c(A,B,F)) :- float(F), !.
|
||||
compile_op(min(x(A),I,x(B)), min_int_c(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(min(x(A),x(B),F), min_float_c(A,B,F)) :- float(F), !.
|
||||
compile_op(min(x(A),x(B),I), min_int_c(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(min(x(A),x(B),x(C)), min(A,B,C)).
|
||||
compile_op(gcd(x(A),I,x(B)), gcd_c(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(gcd(x(A),x(B),I), gcd_c(A,B,I)) :- integer(I), !, \+ '$bignum'(I).
|
||||
compile_op(gcd(x(A),x(B),x(C)), gcd(A,B,C)).
|
||||
compile_op(unot(x(A),x(B)), unot(A,B)).
|
||||
compile_op(exp1(x(A),x(B)), exp1(A,B)).
|
||||
compile_op(log(x(A),x(B)), log(A,B)).
|
||||
compile_op(log10(x(A),x(B)), log10(A,B)).
|
||||
compile_op(sqrt(x(A),x(B)), sqrt(A,B)).
|
||||
compile_op(sin(x(A),x(B)), sin(A,B)).
|
||||
compile_op(cos(x(A),x(B)), cos(A,B)).
|
||||
compile_op(tan(x(A),x(B)), tan(A,B)).
|
||||
compile_op(asin(x(A),x(B)), asin(A,B)).
|
||||
compile_op(acos(x(A),x(B)), acos(A,B)).
|
||||
compile_op(atan(x(A),x(B)), atan(A,B)).
|
||||
compile_op(atan2(x(A),x(B)), atan2(A,B)).
|
||||
compile_op(sinh(x(A),x(B)), sinh(A,B)).
|
||||
compile_op(cosh(x(A),x(B)), cosh(A,B)).
|
||||
compile_op(tanh(x(A),x(B)), tanh(A,B)).
|
||||
compile_op(asinh(x(A),x(B)), asinh(A,B)).
|
||||
compile_op(acosh(x(A),x(B)), acosh(A,B)).
|
||||
compile_op(atanh(x(A),x(B)), atanh(A,B)).
|
||||
compile_op(floor(x(A),x(B)), floor(A,B)).
|
||||
compile_op(abs(x(A),x(B)), abs(A,B)).
|
||||
compile_op(integer(x(A),x(B)), integer(A,B)).
|
||||
compile_op(truncate(x(A),x(B)), truncate(A,B)).
|
||||
compile_op(round(x(A),x(B)), round(A,B)).
|
||||
compile_op(ceiling(x(A),x(B)), ceiling(A,B)).
|
||||
compile_op(msb(x(A),x(B)), msb(A,B)).
|
||||
compile_op(random(x(A),x(B)), random(A,B)).
|
||||
compile_op(lgamma(x(A),x(B)), lgamma(A,B)).
|
||||
*/
|
||||
|
||||
|
||||
@ -194,11 +194,16 @@ module(N) :-
|
||||
% A6: head module (this is the one used in compiling and accessing).
|
||||
%
|
||||
%
|
||||
'$module_expansion'((H:-B),(H:-B1),(H:-BO),M,HM) :- !,
|
||||
'$module_expansion'((H:-B),(H:-B1),(H:-BOO),M,HM) :- !,
|
||||
'$is_mt'(M, H, B, IB, MM),
|
||||
'$module_u_vars'(H,UVars,M), % collect head variables in
|
||||
% expanded positions
|
||||
'$module_expansion'(IB,B1,BO,M,MM,HM,UVars).
|
||||
'$module_expansion'(IB,B1,BO,M,MM,HM,UVars),
|
||||
('$full_clause_optimisation'(H, M, BO, BOO) ->
|
||||
true
|
||||
;
|
||||
BO = BOO
|
||||
).
|
||||
% do not expand bodyless clauses.
|
||||
'$module_expansion'(H,H,H,_,_).
|
||||
|
||||
|
||||
Reference in New Issue
Block a user