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

debugging stuff

Browse Source
This commit is contained in:
Vítor Santos Costa 2015-07-22 19:31:03 -05:00
parent 019ca45bdb
commit 78ed4c9e5e
15 changed files with 269 additions and 270 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
pl/boot.yap
View File

@ -237,7 +237,8 @@ private(_).
'$cut_by'/1, '$cut_by'/1,
'$disable_debugging'/0, '$disable_debugging'/0,
'$do_live'/0, '$do_live'/0,
'$enable_debugging'/0, '$
'/0,
'$find_goal_definition'/4, '$find_goal_definition'/4,
'$handle_throw'/3, '$handle_throw'/3,
'$head_and_body'/3, '$head_and_body'/3,
@ -469,7 +470,7 @@ true :- true.
current_prolog_flag(break_level, BreakLevel), current_prolog_flag(break_level, BreakLevel),
current_prolog_flag(debug, DBON), current_prolog_flag(debug, DBON),
( (
'$nb_getval'('$trace', on, fail) '$trace_on'
-> ->
TraceDebug = trace TraceDebug = trace
; ;
@ -878,7 +879,7 @@ number of steps.
current_prolog_flag(break_level, BL ), current_prolog_flag(break_level, BL ),
( BL \= 0 -> format(user_error, '[~p] ',[BL]) ; ( BL \= 0 -> format(user_error, '[~p] ',[BL]) ;
true ), true ),
( recorded('$print_options','$toplevel'(Opts),_) -> ( current_prolog_flag(toplevel_print_options, Opts) ->
write_term(user_error,Answ,Opts) ; write_term(user_error,Answ,Opts) ;
format(user_error,'~w',[Answ]) format(user_error,'~w',[Answ])
), ),
@ -1105,24 +1106,41 @@ incore(G) :- '$execute'(G).
'$call'(G, CP, G, M). '$call'(G, CP, G, M).
'$user_call'(G, M) :- '$user_call'(G, M) :-
( '$$save_by'(CP), (
'$$save_by'(CP),
'$enable_debugging', '$enable_debugging',
'$call'(G, CP, M:G, M), '$call'(G, CP, M:G, M),
'$$save_by'(CP2), '$$save_by'(CP2),
(CP == CP2 -> ! ; ( true ; '$enable_debugging', fail ) ), (
CP == CP2
->
!
;
( true ; '$enable_debugging', fail )
),
'$disable_debugging' '$disable_debugging'
; ;
'$disable_debugging', '$disable_debugging',
fail fail
). ).
% enable creeping
'$enable_debugging':- '$enable_debugging':-
current_prolog_flag(debug, false), !. current_prolog_flag(debug, false), !.
'$enable_debugging' :- '$enable_debugging' :-
'$nb_getval'('$trace', on, fail), !, '$trace_on', !,
'$creep'. '$creep'.
'$enable_debugging'. '$enable_debugging'.
'$trace_on' :-
'$nb_getval'('$trace', on, fail).
'$trace_off' :-
'$nb_getval'('$trace', off, fail).
/** @pred :_P_ , :_Q_ is iso, meta /** @pred :_P_ , :_Q_ is iso, meta
Conjunction of goals (and). Conjunction of goals (and).
@ -1362,12 +1380,11 @@ bootstrap(F) :-
!. !.
'$enter_command'(Stream,Mod,top) :- !, '$enter_command'(Stream,Mod,top) :- !,
writeln(top),
read_term(Stream, Command, [module(Mod), syntax_errors(dec10),variable_names(Vars), term_position(Pos)]), read_term(Stream, Command, [module(Mod), syntax_errors(dec10),variable_names(Vars), term_position(Pos)]),
'$command'(Command,Vars,Pos,Status). '$command'(Command,Vars,Pos,Status).
'$enter_command'(Stream,Mod,Status) :- '$enter_command'(Stream,Mod,Status) :-
read_clause(Stream, Command, [variable_names(Vars), term_position(Pos)]), read_clause(Stream, Command, [variable_names(Vars), term_position(Pos)]),
'$command'(Command,Vars,Pos,Status). '$command'(Command,Vars,Pos,Status).1
'$abort_loop'(Stream) :- '$abort_loop'(Stream) :-
'$do_error'(permission_error(input,closed_stream,Stream), loop). '$do_error'(permission_error(input,closed_stream,Stream), loop).

10
pl/consult.yap
View File

@ -86,7 +86,6 @@ files and to set-up the Prolog environment. We discuss
*/ */
/** /**
@pred load_files(+ _Files_, + _Options_) @pred load_files(+ _Files_, + _Options_)
@ -842,7 +841,6 @@ db_files(Fs) :-
b_getval('$lf_status', TOpts), b_getval('$lf_status', TOpts),
'$msg_level'( TOpts, Verbosity), '$msg_level'( TOpts, Verbosity),
'$full_filename'(X, Y , ( :- include(X)) ), '$full_filename'(X, Y , ( :- include(X)) ),
writeln((X:Y)),
'$lf_opt'(stream, TOpts, OldStream), '$lf_opt'(stream, TOpts, OldStream),
'$current_module'(Mod), '$current_module'(Mod),
( open(Y, read, Stream) -> ( open(Y, read, Stream) ->
@ -900,7 +898,7 @@ source_file(FileName) :-
source_file(Mod:Pred, FileName) :- source_file(Mod:Pred, FileName) :-
current_module(Mod), current_module(Mod),
Mod \= prolog, Mod \= prolog,
'$current_predicate'(_,Mod,Pred,_), '$current_predicate'(_,Mod,Pred,all),
'$owned_by'(Pred, Mod, FileName). '$owned_by'(Pred, Mod, FileName).
'$owned_by'(T, Mod, FileName) :- '$owned_by'(T, Mod, FileName) :-
@ -971,7 +969,6 @@ most files in the library are from the Edinburgh Prolog library.
*/ */
prolog_load_context(directory, DirName) :- prolog_load_context(directory, DirName) :-
strat_low_level_trace,
( source_location(F, _) ( source_location(F, _)
-> file_directory_name(F, DirName) ; -> file_directory_name(F, DirName) ;
working_directory( DirName, DirName ) working_directory( DirName, DirName )
@ -998,9 +995,6 @@ prolog_load_context(source, F0) :-
prolog_load_context(stream, Stream) :- prolog_load_context(stream, Stream) :-
'$nb_getval'('$consulting_file', _, fail), '$nb_getval'('$consulting_file', _, fail),
'$current_loop_stream'(Stream). '$current_loop_stream'(Stream).
prolog_load_context(term_position, Position) :-
'$current_loop_stream'(Stream)
stream_property( Stream, [alias(loop_stream),position(Position)] ).
% if the file exports a module, then we can % if the file exports a module, then we can
@ -1160,7 +1154,7 @@ unload_file( F0 ) :-
% get rid of file-only predicataes. % get rid of file-only predicataes.
'$unload_file'( FileName, _F0 ) :- '$unload_file'( FileName, _F0 ) :-
current_module(Mod), current_module(Mod),
'$current_predicate'(_A,Mod,P,_), '$current_predicate'(_A,Mod,P,all),
'$owner_file'(P,Mod,FileName), '$owner_file'(P,Mod,FileName),
\+ '$is_multifile'(P,Mod), \+ '$is_multifile'(P,Mod),
functor( P, Na, Ar), functor( P, Na, Ar),

76
pl/debug.yap
View File

@ -221,10 +221,7 @@ nospy _.
/** @pred nospyall /** @pred nospyall
Removes all existing spy-points. Removes all existing spy-points.
*/ */
nospyall :- nospyall :-
'$init_debugger', '$init_debugger',
@ -282,10 +279,6 @@ trace :-
Ends tracing and exits the debugger. This is the same as Ends tracing and exits the debugger. This is the same as
nodebug/0. nodebug/0.
*/ */
notrace :- notrace :-
'$init_debugger', '$init_debugger',
@ -396,8 +389,6 @@ leash(X) :-
-----------------------------------------------------------------------------*/ -----------------------------------------------------------------------------*/
debugging :- debugging :-
'$init_debugger', '$init_debugger',
prolog:debug_action_hook(nospyall), !. prolog:debug_action_hook(nospyall), !.
@ -697,6 +688,9 @@ be lost.
open('CONIN$', read, _S, [alias(debugger_input),bom(false)]). open('CONIN$', read, _S, [alias(debugger_input),bom(false)]).
'$trace_meta_call'( G, M, CP ) :-
'$do_spy'(G, M, CP, spy ).
% last argument to do_spy says that we are at the end of a context. It % last argument to do_spy says that we are at the end of a context. It
% is required to know whether we are controlled by the debugger. % is required to know whether we are controlled by the debugger.
%'$do_spy'(V, M, CP, Flag) :- %'$do_spy'(V, M, CP, Flag) :-
@ -748,7 +742,8 @@ be lost.
L1 is L+1, /* bump it */ L1 is L+1, /* bump it */
nb_setval('$spy_gn',L1), /* and save it globaly */ nb_setval('$spy_gn',L1), /* and save it globaly */
b_getval('$spy_glist',History), /* get goal list */ b_getval('$spy_glist',History), /* get goal list */
b_setval('$spy_glist',[info(L,Module,G,_Retry,_Det,_HasFoundAnswers)|History]), /* and update it */ b_setval('$spy_glist',[info(L,Module,G,_Retry,_Det,_HasFoundAnswers)|History]),
/* and update it */
'$loop_spy'(L, G, Module, CalledFromDebugger). '$loop_spy'(L, G, Module, CalledFromDebugger).
% we are skipping, so we can just call the goal, % we are skipping, so we can just call the goal,
@ -807,6 +802,7 @@ be lost.
/* call port */ /* call port */
'$enter_goal'(GoalNumber, G, Module), '$enter_goal'(GoalNumber, G, Module),
'$spycall'(G, Module, CalledFromDebugger, Retry), '$spycall'(G, Module, CalledFromDebugger, Retry),
'$stop_creeping',
% make sure we are in system mode when running the debugger. % make sure we are in system mode when running the debugger.
( (
'$debugger_deterministic_goal'(G) -> '$debugger_deterministic_goal'(G) ->
@ -839,6 +835,7 @@ be lost.
( (
arg(6, Info, true) arg(6, Info, true)
-> ->
'$stop_creeping',
'$show_trace'(redo,G,Module,GoalNumber,_), /* inform user_error */ '$show_trace'(redo,G,Module,GoalNumber,_), /* inform user_error */
nb_setarg(6, Info, false) nb_setarg(6, Info, false)
; ;
@ -890,7 +887,12 @@ be lost.
'$spycall'(G, M, _, _) :- '$spycall'(G, M, _, _) :-
nb_getval('$debug_jump',true), nb_getval('$debug_jump',true),
!, !,
( '$is_metapredicate'(G, M) -> '$meta_expansion'(G,M,M,M,G1,[]) ; G = G1 ), ( '$is_metapredicate'(G, M)
->
'$meta_expansion'(G,M,M,M,G1,[])
;
G = G1
),
'$execute_nonstop'(G1,M). '$execute_nonstop'(G1,M).
'$spycall'(G, M, _, _) :- '$spycall'(G, M, _, _) :-
( (
@ -901,8 +903,9 @@ be lost.
!, !,
( '$is_metapredicate'(G, M) ( '$is_metapredicate'(G, M)
-> ->
'$meta_expansion'(G,M,M,M,G1,[]), '$meta_expansion'(G,M,M,M,G10,[]),
'$creep'(G1, M) '$debugger_process_meta_arguments'(G10, M, G1),
'$execute'(M:G1)
; ;
'$execute'(M:G) '$execute'(M:G)
). ).
@ -933,6 +936,7 @@ be lost.
% I lost control here. % I lost control here.
CP is '$last_choice_pt', CP is '$last_choice_pt',
'$static_clause'(G,M,_,R), '$static_clause'(G,M,_,R),
'$stop_creeping',
% I may backtrack to here from far away % I may backtrack to here from far away
( (
'$continue_debugging_goal'(no, '$execute_clause'(G, M, R, CP)) '$continue_debugging_goal'(no, '$execute_clause'(G, M, R, CP))
@ -941,8 +945,18 @@ be lost.
). ).
% %
% execute a built-in in creep mode
% %
'$creep'('$execute_clause'(G,Mod,Ref,CP),_M) :-
(
'$$save_by'(CP1),
'$creep',
'$execute_clause'(G,Mod,Ref,CP),
'$$save_by'(CP2),
(CP1 == CP2 -> ! ; ( true ; '$creep', fail ) ),
'$stop_creeping'
;
fail
).
'$creep'(G,M) :- '$creep'(G,M) :-
( (
'$$save_by'(CP1), '$$save_by'(CP1),
@ -955,6 +969,18 @@ be lost.
fail fail
). ).
'$trace'(G,M) :-
(
'$$save_by'(CP1),
'$creep',
'$execute0'( G, M ),
'$$save_by'(CP2),
(CP1 == CP2 -> ! ; ( true ; '$creep', fail ) ),
'$stop_creeping'
;
fail
).
'$tabled_predicate'(G,M) :- '$tabled_predicate'(G,M) :-
'$predicate_flags'(G,M,F,F), '$predicate_flags'(G,M,F,F),
F /\ 0x00000040 =\= 0. F /\ 0x00000040 =\= 0.
@ -964,6 +990,8 @@ be lost.
'$trace'(P,G,Module,L,Deterministic) :- '$trace'(P,G,Module,L,Deterministic) :-
% at this point we are done with leap or skip % at this point we are done with leap or skip
nb_setval('$debug_run',off), nb_setval('$debug_run',off),
% but creep is default
nb_setval('$trace',on),
% make sure we run this code outside debugging mode. % make sure we run this code outside debugging mode.
set_prolog_flag(debug, false), set_prolog_flag(debug, false),
repeat, repeat,
@ -1031,6 +1059,10 @@ be lost.
current_prolog_flag(debug, OldDeb), current_prolog_flag(debug, OldDeb),
set_prolog_flag(debug, false), set_prolog_flag(debug, false),
( '$execute'(G) -> true ; true), ( '$execute'(G) -> true ; true),
% at this point we are done with leap or skip
nb_setval('$debug_run',off),
% but creep is default
nb_setval('$trace',on),
set_prolog_flag(debug, OldDeb), set_prolog_flag(debug, OldDeb),
% '$skipeol'(0'!), % ' % '$skipeol'(0'!), % '
fail. fail.
@ -1350,3 +1382,19 @@ be lost.
yap_hacks:choicepoint(CP,_,prolog,'$loop_spy2',5,(_;_),_), !, yap_hacks:choicepoint(CP,_,prolog,'$loop_spy2',5,(_;_),_), !,
'$debugger_skip_loop_spy2'(CPs,CPs1). '$debugger_skip_loop_spy2'(CPs,CPs1).
'$debugger_skip_loop_spy2'(CPs,CPs). '$debugger_skip_loop_spy2'(CPs,CPs).
'$debugger_process_meta_arguments'(G, M, G1) :-
functor(G,F,N),
'$meta_predicate'(F,M,N,D), !, % we're in an argument
D =.. [F|BMs],
G =.. [F|BGs],
'$ldebugger_process_meta_args'(BGs, M, BMs, BG1s),
G1 =.. [F|BG1s].
'$ldebugger_process_meta_args'([], _, [], []).
'$ldebugger_process_meta_args'([G|BGs], M, [0|BMs], ['$trace'(G1,M1)|BG1s]) :-
!,
strip_module( M:G, M1, G1 ),
'$ldebugger_process_meta_args'(BGs, M, BMs, BG1s).
'$ldebugger_process_meta_args'([G|BGs], M, [_|BMs], [G|BG1s]) :-
'$ldebugger_process_meta_args'(BGs, M, BMs, BG1s).

2
pl/depth_bound.yap
View File

@ -31,3 +31,5 @@ system_module( '$_depth_bound', [depth_bound_call/2], []).
%write(depth_bound_call(A,D)), nl, fail. %write(depth_bound_call(A,D)), nl, fail.
depth_bound_call(A,D) :- depth_bound_call(A,D) :-
'$execute_under_depth_limit'(A,D). '$execute_under_depth_limit'(A,D).

3
pl/init.yap
View File

@ -108,7 +108,7 @@ otherwise.
:- '$handle_throw'(_,_,_), !. :- '$handle_throw'(_,_,_), !.
:- $all_current_modules(M), yap_flag(M:unknown, error) ; true. :- '$all_current_modules'(M), yap_flag(M:unknown, error) ; true.
:- bootstrap('errors.yap'). :- bootstrap('errors.yap').
:- bootstrap('lists.yap'). :- bootstrap('lists.yap').
@ -288,7 +288,6 @@ as directives.
*/ */
:- multifile term_expansion/2. :- multifile term_expansion/2.
:- dynamic term_expansion/2. :- dynamic term_expansion/2.

4
pl/listing.yap
View File

@ -62,10 +62,9 @@ listing :-
Mod \= prolog, Mod \= prolog,
Mod \= system, Mod \= system,
\+ '$hidden'( Mod ), \+ '$hidden'( Mod ),
'$current_predicate'(_,Mod,Pred, _), '$current_predicate'(_,Mod,Pred, user),
'$undefined'(Pred, prolog), % skip predicates exported from prolog. '$undefined'(Pred, prolog), % skip predicates exported from prolog.
functor(Pred,Name,Arity), functor(Pred,Name,Arity),
\+ atom_concat('$', _, Name),
'$listing'(Name,Arity,Mod,Stream), '$listing'(Name,Arity,Mod,Stream),
fail. fail.
listing. listing.
@ -109,7 +108,6 @@ listing(Stream, [MV|MVs]) :- !,
'$do_listing'(Stream, M, Name/Arity) :- '$do_listing'(Stream, M, Name/Arity) :-
( current_predicate(M:Name/Arity), ( current_predicate(M:Name/Arity),
\+ atom_concat('$', _, Name),
'$listing'(Name,Arity,M,Stream), '$listing'(Name,Arity,M,Stream),
fail fail
; ;

17
pl/messages.yap
View File

@ -120,10 +120,8 @@ generate_message(error(Error,Context)) -->
{ Error = existence_error(procedure,_) }, !, { Error = existence_error(procedure,_) }, !,
system_message(error(Error,Context)), system_message(error(Error,Context)),
stack_dump(error(Error,Context)). stack_dump(error(Error,Context)).
generate_message(error(Error,context(Cause,Extra))) -->
system_message(error(Error,Cause)),
stack_dump(error(Error,context(Cause,Extra))).
generate_message(M) --> generate_message(M) -->
file_location,
system_message(M), system_message(M),
stack_dump(M). stack_dump(M).
@ -353,7 +351,7 @@ system_message(error(syntax_error(_), [syntax_error(G,_,Msg,[],_,0,File)|_])) --
% SWI like I/O error message. % SWI like I/O error message.
system_message(error(syntax_error(end_of_clause), [stream(Stream, Line, _, _)|_])) --> system_message(error(syntax_error(end_of_clause), [stream(Stream, Line, _, _)|_])) -->
[ 'SYNTAX ERROR ~a, stream ~w, near line ~d.' - ['Unexpected end of clause',Stream,Line] ]. [ 'SYNTAX ERROR ~a, stream ~w, near line ~d.' - ['Unexpected end of clause',Stream,Line] ].
system_message(error(syntax_error(_), [syntax_error(read(_),_,_,Term,Pos,Start,File)|_])) --> system_message(error(syntax_error(read(_R),between(_L0,_LM,_LF),_Dot,Term,Pos,Start,File))) -->
{ Term = [_|_] }, { Term = [_|_] },
['SYNTAX ERROR' - []], ['SYNTAX ERROR' - []],
syntax_error_line(File, Start, Pos), syntax_error_line(File, Start, Pos),
@ -571,30 +569,31 @@ the _Prefix_ is printed too.
*/ */
prolog:print_message_lines(_S, _, []) :- !. prolog:print_message_lines(_S, _, []) :- !.
prolog:print_message_lines(_S, P, [at_same_line|Lines]) :- !, prolog:print_message_lines(_S, P, [at_same_line|Lines]) :- !,
print_message_line(S, Lines, Rest), '$messages':print_message_line(S, Lines, Rest),
prolog:print_message_lines(S, P, Rest). prolog:print_message_lines(S, P, Rest).
prolog:print_message_lines(S, kind(Kind), Lines) :- !, prolog:print_message_lines(S, kind(Kind), Lines) :- !,
prefix(Kind, Prefix, _), '$messages':prefix(Kind, Prefix, _),
lists:append([ begin(Kind, Ctx) lists:append([ begin(Kind, Ctx)
| Lines | Lines
], ],
[ end(Ctx) [ end(Ctx)
], ],
AllLines), AllLines),
print_message_lines(S, Prefix, AllLines). prolog:print_message_lines(S, Prefix, AllLines).
prolog:print_message_lines(S, P-Opts, Lines) :- prolog:print_message_lines(S, P-Opts, Lines) :-
atom(P), !, atom(P), !,
atom_concat('~N', P, Prefix), atom_concat('~N', P, Prefix),
format(S, Prefix, Opts), format(S, Prefix, Opts),
print_message_line(S, Lines, Rest), '$messages':print_message_line(S, Lines, Rest),
prolog:print_message_lines(S, P-Opts, Rest). prolog:print_message_lines(S, P-Opts, Rest).
prolog:print_message_lines(S, P, Lines) :- prolog:print_message_lines(S, P, Lines) :-
atom(P), !, atom(P), !,
atom_concat('~N', P, Prefix), atom_concat('~N', P, Prefix),
format(S, Prefix, []), format(S, Prefix, []),
print_message_line(S, Lines, Rest), '$messages':print_message_line(S, Lines, Rest),
prolog:print_message_lines(S, P, Rest). prolog:print_message_lines(S, P, Rest).
print_message_line(S, [flush], []) :- !, print_message_line(S, [flush], []) :- !,

4
pl/modules.yap
View File

@ -945,7 +945,6 @@ meta_predicate declaration
*/ */
% directive now meta_predicate Ps :- $meta_predicate(Ps). % directive now meta_predicate Ps :- $meta_predicate(Ps).
:- dynamic('$meta_predicate'/4). :- dynamic('$meta_predicate'/4).
@ -1006,7 +1005,8 @@ meta_predicate declaration
'$meta_expansion'(G, HM, BM, SM, G1,HVars) :- '$meta_expansion'(G, HM, BM, SM, G1,HVars) :-
functor(G,F,N), functor(G,F,N),
'$meta_predicate'(F,BM,N,D), !, % we're in an argument '$meta_predicate'(F,BM,N,D),
!, % we're in an argument
% format(user_error,'[ ~w (~a, ~a, ~a)',[G, HM, BM, SM]), % format(user_error,'[ ~w (~a, ~a, ~a)',[G, HM, BM, SM]),
functor(G1,F,N), functor(G1,F,N),
'$meta_expansion_loop'(N, D, G, G1, HVars, HM, BM, SM). '$meta_expansion_loop'(N, D, G, G1, HVars, HM, BM, SM).

2
pl/preddecls.yap
View File

@ -79,6 +79,8 @@ dynamic(X) :-
'$dynamic'(X,M) :- var(X), !, '$dynamic'(X,M) :- var(X), !,
'$do_error'(instantiation_error,dynamic(M:X)). '$do_error'(instantiation_error,dynamic(M:X)).
'$dynamic'(X,M) :- var(M), !,
'$do_error'(instantiation_error,dynamic(M:X)).
'$dynamic'(Mod:Spec,_) :- !, '$dynamic'(Mod:Spec,_) :- !,
'$dynamic'(Spec,Mod). '$dynamic'(Spec,Mod).
'$dynamic'([], _) :- !. '$dynamic'([], _) :- !.

119
pl/preddyns.yap
View File

@ -18,11 +18,9 @@ Adds clause _C_ to the beginning of the program. If the predicate is
undefined, it is declared dynamic (see dynamic/1). undefined, it is declared dynamic (see dynamic/1).
*/ */
asserta(Mod:C) :- !,
'$assert'(C,Mod,first,_,asserta(Mod:C)).
asserta(C) :- asserta(C) :-
'$current_module'(Mod), strip_module(C, Mod, NC),
'$assert'(C,Mod,first,_,asserta(C)). '$assert'(NC,Mod,first,_,asserta(C)).
/** @pred assertz(+ _C_) is iso /** @pred assertz(+ _C_) is iso
@ -34,11 +32,9 @@ Most Prolog systems only allow asserting clauses for dynamic
predicates. This is also as specified in the ISO standard. YAP also allows predicates. This is also as specified in the ISO standard. YAP also allows
asserting clauses for static predicates, under the restriction that the static predicate may not be live in the stacks. asserting clauses for static predicates, under the restriction that the static predicate may not be live in the stacks.
*/ */
assertz(Mod:C) :- !,
'$assert'(C,Mod,last,_,assertz(Mod:C)).
assertz(C) :- assertz(C) :-
'$current_module'(Mod), strip_module(C,Mod,C1),
'$assert'(C,Mod,last,_,assertz(C)). '$assert'(C1,Mod,last,_,assertz(C)).
/** @pred assert(+ _C_) /** @pred assert(+ _C_)
@ -53,11 +49,9 @@ deprecated, if you want to assert clauses for static procedures you
should use assert_static/1. should use assert_static/1.
*/ */
assert(Mod:C) :- !,
'$assert'(C,Mod,last,_,assert(Mod:C)).
assert(C) :- assert(C) :-
'$current_module'(Mod), strip_module(C,Mod,C1),
'$assert'(C,Mod,last,_,assert(C)). '$assert'(C1,Mod,last,_,assert(C)).
'$assert'(V,Mod,_,_,_) :- var(V), !, '$assert'(V,Mod,_,_,_) :- var(V), !,
'$do_error'(instantiation_error,assert(Mod:V)). '$do_error'(instantiation_error,assert(Mod:V)).
@ -66,45 +60,42 @@ assert(C) :-
'$assert'(I,Mod,_,_,_) :- number(I), !, '$assert'(I,Mod,_,_,_) :- number(I), !,
'$do_error'(type_error(callable,I),assert(Mod:I)). '$do_error'(type_error(callable,I),assert(Mod:I)).
'$assert'(M:C,_,Where,R,P) :- !, '$assert'(M:C,_,Where,R,P) :- !,
'$assert'(C,M,Where,R,P). strip_module(M:C, M1, C1),
'$assert'((H:-G),M1,Where,R,P) :- !, '$assert'(C1,M1,Where,R,P).
'$assert_clause'(H, G, M1, Where, R, P). '$assert'((H:-G),M,Where,R,P) :- !,
'$assert'(H,M1,Where,R,_) :- '$assert_clause'(H, G, M, Where, R, P).
strip_module(M1:H, HM, H1), '$assert'(H,M,Where,R,_) :-
'$assert_fact'(H1, HM, Where, R). '$assert_fact'(H, M, Where, R).
'$assert_clause'(H, _, _, _, _, P) :-
var(H), !, '$do_error'(instantiation_error,P).
'$assert_clause'(M1:C, G, M1, Where, R, P) :- !,
'$assert_clause2'(C, G, M1, Where, R, P).
'$assert_clause'(H, G, M1, Where, R, P) :- !,
'$assert_clause2'(H, G, M1, Where, R, P).
'$assert_fact'(H,Mod,Where,R) :- '$assert_fact'(H,Mod,Where,R) :-
functor(H, Na, Ar),
( '$undefined'(H,Mod) ->
'$dynamic'(Na/Ar, Mod)
;
true
),
( '$is_log_updatable'(H, Mod) -> ( '$is_log_updatable'(H, Mod) ->
'$compile_dynamic'(H, Where, H, Mod, R) '$compile_dynamic'(H, Where, H, Mod, R)
; ;
'$is_dynamic'(H, Mod) -> '$is_dynamic'(H, Mod) ->
'$assertat_d'(Where, H, true, H, Mod, R) '$assertat_d'(Where, H, true, H, Mod, R)
; ;
'$undefined'(H,Mod) -> % try asserting as static, see what happens
functor(H, Na, Ar), Where = last ->
'$dynamic'(Na/Ar, Mod), assert_static(Mod:H)
'$assert_fact'(H,Mod,Where,R)
; ;
current_prolog_flag(language, yap)) -> % I can assert over static facts in YAP mode asserta_static(Mod:H)
'$assert1'(Where,H,H,Mod,H)
;
functor(H, Na, Ar),
'$do_error'(permission_error(modify,static_procedure,Na/Ar),Mod:assert(H))
). ).
'$assert_clause'(H, _, _, _, _, P) :-
'$assert_clause2'(HI,BI,Mod,Where,R,P) :- var(H), !,
'$expand_clause'((HI :- BI),C0,C,Mod,HM), '$do_error'(instantiation_error,P).
'$assert_clause3'(C0,C,HM,Where,R,P). '$assert_clause'(M:C, G, MG, Where, R, P) :-
!,
'$assert_clause3'(C0,C,Mod,Where,R,P) :- strip_module(M:C, M1, C1),
'$assert_clause2'(C1, MG:G, M1, Where, R, P).
'$assert_clause'(H1, B1, Mod, Where, R, P) :-
'$expand_clause'((H1 :- B1),C0,C,Mod,Mod),
'$check_head_and_body'(C,H,B,P), '$check_head_and_body'(C,H,B,P),
( '$is_log_updatable'(H, Mod) -> ( '$is_log_updatable'(H, Mod) ->
'$compile_dynamic'((H :- B), Where, C0, Mod, R) '$compile_dynamic'((H :- B), Where, C0, Mod, R)
@ -112,44 +103,11 @@ assert(C) :-
'$is_dynamic'(H, Mod) -> '$is_dynamic'(H, Mod) ->
'$assertat_d'(Where, H, B, C0, Mod, R) '$assertat_d'(Where, H, B, C0, Mod, R)
; ;
'$undefined'(H,Mod) -> Where = last
functor(H, Na, Ar), ->
'$dynamic'(Na/Ar, Mod), assert_static(Mod:(H :- B))
'$assert_clause3'(C0,C,Mod,Where,R,P)
; ;
current_prolog_flag(language, sicstus)) -> % I can assert over static facts in YAP mode asserta_static(Mod:(H :- B))
'$assert1'(Where,C,C0,Mod,H)
;
functor(H, Na, Ar),
'$do_error'(permission_error(modify,static_procedure,Na/Ar),P)
).
'$assert_dynamic'(V,Mod,_,_,_) :- var(V), !,
'$do_error'(instantiation_error,assert(Mod:V)).
'$assert_dynamic'(M:C,_,Where,R,P) :- !,
'$assert_dynamic'(C,M,Where,R,P).
'$assert_dynamic'((H:-_G),_M1,_Where,_R,P) :-
var(H), !, '$do_error'(instantiation_error,P).
'$assert_dynamic'(CI,Mod,Where,R,P) :-
'$expand_clause'(CI,C0,C,Mod,HM),
'$assert_dynamic2'(C0,C,HM,Where,R,P).
'$assert_dynamic2'(C0,C,Mod,Where,R,P) :-
'$check_head_and_body'(C,H,B,P),
( '$is_log_updatable'(H, Mod) ->
'$compile_dynamic'(C, Where, C0, Mod, R)
;
'$is_dynamic'(H, Mod) ->
'$assertat_d'(Where,H,B,C0,Mod,R)
;
'$undefined'(H, Mod) ->
functor(H, Na, Ar),
'$dynamic'(Na/Ar, Mod),
'$assert_dynamic2'(C0,C,Mod,Where,R,P)
;
functor(H,Na,Ar),
'$do_error'(permission_error(modify,static_procedure,Na/Ar),P)
). ).
/** @pred asserta(+ _C_,- _R_) /** @pred asserta(+ _C_,- _R_)
@ -161,11 +119,9 @@ predicates. If the predicate is undefined, it will automatically be
declared dynamic. declared dynamic.
*/ */
asserta(M:C,R) :- !,
'$assert_dynamic'(C,M,first,R,asserta(M:C,R)).
asserta(C,R) :- asserta(C,R) :-
'$current_module'(M), strip_module(C, M, C1),
'$assert_dynamic'(C,M,first,R,asserta(C,R)). '$assert'(C1,M,first,R,asserta(C,R)).
/** @pred assertz(+ _C_,- _R_) /** @pred assertz(+ _C_,- _R_)
@ -473,4 +429,3 @@ dynamic_predicate(P,Sem) :-
). ).
'$expand_clause'(H,H1,H1,Mod,HM) :- '$expand_clause'(H,H1,H1,Mod,HM) :-
strip_module(Mod:H, HM, H1). strip_module(Mod:H, HM, H1).

136
pl/preds.yap
View File

@ -107,27 +107,22 @@ undefined results.
*/ */
assert_static(Mod:C) :- !,
'$assert_static'(C,Mod,last,_,assert_static(Mod:C)).
assert_static(C) :- assert_static(C) :-
'$current_module'(Mod), strip_module(C, Mod, C1),
'$assert_static'(C,Mod,last,_,assert_static(C)). '$assert_static'(C1, Mod,last,_,assert_static(C)).
/** @pred asserta_static(: _C_) /** @pred asserta_static(: _C_)
Adds clause _C_ to the beginning of a static procedure. Adds clause _C_ as the first clause for a static procedure.
*/ */
asserta_static(Mod:C) :- !,
'$assert_static'(C,Mod,first,_,asserta_static(Mod:C)).
asserta_static(C) :- asserta_static(C) :-
'$current_module'(Mod), strip_module(C, Mod, C1),
'$assert_static'(C,Mod,first,_,asserta_static(C)). '$assert_static'(C1,Mod,first,_,asserta_static(C)).
asserta_static(Mod:C) :- !,
'$assert_static'(C,Mod,last,_,assertz_static(Mod:C)).
/** @pred assertz_static(: _C_) /** @pred assertz_static(: _C_)
@ -145,13 +140,11 @@ static predicates, if source mode was on when they were compiled:
*/ */
assertz_static(C) :- assertz_static(C) :-
'$current_module'(Mod), strip_module(C, Mod, C1),
'$assert_static'(C,Mod,last,_,assertz_static(C)). '$assert_static'(C1,Mod,last,_,assertz_static(C)).
'$assert_static'(V,M,_,_,_) :- var(V), !, '$assert_static'(V,M,_,_,_) :- var(V), !,
'$do_error'(instantiation_error,assert(M:V)). '$do_error'(instantiation_error,assert(M:V)).
'$assert_static'(M:C,_,Where,R,P) :- !,
'$assert_static'(C,M,Where,R,P).
'$assert_static'((H:-_G),_M1,_Where,_R,P) :- '$assert_static'((H:-_G),_M1,_Where,_R,P) :-
var(H), !, '$do_error'(instantiation_error,P). var(H), !, '$do_error'(instantiation_error,P).
'$assert_static'(CI,Mod,Where,R,P) :- '$assert_static'(CI,Mod,Where,R,P) :-
@ -183,10 +176,8 @@ This predicate is applicable to static procedures compiled with
*/ */
clause(M:P,Q) :- !, clause(V0,Q) :-
'$clause'(P,M,Q,_). strip_module(V0, M, V),
clause(V,Q) :-
'$current_module'(M),
'$clause'(V,M,Q,_). '$clause'(V,M,Q,_).
/** @pred clause(+ _H_, _B_,- _R_) /** @pred clause(+ _H_, _B_,- _R_)
@ -199,10 +190,8 @@ erase/1 on the reference on static procedures.
clause(P,Q,R) :- var(P), !, clause(P,Q,R) :- var(P), !,
'$current_module'(M), '$current_module'(M),
'$clause'(P,M,Q,R). '$clause'(P,M,Q,R).
clause(M:P,Q,R) :- !, clause(V0,Q,R) :-
'$clause'(P,M,Q,R). strip_module(V0, M, V),
clause(V,Q,R) :-
'$current_module'(M),
'$clause'(V,M,Q,R). '$clause'(V,M,Q,R).
'$clause'(P,M,Q,R) :- '$clause'(P,M,Q,R) :-
@ -272,8 +261,7 @@ and _I_ is bound to its position.
*/ */
nth_clause(V,I,R) :- nth_clause(V,I,R) :-
'$current_module'(M), strip_module(V, M1, P), !,
strip_module(M:V, M1, P), !,
'$nth_clause'(P, M1, I, R). '$nth_clause'(P, M1, I, R).
@ -291,10 +279,8 @@ remove both static and dynamic predicates. All state on the predicate,
including whether it is dynamic or static, multifile, or including whether it is dynamic or static, multifile, or
meta-predicate, will be lost. meta-predicate, will be lost.
*/ */
abolish(Mod:N,A) :- !, abolish(N0,A) :-
'$abolish'(N,A,Mod). strip_module(N0, Mod, N), !,
abolish(N,A) :-
'$current_module'(Mod),
'$abolish'(N,A,Mod). '$abolish'(N,A,Mod).
'$abolish'(N,A,M) :- var(N), !, '$abolish'(N,A,M) :- var(N), !,
@ -312,7 +298,7 @@ abolish(N,A) :-
Deletes the predicate given by _PredSpec_ from the database. If Deletes the predicate given by _PredSpec_ from the database. If
_PredSpec_ is an unbound variable, delete all predicates for the §§ _PredSpec_ is an unbound variable, delete all predicates for the
current module. The current module. The
specification must include the name and arity, and it may include module specification must include the name and arity, and it may include module
information. Under <tt>iso</tt> language mode this built-in will only abolish information. Under <tt>iso</tt> language mode this built-in will only abolish
@ -320,14 +306,8 @@ dynamic procedures. Under other modes it will abolish any procedures.
*/ */
abolish(V) :- var(V), !, abolish(X0) :-
'$do_error'(instantiation_error,abolish(V)). strip_module(X0,M,X),
abolish(Mod:V) :- var(V), !,
'$do_error'(instantiation_error,abolish(Mod:V)).
abolish(M:X) :- !,
'$abolish'(X,M).
abolish(X) :-
'$current_module'(M),
'$abolish'(X,M). '$abolish'(X,M).
'$abolish'(X,M) :- '$abolish'(X,M) :-
@ -340,8 +320,6 @@ abolish(X) :-
'$abolish_all'(M). '$abolish_all'(M).
'$new_abolish'(A,M) :- atom(A), !, '$new_abolish'(A,M) :- atom(A), !,
'$abolish_all_atoms'(A,M). '$abolish_all_atoms'(A,M).
'$new_abolish'(M:PS,_) :- !,
'$new_abolish'(PS,M).
'$new_abolish'(Na//Ar1, M) :- '$new_abolish'(Na//Ar1, M) :-
integer(Ar1), integer(Ar1),
!, !,
@ -424,8 +402,6 @@ abolish(X) :-
; ;
'$abolish_all_atoms_old'(A,M) '$abolish_all_atoms_old'(A,M)
). ).
'$old_abolish'(M:N,_) :- !,
'$old_abolish'(N,M).
'$old_abolish'([], _) :- !. '$old_abolish'([], _) :- !.
'$old_abolish'([H|T], M) :- !, '$old_abolish'(H, M), '$old_abolish'(T, M). '$old_abolish'([H|T], M) :- !, '$old_abolish'(H, M), '$old_abolish'(T, M).
'$old_abolish'(T, M) :- '$old_abolish'(T, M) :-
@ -473,12 +449,8 @@ Make predicate _Pred_ invisible to new code, and to `current_predicate/2`,
`listing`, and friends. New predicates with the same name and `listing`, and friends. New predicates with the same name and
functor can be declared. functor can be declared.
**/ **/
stash_predicate(V) :- var(V), !, stash_predicate(P0) :-
'$do_error'(instantiation_error,stash_predicate(V)). strip_module(P0, M, P),
stash_predicate(M:P) :- !,
'$stash_predicate2'(P, M).
stash_predicate(P) :-
'$current_module'(M),
'$stash_predicate2'(P, M). '$stash_predicate2'(P, M).
'$stash_predicate2'(V, M) :- var(V), !, '$stash_predicate2'(V, M) :- var(V), !,
@ -496,10 +468,8 @@ Make predicate _Pred_ invisible to `current_predicate/2`,
**/ **/
hide_predicate(V) :- var(V), !, hide_predicate(V) :- var(V), !,
'$do_error'(instantiation_error,hide_predicate(V)). '$do_error'(instantiation_error,hide_predicate(V)).
hide_predicate(M:P) :- !, hide_predicate(P0) :-
'$hide_predicate2'(P, M). strip_module(P0, M, P),
hide_predicate(P) :-
'$current_module'(M),
'$hide_predicate2'(P, M). '$hide_predicate2'(P, M).
'$hide_predicate2'(V, M) :- var(V), !, '$hide_predicate2'(V, M) :- var(V), !,
@ -583,7 +553,7 @@ predicate_property(Pred,Prop) :-
). ).
'$generate_all_preds_from_mod'(Pred, M, M) :- '$generate_all_preds_from_mod'(Pred, M, M) :-
'$current_predicate'(_Na,M,Pred,_). '$current_predicate'(_Na,M,Pred,user).
'$generate_all_preds_from_mod'(Pred, SourceMod, Mod) :- '$generate_all_preds_from_mod'(Pred, SourceMod, Mod) :-
recorded('$import','$import'(SourceMod, Mod, Orig, Pred,_,_),_), recorded('$import','$import'(SourceMod, Mod, Orig, Pred,_,_),_),
'$pred_exists'(Orig, SourceMod). '$pred_exists'(Orig, SourceMod).
@ -630,10 +600,8 @@ indices to those clauses (in bytes).
*/ */
predicate_statistics(V,NCls,Sz,ISz) :- var(V), !, predicate_statistics(V,NCls,Sz,ISz) :- var(V), !,
'$do_error'(instantiation_error,predicate_statistics(V,NCls,Sz,ISz)). '$do_error'(instantiation_error,predicate_statistics(V,NCls,Sz,ISz)).
predicate_statistics(M:P,NCls,Sz,ISz) :- !, predicate_statistics(P0,NCls,Sz,ISz) :-
'$predicate_statistics'(P,M,NCls,Sz,ISz). strip_module(P0, M, P),
predicate_statistics(P,NCls,Sz,ISz) :-
'$current_module'(M),
'$predicate_statistics'(P,M,NCls,Sz,ISz). '$predicate_statistics'(P,M,NCls,Sz,ISz).
'$predicate_statistics'(M:P,_,NCls,Sz,ISz) :- !, '$predicate_statistics'(M:P,_,NCls,Sz,ISz) :- !,
@ -661,27 +629,21 @@ predicate_erased_statistics(P,NCls,Sz,ISz) :-
var(P), !, var(P), !,
current_predicate(_,P), current_predicate(_,P),
predicate_erased_statistics(P,NCls,Sz,ISz). predicate_erased_statistics(P,NCls,Sz,ISz).
predicate_erased_statistics(M:P,NCls,Sz,ISz) :- !, predicate_erased_statistics(P0,NCls,Sz,ISz) :-
'$predicate_erased_statistics'(M:P,NCls,Sz,_,ISz). strip_module(P0,M,P),
predicate_erased_statistics(P,NCls,Sz,ISz) :-
'$current_module'(M),
'$predicate_erased_statistics'(M:P,NCls,Sz,_,ISz). '$predicate_erased_statistics'(M:P,NCls,Sz,_,ISz).
/** @pred current_predicate( _A_, _P_) /** @pred current_predicate( _A_, _P_)
Defines the relation: _P_ is a currently defined predicate whose name is the atom _A_. Defines the relation: _P_ is a currently defined predicate whose name is the atom _A_.
*/ */
current_predicate(A,T) :- current_predicate(A,T0) :-
'$ground_module'(T, M, T0), strip_module(T0, M, T),
( (
'$current_predicate'(A, M, T0, _), '$current_predicate'(A, M, T0, user)
%TFlags is Flags /\ 0x00004000,
% format('1 ~w ~16r~n', [M:T0,Flags, TFlags]),
\+ '$system_predicate'(T0, M)
; ;
'$imported_predicate'(T0, M, SourceT, SourceMod), '$imported_predicate'(T, M, SourceT, SourceMod),
functor(T0, A, _), functor(T, A, _),
% format('2 ~w ~16r~n', [M:T0,Flags]),
\+ '$system_predicate'(SourceT, SourceMod) \+ '$system_predicate'(SourceT, SourceMod)
). ).
@ -691,12 +653,18 @@ current_predicate(A,T) :-
is the atom _A_. is the atom _A_.
*/ */
system_predicate(A,T) :- system_predicate(A,T1) :-
'$ground_module'(T, M, T0), strip_module( T1, M, T),
( (
'$current_predicate'(A, M, T0, Flags) M \= prolog,
'$current_predicate'(A, M, T0, system)
; ;
'$current_predicate'(A, prolog, T0, Flags) '$imported_predicate'(T, M, SourceT, SourceMod),
M \= prolog,
functor(T, A, _),
'$system_predicate'(SourceT, SourceMod)
;
'$current_predicate'(A, prolog, T0, system)
). ).
/** @pred system_predicate( ?_P_ ) /** @pred system_predicate( ?_P_ )
@ -704,7 +672,8 @@ system_predicate(A,T) :-
Defines the relation: _P_ is a currently defined system predicate. Defines the relation: _P_ is a currently defined system predicate.
*/ */
system_predicate(P) :- system_predicate(P) :-
system_predicate(_, P). strip_module(M, P),
system_predicate(_, M:P).
/** /**
@ -716,16 +685,17 @@ system_predicate(P) :-
_Na_ is the name of the predicate, and _Ar_ its arity. _Na_ is the name of the predicate, and _Ar_ its arity.
*/ */
current_predicate(F0) :- current_predicate(F0) :-
strip_module(F0, M, F), strip_module(F0, M, AN),
( ( AN = A/N
var(F)
-> ->
current_predicate(M:A, S), current_predicate(A, M:S),
functor( S, A, Ar) functor( S, A, Ar)
; ;
F = A/Ar, AN == A//N
current_predicate(M:A, S), ->
functor( S, A, Ar) current_predicate(A, M:S),
Ar2 is Ar+2,
functor( S, A, Ar2)
). ).
'$imported_predicate'(A, ImportingMod, A/Arity, G, Flags) :- '$imported_predicate'(A, ImportingMod, A/Arity, G, Flags) :-
@ -742,7 +712,7 @@ name is the atom _A_. It can be used to generate all the keys for
the internal data-base. the internal data-base.
*/ */
current_key(A,K) :- current_key(A,K) :-
'$current_predicate'(A,idb,K,_). '$current_predicate'(A,idb,K,user).
% do nothing for now. % do nothing for now.
'$noprofile'(_, _). '$noprofile'(_, _).

7
pl/protect.yap
View File

@ -20,12 +20,13 @@
% This protects all code from further changes % This protects all code from further changes
% and also makes it impossible from some predicates to be seen % and also makes it impossible from some predicates to be seen
'$protect' :- '$protect' :-
'$current_predicate'(_A, M, T0, Flags), '$current_predicate'(_A, M, T0, all),
%format(' ~a ~n', [M]) , %format(' ~a ~n', [M]) ,
M \= user, M \= user,
M \= lists, M \= lists,
'$predicate_flags'(T0, M, _Flags, NFlags), '$predicate_flags'(T0, M, Flags, Flags),
NFlags is Flags \/ 0x00004000, NFlags is Flags \/ 0x00004000,
'$predicate_flags'(T0, M, _Flags, NFlags),
%format('~w ~16r ~16r~n', [T0,Flags, NFlags]) , %format('~w ~16r ~16r~n', [T0,Flags, NFlags]) ,
fail. fail.
'$protect' :- '$protect' :-
@ -40,7 +41,7 @@
'$protect'. '$protect'.
'$hide_predicates'(Name) :- '$hide_predicates'(Name) :-
'$current_predicate'(Name, Mod, P, _), '$current_predicate'(Name, Mod, P, all),
'$hide_predicate'(P,Mod), '$hide_predicate'(P,Mod),
fail. fail.
'$hide_predicates'(_). '$hide_predicates'(_).

5
pl/qly.yap
View File

@ -540,6 +540,7 @@ qload_module(Mod) :-
unload_module( Mod ), fail. unload_module( Mod ), fail.
'$qload_module'(S, _Mod, _File, _SourceModule) :- '$qload_module'(S, _Mod, _File, _SourceModule) :-
'$qload_module_preds'(S), fail. '$qload_module_preds'(S), fail.
%:- start_low_level_trace.
'$qload_module'(_S, Mod, File, SourceModule) :- '$qload_module'(_S, Mod, File, SourceModule) :-
Mod:'@mod_info'(F, Exps, MFs, Line,Parents, Imps, Metas, ModTransps, Foreigns, TEs), Mod:'@mod_info'(F, Exps, MFs, Line,Parents, Imps, Metas, ModTransps, Foreigns, TEs),
abolish(Mod:'@mod_info'/10), abolish(Mod:'@mod_info'/10),
@ -555,12 +556,12 @@ qload_module(Mod) :-
% no evil. % no evil.
'$convert_for_export'(all, Exps, Mod, SourceModule, TranslationTab, _AllExports0, qload_module), '$convert_for_export'(all, Exps, Mod, SourceModule, TranslationTab, _AllExports0, qload_module),
'$add_to_imports'(TranslationTab, Mod, SourceModule). % insert ops, at least for now '$add_to_imports'(TranslationTab, Mod, SourceModule). % insert ops, at least for now
%:- stop_low_level_trace.
'$fetch_imports_module'(Mod, Imports) :- '$fetch_imports_module'(Mod, Imports) :-
findall(Info, '$fetch_import_module'(Mod, Info), Imports). findall(Info, '$fetch_import_module'(Mod, Info), Imports).
% detect an import that is local to the module. % detect an import that is local to the module.
'$fetch_import_module'(Mod, '$import'(Mod0,Mod,G0,G,N,K) - S) :- '$fetch_import_module'(Mod, '$impcort'(Mod0,Mod,G0,G,N,K) - S) :-
recorded('$import', '$import'(Mod0,Mod,G0,G,N,K), _), recorded('$import', '$import'(Mod0,Mod,G0,G,N,K), _),
( recorded('$module','$module'(_, Mod0, S, _, _), _) -> true ; S = user_input ). ( recorded('$module','$module'(_, Mod0, S, _, _), _) -> true ; S = user_input ).

20
pl/signals.yap
View File

@ -223,8 +223,7 @@ order of dispatch.
'$is_no_trace'(G, M), !, '$is_no_trace'(G, M), !,
( (
'$$save_by'(CP), '$$save_by'(CP),
'$enable_debugging', '$no_creep_call'(G,M),
'$execute_nonstop'(G, M),
'$$save_by'(CP2), '$$save_by'(CP2),
'$disable_debugging', '$disable_debugging',
(CP == CP2 -> ! ; ( true ; '$enable_debugging', fail ) ), (CP == CP2 -> ! ; ( true ; '$enable_debugging', fail ) ),
@ -237,6 +236,18 @@ order of dispatch.
CP is '$last_choice_pt', CP is '$last_choice_pt',
'$do_spy'(G, Mod, CP, WhereFrom). '$do_spy'(G, Mod, CP, WhereFrom).
'$no_creep_call'('$execute_clause'(G,Mod,Ref,CP),_) :- !,
'$enable_debugging',
'$execute_clause'(G,Mod,Ref,CP).
'$no_creep_call'('$execute_nonstop'(G, M),_) :- !,
'$enable_debugging',
'$execute_nonstop'(G, M).
'$no_creep_call'(G, M) :-
'$enable_debugging',
'$execute_nonstop'(G, M).
'$execute_goal'(G, Mod) :- '$execute_goal'(G, Mod) :-
( (
'$is_metapredicate'(G, Mod) '$is_metapredicate'(G, Mod)
@ -316,8 +327,7 @@ alarm(Interval, Goal, Left) :-
Left = Left0. Left = Left0.
alarm(Interval, Goal, Left) :- alarm(Interval, Goal, Left) :-
integer(Interval), !, integer(Interval), !,
on_signal(sig_alarm, _, Goal), on_signal(sig_alarm, _, Goal), '$alarm'(Interval, 0, Left, _).
'$alarm'(Interval, 0, Left, _).
alarm(Number, Goal, Left) :- alarm(Number, Goal, Left) :-
float(Number), !, float(Number), !,
Secs is integer(Number), Secs is integer(Number),
@ -344,7 +354,7 @@ read_sig.
:- '$set_no_trace'(true, prolog). :- '$set_no_trace'(true, prolog).
:- '$set_no_trace'('$call'(_,_,_,_), prolog). :- '$set_no_trace'('$call'(_,_,_,_), prolog).
:- '$set_no_trace'('$execute_nonstop'(_,_), prolog). :- '$set_no_trace'('$execute_nonstop'(_,_), prolog).
:- '$set_no_trace'('$execute_clause'(_,_,_,_), prolog).
:- '$set_no_trace'('$restore_regs'(_,_), prolog). :- '$set_no_trace'('$restore_regs'(_,_), prolog).
%%! @} %%! @}

3
pl/undefined.yap
View File

@ -54,6 +54,9 @@ with SICStus Prolog.
'$exit_undefp', '$exit_undefp',
call(M0:NG) call(M0:NG)
; ;
'$messages' = M0,
fail
;
'$exit_undefp', '$exit_undefp',
'$handle_error'(Default,G0,M0) '$handle_error'(Default,G0,M0)
). ).