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

51
pl/boot.yap
View File

@ -237,7 +237,8 @@ private(_).
'$cut_by'/1,
'$disable_debugging'/0,
'$do_live'/0,
'$enable_debugging'/0,
'$
'/0,
'$find_goal_definition'/4,
'$handle_throw'/3,
'$head_and_body'/3,
@ -469,7 +470,7 @@ true :- true.
current_prolog_flag(break_level, BreakLevel),
current_prolog_flag(debug, DBON),
(
'$nb_getval'('$trace', on, fail)
'$trace_on'
->
TraceDebug = trace
;
@ -878,7 +879,7 @@ number of steps.
current_prolog_flag(break_level, BL ),
( BL \= 0 -> format(user_error, '[~p] ',[BL]) ;
true ),
( recorded('$print_options','$toplevel'(Opts),_) ->
( current_prolog_flag(toplevel_print_options, Opts) ->
write_term(user_error,Answ,Opts) ;
format(user_error,'~w',[Answ])
),
@ -1105,24 +1106,41 @@ incore(G) :- '$execute'(G).
'$call'(G, CP, G, M).
'$user_call'(G, M) :-
( '$$save_by'(CP),
(
'$$save_by'(CP),
'$enable_debugging',
'$call'(G, CP, M:G, M),
'$$save_by'(CP2),
(CP == CP2 -> ! ; ( true ; '$enable_debugging', fail ) ),
(
CP == CP2
->
!
;
( true ; '$enable_debugging', fail )
),
'$disable_debugging'
;
'$disable_debugging',
fail
).
;
'$disable_debugging',
fail
).
'$enable_debugging' :-
% enable creeping
'$enable_debugging':-
current_prolog_flag(debug, false), !.
'$enable_debugging' :-
'$nb_getval'('$trace', on, fail), !,
'$trace_on', !,
'$creep'.
'$enable_debugging'.
'$trace_on' :-
'$nb_getval'('$trace', on, fail).
'$trace_off' :-
'$nb_getval'('$trace', off, fail).
/** @pred :_P_ , :_Q_ is iso, meta
Conjunction of goals (and).
@ -1361,13 +1379,12 @@ bootstrap(F) :-
user:'$LoopError'(Error, Status)),
!.
'$enter_command'(Stream,Mod,top) :- !,
writeln(top),
'$enter_command'(Stream,Mod,top) :- !,
read_term(Stream, Command, [module(Mod), syntax_errors(dec10),variable_names(Vars), term_position(Pos)]),
'$command'(Command,Vars,Pos,Status).
'$enter_command'(Stream,Mod,Status) :-
read_clause(Stream, Command, [variable_names(Vars), term_position(Pos)]),
'$command'(Command,Vars,Pos,Status).
'$command'(Command,Vars,Pos,Status).
'$enter_command'(Stream,Mod,Status) :-
read_clause(Stream, Command, [variable_names(Vars), term_position(Pos)]),
'$command'(Command,Vars,Pos,Status).1
'$abort_loop'(Stream) :-
'$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_)
@ -842,7 +841,6 @@ db_files(Fs) :-
b_getval('$lf_status', TOpts),
'$msg_level'( TOpts, Verbosity),
'$full_filename'(X, Y , ( :- include(X)) ),
writeln((X:Y)),
'$lf_opt'(stream, TOpts, OldStream),
'$current_module'(Mod),
( open(Y, read, Stream) ->
@ -900,7 +898,7 @@ source_file(FileName) :-
source_file(Mod:Pred, FileName) :-
current_module(Mod),
Mod \= prolog,
'$current_predicate'(_,Mod,Pred,_),
'$current_predicate'(_,Mod,Pred,all),
'$owned_by'(Pred, 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) :-
strat_low_level_trace,
( source_location(F, _)
-> file_directory_name(F, DirName) ;
working_directory( DirName, DirName )
@ -998,9 +995,6 @@ prolog_load_context(source, F0) :-
prolog_load_context(stream, Stream) :-
'$nb_getval'('$consulting_file', _, fail),
'$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
@ -1160,7 +1154,7 @@ unload_file( F0 ) :-
% get rid of file-only predicataes.
'$unload_file'( FileName, _F0 ) :-
current_module(Mod),
'$current_predicate'(_A,Mod,P,_),
'$current_predicate'(_A,Mod,P,all),
'$owner_file'(P,Mod,FileName),
\+ '$is_multifile'(P,Mod),
functor( P, Na, Ar),

102
pl/debug.yap
View File

@ -221,10 +221,7 @@ nospy _.
/** @pred nospyall
Removes all existing spy-points.
*/
nospyall :-
'$init_debugger',
@ -241,7 +238,7 @@ debug :-
'$start_debugging'(on),
print_message(informational,debug(debug)).
'$start_debugging'(Mode) :-
'$start_debugging'(Mode) :-
(Mode == on ->
set_prolog_flag(debug, true)
;
@ -250,15 +247,15 @@ debug :-
nb_setval('$debug_run',off),
nb_setval('$debug_jump',false).
nodebug :-
nodebug :-
'$init_debugger',
set_prolog_flag(debug, false),
nb_setval('$trace',off),
print_message(informational,debug(off)).
%
% remove any debugging info after an abort.
%
%
% remove any debugging info after an abort.
%
/** @pred trace
@ -282,10 +279,6 @@ trace :-
Ends tracing and exits the debugger. This is the same as
nodebug/0.
*/
notrace :-
'$init_debugger',
@ -396,8 +389,6 @@ leash(X) :-
-----------------------------------------------------------------------------*/
debugging :-
'$init_debugger',
prolog:debug_action_hook(nospyall), !.
@ -674,12 +665,12 @@ be lost.
'$debugger_input',
'$do_spy'(G, Mod, CP, spy).
/**
/**
* @pred debugger_input.
* name of stream used for debugging,
* must be always connected to a tty.
*
* '$debugger_input': try to connect the debugger to an open terminal.
*
* '$debugger_input': try to connect the debugger to an open terminal.
*/
'$debugger_input' :-
stream_property(_,alias(debugger_input)),
@ -695,9 +686,12 @@ be lost.
'$debugger_input' :-
current_prolog_flag(windows, true ), !,
open('CONIN$', read, _S, [alias(debugger_input),bom(false)]).
% last argument to do_spy says that we are at the end of a context. It
'$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
% is required to know whether we are controlled by the debugger.
%'$do_spy'(V, M, CP, Flag) :-
% writeln('$do_spy'(V, M, CP, Flag)), fail.
@ -735,9 +729,9 @@ be lost.
).
'$do_spy'((A|B), M, CP, CalledFromDebugger) :- !,
(
'$do_spy'(A, M, CP, CalledFromDebugger)
'$do_spy'(A, M, CP, CalledFromDebugger )
;
'$do_spy'(B, M, CP, CalledFromDebugger)
'$do_spy'(B, M, CP, CalledFromDebugger )
).
'$do_spy'((\+G), M, CP, CalledFromDebugger) :- !,
\+ '$do_spy'(G, M, CP, CalledFromDebugger).
@ -748,7 +742,8 @@ be lost.
L1 is L+1, /* bump it */
nb_setval('$spy_gn',L1), /* and save it globaly */
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).
% we are skipping, so we can just call the goal,
@ -807,6 +802,7 @@ be lost.
/* call port */
'$enter_goal'(GoalNumber, G, Module),
'$spycall'(G, Module, CalledFromDebugger, Retry),
'$stop_creeping',
% make sure we are in system mode when running the debugger.
(
'$debugger_deterministic_goal'(G) ->
@ -839,6 +835,7 @@ be lost.
(
arg(6, Info, true)
->
'$stop_creeping',
'$show_trace'(redo,G,Module,GoalNumber,_), /* inform user_error */
nb_setarg(6, Info, false)
;
@ -890,7 +887,12 @@ be lost.
'$spycall'(G, M, _, _) :-
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).
'$spycall'(G, M, _, _) :-
(
@ -901,13 +903,14 @@ be lost.
!,
( '$is_metapredicate'(G, M)
->
'$meta_expansion'(G,M,M,M,G1,[]),
'$creep'(G1, M)
'$meta_expansion'(G,M,M,M,G10,[]),
'$debugger_process_meta_arguments'(G10, M, G1),
'$execute'(M:G1)
;
'$execute'(M:G)
).
'$spycall'(G, M, _, _) :-
'$tabled_predicate'(G,M),
'$tabled_predicate'(G,M),
!,
'$continue_debugging_goal'(no, '$execute_nonstop'(G,M)).
'$spycall'(G, M, CalledFromDebugger, InRedo) :-
@ -933,6 +936,7 @@ be lost.
% I lost control here.
CP is '$last_choice_pt',
'$static_clause'(G,M,_,R),
'$stop_creeping',
% I may backtrack to here from far away
(
'$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) :-
(
'$$save_by'(CP1),
@ -955,6 +969,18 @@ be lost.
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) :-
'$predicate_flags'(G,M,F,F),
F /\ 0x00000040 =\= 0.
@ -964,6 +990,8 @@ be lost.
'$trace'(P,G,Module,L,Deterministic) :-
% at this point we are done with leap or skip
nb_setval('$debug_run',off),
% but creep is default
nb_setval('$trace',on),
% make sure we run this code outside debugging mode.
set_prolog_flag(debug, false),
repeat,
@ -1031,6 +1059,10 @@ be lost.
current_prolog_flag(debug, OldDeb),
set_prolog_flag(debug, false),
( '$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),
% '$skipeol'(0'!), % '
fail.
@ -1350,3 +1382,19 @@ be lost.
yap_hacks:choicepoint(CP,_,prolog,'$loop_spy2',5,(_;_),_), !,
'$debugger_skip_loop_spy2'(CPs,CPs1).
'$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.
depth_bound_call(A,D) :-
'$execute_under_depth_limit'(A,D).

9
pl/init.yap
View File

@ -108,7 +108,7 @@ otherwise.
:- '$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('lists.yap').
@ -145,7 +145,7 @@ otherwise.
'grammar.yap',
'ground.yap',
'listing.yap',
'arithpreds.yap',
'arithpreds.yap',
% modules must be after preds, otherwise we will have trouble
% with meta-predicate expansion being invoked
% must follow grammar
@ -164,8 +164,8 @@ otherwise.
'eam.yap',
'chtypes.yap',
'yapor.yap',
'qly.yap',
'udi.yap'].
'qly.yap',
'udi.yap'].
:- meta_predicate(log_event(+,:)).
@ -288,7 +288,6 @@ as directives.
*/
:- multifile term_expansion/2.
:- dynamic term_expansion/2.

4
pl/listing.yap
View File

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

31
pl/messages.yap
View File

@ -120,10 +120,8 @@ generate_message(error(Error,Context)) -->
{ Error = existence_error(procedure,_) }, !,
system_message(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) -->
file_location,
system_message(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.
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] ].
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 = [_|_] },
['SYNTAX ERROR' - []],
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, 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, kind(Kind), Lines) :- !,
prefix(Kind, Prefix, _),
'$messages':prefix(Kind, Prefix, _),
lists:append([ begin(Kind, Ctx)
| Lines
],
[ end(Ctx)
],
AllLines),
print_message_lines(S, Prefix, AllLines).
prolog:print_message_lines(S, Prefix, AllLines).
prolog:print_message_lines(S, P-Opts, Lines) :-
atom(P), !,
atom_concat('~N', P, Prefix),
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, Lines) :-
atom(P), !,
atom_concat('~N', P, Prefix),
format(S, Prefix, []),
print_message_line(S, Lines, Rest),
'$messages':print_message_line(S, Lines, Rest),
prolog:print_message_lines(S, P, Rest).
print_message_line(S, [flush], []) :- !,
@ -671,13 +670,13 @@ pred_arity(H,Name,Arity) :-
functor(H,Name,Arity).
translate_message(Term) -->
generate_message(Term), !.
translate_message(Term) -->
{ Term = error(_, _) },
[ 'Unknown exception: ~p'-[Term] ].
translate_message(Term) -->
[ 'Unknown message: ~p'-[Term] ].
translate_message(Term) -->
generate_message(Term), !.
translate_message(Term) -->
{ Term = error(_, _) },
[ 'Unknown exception: ~p'-[Term] ].
translate_message(Term) -->
[ 'Unknown message: ~p'-[Term] ].
/**
@}

4
pl/modules.yap
View File

@ -945,7 +945,6 @@ meta_predicate declaration
*/
% directive now meta_predicate Ps :- $meta_predicate(Ps).
:- dynamic('$meta_predicate'/4).
@ -1006,7 +1005,8 @@ meta_predicate declaration
'$meta_expansion'(G, HM, BM, SM, G1,HVars) :-
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]),
functor(G1,F,N),
'$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), !,
'$do_error'(instantiation_error,dynamic(M:X)).
'$dynamic'(X,M) :- var(M), !,
'$do_error'(instantiation_error,dynamic(M:X)).
'$dynamic'(Mod:Spec,_) :- !,
'$dynamic'(Spec,Mod).
'$dynamic'([], _) :- !.

