View source with raw comments or as raw
   1/*  Part of SWI-Prolog
   2
   3    Author:        Jan Wielemaker
   4    E-mail:        J.Wielemaker@vu.nl
   5    WWW:           http://www.swi-prolog.org
   6    Copyright (c)  2002-2016, University of Amsterdam
   7                              VU University Amsterdam
   8    All rights reserved.
   9
  10    Redistribution and use in source and binary forms, with or without
  11    modification, are permitted provided that the following conditions
  12    are met:
  13
  14    1. Redistributions of source code must retain the above copyright
  15       notice, this list of conditions and the following disclaimer.
  16
  17    2. Redistributions in binary form must reproduce the above copyright
  18       notice, this list of conditions and the following disclaimer in
  19       the documentation and/or other materials provided with the
  20       distribution.
  21
  22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
  25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
  27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
  28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
  32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
  33    POSSIBILITY OF SUCH DAMAGE.
  34*/
  35
  36:- module(prolog_debug,
  37          [ debug/3,                    % +Topic, +Format, :Args
  38            debug/1,                    % +Topic
  39            nodebug/1,                  % +Topic
  40            debugging/1,                % ?Topic
  41            debugging/2,                % ?Topic, ?Bool
  42            list_debug_topics/0,
  43            debug_message_context/1,    % (+|-)What
  44
  45            assertion/1                 % :Goal
  46          ]).
  47:- use_module(library(error)).
  48:- use_module(library(lists)).
  49:- set_prolog_flag(generate_debug_info, false).
  50
  51:- meta_predicate
  52    assertion(0),
  53    debug(+,+,:).
  54
  55:- multifile prolog:assertion_failed/2.
  56:- dynamic   prolog:assertion_failed/2.
  57
  58/*:- use_module(library(prolog_stack)).*/ % We use the autoloader if needed
  59
  60%:- set_prolog_flag(generate_debug_info, false).
  61
  62:- dynamic
  63    debugging/3,                    % Topic, Enabled, To
  64    debug_context/1.
  65
  66debug_context(thread).
  67
  68/** <module> Print debug messages and test assertions
  69
  70This library is a replacement for  format/3 for printing debug messages.
  71Messages are assigned a _topic_. By   dynamically  enabling or disabling
  72topics the user can  select  desired   messages.  Debug  statements  are
  73removed when the code is compiled for optimization.
  74
  75See manual for details. With XPCE, you can use the call below to start a
  76graphical monitoring tool.
  77
  78==
  79?- prolog_ide(debug_monitor).
  80==
  81
  82Using the predicate assertion/1 you  can   make  assumptions  about your
  83program explicit, trapping the debugger if the condition does not hold.
  84
  85@author Jan Wielemaker
  86*/
  87
  88%!  debugging(+Topic) is semidet.
  89%!  debugging(-Topic) is nondet.
  90%!  debugging(?Topic, ?Bool) is nondet.
  91%
  92%   Examine debug topics. The form debugging(+Topic)  may be used to
  93%   perform more complex debugging tasks.   A typical usage skeleton
  94%   is:
  95%
  96%     ==
  97%           (   debugging(mytopic)
  98%           ->  <perform debugging actions>
  99%           ;   true
 100%           ),
 101%           ...
 102%     ==
 103%
 104%   The other two calls are intended to examine existing and enabled
 105%   debugging tokens and are typically not used in user programs.
 106
 107debugging(Topic) :-
 108    debugging(Topic, true, _To).
 109
 110debugging(Topic, Bool) :-
 111    debugging(Topic, Bool, _To).
 112
 113%!  debug(+Topic) is det.
 114%!  nodebug(+Topic) is det.
 115%
 116%   Add/remove a topic from being   printed.  nodebug(_) removes all
 117%   topics. Gives a warning if the topic is not defined unless it is
 118%   used from a directive. The latter allows placing debug topics at
 119%   the start of a (load-)file without warnings.
 120%
 121%   For debug/1, Topic can be  a  term   Topic  >  Out, where Out is
 122%   either a stream or  stream-alias  or   a  filename  (atom). This
 123%   redirects debug information on this topic to the given output.
 124
 125debug(Topic) :-
 126    debug(Topic, true).
 127nodebug(Topic) :-
 128    debug(Topic, false).
 129
 130debug(Spec, Val) :-
 131    debug_target(Spec, Topic, Out),
 132    (   (   retract(debugging(Topic, Enabled0, To0))
 133        *-> update_debug(Enabled0, To0, Val, Out, Enabled, To),
 134            assert(debugging(Topic, Enabled, To)),
 135            fail
 136        ;   (   prolog_load_context(file, _)
 137            ->  true
 138            ;   print_message(warning, debug_no_topic(Topic))
 139            ),
 140            update_debug(false, [], Val, Out, Enabled, To),
 141            assert(debugging(Topic, Enabled, To))
 142        )
 143    ->  true
 144    ;   true
 145    ).
 146
 147debug_target(Spec, Topic, To) :-
 148    nonvar(Spec),
 149    Spec = (Topic > To),
 150    !.
 151debug_target(Topic, Topic, -).
 152
 153update_debug(_, To0, true, -, true, To) :-
 154    !,
 155    ensure_output(To0, To).
 156update_debug(true, To0, true, Out, true, Output) :-
 157    !,
 158    (   memberchk(Out, To0)
 159    ->  Output = To0
 160    ;   append(To0, [Out], Output)
 161    ).
 162update_debug(false, _, true, Out, true, [Out]) :- !.
 163update_debug(_, _, false, -, false, []) :- !.
 164update_debug(true, [Out], false, Out, false, []) :- !.
 165update_debug(true, To0, false, Out, true, Output) :-
 166    !,
 167    delete(To0, Out, Output).
 168
 169ensure_output([], [user_error]) :- !.
 170ensure_output(List, List).
 171
 172%!  debug_topic(+Topic) is det.
 173%
 174%   Declare a topic for debugging.  This can be used to find all
 175%   topics available for debugging.
 176
 177debug_topic(Topic) :-
 178    (   debugging(Registered, _, _),
 179        Registered =@= Topic
 180    ->  true
 181    ;   assert(debugging(Topic, false, []))
 182    ).
 183
 184%!  list_debug_topics is det.
 185%
 186%   List currently known debug topics and their setting.
 187
 188list_debug_topics :-
 189    format(user_error, '~`-t~45|~n', []),
 190    format(user_error, '~w~t ~w~35| ~w~n',
 191           ['Debug Topic', 'Activated', 'To']),
 192    format(user_error, '~`-t~45|~n', []),
 193    (   debugging(Topic, Value, To),
 194        format(user_error, '~w~t ~w~35| ~w~n', [Topic, Value, To]),
 195        fail
 196    ;   true
 197    ).
 198
 199%!  debug_message_context(+What) is det.
 200%
 201%   Specify additional context for debug messages.   What  is one of
 202%   +Context or -Context, and Context is  one of =thread=, =time= or
 203%   time(Format),  where  Format  is    a  format specification  for
 204%   format_time/3 (default is =|%T.%3f|=).  Initially, debug/3 shows
 205%   only thread information.
 206
 207debug_message_context(+Topic) :-
 208    !,
 209    valid_topic(Topic, Del, Add),
 210    retractall(debug_context(Del)),
 211    assert(debug_context(Add)).
 212debug_message_context(-Topic) :-
 213    !,
 214    valid_topic(Topic, Del, _),
 215    retractall(debug_context(Del)).
 216debug_message_context(Term) :-
 217    type_error(debug_message_context, Term).
 218
 219valid_topic(thread, thread, thread) :- !.
 220valid_topic(time, time(_), time('%T.%3f')) :- !.
 221valid_topic(time(Format), time(_), time(Format)) :- !.
 222valid_topic(X, _, _) :-
 223    domain_error(debug_message_context, X).
 224
 225
 226%!  debug(+Topic, +Format, :Args) is det.
 227%
 228%   Format a message if debug topic  is enabled. Similar to format/3
 229%   to =user_error=, but only prints if   Topic is activated through
 230%   debug/1. Args is a  meta-argument  to   deal  with  goal for the
 231%   @-command.   Output   is   first    handed     to    the    hook
 232%   prolog:debug_print_hook/3.  If  this  fails,    Format+Args   is
 233%   translated  to  text   using    the   message-translation   (see
 234%   print_message/2) for the  term  debug(Format,   Args)  and  then
 235%   printed to every matching destination   (controlled  by debug/1)
 236%   using print_message_lines/3.
 237%
 238%   The message is preceded by '% ' and terminated with a newline.
 239%
 240%   @see    format/3.
 241
 242debug(Topic, Format, Args) :-
 243    debugging(Topic, true, To),
 244    !,
 245    print_debug(Topic, To, Format, Args).
 246debug(_, _, _).
 247
 248
 249%!  prolog:debug_print_hook(+Topic, +Format, +Args) is semidet.
 250%
 251%   Hook called by debug/3.  This  hook   is  used  by the graphical
 252%   frontend that can be activated using prolog_ide/1:
 253%
 254%     ==
 255%     ?- prolog_ide(debug_monitor).
 256%     ==
 257
 258:- multifile
 259    prolog:debug_print_hook/3.
 260
 261print_debug(Topic, _To, Format, Args) :-
 262    prolog:debug_print_hook(Topic, Format, Args),
 263    !.
 264print_debug(_, [], _, _) :- !.
 265print_debug(Topic, To, Format, Args) :-
 266    phrase('$messages':translate_message(debug(Format, Args)), Lines),
 267    (   member(T, To),
 268        debug_output(T, Stream),
 269        with_output_to(
 270            Stream,
 271            print_message_lines(current_output, kind(debug(Topic)), Lines)),
 272        fail
 273    ;   true
 274    ).
 275
 276
 277debug_output(user, user_error) :- !.
 278debug_output(Stream, Stream) :-
 279    is_stream(Stream),
 280    !.
 281debug_output(File, Stream) :-
 282    open(File, append, Stream,
 283         [ close_on_abort(false),
 284           alias(File),
 285           buffer(line)
 286         ]).
 287
 288
 289                 /*******************************
 290                 *           ASSERTION          *
 291                 *******************************/
 292
 293%!  assertion(:Goal) is det.
 294%
 295%   Acts similar to C assert()  macro.  It   has  no  effect if Goal
 296%   succeeds. If Goal fails or throws    an exception, the following
 297%   steps are taken:
 298%
 299%     * call prolog:assertion_failed/2.  If prolog:assertion_failed/2
 300%       fails, then:
 301%
 302%       - If this is an interactive toplevel thread, print a
 303%         message, the stack-trace, and finally trap the debugger.
 304%       - Otherwise, throw error(assertion_error(Reason, G),_) where
 305%         Reason is one of =fail= or the exception raised.
 306
 307assertion(G) :-
 308    \+ \+ catch(G,
 309                Error,
 310                assertion_failed(Error, G)),
 311
 312    !.
 313assertion(G) :-
 314    assertion_failed(fail, G),
 315    assertion_failed.               % prevent last call optimization.
 316
 317assertion_failed(Reason, G) :-
 318    prolog:assertion_failed(Reason, G),
 319    !.
 320assertion_failed(Reason, _) :-
 321    assertion_rethrow(Reason),
 322    !,
 323    throw(Reason).
 324assertion_failed(Reason, G) :-
 325    print_message(error, assertion_failed(Reason, G)),
 326    backtrace(10),
 327    (   current_prolog_flag(break_level, _) % interactive thread
 328    ->  trace
 329    ;   throw(error(assertion_error(Reason, G), _))
 330    ).
 331
 332assertion_failed.
 333
 334assertion_rethrow(time_limit_exceeded).
 335assertion_rethrow('$aborted').
 336
 337%!  assume(:Goal) is det.
 338%
 339%   Acts similar to C assert() macro.  It has no effect of Goal
 340%   succeeds.  If Goal fails it prints a message, a stack-trace
 341%   and finally traps the debugger.
 342%
 343%   @deprecated     Use assertion/1 in new code.
 344
 345                 /*******************************
 346                 *           EXPANSION          *
 347                 *******************************/
 348
 349%       The optimise_debug flag  defines whether  Prolog  optimizes
 350%       away assertions and  debug/3 statements.  Values are =true=
 351%       (debug is optimized away),  =false= (debug is retained) and
 352%       =default= (debug optimization is dependent on the optimise
 353%       flag).
 354
 355optimise_debug :-
 356    (   current_prolog_flag(optimise_debug, true)
 357    ->  true
 358    ;   current_prolog_flag(optimise_debug, default),
 359        current_prolog_flag(optimise, true)
 360    ->  true
 361    ).
 362
 363:- multifile
 364    system:goal_expansion/2.
 365
 366system:goal_expansion(debug(Topic,_,_), true) :-
 367    (   optimise_debug
 368    ->  true
 369    ;   debug_topic(Topic),
 370        fail
 371    ).
 372system:goal_expansion(debugging(Topic), fail) :-
 373    (   optimise_debug
 374    ->  true
 375    ;   debug_topic(Topic),
 376        fail
 377    ).
 378system:goal_expansion(assertion(_), true) :-
 379    optimise_debug.
 380system:goal_expansion(assume(_), true) :-
 381    print_message(informational,
 382                  compatibility(renamed(assume/1, assertion/1))),
 383    optimise_debug.
 384
 385
 386                 /*******************************
 387                 *            MESSAGES          *
 388                 *******************************/
 389
 390:- multifile
 391    prolog:message/3.
 392
 393prolog:message(assertion_failed(_, G)) -->
 394    [ 'Assertion failed: ~q'-[G] ].
 395prolog:message(debug(Fmt, Args)) -->
 396    show_thread_context,
 397    show_time_context,
 398    [ Fmt-Args ].
 399prolog:message(debug_no_topic(Topic)) -->
 400    [ '~q: no matching debug topic (yet)'-[Topic] ].
 401
 402show_thread_context -->
 403    { debug_context(thread),
 404      thread_self(Me) ,
 405      Me \== main
 406    },
 407    [ '[Thread ~w] '-[Me] ].
 408show_thread_context -->
 409    [].
 410
 411show_time_context -->
 412    { debug_context(time(Format)),
 413      get_time(Now),
 414      format_time(string(S), Format, Now)
 415    },
 416    [ '[~w] '-[S] ].
 417show_time_context -->
 418    [].
 419
 420                 /*******************************
 421                 *             HOOKS            *
 422                 *******************************/
 423
 424%!  prolog:assertion_failed(+Reason, +Goal) is semidet.
 425%
 426%   This hook is called if the Goal  of assertion/1 fails. Reason is
 427%   unified with either =fail= if Goal simply failed or an exception
 428%   call otherwise. If this hook  fails,   the  default behaviour is
 429%   activated.  If  the  hooks  throws  an   exception  it  will  be
 430%   propagated into the caller of assertion/1.
 431
 432
 433                 /*******************************
 434                 *            SANDBOX           *
 435                 *******************************/
 436
 437:- multifile sandbox:safe_meta/2.
 438
 439sandbox:safe_meta(prolog_debug:assertion(X), [X]).