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

reset

Browse Source
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?
*/
inline static bool CallMetaCall(Term t, Term mod USES_REGS) {
// we have a creep requesr waiting
// we have a creep requesr waiting
ARG1 = t;
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) {
BACKUP_MACHINE_REGS();
yhandle_t sl = Yap_StartSlots();
Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL);
PredEntry *pe;
@ -1056,15 +1055,12 @@ static Int _user_expand_goal(USES_REGS1) {
Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL PASS_REGS, false)) {
RECOVER_MACHINE_REGS();
return complete_ge(true, omod, sl, creeping);
}
RECOVER_MACHINE_REGS();
return complete_ge(false, omod, sl, creeping);
}
static Int do_term_expansion(USES_REGS1) {
BACKUP_MACHINE_REGS();
yhandle_t sl = Yap_StartSlots();
Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL);
PredEntry *pe;
@ -1079,7 +1075,6 @@ static Int do_term_expansion(USES_REGS1) {
Yap_GetPredPropByFunc(FunctorTermExpansion, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
RECOVER_MACHINE_REGS();
return complete_ge(true, omod, sl, creeping);
}
/* CurMod:term_expansion(A,B) */
@ -1088,7 +1083,6 @@ static Int do_term_expansion(USES_REGS1) {
(pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, cmod))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
RECOVER_MACHINE_REGS();
return complete_ge(true, omod, sl, creeping);
}
/* system:term_expansion(A,B) */
@ -1100,10 +1094,8 @@ static Int do_term_expansion(USES_REGS1) {
Yap_GetPredPropByFunc(FunctorTermExpansion, SYSTEM_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
RECOVER_MACHINE_REGS();
return complete_ge(true, omod, sl, creeping);
}
RECOVER_MACHINE_REGS();
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 *CodeAdr;
bool out;
saved_p = P;
saved_cp = CP;
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;
while(IsVarTerm(*pt2))
pt2 = (CELL *)(*pt2);
HR[1] = AbsPair(HR+2);
HR[0] = AbsPair(HR+2);
HR += 2;
HR[-2] = (CELL)pt2;
HR[-1] = (CELL)pt2;
*pt2 = TermRefoundVar;
}
continue;
@ -3035,8 +3035,8 @@ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt
clean_tr(TR0 PASS_REGS);
if (HR != InitialH) {
/* close the list */
RESET_VARIABLE(HR-1);
Yap_unify((CELL)(HR-1),ARG2);
RESET_VARIABLE(HR-2);
Yap_unify((CELL)(HR-2),ARG2);
return output;
} else {
return ARG2;
@ -3067,7 +3067,7 @@ p_non_singletons_in_term( USES_REGS1 ) /* non_singletons in term t */
while (TRUE) {
t = Deref(ARG1);
if (IsVarTerm(t)) {
out = MkPairTerm(t,ARG2);
out = ARG2;
} else if (IsPrimitiveTerm(t)) {
out = ARG2;
} else if (IsPairTerm(t)) {

2
os/yio.yap
View File

@ -181,7 +181,7 @@ display(Stream, T) :-
/* interface to user portray */
'$portray'(T) :-
\+ '$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.
'$portray'(_) :- set_value('$portray',false), fail.

38
pl/absf.yap
View File

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

29
pl/boot.yap
View File

@ -50,7 +50,30 @@ private(_).
(not)/1,
repeat/0,
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]).
@ -189,11 +212,11 @@ print_message(L,E) :-
:- c_compile('directives.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 */
'$yap_strip_module'(C, EM, EG),
'$execute_command'(EG,EM,VL,Pos,Con,_Source).
'$sys':command(C,VL,Pos,Con) :-
'$command'(C,VL,Pos,Con) :-
( (Con = top ; var(C) ; C = [_|_]) ->
'$yap_strip_module'(C, EM, EG),
'$execute_command'(EG,EM,VL,Pos,Con,C) ;

46
pl/consult.yap
View File

@ -40,7 +40,21 @@
source_file/2,
source_file_property/2,
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]).
@ -834,7 +848,7 @@ nb_setval('$if_le1vel',0).
erase(R),
G \= '$',
strip_module(user:G, M0, G0),
( catch(M0:G0, Error, error_handler(Error, top))
( catch(M0:G0, Error, user:'$LoopError'(Error, top))
->
true
;
@ -851,7 +865,7 @@ nb_setval('$if_le1vel',0).
'$process_init_goal'([G|_]) :-
'$yap_strip_module'( G, M0, G0),
(
catch(M0:G0, Error, error_handler(Error, top))
catch(M0:G0, Error, user:'$LoopError'(Error, top))
->
true
;
@ -915,7 +929,7 @@ nb_setval('$if_le1vel',0).
'$init_win_graphics',
fail.
'$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).
'$do_startup_reconsult'(_).
@ -1455,24 +1469,7 @@ Similar to initialization/1, but allows for specifying when
*/
initialization(G,OPT) :-
must_be_of_type(callable, G0, initialization(G0,OPT)),
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, _ )
),
catch('$initialization'(G, OPT), Error, '$LoopError'( Error, consult ) ),
fail.
initialization(_G,_OPT).
@ -1653,9 +1650,8 @@ End of conditional compilation.
nb_setval('$if_skip_mode',OldMode).
'$if_call'(Goal) :-
'$expand_term'(Goal,TrueGoal),
catch(once(TrueGoal), E, (print_message(error, E), fail)).
'$if_call'(G) :-
catch('$eval_if'(G), E, (print_message(error, E), fail)).
'$eval_if'(Goal) :-
'$expand_term'(Goal,TrueGoal),

61
pl/control.yap
View File

@ -390,19 +390,19 @@ version(T) :-
'$set_toplevel_hook'(_).
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).
'$sys':answer( answer, LGs, Vs, Bindings) :-
'$answer'( answer, LGs, Vs, Bindings) :-
!,
'$process_answer'(Vs, LGs, Bindings).
'$sys':answer(!, _, _, _).
'$sys':answer(fail,_,_,_).
'$sys':answer(exception(E),_,_,_) :-
'$answer'(!, _, _, _).
'$answer'(fail,_,_,_).
'$answer'(exception(E),_,_,_) :-
'$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
debugger state */
'$debug_state'(state(Trace, Debug, State, SPY_GN, GList)) :-
'$debug_state'(state(Trace, Debug, State, SPY_GN, GList, GDList)) :-
'$init_debugger',
nb_getval('$trace',Trace),
nb_getval('$debug_state',State),
current_prolog_flag(debug, Debug),
nb_getval('$spy_gn',SPY_GN),
b_getval('$spy_glist',GList).
b_getval('$spy_glist',GList),
b_getval('$spy_depth',GDList).
'$debug_stop' :-
@ -485,15 +486,17 @@ b_getval(GlobalVariable, Val) :-
b_setval('$trace',off),
set_prolog_flag(debug, false),
b_setval('$spy_glist',[]),
b_setval('$spy_gdlist',[]).
b_setval('$spy_gdlist',[]),
'$disable_debugging'.
'$debug_restart'(state(Trace, Debug, State, SPY_GN, GList)) :-
'$debug_restart'(state(Trace, Debug, State, SPY_GN, GList, GDList)) :-
b_setval('$spy_glist',GList),
b_setval('$spy_gdlist',GDList),
b_setval('$spy_gn',SPY_GN),
set_prolog_flag(debug, Debug),
nb_setval('$debug_state',State),
b_setval('$trace',Trace).
nb_setval('$debug_state',State),
b_setval('$trace',Trace),
'$enable_debugging'.
/** @pred break
@ -512,34 +515,20 @@ debugging.
*/
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_start',
'$break'( true ),
yap_flag( user_input, InpStream ),
yap_flag( user_output, OutStream ),
yap_flag( user_error, ErrStream ),
current_output(OutStream), current_input(InpStream),
current_prolog_flag(break_level, BL ),
NBL is BL+1,
set_prolog_flag(break_level, NBL ).
'$do_break'(NBL) :-
format(user_error, '% Break (level ~w)~n', [NBL]),
set_prolog_flag(break_level, NBL ),
format(user_error, '% Break (level ~w)~n', [NBL]),
'$do_live',
!.
'$leave_break'(DState,streams(InpStream,OutStream,ErrStream),BL) :-
!,
set_value('$live','$true'),
'$debug_restore'(DState),
yap_flag( user_input, InpStream ),
yap_flag( user_output, OutStream ),
yap_flag( user_error, ErrStream ),
set_input(InpStream),
set_output(OutStream),
set_prolog_flag(break_level, BL ),
'$break'( false ).
@ -599,7 +588,7 @@ halt(X) :-
'$run_atom_goal'(GA) :-
'$current_module'(Module),
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'.],[0'.]) :- !.

