event handling

pl/debug.yap

@@ -372,34 +372,43 @@ be lost.
 '$loop_spy'(GoalNumber, G, Module, CalledFromDebugger) :-
 	'$current_choice_point'(CP),
 	'$system_catch'('$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger, CP),
-		    Module, error(Event,Context),
+		    Module, Error,
-		    '$loop_spy_event'(error(Event,Context), GoalNumber, G, Module, CalledFromDebugger)).
+		    '$TraceError'(Error, GoalNumber, G, Module, CalledFromDebugger)).
 
-% handle weird things happening in the debugger.
+/**
-'$loop_spy_event'('$pass'(Event), _, _, _, _) :- !,
+  * @pred '$TraceError'(+Exception, +CurrentGoalId, +CurrentGoal, +Module, +Status)
-	throw(Event).
+  *
-'$loop_spy_event'(error('$retry_spy'(G0),_), GoalNumber, G, Module, CalledFromDebugger) :-
+  * forward exception until leaving the debugger or
-	G0 >= GoalNumber, !,
+  * finding a matching frame:
-	'$loop_spy'(GoalNumber, G, Module, CalledFromDebugger).
+  *
-'$loop_spy_event'(error('$retry_spy'(GoalNumber),_), _, _, _, _) :- !,
+*/
-	throw(error('$retry_spy'(GoalNumber),[])).
+%%% - retry: forward throw while the call is newer than goal
-'$loop_spy_event'(error('$fail_spy'(G0),_), GoalNumber, G, Module, CalledFromDebugger) :-
+'$TraceError'('$forward'('$retry_spy'(G0)), GoalNumber, G, Module, CalledFromDebugger) :-
+	( G0 >= GoalNumber
+  ->
+	'$loop_spy'(GoalNumber, G, Module, CalledFromDebugger)
+;
+	throw('$forward'('$retry_spy'(G0)))
+  ).
+%%% - backtrack long distance
+'$TraceError'('$forward'('$fail_spy'(G0)), GoalNumber, G, Module, CalledFromDebugger) :-
 	G0 >= GoalNumber, !,
 	'$loop_fail'(GoalNumber, G, Module, CalledFromDebugger).
-'$loop_spy_event'(error('$fail_spy'(GoalNumber),_), _, _, _, _) :- !,
+'$TraceError'('$forward'('$fail_spy'(GoalNumber)), _, _, _, _) :- !,
-	throw(error('$fail_spy'(GoalNumber),[])).
+	throw(error('$fail_spy'(GoalNumber))).
-'$loop_spy_event'(error('$done_spy'(G0),_), GoalNumber, _G, _, CalledFromDebugger) :-
+%%%
-	G0 >= GoalNumber, !,
+%%% - forward through the debugger
-	'$continue_debugging'(zip, CalledFromDebugger).
+'$TraceError'('$forward'('$wrapper'(Event)), _, _, _, _) :-
-'$loop_spy_event'(error('$done_spy'(GoalNumber),_), _, _, _, _) :- !,
+	!,
-	throw(error('$done_spy'(GoalNumber),[])).
+	throw(Event).
-'$loop_spy_event'(Event, GoalNumber, G, Module, CalledFromDebugger) :-
+%%% - anything else, leave to the user and restore the catch
+'$TraceError'(Event, GoalNumber, G, Module, CalledFromDebugger) :-
 	'$debug_error'(Event),
 	'$system_catch'(
 		     ('$trace'(exception(Event),G,Module,GoalNumber,_),fail),
 		     Module,
-		     error(NewEvent,NewContext),
+		     Error,
-		     '$loop_spy_event'(error(NewEvent,NewContext), GoalNumber, G, Module, CalledFromDebugger)
+		     '$TraceError'(Error, GoalNumber, G, Module, CalledFromDebugger)
 		    ).
 
 
@@ -553,7 +562,7 @@ be lost.
 
 '$spycall_expanded'(G, M, CalledFromDebugger, InRedo) :-
 	'$undefined'(G, M), !,