123
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).
*/
asserta(Mod:C) :- !,
'$assert'(C,Mod,first,_,asserta(Mod:C)).
asserta(C) :-
'$current_module'(Mod),
'$assert'(C,Mod,first,_,asserta(C)).
strip_module(C, Mod, NC),
'$assert'(NC,Mod,first,_,asserta(C)).
/** @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
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) :-
'$current_module'(Mod),
'$assert'(C,Mod,last,_,assertz(C)).
strip_module(C,Mod,C1),
'$assert'(C1,Mod,last,_,assertz(C)).
/** @pred assert(+ _C_)
@ -53,11 +49,9 @@ deprecated, if you want to assert clauses for static procedures you
should use assert_static/1.
*/
assert(Mod:C) :- !,
'$assert'(C,Mod,last,_,assert(Mod:C)).
assert(C) :-
'$current_module'(Mod),
'$assert'(C,Mod,last,_,assert(C)).
strip_module(C,Mod,C1),
'$assert'(C1,Mod,last,_,assert(C)).
'$assert'(V,Mod,_,_,_) :- var(V), !,
'$do_error'(instantiation_error,assert(Mod:V)).
@ -66,45 +60,42 @@ assert(C) :-
'$assert'(I,Mod,_,_,_) :- number(I), !,
'$do_error'(type_error(callable,I),assert(Mod:I)).
'$assert'(M:C,_,Where,R,P) :- !,
'$assert'(C,M,Where,R,P).
'$assert'((H:-G),M1,Where,R,P) :- !,
'$assert_clause'(H, G, M1, Where, R, P).
'$assert'(H,M1,Where,R,_) :-
strip_module(M1:H, HM, H1),
'$assert_fact'(H1, HM, 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).
strip_module(M:C, M1, C1),
'$assert'(C1,M1,Where,R,P).
'$assert'((H:-G),M,Where,R,P) :- !,
'$assert_clause'(H, G, M, Where, R, P).
'$assert'(H,M,Where,R,_) :-
'$assert_fact'(H, M, 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) ->
'$compile_dynamic'(H, Where, H, Mod, R)
;
'$is_dynamic'(H, Mod) ->
;
'$is_dynamic'(H, Mod) ->
'$assertat_d'(Where, H, true, H, Mod, R)
;
'$undefined'(H,Mod) ->
functor(H, Na, Ar),
'$dynamic'(Na/Ar, Mod),
'$assert_fact'(H,Mod,Where,R)
% try asserting as static, see what happens
Where = last ->
assert_static(Mod:H)
;
current_prolog_flag(language, yap)) -> % I can assert over static facts in YAP mode
'$assert1'(Where,H,H,Mod,H)
;
functor(H, Na, Ar),
'$do_error'(permission_error(modify,static_procedure,Na/Ar),Mod:assert(H))
asserta_static(Mod:H)
).
'$assert_clause2'(HI,BI,Mod,Where,R,P) :-
'$expand_clause'((HI :- BI),C0,C,Mod,HM),
'$assert_clause3'(C0,C,HM,Where,R,P).
'$assert_clause3'(C0,C,Mod,Where,R,P) :-
'$assert_clause'(H, _, _, _, _, P) :-
var(H), !,
'$do_error'(instantiation_error,P).
'$assert_clause'(M:C, G, MG, 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),
( '$is_log_updatable'(H, Mod) ->
'$compile_dynamic'((H :- B), Where, C0, Mod, R)
@ -112,44 +103,11 @@ assert(C) :-
'$is_dynamic'(H, Mod) ->
'$assertat_d'(Where, H, B, C0, Mod, R)
;
'$undefined'(H,Mod) ->
functor(H, Na, Ar),
'$dynamic'(Na/Ar, Mod),
'$assert_clause3'(C0,C,Mod,Where,R,P)
Where = last
->
assert_static(Mod:(H :- B))
;
current_prolog_flag(language, sicstus)) -> % I can assert over static facts in YAP mode
'$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)
asserta_static(Mod:(H :- B))
).
/** @pred asserta(+ _C_,- _R_)
@ -161,11 +119,9 @@ predicates. If the predicate is undefined, it will automatically be
declared dynamic.
*/
asserta(M:C,R) :- !,
'$assert_dynamic'(C,M,first,R,asserta(M:C,R)).
asserta(C,R) :-
'$current_module'(M),
'$assert_dynamic'(C,M,first,R,asserta(C,R)).
strip_module(C, M, C1),
'$assert'(C1,M,first,R,asserta(C,R)).
/** @pred assertz(+ _C_,- _R_)
@ -473,4 +429,3 @@ dynamic_predicate(P,Sem) :-
).
'$expand_clause'(H,H1,H1,Mod,HM) :-
strip_module(Mod:H, HM, H1).

152
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) :-
'$current_module'(Mod),
'$assert_static'(C,Mod,last,_,assert_static(C)).
strip_module(C, Mod, C1),
'$assert_static'(C1, Mod,last,_,assert_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) :-
'$current_module'(Mod),
'$assert_static'(C,Mod,first,_,asserta_static(C)).
strip_module(C, Mod, C1),
'$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_)
@ -145,13 +140,11 @@ static predicates, if source mode was on when they were compiled:
*/
assertz_static(C) :-
'$current_module'(Mod),
'$assert_static'(C,Mod,last,_,assertz_static(C)).
strip_module(C, Mod, C1),
'$assert_static'(C1,Mod,last,_,assertz_static(C)).
'$assert_static'(V,M,_,_,_) :- var(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) :-
var(H), !, '$do_error'(instantiation_error,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'(P,M,Q,_).
clause(V,Q) :-
'$current_module'(M),
clause(V0,Q) :-
strip_module(V0, M, V),
'$clause'(V,M,Q,_).
/** @pred clause(+ _H_, _B_,- _R_)
@ -199,10 +190,8 @@ erase/1 on the reference on static procedures.
clause(P,Q,R) :- var(P), !,
'$current_module'(M),
'$clause'(P,M,Q,R).
clause(M:P,Q,R) :- !,
'$clause'(P,M,Q,R).
clause(V,Q,R) :-
'$current_module'(M),
clause(V0,Q,R) :-
strip_module(V0, M, V),
'$clause'(V,M,Q,R).
'$clause'(P,M,Q,R) :-
@ -272,8 +261,7 @@ and _I_ is bound to its position.
*/
nth_clause(V,I,R) :-
'$current_module'(M),
strip_module(M:V, M1, P), !,
strip_module(V, M1, P), !,
'$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
meta-predicate, will be lost.
*/
abolish(Mod:N,A) :- !,
'$abolish'(N,A,Mod).
abolish(N,A) :-
'$current_module'(Mod),
abolish(N0,A) :-
strip_module(N0, Mod, N), !,
'$abolish'(N,A,Mod).
'$abolish'(N,A,M) :- var(N), !,
@ -312,7 +298,7 @@ abolish(N,A) :-
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
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
@ -320,14 +306,8 @@ dynamic procedures. Under other modes it will abolish any procedures.
*/
abolish(V) :- var(V), !,
'$do_error'(instantiation_error,abolish(V)).
abolish(Mod:V) :- var(V), !,
'$do_error'(instantiation_error,abolish(Mod:V)).
abolish(M:X) :- !,
'$abolish'(X,M).
abolish(X) :-
'$current_module'(M),
abolish(X0) :-
strip_module(X0,M,X),
'$abolish'(X,M).
'$abolish'(X,M) :-
@ -340,8 +320,6 @@ abolish(X) :-
'$abolish_all'(M).
'$new_abolish'(A,M) :- atom(A), !,
'$abolish_all_atoms'(A,M).
'$new_abolish'(M:PS,_) :- !,
'$new_abolish'(PS,M).
'$new_abolish'(Na//Ar1, M) :-
integer(Ar1),
!,
@ -424,8 +402,6 @@ abolish(X) :-
;
'$abolish_all_atoms_old'(A,M)
).
'$old_abolish'(M:N,_) :- !,
'$old_abolish'(N,M).
'$old_abolish'([], _) :- !.
'$old_abolish'([H|T], M) :- !, '$old_abolish'(H, 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
functor can be declared.
**/
stash_predicate(V) :- var(V), !,
'$do_error'(instantiation_error,stash_predicate(V)).
stash_predicate(M:P) :- !,
'$stash_predicate2'(P, M).
stash_predicate(P) :-
'$current_module'(M),
stash_predicate(P0) :-
strip_module(P0, M, P),
'$stash_predicate2'(P, M).
'$stash_predicate2'(V, M) :- var(V), !,
@ -496,10 +468,8 @@ Make predicate _Pred_ invisible to `current_predicate/2`,
**/
hide_predicate(V) :- var(V), !,
'$do_error'(instantiation_error,hide_predicate(V)).
hide_predicate(M:P) :- !,
'$hide_predicate2'(P, M).
hide_predicate(P) :-
'$current_module'(M),
hide_predicate(P0) :-
strip_module(P0, M, P),
'$hide_predicate2'(P, M).
'$hide_predicate2'(V, M) :- var(V), !,
@ -583,7 +553,7 @@ predicate_property(Pred,Prop) :-
).
'$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) :-
recorded('$import','$import'(SourceMod, Mod, Orig, Pred,_,_),_),
'$pred_exists'(Orig, SourceMod).
@ -630,10 +600,8 @@ indices to those clauses (in bytes).
*/
predicate_statistics(V,NCls,Sz,ISz) :- var(V), !,
'$do_error'(instantiation_error,predicate_statistics(V,NCls,Sz,ISz)).
predicate_statistics(M:P,NCls,Sz,ISz) :- !,
'$predicate_statistics'(P,M,NCls,Sz,ISz).
predicate_statistics(P,NCls,Sz,ISz) :-
'$current_module'(M),
predicate_statistics(P0,NCls,Sz,ISz) :-
strip_module(P0, M, P),
'$predicate_statistics'(P,M,NCls,Sz,ISz).
'$predicate_statistics'(M:P,_,NCls,Sz,ISz) :- !,
@ -661,29 +629,23 @@ predicate_erased_statistics(P,NCls,Sz,ISz) :-
var(P), !,
current_predicate(_,P),
predicate_erased_statistics(P,NCls,Sz,ISz).
predicate_erased_statistics(M:P,NCls,Sz,ISz) :- !,
'$predicate_erased_statistics'(M:P,NCls,Sz,_,ISz).
predicate_erased_statistics(P,NCls,Sz,ISz) :-
'$current_module'(M),
predicate_erased_statistics(P0,NCls,Sz,ISz) :-
strip_module(P0,M,P),
'$predicate_erased_statistics'(M:P,NCls,Sz,_,ISz).
/** @pred current_predicate( _A_, _P_)
Defines the relation: _P_ is a currently defined predicate whose name is the atom _A_.
*/
current_predicate(A,T) :-
'$ground_module'(T, M, T0),
(
'$current_predicate'(A, M, T0, _),
%TFlags is Flags /\ 0x00004000,
% format('1 ~w ~16r~n', [M:T0,Flags, TFlags]),
\+ '$system_predicate'(T0, M)
;
'$imported_predicate'(T0, M, SourceT, SourceMod),
functor(T0, A, _),
% format('2 ~w ~16r~n', [M:T0,Flags]),
\+ '$system_predicate'(SourceT, SourceMod)
).
current_predicate(A,T0) :-
strip_module(T0, M, T),
(
'$current_predicate'(A, M, T0, user)
;
'$imported_predicate'(T, M, SourceT, SourceMod),
functor(T, A, _),
\+ '$system_predicate'(SourceT, SourceMod)
).
/** @pred system_predicate( _A_, _P_)
@ -691,12 +653,18 @@ current_predicate(A,T) :-
is the atom _A_.
*/
system_predicate(A,T) :-
'$ground_module'(T, M, T0),
system_predicate(A,T1) :-
strip_module( T1, M, T),
(
'$current_predicate'(A, M, T0, Flags)
M \= prolog,
'$current_predicate'(A, M, T0, system)
;
'$imported_predicate'(T, M, SourceT, SourceMod),
M \= prolog,
functor(T, A, _),
'$system_predicate'(SourceT, SourceMod)
;
'$current_predicate'(A, prolog, T0, Flags)
'$current_predicate'(A, prolog, T0, system)
).
/** @pred system_predicate( ?_P_ )
@ -704,7 +672,8 @@ system_predicate(A,T) :-
Defines the relation: _P_ is a currently defined system predicate.
*/
system_predicate(P) :-
system_predicate(_, P).
strip_module(M, P),
system_predicate(_, M:P).
/**
@ -716,17 +685,18 @@ system_predicate(P) :-
_Na_ is the name of the predicate, and _Ar_ its arity.
*/
current_predicate(F0) :-
strip_module(F0, M, F),
(
var(F)
->
current_predicate(M:A, S),
functor( S, A, Ar)
;
F = A/Ar,
current_predicate(M:A, S),
functor( S, A, Ar)
).
strip_module(F0, M, AN),
( AN = A/N
->
current_predicate(A, M:S),
functor( S, A, Ar)
;
AN == A//N
->
current_predicate(A, M:S),
Ar2 is Ar+2,
functor( S, A, Ar2)
).
'$imported_predicate'(A, ImportingMod, A/Arity, G, Flags) :-
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod),
@ -742,7 +712,7 @@ name is the atom _A_. It can be used to generate all the keys for
the internal data-base.
*/
current_key(A,K) :-
'$current_predicate'(A,idb,K,_).
'$current_predicate'(A,idb,K,user).
% do nothing for now.
'$noprofile'(_, _).

