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

undefined predicate handling fixes

Browse Source 
obey the flag
This commit is contained in:
Vítor Santos Costa 2016-02-22 12:55:05 +00:00
parent c7049b5467
commit 98bd9d7400
5 changed files with 61 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
C/absmi.c
View File

@ -1364,6 +1364,10 @@ static void
undef_goal( USES_REGS1 ) undef_goal( USES_REGS1 )
{ {
PredEntry *pe = PredFromDefCode(P); PredEntry *pe = PredFromDefCode(P);
if (Yap_UnknownFlag(CurrentModule) == TermFail) {
P = FAILCODE;
return;
}
BEGD(d0); BEGD(d0);
/* avoid trouble with undefined dynamic procedures */ /* avoid trouble with undefined dynamic procedures */
/* I assume they were not locked beforehand */ /* I assume they were not locked beforehand */
@ -1373,9 +1377,7 @@ undef_goal( USES_REGS1 )
PP = pe; PP = pe;
} }
#endif #endif
if ((pe->PredFlags & (DynamicPredFlag|LogUpdatePredFlag|MultiFileFlag)) || if (pe->PredFlags & (DynamicPredFlag|LogUpdatePredFlag|MultiFileFlag)) {
CurrentModule == PROLOG_MODULE ||
(UndefCode->OpcodeOfPred == UNDEF_OPCODE)) {
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
UNLOCKPE(19,PP); UNLOCKPE(19,PP);
PP = NULL; PP = NULL;

59
C/flags.c
View File

@ -613,8 +613,8 @@ static bool sys_thread_id(Term inp) {
static bool setYapFlagInModule(Term tflag, Term t2, Term mod) { static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
CACHE_REGS CACHE_REGS
FlagEntry *fv; FlagEntry *fv;
ModEntry *new = Yap_GetModuleEntry(mod); ModEntry *me = Yap_GetModuleEntry(mod);
if (!new) if (!me)
return false; return false;
fv = GetFlagProp(AtomOfTerm(tflag)); fv = GetFlagProp(AtomOfTerm(tflag));
if (!fv && !fv->global) { if (!fv && !fv->global) {
@ -641,18 +641,18 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
// module specific stuff now // module specific stuff now
if (fv->FlagOfVE == UNKNOWN_FLAG) { if (fv->FlagOfVE == UNKNOWN_FLAG) {
new->flags &= ~(UNKNOWN_MASK); me->flags &= ~(UNKNOWN_MASK);
if (t2 == TermError) { if (t2 == TermError) {
new->flags |= (UNKNOWN_ERROR); me->flags |= (UNKNOWN_ERROR);
return true; return true;
} else if (t2 == TermFail) { } else if (t2 == TermFail) {
new->flags |= (UNKNOWN_FAIL); me->flags |= (UNKNOWN_FAIL);
return true; return true;
} else if (t2 == TermWarning) { } else if (t2 == TermWarning) {
new->flags |= (UNKNOWN_WARNING); me->flags |= (UNKNOWN_WARNING);
return true; return true;
} else if (t2 == TermFastFail) { } else if (t2 == TermFastFail) {
new->flags |= (UNKNOWN_FAST_FAIL); me->flags |= (UNKNOWN_FAST_FAIL);
return true; return true;
} }
Yap_Error( Yap_Error(
@ -661,13 +661,13 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
RepAtom(AtomOfTerm(tflag))->StrOfAE); RepAtom(AtomOfTerm(tflag))->StrOfAE);
return false; return false;
} else if (fv->FlagOfVE == DOUBLE_QUOTES_FLAG) { } else if (fv->FlagOfVE == DOUBLE_QUOTES_FLAG) {
return dqf1(new, t2 PASS_REGS); return dqf1(me, t2 PASS_REGS);
} else if (fv->FlagOfVE == CHARACTER_ESCAPES_FLAG) { } else if (fv->FlagOfVE == CHARACTER_ESCAPES_FLAG) {
if (t2 == TermTrue) { if (t2 == TermTrue) {
new->flags |= M_CHARESCAPE; me->flags |= M_CHARESCAPE;
return true; return true;
} else if (t2 == TermFalse) { } else if (t2 == TermFalse) {
new->flags &= ~(M_CHARESCAPE); me->flags &= ~(M_CHARESCAPE);
return true; return true;
} }
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2,
@ -675,7 +675,7 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
RepAtom(AtomOfTerm(tflag))->StrOfAE); RepAtom(AtomOfTerm(tflag))->StrOfAE);
return false; return false;
} else if (fv->FlagOfVE == BACKQUOTED_STRING_FLAG) { } else if (fv->FlagOfVE == BACKQUOTED_STRING_FLAG) {
return bqf1(new, t2 PASS_REGS); return bqf1(me, t2 PASS_REGS);
; ;
} }
// bad key? // bad key?
@ -684,7 +684,7 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
static Term getYapFlagInModule(Term tflag, Term mod) { static Term getYapFlagInModule(Term tflag, Term mod) {
FlagEntry *fv; FlagEntry *fv;
ModEntry *new = Yap_GetModuleEntry(mod); ModEntry *me = Yap_GetModuleEntry(mod);
if (!mod) if (!mod)
return false; return false;
fv = GetFlagProp(AtomOfTerm(tflag)); fv = GetFlagProp(AtomOfTerm(tflag));
@ -695,28 +695,28 @@ static Term getYapFlagInModule(Term tflag, Term mod) {
// module specific stuff now // module specific stuff now
if (fv->FlagOfVE == UNKNOWN_FLAG) { if (fv->FlagOfVE == UNKNOWN_FLAG) {
if (new->flags & UNKNOWN_ERROR) if (me->flags & UNKNOWN_ERROR)
return TermError; return TermError;
if (new->flags & UNKNOWN_WARNING) if (me->flags & UNKNOWN_WARNING)
return TermWarning; return TermWarning;
return TermFail; return TermFail;
} else if (fv->FlagOfVE == CHARACTER_ESCAPES_FLAG) { } else if (fv->FlagOfVE == CHARACTER_ESCAPES_FLAG) {
if (new->flags & M_CHARESCAPE) if (me->flags & M_CHARESCAPE)
return TermTrue; return TermTrue;
} else if (fv->FlagOfVE == BACKQUOTED_STRING_FLAG) { } else if (fv->FlagOfVE == BACKQUOTED_STRING_FLAG) {
if (new->flags & BCKQ_CHARS) if (me->flags & BCKQ_CHARS)
return TermChars; return TermChars;
if (new->flags & BCKQ_CODES) if (me->flags & BCKQ_CODES)
return TermCodes; return TermCodes;
if (new->flags & BCKQ_ATOM) if (me->flags & BCKQ_ATOM)
return TermAtom; return TermAtom;
return TermString; return TermString;
} else if (fv->FlagOfVE == DOUBLE_QUOTES_FLAG) { } else if (fv->FlagOfVE == DOUBLE_QUOTES_FLAG) {
if (new->flags & DBLQ_CHARS) if (me->flags & DBLQ_CHARS)
return TermChars; return TermChars;
if (new->flags & DBLQ_CODES) if (me->flags & DBLQ_CODES)
return TermCodes; return TermCodes;
if (new->flags & DBLQ_ATOM) if (me->flags & DBLQ_ATOM)
return TermAtom; return TermAtom;
return TermString; return TermString;
} }
@ -1012,6 +1012,21 @@ bool setYapFlag(Term tflag, Term t2) {
return true; return true;
} }
Term Yap_UnknownFlag(Term mod) {
if (mod == PROLOG_MODULE)
mod = TermProlog;
ModEntry *fv = Yap_GetModuleEntry(mod);
if (fv == NULL)
fv = Yap_GetModuleEntry(AtomUser);
if (fv->flags & UNKNOWN_ERROR)
return TermError;
if (fv->flags & UNKNOWN_WARNING)
return TermWarning;
return TermFail;
}
Term getYapFlag(Term tflag) { Term getYapFlag(Term tflag) {
FlagEntry *fv; FlagEntry *fv;
flag_term *tarr; flag_term *tarr;
@ -1043,7 +1058,7 @@ Term getYapFlag(Term tflag) {
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, fl, "trying to read unknown flag %s", Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, fl, "trying to read unknown flag %s",
RepAtom(AtomOfTerm(fl))->StrOfAE); RepAtom(AtomOfTerm(fl))->StrOfAE);
} }
return FALSE; return false;
} }
if (fv->global) if (fv->global)
tarr = GLOBAL_Flags; tarr = GLOBAL_Flags;

2
H/YapFlags.h
View File

@ -359,6 +359,8 @@ static inline Term gcTrace(void) {
return GLOBAL_Flags[GC_TRACE_FLAG].at; return GLOBAL_Flags[GC_TRACE_FLAG].at;
} }
Term Yap_UnknownFlag(Term mod);
bool rmdot(Term inp); bool rmdot(Term inp);
xarg *Yap_ArgListToVector(Term listl, const param_t *def, int n); xarg *Yap_ArgListToVector(Term listl, const param_t *def, int n);

26
pl/boot.yap
View File

@ -257,11 +257,9 @@ private(_).
'$early_print_message'(_, absolute_file_path(X, Y)) :- !, '$early_print_message'(_, absolute_file_path(X, Y)) :- !,
format(user_error, X, Y), nl(user_error). format(user_error, X, Y), nl(user_error).
'$early_print_message'(_, loading( C, F)) :- !, '$early_print_message'(_, loading( C, F)) :- !,
'$show_consult_level'(LC), format(user_error, '~*|% ~a ~w...~n', [2,C,F]).
format(user_error, '~*|% ~a ~w...~n', [LC,C,F]).
'$early_print_message'(_, loaded(F,C,M,T,H)) :- !, '$early_print_message'(_, loaded(F,C,M,T,H)) :- !,
'$show_consult_level'(LC), format(user_error, '~*|% ~a:~w ~a ~d bytes in ~d seconds...~n', [2, M, F ,C, H, T]).
format(user_error, '~*|% ~a:~w ~a ~d bytes in ~d seconds...~n', [LC, M, F ,C, H, T]).
'$early_print_message'(Level, Msg) :- '$early_print_message'(Level, Msg) :-
source_location(F0, L), source_location(F0, L),
!, !,
@ -269,23 +267,24 @@ private(_).
'$early_print_message'(Level, Msg) :- '$early_print_message'(Level, Msg) :-
format(user_error, 'unprocessed ~a ~w ~n', [Level,Msg]). format(user_error, 'unprocessed ~a ~w ~n', [Level,Msg]).
'$exceptional_cases'(_:print_message(Context, Msg)) :- '$handle_error'(_Action,_G0,_M0) :- fail.
'$early_print_message'(Context, Msg).
% cases where we cannot afford to ever fail.
'$undefp'([_|print_message(Context, Msg)], true) :- !,
'$early_print_message'(Context, Msg).
% undef handler
'$undefp'([M0|G0], Action) :- '$undefp'([M0|G0], Action) :-
% make sure we do not loop on undefined predicates % make sure we do not loop on undefined predicates
'$stop_creeping'(Current), '$stop_creeping'(Current),
yap_flag( unknown, _, fail), yap_flag( unknown, Action, fail),
% yap_flag( debug, Debug, false), % yap_flag( debug, Debug, false),
( (
'$exceptional_cases'(M0:G0),
'$undefp_search'(M0:G0, NM:NG), '$undefp_search'(M0:G0, NM:NG),
( M0 \== NM -> true ; G0 \== NG ), ( M0 \== NM -> true ; G0 \== NG ),
NG \= fail, NG \= fail
'$pred_exists'(NG,NM)
-> ->
yap_flag( unknown, _, Action), yap_flag( unknown, _, Action),
% yap_flag( debug, _, Debug), % yap_flag( debug, _, Debug),
( (
Current == true Current == true
-> ->
@ -296,8 +295,6 @@ private(_).
) )
; ;
yap_flag( unknown, _, Action), yap_flag( unknown, _, Action),
% yap_flag( debug, _, Debug),
'$pred_exists'('$handle_error'(Action,G0,M0), prolog),
'$handle_error'(Action,G0,M0) '$handle_error'(Action,G0,M0)
). ).
@ -675,7 +672,7 @@ number of steps.
Option \= top, !, Option \= top, !,
'$current_module'(M), '$current_module'(M),
% allow user expansion % allow user expansion
expand_term((:- G), O), expand_term((:- M:G), O),
( (
O = (:- G1) O = (:- G1)
-> ->
@ -1705,7 +1702,6 @@ log_event( String, Args ) :-
prompt(_,' '), prompt(_,' '),
'$ensure_prompting'. '$ensure_prompting'.
/** /**
@} @}
*/ */

3
pl/init.yap
View File

@ -133,11 +133,14 @@ otherwise.
:- dynamic prolog:'$parent_module'/2. :- dynamic prolog:'$parent_module'/2.
%:- start_low_level_trace.
:- [ :- [
'directives.yap', 'directives.yap',
'preds.yap', 'preds.yap',
'modules.yap' 'modules.yap'
]. ].
%:- stop_low_level_trace.
:- use_module('error.yap'). :- use_module('error.yap').