1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        jan@swi-prolog.org
    5    WWW:           https://www.swi-prolog.org
    6    Copyright (c)  2021-2025, SWI-Prolog Solutions b.v.
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(prolog_debug_tools,
   36          [ (spy)/1,                % :Spec (some users tend to define these as
   37            (nospy)/1,              % :Spec  an operator)
   38            nospyall/0,
   39            debugging/0,
   40            trap/1,                 % +Exception
   41            notrap/1                % +Exception
   42          ]).   43:- use_module(library(broadcast), [broadcast/1]).   44:- autoload(library(edinburgh), [debug/0]).   45:- autoload(library(gensym), [gensym/2]).   46
   47:- multifile
   48    trap_alias/2.   49
   50:- set_prolog_flag(generate_debug_info, false).   51
   52/** <module> User level debugging tools
   53
   54This  library  provides  tools   to    control   the  Prolog  debuggers.
   55Traditionally this code was  built-in.  Because   these  tools  are only
   56required in (interactive) debugging sessions they   have been moved into
   57the library.
   58*/
   59
   60%!  prolog:debug_control_hook(+Action)
   61%
   62%   Allow user-hooks in the Prolog debugger interaction.  See the calls
   63%   below for the provided hooks.  We use a single predicate with action
   64%   argument to avoid an uncontrolled poliferation of hooks.
   65
   66:- multifile
   67    prolog:debug_control_hook/1.    % +Action
   68
   69:- meta_predicate
   70    spy(:),
   71    nospy(:).   72
   73%!  spy(:Spec) is det.
   74%!  nospy(:Spec) is det.
   75%!  nospyall is det.
   76%
   77%   Set/clear spy-points. A successfully  set   or  cleared spy-point is
   78%   reported using print_message/2, level `informational`,   with one of
   79%   the following terms, where Spec is of the form M:Head.
   80%
   81%       - spy(Spec)
   82%       - nospy(Spec)
   83%
   84%   @see    spy/1 and nospy/1 call the hook prolog:debug_control_hook/1
   85%           to allow for alternative specifications of the thing to
   86%           debug.
   87
   88spy(Spec) :-
   89    '$notrace'(spy_(Spec)).
   90
   91spy_(_:X) :-
   92    var(X),
   93    throw(error(instantiation_error, _)).
   94spy_(_:[]) :- !.
   95spy_(M:[H|T]) :-
   96    !,
   97    spy(M:H),
   98    spy(M:T).
   99spy_(Spec) :-
  100    prolog:debug_control_hook(spy(Spec)),
  101    !.
  102spy_(Spec) :-
  103    '$find_predicate'(Spec, Preds),
  104    '$member'(PI, Preds),
  105        pi_to_head(PI, Head),
  106        '$define_predicate'(Head),
  107        '$spy'(Head),
  108    fail.
  109spy_(_).
  110
  111nospy(Spec) :-
  112    '$notrace'(nospy_(Spec)).
  113
  114nospy_(_:X) :-
  115    var(X),
  116    throw(error(instantiation_error, _)).
  117nospy_(_:[]) :- !.
  118nospy_(M:[H|T]) :-
  119    !,
  120    nospy(M:H),
  121    nospy(M:T).
  122nospy_(Spec) :-
  123    prolog:debug_control_hook(nospy(Spec)),
  124    !.
  125nospy_(Spec) :-
  126    '$find_predicate'(Spec, Preds),
  127    '$member'(PI, Preds),
  128         pi_to_head(PI, Head),
  129        '$nospy'(Head),
  130    fail.
  131nospy_(_).
  132
  133nospyall :-
  134    '$notrace'(nospyall_).
  135
  136nospyall_ :-
  137    prolog:debug_control_hook(nospyall),
  138    fail.
  139nospyall_ :-
  140    spy_point(Head),
  141        '$nospy'(Head),
  142    fail.
  143nospyall_.
  144
  145pi_to_head(M:PI, M:Head) :-
  146    !,
  147    pi_to_head(PI, Head).
  148pi_to_head(Name/Arity, Head) :-
  149    functor(Head, Name, Arity).
  150
  151%!  debugging is det.
  152%
  153%   Report current status of the debugger.
  154
  155:- '$hide'(debugging/0).  156debugging :-
  157    current_prolog_flag(debug, DebugMode),
  158    '$notrace'(debugging_(DebugMode)).
  159
  160debugging_(DebugMode) :-
  161    prolog:debug_control_hook(debugging(DebugMode)),
  162    !.
  163debugging_(DebugMode) :-
  164    print_message(informational, debugging(DebugMode)),
  165    (   DebugMode == true
  166    ->  findall(H, spy_point(H), SpyPoints),
  167        print_message(informational, spying(SpyPoints))
  168    ;   true
  169    ),
  170    trapping,
  171    forall(debugging_hook(DebugMode), true).
  172
  173spy_point(Module:Head) :-
  174    current_predicate(_, Module:Head),
  175    '$get_predicate_attribute'(Module:Head, spy, 1),
  176    \+ predicate_property(Module:Head, imported_from(_)).
  177
  178%!  debugging_hook(+DebugMode)
  179%
  180%   Multifile hook that is   called as forall(debugging_hook(DebugMode),
  181%   true) and that may be used to   extend  the information printed from
  182%   other debugging libraries.
  183
  184:- multifile debugging_hook/1.  185
  186
  187		 /*******************************
  188		 *           EXCEPTIONS		*
  189		 *******************************/
  190
  191%!  trap(+Formal) is det.
  192%!  notrap(+Formal) is det.
  193%
  194%   Install a trap on error(Formal, Context)  exceptions that unify. The
  195%   tracer  is  started  when  a  matching  exception  is  raised.  This
  196%   predicate enables _debug mode_ using  debug/0   to  get more context
  197%   about the exception. Even with debug   mode  disabled exceptions are
  198%   still trapped and thus one may call  nodebug/0 to run in normal mode
  199%   after installing a trap. Exceptions are trapped in any thread. Debug
  200%   mode is only enabled in the calling  thread. To enable debug mode in
  201%   all threads use tdebug/0.
  202%
  203%   Calling debugging/0 lists the enabled  traps. The predicate notrap/1
  204%   removes matching (unifying) traps.
  205%
  206%   In many cases debugging an exception that  is caught is as simple as
  207%   below (assuming run/0 starts your program).
  208%
  209%   ```
  210%   ?- trap(_).
  211%   ?- run.
  212%   ```
  213%
  214%   The multifile hook trap_alias/2 allow for   defining short hands for
  215%   commonly used traps.  Currently this defines
  216%
  217%     - det
  218%       Trap determinism exceptions raised as a result of the det/1
  219%       directive.
  220%     - =>
  221%       Trap rule existence error exceptions.
  222%
  223%   @see gtrap/1 to trap using the graphical debugger.
  224%   @see _Edit exceptions_ menu in PceEmacs and the graphical debugger
  225%   that provide a graphical frontend to trap exceptions.
  226
  227:- dynamic
  228    exception/4,                    % Name, Term, NotCaught, Caught
  229    installed/1.                    % ClauseRef
  230
  231trap(Error) :-
  232    '$notrace'(trap_(Error)).
  233
  234trap_(Spec) :-
  235    expand_trap(Spec, Formal),
  236    gensym(ex, Rule),
  237    asserta(exception(Rule, error(Formal, _), true, true)),
  238    print_message(informational, trap(Rule, error(Formal, _), true, true)),
  239    install_exception_hook,
  240    debug.
  241
  242notrap(Error) :-
  243    '$notrace'(notrap_(Error)).
  244
  245notrap_(Spec) :-
  246    expand_trap(Spec, Formal),
  247    Exception = error(Formal, _),
  248    findall(exception(Name, Exception, NotCaught, Caught),
  249            retract(exception(Name, error(Formal, _), Caught, NotCaught)),
  250            Trapping),
  251    print_message(informational, notrap(Trapping)).
  252
  253expand_trap(Var, _Formal), var(Var) =>
  254    true.
  255expand_trap(Alias, Formal), trap_alias(Alias, For) =>
  256    Formal = For.
  257expand_trap(Explicit, Formal) =>
  258    Formal = Explicit.
  259
  260%!  trap_alias(+Alias, -Error)
  261%
  262%   Define short hands for commonly used exceptions.
  263
  264trap_alias(det,                  determinism_error(_Pred, _Declared, _Observed, property)).
  265trap_alias(=>,			 existence_error(rule, _)).
  266trap_alias(existence_error,      existence_error(_,_)).
  267trap_alias(type_error,           type_error(_,_)).
  268trap_alias(domain_error,         domain_error(_,_)).
  269trap_alias(permission_error,     permission_error(_,_,_)).
  270trap_alias(representation_error, representation_error(_)).
  271trap_alias(resource_error,       resource_error(_)).
  272trap_alias(syntax_error,         syntax_error(_)).
  273
  274trapping :-
  275    findall(exception(Name, Term, NotCaught, Caught),
  276            exception(Name, Term, NotCaught, Caught),
  277            Trapping),
  278    print_message(information, trapping(Trapping)).
  279
  280:- dynamic   prolog:prolog_exception_hook/5.  281:- multifile prolog:prolog_exception_hook/5.  282
  283%!  exception_hook(+ExIn, -ExOut, +Frame, +Catcher, +DebugMode) is
  284%!                 failure.
  285%
  286%   Trap exceptions and consider whether or not to start the tracer.
  287
  288:- public exception_hook/5.  289
  290exception_hook(Ex, Ex, Frame, Catcher, _Debug) :-
  291    thread_self(Me),
  292    thread_property(Me, debug(true)),
  293    broadcast(debug(exception(Ex))),
  294    exception(_, Ex, NotCaught, Caught),
  295    !,
  296    (   Caught == true
  297    ->  true
  298    ;   Catcher == none,
  299        NotCaught == true
  300    ),
  301    \+ direct_catch(Frame),
  302    trace, fail.
  303
  304%!  direct_catch(+Frame) is semidet.
  305%
  306%   True if we are dealing with a  catch(SytemPred, _, _), i.e., a catch
  307%   directly wrapped around a call to  a   built-in.  In that case it is
  308%   highly unlikely that we want the debugger to step in.
  309
  310direct_catch(Frame) :-
  311    prolog_frame_attribute(Frame, parent, Parent),
  312    prolog_frame_attribute(Parent, predicate_indicator, system:catch/3),
  313    prolog_frame_attribute(Frame, Level, MyLevel),
  314    prolog_frame_attribute(Parent, Level, CatchLevel),
  315    MyLevel =:= CatchLevel+1.
  316
  317%!  install_exception_hook
  318%
  319%   Make sure our handler is the first of the hook predicate.
  320
  321install_exception_hook :-
  322    installed(Ref),
  323    (   nth_clause(_, I, Ref)
  324    ->  I == 1, !                   % Ok, we are the first
  325    ;   retractall(installed(Ref)),
  326        erase(Ref),                 % Someone before us!
  327        fail
  328    ).
  329install_exception_hook :-
  330    asserta((prolog:prolog_exception_hook(Ex, Out, Frame, Catcher, Debug) :-
  331                    exception_hook(Ex, Out, Frame, Catcher, Debug)), Ref),
  332    assert(installed(Ref)).
  333
  334
  335		 /*******************************
  336		 *            MESSAGES		*
  337		 *******************************/
  338
  339:- multifile
  340    prolog:message//1.  341
  342prolog:message(trapping([])) -->
  343    [ 'No exception traps'-[] ].
  344prolog:message(trapping(Trapping)) -->
  345    [ 'Exception traps on'-[], nl ],
  346    trapping(Trapping).
  347prolog:message(trap(_Rule, Error, _Caught, _NotCaught)) -->
  348    [ 'Installed trap for exception '-[] ],
  349    exception(Error),
  350    [ nl ].
  351prolog:message(notrap([])) -->
  352    [ 'No matching traps'-[] ].
  353prolog:message(notrap(Trapping)) -->
  354    [ 'Removed traps from exceptions'-[], nl ],
  355    trapping(Trapping).
  356
  357trapping([]) --> [].
  358trapping([exception(_Rule, Error, _Caught, _NotCaught)|T]) -->
  359    [ '  '-[] ],
  360    exception(Error),
  361    [ nl ],
  362    trapping(T).
  363
  364exception(Term) -->
  365    { copy_term(Term, T2),
  366      numbervars(T2, 0, _, [singletons(true)])
  367    },
  368    [ '~p'-[T2] ]