-	'$get_undefined_pred'(G, M, Goal, NM), NM \= M,
+	'$get_undefined_pred'(G, M,  Goal, NM), NM \= M,
 	'$spycall'(Goal, NM, CalledFromDebugger, InRedo).
 '$spycall_expanded'(G, M, _CalledFromDebugger, InRedo) :-
 	CP is '$last_choice_pt',
@@ -721,7 +730,6 @@ be lost.
     lists:memberchk( call_tracer, Opts),
             !,			% <'Depth
         	'$skipeol'(0'C),
-        '$start_low_level_trace',
         	'__NB_setval__'('$debug_jump',false).
 '$action'(0'^,_,_,G,_,_) :- !,			% '
 	'$print_deb_sterm'(G),
@@ -736,7 +744,7 @@ be lost.
 	fail.
 '$action'(0'A,_,_,_,_,_) :- !,			% 'b		break
 	'$skipeol'(0'A),
-	'$hacks':'$stack_dump',
+	'$stack_dump',
 	fail.
 '$action'(0'c,_,_,_,_,on) :- !,			% 'c		creep
 	'$skipeol'(0'c),
@@ -746,7 +754,7 @@ be lost.
 	halt.
 '$action'(0'f,_,CallId,_,_,_) :- !,		% 'f		fail
 	'$scan_number'(0'f, CallId, GoalId),    %'f
-	throw(error('$fail_spy'(GoalId),[])).
+	throw('$forward'('$fail_spy'(GoalId))).
 '$action'(0'h,_,_,_,_,_) :- !,			% 'h		help
 	'$action_help',
 	'$skipeol'(104),
@@ -793,10 +801,14 @@ be lost.
 	'__NB_setval__'('$debug_run', -1),
 	'__NB_setval__'('$debug_jump',true),
 	nodebug.
+'$action'(0'r,_,CallId,_,_,_) :- !,		        % 'r		retry
+    '$scan_number'(0'r,CallId,ScanNumber),		% '
+				%	set_prolog_flag(debug, true),
+    throw('$forward'('$retry_spy'(ScanNumber))).
 '$action'(0'r,_,CallId,_,_,_) :- !,		        % 'r		retry
     '$scan_number'(0'r,CallId,ScanNumber),		% '
 %	set_prolog_flag(debug, true),
-	throw(error('$retry_spy'(ScanNumber),[])).
+	throw('$forward'('$wrapper'(ScanNumber))).
 '$action'(0's,P,CallNumber,_,_,on) :- !,		% 's		skip
 	'$skipeol'(0's),				% '
 	(
@@ -827,6 +839,8 @@ be lost.
         '$scan_number'(0'g,-1,HowMany),         % '
         '$show_ancestors'(HowMany),
 	fail.
+'$action'(0'T,exception(G),_,_,_,_) :- !,	% 'T		throw
+	throw( '$forward'('$wrapper'(G))).
 '$action'(C,_,_,_,_,_) :-
 	'$skipeol'(C),
 	'$ilgl'(C),
@@ -920,6 +934,7 @@ be lost.
 	format(user_error,'+        spy this    -       nospy this~n', []),
 	format(user_error,'^        view subg   ^^      view using~n', []),
 	format(user_error,'A        choices     g [N]   ancestors~n', []),
+	format(user_error,'T        throw       ~n', []),
 	format(user_error,'! g execute goal~n', []).
 
 '$ilgl'(C) :-
@@ -1017,7 +1032,7 @@ be lost.
 	'$debugger_skip_loop_spy2'(CPs1,CPs2),
 	'$debugger_skip_spycall'(CPs2,CPs3),
 	'$debugger_skip_loop_spy2'(CPs3,[Catch|_]),
-	yap_hacks:choicepoint(Catch,_,prolog,'$catch',3,'$catch'(_,'$loop_spy_event'(_,_,G,_,_),_),_).
+	yap_hacks:choicepoint(Catch,_,prolog,'$catch',3,'$catch'(_,'$TraceError'(_,_,G,_,_),_),_).
 
 
 '$cps'([CP|CPs]) :-