diogo
/
yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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:
vsc 2002-10-18 13:54:53 +00:00
parent e19f91db60
commit d21021da0d
6 changed files with 63 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
C/compiler.c
View File

@ -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
View File

@ -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 !! */

4
library/apply_macros.yap
View File

@ -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)

2
m4/Yatom.h.m4
View File

@ -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. */

3
pl/modules.yap
View File

@ -588,8 +588,7 @@ source_module(Mod) :-
use_module(:,?), use_module(:,?),
use_module(?,:,?), use_module(?,:,?),
when(?,:), when(?,:),
^(+,:), ^(+,:).
\+(:).
% %

13
pl/preds.yap
View File

@ -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'((\+_)).