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

debugger

Browse Source
This commit is contained in:
Vítor Santos Costa 2019-05-10 03:05:40 +01:00
parent e23055d4f0
commit 4d395761a4
4 changed files with 138 additions and 147 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
library/rbtrees.yap
View File

@ -76,7 +76,7 @@ form colour(Left, Key, Value, Right), where _colour_ is one of =red= or
rb_partial_map(+,+,2,-), rb_partial_map(+,+,2,-),
rb_apply(+,+,2,-). rb_apply(+,+,2,-).
/*
:- use_module(library(type_check)). :- use_module(library(type_check)).
:- type rbtree(K,V) ---> t(tree(K,V),tree(K,V)). :- type rbtree(K,V) ---> t(tree(K,V),tree(K,V)).
@ -97,7 +97,7 @@ form colour(Left, Key, Value, Right), where _colour_ is one of =red= or
:- pred max(tree(K,V),K,V). :- pred max(tree(K,V),K,V).
:- pred rb_next(rbtree(K,V),K,pair(K,V),V). :- pred rb_next(rbtree(K,V),K,pair(K,V),V).
:- pred next(tree(K,V),K,pair(K,V),V,tree(K,V)). :- pred next(tree(K,V),K,pair(K,V),V,tree(K,V)).
*/
%% @pred rb_new(-T) is det. %% @pred rb_new(-T) is det.
% create an empty tree. % create an empty tree.

40
pl/debug.yap
View File

@ -14,11 +14,9 @@
* comments: YAP debugger * * comments: YAP debugger *
* * * *
*************************************************************************/ *************************************************************************/
:- system_module('$_debug',
[],
:- system_module( '$_debug', [], ['$trace_query'/4, ['$trace_query'/4, '$init_debugger'/0, '$skipeol'/1]).
'$init_debugger'/0,
'$skipeol'/1]).
@ -489,15 +487,10 @@ be lost.
). ).
% system_ % system_
'$trace_goal__'(G,M, GoalNumber, H) :- '$trace_goal__'(G,M, GoalNumber, H) :-
!,
gated_call(
'$enter_trace'(GoalNumber, G, M, H), '$enter_trace'(GoalNumber, G, M, H),
( '$creep_is_on_at_entry'(G,M) gated_call(
-> true,
'$execute_nonstop'(('$creep',G),M) '$execute_nonstop'(G,M),
;
'$execute_nonstop'(G,M)
),
Port, Port,
'$trace_port'(Port, GoalNumber, G, M, true, H) '$trace_port'(Port, GoalNumber, G, M, true, H)
). ).
@ -580,17 +573,12 @@ be lost.
'$trace_port_'(redo, GoalNumber, G, Module, Info). '$trace_port_'(redo, GoalNumber, G, Module, Info).
'$trace_port'(Port, GoalNumber, G, Module, _CalledFromDebugger, Info) :- '$trace_port'(Port, GoalNumber, G, Module, _CalledFromDebugger, Info) :-
'$stop_creeping'(_) , '$trace_off',
current_prolog_flag(debug, true),
'__NB_getval__'('$debug_status',state(Skip,Border,_,Trace), fail),
( Skip == creep -> true;
'$stop_creeping'(_) ,
'$id_goal'(GoalNumber),
GoalNumber =< Border),
!, !,
'__NB_setval__'('$debug_status', state(creep, 0, stop,Trace)), '$trace_port_'(Port, GoalNumber, G, Module, Info),
'$trace_port_'(Port, GoalNumber, G, Module, Info). '$continue_debugging'(Port).
'$trace_port'(_Port, _GoalNumber, _G, _Module, _CalledFromDebugger, _Info). '$trace_port'(Port, _GoalNumber, _G, _Module, _CalledFromDebugger, _Info) :-
'$continue_debugging'(Port).
'$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).
@ -737,12 +725,8 @@ be lost.
'$action'(!,_,_,_,_,_) :- !, % ! 'g execute '$action'(!,_,_,_,_,_) :- !, % ! 'g execute
read(debugger_input, G), read(debugger_input, G),
% don't allow yourself to be caught by creep. % don't allow yourself to be caught by creep.
current_prolog_flag(debug, OldDeb),
set_prolog_flag(debug, false),
ignore( G ), ignore( G ),
% at this point we are done with leap or skip skip( debugger_input, 10), % '
set_prolog_flag(debug, OldDeb),
% skip( debugger_input, 10), % '
fail. fail.
'$action'(<,_,_,_,_,_) :- !, % <'Depth '$action'(<,_,_,_,_,_) :- !, % <'Depth
'$new_deb_depth', '$new_deb_depth',

92
pl/spy.yap
View File

