get rid of UnCutable
a:(a(X),b(X)) should be the same as a:a(X), a:b(X). Use PushModPred to force that. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@642 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
parent
e19f91db60
commit
d21021da0d
58
C/compiler.c
58
C/compiler.c
@ -34,8 +34,8 @@ STATIC_PROTO(void c_arg, (Int, Term, unsigned int));
|
|||||||
STATIC_PROTO(void c_args, (Term));
|
STATIC_PROTO(void c_args, (Term));
|
||||||
STATIC_PROTO(void c_eq, (Term, Term));
|
STATIC_PROTO(void c_eq, (Term, Term));
|
||||||
STATIC_PROTO(void c_test, (Int, Term));
|
STATIC_PROTO(void c_test, (Int, Term));
|
||||||
STATIC_PROTO(void c_bifun, (Int, Term, Term, Term, int, int *));
|
STATIC_PROTO(void c_bifun, (Int, Term, Term, Term, int));
|
||||||
STATIC_PROTO(void c_goal, (Term, int, int *));
|
STATIC_PROTO(void c_goal, (Term, int));
|
||||||
STATIC_PROTO(void get_type_info, (Term));
|
STATIC_PROTO(void get_type_info, (Term));
|
||||||
STATIC_PROTO(void c_body, (Term, int));
|
STATIC_PROTO(void c_body, (Term, int));
|
||||||
STATIC_PROTO(void get_cl_info, (Term));
|
STATIC_PROTO(void get_cl_info, (Term));
|
||||||
@ -699,7 +699,7 @@ bip_cons Op,Xk,Ri,C
|
|||||||
|
|
||||||
*/
|
*/
|
||||||
static void
|
static void
|
||||||
c_bifun(Int Op, Term t1, Term t2, Term t3, int mod, int *uncutable)
|
c_bifun(Int Op, Term t1, Term t2, Term t3, int mod)
|
||||||
{
|
{
|
||||||
/* compile Z = X Op Y arithmetic function */
|
/* compile Z = X Op Y arithmetic function */
|
||||||
/* first we fetch the arguments */
|
/* first we fetch the arguments */
|
||||||
@ -818,7 +818,7 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, int mod, int *uncutable)
|
|||||||
if (IsNumTerm(t1)) {
|
if (IsNumTerm(t1)) {
|
||||||
/* we will always fail */
|
/* we will always fail */
|
||||||
if (i2)
|
if (i2)
|
||||||
c_goal(MkAtomTerm(AtomFalse), mod, uncutable);
|
c_goal(MkAtomTerm(AtomFalse), mod);
|
||||||
} else if (!IsAtomTerm(t1)) {
|
} else if (!IsAtomTerm(t1)) {
|
||||||
char s[32];
|
char s[32];
|
||||||
|
|
||||||
@ -889,7 +889,7 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, int mod, int *uncutable)
|
|||||||
} else if (IsApplTerm(t2)) {
|
} else if (IsApplTerm(t2)) {
|
||||||
Functor f = FunctorOfTerm(t2);
|
Functor f = FunctorOfTerm(t2);
|
||||||
if (i1 < 1 || i1 > ArityOfFunctor(f)) {
|
if (i1 < 1 || i1 > ArityOfFunctor(f)) {
|
||||||
c_goal(MkAtomTerm(AtomFalse), mod, uncutable);
|
c_goal(MkAtomTerm(AtomFalse), mod);
|
||||||
} else {
|
} else {
|
||||||
c_eq(ArgOfTerm(i1, t2), t3);
|
c_eq(ArgOfTerm(i1, t2), t3);
|
||||||
}
|
}
|
||||||
@ -903,7 +903,7 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, int mod, int *uncutable)
|
|||||||
c_eq(TailOfTerm(t2), t3);
|
c_eq(TailOfTerm(t2), t3);
|
||||||
return;
|
return;
|
||||||
default:
|
default:
|
||||||
c_goal(MkAtomTerm(AtomFalse), mod, uncutable);
|
c_goal(MkAtomTerm(AtomFalse), mod);
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@ -1063,13 +1063,13 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, int mod, int *uncutable)
|
|||||||
}
|
}
|
||||||
|
|
||||||
static void
|
static void
|
||||||
c_functor(Term Goal, int mod, int *uncutable)
|
c_functor(Term Goal, int mod)
|
||||||
{
|
{
|
||||||
Term t1 = ArgOfTerm(1, Goal);
|
Term t1 = ArgOfTerm(1, Goal);
|
||||||
Term t2 = ArgOfTerm(2, Goal);
|
Term t2 = ArgOfTerm(2, Goal);
|
||||||
Term t3 = ArgOfTerm(3, Goal);
|
Term t3 = ArgOfTerm(3, Goal);
|
||||||
if (IsVarTerm(t1) && IsNewVar(t1)) {
|
if (IsVarTerm(t1) && IsNewVar(t1)) {
|
||||||
c_bifun(_functor, t2, t3, t1, mod, uncutable);
|
c_bifun(_functor, t2, t3, t1, mod);
|
||||||
} else if (IsNonVarTerm(t1)) {
|
} else if (IsNonVarTerm(t1)) {
|
||||||
/* just split the structure */
|
/* just split the structure */
|
||||||
if (IsAtomicTerm(t1)) {
|
if (IsAtomicTerm(t1)) {
|
||||||
@ -1121,7 +1121,7 @@ IsTrueGoal(Term t) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static void
|
static void
|
||||||
c_goal(Term Goal, int mod, int* uncutable)
|
c_goal(Term Goal, int mod)
|
||||||
{
|
{
|
||||||
Functor f;
|
Functor f;
|
||||||
PredEntry *p;
|
PredEntry *p;
|
||||||
@ -1177,11 +1177,6 @@ c_goal(Term Goal, int mod, int* uncutable)
|
|||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
else if (atom == AtomCut) {
|
else if (atom == AtomCut) {
|
||||||
if (*uncutable){
|
|
||||||
Error_TYPE = UNKNOWN_ERROR; /*ceh: needs an official assigned error*/
|
|
||||||
Error_Term = Goal;
|
|
||||||
FAIL("tried to cut an uncutable goal", UNKNOWN_ERROR, Goal);
|
|
||||||
}
|
|
||||||
if (profiling)
|
if (profiling)
|
||||||
emit(enter_profiling_op, (CELL)RepPredProp(PredPropByAtom(AtomCut,0)), Zero);
|
emit(enter_profiling_op, (CELL)RepPredProp(PredPropByAtom(AtomCut,0)), Zero);
|
||||||
else if (call_counting)
|
else if (call_counting)
|
||||||
@ -1349,16 +1344,16 @@ c_goal(Term Goal, int mod, int* uncutable)
|
|||||||
}
|
}
|
||||||
save = onlast;
|
save = onlast;
|
||||||
onlast = FALSE;
|
onlast = FALSE;
|
||||||
c_goal(ArgOfTerm(1, arg), mod, uncutable);
|
c_goal(ArgOfTerm(1, arg), mod);
|
||||||
if (!optimizing_comit) {
|
if (!optimizing_comit) {
|
||||||
c_var((Term) comitvar, comit_b_flag,
|
c_var((Term) comitvar, comit_b_flag,
|
||||||
1);
|
1);
|
||||||
}
|
}
|
||||||
onlast = save;
|
onlast = save;
|
||||||
c_goal(ArgOfTerm(2, arg), mod, uncutable);
|
c_goal(ArgOfTerm(2, arg), mod);
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
c_goal(ArgOfTerm(1, Goal), mod, uncutable);
|
c_goal(ArgOfTerm(1, Goal), mod);
|
||||||
if (!onlast) {
|
if (!onlast) {
|
||||||
emit(jump_op, m, Zero);
|
emit(jump_op, m, Zero);
|
||||||
}
|
}
|
||||||
@ -1375,13 +1370,13 @@ c_goal(Term Goal, int mod, int* uncutable)
|
|||||||
else {
|
else {
|
||||||
optimizing_comit = FALSE; /* not really necessary */
|
optimizing_comit = FALSE; /* not really necessary */
|
||||||
}
|
}
|
||||||
c_goal(Goal, mod, uncutable);
|
c_goal(Goal, mod);
|
||||||
/* --onbranch; */
|
/* --onbranch; */
|
||||||
onbranch = pop_branch();
|
onbranch = pop_branch();
|
||||||
if (!onlast) {
|
if (!onlast) {
|
||||||
emit(label_op, m, Zero);
|
emit(label_op, m, Zero);
|
||||||
if ((onlast = save))
|
if ((onlast = save))
|
||||||
c_goal(MkAtomTerm(AtomTrue), mod, uncutable);
|
c_goal(MkAtomTerm(AtomTrue), mod);
|
||||||
}
|
}
|
||||||
emit(pop_or_op, Zero, Zero);
|
emit(pop_or_op, Zero, Zero);
|
||||||
return;
|
return;
|
||||||
@ -1391,9 +1386,9 @@ c_goal(Term Goal, int mod, int* uncutable)
|
|||||||
int t2 = ArgOfTerm(2, Goal);
|
int t2 = ArgOfTerm(2, Goal);
|
||||||
|
|
||||||
onlast = FALSE;
|
onlast = FALSE;
|
||||||
c_goal(ArgOfTerm(1, Goal), mod, uncutable);
|
c_goal(ArgOfTerm(1, Goal), mod);
|
||||||
onlast = save;
|
onlast = save;
|
||||||
c_goal(t2, mod, uncutable);
|
c_goal(t2, mod);
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
else if (f == FunctorNot || f == FunctorAltNot) {
|
else if (f == FunctorNot || f == FunctorAltNot) {
|
||||||
@ -1417,7 +1412,7 @@ c_goal(Term Goal, int mod, int* uncutable)
|
|||||||
emit_3ops(push_or_op, label, Zero, Zero);
|
emit_3ops(push_or_op, label, Zero, Zero);
|
||||||
emit_3ops(either_op, label, Zero, Zero);
|
emit_3ops(either_op, label, Zero, Zero);
|
||||||
emit(restore_tmps_op, Zero, Zero);
|
emit(restore_tmps_op, Zero, Zero);
|
||||||
c_goal(ArgOfTerm(1, Goal), mod, uncutable);
|
c_goal(ArgOfTerm(1, Goal), mod);
|
||||||
c_var(comitvar, comit_b_flag, 1);
|
c_var(comitvar, comit_b_flag, 1);
|
||||||
onlast = save;
|
onlast = save;
|
||||||
emit(fail_op, end_label, Zero);
|
emit(fail_op, end_label, Zero);
|
||||||
@ -1428,7 +1423,7 @@ c_goal(Term Goal, int mod, int* uncutable)
|
|||||||
onlast = save;
|
onlast = save;
|
||||||
/* --onbranch; */
|
/* --onbranch; */
|
||||||
onbranch = pop_branch();
|
onbranch = pop_branch();
|
||||||
c_goal(MkAtomTerm(AtomTrue), mod, uncutable);
|
c_goal(MkAtomTerm(AtomTrue), mod);
|
||||||
++goalno;
|
++goalno;
|
||||||
emit(pop_or_op, Zero, Zero);
|
emit(pop_or_op, Zero, Zero);
|
||||||
return;
|
return;
|
||||||
@ -1445,10 +1440,10 @@ c_goal(Term Goal, int mod, int* uncutable)
|
|||||||
}
|
}
|
||||||
onlast = FALSE;
|
onlast = FALSE;
|
||||||
c_var(comitvar, save_b_flag, 1);
|
c_var(comitvar, save_b_flag, 1);
|
||||||
c_goal(ArgOfTerm(1, Goal), mod, uncutable);
|
c_goal(ArgOfTerm(1, Goal), mod);
|
||||||
c_var(comitvar, comit_b_flag, 1);
|
c_var(comitvar, comit_b_flag, 1);
|
||||||
onlast = save;
|
onlast = save;
|
||||||
c_goal(ArgOfTerm(2, Goal), mod, uncutable);
|
c_goal(ArgOfTerm(2, Goal), mod);
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
else if (f == FunctorEq) {
|
else if (f == FunctorEq) {
|
||||||
@ -1497,14 +1492,14 @@ c_goal(Term Goal, int mod, int* uncutable)
|
|||||||
}
|
}
|
||||||
else if (op >= _plus && op <= _functor) {
|
else if (op >= _plus && op <= _functor) {
|
||||||
if (op == _functor) {
|
if (op == _functor) {
|
||||||
c_functor(Goal, mod, uncutable);
|
c_functor(Goal, mod);
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
c_bifun(op,
|
c_bifun(op,
|
||||||
ArgOfTerm(1, Goal),
|
ArgOfTerm(1, Goal),
|
||||||
ArgOfTerm(2, Goal),
|
ArgOfTerm(2, Goal),
|
||||||
ArgOfTerm(3, Goal),
|
ArgOfTerm(3, Goal),
|
||||||
mod, uncutable);
|
mod);
|
||||||
}
|
}
|
||||||
if (onlast) {
|
if (onlast) {
|
||||||
emit(deallocate_op, Zero, Zero);
|
emit(deallocate_op, Zero, Zero);
|
||||||
@ -1609,10 +1604,6 @@ c_goal(Term Goal, int mod, int* uncutable)
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
if (p->PredFlags & UnCutAblePredFlag ){
|
|
||||||
(void)(*uncutable)++;
|
|
||||||
}
|
|
||||||
|
|
||||||
if (p->PredFlags & SafePredFlag
|
if (p->PredFlags & SafePredFlag
|
||||||
#ifdef YAPOR
|
#ifdef YAPOR
|
||||||
/* synchronisation means saving the state, so it is never safe in YAPOR */
|
/* synchronisation means saving the state, so it is never safe in YAPOR */
|
||||||
@ -1710,7 +1701,6 @@ get_type_info(Term Goal)
|
|||||||
static void
|
static void
|
||||||
c_body(Term Body, int mod)
|
c_body(Term Body, int mod)
|
||||||
{
|
{
|
||||||
int uncutable=0;
|
|
||||||
onhead = FALSE;
|
onhead = FALSE;
|
||||||
BodyStart = cpc;
|
BodyStart = cpc;
|
||||||
goalno = 1;
|
goalno = 1;
|
||||||
@ -1730,11 +1720,11 @@ c_body(Term Body, int mod)
|
|||||||
Body = ArgOfTerm(1, Body);
|
Body = ArgOfTerm(1, Body);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
c_goal(ArgOfTerm(1, Body), mod, &uncutable);
|
c_goal(ArgOfTerm(1, Body), mod);
|
||||||
Body = t2;
|
Body = t2;
|
||||||
}
|
}
|
||||||
onlast = TRUE;
|
onlast = TRUE;
|
||||||
c_goal(Body, mod, &uncutable);
|
c_goal(Body, mod);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void
|
static void
|
||||||
|
26
C/exec.c
26
C/exec.c
@ -206,6 +206,29 @@ EnterCreepMode(SMALLUNSGN mod) {
|
|||||||
return (CallPredicate(PredSpy, B));
|
return (CallPredicate(PredSpy, B));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* push module inside so that it will visible to the next calls */
|
||||||
|
static Term
|
||||||
|
PushModule(Term t,SMALLUNSGN mod) {
|
||||||
|
Functor f = FunctorOfTerm(t);
|
||||||
|
Term tmod = ModuleName[mod];
|
||||||
|
if (ArityOfFunctor(f) == 2) {
|
||||||
|
Term ti[2], tf[2];
|
||||||
|
ti[0] = tmod;
|
||||||
|
ti[1] = ArgOfTerm(1,t);
|
||||||
|
tf[0] = MkApplTerm(FunctorModule,2,ti);
|
||||||
|
ti[0] = tmod;
|
||||||
|
ti[1] = ArgOfTerm(2,t);
|
||||||
|
tf[1] = MkApplTerm(FunctorModule,2,ti);
|
||||||
|
return(MkApplTerm(f,2,tf));
|
||||||
|
} else {
|
||||||
|
Term ti[2], tf[1];
|
||||||
|
ti[0] = tmod;
|
||||||
|
ti[1] = ArgOfTerm(1,t);
|
||||||
|
tf[0] = MkApplTerm(FunctorModule,2,ti);
|
||||||
|
return(MkApplTerm(f,1,tf));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
inline static Int
|
inline static Int
|
||||||
do_execute(Term t, SMALLUNSGN mod)
|
do_execute(Term t, SMALLUNSGN mod)
|
||||||
{
|
{
|
||||||
@ -241,6 +264,9 @@ do_execute(Term t, SMALLUNSGN mod)
|
|||||||
goto restart_exec;
|
goto restart_exec;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
if (pen->PredFlags & PushModPredFlag) {
|
||||||
|
t = PushModule(t,mod);
|
||||||
|
}
|
||||||
return(CallMetaCall(mod));
|
return(CallMetaCall(mod));
|
||||||
}
|
}
|
||||||
/* now let us do what we wanted to do from the beginning !! */
|
/* now let us do what we wanted to do from the beginning !! */
|
||||||
|
@ -110,7 +110,7 @@ user:goal_expansion(sumlist(Meta, List, AccIn, AccOut), Module, Goal) :-
|
|||||||
(RecursionHead :- Apply, RecursiveCall)
|
(RecursionHead :- Apply, RecursiveCall)
|
||||||
], Module).
|
], Module).
|
||||||
|
|
||||||
user:goal_expansion(mapargs(Meta, In, Out), Module, NewGoal) :-
|
user:goal_expansion(mapargs(Meta, In, Out), _Module, NewGoal) :-
|
||||||
( var(Out)
|
( var(Out)
|
||||||
->
|
->
|
||||||
NewGoal = (
|
NewGoal = (
|
||||||
@ -126,7 +126,7 @@ user:goal_expansion(mapargs(Meta, In, Out), Module, NewGoal) :-
|
|||||||
)
|
)
|
||||||
).
|
).
|
||||||
|
|
||||||
user:goal_expansion(sumargs(Meta, Term, AccIn, AccOut), Module, Goal) :-
|
user:goal_expansion(sumargs(Meta, Term, AccIn, AccOut), _Module, Goal) :-
|
||||||
Goal = (
|
Goal = (
|
||||||
Term =.. [_|TermArgs],
|
Term =.. [_|TermArgs],
|
||||||
sumlist(Meta, TermArgs, AccIn, AccOut)
|
sumlist(Meta, TermArgs, AccIn, AccOut)
|
||||||
|
@ -162,7 +162,7 @@ Inline(IsValProperty, PropFlags, int, flags, (flags == ValProperty) )
|
|||||||
CodeOfPred holds the address of the correspondent C-function.
|
CodeOfPred holds the address of the correspondent C-function.
|
||||||
*/
|
*/
|
||||||
typedef enum {
|
typedef enum {
|
||||||
UnCutAblePredFlag= 0x8000000L, /* Predicate may not be cut */
|
PushModPredFlag = 0x8000000L, /* may need module to be set */
|
||||||
CountPredFlag = 0x4000000L, /* count calls to pred */
|
CountPredFlag = 0x4000000L, /* count calls to pred */
|
||||||
HiddenPredFlag = 0x2000000L, /* invisible predicate */
|
HiddenPredFlag = 0x2000000L, /* invisible predicate */
|
||||||
CArgsPredFlag = 0x1000000L, /* SWI-like C-interface pred. */
|
CArgsPredFlag = 0x1000000L, /* SWI-like C-interface pred. */
|
||||||
|
@ -588,8 +588,7 @@ source_module(Mod) :-
|
|||||||
use_module(:,?),
|
use_module(:,?),
|
||||||
use_module(?,:,?),
|
use_module(?,:,?),
|
||||||
when(?,:),
|
when(?,:),
|
||||||
^(+,:),
|
^(+,:).
|
||||||
\+(:).
|
|
||||||
|
|
||||||
|
|
||||||
%
|
%
|
||||||
|
13
pl/preds.yap
13
pl/preds.yap
@ -630,8 +630,13 @@ hide_predicate(P) :-
|
|||||||
'$hide_predicate2'(PredDesc, M) :-
|
'$hide_predicate2'(PredDesc, M) :-
|
||||||
'$do_error'(type_error(predicate_indicator,T),hide_predicate(M:PredDesc)).
|
'$do_error'(type_error(predicate_indicator,T),hide_predicate(M:PredDesc)).
|
||||||
|
|
||||||
|
'$make_pred_push_mod'(P) :-
|
||||||
|
'$flags'(P,prolog,F,F),
|
||||||
|
NF is F \/ 0x8200000,
|
||||||
|
'$flags'(P,prolog,F,NF).
|
||||||
|
|
||||||
|
:- '$make_pred_push_mod'((_,_)).
|
||||||
|
:- '$make_pred_push_mod'((_;_)).
|
||||||
|
:- '$make_pred_push_mod'((_|_)).
|
||||||
|
:- '$make_pred_push_mod'((_->_)).
|
||||||
|
:- '$make_pred_push_mod'((\+_)).
|
||||||
|
Reference in New Issue
Block a user