strip_module should try to always return a valid module

This commit is contained in:
Vitor Santos Costa 2014-02-09 10:46:43 +00:00
parent f26cb133b9
commit 8d8a4104b9

View File

@ -249,26 +249,15 @@ init_current_module( USES_REGS1 )
static Int static Int
p_strip_module( USES_REGS1 ) p_strip_module( USES_REGS1 )
{ {
Term t1 = Deref(ARG1), t2, tmod = CurrentModule; Term t1 = Deref(ARG1), tmod = CurrentModule;
if (tmod == PROLOG_MODULE) { if (tmod == PROLOG_MODULE) {
tmod = TermProlog; tmod = TermProlog;
} }
if (IsVarTerm(t1) || t1 = Yap_StripModule( t1, &tmod );
!IsApplTerm(t1) || if (!t1) {
FunctorOfTerm(t1) != FunctorModule || Yap_Error(TYPE_ERROR_CALLABLE,ARG1,"trying to obtain module");
IsVarTerm(t2 = ArgOfTerm(1,t1)) || return FALSE;
!IsAtomTerm(t2)) {
return Yap_unify(ARG3, t1) &&
Yap_unify(ARG2, tmod);
} }
do {
tmod = t2;
t1 = ArgOfTerm(2,t1);
} while (!IsVarTerm(t1) &&
IsApplTerm(t1) &&
FunctorOfTerm(t1) == FunctorModule &&
!IsVarTerm(t2 = ArgOfTerm(1,t1)) &&
IsAtomTerm(t2));
return Yap_unify(ARG3, t1) && return Yap_unify(ARG3, t1) &&
Yap_unify(ARG2, tmod); Yap_unify(ARG2, tmod);
} }
@ -303,11 +292,17 @@ Yap_StripModule(Term t, Term *modp)
if (modp) if (modp)
tmod = *modp; tmod = *modp;
else else {
tmod = CurrentModule; tmod = CurrentModule;
if (tmod == PROLOG_MODULE) {
tmod = TermProlog;
}
}
restart: restart:
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
return 0L; if (modp)
*modp = tmod;
return t;
} else if (IsAtomTerm(t) || IsPairTerm(t)) { } else if (IsAtomTerm(t) || IsPairTerm(t)) {
if (modp) if (modp)
*modp = tmod; *modp = tmod;
@ -315,11 +310,13 @@ Yap_StripModule(Term t, Term *modp)
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t); Functor fun = FunctorOfTerm(t);
if (fun == FunctorModule) { if (fun == FunctorModule) {
tmod = ArgOfTerm(1, t); Term t1 = ArgOfTerm(1, t);
if (IsVarTerm(tmod) ) { if (IsVarTerm( t1 ) ) {
return 0L; *modp = tmod;
return t;
} }
if (!IsAtomTerm(tmod) ) { tmod = t1;
if (!IsVarTerm(tmod) && !IsAtomTerm(tmod) ) {
return 0L; return 0L;
} }
t = ArgOfTerm(2, t); t = ArgOfTerm(2, t);