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

hide´

Browse Source
This commit is contained in:
Vitor Santos Costa 2018-11-02 15:32:05 +00:00
parent a6090a61ab
commit 4a0dd26ecb
12 changed files with 178 additions and 179 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
C/absmi.c
View File

@ -957,15 +957,14 @@ static void undef_goal(USES_REGS1) {
} else { } else {
d0 = AbsAppl(HR); d0 = AbsAppl(HR);
*HR++ = (CELL)pe->FunctorOfPred; *HR++ = (CELL)pe->FunctorOfPred;
CELL *ip=HR, *imax = HR+pe->ArityOfPE; CELL *ip=HR;
HR = imax; UInt imax = pe->ArityOfPE;
BEGP(pt1); HR += imax;
pt1 = XREGS + 1; UInt i = 1;
for (; ip < imax; ip++) { for (; i <= imax; ip++, i++) {
BEGD(d1); BEGD(d1);
BEGP(pt0); BEGP(pt0);
pt0 = pt1++; d1 = XREGS[i];
d1 = *pt0;
deref_head(d1, undef_unk); deref_head(d1, undef_unk);
undef_nonvar: undef_nonvar:
/* just copy it to the heap */ /* just copy it to the heap */
@ -973,19 +972,17 @@ static void undef_goal(USES_REGS1) {
continue; continue;
derefa_body(d1, pt0, undef_unk, undef_nonvar); derefa_body(d1, pt0, undef_unk, undef_nonvar);
if (pt0 <= HR) { if (pt0 < HR) {
/* variable is safe */ /* variable is safe */
*ip = (CELL)pt0; *ip = (CELL)pt0;
} else { } else {
/* bind it, in case it is a local variable */ /* bind it, in case it is a local variable */
d1 = Unsigned(ip);
RESET_VARIABLE(ip); RESET_VARIABLE(ip);
Bind_Local(pt0, d1); Bind_Local(pt0, Unsigned(ip));
} }
ENDP(pt0); ENDP(pt0);
ENDD(d1); ENDD(d1);
} }
ENDP(pt1);
} }
ARG1 = AbsPair(HR); ARG1 = AbsPair(HR);
HR[1] = d0; HR[1] = d0;

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(
'$enter_absf'( File, LOpts, Opts, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ), '$sys':enter_absf( File, LOpts, Opts, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ),
'$find_in_path'(File, Opts,TrueFileName, HasSol, TakeFirst), '$sys':find_in_path(File, Opts,TrueFileName, HasSol, TakeFirst),
Port, Port,
'$absf_port'(Port, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) '$sys':absf_port(Port, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors )
). ).
'$enter_absf'( File, LOpts, Opts, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :- '$sys':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).
'$absf_port'(answer, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :- '$sys':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 ). '$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 ) :-
(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]).
'$absf_port'(redo, File, _TrueFileName, _HasSol, _OldF, _PreviousFileErrors, _PreviousVerbose, Expand, Verbose, _TakeFirst, FileErrors ) :- '$sys':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]).
'$absf_port'(fail, 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_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, ['...'])).
'$absf_port'(!, _File, _TrueFileName, _HasSol, _OldF, _PreviousFileErrors, _PreviousVerbose, _Expand, _Verbose, _TakeFirst, _FileErrors ). '$sys':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 ) :- '$sys':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 ). '$sys':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 ) :- '$sys':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 ). '$sys':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
'$find_in_path'(user,_,user_input, _, _) :- !. '$sys':find_in_path(user,_,user_input, _, _) :- !.
'$find_in_path'(user_input,_,user_input, _, _) :- !. '$sys':find_in_path(user_input,_,user_input, _, _) :- !.
'$find_in_path'(user_output,_,user_ouput, _, _) :- !. '$sys':find_in_path(user_output,_,user_ouput, _, _) :- !.
'$find_in_path'(user_error,_,user_error, _, _) :- !. '$sys':find_in_path(user_error,_,user_error, _, _) :- !.
'$find_in_path'(Name, Opts, File, _, First) :- '$sys':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 ),

