debugger

2019-05-10 03:05:40 +01:00 · 2019-05-10 03:05:40 +01:00 · 4d395761a4
parent e23055d4f0
commit 4d395761a4
4 changed files with 138 additions and 147 deletions
--- 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.
--- 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',
--- 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)).
+
 /*

@}
--- 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'
 %     ;