58
pl/debug.yap
View File

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

8
pl/directives.yap
View File

@ -125,13 +125,11 @@
'$exec_directive'(multifile(D), _, M, _, _) :-
catch(multifile(M:D),
'$system_catch'('$multifile'(D, M), M,
Error,
loop_Error(Error, top)).
user:'$LoopError'(Error, top)).
'$exec_directive'(discontiguous(D), _, M, _, _) :-
catch(discontiguous(M:D),
Error,
loop_Error(Error, top)).
'$discontiguous'(D,M).
/** @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.
*/
prolog:'$translate_rule'(Rule, T) :-
translate_rule(Rule, T ).
translate_rule(Rule, (NH :- B) ) :-
prolog:'$translate_rule'(Rule, (NH :- B) ) :-
source_module( SM ),
'$yap_strip_module'( SM:Rule, M0, (LP-->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) :-
nonvar(NT),
catch('$_grammar':translate_rule(
catch(prolog:'$translate_rule'(
(pseudo_nt --> Mod:NT), Rule),
error(Pat,ImplDep),
( \+ '$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.
'$startup_goals' :-
recorded('$startup_goal',G,_),
catch(once(user:G),Error,error_handler(Error)),
catch(once(user:G),Error,user:'$Error'(Error)),
fail.
'$startup_goals' :-
get_value('$init_goal',GA),
@ -125,7 +125,7 @@
'$startup_goals' :-
recorded('$restore_flag', goal(Module:GA), R),
erase(R),
catch(once(Module:GA),Error,error_handler(Error)),
catch(once(Module:GA),Error,user:'$Error'(Error)),
fail.
'$startup_goals' :-
get_value('$myddas_goal',GA), GA \= [],
@ -204,7 +204,7 @@
recorded('$restore_goal',G,R),
erase(R),
prompt(_,'| '),
catch(once(user:G),Error,error_handler(Error)),
catch(once(user:G),Error,user:'$Error'(Error)),
fail.
'$init_path_extensions' :-

1
pl/listing.yap
View File

@ -318,6 +318,7 @@ portray_clause(Clause) :-
'$beautify_vs'(T) :-
'$non_singletons_in_term'(T,[],Fs),
writeln(Fs),
'$vv_transform'(Fs,1),
term_variables(T, 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,S) :-
'$init_db_queue'(Ref),
( catch(G, Error,'$sys':clean_findall(Ref,Error) ),
( catch(G, Error,'$clean_findall'(Ref,Error) ),
'$execute'(G),
'$db_enqueue'(Ref, T),
fail

4
pl/threads.yap
View File

@ -132,11 +132,11 @@ volatile(P) :-
'$current_module'(Module),
'$run_at_thread_start',
% 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
fail.
'$threads´:close_thread'(Status, _Detached) :-
'$close_thread'(Status, _Detached) :-
'$thread_zombie_self'(Id0), !,
'$record_thread_status'(Id0,Status),
'$run_at_thread_exit'(Id0),

170
pl/top.yap
View File

@ -30,7 +30,7 @@ live :-
;
format(user_error,'[~w]~n', [Module])
),
'$enter_top_level'.
'$system_catch'('$enter_top_level',Module,Error,'$Error'(Error)).
% Start file for yap
@ -46,9 +46,18 @@ live :-
/* main execution loop */
'$read_toplevel'(Goal, Bindings, Pos) :-
'$prompt',
read_term(user_input,
catch(read_term(user_input,
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 )
@ -76,7 +85,7 @@ live :-
% stop at spy-points if debugging is on.
nb_setval('$debug_run',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),
(
BreakLevel \= 0
@ -116,7 +125,7 @@ live :-
'$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
;
'$execute_commands'(Cs,M,VL,Pos,Con,Source)
@ -131,20 +140,20 @@ live :-
'$execute_command'(C,_,_,_,_,Source) :-
var(C),
!,
'$do_error'(instantiation_error,meta_call(Source)).
'$do_error'(instantiation_error,meta_call(Source)).
'$execute_command'(C,_,_,_,_top,Source) :-
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) :-
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'(Command,_,_,_,_,_) :-
'__NB_getval__'('$if_skip_mode', skip, fail),
\+ '$if_directive'(Command),
!.
'__NB_getval__'('$if_skip_mode', skip, fail),
\+ '$if_directive'(Command),
!.
'$execute_command'((:-G),M,VL,Pos,Option,_) :-
Option \= top,
!, % allow user expansion
@ -153,29 +162,29 @@ live :-
(
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) :-
Option \= top,
!,
'$execute_command'(G, M, VL, Pos, top, Source).
Option \= top,
!,
'$execute_command'(G, M, VL, Pos, top, 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,top,O).
'$expand_term'(T,top,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_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).
@ -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,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) :-
% writeln(G),
'$go_compile_clause'(G,V,Pos,reconsult,Source),
fail.
'$go_compile_clause'(G,V,Pos,reconsult,Source),
fail.
'$continue_with_command'(consult,V,Pos,G,Source) :-
'$go_compile_clause'(G,V,Pos,consult,Source),
fail.
'$go_compile_clause'(G,V,Pos,consult,Source),
fail.
'$continue_with_command'(top,V,_,G,_) :-
'$query'(G,V).
'$query'(G,V).
%%
% @pred '$go_compile_clause'(G,Vs,Pos, Where, Source) is det
@ -282,31 +291,31 @@ live :-
'$yes_no'(G,(?-)).
'$query'(G,V) :-
(
'$current_module'(M),
'$current_choice_point'(CP),
'$user_call'(G, M),
'$current_choice_point'(NCP),
'$sys':delayed_goals(G, V, Vs, LGs, DCP),
'$write_answer'(Vs, LGs, Written),
'$write_query_answer_true'(Written),
(
'$prompt_alternatives_on'(determinism), CP == NCP, DCP = 0
->
format(user_error, '.~n', []),
!
;
'$another',
!
),
fail
'$current_module'(M),
'$current_choice_point'(CP),
'$user_call'(G, M),
'$current_choice_point'(NCP),
'$delayed_goals'(G, V, Vs, LGs, DCP),
'$write_answer'(Vs, LGs, Written),
'$write_query_answer_true'(Written),
(
'$prompt_alternatives_on'(determinism), CP == NCP, DCP = 0
->
format(user_error, '.~n', []),
!
;
'$another',
!
),
fail
;
'$out_neg_answer'
'$out_neg_answer'
).
'$yes_no'(G,C):-
'$yes_no'(G,C) :-
'$current_module'(M),
'$do_yes_no'(G,M),
'$sys':delayed_goals(G, [], NV, LGs, _),
'$delayed_goals'(G, [], NV, LGs, _),
'$write_answer'(NV, LGs, Written),
( Written = [] ->
!,'$present_answer'(C, true)
@ -321,15 +330,15 @@ live :-
'$process_answer'(Vs, LGs, Bindings) :-
'$purge_dontcares'(Vs,IVs),
'$sort'(IVs, NVs),
'$prep_answer_var_by_var'(NVs, LAnsw, LGs),
'$name_vars_in_goals'(LAnsw, Vs, Bindings).
'$purge_dontcares'(Vs,IVs),
'$sort'(IVs, NVs),
'$prep_answer_var_by_var'(NVs, LAnsw, LGs),
'$name_vars_in_goals'(LAnsw, Vs, Bindings).
%
% *-> 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),
attributes:delayed_goals(G, V, NV, LGs),
@ -634,11 +643,10 @@ write_query_answer( Bindings ) :-
'$call'(M:_,_,G0,_) :- var(M), !,
'$do_error'(instantiation_error,call(G0)).
/*'$call'(M:G,CP,G0,_M0) :- !,
'$call'(M:G,CP,G0,_M0) :- !,
'$expand_meta_call'(M:G, [], NG),
'$yap_strip_module'(NG,NM,NC),
'$call'(NC,CP,G0,NM).
*/
'$call'((X,Y),CP,G0,M) :- !,
'$call'(X,CP,G0,M),
'$call'(Y,CP,G0,M).
@ -740,7 +748,8 @@ write_query_answer( Bindings ) :-
prompt1(': '), prompt(_,' '),
'$current_module'(OldModule),
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),
!.
'$loop'(Stream,db) :-
@ -748,13 +757,17 @@ write_query_answer( Bindings ) :-
prompt1(': '), prompt(_,' '),
'$current_module'(OldModule),
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),
!.
'$loop'(Stream,Status) :-
repeat,
'$current_module'( OldModule, OldModule ),
'$enter_command'(Stream,OldModule,Status),
'$current_module'( OldModule, OldModule ),
'$system_catch'( '$enter_command'(Stream,OldModule,Status),
OldModule, Error,
user:'$LoopError'(Error, Status)
),
!.
'$boot_loop'(Stream,Where) :-
@ -762,19 +775,22 @@ write_query_answer( Bindings ) :-
'$current_module'( OldModule, OldModule ),
read_clause(Stream, Command, [module(OldModule), syntax_errors(dec10),variable_names(_Vars), term_position(_Pos)]),
(Command == end_of_file
->
!
->
!
;
Command = (:- Goal) ->
'$boot_execute'(Goal),
fail
;
Command = (H --> B) ->
'$boot_dcg'(H,B, Where),
Command = (:- Goal) ->
'$system_catch'('$boot_execute'(Goal), prolog, Error,
user:'$LoopError'(Error, consult) ),
fail
;
Command = (H --> B) ->
'$system_catch'('$boot_dcg'(H,B, Where), prolog, Error,
user:'$LoopError'(Error, consult) ),
fail
;
'$boot_clause'( Command, Where ),
'$system_catch'('$boot_clause'( Command, Where ), prolog, Error,
user:'$LoopError'(Error, consult) ),
fail
).
@ -800,9 +816,8 @@ write_query_answer( Bindings ) :-
'$enter_command'(Stream, Mod, Status) :-
prompt1(': '),
prompt(_,' '),
Options = [module(Mod), syntax_errors(dec10),variable_names(Vars), term_position(Pos)],
prompt1(': '), prompt(_,' '),
Options = [module(Mod), syntax_errors(dec10),variable_names(Vars), term_position(Pos)],
(
Status == top
->
@ -810,7 +825,7 @@ write_query_answer( Bindings ) :-
;
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.
@ -909,7 +924,7 @@ expand_term(Term,Expanded) :-
% Grammar Rules expansion
%
'$expand_term_grammar'((A-->B), C) :-
'$translate_rule'((A-->B),C), !.
prolog:'$translate_rule'((A-->B),C), !.
'$expand_term_grammar'(A, A).
%
@ -1020,8 +1035,7 @@ a matching catch/3, or until reaching top-level.
current_prolog_flag(break_level, 0 ),
recorded('$toplevel_hooks',H,_),
H \= fail, !,
ignore(user:H),
fail.
( call(user:H) -> true ; true).
'$run_toplevel_hooks'.
'$run_at_thread_start' :-

2
pl/yio.yap
View File

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