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

boot

This commit is contained in:
Vitor Santos Costa 2019-01-31 11:54:17 +00:00
parent f7ed109d1c
commit b71b4f6fca
8 changed files with 72 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
C/cdmgr.c
View File

@ -2852,10 +2852,14 @@ static Int undefp_handler(USES_REGS1) { /* '$undefp_handler'(P,Mod) */
PredEntry *pe;
pe = Yap_get_pred(Deref(ARG1), Deref(ARG2), "undefined/1");
if (EndOfPAEntr(pe))
return false;
PELOCK(59, pe);
if (EndOfPAEntr(pe)) {
UndefCode = FAILCODE;
UNLOCKPE(59, pe);
return false;
}
if (pe->OpcodeOfPred == UNDEF_OPCODE) {
UndefCode = FAILCODE;
UNLOCKPE(59, pe);
return false;
}

33
C/exec.c
View File

@ -189,11 +189,10 @@ static bool CallError(yap_error_number err, Term t, Term mod USES_REGS) {
/** @pred current_choice_point( -CP )
*
* unify the logic variable _CP_ with a number that gives the offset of the
* current choice-point. This number is only valid as long as we do not
*backtrack by or cut
* _CP_, and is safe in the presence of stack shifting and/or garbage
*collection.
* unify the logic variable _CP_ with a number that identifies the
* last alternative taken, or current choice-point. This number is
* only valid as long as we do not backtrack by or cut _CP_, and is
* safe in the presence of stack shifting and/or garbage collection.
*/
static Int current_choice_point(USES_REGS1) {
Term t = Deref(ARG1);
@ -208,6 +207,29 @@ static Int current_choice_point(USES_REGS1) {
return TRUE;
}
/** @pred parent_choice_point( +CP, -PCP )
*
* given that _CP_ identifies an
* alternative taken, or choice-point, _PCP_ identifies its parent.
*
* The call will fail if _CP_ is topmost in the search tree.
*/
static Int parent_choice_point(USES_REGS1) {
Term t = Deref(ARG1);
Term td;
#if SHADOW_HB
register CELL *HBREG = HB;
#endif
if (!IsVarTerm(t))
return (FALSE);
choiceptr cp = cp_from_integer(t);
if (cp == NULL || cp->cp_b == NULL)
return false;
td = cp_as_integer(cp->cp_b PASS_REGS);
YapBind((CELL *)t, td);
return TRUE;
}
static Int save_env_b(USES_REGS1) {
Term t = Deref(ARG1);
Term td;
@ -2302,6 +2324,7 @@ void Yap_InitExecFs(void) {
Yap_InitCPred("current_choice_point", 1, current_choice_point, 0);
Yap_InitCPred("current_choicepoint", 1, current_choice_point, 0);
Yap_InitCPred("env_choice_point", 1, save_env_b, 0);
Yap_InitCPred("parent_choice_point", 1, parent_choice_point, 0);
Yap_InitCPred("cut_at", 1, clean_ifcp, SafePredFlag);
CurrentModule = cm;
Yap_InitCPred("$restore_regs", 1, restore_regs,

2
C/yap-args.c
View File

@ -1206,6 +1206,7 @@ X_API void YAP_Init(YAP_init_args *yap_init) {
}
LOCAL_consult_level = -1;
}
Yap_do_low_level_trace=1;
YAP_RunGoalOnce(TermInitProlog);
if (yap_init->install && Yap_OUTPUT_STARTUP) {
Term t = MkAtomTerm(Yap_LookupAtom(Yap_OUTPUT_STARTUP));
@ -1214,6 +1215,7 @@ X_API void YAP_Init(YAP_init_args *yap_init) {
YAP_RunGoalOnce(g);
}
Yap_do_low_level_trace=0;
end_init(yap_init);
}

12
library/hacks.yap
View File

@ -10,6 +10,8 @@
:- module(yap_hacks, [
current_choicepoint/1,
parent_choicepoint/1,
parent_choicepoint/2,
cut_by/1,
cut_at/1,
current_choicepoints/1,
@ -66,6 +68,16 @@ run_formats([], _).
run_formats([Com-Args|StackInfo], Stream) :-
format(Stream, Com, Args),
run_formats(StackInfo, user_error).
/**
* @pred parent_choicepoint(+_ChoicePoint_)
*
* _ChoicePoint_ is the parent of the current choice-point.
*
*/
parent_choicepoint(BP) :-
current_choicepoint(B),
parent_choicepoint(B, BP).
/**
* @pred virtual_alarm(+Interval, 0:Goal, -Left)

8
pl/boot.yap
View File

@ -41,7 +41,7 @@ system_module(Mod, SysExps) :-
use_system_module(_Module, _SysExps).
system_module(_Mod, SysExps, _Decls) :-
system_module(_Mod, _SysExps, _Decls) :-
% '$new_system_predicates'(SysExps),
fail.
system_module(_Mod, _SysExps, _Decls) :-
@ -100,9 +100,9 @@ print_message(L,E) :-
).
'$undefp0'([M|G], _Action) :-
functor(G,N,A),
print_message( error, error(error(unknown, M:N/A),M:G)),
fail.
functor(G,N,A),
print_message( error, error(error(unknown, M:N/A),M:G)),
fail.
:- '$undefp_handler'('$undefp0'(_,_),prolog).

6
pl/init.yap
View File

@ -113,8 +113,8 @@
'$startup_goals' :-
module(user),
fail.
'$startup_goals' :-
recorded('$startup_goal',G,_),
'$startup_goals' :-
recorded('$startup_goal',G,_),
catch(once(user:G),Error,user:'$Error'(Error)),
fail.
'$startup_goals' :-
@ -187,7 +187,7 @@
get_value('$consult_on_boot',X), X \= [],
set_value('$consult_on_boot',[]),
'$do_startup_reconsult'(X),
!.
fail.
'$init_from_saved_state_and_args' :-
recorded('$restore_flag', init_file(M:B), R),
erase(R),

13
pl/top.yap
View File

@ -177,11 +177,11 @@ live :-
catch( '$expand_term0'(T,Con,O), _,( '$disable_debugging', fail) ),
!.
'$expand_term0'(T,consult,O) :-
expand_term( T, O).
'$expand_term0'(T,reconsult,O) :-
expand_term( T, O).
'$expand_term0'(T,top,O) :-
'$expand_term0'(T,consult,O) :-
expand_term( T, O).
'$expand_term0'(T,reconsult,O) :-
expand_term( T, O).
'$expand_term0'(T,top,O) :-
expand_term( T, T1),
!,
'$expand_term1'(T1,O).
@ -879,8 +879,7 @@ gated_call(Setup, Goal, Catcher, Cleanup) :-
'$precompile_term'(Term, Term, Term).
'$expand_clause'(InputCl, C1, CO) :-
source_module(SM),
'$yap_strip_clause'(SM:InputCl, M, ICl),
'$yap_strip_clause'(InputCl, M, ICl),
'$expand_a_clause'( M:ICl, SM, C1, CO),
!.
'$expand_clause'(Cl, Cl, Cl).

21
pl/undefined.yap
View File

@ -97,26 +97,27 @@ undefined_query(G0, M0, Cut) :-
'$undefp'([M0|G0],MG) :-
% make sure we do not loop on undefined predicates
'$undef_setup'(M0:G0, Action,Debug,Current, MGI),
('$get_undefined_predicates'( MGI, MG ) , MG)
('$get_undefined_predicates'( MGI, MG )
->
true
;
'$undef_error'(Current, M0:G0, MGI, MG)
,
'$undef_cleanup'(Action,Debug,Current).
'$undef_cleanup'(Action,Debug,Current)
).
'$undef_error'(_, M0:G0, _, MG) :-
'$pred_exists'(unknown_predicate_handler(_,_,_,_), user),
'$yap_strip_module'(M0:G0, EM0, GM0),
user:unknown_predicate_handler(GM0,EM0,MG),
!.
'$handle_error'(error, Mod:Goal, I,_) :-
'$undef_error'(error, Mod:Goal, I,_) :-
'$do_error'(existence_error(procedure,I), Mod:Goal).
'$handle_error'(warning,Mod:Goal,I,_) :-
'$undef_error'(warning,Mod:Goal,I,_) :-
'program_continuation'(PMod,PName,PAr),
print_message(warning,error(existence_error(procedure,I), context(Mod:Goal,PMod:PName/PAr))),
fail.
'$handle_error'(fail,_Goal,_Mod) :-
'$undef_error'(fail,_Goal,_Mod) :-
fail.
'$undef_setup'(G0,Action,Debug,Current,GI) :-
@ -127,20 +128,20 @@ undefined_query(G0, M0, Cut) :-
'$g2i'(user:G, Na/Ar ) :-
!,
functor(G, Na, Ar).
functor(G, Na, Ar).
'$g2i'(prolog:G, Na/Ar ) :-
!,
functor(G, Na, Ar).
functor(G, Na, Ar).
'$g2i'(M:G, M:Na/Ar ) :-
!,
functor(G, Na, Ar).
functor(G, Na, Ar).
'$undef_cleanup'(Action,Debug,_Current) :-
yap_flag( unknown, _, Action),
yap_flag( debug, _, Debug),
'$start_creep'([prolog|true], creep).
:- '$undefp_handler'('$undefp'(_,_), prolog).
:- '$undefp_handler'('$undefp'(_,_), prolog).
/** @pred unknown(- _O_,+ _N_)
@ -154,7 +155,7 @@ The unknown predicate, informs about what the user wants to be done
*/
unknown(P, NP) :-
prolog_flag( unknown, P, NP ).
yap_flag( unknown, P, NP ).
/**
@}