diff --git a/C/cdmgr.c b/C/cdmgr.c index 6610616c6..f044e843d 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -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; } diff --git a/C/exec.c b/C/exec.c index fa757cc39..43751cbac 100755 --- a/C/exec.c +++ b/C/exec.c @@ -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, diff --git a/C/yap-args.c b/C/yap-args.c index ccd7083fe..864f46b2f 100755 --- a/C/yap-args.c +++ b/C/yap-args.c @@ -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); } diff --git a/library/hacks.yap b/library/hacks.yap index 9759b3763..2f46e89b4 100644 --- a/library/hacks.yap +++ b/library/hacks.yap @@ -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) diff --git a/pl/boot.yap b/pl/boot.yap index 420f0b3a5..ca48d01b8 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -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). diff --git a/pl/init.yap b/pl/init.yap index 950ff1049..d783a7dc7 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -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), diff --git a/pl/top.yap b/pl/top.yap index bd76975b8..b41ae8e6e 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -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). diff --git a/pl/undefined.yap b/pl/undefined.yap index 811891732..9b13b60dc 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -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 ). /** @}