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

fix meta-call handliong of : declarations

Browse Source 
get rid of execute_within, we've got enough confusion around already.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@825 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2003-05-02 14:37:11 +00:00
parent 6e17ac0070
commit 52b61e45ed
3 changed files with 44 additions and 156 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
C/absmi.c
View File

@ -10208,7 +10208,7 @@ Yap_absmi(int inp)
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
RESET_VARIABLE(H);
H[1] = XREG(PREG->u.ycx.c);
H[1] = PREG->u.ycx.c;
H[2] = XREG(PREG->u.ycx.xi);
low_level_trace(enter_pred,RepPredProp(Yap_GetPredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("functor"),3),0)),H);
}
@ -11077,8 +11077,7 @@ Yap_absmi(int inp)
#else
if (E_YREG > (CELL *)B) {
E_YREG = (CELL *)B;
}
else {
} else {
E_YREG = (CELL *) ((CELL) E_YREG+ ENV_Size(CPREG));
}
#endif /* FROZEN_STACKS */
@ -11089,6 +11088,7 @@ Yap_absmi(int inp)
SREG = RepAppl(d0);
BEGD(d1);
d1 = SREG[2];
execute_comma_comma:
/* create an to execute the call */
deref_head(d1, execute_comma_comma_unk);
execute_comma_comma_nvar:
@ -11097,8 +11097,15 @@ Yap_absmi(int inp)
E_YREG[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByAtom(AtomOfTerm(d1),mod));
} else if (IsApplTerm(d1)) {
Functor f = FunctorOfTerm(d1);
if (IsExtensionFunctor(f) || f == FunctorModule) {
if (IsExtensionFunctor(f)) {
goto execute_metacall_after_comma;
} else if (f == FunctorModule) {
Term tmod = ArgOfTerm(1, d1);
if (IsVarTerm(tmod) || !IsAtomTerm(tmod))
goto execute_metacall_after_comma;
mod = Yap_LookupModule(tmod);
d1 = RepAppl(d1)[2];
goto execute_comma_comma;
} else {
E_YREG[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByFunc(f,mod));
}
@ -11116,6 +11123,7 @@ Yap_absmi(int inp)
E_YREG -= EnvSizeInCells+3;
d0 = SREG[1];
CPREG = NEXTOP(COMMA_CODE,sla);
execute_comma_comma2:
/* create an to execute the call */
deref_head(d0, execute_comma_comma2_unk);
execute_comma_comma2_nvar:
@ -11144,7 +11152,12 @@ Yap_absmi(int inp)
} else if (IsApplTerm(d0)) {
Functor f = FunctorOfTerm(d0);
if (IsExtensionFunctor(f) || f == FunctorModule) {
goto execute_metacall_after_comma;
Term tmod = ArgOfTerm(1, d0);
if (IsVarTerm(tmod) || !IsAtomTerm(tmod))
goto execute_metacall_after_comma;
mod = Yap_LookupModule(tmod);
d0 = RepAppl(d0)[2];
goto execute_comma_comma2;
} else {
pen = RepPredProp(PredPropByFunc(f,mod));
if (pen->PredFlags & MetaPredFlag) {
@ -11177,7 +11190,7 @@ Yap_absmi(int inp)
execute_metacall_after_comma:
ARG1 = ARG3 = d0;
pen = PredMetaCall;
ARG2 = Yap_cp_as_integer((choiceptr)ENV[E_CB]);
ARG2 = Yap_cp_as_integer((choiceptr)pt0[E_CB]);
ARG4 = ModuleName[mod];
CACHE_A1();
goto execute_after_comma;

125
C/exec.c
View File

@ -331,130 +331,6 @@ p_execute_in_mod(void)
return(do_execute(Deref(ARG1), IntOfTerm(Deref(ARG2))));
}
inline static Int
CallMetaCallWithin(SMALLUNSGN mod, choiceptr cpt)
{
if (yap_flags[SPY_CREEP_FLAG]) {
return(EnterCreepMode(mod));
}
return (CallPredicate(PredMetaCall, cpt));
}
/* '$execute_within'(Goal,CutPt,OrigGoal,Mod) */
static Int
p_execute_within(void)
{
Term t = Deref(ARG1);
Term tmod = Deref(ARG4);
unsigned int arity;
Prop pe;
Atom a;
SMALLUNSGN mod = Yap_LookupModule(tmod);
#ifdef SBA
choiceptr cut_pt = (choiceptr)IntegerOfTerm(Deref(ARG2));
#else
choiceptr cut_pt = (choiceptr)(LCL0-IntegerOfTerm(Deref(ARG2)));
#endif
restart_exec:
if (IsVarTerm(t)) {
return CallError(INSTANTIATION_ERROR, mod);
} else if (IsApplTerm(t)) {
register Functor f = FunctorOfTerm(t);
register unsigned int i;
register CELL *pt;
if (IsExtensionFunctor(f)) {
return CallError(TYPE_ERROR_CALLABLE, mod);
}
{
PredEntry *pen;
arity = ArityOfFunctor(f);
a = NameOfFunctor(f);
pe = PredPropByFunc(f, mod);
pen = RepPredProp(pe);
/* You thought we would be over by now */
/* but no meta calls require special preprocessing */
if (pen->PredFlags & MetaPredFlag) {
if (f == FunctorModule) {
Term tmod = ArgOfTerm(1,t);
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
mod = Yap_LookupModule(tmod);
t = ArgOfTerm(2,t);
goto restart_exec;
}
}
if (mod != CurrentModule)
return(CallMetaCallWithin(mod, B));
}
/* at this point check if we should enter creep mode */
if (yap_flags[SPY_CREEP_FLAG]) {
return(EnterCreepMode(mod));
} else if (PRED_GOAL_EXPANSION_ON) {
return(CallMetaCallWithin(mod, B));
} else {
/* now let us do what we wanted to do from the beginning !! */
/* I cannot use the standard macro here because
otherwise I would dereference the argument and
might skip a svar */
pt = RepAppl(t)+1;
for (i = 1; i <= arity; ++i) {
#if SBA
Term d0 = *pt++;
if (d0 == 0)
XREGS[i] = (CELL)(pt-1);
else
XREGS[i] = d0;
#else
XREGS[i] = *pt++;
#endif
}
return (CallPredicate(pen, B));
}
}
} else if (IsAtomOrIntTerm(t)) {
if (IsIntTerm(t)) {
return CallError(TYPE_ERROR_CALLABLE, mod);
}
a = AtomOfTerm(t);
if (a == AtomTrue || a == AtomOtherwise)
return(TRUE);
else if (a == AtomCut) {
/* find where to cut to */
if (SHOULD_CUT_UP_TO(B,cut_pt)) {
#ifdef YAPOR
/* Wow, we're gonna cut!!! */
CUT_prune_to(cut_pt);
#else
/* Wow, we're gonna cut!!! */
B = cut_pt;
#endif /* YAPOR */
#ifdef TABLING
abolish_incomplete_subgoals(B);
#endif /* TABLING */
HB = PROTECT_FROZEN_H(B);
}
return(TRUE);
} else if (a == AtomFail || a == AtomFalse) {
return(FALSE);
} else {
/* call may not define new system predicates!! */
if (yap_flags[SPY_CREEP_FLAG]) {
return(EnterCreepMode(mod));
} else if (PRED_GOAL_EXPANSION_ON) {
return(CallMetaCallWithin(mod, B));
}
pe = PredPropByAtom(a, mod);
return (CallPredicate(RepPredProp(pe), B));
}
} else {
/* Is Pair Term */
return(CallMetaCallWithin(mod,B));
}
}
static Int
p_execute0(void)
{ /* '$execute0'(Goal,Mod) */
@ -1722,7 +1598,6 @@ Yap_InitExecFs(void)
Yap_InitComma();
Yap_InitCPred("$execute", 1, p_execute, 0);
Yap_InitCPred("$execute_in_mod", 2, p_execute_in_mod, 0);
Yap_InitCPred("$execute_within", 4, p_execute_within, 0);
Yap_InitCPred("$execute", 3, p_at_execute, 0);
Yap_InitCPred("$call_with_args", 2, p_execute_0, 0);
Yap_InitCPred("$call_with_args", 3, p_execute_1, 0);

50
pl/boot.yap
View File

@ -693,41 +693,41 @@ incore(G) :- '$execute'(G).
'$call'(M:G,CP,G0,_) :- !,
'$call'(G,CP,G0,M).
'$call'((X,Y),CP,G0,M) :- !,
'$execute_within'(X,CP,G0,M),
'$execute_within'(Y,CP,G0,M).
'$call'(X,CP,G0,M),
'$call'(Y,CP,G0,M).
'$call'((X->Y),CP,G0,M) :- !,
(
'$execute_within'(X,CP,G0,M)
'$call'(X,CP,G0,M)
->
'$execute_within'(Y,CP,G0,M)
'$call'(Y,CP,G0,M)
).
'$call'((X->Y; Z),CP,G0,M) :- !,
(
'$execute_within'(X,CP,G0,M)
'$call'(X,CP,G0,M)
->
'$execute_within'(Y,CP,G0,M)
'$call'(Y,CP,G0,M)
;
'$execute_within'(Z,CP,G0,M)
'$call'(Z,CP,G0,M)
).
'$call'((A;B),CP,G0,M) :- !,
(
'$execute_within'(A,CP,G0,M)
'$call'(A,CP,G0,M)
;
'$execute_within'(B,CP,G0,M)
'$call'(B,CP,G0,M)
).
'$call'((X->Y| Z),CP,G0,M) :- !,
(
'$execute_within'(X,CP,G0,M)
'$call'(X,CP,G0,M)
->
'$execute_within'(Y,CP,G0,M)
'$call'(Y,CP,G0,M)
;
'$execute_within'(Z,CP,G0,M)
'$call'(Z,CP,G0,M)
).
'$call'((A|B),CP, G0,M) :- !,
(
'$execute_within'(A,CP,G0,M)
'$call'(A,CP,G0,M)
;
'$execute_within'(B,CP,G0,M)
'$call'(B,CP,G0,M)
).
'$call'(\+ X, _, _,_) :- !,
\+ '$execute'(X).
@ -754,33 +754,33 @@ incore(G) :- '$execute'(G).
'$execute0'(NG, NMod).
'$spied_call'((A,B),CP,G0,M) :- !,
'$execute_within'(A,CP,G0,M),
'$execute_within'(B,CP,G0,M).
'$call'(A,CP,G0,M),
'$call'(B,CP,G0,M).
'$spied_call'((X->Y),CP,G0,M) :- !,
(
'$execute_within'(X,CP,G0,M)
'$call'(X,CP,G0,M)
->
'$execute_within'(Y,CP,G0,M)
'$call'(Y,CP,G0,M)
).
'$spied_call'((X->Y; Z),CP,G0,M) :- !,
(
'$execute_within'(X,CP,G0,M)
'$call'(X,CP,G0,M)
->
'$execute_within'(Y,CP,G0,M)
'$call'(Y,CP,G0,M)
;
'$execute_within'(Z,CP,G0,M)
'$call'(Z,CP,G0,M)
).
'$spied_call'((A;B),CP,G0,M) :- !,
(
'$execute_within'(A,CP,G0,M)
'$call'(A,CP,G0,M)
;
'$execute_within'(B,CP,G0,M)
'$call'(B,CP,G0,M)
).
'$spied_call'((A|B),CP,G0,M) :- !,
(
'$execute_within'(A,CP,G0,M)
'$call'(A,CP,G0,M)
;
'$execute_within'(B,CP,G0,M)
'$call'(B,CP,G0,M)
).
'$spied_call'(\+ X,_,_,M) :- !,
\+ '$execute'(M:X).