From 4d395761a443303602213793e064b23c8ba0cdec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Fri, 10 May 2019 03:05:40 +0100 Subject: [PATCH] debugger --- library/rbtrees.yap | 4 +- pl/debug.yap | 40 ++++--------- pl/spy.yap | 106 +++++++++++++++++----------------- pl/top.yap | 135 +++++++++++++++++++++++--------------------- 4 files changed, 138 insertions(+), 147 deletions(-) diff --git a/library/rbtrees.yap b/library/rbtrees.yap index 8b52743b4..d78dace0c 100644 --- a/library/rbtrees.yap +++ b/library/rbtrees.yap @@ -76,7 +76,7 @@ form colour(Left, Key, Value, Right), where _colour_ is one of =red= or rb_partial_map(+,+,2,-), rb_apply(+,+,2,-). -/* + :- use_module(library(type_check)). :- 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 rb_next(rbtree(K,V),K,pair(K,V),V). :- pred next(tree(K,V),K,pair(K,V),V,tree(K,V)). -*/ + %% @pred rb_new(-T) is det. % create an empty tree. diff --git a/pl/debug.yap b/pl/debug.yap index f8a0097a2..be708e3a6 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -14,11 +14,9 @@ * comments: YAP debugger * * * *************************************************************************/ - - -:- system_module( '$_debug', [], ['$trace_query'/4, - '$init_debugger'/0, - '$skipeol'/1]). +:- system_module('$_debug', + [], + ['$trace_query'/4, '$init_debugger'/0, '$skipeol'/1]). @@ -489,15 +487,10 @@ be lost. ). % system_ '$trace_goal__'(G,M, GoalNumber, H) :- - !, + '$enter_trace'(GoalNumber, G, M, H), gated_call( - '$enter_trace'(GoalNumber, G, M, H), - ( '$creep_is_on_at_entry'(G,M) - -> - '$execute_nonstop'(('$creep',G),M) - ; - '$execute_nonstop'(G,M) - ), + true, + '$execute_nonstop'(G,M), Port, '$trace_port'(Port, GoalNumber, G, M, true, H) ). @@ -580,17 +573,12 @@ be lost. '$trace_port_'(redo, GoalNumber, G, Module, Info). '$trace_port'(Port, GoalNumber, G, Module, _CalledFromDebugger, Info) :- - '$stop_creeping'(_) , - current_prolog_flag(debug, true), - '__NB_getval__'('$debug_status',state(Skip,Border,_,Trace), fail), - ( Skip == creep -> true; - '$stop_creeping'(_) , - '$id_goal'(GoalNumber), - GoalNumber =< Border), + '$trace_off', !, - '__NB_setval__'('$debug_status', state(creep, 0, stop,Trace)), - '$trace_port_'(Port, GoalNumber, G, Module, Info). -'$trace_port'(_Port, _GoalNumber, _G, _Module, _CalledFromDebugger, _Info). + '$trace_port_'(Port, GoalNumber, G, Module, Info), + '$continue_debugging'(Port). +'$trace_port'(Port, _GoalNumber, _G, _Module, _CalledFromDebugger, _Info) :- + '$continue_debugging'(Port). '$trace_port_'(call, GoalNumber, G, Module, Info) :- '$port'(call,G,Module,GoalNumber,deterministic, Info). @@ -737,12 +725,8 @@ be lost. '$action'(!,_,_,_,_,_) :- !, % ! 'g execute read(debugger_input, G), % don't allow yourself to be caught by creep. - current_prolog_flag(debug, OldDeb), - set_prolog_flag(debug, false), ignore( G ), - % at this point we are done with leap or skip - set_prolog_flag(debug, OldDeb), -% skip( debugger_input, 10), % ' + skip( debugger_input, 10), % ' fail. '$action'(<,_,_,_,_,_) :- !, % <'Depth '$new_deb_depth', diff --git a/pl/spy.yap b/pl/spy.yap index 425dc0f51..b86dcac5b 100644 --- a/pl/spy.yap +++ b/pl/spy.yap @@ -60,18 +60,7 @@ mode and the existing spy-points, when the debugger is on. :- op(900,fx,[spy,nospy]). -'$init_debugger' :- - '__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 +% First part : setting and reseting spy points % $suspy does most of the work '$suspy'(V,S,M) :- var(V) , !, @@ -214,19 +203,15 @@ debug :- '$start_debugging'(on), print_message(informational,debug(debug)). -'$start_debugging'(Mode) :- - (Mode == on -> - set_prolog_flag(debug, true) - ; - set_prolog_flag(debug, false) - ), - '__NB_getval__'('$trace',Trace, fail), - ( Trace == on -> Creep = crep; Creep = zip ), - '__NB_setval__'('$debug_state',state(Creep,0,stop,Trace) ). +'$start_debugging'(_Mode) :- + '__NB_setval__'(debug, false), + '__NB_getval__'('$trace',Trace, fail), + ( Trace == on -> Creep = crep; Creep = zip ), + '__NB_setval__'('$debug_state',state(Creep,0,stop,Trace) ). nodebug :- - '$init_debugger', set_prolog_flag(debug, false), + '$init_debugger', '__NB_setval__'('$trace',off), print_message(informational,debug(off)). @@ -394,21 +379,30 @@ notrace(G) :- ). '$creep_at_port'(retry) :- - current_prolog_flag(debug, true), - '__NB_getval__'('$trace',Trace,fail), + '__NB_getval__'(debug, true, fail), + '__NB_getval__'('$trace',Trace,fail), Trace = on, !, '$enable_debugging'. '$creep_at_port'(fail) :- - current_prolog_flag(debug, true), + '__NB_getval__'(debug, true, fail), '__NB_getval__'('$trace',Trace,fail), Trace = on, !, '$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) %% @@ -416,7 +410,7 @@ notrace(G) :- %% enable creeping on a goal by just switching execution to debugger. %% '$enter_debugging'(G,Mod,CP,G0,NG) :- - '$creep_is_on_at_entry'(G,Mod), + '$creepcalls'(G,Mod), !, '$trace_query'(G,Mod,CP,G0,NG). '$enter_debugging'(G,_Mod,_CP,_G0,G). @@ -426,19 +420,9 @@ notrace(G) :- '$reenter_debugger'(retry) :- '$re_enter_creep_mode'. '$reenter_debugger'(_) :- - set_current_flag(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'. + '__NB_setval__'(debug, false). +% what to do when you exit the debugger. '$continue_debugging'(exit) :- !, '$re_enter_creep_mode'. @@ -452,19 +436,21 @@ notrace(G) :- '$enable_debugging' :- '$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' :- - '__NB_getval__'('$debug_status', state(_Creep, GN, Spy), fail), - '__NB_setval__'('$trace',off), - nb_setval('$debug_status', state(zip, GN, Spy,off)). + + +%% @pred $re_enter_creep_mode1 +%% +%% Internal predicate called when exiting through a port; +%% enable creeping on the next goal. +%% +'$re_enter_creep_mode' :- + '__NB_getval__'(debug, true, fail), + !, + '$creep'. +'$re_enter_creep_mode'. '$creep_is_off'(_,_) :- - current_prolog_flag(debug, false), !. + '__NB_getval__'(debug, false, fail), !. '$creep_is_off'(Module:G, GN0) :- '__NB_getval__'('$debug_status',state(zip, GN, Spy,_), fail), ( @@ -483,12 +469,13 @@ notrace(G) :- %% % '$creep_is_on' :- - current_prolog_flag(debug, true), + '__NB_getval__'(debug, true, fail), '__NB_getval__'('$debug_status',state(Step, _GN, _Spy,_), fail), Step \= zip. '$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), ( Step \= zip @@ -497,6 +484,17 @@ notrace(G) :- '$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)). + /* @} diff --git a/pl/top.yap b/pl/top.yap index 8abf13d29..9a3db0b30 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -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 % % start a Prolog engine. live :- repeat, - yap_flag(verbose,normal), - current_source_module(Module,Module), - ( Module==user -> - true % '$compile_mode'(_,0) - ; - format(user_error,'[~w]~n', [Module]) + yap_flag(verbose, normal), + current_source_module(Module, Module), + ( Module==user + -> true % '$compile_mode'(_,0) + ; 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 @@ -46,64 +44,75 @@ live :- /* main execution loop */ '$read_toplevel'(Goal, Bindings, Pos) :- - '$prompt', - catch(read_term(user_input, - Goal, - [variable_names(Bindings), syntax_errors(dec10), term_position(Pos)]), - E, '$handle_toplevel_error'( E) ). + '$prompt', + catch(read_term(user_input, + Goal, + + [ 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'(syntax_error(_)) :- + !, + fail. +'$handle_toplevel_error'(error(io_error(read, user_input), _)) :- + !. '$handle_toplevel_error'(_, E) :- - throw(E). + throw(E). % reset alarms when entering top-level. '$enter_top_level' :- - '$alarm'(0, 0, _, _), - fail. + '$alarm'(0, 0, _, _), + fail. '$enter_top_level' :- - '$clean_up_dead_clauses', - fail. + '$clean_up_dead_clauses', + fail. '$enter_top_level' :- - get_value('$top_level_goal',GA), GA \= [], !, - set_value('$top_level_goal',[]), - '$run_atom_goal'(GA), - fail. + get_value('$top_level_goal', GA), + GA\=[], + !, + set_value('$top_level_goal', []), + '$run_atom_goal'(GA), + fail. '$enter_top_level' :- flush_output, - '$run_toplevel_hooks', - prompt1(' ?- '), - '$read_toplevel'(Command,Varnames,Pos), - nb_setval('$spy_gn',1), - % stop at spy-points if debugging is on. - 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), - ( - BreakLevel \= 0 - -> - true - ; - '$pred_exists'(halt(_), user) - -> - halt(0) - ; - '$halt'(0) - ). + '$run_toplevel_hooks', + prompt1(' ?- '), + '$read_toplevel'(Command, Varnames, Pos), + '$init_debugger', + '$command'(Command, Varnames, Pos, top), + current_prolog_flag(break_level, BreakLevel), + ( BreakLevel\=0 + -> true + ; '$pred_exists'(halt(_), user) + -> halt(0) + ; '$halt'(0) + ). + +'$init_debug' :- + nb_setval('$spy_gn', 1), + % 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' :- - eraseall('$'), - eraseall('$$set'), - eraseall('$$one'), - eraseall('$reconsulted'), fail. -'$erase_sets' :- \+ recorded('$path',_,_), recorda('$path',[],_). + eraseall($), + eraseall('$$set'), + eraseall('$$one'), + eraseall('$reconsulted'), + fail. +'$erase_sets' :- + \+ recorded('$path', _, _), + recorda('$path', [], _). '$erase_sets'. '$start_corouts' :- @@ -176,7 +185,7 @@ live :- '$expand_term'(T,top,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) :- @@ -389,7 +398,7 @@ live :- '$do_another'(C) :- ( C=:= ";" -> - skip(user_input,10), % + skip(user_input,10), % '$add_nl_outside_console', fail ; @@ -582,7 +591,7 @@ write_query_answer( Bindings ) :- '$enable_debugging', '$call'(G, CP, G0, M), Port, - '$disable_debugging_on_port'(Port) + '$reenter_debugger'(Port) ). @@ -591,7 +600,7 @@ write_query_answer( Bindings ) :- '$enable_debugging', M:G, Port, - '$disable_debugging_on_port'(Port) + '$reenter_debugger'(Port) ). '$cut_by'(CP) :- '$$cut_by'(CP). @@ -696,7 +705,7 @@ write_query_answer( Bindings ) :- % ( % '$is_metapredicate'(G,CurMod) % -> -% '$disable_debugging', +% '$reenter_debugger'(exit)', % ( '$expand_meta_call'(CurMod:G, [], NG) -> true ; true ), % '$enable_debugging' % ;