9
pl/boot.yap
View File

@ -87,11 +87,6 @@ private(_).
% be careful here not to generate an undefined exception.. % be careful here not to generate an undefined exception..
'$setup_call_catcher_cleanup'(Setup, Goal, Catcher, Cleanup) :-
'$setup_call_catcher_cleanup'('$h'(Setup)),
'$gated_call'( false , '$h'(Goal), Catcher, '$h'(Cleanup)) .
print_message(L,E) :- print_message(L,E) :-
'$number_of_clauses'(print_message(L,E), prolog_complete, 1), '$number_of_clauses'(print_message(L,E), prolog_complete, 1),
!, !,
@ -194,11 +189,11 @@ print_message(L,E) :-
:- c_compile('directives.yap'). :- c_compile('directives.yap').
:- c_compile('init.yap'). :- c_compile('init.yap').
'$command'(C,VL,Pos,Con) :- '$sys':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).
'$command'(C,VL,Pos,Con) :- '$sys':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) ;

28
pl/consult.yap
View File

@ -834,7 +834,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, user:'$LoopError'(Error, top)) ( catch(M0:G0, Error, loop_error(Error, top))
-> ->
true true
; ;
@ -851,7 +851,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, user:'$LoopError'(Error, top)) catch(M0:G0, Error, loop_error(Error, top))
-> ->
true true
; ;
@ -915,7 +915,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, '$LoopError'(Error, consult)), catch(load_files(user:X, [silent(true)]), Error, loop_error(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,7 +1455,24 @@ Similar to initialization/1, but allows for specifying when
*/ */
initialization(G,OPT) :- initialization(G,OPT) :-
catch('$initialization'(G, OPT), Error, '$LoopError'( Error, consult ) ), 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,loop_error(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).
@ -1641,7 +1658,8 @@ End of conditional compilation.
catch(once(TrueGoal), E, (print_message(error, E), fail)). catch(once(TrueGoal), E, (print_message(error, E), fail)).
'$eval_if'(Goal) :- '$eval_if'(Goal) :-
once(TrueGoal). '$expand_term'(Goal,TrueGoal),
once(TrueGoal).
'$if_directive'((:- if(_))). '$if_directive'((:- if(_))).
'$if_directive'((:- else)). '$if_directive'((:- else)).

16
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,'$delayed_goals'(G, V, Vs, LGs, _DCP)), Status, '$answer'( Status, LGs, Vs, Bindings) ). gated_call( true, (G,'$sys':delayed_goals(G, V, Vs, LGs, _DCP)), Status, '$sys':answer( Status, LGs, Vs, Bindings) ).
'$answer'( exit, LGs, Vs, Bindings) :- '$sys':answer( exit, LGs, Vs, Bindings) :-
!, !,
'$process_answer'(Vs, LGs, Bindings). '$process_answer'(Vs, LGs, Bindings).
'$answer'( answer, LGs, Vs, Bindings) :- '$sys':answer( answer, LGs, Vs, Bindings) :-
!, !,
'$process_answer'(Vs, LGs, Bindings). '$process_answer'(Vs, LGs, Bindings).
'$answer'(!, _, _, _). '$sys':answer(!, _, _, _).
'$answer'(fail,_,_,_). '$sys':answer(fail,_,_,_).
'$answer'(exception(E),_,_,_) :- '$sys':answer(exception(E),_,_,_) :-
'$LoopError'(E,error). '$LoopError'(E,error).
'$answer'(external_exception(_),_,_,_). '$sys':answer(external_exception(_),_,_,_).
%% @} %% @}
@ -599,7 +599,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,user:'$Error'(Error)). catch(once(Module:G), Error,loop_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'.]) :- !.

56
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_input', '$debugger':d_input,
EG, EG,
E, E,
'$continue_debugging'(E) '$debugger':d_continue(E)
). ).
'$continue_debugging'(exit) :- !, '$creep'. '$debugger':d_continue(exit) :- !, '$creep'.
'$continue_debugging'(answer) :- !, '$creep'. '$debugger':d_continue(answer) :- !, '$creep'.
'$continue_debugging'(fail) :- !, '$creep'. '$debugger':d_continue(fail) :- !, '$creep'.
'$continue_debugging'(_). '$debugger':d_continue(_).
@ -374,19 +374,19 @@ be lost.
* user_input is bound to a file. * user_input is bound to a file.
* *
*/ */
'$debugger_input' :- '$debugger':d_input :-
stream_property(_,alias(debugger_input)), stream_property(_,alias(debugger_input)),
!. !.
'$debugger_input' :- '$debugger':d_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_input' :- '$debugger':d_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_input' :- '$debugger':d_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(
'$enter_trace'(GoalNumber, G, M, H), '$sys':enter_trace(GoalNumber, G, M, H),
'$execute_nonstop'(NG,MF), '$debugger':execute_nonstop(NG,MF),
Port, Port,
'$trace_port'(Port, GoalNumber, G, M, true, H) '$sys':trace_port(Port, GoalNumber, G, M, true, H)
). ).
% system_ % system_
'$trace_goal'(G, M, GoalNumber, H) :- '$trace_goal'(G, M, GoalNumber, H) :-
@ -483,22 +483,24 @@ be lost.
), ),
!, !,
gated_call( gated_call(
'$enter_trace'(GoalNumber, G, M, H), '$sys':enter_trace(GoalNumber, G, M, H),
'$execute_nonstop'(G,M), '$debugger':execute_nonstop(G,M),
Port, Port,
'$trace_port'(Port, GoalNumber, G, M, true, H) '$sys':trace_port(Port, GoalNumber, G, M, true, H)
). ).
'$trace_goal'(G, M, GoalNumber, H) :- '$trace_goal'(G, M, GoalNumber, H) :-
gated_call( gated_call(
'$enter_trace'(GoalNumber, G, M, H), '$sys':enter_trace(GoalNumber, G, M, H),
'$debug'( GoalNumber, G, M, H), '$sys':debug( GoalNumber, G, M, H),
Port, Port,
'$trace_port'(Port, GoalNumber, G, M, true, H) '$sys':trace_port(Port, GoalNumber, G, M, true, H)
). ).
'$debugger':execute_nonstop(G,M) :-
'$execute_nonstop'(G,M)
/** /**
* @pred '$enter_trace'(+L, 0:G, +Module, +Info) * @pred '$sys':enter_trace(+L, 0:G, +Module, +Info)
* *
* call goal: prelims * call goal: prelims
* *
@ -507,7 +509,7 @@ be lost.
* @parameter _Info_ describes the goal * @parameter _Info_ describes the goal
* *
*/ */
'$enter_trace'(L, G, Module, Info) :- '$sys':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),
@ -535,7 +537,7 @@ be lost.
'__NB_setval__'('$spy_gn',L1). '__NB_setval__'('$spy_gn',L1).
/** /**
* @pred '$enter_trace'(+L, 0:G, +Module, +Info) * @pred '$sys':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
@ -548,16 +550,16 @@ be lost.
* *
*/ */
'$debug'(_, G, M, _H) :- '$sys':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 ).
'$debug'(GoalNumber, G, M, Info) :- '$sys':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).
'$debug'(GoalNumber, G, M, Info) :- '$sys':debug(GoalNumber, G, M, Info) :-
'$creep_step'(GoalNumber, G, M, Info). '$creep_step'(GoalNumber, G, M, Info).
@ -598,7 +600,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).
'$trace_port'(Port, GoalNumber, G, Module, _CalledFromDebugger, Info) :- '$sys':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),
@ -606,7 +608,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).
'$trace_port'(_Port, _GoalNumber, _G, _Module, _CalledFromDebugger, _Info). '$sys':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).