7
pl/protect.yap
View File

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

7
pl/qly.yap
View File

@ -539,7 +539,8 @@ qload_module(Mod) :-
'$qload_module'(_S, Mod, _File, _SourceModule) :-
unload_module( Mod ), fail.
'$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) :-
Mod:'@mod_info'(F, Exps, MFs, Line,Parents, Imps, Metas, ModTransps, Foreigns, TEs),
abolish(Mod:'@mod_info'/10),
@ -555,12 +556,12 @@ qload_module(Mod) :-
% no evil.
'$convert_for_export'(all, Exps, Mod, SourceModule, TranslationTab, _AllExports0, qload_module),
'$add_to_imports'(TranslationTab, Mod, SourceModule). % insert ops, at least for now
%:- stop_low_level_trace.
'$fetch_imports_module'(Mod, Imports) :-
findall(Info, '$fetch_import_module'(Mod, Info), Imports).
% 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('$module','$module'(_, Mod0, S, _, _), _) -> true ; S = user_input ).

32
pl/signals.yap
View File

@ -29,7 +29,7 @@
:- use_system_module( '$_threads', ['$thread_gfetch'/1]).
/** @pred alarm(+ _Seconds_,+ _Callable_,+ _OldAlarm_)
/** @pred alarm(+ _Seconds_,+ _Callable_,+ _OldAlarm_)
Arranges for YAP to be interrupted in _Seconds_ seconds, or in
@ -99,9 +99,9 @@ if the alarm is sent. It uses catch/3 to handle the case the
`alarm` is sent. Then it starts the alarm, calls the goal
_Goal_, and disables the alarm on success or failure.
*/
/** @pred on_signal(+ _Signal_,? _OldAction_,+ _Callable_)
/** @pred on_signal(+ _Signal_,? _OldAction_,+ _Callable_)
Set the interrupt handler for soft interrupt _Signal_ to be
@ -223,8 +223,7 @@ order of dispatch.
'$is_no_trace'(G, M), !,
(
'$$save_by'(CP),
'$enable_debugging',
'$execute_nonstop'(G, M),
'$no_creep_call'(G,M),
'$$save_by'(CP2),
'$disable_debugging',
(CP == CP2 -> ! ; ( true ; '$enable_debugging', fail ) ),
@ -232,11 +231,23 @@ order of dispatch.
;
'$disable_debugging',
fail
).
).
'$start_creep'([Mod|G], WhereFrom) :-
CP is '$last_choice_pt',
CP is '$last_choice_pt',
'$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) :-
(
'$is_metapredicate'(G, Mod)
@ -262,7 +273,7 @@ order of dispatch.
'$signal_def'(sig_pipe, throw(error(signal(pipe,[]),true))).
'$signal_def'(sig_fpe, throw(error(signal(fpe,[]),true))).
% ignore sig_alarm by default
'$signal_def'(sig_alarm, true).
'$signal_def'(sig_alarm, true).
'$signal'(sig_hup).
@ -316,8 +327,7 @@ alarm(Interval, Goal, Left) :-
Left = Left0.
alarm(Interval, Goal, Left) :-
integer(Interval), !,
on_signal(sig_alarm, _, Goal),
'$alarm'(Interval, 0, Left, _).
on_signal(sig_alarm, _, Goal), '$alarm'(Interval, 0, Left, _).
alarm(Number, Goal, Left) :-
float(Number), !,
Secs is integer(Number),
@ -344,7 +354,7 @@ read_sig.
:- '$set_no_trace'(true, prolog).
:- '$set_no_trace'('$call'(_,_,_,_), prolog).
:- '$set_no_trace'('$execute_nonstop'(_,_), prolog).
:- '$set_no_trace'('$execute_clause'(_,_,_,_), prolog).
:- '$set_no_trace'('$restore_regs'(_,_), prolog).
%%! @}

3
pl/undefined.yap
View File

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