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

reset

This commit is contained in:
Vitor Santos Costa 2018-11-03 10:49:35 +00:00
parent 0f313755cc
commit a1f8631844
16 changed files with 232 additions and 224 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
C/exec.c
View File

@ -113,7 +113,7 @@ static inline bool CallPredicate(PredEntry *pen, choiceptr cut_pt,
* @return did we fiid it? * @return did we fiid it?
*/ */
inline static bool CallMetaCall(Term t, Term mod USES_REGS) { inline static bool CallMetaCall(Term t, Term mod USES_REGS) {
// we have a creep requesr waiting // we have a creep requesr waiting
ARG1 = t; ARG1 = t;
ARG2 = cp_as_integer(B PASS_REGS); /* p_current_choice_point */ ARG2 = cp_as_integer(B PASS_REGS); /* p_current_choice_point */
@ -1009,7 +1009,6 @@ static bool complete_ge(bool out, Term omod, yhandle_t sl, bool creeping) {
} }
static Int _user_expand_goal(USES_REGS1) { static Int _user_expand_goal(USES_REGS1) {
BACKUP_MACHINE_REGS();
yhandle_t sl = Yap_StartSlots(); yhandle_t sl = Yap_StartSlots();
Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL); Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL);
PredEntry *pe; PredEntry *pe;
@ -1056,15 +1055,12 @@ static Int _user_expand_goal(USES_REGS1) {
Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE))) && Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL PASS_REGS, false)) { Yap_execute_pred(pe, NULL PASS_REGS, false)) {
RECOVER_MACHINE_REGS();
return complete_ge(true, omod, sl, creeping); return complete_ge(true, omod, sl, creeping);
} }
RECOVER_MACHINE_REGS();
return complete_ge(false, omod, sl, creeping); return complete_ge(false, omod, sl, creeping);
} }
static Int do_term_expansion(USES_REGS1) { static Int do_term_expansion(USES_REGS1) {
BACKUP_MACHINE_REGS();
yhandle_t sl = Yap_StartSlots(); yhandle_t sl = Yap_StartSlots();
Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL); Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL);
PredEntry *pe; PredEntry *pe;
@ -1079,7 +1075,6 @@ static Int do_term_expansion(USES_REGS1) {
Yap_GetPredPropByFunc(FunctorTermExpansion, USER_MODULE))) && Yap_GetPredPropByFunc(FunctorTermExpansion, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, false PASS_REGS)) { Yap_execute_pred(pe, NULL, false PASS_REGS)) {
RECOVER_MACHINE_REGS();
return complete_ge(true, omod, sl, creeping); return complete_ge(true, omod, sl, creeping);
} }
/* CurMod:term_expansion(A,B) */ /* CurMod:term_expansion(A,B) */
@ -1088,7 +1083,6 @@ static Int do_term_expansion(USES_REGS1) {
(pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, cmod))) && (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, cmod))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, false PASS_REGS)) { Yap_execute_pred(pe, NULL, false PASS_REGS)) {
RECOVER_MACHINE_REGS();
return complete_ge(true, omod, sl, creeping); return complete_ge(true, omod, sl, creeping);
} }
/* system:term_expansion(A,B) */ /* system:term_expansion(A,B) */
@ -1100,10 +1094,8 @@ static Int do_term_expansion(USES_REGS1) {
Yap_GetPredPropByFunc(FunctorTermExpansion, SYSTEM_MODULE))) && Yap_GetPredPropByFunc(FunctorTermExpansion, SYSTEM_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, false PASS_REGS)) { Yap_execute_pred(pe, NULL, false PASS_REGS)) {
RECOVER_MACHINE_REGS();
return complete_ge(true, omod, sl, creeping); return complete_ge(true, omod, sl, creeping);
} }
RECOVER_MACHINE_REGS();
return complete_ge(false, omod, sl, creeping); return complete_ge(false, omod, sl, creeping);
} }
@ -1667,6 +1659,7 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
yamop *saved_p, *saved_cp; yamop *saved_p, *saved_cp;
yamop *CodeAdr; yamop *CodeAdr;
bool out; bool out;
saved_p = P; saved_p = P;
saved_cp = CP; saved_cp = CP;
LOCAL_PrologMode |= TopGoalMode; LOCAL_PrologMode |= TopGoalMode;

10
C/utilpreds.c
View File