5
pl/grammar.yap
View File

@ -94,7 +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, (NH :- B) ) :- 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)),
@ -281,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(prolog:'$translate_rule'( catch('$_grammar':translate_rule(
(pseudo_nt --> Mod:NT), Rule), (pseudo_nt --> Mod:NT), Rule),
error(Pat,ImplDep), error(Pat,ImplDep),
( \+ '$harmless_dcgexception'(Pat), ( \+ '$harmless_dcgexception'(Pat),
@ -323,3 +323,4 @@ 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,user:'$Error'(Error)), catch(once(user:G),Error,loop_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,user:'$Error'(Error)), catch(once(Module:GA),Error,loop_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,user:'$Error'(Error)), catch(once(user:G),Error,loop_error(Error)),
fail. fail.
'$init_path_extensions' :- '$init_path_extensions' :-

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,'$clean_findall'(Ref,Error) ), ( catch(G, Error,'$sys':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.
'$system_catch'((G -> throw('$thread_finished'(true)) ; throw('$thread_finished'(false))),Module,Exception,'$close_thread'(Exception,Detached)), catch((Module:G -> throw('$thread_finished'(true)) ; throw('$thread_finished'(false))),Exception,'$threads´:close_thread'(Exception,Detached)),
% force backtracking and handling exceptions % force backtracking and handling exceptions
fail. fail.
'$close_thread'(Status, _Detached) :- '$threads´: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),

172
pl/top.yap
View File

@ -30,7 +30,7 @@ live :-
; ;
format(user_error,'[~w]~n', [Module]) format(user_error,'[~w]~n', [Module])
), ),
'$system_catch'('$enter_top_level',Module,Error,'$Error'(Error)). '$enter_top_level'.
% Start file for yap % Start file for yap
@ -46,18 +46,9 @@ live :-
/* main execution loop */ /* main execution loop */
'$read_toplevel'(Goal, Bindings, Pos) :- '$read_toplevel'(Goal, Bindings, Pos) :-
'$prompt', '$prompt',
catch(read_term(user_input, 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 )
@ -85,7 +76,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),
'$command'(Command,Varnames,Pos,top), catch('$sys':command(Command,Varnames,Pos,top),E,loop_error(E)),
current_prolog_flag(break_level, BreakLevel), current_prolog_flag(break_level, BreakLevel),
( (
BreakLevel \= 0 BreakLevel \= 0
@ -125,7 +116,7 @@ live :-
'$execute_commands'([C|Cs],M,VL,Pos,Con,Source) :- '$execute_commands'([C|Cs],M,VL,Pos,Con,Source) :-
!, !,
( (
'$system_catch'('$execute_command'(C,M,VL,Pos,Con,Source),prolog,Error,'$LoopError'(Error, Con)), '$execute_command'(C,M,VL,Pos,Con,Source),
fail fail
; ;
'$execute_commands'(Cs,M,VL,Pos,Con,Source) '$execute_commands'(Cs,M,VL,Pos,Con,Source)
@ -140,20 +131,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
@ -162,29 +153,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) :-
catch( '$expand_term0'(T,Con,O), _,( '$disable_debugging', fail) ), '$expand_term0'(T,Con,O),
!. !.
'$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).
@ -197,16 +188,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
@ -291,31 +282,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),
'$delayed_goals'(G, V, Vs, LGs, DCP), '$sys':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),
'$delayed_goals'(G, [], NV, LGs, _), '$sys':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)
@ -330,15 +321,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.
% %
'$delayed_goals'(G, V, NV, LGs, NCP) :- '$sys':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),
@ -643,10 +634,11 @@ 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).
@ -748,8 +740,7 @@ write_query_answer( Bindings ) :-
prompt1(': '), prompt(_,' '), prompt1(': '), prompt(_,' '),
'$current_module'(OldModule), '$current_module'(OldModule),
repeat, repeat,
'$system_catch'(dbload_from_stream(Stream, OldModule, exo), '$db_load', Error, dbload_from_stream(Stream, OldModule, exo),
user:'$LoopError'(Error, top)),
prolog_flag(agc_margin,_,Old), prolog_flag(agc_margin,_,Old),
!. !.
'$loop'(Stream,db) :- '$loop'(Stream,db) :-
@ -757,17 +748,13 @@ write_query_answer( Bindings ) :-
prompt1(': '), prompt(_,' '), prompt1(': '), prompt(_,' '),
'$current_module'(OldModule), '$current_module'(OldModule),
repeat, repeat,
'$system_catch'(dbload_from_stream(Stream, OldModule, db), '$db_load', Error, dbload_from_stream(Stream, OldModule, db),
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 ),
'$system_catch'( '$enter_command'(Stream,OldModule,Status), '$enter_command'(Stream,OldModule,Status),
OldModule, Error,
user:'$LoopError'(Error, Status)
),
!. !.
'$boot_loop'(Stream,Where) :- '$boot_loop'(Stream,Where) :-
@ -775,22 +762,19 @@ 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) ->
'$system_catch'('$boot_execute'(Goal), prolog, Error, '$boot_execute'(Goal),
user:'$LoopError'(Error, consult) ), fail
fail ;
; Command = (H --> B) ->
Command = (H --> B) -> '$boot_dcg'(H,B, Where),
'$system_catch'('$boot_dcg'(H,B, Where), prolog, Error,
user:'$LoopError'(Error, consult) ),
fail fail
; ;
'$system_catch'('$boot_clause'( Command, Where ), prolog, Error, '$boot_clause'( Command, Where ),
user:'$LoopError'(Error, consult) ),
fail fail
). ).
@ -801,7 +785,7 @@ Command = (H --> B) ->
format(user_error, ':- ~w failed.~n', [Goal]). format(user_error, ':- ~w failed.~n', [Goal]).
'$boot_dcg'( H, B, Where ) :- '$boot_dcg'( H, B, Where ) :-
'$translate_rule'((H --> B), (NH :- NB) ), '$_grammar':translate_rule((H --> B), (NH :- NB) ),
'$$compile'((NH :- NB), Where, ( H --> B), _R), '$$compile'((NH :- NB), Where, ( H --> B), _R),
!. !.
'$boot_dcg'( H, B, _ ) :- '$boot_dcg'( H, B, _ ) :-
@ -816,8 +800,9 @@ Command = (H --> B) ->
'$enter_command'(Stream, Mod, Status) :- '$enter_command'(Stream, Mod, Status) :-
prompt1(': '), prompt(_,' '), prompt1(': '),
Options = [module(Mod), syntax_errors(dec10),variable_names(Vars), term_position(Pos)], prompt(_,' '),
Options = [module(Mod), syntax_errors(dec10),variable_names(Vars), term_position(Pos)],
( (
Status == top Status == top
-> ->
@ -825,7 +810,7 @@ Command = (H --> B) ->
; ;
read_clause(Stream, Command, Options) read_clause(Stream, Command, Options)
), ),
'$command'(Command,Vars,Pos, Status). catch('$sys':command(Command,Vars,Pos, Status), Error, loop_error(Error,top)).
/** @pred user:expand_term( _T_,- _X_) is dynamic,multifile. /** @pred user:expand_term( _T_,- _X_) is dynamic,multifile.
@ -924,7 +909,7 @@ expand_term(Term,Expanded) :-
% Grammar Rules expansion % Grammar Rules expansion
% %
'$expand_term_grammar'((A-->B), C) :- '$expand_term_grammar'((A-->B), C) :-
prolog:'$translate_rule'((A-->B),C), !. '$_grammar':translate_rule((A-->B),C), !.
'$expand_term_grammar'(A, A). '$expand_term_grammar'(A, A).
% %
@ -1035,7 +1020,8 @@ 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, !,
( call(user:H) -> true ; true). ignore(user:H),
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),user,Error,user:'$Error'(Error)), !, catch(user:portray(T),Error,loop_error(Error)), !,
set_value('$portray',true), fail. set_value('$portray',true), fail.
'$portray'(_) :- set_value('$portray',false), fail. '$portray'(_) :- set_value('$portray',false), fail.