From 52b61e45ed745b9ad578821fd2ad845b399a0bff Mon Sep 17 00:00:00 2001 From: vsc Date: Fri, 2 May 2003 14:37:11 +0000 Subject: [PATCH] fix meta-call handliong of : declarations 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 --- C/absmi.c | 25 ++++++++--- C/exec.c | 125 ---------------------------------------------------- pl/boot.yap | 50 ++++++++++----------- 3 files changed, 44 insertions(+), 156 deletions(-) diff --git a/C/absmi.c b/C/absmi.c index c3f1de5f3..f456259dc 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -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; diff --git a/C/exec.c b/C/exec.c index 680fb6b2d..bec5a1baa 100644 --- a/C/exec.c +++ b/C/exec.c @@ -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); diff --git a/pl/boot.yap b/pl/boot.yap index 2eaf41483..211384720 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -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).