@ -3002,9 +3002,9 @@ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt
CELL *pt2 = pt0; CELL *pt2 = pt0;
while(IsVarTerm(*pt2)) while(IsVarTerm(*pt2))
pt2 = (CELL *)(*pt2); pt2 = (CELL *)(*pt2);
HR[1] = AbsPair(HR+2); HR[0] = AbsPair(HR+2);
HR += 2; HR += 2;
HR[-2] = (CELL)pt2; HR[-1] = (CELL)pt2;
*pt2 = TermRefoundVar; *pt2 = TermRefoundVar;
} }
continue; continue;
@ -3035,8 +3035,8 @@ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt
clean_tr(TR0 PASS_REGS); clean_tr(TR0 PASS_REGS);
if (HR != InitialH) { if (HR != InitialH) {
/* close the list */ /* close the list */
RESET_VARIABLE(HR-1); RESET_VARIABLE(HR-2);
Yap_unify((CELL)(HR-1),ARG2); Yap_unify((CELL)(HR-2),ARG2);
return output; return output;
} else { } else {
return ARG2; return ARG2;
@ -3067,7 +3067,7 @@ p_non_singletons_in_term( USES_REGS1 ) /* non_singletons in term t */
while (TRUE) { while (TRUE) {
t = Deref(ARG1); t = Deref(ARG1);
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
out = MkPairTerm(t,ARG2); out = ARG2;
} else if (IsPrimitiveTerm(t)) { } else if (IsPrimitiveTerm(t)) {
out = ARG2; out = ARG2;
} else if (IsPairTerm(t)) { } else if (IsPairTerm(t)) {

2
os/yio.yap
View File

@ -181,7 +181,7 @@ display(Stream, T) :-
/* interface to user portray */ /* interface to user portray */
'$portray'(T) :- '$portray'(T) :-
\+ '$undefined'(portray(_),user), \+ '$undefined'(portray(_),user),
'$system_catch'(call(portray(T)),user,Error,user:'$Error'(Error)), !, catch(user:portray(T),Error,'$Error'(Error)), !,
set_value('$portray',true), fail. set_value('$portray',true), fail.
'$portray'(_) :- set_value('$portray',false), fail. '$portray'(_) :- set_value('$portray',false), fail.

38
pl/absf.yap
View File

@ -164,13 +164,13 @@ absolute_file_name(File0,File) :-
% look for solutions % look for solutions
gated_call( gated_call(
'$sys':enter_absf( File, LOpts, Opts, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ), '$enter_absf'( File, LOpts, Opts, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ),
'$sys':find_in_path(File, Opts,TrueFileName, HasSol, TakeFirst), '$find_in_path'(File, Opts,TrueFileName, HasSol, TakeFirst),
Port, Port,
'$sys':absf_port(Port, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) '$absf_port'(Port, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors )
). ).
'$sys':enter_absf( File, LOpts, Opts, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :- '$enter_absf'( File, LOpts, Opts, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :-
( var(File) -> instantiation_error(File) ; true), ( var(File) -> instantiation_error(File) ; true),
abs_file_parameters(LOpts,Opts), abs_file_parameters(LOpts,Opts),
current_prolog_flag(open_expands_filename, OldF), current_prolog_flag(open_expands_filename, OldF),
@ -188,20 +188,20 @@ absolute_file_name(File0,File) :-
'$absf_trace_options'(LOpts), '$absf_trace_options'(LOpts),
HasSol = t(no). HasSol = t(no).
'$sys':absf_port(answer, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :- '$absf_port'(answer, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :-
'$sys':absf_port(exit, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ). '$absf_port'(exit, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ).
'$sys':absf_port(exit, _File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, _Expand, _Verbose, TakeFirst, _FileErrors ) :- '$absf_port'(exit, _File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, _Expand, _Verbose, TakeFirst, _FileErrors ) :-
(TakeFirst == first -> ! ; nb_setarg(1, HasSol, yes) ), (TakeFirst == first -> ! ; nb_setarg(1, HasSol, yes) ),
set_prolog_flag( fileerrors, PreviousFileErrors ), set_prolog_flag( fileerrors, PreviousFileErrors ),
set_prolog_flag( open_expands_filename, OldF), set_prolog_flag( open_expands_filename, OldF),
set_prolog_flag( verbose_file_search, PreviousVerbose ), set_prolog_flag( verbose_file_search, PreviousVerbose ),
'$absf_trace'(' |------- found ~a', [TrueFileName]). '$absf_trace'(' |------- found ~a', [TrueFileName]).
'$sys':absf_port(redo, File, _TrueFileName, _HasSol, _OldF, _PreviousFileErrors, _PreviousVerbose, Expand, Verbose, _TakeFirst, FileErrors ) :- '$absf_port'(redo, File, _TrueFileName, _HasSol, _OldF, _PreviousFileErrors, _PreviousVerbose, Expand, Verbose, _TakeFirst, FileErrors ) :-
set_prolog_flag( fileerrors, FileErrors ), set_prolog_flag( fileerrors, FileErrors ),
set_prolog_flag( verbose_file_search, Verbose ), set_prolog_flag( verbose_file_search, Verbose ),
set_prolog_flag( file_name_variables, Expand ), set_prolog_flag( file_name_variables, Expand ),
'$absf_trace'(' |------- restarted search for ~a', [File]). '$absf_trace'(' |------- restarted search for ~a', [File]).
'$sys':absf_port(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, _Expand, _Verbose, _TakeFirst, FileErrors ) :- '$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, _Expand, _Verbose, _TakeFirst, FileErrors ) :-
'$absf_trace'(' !------- failed.', []), '$absf_trace'(' !------- failed.', []),
set_prolog_flag( fileerrors, PreviousFileErrors ), set_prolog_flag( fileerrors, PreviousFileErrors ),
set_prolog_flag( verbose_file_search, PreviousVerbose ), set_prolog_flag( verbose_file_search, PreviousVerbose ),
@ -210,22 +210,22 @@ absolute_file_name(File0,File) :-
arg(1,HasSol,no), arg(1,HasSol,no),
FileErrors = error, FileErrors = error,
'$do_error'(existence_error(file,File),absolute_file_name(File, TrueFileName, ['...'])). '$do_error'(existence_error(file,File),absolute_file_name(File, TrueFileName, ['...'])).
'$sys':absf_port(!, _File, _TrueFileName, _HasSol, _OldF, _PreviousFileErrors, _PreviousVerbose, _Expand, _Verbose, _TakeFirst, _FileErrors ). '$absf_port'(!, _File, _TrueFileName, _HasSol, _OldF, _PreviousFileErrors, _PreviousVerbose, _Expand, _Verbose, _TakeFirst, _FileErrors ).
'$sys':absf_port(exception(_), File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :- '$absf_port'(exception(_), File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :-
'$sys':absf_port(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ). '$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ).
'$sys':absf_port(external_exception(_), File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :- '$absf_port'(external_exception(_), File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :-
'$sys':absf_port(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ). '$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ).
% This sequence must be followed: % This sequence must be followed:
% user and user_input are special; % user and user_input are special;
% library(F) must check library_directories % library(F) must check library_directories
% T(F) must check file_search_path % T(F) must check file_search_path
% all must try search in path % all must try search in path
'$sys':find_in_path(user,_,user_input, _, _) :- !. '$find_in_path'(user,_,user_input, _, _) :- !.
'$sys':find_in_path(user_input,_,user_input, _, _) :- !. '$find_in_path'(user_input,_,user_input, _, _) :- !.
'$sys':find_in_path(user_output,_,user_ouput, _, _) :- !. '$find_in_path'(user_output,_,user_ouput, _, _) :- !.
'$sys':find_in_path(user_error,_,user_error, _, _) :- !. '$find_in_path'(user_error,_,user_error, _, _) :- !.
'$sys':find_in_path(Name, Opts, File, _, First) :- '$find_in_path'(Name, Opts, File, _, First) :-
% ( atom(Name) -> true ; start_low_level_trace ), % ( atom(Name) -> true ; start_low_level_trace ),
get_abs_file_parameter( file_type, Opts, Type ), get_abs_file_parameter( file_type, Opts, Type ),
get_abs_file_parameter( access, Opts, Access ), get_abs_file_parameter( access, Opts, Access ),

29
pl/boot.yap
View File

@ -50,7 +50,30 @@ private(_).
(not)/1, (not)/1,
repeat/0, repeat/0,
throw/1, throw/1,
true/0], []). true/0], ['$$compile'/4,
'$call'/4,
'$catch'/3,
'$check_callable'/2,
'$check_head_and_body'/4,
'$check_if_reconsulted'/2,
'$clear_reconsulting'/0,
'$command'/4,
'$cut_by'/1,
'$disable_debugging'/0,
'$do_live'/0,
'$'/0,
'$find_goal_definition'/4,
'$head_and_body'/3,
'$inform_as_reconsulted'/2,
'$init_system'/0,
'$init_win_graphics'/0,
'$loop'/2,
'$meta_call'/2,
'$prompt_alternatives_on'/1,
'$run_at_thread_start'/0,
'$system_catch'/4,
'$undefp'/1,
'$version'/0]).
:- use_system_module( '$_absf', ['$system_library_directories'/2]). :- use_system_module( '$_absf', ['$system_library_directories'/2]).
@ -189,11 +212,11 @@ print_message(L,E) :-
:- c_compile('directives.yap'). :- c_compile('directives.yap').
:- c_compile('init.yap'). :- c_compile('init.yap').
'$sys':command(C,VL,Pos,Con) :- '$command'(C,VL,Pos,Con) :-
current_prolog_flag(strict_iso, true), !, /* strict_iso on */ current_prolog_flag(strict_iso, true), !, /* strict_iso on */
'$yap_strip_module'(C, EM, EG), '$yap_strip_module'(C, EM, EG),
'$execute_command'(EG,EM,VL,Pos,Con,_Source). '$execute_command'(EG,EM,VL,Pos,Con,_Source).
'$sys':command(C,VL,Pos,Con) :- '$command'(C,VL,Pos,Con) :-
( (Con = top ; var(C) ; C = [_|_]) -> ( (Con = top ; var(C) ; C = [_|_]) ->
'$yap_strip_module'(C, EM, EG), '$yap_strip_module'(C, EM, EG),
'$execute_command'(EG,EM,VL,Pos,Con,C) ; '$execute_command'(EG,EM,VL,Pos,Con,C) ;

46
pl/consult.yap
View File

@ -40,7 +40,21 @@
source_file/2, source_file/2,
source_file_property/2, source_file_property/2,
use_module/3], use_module/3],
['$initialization'/2]). ['$add_multifile'/3,
'$csult'/2,
'$do_startup_reconsult'/1,
'$elif'/2,
'$else'/1,
'$endif'/1,
'$if'/2,
'$include'/2,
'$initialization'/1,
'$initialization'/2,
'$lf_opt'/3,
'$load_files'/3,
'$require'/2,
'$set_encoding'/1,
'$use_module'/3]).
:- use_system_module( '$_absf', ['$full_filename'/2]). :- use_system_module( '$_absf', ['$full_filename'/2]).
@ -834,7 +848,7 @@ nb_setval('$if_le1vel',0).
erase(R), erase(R),
G \= '$', G \= '$',
strip_module(user:G, M0, G0), strip_module(user:G, M0, G0),
( catch(M0:G0, Error, error_handler(Error, top)) ( catch(M0:G0, Error, user:'$LoopError'(Error, top))
-> ->
true true
; ;
@ -851,7 +865,7 @@ nb_setval('$if_le1vel',0).
'$process_init_goal'([G|_]) :- '$process_init_goal'([G|_]) :-
'$yap_strip_module'( G, M0, G0), '$yap_strip_module'( G, M0, G0),
( (
catch(M0:G0, Error, error_handler(Error, top)) catch(M0:G0, Error, user:'$LoopError'(Error, top))
-> ->
true true
; ;
@ -915,7 +929,7 @@ nb_setval('$if_le1vel',0).
'$init_win_graphics', '$init_win_graphics',
fail. fail.
'$do_startup_reconsult'(X) :- '$do_startup_reconsult'(X) :-
catch(load_files(user:X, [silent(true)]), Error, error_handler(Error, consult)), catch(load_files(user:X, [silent(true)]), Error, '$LoopError'(Error, consult)),
!, !,
( current_prolog_flag(halt_after_consult, false) -> true ; halt). ( current_prolog_flag(halt_after_consult, false) -> true ; halt).
'$do_startup_reconsult'(_). '$do_startup_reconsult'(_).
@ -1455,24 +1469,7 @@ Similar to initialization/1, but allows for specifying when
*/ */
initialization(G,OPT) :- initialization(G,OPT) :-
must_be_of_type(callable, G0, initialization(G0,OPT)), catch('$initialization'(G, OPT), Error, '$LoopError'( Error, consult ) ),
must_be_of_type(oneof([after_load, now, restore]),
OPT, initialization(G0,OPT)),
'$yap_strip_module'(G0,M,G1),
'$expand_term'((M:G1), G),
(
OPT == now
->
( catch(G,E,error_handler(E)) -> true ; format(user_error,':- ~w failed.~n',[G]) )
;
OPT == after_load
->
'$initialization_queue'(G)
;
OPT == restore
->
recordz('$call_at_restore', G, _ )
),
fail. fail.
initialization(_G,_OPT). initialization(_G,_OPT).
@ -1653,9 +1650,8 @@ End of conditional compilation.
nb_setval('$if_skip_mode',OldMode). nb_setval('$if_skip_mode',OldMode).
'$if_call'(Goal) :- '$if_call'(G) :-
'$expand_term'(Goal,TrueGoal), catch('$eval_if'(G), E, (print_message(error, E), fail)).
catch(once(TrueGoal), E, (print_message(error, E), fail)).
'$eval_if'(Goal) :- '$eval_if'(Goal) :-
'$expand_term'(Goal,TrueGoal), '$expand_term'(Goal,TrueGoal),

61
pl/control.yap
View File

@ -390,19 +390,19 @@ version(T) :-
'$set_toplevel_hook'(_). '$set_toplevel_hook'(_).
query_to_answer(G, V, Status, Bindings) :- query_to_answer(G, V, Status, Bindings) :-
gated_call( true, (G,'$sys':delayed_goals(G, V, Vs, LGs, _DCP)), Status, '$sys':answer( Status, LGs, Vs, Bindings) ). gated_call( true, (G,'$delayed_goals'(G, V, Vs, LGs, _DCP)), Status, '$answer'( Status, LGs, Vs, Bindings) ).
'$sys':answer( exit, LGs, Vs, Bindings) :- '$answer'( exit, LGs, Vs, Bindings) :-
!, !,
'$process_answer'(Vs, LGs, Bindings). '$process_answer'(Vs, LGs, Bindings).
'$sys':answer( answer, LGs, Vs, Bindings) :- '$answer'( answer, LGs, Vs, Bindings) :-
!, !,
'$process_answer'(Vs, LGs, Bindings). '$process_answer'(Vs, LGs, Bindings).
'$sys':answer(!, _, _, _). '$answer'(!, _, _, _).
'$sys':answer(fail,_,_,_). '$answer'(fail,_,_,_).
'$sys':answer(exception(E),_,_,_) :- '$answer'(exception(E),_,_,_) :-
'$LoopError'(E,error). '$LoopError'(E,error).
'$sys':answer(external_exception(_),_,_,_). '$answer'(external_exception(_),_,_,_).
%% @} %% @}
@ -471,13 +471,14 @@ b_getval(GlobalVariable, Val) :-
it saves the importante data about current streams and it saves the importante data about current streams and
debugger state */ debugger state */
'$debug_state'(state(Trace, Debug, State, SPY_GN, GList)) :- '$debug_state'(state(Trace, Debug, State, SPY_GN, GList, GDList)) :-
'$init_debugger', '$init_debugger',
nb_getval('$trace',Trace), nb_getval('$trace',Trace),
nb_getval('$debug_state',State), nb_getval('$debug_state',State),
current_prolog_flag(debug, Debug), current_prolog_flag(debug, Debug),
nb_getval('$spy_gn',SPY_GN), nb_getval('$spy_gn',SPY_GN),
b_getval('$spy_glist',GList). b_getval('$spy_glist',GList),
b_getval('$spy_depth',GDList).
'$debug_stop' :- '$debug_stop' :-
@ -485,15 +486,17 @@ b_getval(GlobalVariable, Val) :-
b_setval('$trace',off), b_setval('$trace',off),
set_prolog_flag(debug, false), set_prolog_flag(debug, false),
b_setval('$spy_glist',[]), b_setval('$spy_glist',[]),
b_setval('$spy_gdlist',[]). b_setval('$spy_gdlist',[]),
'$disable_debugging'.
'$debug_restart'(state(Trace, Debug, State, SPY_GN, GList, GDList)) :-
'$debug_restart'(state(Trace, Debug, State, SPY_GN, GList)) :-
b_setval('$spy_glist',GList), b_setval('$spy_glist',GList),
b_setval('$spy_gdlist',GDList),
b_setval('$spy_gn',SPY_GN), b_setval('$spy_gn',SPY_GN),
set_prolog_flag(debug, Debug), set_prolog_flag(debug, Debug),
nb_setval('$debug_state',State), nb_setval('$debug_state',State),
b_setval('$trace',Trace). b_setval('$trace',Trace),
'$enable_debugging'.
/** @pred break /** @pred break
@ -512,34 +515,20 @@ debugging.
*/ */
break :- break :-
'$e_setup_call_cleanup'(
prolog:'$enter_break'(Dstate,StdStreams,BL,NBL),
prolog:'$do_break'(NBL),
prolog:'$leave_break'(Dstate,StdStreams,BL)
).
'$enter_break'(DState,streams(InpStream,OutStream,ErrStream),BL,NBL),
'$debug_state'(DState), '$debug_state'(DState),
'$debug_start',
'$break'( true ), '$break'( true ),
yap_flag( user_input, InpStream ), current_output(OutStream), current_input(InpStream),
yap_flag( user_output, OutStream ),
yap_flag( user_error, ErrStream ),
current_prolog_flag(break_level, BL ), current_prolog_flag(break_level, BL ),
NBL is BL+1, NBL is BL+1,
set_prolog_flag(break_level, NBL ). set_prolog_flag(break_level, NBL ),
format(user_error, '% Break (level ~w)~n', [NBL]),
'$do_break'(NBL) :-
format(user_error, '% Break (level ~w)~n', [NBL]),
'$do_live', '$do_live',
!. !,
'$leave_break'(DState,streams(InpStream,OutStream,ErrStream),BL) :-
set_value('$live','$true'), set_value('$live','$true'),
'$debug_restore'(DState), '$debug_restore'(DState),
yap_flag( user_input, InpStream ), set_input(InpStream),
yap_flag( user_output, OutStream ), set_output(OutStream),
yap_flag( user_error, ErrStream ),
set_prolog_flag(break_level, BL ), set_prolog_flag(break_level, BL ),
'$break'( false ). '$break'( false ).
@ -599,7 +588,7 @@ halt(X) :-
'$run_atom_goal'(GA) :- '$run_atom_goal'(GA) :-
'$current_module'(Module), '$current_module'(Module),
atom_to_term(GA, G, _), atom_to_term(GA, G, _),
catch(once(Module:G), Error,error_handler(Error)). catch(once(Module:G), Error,user:'$Error'(Error)).
'$add_dot_to_atom_goal'([],[0'.]) :- !. %' '$add_dot_to_atom_goal'([],[0'.]) :- !. %'
'$add_dot_to_atom_goal'([0'.],[0'.]) :- !. '$add_dot_to_atom_goal'([0'.],[0'.]) :- !.

58
pl/debug.yap
View File

@ -307,17 +307,17 @@ be lost.
'$$save_by'(CP), '$$save_by'(CP),
'$trace_query'(G, Mod, CP, G, EG), '$trace_query'(G, Mod, CP, G, EG),
gated_call( gated_call(
'$debugger':d_input, '$debugger_input',
EG, EG,
E, E,
'$debugger':d_continue(E) '$continue_debugging'(E)
). ).
'$debugger':d_continue(exit) :- !, '$creep'. '$continue_debugging'(exit) :- !, '$creep'.
'$debugger':d_continue(answer) :- !, '$creep'. '$continue_debugging'(answer) :- !, '$creep'.
'$debugger':d_continue(fail) :- !, '$creep'. '$continue_debugging'(fail) :- !, '$creep'.
'$debugger':d_continue(_). '$continue_debugging'(_).
@ -374,19 +374,19 @@ be lost.
* user_input is bound to a file. * user_input is bound to a file.
* *
*/ */
'$debugger':d_input :- '$debugger_input' :-
stream_property(_,alias(debugger_input)), stream_property(_,alias(debugger_input)),
!. !.
'$debugger':d_input :- '$debugger_input' :-
S = user_input, S = user_input,
stream_property(S,tty(true)), stream_property(S,tty(true)),
% stream_property(S,input), % stream_property(S,input),
!, !,
set_stream(S,alias(debugger_input)). set_stream(S,alias(debugger_input)).
'$debugger':d_input :- '$debugger_input' :-
current_prolog_flag(unix, true ), !, current_prolog_flag(unix, true ), !,
open('/dev/tty', read, _S, [alias(debugger_input),bom(false)]). open('/dev/tty', read, _S, [alias(debugger_input),bom(false)]).
'$debugger':d_input :- '$debugger_input' :-
current_prolog_flag(windows, true ), !, current_prolog_flag(windows, true ), !,
open('CONIN$', read, _S, [alias(debugger_input),bom(false)]). open('CONIN$', read, _S, [alias(debugger_input),bom(false)]).
@ -469,10 +469,10 @@ be lost.
'$debugger_expand_meta_call'(M:G, [], G1), '$debugger_expand_meta_call'(M:G, [], G1),
strip_module(G1, MF, NG), strip_module(G1, MF, NG),
gated_call( gated_call(
'$sys':enter_trace(GoalNumber, G, M, H), '$enter_trace'(GoalNumber, G, M, H),
'$debugger':execute_nonstop(NG,MF), '$execute_nonstop'(NG,MF),
Port, Port,
'$sys':trace_port(Port, GoalNumber, G, M, true, H) '$trace_port'(Port, GoalNumber, G, M, true, H)
). ).
% system_ % system_
'$trace_goal'(G, M, GoalNumber, H) :- '$trace_goal'(G, M, GoalNumber, H) :-
@ -483,24 +483,22 @@ be lost.
), ),
!, !,
gated_call( gated_call(
'$sys':enter_trace(GoalNumber, G, M, H), '$enter_trace'(GoalNumber, G, M, H),
'$debugger':execute_nonstop(G,M), '$execute_nonstop'(G,M),
Port, Port,
'$sys':trace_port(Port, GoalNumber, G, M, true, H) '$trace_port'(Port, GoalNumber, G, M, true, H)
). ).
'$trace_goal'(G, M, GoalNumber, H) :- '$trace_goal'(G, M, GoalNumber, H) :-
gated_call( gated_call(
'$sys':enter_trace(GoalNumber, G, M, H), '$enter_trace'(GoalNumber, G, M, H),
'$sys':debug( GoalNumber, G, M, H), '$debug'( GoalNumber, G, M, H),
Port, Port,
'$sys':trace_port(Port, GoalNumber, G, M, true, H) '$trace_port'(Port, GoalNumber, G, M, true, H)
). ).
'$debugger':execute_nonstop(G,M) :-
'$execute_nonstop'(G,M).
/** /**
* @pred '$sys':enter_trace(+L, 0:G, +Module, +Info) * @pred '$enter_trace'(+L, 0:G, +Module, +Info)
* *
* call goal: prelims * call goal: prelims
* *
@ -509,7 +507,7 @@ be lost.
* @parameter _Info_ describes the goal * @parameter _Info_ describes the goal
* *
*/ */
'$sys':enter_trace(L, G, Module, Info) :- '$enter_trace'(L, G, Module, Info) :-
/* get goal no. */ /* get goal no. */
( var(L) -> ( var(L) ->
'__NB_getval__'('$spy_gn',L,fail), '__NB_getval__'('$spy_gn',L,fail),
@ -537,7 +535,7 @@ be lost.
'__NB_setval__'('$spy_gn',L1). '__NB_setval__'('$spy_gn',L1).
/** /**
* @pred '$sys':enter_trace(+L, 0:G, +Module, +Info) * @pred '$enter_trace'(+L, 0:G, +Module, +Info)
* *
* call goal: setup the diferrent cases * call goal: setup the diferrent cases
* - zip, just run through * - zip, just run through
@ -550,16 +548,16 @@ be lost.
* *
*/ */
'$sys':debug(_, G, M, _H) :- '$debug'(_, G, M, _H) :-
'__NB_getval__'('$debug_status',state(zip,_Border,Spy), fail), '__NB_getval__'('$debug_status',state(zip,_Border,Spy), fail),
( Spy == stop -> \+ '$pred_being_spied'(G,M) ; true ), ( Spy == stop -> \+ '$pred_being_spied'(G,M) ; true ),
!, !,
'$execute_nonstop'( G, M ). '$execute_nonstop'( G, M ).
'$sys':debug(GoalNumber, G, M, Info) :- '$debug'(GoalNumber, G, M, Info) :-
'$is_source'(G,M), '$is_source'(G,M),
!, !,
'$trace_go'(GoalNumber, G, M, Info). '$trace_go'(GoalNumber, G, M, Info).
'$sys':debug(GoalNumber, G, M, Info) :- '$debug'(GoalNumber, G, M, Info) :-
'$creep_step'(GoalNumber, G, M, Info). '$creep_step'(GoalNumber, G, M, Info).
@ -600,7 +598,7 @@ be lost.
'$retry_clause'(GoalNumber, G, Module, Info, _X) :- '$retry_clause'(GoalNumber, G, Module, Info, _X) :-
'$trace_port_'(redo, GoalNumber, G, Module, Info). '$trace_port_'(redo, GoalNumber, G, Module, Info).
'$sys':trace_port(Port, GoalNumber, G, Module, _CalledFromDebugger, Info) :- '$trace_port'(Port, GoalNumber, G, Module, _CalledFromDebugger, Info) :-
'$stop_creeping'(_) , '$stop_creeping'(_) ,
current_prolog_flag(debug, true), current_prolog_flag(debug, true),
'__NB_getval__'('$debug_status',state(Skip,Border,_), fail), '__NB_getval__'('$debug_status',state(Skip,Border,_), fail),
@ -608,7 +606,7 @@ be lost.
!, !,
'__NB_setval__'('$debug_status', state(creep, 0, stop)), '__NB_setval__'('$debug_status', state(creep, 0, stop)),
'$trace_port_'(Port, GoalNumber, G, Module, Info). '$trace_port_'(Port, GoalNumber, G, Module, Info).
'$sys':trace_port(_Port, _GoalNumber, _G, _Module, _CalledFromDebugger, _Info). '$trace_port'(_Port, _GoalNumber, _G, _Module, _CalledFromDebugger, _Info).
'$trace_port_'(call, GoalNumber, G, Module, Info) :- '$trace_port_'(call, GoalNumber, G, Module, Info) :-
'$port'(call,G,Module,GoalNumber,deterministic, Info). '$port'(call,G,Module,GoalNumber,deterministic, Info).
@ -782,7 +780,7 @@ be lost.
skip( debugger_input, 10), skip( debugger_input, 10),
break, break,
fail. fail.
'$action'('A',_,_,_,_,_) :- !, % A ancestors '$action'('A',_,_,_,_,_) :- !, % 'b break
skip( debugger_input, 10), skip( debugger_input, 10),
'$stack_dump', '$stack_dump',
fail. fail.

8
pl/directives.yap
View File

@ -125,13 +125,11 @@
'$exec_directive'(multifile(D), _, M, _, _) :- '$exec_directive'(multifile(D), _, M, _, _) :-
catch(multifile(M:D), '$system_catch'('$multifile'(D, M), M,
Error, Error,
loop_Error(Error, top)). user:'$LoopError'(Error, top)).
'$exec_directive'(discontiguous(D), _, M, _, _) :- '$exec_directive'(discontiguous(D), _, M, _, _) :-
catch(discontiguous(M:D), '$discontiguous'(D,M).
Error,
loop_Error(Error, top)).
/** @pred initialization /** @pred initialization

8
pl/grammar.yap
View File

@ -94,10 +94,7 @@ Grammar related built-in predicates:
Also, phrase/2-3 check their first argument. Also, phrase/2-3 check their first argument.
*/ */
prolog:'$translate_rule'(Rule, T) :- prolog:'$translate_rule'(Rule, (NH :- B) ) :-
translate_rule(Rule, T ).
translate_rule(Rule, (NH :- B) ) :-
source_module( SM ), source_module( SM ),
'$yap_strip_module'( SM:Rule, M0, (LP-->RP) ), '$yap_strip_module'( SM:Rule, M0, (LP-->RP) ),
t_head(LP, NH0, NGs, S, SR, (LP-->SM:RP)), t_head(LP, NH0, NGs, S, SR, (LP-->SM:RP)),
@ -284,7 +281,7 @@ prolog:'\\+'(A, S0, S) :-
'$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal) :- '$c_built_in_phrase'(NT, Xs0, Xs, Mod, NewGoal) :-
nonvar(NT), nonvar(NT),
catch('$_grammar':translate_rule( catch(prolog:'$translate_rule'(
(pseudo_nt --> Mod:NT), Rule), (pseudo_nt --> Mod:NT), Rule),
error(Pat,ImplDep), error(Pat,ImplDep),
( \+ '$harmless_dcgexception'(Pat), ( \+ '$harmless_dcgexception'(Pat),
@ -326,4 +323,3 @@ do_c_built_in(phrase(NT,Xs),Mod,_,NewGoal) :-
/** /**
@} @}
*/ */

6
pl/init.yap
View File

@ -114,7 +114,7 @@
fail. fail.
'$startup_goals' :- '$startup_goals' :-
recorded('$startup_goal',G,_), recorded('$startup_goal',G,_),
catch(once(user:G),Error,error_handler(Error)), catch(once(user:G),Error,user:'$Error'(Error)),
fail. fail.
'$startup_goals' :- '$startup_goals' :-
get_value('$init_goal',GA), get_value('$init_goal',GA),
@ -125,7 +125,7 @@
'$startup_goals' :- '$startup_goals' :-
recorded('$restore_flag', goal(Module:GA), R), recorded('$restore_flag', goal(Module:GA), R),
erase(R), erase(R),
catch(once(Module:GA),Error,error_handler(Error)), catch(once(Module:GA),Error,user:'$Error'(Error)),
fail. fail.
'$startup_goals' :- '$startup_goals' :-
get_value('$myddas_goal',GA), GA \= [], get_value('$myddas_goal',GA), GA \= [],
@ -204,7 +204,7 @@
recorded('$restore_goal',G,R), recorded('$restore_goal',G,R),
erase(R), erase(R),
prompt(_,'| '), prompt(_,'| '),
catch(once(user:G),Error,error_handler(Error)), catch(once(user:G),Error,user:'$Error'(Error)),
fail. fail.
'$init_path_extensions' :- '$init_path_extensions' :-

1
pl/listing.yap
View File

@ -318,6 +318,7 @@ portray_clause(Clause) :-
'$beautify_vs'(T) :- '$beautify_vs'(T) :-
'$non_singletons_in_term'(T,[],Fs), '$non_singletons_in_term'(T,[],Fs),
writeln(Fs),
'$vv_transform'(Fs,1), '$vv_transform'(Fs,1),
term_variables(T, NFs), term_variables(T, NFs),
'$v_transform'(NFs). '$v_transform'(NFs).

2
pl/setof.yap
View File

@ -292,7 +292,7 @@ Note that all/3 will fail if no answers are found.
all(T, G same X,S) :- !, all(T same X,G,Sx), '$$produce'(Sx,S,X). all(T, G same X,S) :- !, all(T same X,G,Sx), '$$produce'(Sx,S,X).
all(T,G,S) :- all(T,G,S) :-
'$init_db_queue'(Ref), '$init_db_queue'(Ref),
( catch(G, Error,'$sys':clean_findall(Ref,Error) ), ( catch(G, Error,'$clean_findall'(Ref,Error) ),
'$execute'(G), '$execute'(G),
'$db_enqueue'(Ref, T), '$db_enqueue'(Ref, T),
fail fail

4
pl/threads.yap
View File

@ -132,11 +132,11 @@ volatile(P) :-
'$current_module'(Module), '$current_module'(Module),
'$run_at_thread_start', '$run_at_thread_start',
% always finish with a throw to make sure we clean stacks. % always finish with a throw to make sure we clean stacks.
catch((Module:G -> throw('$thread_finished'(true)) ; throw('$thread_finished'(false))),Exception,'$threads´:close_thread'(Exception,Detached)), '$system_catch'((G -> throw('$thread_finished'(true)) ; throw('$thread_finished'(false))),Module,Exception,'$close_thread'(Exception,Detached)),
% force backtracking and handling exceptions % force backtracking and handling exceptions
fail. fail.
'$threads´:close_thread'(Status, _Detached) :- '$close_thread'(Status, _Detached) :-
'$thread_zombie_self'(Id0), !, '$thread_zombie_self'(Id0), !,
'$record_thread_status'(Id0,Status), '$record_thread_status'(Id0,Status),
'$run_at_thread_exit'(Id0), '$run_at_thread_exit'(Id0),

170
pl/top.yap
View File

@ -30,7 +30,7 @@ live :-
; ;
format(user_error,'[~w]~n', [Module]) format(user_error,'[~w]~n', [Module])
), ),
'$enter_top_level'. '$system_catch'('$enter_top_level',Module,Error,'$Error'(Error)).
% Start file for yap % Start file for yap
@ -46,9 +46,18 @@ live :-
/* main execution loop */ /* main execution loop */
'$read_toplevel'(Goal, Bindings, Pos) :- '$read_toplevel'(Goal, Bindings, Pos) :-
'$prompt', '$prompt',
read_term(user_input, catch(read_term(user_input,
Goal, Goal,
[variable_names(Bindings), syntax_errors(dec10), term_position(Pos)]). [variable_names(Bindings), syntax_errors(dec10), term_position(Pos)]),
E, '$handle_toplevel_error'( E) ).
'$handle_toplevel_error'( syntax_error(_)) :-
!,
fail.
'$handle_toplevel_error'( error(io_error(read,user_input),_)) :-
!.
'$handle_toplevel_error'(_, E) :-
throw(E).
/** @pred stream_property( Stream, Prop ) /** @pred stream_property( Stream, Prop )
@ -76,7 +85,7 @@ live :-
% stop at spy-points if debugging is on. % stop at spy-points if debugging is on.
nb_setval('$debug_run',off), nb_setval('$debug_run',off),
nb_setval('$debug_jump',off), nb_setval('$debug_jump',off),
catch('$sys':command(Command,Varnames,Pos,top),E,error_handler(E)), '$command'(Command,Varnames,Pos,top),
current_prolog_flag(break_level, BreakLevel), current_prolog_flag(break_level, BreakLevel),
( (
BreakLevel \= 0 BreakLevel \= 0
@ -116,7 +125,7 @@ live :-
'$execute_commands'([C|Cs],M,VL,Pos,Con,Source) :- '$execute_commands'([C|Cs],M,VL,Pos,Con,Source) :-
!, !,
( (
'$execute_command'(C,M,VL,Pos,Con,Source), '$system_catch'('$execute_command'(C,M,VL,Pos,Con,Source),prolog,Error,'$LoopError'(Error, Con)),
fail fail
; ;
'$execute_commands'(Cs,M,VL,Pos,Con,Source) '$execute_commands'(Cs,M,VL,Pos,Con,Source)
@ -131,20 +140,20 @@ live :-
'$execute_command'(C,_,_,_,_,Source) :- '$execute_command'(C,_,_,_,_,Source) :-
var(C), var(C),
!, !,
'$do_error'(instantiation_error,meta_call(Source)). '$do_error'(instantiation_error,meta_call(Source)).
'$execute_command'(C,_,_,_,_top,Source) :- '$execute_command'(C,_,_,_,_top,Source) :-
number(C), number(C),
!, !,
'$do_error'(type_error(callable,C),meta_call(Source)). '$do_error'(type_error(callable,C),meta_call(Source)).
'$execute_command'(R,_,_,_,_top,Source) :- '$execute_command'(R,_,_,_,_top,Source) :-
db_reference(R), db_reference(R),
!, !,
'$do_error'(type_error(callable,R),meta_call(Source)). '$do_error'(type_error(callable,R),meta_call(Source)).
'$execute_command'(end_of_file,_,_,_,_,_) :- !. '$execute_command'(end_of_file,_,_,_,_,_) :- !.
'$execute_command'(Command,_,_,_,_,_) :- '$execute_command'(Command,_,_,_,_,_) :-
'__NB_getval__'('$if_skip_mode', skip, fail), '__NB_getval__'('$if_skip_mode', skip, fail),
\+ '$if_directive'(Command), \+ '$if_directive'(Command),
!. !.
'$execute_command'((:-G),M,VL,Pos,Option,_) :- '$execute_command'((:-G),M,VL,Pos,Option,_) :-
Option \= top, Option \= top,
!, % allow user expansion !, % allow user expansion
@ -153,29 +162,29 @@ live :-
( (
NO = (:- G1) NO = (:- G1)
-> ->
'$process_directive'(G1, Option, NM, VL, Pos) '$process_directive'(G1, Option, NM, VL, Pos)
; ;
'$execute_commands'(G1,NM,VL,Pos,Option,O) '$execute_commands'(G1,NM,VL,Pos,Option,O)
). ).
'$execute_command'((?-G), M, VL, Pos, Option, Source) :- '$execute_command'((?-G), M, VL, Pos, Option, Source) :-
Option \= top, Option \= top,
!, !,
'$execute_command'(G, M, VL, Pos, top, Source). '$execute_command'(G, M, VL, Pos, top, Source).
'$execute_command'(G, M, VL, Pos, Option, Source) :- '$execute_command'(G, M, VL, Pos, Option, Source) :-
'$continue_with_command'(Option, VL, Pos, M:G, Source). '$continue_with_command'(Option, VL, Pos, M:G, Source).
'$expand_term'(T,O) :- '$expand_term'(T,O) :-
'$expand_term'(T,top,O). '$expand_term'(T,top,O).
'$expand_term'(T,Con,O) :- '$expand_term'(T,Con,O) :-
'$expand_term0'(T,Con,O), catch( '$expand_term0'(T,Con,O), _,( '$disable_debugging', fail) ),
!. !.
'$expand_term0'(T,consult,O) :- '$expand_term0'(T,consult,O) :-
expand_term( T, O). expand_term( T, O).
'$expand_term0'(T,reconsult,O) :- '$expand_term0'(T,reconsult,O) :-
expand_term( T, O). expand_term( T, O).
'$expand_term0'(T,top,O) :- '$expand_term0'(T,top,O) :-
expand_term( T, T1), expand_term( T, T1),
!, !,
'$expand_term1'(T1,O). '$expand_term1'(T1,O).
@ -188,16 +197,16 @@ live :-
'$continue_with_command'(Where,V,'$stream_position'(C,_P,A1,A2,A3),'$source_location'(_F,L):G,Source) :- '$continue_with_command'(Where,V,'$stream_position'(C,_P,A1,A2,A3),'$source_location'(_F,L):G,Source) :-
!, !,
'$continue_with_command'(Where,V,'$stream_position'(C,L,A1,A2,A3),G,Source). '$continue_with_command'(Where,V,'$stream_position'(C,L,A1,A2,A3),G,Source).
'$continue_with_command'(reconsult,V,Pos,G,Source) :- '$continue_with_command'(reconsult,V,Pos,G,Source) :-
% writeln(G), % writeln(G),
'$go_compile_clause'(G,V,Pos,reconsult,Source), '$go_compile_clause'(G,V,Pos,reconsult,Source),
fail. fail.
'$continue_with_command'(consult,V,Pos,G,Source) :- '$continue_with_command'(consult,V,Pos,G,Source) :-
'$go_compile_clause'(G,V,Pos,consult,Source), '$go_compile_clause'(G,V,Pos,consult,Source),
fail. fail.
'$continue_with_command'(top,V,_,G,_) :- '$continue_with_command'(top,V,_,G,_) :-
'$query'(G,V). '$query'(G,V).
%% %%
% @pred '$go_compile_clause'(G,Vs,Pos, Where, Source) is det % @pred '$go_compile_clause'(G,Vs,Pos, Where, Source) is det
@ -282,31 +291,31 @@ live :-
'$yes_no'(G,(?-)). '$yes_no'(G,(?-)).
'$query'(G,V) :- '$query'(G,V) :-
( (
'$current_module'(M), '$current_module'(M),
'$current_choice_point'(CP), '$current_choice_point'(CP),
'$user_call'(G, M), '$user_call'(G, M),
'$current_choice_point'(NCP), '$current_choice_point'(NCP),
'$sys':delayed_goals(G, V, Vs, LGs, DCP), '$delayed_goals'(G, V, Vs, LGs, DCP),
'$write_answer'(Vs, LGs, Written), '$write_answer'(Vs, LGs, Written),
'$write_query_answer_true'(Written), '$write_query_answer_true'(Written),
( (
'$prompt_alternatives_on'(determinism), CP == NCP, DCP = 0 '$prompt_alternatives_on'(determinism), CP == NCP, DCP = 0
-> ->
format(user_error, '.~n', []), format(user_error, '.~n', []),
! !
; ;
'$another', '$another',
! !
), ),
fail fail
; ;
'$out_neg_answer' '$out_neg_answer'
). ).
'$yes_no'(G,C):- '$yes_no'(G,C) :-
'$current_module'(M), '$current_module'(M),
'$do_yes_no'(G,M), '$do_yes_no'(G,M),
'$sys':delayed_goals(G, [], NV, LGs, _), '$delayed_goals'(G, [], NV, LGs, _),
'$write_answer'(NV, LGs, Written), '$write_answer'(NV, LGs, Written),
( Written = [] -> ( Written = [] ->
!,'$present_answer'(C, true) !,'$present_answer'(C, true)
@ -321,15 +330,15 @@ live :-
'$process_answer'(Vs, LGs, Bindings) :- '$process_answer'(Vs, LGs, Bindings) :-
'$purge_dontcares'(Vs,IVs), '$purge_dontcares'(Vs,IVs),
'$sort'(IVs, NVs), '$sort'(IVs, NVs),
'$prep_answer_var_by_var'(NVs, LAnsw, LGs), '$prep_answer_var_by_var'(NVs, LAnsw, LGs),
'$name_vars_in_goals'(LAnsw, Vs, Bindings). '$name_vars_in_goals'(LAnsw, Vs, Bindings).
% %
% *-> at this point would require compiler support, which does not exist. % *-> at this point would require compiler support, which does not exist.
% %
'$sys':delayed_goals(G, V, NV, LGs, NCP) :- '$delayed_goals'(G, V, NV, LGs, NCP) :-
( (
'$$save_by'(NCP1), '$$save_by'(NCP1),
attributes:delayed_goals(G, V, NV, LGs), attributes:delayed_goals(G, V, NV, LGs),
@ -634,11 +643,10 @@ write_query_answer( Bindings ) :-
'$call'(M:_,_,G0,_) :- var(M), !, '$call'(M:_,_,G0,_) :- var(M), !,
'$do_error'(instantiation_error,call(G0)). '$do_error'(instantiation_error,call(G0)).
/*'$call'(M:G,CP,G0,_M0) :- !, '$call'(M:G,CP,G0,_M0) :- !,
'$expand_meta_call'(M:G, [], NG), '$expand_meta_call'(M:G, [], NG),
'$yap_strip_module'(NG,NM,NC), '$yap_strip_module'(NG,NM,NC),
'$call'(NC,CP,G0,NM). '$call'(NC,CP,G0,NM).
*/
'$call'((X,Y),CP,G0,M) :- !, '$call'((X,Y),CP,G0,M) :- !,
'$call'(X,CP,G0,M), '$call'(X,CP,G0,M),
'$call'(Y,CP,G0,M). '$call'(Y,CP,G0,M).
@ -740,7 +748,8 @@ write_query_answer( Bindings ) :-
prompt1(': '), prompt(_,' '), prompt1(': '), prompt(_,' '),
'$current_module'(OldModule), '$current_module'(OldModule),
repeat, repeat,
dbload_from_stream(Stream, OldModule, exo), '$system_catch'(dbload_from_stream(Stream, OldModule, exo), '$db_load', Error,
user:'$LoopError'(Error, top)),
prolog_flag(agc_margin,_,Old), prolog_flag(agc_margin,_,Old),
!. !.
'$loop'(Stream,db) :- '$loop'(Stream,db) :-
@ -748,13 +757,17 @@ write_query_answer( Bindings ) :-
prompt1(': '), prompt(_,' '), prompt1(': '), prompt(_,' '),
'$current_module'(OldModule), '$current_module'(OldModule),
repeat, repeat,
dbload_from_stream(Stream, OldModule, db), '$system_catch'(dbload_from_stream(Stream, OldModule, db), '$db_load', Error,
user:'$LoopError'(Error, top)),
prolog_flag(agc_margin,_,Old), prolog_flag(agc_margin,_,Old),
!. !.
'$loop'(Stream,Status) :- '$loop'(Stream,Status) :-
repeat, repeat,
'$current_module'( OldModule, OldModule ), '$current_module'( OldModule, OldModule ),
'$enter_command'(Stream,OldModule,Status), '$system_catch'( '$enter_command'(Stream,OldModule,Status),
OldModule, Error,
user:'$LoopError'(Error, Status)
),
!. !.
'$boot_loop'(Stream,Where) :- '$boot_loop'(Stream,Where) :-
@ -762,19 +775,22 @@ write_query_answer( Bindings ) :-
'$current_module'( OldModule, OldModule ), '$current_module'( OldModule, OldModule ),
read_clause(Stream, Command, [module(OldModule), syntax_errors(dec10),variable_names(_Vars), term_position(_Pos)]), read_clause(Stream, Command, [module(OldModule), syntax_errors(dec10),variable_names(_Vars), term_position(_Pos)]),
(Command == end_of_file (Command == end_of_file
-> ->
! !
; ;
Command = (:- Goal) -> Command = (:- Goal) ->
'$boot_execute'(Goal), '$system_catch'('$boot_execute'(Goal), prolog, Error,
fail user:'$LoopError'(Error, consult) ),
; fail
Command = (H --> B) -> ;
'$boot_dcg'(H,B, Where), Command = (H --> B) ->
'$system_catch'('$boot_dcg'(H,B, Where), prolog, Error,
user:'$LoopError'(Error, consult) ),
fail fail
; ;
'$boot_clause'( Command, Where ), '$system_catch'('$boot_clause'( Command, Where ), prolog, Error,
user:'$LoopError'(Error, consult) ),
fail fail
). ).
@ -800,9 +816,8 @@ write_query_answer( Bindings ) :-
'$enter_command'(Stream, Mod, Status) :- '$enter_command'(Stream, Mod, Status) :-
prompt1(': '), prompt1(': '), prompt(_,' '),
prompt(_,' '), Options = [module(Mod), syntax_errors(dec10),variable_names(Vars), term_position(Pos)],
Options = [module(Mod), syntax_errors(dec10),variable_names(Vars), term_position(Pos)],
( (
Status == top Status == top
-> ->
@ -810,7 +825,7 @@ write_query_answer( Bindings ) :-
; ;
read_clause(Stream, Command, Options) read_clause(Stream, Command, Options)
), ),
catch('$sys':command(Command,Vars,Pos, Status), Error, error_handler(Error,top)). '$command'(Command,Vars,Pos, Status).
/** @pred user:expand_term( _T_,- _X_) is dynamic,multifile. /** @pred user:expand_term( _T_,- _X_) is dynamic,multifile.
@ -909,7 +924,7 @@ expand_term(Term,Expanded) :-
% Grammar Rules expansion % Grammar Rules expansion
% %
'$expand_term_grammar'((A-->B), C) :- '$expand_term_grammar'((A-->B), C) :-
'$translate_rule'((A-->B),C), !. prolog:'$translate_rule'((A-->B),C), !.
'$expand_term_grammar'(A, A). '$expand_term_grammar'(A, A).
% %
@ -1020,8 +1035,7 @@ a matching catch/3, or until reaching top-level.
current_prolog_flag(break_level, 0 ), current_prolog_flag(break_level, 0 ),
recorded('$toplevel_hooks',H,_), recorded('$toplevel_hooks',H,_),
H \= fail, !, H \= fail, !,
ignore(user:H), ( call(user:H) -> true ; true).
fail.
'$run_toplevel_hooks'. '$run_toplevel_hooks'.
'$run_at_thread_start' :- '$run_at_thread_start' :-

2
pl/yio.yap
View File

@ -181,7 +181,7 @@ display(Stream, T) :-
/* interface to user portray */ /* interface to user portray */
'$portray'(T) :- '$portray'(T) :-
\+ '$undefined'(portray(_),user), \+ '$undefined'(portray(_),user),
catch(user:portray(T),Error,error_handler(Error)), !, catch(user:portray(T),Error,user:'$Error'(Error)), !,
set_value('$portray',true), fail. set_value('$portray',true), fail.
'$portray'(_) :- set_value('$portray',false), fail. '$portray'(_) :- set_value('$portray',false), fail.