diff --git a/C/cdmgr.c b/C/cdmgr.c index aa4816431..7e493d43d 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -1656,7 +1656,7 @@ add_first_static(PredEntry *p, yamop *cp, int spy_flag) yamop *pt = cp; if (is_logupd(p)) { - if (p == PredGoalExpansion) { + if (p == PredGoalExpansion || p->FunctorOfPred == FunctorGoalExpansion2) { PRED_GOAL_EXPANSION_ON = TRUE; Yap_InitComma(); } @@ -1711,7 +1711,7 @@ add_first_dynamic(PredEntry *p, yamop *cp, int spy_flag) { yamop *ncp = ((DynamicClause *)NULL)->ClCode; DynamicClause *cl; - if (p == PredGoalExpansion) { + if (p == PredGoalExpansion || p->FunctorOfPred == FunctorGoalExpansion2) { PRED_GOAL_EXPANSION_ON = TRUE; Yap_InitComma(); } @@ -2093,6 +2093,7 @@ mark_preds_with_this_func(Functor f, Prop p0) for (i = 0; i < PredHashTableSize; i++) { PredEntry *p = PredHash[i]; + /* search the whole pred table, kind of inneficient */ while (p) { Prop nextp = p->NextOfPE; if (p->FunctorOfPred == f) @@ -2102,6 +2103,109 @@ mark_preds_with_this_func(Functor f, Prop p0) } } +static void +mark_preds_with_this_atom(Prop p) +{ + while (p) { + Prop nextp = p->NextOfPE; + if (p->KindOfPE == PEProp) + RepPredProp(p)->PredFlags |= GoalExPredFlag; + p = nextp; + } +} + +static void +goal_expansion_support(PredEntry *p, Term tf) +{ + if (p == PredGoalExpansion) { + Term tg = ArgOfTerm(1, tf); + Term tm = ArgOfTerm(2, tf); + + if (IsVarTerm(tg) || IsVarTerm(tm)) { + if (!IsVarTerm(tg)) { + /* this is the complicated case, first I need to inform + predicates for this functor */ + PRED_GOAL_EXPANSION_FUNC = TRUE; + if (IsAtomTerm(tg)) { + AtomEntry *ae = RepAtom(AtomOfTerm(tg)); + Prop p0 = ae->PropsOfAE; + int found = FALSE; + + while (p0) { + PredEntry *pe = RepPredProp(p0); + if (pe->KindOfPE == PEProp) { + pe->PredFlags |= GoalExPredFlag; + found = TRUE; + } + p0 = pe->NextOfPE; + } + if (!found) { + PredEntry *npe = RepPredProp(PredPropByAtom(AtomOfTerm(tg),IDB_MODULE)); + npe->PredFlags |= GoalExPredFlag; + } + } else if (IsApplTerm(tg)) { + FunctorEntry *fe = (FunctorEntry *)FunctorOfTerm(tg); + Prop p0; + + p0 = fe->PropsOfFE; + if (p0) { + mark_preds_with_this_func(FunctorOfTerm(tg), p0); + } else { + Term mod = CurrentModule; + PredEntry *npe; + if (CurrentModule == PROLOG_MODULE) + mod = IDB_MODULE; + npe = RepPredProp(PredPropByFunc(fe,mod)); + npe->PredFlags |= GoalExPredFlag; + } + } + } else { + PRED_GOAL_EXPANSION_ALL = TRUE; + } + } else { + if (IsAtomTerm(tm)) { + if (IsAtomTerm(tg)) { + PredEntry *p = RepPredProp(PredPropByAtom(AtomOfTerm(tg), tm)); + p->PredFlags |= GoalExPredFlag; + } else if (IsApplTerm(tg)) { + PredEntry *p = RepPredProp(PredPropByFunc(FunctorOfTerm(tg), tm)); + p->PredFlags |= GoalExPredFlag; + } + } + } + } else if (p->FunctorOfPred == FunctorGoalExpansion2) { + Term tg = ArgOfTerm(1, tf); + + if (IsVarTerm(tg)) { + PRED_GOAL_EXPANSION_ALL = TRUE; + } else if (IsApplTerm(tg)) { + FunctorEntry *fe = (FunctorEntry *)FunctorOfTerm(tg); + Prop p0; + PredEntry *npe; + + p0 = fe->PropsOfFE; + if (p0 && (p->ModuleOfPred == PROLOG_MODULE || p->ModuleOfPred == SYSTEM_MODULE || p->ModuleOfPred == USER_MODULE)) { + mark_preds_with_this_func(fe, p0); + PRED_GOAL_EXPANSION_FUNC = TRUE; + } + npe = RepPredProp(PredPropByFunc(fe,p->ModuleOfPred)); + npe->PredFlags |= GoalExPredFlag; + } else if (IsAtomTerm(tg)) { + Atom at = AtomOfTerm(tg); + Prop p0; + PredEntry *npe; + + p0 = RepAtom(at)->PropsOfAE; + if (p0 && (p->ModuleOfPred == PROLOG_MODULE || p->ModuleOfPred == SYSTEM_MODULE || p->ModuleOfPred == USER_MODULE)) { + mark_preds_with_this_atom(p0); + PRED_GOAL_EXPANSION_FUNC = TRUE; + } + npe = RepPredProp(PredPropByAtom(at,p->ModuleOfPred)); + npe->PredFlags |= GoalExPredFlag; + } + } +} + static int addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref) /* @@ -2158,63 +2262,7 @@ addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref) } if (pflags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) spy_flag = TRUE; - if (p == PredGoalExpansion) { - Term tg = ArgOfTerm(1, tf); - Term tm = ArgOfTerm(2, tf); - - if (IsVarTerm(tg) || IsVarTerm(tm)) { - if (!IsVarTerm(tg)) { - /* this is the complicated case, first I need to inform - predicates for this functor */ - PRED_GOAL_EXPANSION_FUNC = TRUE; - if (IsAtomTerm(tg)) { - AtomEntry *ae = RepAtom(AtomOfTerm(tg)); - Prop p0 = ae->PropsOfAE; - int found = FALSE; - - while (p0) { - PredEntry *pe = RepPredProp(p0); - if (pe->KindOfPE == PEProp) { - pe->PredFlags |= GoalExPredFlag; - found = TRUE; - } - p0 = pe->NextOfPE; - } - if (!found) { - PredEntry *npe = RepPredProp(PredPropByAtom(AtomOfTerm(tg),IDB_MODULE)); - npe->PredFlags |= GoalExPredFlag; - } - } else if (IsApplTerm(tg)) { - FunctorEntry *fe = (FunctorEntry *)FunctorOfTerm(tg); - Prop p0; - - p0 = fe->PropsOfFE; - if (p0) { - mark_preds_with_this_func(FunctorOfTerm(tg), p0); - } else { - Term mod = CurrentModule; - PredEntry *npe; - if (CurrentModule == PROLOG_MODULE) - mod = IDB_MODULE; - npe = RepPredProp(PredPropByFunc(fe,mod)); - npe->PredFlags |= GoalExPredFlag; - } - } - } else { - PRED_GOAL_EXPANSION_ALL = TRUE; - } - } else { - if (IsAtomTerm(tm)) { - if (IsAtomTerm(tg)) { - PredEntry *p = RepPredProp(PredPropByAtom(AtomOfTerm(tg), tm)); - p->PredFlags |= GoalExPredFlag; - } else if (IsApplTerm(tg)) { - PredEntry *p = RepPredProp(PredPropByFunc(FunctorOfTerm(tg), tm)); - p->PredFlags |= GoalExPredFlag; - } - } - } - } + goal_expansion_support(p, tf); if (mode == consult) not_was_reconsulted(p, t, TRUE); /* always check if we have a valid error first */ diff --git a/H/iatoms.h b/H/iatoms.h index 4bc8ff0d9..c437cfa05 100644 --- a/H/iatoms.h +++ b/H/iatoms.h @@ -384,6 +384,7 @@ FunctorGPrimitive = Yap_MkFunctor(AtomPrimitive,1); FunctorGVar = Yap_MkFunctor(AtomGVar,1); FunctorGeneratePredInfo = Yap_MkFunctor(AtomGeneratePredInfo,4); + FunctorGoalExpansion2 = Yap_MkFunctor(AtomGoalExpansion,2); FunctorGoalExpansion = Yap_MkFunctor(AtomGoalExpansion,3); FunctorHandleThrow = Yap_MkFunctor(AtomHandleThrow,3); FunctorId = Yap_MkFunctor(AtomId,1); diff --git a/H/ratoms.h b/H/ratoms.h index 28dd9816b..64e3251b6 100644 --- a/H/ratoms.h +++ b/H/ratoms.h @@ -384,6 +384,7 @@ FunctorGPrimitive = FuncAdjust(FunctorGPrimitive); FunctorGVar = FuncAdjust(FunctorGVar); FunctorGeneratePredInfo = FuncAdjust(FunctorGeneratePredInfo); + FunctorGoalExpansion2 = FuncAdjust(FunctorGoalExpansion2); FunctorGoalExpansion = FuncAdjust(FunctorGoalExpansion); FunctorHandleThrow = FuncAdjust(FunctorHandleThrow); FunctorId = FuncAdjust(FunctorId); diff --git a/H/tatoms.h b/H/tatoms.h index 0538f30f5..a996ce74d 100644 --- a/H/tatoms.h +++ b/H/tatoms.h @@ -766,6 +766,8 @@ #define FunctorGVar Yap_heap_regs->FunctorGVar_ Functor FunctorGeneratePredInfo_; #define FunctorGeneratePredInfo Yap_heap_regs->FunctorGeneratePredInfo_ + Functor FunctorGoalExpansion2_; +#define FunctorGoalExpansion2 Yap_heap_regs->FunctorGoalExpansion2_ Functor FunctorGoalExpansion_; #define FunctorGoalExpansion Yap_heap_regs->FunctorGoalExpansion_ Functor FunctorHandleThrow_; diff --git a/misc/ATOMS b/misc/ATOMS index 337c89b99..15e8e5ec5 100644 --- a/misc/ATOMS +++ b/misc/ATOMS @@ -389,6 +389,7 @@ F GNumber Number 1 F GPrimitive Primitive 1 F GVar GVar 1 F GeneratePredInfo GeneratePredInfo 4 +F GoalExpansion2 GoalExpansion 2 F GoalExpansion GoalExpansion 3 F HandleThrow HandleThrow 3 F Id Id 1 diff --git a/pl/boot.yap b/pl/boot.yap index d67a0594f..d74d72ad6 100755 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -903,7 +903,7 @@ not(G) :- \+ '$execute'(G). '$call'(G, CP, G0, CurMod) :- ( '$is_expand_goal_or_meta_predicate'(G,CurMod) -> ( - '$notrace'(user:goal_expansion(G, CurMod, NG)) -> + '$notrace'((CurMod:goal_expansion(G,NG) ; system:goal_expansion(G,NG) ; user:goal_expansion(G, CurMod, NG) ; user:goal_expansion(G,NG) )) -> '$call'(NG, CP, G0,CurMod) ; % repeat other code. diff --git a/pl/init.yap b/pl/init.yap index b3f2b8c05..00687a336 100755 --- a/pl/init.yap +++ b/pl/init.yap @@ -201,6 +201,14 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP). :- dynamic goal_expansion/3. +:- multifile goal_expansion/2. + +:- dynamic goal_expansion/2. + +:- multifile system:goal_expansion/2. + +:- dynamic system:goal_expansion/2. + :- multifile user:prolog_file_type/2. :- dynamic user:prolog_file_type/2. diff --git a/pl/modules.yap b/pl/modules.yap index abb924748..0ed5cc880 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -351,7 +351,6 @@ expand_goal(G, G). -> true ; - recorded('$dialect',swi,_), '$pred_exists'(goal_expansion(G,GI), system), system:goal_expansion(G, GI) ->