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

correct support for goal expansion (bug report from Paulo Moura)

Browse Source
This commit is contained in:
Vítor Santos Costa 2012-11-07 13:49:54 +00:00
parent 2a737fe22b
commit f74164c642
8 changed files with 121 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

166
C/cdmgr.c
View File

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

1
H/iatoms.h
View File

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

1
H/ratoms.h
View File

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

2
H/tatoms.h
View File

@ -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_;

1
misc/ATOMS
View File

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

2
pl/boot.yap
View File

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

8
pl/init.yap
View File

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

1
pl/modules.yap
View File

@ -351,7 +351,6 @@ expand_goal(G, G).
->
true
;
recorded('$dialect',swi,_),
'$pred_exists'(goal_expansion(G,GI), system),
system:goal_expansion(G, GI)
->