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 )
{
PredEntry *pe = PredFromDefCode(P);
if (Yap_UnknownFlag(CurrentModule) == TermFail) {
P = FAILCODE;
return;
}
BEGD(d0);
/* avoid trouble with undefined dynamic procedures */
/* I assume they were not locked beforehand */
@ -1373,9 +1377,7 @@ undef_goal( USES_REGS1 )
PP = pe;
}
#endif
if ((pe->PredFlags & (DynamicPredFlag|LogUpdatePredFlag|MultiFileFlag)) ||
CurrentModule == PROLOG_MODULE ||
(UndefCode->OpcodeOfPred == UNDEF_OPCODE)) {
if (pe->PredFlags & (DynamicPredFlag|LogUpdatePredFlag|MultiFileFlag)) {
#if defined(YAPOR) || defined(THREADS)
UNLOCKPE(19,PP);
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) {
CACHE_REGS
FlagEntry *fv;
ModEntry *new = Yap_GetModuleEntry(mod);
if (!new)
ModEntry *me = Yap_GetModuleEntry(mod);
if (!me)
return false;
fv = GetFlagProp(AtomOfTerm(tflag));
if (!fv && !fv->global) {
@ -641,18 +641,18 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
// module specific stuff now
if (fv->FlagOfVE == UNKNOWN_FLAG) {
new->flags &= ~(UNKNOWN_MASK);
me->flags &= ~(UNKNOWN_MASK);
if (t2 == TermError) {
new->flags |= (UNKNOWN_ERROR);
me->flags |= (UNKNOWN_ERROR);
return true;
} else if (t2 == TermFail) {
new->flags |= (UNKNOWN_FAIL);
me->flags |= (UNKNOWN_FAIL);
return true;
} else if (t2 == TermWarning) {
new->flags |= (UNKNOWN_WARNING);
me->flags |= (UNKNOWN_WARNING);
return true;
} else if (t2 == TermFastFail) {
new->flags |= (UNKNOWN_FAST_FAIL);
me->flags |= (UNKNOWN_FAST_FAIL);
return true;
}
Yap_Error(
@ -661,13 +661,13 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
RepAtom(AtomOfTerm(tflag))->StrOfAE);
return false;
} 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) {
if (t2 == TermTrue) {
new->flags |= M_CHARESCAPE;
me->flags |= M_CHARESCAPE;
return true;
} else if (t2 == TermFalse) {
new->flags &= ~(M_CHARESCAPE);
me->flags &= ~(M_CHARESCAPE);
return true;
}
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);
return false;
} else if (fv->FlagOfVE == BACKQUOTED_STRING_FLAG) {
return bqf1(new, t2 PASS_REGS);
return bqf1(me, t2 PASS_REGS);
;
}
// bad key?
@ -684,7 +684,7 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
static Term getYapFlagInModule(Term tflag, Term mod) {
FlagEntry *fv;
ModEntry *new = Yap_GetModuleEntry(mod);
ModEntry *me = Yap_GetModuleEntry(mod);
if (!mod)
return false;
fv = GetFlagProp(AtomOfTerm(tflag));
@ -695,28 +695,28 @@ static Term getYapFlagInModule(Term tflag, Term mod) {
// module specific stuff now
if (fv->FlagOfVE == UNKNOWN_FLAG) {
if (new->flags & UNKNOWN_ERROR)
if (me->flags & UNKNOWN_ERROR)
return TermError;
if (new->flags & UNKNOWN_WARNING)
if (me->flags & UNKNOWN_WARNING)
return TermWarning;
return TermFail;
} else if (fv->FlagOfVE == CHARACTER_ESCAPES_FLAG) {
if (new->flags & M_CHARESCAPE)
if (me->flags & M_CHARESCAPE)
return TermTrue;
} else if (fv->FlagOfVE == BACKQUOTED_STRING_FLAG) {
if (new->flags & BCKQ_CHARS)
if (me->flags & BCKQ_CHARS)
return TermChars;
if (new->flags & BCKQ_CODES)
if (me->flags & BCKQ_CODES)
return TermCodes;
if (new->flags & BCKQ_ATOM)
if (me->flags & BCKQ_ATOM)
return TermAtom;
return TermString;
} else if (fv->FlagOfVE == DOUBLE_QUOTES_FLAG) {
if (new->flags & DBLQ_CHARS)
if (me->flags & DBLQ_CHARS)
return TermChars;
if (new->flags & DBLQ_CODES)
if (me->flags & DBLQ_CODES)
return TermCodes;
if (new->flags & DBLQ_ATOM)
if (me->flags & DBLQ_ATOM)
return TermAtom;
return TermString;
}
@ -1012,6 +1012,21 @@ bool setYapFlag(Term tflag, Term t2) {
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) {
FlagEntry *fv;
flag_term *tarr;
@ -1043,7 +1058,7 @@ Term getYapFlag(Term tflag) {
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, fl, "trying to read unknown flag %s",
RepAtom(AtomOfTerm(fl))->StrOfAE);
}
return FALSE;
return false;
}
if (fv->global)
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;
}
Term Yap_UnknownFlag(Term mod);
bool rmdot(Term inp);
xarg *Yap_ArgListToVector(Term listl, const param_t *def, int n);

32
pl/boot.yap
View File

@ -253,15 +253,13 @@ private(_).
'$iso_check_goal'/2]).
'$early_print_message'(_, absolute_file_path(X, Y)) :- !,
format(user_error, X, Y), nl(user_error).
'$early_print_message'(_, loading( C, F)) :- !,
'$show_consult_level'(LC),
format(user_error, '~*|% ~a ~w...~n', [LC,C,F]).
format(user_error, '~*|% ~a ~w...~n', [2,C,F]).
'$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', [LC, M, F ,C, H, T]).
format(user_error, '~*|% ~a:~w ~a ~d bytes in ~d seconds...~n', [2, M, F ,C, H, T]).
'$early_print_message'(Level, Msg) :-
source_location(F0, L),
!,
@ -269,23 +267,24 @@ private(_).
'$early_print_message'(Level, Msg) :-
format(user_error, 'unprocessed ~a ~w ~n', [Level,Msg]).
'$exceptional_cases'(_:print_message(Context, Msg)) :-
'$handle_error'(_Action,_G0,_M0) :- fail.
% 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) :-
% make sure we do not loop on undefined predicates
'$stop_creeping'(Current),
yap_flag( unknown, _, fail),
yap_flag( unknown, Action, fail),
% yap_flag( debug, Debug, false),
(
'$exceptional_cases'(M0:G0),
'$undefp_search'(M0:G0, NM:NG),
( M0 \== NM -> true ; G0 \== NG ),
NG \= fail,
'$pred_exists'(NG,NM)
NG \= fail
->
yap_flag( unknown, _, Action),
% yap_flag( debug, _, Debug),
% yap_flag( debug, _, Debug),
(
Current == true
->
@ -296,11 +295,9 @@ private(_).
)
;
yap_flag( unknown, _, Action),
% yap_flag( debug, _, Debug),
'$pred_exists'('$handle_error'(Action,G0,M0), prolog),
'$handle_error'(Action,G0,M0)
).
/*
'$undefp'([M0|G0], Default) :-
G0 \= '$imported_predicate'(_,_,_,_),
@ -675,7 +672,7 @@ number of steps.
Option \= top, !,
'$current_module'(M),
% allow user expansion
expand_term((:- G), O),
expand_term((:- M:G), O),
(
O = (:- G1)
->
@ -1476,7 +1473,7 @@ bootstrap(F) :-
%
'$precompile_term'(Term, ExpandedUser, Expanded) :-
%format('[ ~w~n',[Term]),
'$expand_clause'(Term, ExpandedUser, ExpandedI),
'$expand_clause'(Term, ExpandedUser, ExpandedI),
!,
%format(' -> ~w~n',[Expanded0]),
(
@ -1705,7 +1702,6 @@ log_event( String, Args ) :-
prompt(_,' '),
'$ensure_prompting'.
/**
@}
*/

3
pl/init.yap
View File

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