new from SWI
This commit is contained in:
Vitor Santos Costa
parent
85acf5c4ea
commit
4f5a3469d6
296
LGPL/debug.pl
296
LGPL/debug.pl
@ -1,11 +1,10 @@
|
||||
/* $Id: debug.pl,v 1.1 2008-02-12 17:03:53 vsc Exp $
|
||||
|
||||
Part of SWI-Prolog
|
||||
/* Part of SWI-Prolog
|
||||
|
||||
Author: Jan Wielemaker
|
||||
E-mail: jan@swi.psy.uva.nl
|
||||
E-mail: J.Wielemaker@vu.nl
|
||||
WWW: http://www.swi-prolog.org
|
||||
Copyright (C): 1985-2002, University of Amsterdam
|
||||
Copyright (C): 1985-2012, University of Amsterdam
|
||||
VU University Amsterdam
|
||||
|
||||
This program is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU General Public License
|
||||
@ -19,7 +18,7 @@
|
||||
|
||||
You should have received a copy of the GNU Lesser General Public
|
||||
License along with this library; if not, write to the Free Software
|
||||
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
|
||||
As a special exception, if you link this library with other files,
|
||||
compiled with a Free Software compiler, to produce an executable, this
|
||||
@ -30,19 +29,29 @@
|
||||
*/
|
||||
|
||||
:- module(prolog_debug,
|
||||
[ debug/3, % +Topic, +Format, +Args
|
||||
[ debug/3, % +Topic, +Format, :Args
|
||||
debug/1, % +Topic
|
||||
nodebug/1, % +Topic
|
||||
debugging/1, % ?Topic
|
||||
debugging/2, % ?Topic, ?Bool
|
||||
list_debug_topics/0,
|
||||
debug_message_context/1, % (+|-)What
|
||||
|
||||
assertion/1 % :Goal
|
||||
]).
|
||||
|
||||
:- meta_predicate(assertion(:)).
|
||||
:- use_module(library(error)).
|
||||
:- use_module(library(lists)).
|
||||
:- set_prolog_flag(generate_debug_info, false).
|
||||
|
||||
:- meta_predicate
|
||||
assertion(0),
|
||||
debug(+,+,:).
|
||||
|
||||
:- multifile prolog:assertion_failed/2.
|
||||
:- dynamic prolog:assertion_failed/2.
|
||||
|
||||
/*:- use_module(library(prolog_stack)).*/ % We use the autoloader if needed
|
||||
|
||||
:- if(current_prolog_flag(dialect, yap)).
|
||||
|
||||
:- use_module(library(hacks), [stack_dump/1]).
|
||||
@ -53,10 +62,15 @@ backtrace(N) :-
|
||||
|
||||
:- endif.
|
||||
|
||||
:- dynamic
|
||||
debugging/2.
|
||||
%:- set_prolog_flag(generate_debug_info, false).
|
||||
|
||||
/** <module> Print debug messages
|
||||
:- dynamic
|
||||
debugging/3, % Topic, Enabled, To
|
||||
debug_context/1.
|
||||
|
||||
debug_context(thread).
|
||||
|
||||
/** <module> Print debug messages and test assertions
|
||||
|
||||
This library is a replacement for format/3 for printing debug messages.
|
||||
Messages are assigned a _topic_. By dynamically enabling or disabling
|
||||
@ -64,7 +78,7 @@ topics the user can select desired messages. Debug statements are
|
||||
removed when the code is compiled for optimization.
|
||||
|
||||
See manual for details. With XPCE, you can use the call below to start a
|
||||
graphical monitorring tool.
|
||||
graphical monitoring tool.
|
||||
|
||||
==
|
||||
?- prolog_ide(debug_monitor).
|
||||
@ -80,11 +94,26 @@ program explicit, trapping the debugger if the condition does not hold.
|
||||
%% debugging(-Topic) is nondet.
|
||||
%% debugging(?Topic, ?Bool) is nondet.
|
||||
%
|
||||
% Check whether we are debugging Topic or enumerate the topics we
|
||||
% are debugging.
|
||||
% Examine debug topics. The form debugging(+Topic) may be used to
|
||||
% perform more complex debugging tasks. A typical usage skeleton
|
||||
% is:
|
||||
%
|
||||
% ==
|
||||
% ( debugging(mytopic)
|
||||
% -> <perform debugging actions>
|
||||
% ; true
|
||||
% ),
|
||||
% ...
|
||||
% ==
|
||||
%
|
||||
% The other two calls are intended to examine existing and enabled
|
||||
% debugging tokens and are typically not used in user programs.
|
||||
|
||||
debugging(Topic) :-
|
||||
debugging(Topic, true).
|
||||
debugging(Topic, true, _To).
|
||||
|
||||
debugging(Topic, Bool) :-
|
||||
debugging(Topic, Bool, _To).
|
||||
|
||||
%% debug(+Topic) is det.
|
||||
%% nodebug(+Topic) is det.
|
||||
@ -92,27 +121,51 @@ debugging(Topic) :-
|
||||
% Add/remove a topic from being printed. nodebug(_) removes all
|
||||
% topics. Gives a warning if the topic is not defined unless it is
|
||||
% used from a directive. The latter allows placing debug topics at
|
||||
% the start a a (load-)file without warnings.
|
||||
% the start of a (load-)file without warnings.
|
||||
%
|
||||
% For debug/1, Topic can be a term Topic > Out, where Out is
|
||||
% either a stream or stream-alias or a filename (atom). This
|
||||
% redirects debug information on this topic to the given output.
|
||||
|
||||
debug(Topic) :-
|
||||
debug(Topic, true).
|
||||
nodebug(Topic) :-
|
||||
debug(Topic, false).
|
||||
|
||||
debug(Topic, Val) :-
|
||||
( ( retract(debugging(Topic, _))
|
||||
*-> assert(debugging(Topic, Val)),
|
||||
debug(Spec, Val) :-
|
||||
debug_target(Spec, Topic, Out),
|
||||
( ( retract(debugging(Topic, Enabled0, To0))
|
||||
*-> update_debug(Enabled0, To0, Val, Out, Enabled, To),
|
||||
assert(debugging(Topic, Enabled, To)),
|
||||
fail
|
||||
; ( prolog_load_context(file, _)
|
||||
-> true
|
||||
; print_message(warning, debug_no_topic(Topic))
|
||||
),
|
||||
assert(debugging(Topic, Val))
|
||||
update_debug(false, [], Val, Out, Enabled, To),
|
||||
assert(debugging(Topic, Enabled, To))
|
||||
)
|
||||
-> true
|
||||
; true
|
||||
).
|
||||
|
||||
debug_target(Spec, Topic, To) :-
|
||||
nonvar(Spec),
|
||||
Spec = (Topic > To), !.
|
||||
debug_target(Topic, Topic, -).
|
||||
|
||||
update_debug(_, To0, true, -, true, To) :- !,
|
||||
ensure_output(To0, To).
|
||||
update_debug(true, To0, true, Out, true, Output) :- !,
|
||||
append(To0, [Out], Output).
|
||||
update_debug(false, _, true, Out, true, [Out]) :- !.
|
||||
update_debug(_, _, false, -, false, []) :- !.
|
||||
update_debug(true, [Out], false, Out, false, []) :- !.
|
||||
update_debug(true, To0, false, Out, true, Output) :- !,
|
||||
delete(To0, Out, Output).
|
||||
|
||||
ensure_output([], [user_error]) :- !.
|
||||
ensure_output(List, List).
|
||||
|
||||
%% debug_topic(+Topic) is det.
|
||||
%
|
||||
@ -120,44 +173,108 @@ debug(Topic, Val) :-
|
||||
% topics available for debugging.
|
||||
|
||||
debug_topic(Topic) :-
|
||||
( debugging(Registered, _),
|
||||
( debugging(Registered, _, _),
|
||||
Registered =@= Topic
|
||||
-> true
|
||||
; assert(debugging(Topic, false))
|
||||
; assert(debugging(Topic, false, []))
|
||||
).
|
||||
|
||||
%% list_debug_topics is det.
|
||||
%
|
||||
%
|
||||
% List currently known debug topics and their setting.
|
||||
|
||||
list_debug_topics :-
|
||||
format(user_error, '~*t~40|~n', "-"),
|
||||
format(user_error, '~w~t~30| ~w~n', ['Debug Topic', 'Activated']),
|
||||
format(user_error, '~*t~40|~n', "-"),
|
||||
( debugging(Topic, Value),
|
||||
format(user_error, '~w~t~30| ~w~n', [Topic, Value]),
|
||||
format(user_error, '~*t~45|~n', "-"),
|
||||
format(user_error, '~w~t ~w~35| ~w~n',
|
||||
['Debug Topic', 'Activated', 'To']),
|
||||
format(user_error, '~*t~45|~n', "-"),
|
||||
( debugging(Topic, Value, To),
|
||||
format(user_error, '~w~t ~w~35| ~w~n', [Topic, Value, To]),
|
||||
fail
|
||||
; true
|
||||
).
|
||||
|
||||
%% debug(+Topic, +Format, +Args) is det.
|
||||
%% debug_message_context(+What) is det.
|
||||
%
|
||||
% As format/3 to user_error, but only does something if Topic
|
||||
% is activated through debug/1.
|
||||
% Specify additional context for debug messages. What is one of
|
||||
% +Context or -Context, and Context is one of =thread=, =time= or
|
||||
% time(Format), where Format is a format specification for
|
||||
% format_time/3 (default is =|%T.%3f|=). Initially, debug/3 shows
|
||||
% only thread information.
|
||||
|
||||
debug_message_context(+Topic) :- !,
|
||||
valid_topic(Topic, Del, Add),
|
||||
retractall(debug_context(Del)),
|
||||
assert(debug_context(Add)).
|
||||
debug_message_context(-Topic) :- !,
|
||||
valid_topic(Topic, Del, _),
|
||||
retractall(debug_context(Del)).
|
||||
debug_message_context(Term) :-
|
||||
type_error(debug_message_context, Term).
|
||||
|
||||
valid_topic(thread, thread, thread) :- !.
|
||||
valid_topic(time, time(_), time('%T.%3f')) :- !.
|
||||
valid_topic(time(Format), time(_), time(Format)) :- !.
|
||||
valid_topic(X, _, _) :-
|
||||
domain_error(debug_message_context, X).
|
||||
|
||||
|
||||
%% debug(+Topic, +Format, :Args) is det.
|
||||
%
|
||||
% Format a message if debug topic is enabled. Similar to format/3
|
||||
% to =user_error=, but only prints if Topic is activated through
|
||||
% debug/1. Args is a meta-argument to deal with goal for the
|
||||
% @-command. Output is first handed to the hook
|
||||
% prolog:debug_print_hook/3. If this fails, Format+Args is
|
||||
% translated to text using the message-translation (see
|
||||
% print_message/2) for the term debug(Format, Args) and then
|
||||
% printed to every matching destination (controlled by debug/1)
|
||||
% using print_message_lines/3.
|
||||
%
|
||||
% The message is preceded by '% ' and terminated with a newline.
|
||||
%
|
||||
% @see format/3.
|
||||
|
||||
debug(Topic, Format, Args) :-
|
||||
debugging(Topic, true), !,
|
||||
print_debug(Topic, Format, Args).
|
||||
debugging(Topic, true, To), !,
|
||||
print_debug(Topic, To, Format, Args).
|
||||
debug(_, _, _).
|
||||
|
||||
|
||||
%% prolog:debug_print_hook(+Topic, +Format, +Args) is semidet.
|
||||
%
|
||||
% Hook called by debug/3. This hook is used by the graphical
|
||||
% frontend that can be activated using prolog_ide/1:
|
||||
%
|
||||
% ==
|
||||
% ?- prolog_ide(debug_monitor).
|
||||
% ==
|
||||
|
||||
:- multifile
|
||||
prolog:debug_print_hook/3.
|
||||
|
||||
print_debug(Topic, Format, Args) :-
|
||||
print_debug(Topic, _To, Format, Args) :-
|
||||
prolog:debug_print_hook(Topic, Format, Args), !.
|
||||
print_debug(_, Format, Args) :-
|
||||
print_message(informational, debug(Format, Args)).
|
||||
print_debug(_, [], _, _) :- !.
|
||||
print_debug(Topic, To, Format, Args) :-
|
||||
phrase('$messages':translate_message(debug(Format, Args)), Lines),
|
||||
( member(T, To),
|
||||
debug_output(T, Stream),
|
||||
print_message_lines(Stream, kind(debug(Topic)), Lines),
|
||||
fail
|
||||
; true
|
||||
).
|
||||
|
||||
|
||||
debug_output(user, user_error) :- !.
|
||||
debug_output(Stream, Stream) :-
|
||||
is_stream(Stream), !.
|
||||
debug_output(File, Stream) :-
|
||||
open(File, append, Stream,
|
||||
[ close_on_abort(false),
|
||||
alias(File),
|
||||
buffer(line)
|
||||
]).
|
||||
|
||||
|
||||
/*******************************
|
||||
@ -165,27 +282,46 @@ print_debug(_, Format, Args) :-
|
||||
*******************************/
|
||||
|
||||
%% assertion(:Goal) is det.
|
||||
%
|
||||
% Acts similar to C assert() macro. It has no effect of Goal
|
||||
% succeeds. If Goal fails it prints a message, a stack-trace
|
||||
% and finally traps the debugger.
|
||||
%
|
||||
% Acts similar to C assert() macro. It has no effect if Goal
|
||||
% succeeds. If Goal fails or throws an exception, the following
|
||||
% steps are taken:
|
||||
%
|
||||
% * call prolog:assertion_failed/2. If prolog:assertion_failed/2
|
||||
% fails, then:
|
||||
%
|
||||
% - If this is an interactive toplevel thread, print a
|
||||
% message, the stack-trace, and finally trap the debugger.
|
||||
% - Otherwise, throw error(assertion_error(Reason, G),_) where
|
||||
% Reason is one of =fail= or the exception raised.
|
||||
|
||||
assertion(G) :-
|
||||
\+ \+ G, !. % avoid binding variables
|
||||
\+ \+ catch(G,
|
||||
Error,
|
||||
assertion_failed(Error, G)),
|
||||
!.
|
||||
assertion(G) :-
|
||||
print_message(error, assumption_failed(G)),
|
||||
assertion_failed(fail, G),
|
||||
assertion_failed. % prevent last call optimization.
|
||||
|
||||
assertion_failed(Reason, G) :-
|
||||
prolog:assertion_failed(Reason, G), !.
|
||||
assertion_failed(Reason, G) :-
|
||||
print_message(error, assertion_failed(Reason, G)),
|
||||
backtrace(10),
|
||||
trace,
|
||||
assertion_failed.
|
||||
( current_prolog_flag(break_level, _) % interactive thread
|
||||
-> trace
|
||||
; throw(error(assertion_error(Reason, G), _))
|
||||
).
|
||||
|
||||
assertion_failed.
|
||||
|
||||
%% assume(:Goal) is det.
|
||||
%
|
||||
%
|
||||
% Acts similar to C assert() macro. It has no effect of Goal
|
||||
% succeeds. If Goal fails it prints a message, a stack-trace
|
||||
% and finally traps the debugger.
|
||||
%
|
||||
%
|
||||
% @deprecated Use assertion/1 in new code.
|
||||
|
||||
/*******************************
|
||||
@ -193,34 +329,28 @@ assertion_failed.
|
||||
*******************************/
|
||||
|
||||
:- multifile
|
||||
user:goal_expansion/2.
|
||||
system:goal_expansion/2.
|
||||
|
||||
user:goal_expansion(debug(Topic,_,_), true) :-
|
||||
system:goal_expansion(debug(Topic,_,_), true) :-
|
||||
( current_prolog_flag(optimise, true)
|
||||
-> true
|
||||
; debug_topic(Topic),
|
||||
fail
|
||||
).
|
||||
user:goal_expansion(debugging(Topic), fail) :-
|
||||
system:goal_expansion(debugging(Topic), fail) :-
|
||||
( current_prolog_flag(optimise, true)
|
||||
-> true
|
||||
; debug_topic(Topic),
|
||||
fail
|
||||
).
|
||||
user:goal_expansion(assertion(G), Goal) :-
|
||||
( current_prolog_flag(optimise, true)
|
||||
-> Goal = true
|
||||
; expand_goal(G, G2),
|
||||
Goal = assertion(G2)
|
||||
).
|
||||
user:goal_expansion(assume(G), Goal) :-
|
||||
system:goal_expansion(assertion(_), Goal) :-
|
||||
current_prolog_flag(optimise, true),
|
||||
Goal = true.
|
||||
system:goal_expansion(assume(_), Goal) :-
|
||||
print_message(informational,
|
||||
compatibility(renamed(assume/1, assertion/1))),
|
||||
( current_prolog_flag(optimise, true)
|
||||
-> Goal = true
|
||||
; expand_goal(G, G2),
|
||||
Goal = assertion(G2)
|
||||
).
|
||||
current_prolog_flag(optimise, true),
|
||||
Goal = true.
|
||||
|
||||
|
||||
/*******************************
|
||||
@ -230,13 +360,41 @@ user:goal_expansion(assume(G), Goal) :-
|
||||
:- multifile
|
||||
prolog:message/3.
|
||||
|
||||
prolog:message(assumption_failed(G)) -->
|
||||
[ 'Assertion failed: ~p'-[G] ].
|
||||
prolog:message(assertion_failed(_, G)) -->
|
||||
[ 'Assertion failed: ~q'-[G] ].
|
||||
prolog:message(debug(Fmt, Args)) -->
|
||||
{ thread_self(Me) },
|
||||
( { Me == main }
|
||||
-> [ Fmt-Args ]
|
||||
; [ '[Thread ~w] '-[Me], Fmt-Args ]
|
||||
).
|
||||
show_thread_context,
|
||||
show_time_context,
|
||||
[ Fmt-Args ].
|
||||
prolog:message(debug_no_topic(Topic)) -->
|
||||
[ '~q: no matching debug topic (yet)'-[Topic] ].
|
||||
|
||||
show_thread_context -->
|
||||
{ debug_context(thread),
|
||||
thread_self(Me) ,
|
||||
Me \== main
|
||||
},
|
||||
[ '[Thread ~w] '-[Me] ].
|
||||
show_thread_context -->
|
||||
[].
|
||||
|
||||
show_time_context -->
|
||||
{ debug_context(time(Format)),
|
||||
get_time(Now),
|
||||
format_time(string(S), Format, Now)
|
||||
},
|
||||
[ '[~w] '-[S] ].
|
||||
show_time_context -->
|
||||
[].
|
||||
|
||||
/*******************************
|
||||
* HOOKS *
|
||||
*******************************/
|
||||
|
||||
%% prolog:assertion_failed(+Reason, +Goal) is semidet.
|
||||
%
|
||||
% This hook is called if the Goal of assertion/1 fails. Reason is
|
||||
% unified with either =fail= if Goal simply failed or an exception
|
||||
% call otherwise. If this hook fails, the default behaviour is
|
||||
% activated. If the hooks throws an exception it will be
|
||||
% propagated into the caller of assertion/1.
|
||||
|
||||
Reference in New Issue
Block a user