@ -60,18 +60,7 @@ mode and the existing spy-points, when the debugger is on.
:- op(900,fx,[spy,nospy]). :- op(900,fx,[spy,nospy]).
'$init_debugger' :- % First part : setting and reseting spy points
'__NB_getval__'('$trace', _, fail), !.
'$init_debugger' :-
'$debugger_input',
'__NB_setval__'('$trace',off),
'__NB_setval__'('$if_skip_mode',no_skip),
'__NB_setval__'('$spy_glist',[]),
'__NB_setval__'('$spy_gn',1),
'__NB_setval__'('$debug_state', state(zip,0,stop,off)).
% First part : setting and reseting spy points
% $suspy does most of the work % $suspy does most of the work
'$suspy'(V,S,M) :- var(V) , !, '$suspy'(V,S,M) :- var(V) , !,
@ -214,19 +203,15 @@ debug :-
'$start_debugging'(on), '$start_debugging'(on),
print_message(informational,debug(debug)). print_message(informational,debug(debug)).
'$start_debugging'(Mode) :- '$start_debugging'(_Mode) :-
(Mode == on -> '__NB_setval__'(debug, false),
set_prolog_flag(debug, true)
;
set_prolog_flag(debug, false)
),
'__NB_getval__'('$trace',Trace, fail), '__NB_getval__'('$trace',Trace, fail),
( Trace == on -> Creep = crep; Creep = zip ), ( Trace == on -> Creep = crep; Creep = zip ),
'__NB_setval__'('$debug_state',state(Creep,0,stop,Trace) ). '__NB_setval__'('$debug_state',state(Creep,0,stop,Trace) ).
nodebug :- nodebug :-
'$init_debugger',
set_prolog_flag(debug, false), set_prolog_flag(debug, false),
'$init_debugger',
'__NB_setval__'('$trace',off), '__NB_setval__'('$trace',off),
print_message(informational,debug(off)). print_message(informational,debug(off)).
@ -394,21 +379,30 @@ notrace(G) :-
). ).
'$creep_at_port'(retry) :- '$creep_at_port'(retry) :-
current_prolog_flag(debug, true), '__NB_getval__'(debug, true, fail),
'__NB_getval__'('$trace',Trace,fail), '__NB_getval__'('$trace',Trace,fail),
Trace = on, Trace = on,
!, !,
'$enable_debugging'. '$enable_debugging'.
'$creep_at_port'(fail) :- '$creep_at_port'(fail) :-
current_prolog_flag(debug, true), '__NB_getval__'(debug, true, fail),
'__NB_getval__'('$trace',Trace,fail), '__NB_getval__'('$trace',Trace,fail),
Trace = on, Trace = on,
!, !,
'$enable_debugging'. '$enable_debugging'.
'$disable_debugging_on_port'(_Port) :-
'$disable_debugging'.
'$init_debugger' :-
'$init_debugger_trace',
'__NB_setval__'('$if_skip_mode',no_skip),
'__NB_setval__'('$spy_glist',[]),
'__NB_setval__'('$spy_gn',1).
'$init_debugger_trace' :-
'__NB_getval__'('$trace',on,fail),
!,
nb_setval('$debug_status', state(creep, 0, stop, on)).
'$init_debugger_trace' :-
nb_setval('$debug_status', state(zip, 0, stop, off)).
%% @pred $enter_debugging(G,Mod,CP,G0,NG) %% @pred $enter_debugging(G,Mod,CP,G0,NG)
%% %%
@ -416,7 +410,7 @@ notrace(G) :-
%% enable creeping on a goal by just switching execution to debugger. %% enable creeping on a goal by just switching execution to debugger.
%% %%
'$enter_debugging'(G,Mod,CP,G0,NG) :- '$enter_debugging'(G,Mod,CP,G0,NG) :-
'$creep_is_on_at_entry'(G,Mod), '$creepcalls'(G,Mod),
!, !,
'$trace_query'(G,Mod,CP,G0,NG). '$trace_query'(G,Mod,CP,G0,NG).
'$enter_debugging'(G,_Mod,_CP,_G0,G). '$enter_debugging'(G,_Mod,_CP,_G0,G).
@ -426,19 +420,9 @@ notrace(G) :-
'$reenter_debugger'(retry) :- '$reenter_debugger'(retry) :-
'$re_enter_creep_mode'. '$re_enter_creep_mode'.
'$reenter_debugger'(_) :- '$reenter_debugger'(_) :-
set_current_flag(debug, false). '__NB_setval__'(debug, false).
%% @pred $re_enter_creep_mode1
%%
%% Internal predicate called when exiting through a port;
%% enable creeping on the next goal.
%%
'$re_enter_creep_mode' :-
'$creep_is_on',
!,
'$creep'.
'$re_enter_creep_mode'.
% what to do when you exit the debugger.
'$continue_debugging'(exit) :- '$continue_debugging'(exit) :-
!, !,
'$re_enter_creep_mode'. '$re_enter_creep_mode'.
@ -453,18 +437,20 @@ notrace(G) :-
'$enable_debugging' :- '$enable_debugging' :-
'$re_enter_creep_mode'. '$re_enter_creep_mode'.
'$trace_on' :-
'__NB_getval__'('$debug_status', state(_Creep, GN, Spy,_), fail),
nb_setval('$trace',on),
nb_setval('$debug_status', state(creep, GN, Spy, on)).
'$trace_off' :- %% @pred $re_enter_creep_mode1
'__NB_getval__'('$debug_status', state(_Creep, GN, Spy), fail), %%
'__NB_setval__'('$trace',off), %% Internal predicate called when exiting through a port;
nb_setval('$debug_status', state(zip, GN, Spy,off)). %% enable creeping on the next goal.
%%
'$re_enter_creep_mode' :-
'__NB_getval__'(debug, true, fail),
!,
'$creep'.
'$re_enter_creep_mode'.
'$creep_is_off'(_,_) :- '$creep_is_off'(_,_) :-
current_prolog_flag(debug, false), !. '__NB_getval__'(debug, false, fail), !.
'$creep_is_off'(Module:G, GN0) :- '$creep_is_off'(Module:G, GN0) :-
'__NB_getval__'('$debug_status',state(zip, GN, Spy,_), fail), '__NB_getval__'('$debug_status',state(zip, GN, Spy,_), fail),
( (
@ -483,12 +469,13 @@ notrace(G) :-
%% %%
% %
'$creep_is_on' :- '$creep_is_on' :-
current_prolog_flag(debug, true), '__NB_getval__'(debug, true, fail),
'__NB_getval__'('$debug_status',state(Step, _GN, _Spy,_), fail), '__NB_getval__'('$debug_status',state(Step, _GN, _Spy,_), fail),
Step \= zip. Step \= zip.
'$creep_is_on_at_entry'(G,M) :- '$creep_is_on_at_entry'(G,M) :-
current_prolog_flag(debug, true), '__NB_getval__'(debug, true, fail),
\+ '$system_predicate'(G,M),
'__NB_getval__'('$debug_status',state(Step, _GN, Spy,_), fail), '__NB_getval__'('$debug_status',state(Step, _GN, Spy,_), fail),
( (
Step \= zip Step \= zip
@ -497,6 +484,17 @@ notrace(G) :-
'$pred_being_spied'(G,M) '$pred_being_spied'(G,M)
). ).
'$trace_on' :-
'__NB_getval__'('$debug_status', state(_Creep, GN, Spy,Trace), fail),
nb_getval('$trace',on),
nb_setval('$debug_status', state(creep, GN, Spy, Trace)).
'$trace_off' :-
'__NB_getval__'('$debug_status', state(_Creep, GN, Spy, Trace),fail),
'__NB_setval__'(debug,false),
nb_setval('$debug_status', state(zip, GN, Spy,Trace)).
/* /*
@} @}

97
pl/top.yap
View File

@ -13,25 +13,23 @@
* @{ * @{
* *
*/ */
:- '$system_meta_predicates'([gated_call(0, 0, ?, 0), catch(0, ?, 0), log_event(+, :)]).
:- '$system_meta_predicates'([
gated_call(0,0,?,0),
catch(0,?,0),
log_event(+,:)]).
% @pred live % @pred live
% %
% start a Prolog engine. % start a Prolog engine.
live :- live :-
repeat, repeat,
yap_flag(verbose,normal), yap_flag(verbose, normal),
current_source_module(Module,Module), current_source_module(Module, Module),
( Module==user -> ( Module==user
true % '$compile_mode'(_,0) -> true % '$compile_mode'(_,0)
; ; format(user_error, '[~w]~n', [Module])
format(user_error,'[~w]~n', [Module])
), ),
'$system_catch'('$enter_top_level',Module,Error,'$Error'(Error)). '$system_catch'('$enter_top_level',
Module,
Error,
'$Error'(Error)).
% Start file for yap % Start file for yap
@ -49,13 +47,18 @@ live :-
'$prompt', '$prompt',
catch(read_term(user_input, catch(read_term(user_input,
Goal, Goal,
[variable_names(Bindings), syntax_errors(dec10), term_position(Pos)]),
E, '$handle_toplevel_error'( E) ).
'$handle_toplevel_error'( syntax_error(_)) :- [ variable_names(Bindings),
syntax_errors(dec10),
term_position(Pos)
]),
E,
'$handle_toplevel_error'(E)).
'$handle_toplevel_error'(syntax_error(_)) :-
!, !,
fail. fail.
'$handle_toplevel_error'( error(io_error(read,user_input),_)) :- '$handle_toplevel_error'(error(io_error(read, user_input), _)) :-
!. !.
'$handle_toplevel_error'(_, E) :- '$handle_toplevel_error'(_, E) :-
throw(E). throw(E).
@ -69,41 +72,47 @@ live :-
'$clean_up_dead_clauses', '$clean_up_dead_clauses',
fail. fail.
'$enter_top_level' :- '$enter_top_level' :-
get_value('$top_level_goal',GA), GA \= [], !, get_value('$top_level_goal', GA),
set_value('$top_level_goal',[]), GA\=[],
!,
set_value('$top_level_goal', []),
'$run_atom_goal'(GA), '$run_atom_goal'(GA),
fail. fail.
'$enter_top_level' :- '$enter_top_level' :-
flush_output, flush_output,
'$run_toplevel_hooks', '$run_toplevel_hooks',
prompt1(' ?- '), prompt1(' ?- '),
'$read_toplevel'(Command,Varnames,Pos), '$read_toplevel'(Command, Varnames, Pos),
nb_setval('$spy_gn',1), '$init_debugger',
% stop at spy-points if debugging is on. '$command'(Command, Varnames, Pos, top),
nb_setval('$debug_run',off),
nb_setval('$debug_jump',off),
'__NB_setval__'('$trace',off),
nb_setval('$debug_status', state(zip, 0, stop,off)),
'$command'(Command,Varnames,Pos,top),
current_prolog_flag(break_level, BreakLevel), current_prolog_flag(break_level, BreakLevel),
( ( BreakLevel\=0
BreakLevel \= 0 -> true
-> ; '$pred_exists'(halt(_), user)
true -> halt(0)
; ; '$halt'(0)
'$pred_exists'(halt(_), user) ).
->
halt(0) '$init_debug' :-
; nb_setval('$spy_gn', 1),
'$halt'(0) % stop at spy-points if debugging is on.
nb_setval('$debug_run', off),
nb_setval('$debug_jump', off),
'__NB_getval__'('$trace', Trace, fail),
( Trace==on
-> nb_setval('$debug_status', state(creep, 0, stop, on))
; nb_setval('$debug_status', state(zip, 0, stop, off))
). ).
'$erase_sets' :- '$erase_sets' :-
eraseall('$'), eraseall($),
eraseall('$$set'), eraseall('$$set'),
eraseall('$$one'), eraseall('$$one'),
eraseall('$reconsulted'), fail. eraseall('$reconsulted'),
'$erase_sets' :- \+ recorded('$path',_,_), recorda('$path',[],_). fail.
'$erase_sets' :-
\+ recorded('$path', _, _),
recorda('$path', [], _).
'$erase_sets'. '$erase_sets'.
'$start_corouts' :- '$start_corouts' :-
@ -176,7 +185,7 @@ live :-
'$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) ), catch( '$expand_term0'(T,Con,O), _,( '$reenter_debugger'(exit), fail) ),
!. !.
'$expand_term0'(T,consult,O) :- '$expand_term0'(T,consult,O) :-
@ -389,7 +398,7 @@ live :-
'$do_another'(C) :- '$do_another'(C) :-
( C=:= ";" -> ( C=:= ";" ->
skip(user_input,10), % skip(user_input,10),
% '$add_nl_outside_console', % '$add_nl_outside_console',
fail fail
; ;
@ -582,7 +591,7 @@ write_query_answer( Bindings ) :-
'$enable_debugging', '$enable_debugging',
'$call'(G, CP, G0, M), '$call'(G, CP, G0, M),
Port, Port,
'$disable_debugging_on_port'(Port) '$reenter_debugger'(Port)
). ).
@ -591,7 +600,7 @@ write_query_answer( Bindings ) :-
'$enable_debugging', '$enable_debugging',
M:G, M:G,
Port, Port,
'$disable_debugging_on_port'(Port) '$reenter_debugger'(Port)
). ).
'$cut_by'(CP) :- '$$cut_by'(CP). '$cut_by'(CP) :- '$$cut_by'(CP).
@ -696,7 +705,7 @@ write_query_answer( Bindings ) :-
% ( % (
% '$is_metapredicate'(G,CurMod) % '$is_metapredicate'(G,CurMod)
% -> % ->
% '$disable_debugging', % '$reenter_debugger'(exit)',
% ( '$expand_meta_call'(CurMod:G, [], NG) -> true ; true ), % ( '$expand_meta_call'(CurMod:G, [], NG) -> true ; true ),
% '$enable_debugging' % '$enable_debugging'
% ; % ;