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-2026, 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:- autoload(library(pairs), [group_pairs_by_key/2]).   47
   48:- multifile
   49    trap_alias/2.   50
   51:- set_prolog_flag(generate_debug_info, false).   52
   53/** <module> User level debugging tools
   54
   55This  library  provides  tools   to    control   the  Prolog  debuggers.
   56Traditionally this code was  built-in.  Because   these  tools  are only
   57required in (interactive) debugging sessions they   have been moved into
   58the library.
   59*/
   60
   61%!  prolog:debug_control_hook(+Action)
   62%
   63%   Allow user-hooks in the Prolog debugger interaction.  See the calls
   64%   below for the provided hooks.  We use a single predicate with action
   65%   argument to avoid an uncontrolled poliferation of hooks.
   66
   67:- multifile
   68    prolog:debug_control_hook/1.    % +Action
   69
   70:- meta_predicate
   71    spy(:),
   72    nospy(:).   73
   74%!  spy(:Spec) is det.
   75%!  nospy(:Spec) is det.
   76%!  nospyall is det.
   77%
   78%   Set/clear spy-points. A successfully  set   or  cleared spy-point is
   79%   reported using print_message/2, level `informational`,   with one of
   80%   the following terms, where Spec is of the form M:Head.
   81%
   82%       - spy(Spec)
   83%       - nospy(Spec)
   84%
   85%   @see    spy/1 and nospy/1 call the hook prolog:debug_control_hook/1
   86%           to allow for alternative specifications of the thing to
   87%           debug.
   88
   89spy(Spec) :-
   90    '$notrace'(spy_(Spec)).
   91
   92spy_(_:X) :-
   93    var(X),
   94    throw(error(instantiation_error, _)).
   95spy_(_:[]) :- !.
   96spy_(M:[H|T]) :-
   97    !,
   98    spy(M:H),
   99    spy(M:T).
  100spy_(Spec) :-
  101    prolog:debug_control_hook(spy(Spec)),
  102    !.
  103spy_(Spec) :-
  104    '$find_predicate'(Spec, Preds),
  105    '$member'(PI, Preds),
  106        pi_to_head(PI, Head),
  107        '$define_predicate'(Head),
  108        set_spy_point(Head),
  109    fail.
  110spy_(_).
  111
  112set_spy_point(Head) :-
  113    '$get_predicate_attribute'(Head, spy, 1),
  114    !,
  115    print_message(informational, already_spying(Head)).
  116set_spy_point(Head) :-
  117    '$spy'(Head).
  118
  119nospy(Spec) :-
  120    notrace(nospy_(Spec)).
  121
  122nospy_(_:X) :-
  123    var(X),
  124    throw(error(instantiation_error, _)).
  125nospy_(_:[]) :- !.
  126nospy_(M:[H|T]) :-
  127    !,
  128    nospy(M:H),
  129    nospy(M:T).
  130nospy_(Spec) :-
  131    prolog:debug_control_hook(nospy(Spec)),
  132    !.
  133nospy_(Spec) :-
  134    '$find_predicate'(Spec, Preds),
  135    '$member'(PI, Preds),
  136         pi_to_head(PI, Head),
  137        '$nospy'(Head),
  138    fail.
  139nospy_(_).
  140
  141nospyall :-
  142    notrace(nospyall_).
  143
  144nospyall_ :-
  145    prolog:debug_control_hook(nospyall),
  146    fail.
  147nospyall_ :-
  148    spy_point(Head),
  149        '$nospy'(Head),
  150    fail.
  151nospyall_.
  152
  153pi_to_head(M:PI, M:Head) :-
  154    !,
  155    pi_to_head(PI, Head).
  156pi_to_head(Name/Arity, Head) :-
  157    functor(Head, Name, Arity).
  158
  159%!  debugging is det.
  160%
  161%   Report current status of the debugger.
  162
  163:- '$hide'(debugging/0).  164debugging :-
  165    current_prolog_flag(debug, DebugMode),
  166    debug_threads(Threads),
  167    notrace(debugging_(DebugMode, Threads)).
  168
  169debugging_(DebugMode, Threads) :-
  170    prolog:debug_control_hook(debugging(DebugMode, Threads)),
  171    !.
  172debugging_(DebugMode, _) :-
  173    prolog:debug_control_hook(debugging(DebugMode)),
  174    !.
  175debugging_(DebugMode, Threads) :-
  176    print_message(informational, debugging(DebugMode, Threads)),
  177    (   (   DebugMode == true
  178        ;   Threads \== []
  179        )
  180    ->  findall(H, spy_point(H), SpyPoints),
  181        print_message(informational, spying(SpyPoints))
  182    ;   true
  183    ),
  184    trapping,
  185    forall(debugging_hook(DebugMode), true).
  186
  187%!  debug_threads(-ThreadsByClass:list(pair)) is det.
  188%
  189%   Produce a list `Class-ThreadIds` of threads   other than the calling
  190%   thread that is in debug mode.
  191
  192:- if(current_prolog_flag(threads, true)).  193debug_threads(ThreadsByClass) :-
  194    findall(TInfo, debug_thread(TInfo), Threads),
  195    keysort(Threads, Sorted),
  196    group_pairs_by_key(Sorted, ThreadsByClass).
  197
  198debug_thread(Class-Thread) :-
  199    thread_self(Me),
  200    thread_property(Thread, debug_mode(true)),
  201    Thread \== Me,
  202    catch(( thread_property(Thread, debug(true)),
  203            thread_property(Thread, class(Class))
  204          ), error(_,_), fail).
  205:- else.  206debug_threads([]).
  207:- endif.  208
  209spy_point(Module:Head) :-
  210    current_predicate(_, Module:Head),
  211    '$get_predicate_attribute'(Module:Head, spy, 1),
  212    \+ predicate_property(Module:Head, imported_from(_)).
  213
  214%!  debugging_hook(+DebugMode)
  215%
  216%   Multifile hook that is   called as forall(debugging_hook(DebugMode),
  217%   true) and that may be used to   extend  the information printed from
  218%   other debugging libraries.
  219
  220:- multifile debugging_hook/1.  221
  222
  223		 /*******************************
  224		 *           EXCEPTIONS		*
  225		 *******************************/
  226
  227%!  trap(+Formal) is det.
  228%!  notrap(+Formal) is det.
  229%
  230%   Install a trap on error(Formal, Context)  exceptions that unify. The
  231%   tracer  is  started  when  a  matching  exception  is  raised.  This
  232%   predicate enables _debug mode_ using  debug/0   to  get more context
  233%   about the exception. Even with debug   mode  disabled exceptions are
  234%   still trapped and thus one may call  nodebug/0 to run in normal mode
  235%   after installing a trap. Exceptions are trapped in any thread. Debug
  236%   mode is only enabled in the calling  thread. To enable debug mode in
  237%   all threads use tdebug/0.
  238%
  239%   Calling debugging/0 lists the enabled  traps. The predicate notrap/1
  240%   removes matching (unifying) traps.
  241%
  242%   In many cases debugging an exception that  is caught is as simple as
  243%   below (assuming run/0 starts your program).
  244%
  245%   ```
  246%   ?- trap(_).
  247%   ?- run.
  248%   ```
  249%
  250%   The multifile hook trap_alias/2 allow for   defining short hands for
  251%   commonly used traps.  Currently this defines
  252%
  253%     - det
  254%       Trap determinism exceptions raised as a result of the det/1
  255%       directive.
  256%     - =>
  257%       Trap rule existence error exceptions.
  258%
  259%   @see gtrap/1 to trap using the graphical debugger.
  260%   @see _Edit exceptions_ menu in PceEmacs and the graphical debugger
  261%   that provide a graphical frontend to trap exceptions.
  262
  263:- dynamic
  264    exception/4,                    % Name, Term, NotCaught, Caught
  265    installed/1.                    % ClauseRef
  266
  267trap(Error) :-
  268    '$notrace'(trap_(Error)).
  269
  270trap_(Spec) :-
  271    expand_trap(Spec, Formal),
  272    gensym(ex, Rule),
  273    asserta(exception(Rule, error(Formal, _), true, true)),
  274    print_message(informational, trap(Rule, error(Formal, _), true, true)),
  275    install_exception_hook,
  276    debug.
  277
  278notrap(Error) :-
  279    '$notrace'(notrap_(Error)).
  280
  281notrap_(Spec) :-
  282    expand_trap(Spec, Formal),
  283    Exception = error(Formal, _),
  284    findall(exception(Name, Exception, NotCaught, Caught),
  285            retract(exception(Name, error(Formal, _), Caught, NotCaught)),
  286            Trapping),
  287    print_message(informational, notrap(Trapping)).
  288
  289expand_trap(Var, _Formal), var(Var) =>
  290    true.
  291expand_trap(Alias, Formal), trap_alias(Alias, For) =>
  292    Formal = For.
  293expand_trap(Explicit, Formal) =>
  294    Formal = Explicit.
  295
  296%!  trap_alias(+Alias, -Error)
  297%
  298%   Define short hands for commonly used exceptions.
  299
  300trap_alias(det,                  determinism_error(_Pred, _Declared, _Observed, property)).
  301trap_alias(=>,			 existence_error(rule, _)).
  302trap_alias(existence_error,      existence_error(_,_)).
  303trap_alias(type_error,           type_error(_,_)).
  304trap_alias(domain_error,         domain_error(_,_)).
  305trap_alias(permission_error,     permission_error(_,_,_)).
  306trap_alias(representation_error, representation_error(_)).
  307trap_alias(resource_error,       resource_error(_)).
  308trap_alias(syntax_error,         syntax_error(_)).
  309
  310trapping :-
  311    findall(exception(Name, Term, NotCaught, Caught),
  312            exception(Name, Term, NotCaught, Caught),
  313            Trapping),
  314    print_message(information, trapping(Trapping)).
  315
  316:- dynamic   prolog:prolog_exception_hook/5.  317:- multifile prolog:prolog_exception_hook/5.  318
  319%!  exception_hook(+ExIn, -ExOut, +Frame, +Catcher, +DebugMode) is
  320%!                 failure.
  321%
  322%   Trap exceptions and consider whether or not to start the tracer.
  323
  324:- public exception_hook/5.  325
  326exception_hook(Ex, Ex, Frame, Catcher, _Debug) :-
  327    thread_self(Me),
  328    thread_property(Me, debug(true)),
  329    broadcast(debug(exception(Ex))),
  330    exception(_, Ex, NotCaught, Caught),
  331    !,
  332    (   Caught == true
  333    ->  true
  334    ;   Catcher == none,
  335        NotCaught == true
  336    ),
  337    \+ direct_catch(Frame),
  338    trace, fail.
  339
  340%!  direct_catch(+Frame) is semidet.
  341%
  342%   True if we are dealing with a  catch(SytemPred, _, _), i.e., a catch
  343%   directly wrapped around a call to  a   built-in.  In that case it is
  344%   highly unlikely that we want the debugger to step in.
  345
  346direct_catch(Frame) :-
  347    prolog_frame_attribute(Frame, parent, Parent),
  348    prolog_frame_attribute(Parent, predicate_indicator, system:catch/3),
  349    prolog_frame_attribute(Frame, level, MyLevel),
  350    prolog_frame_attribute(Parent, level, CatchLevel),
  351    MyLevel =:= CatchLevel+1.
  352
  353%!  install_exception_hook
  354%
  355%   Make sure our handler is the first of the hook predicate.
  356
  357install_exception_hook :-
  358    installed(Ref),
  359    (   nth_clause(_, I, Ref)
  360    ->  I == 1, !                   % Ok, we are the first
  361    ;   retractall(installed(Ref)),
  362        erase(Ref),                 % Someone before us!
  363        fail
  364    ).
  365install_exception_hook :-
  366    asserta((prolog:prolog_exception_hook(Ex, Out, Frame, Catcher, Debug) :-
  367                    exception_hook(Ex, Out, Frame, Catcher, Debug)), Ref),
  368    assert(installed(Ref)).
  369
  370
  371		 /*******************************
  372		 *            MESSAGES		*
  373		 *******************************/
  374
  375:- multifile
  376    prolog:message//1.  377
  378prolog:message(trapping([])) -->
  379    [ 'No exception traps'-[] ].
  380prolog:message(trapping(Trapping)) -->
  381    [ 'Exception traps on'-[], nl ],
  382    trapping(Trapping).
  383prolog:message(trap(_Rule, Error, _Caught, _NotCaught)) -->
  384    [ 'Installed trap for exception '-[] ],
  385    exception(Error),
  386    [ nl ].
  387prolog:message(notrap([])) -->
  388    [ 'No matching traps'-[] ].
  389prolog:message(notrap(Trapping)) -->
  390    [ 'Removed traps from exceptions'-[], nl ],
  391    trapping(Trapping).
  392
  393trapping([]) --> [].
  394trapping([exception(_Rule, Error, _Caught, _NotCaught)|T]) -->
  395    [ '  '-[] ],
  396    exception(Error),
  397    [ nl ],
  398    trapping(T).
  399
  400exception(Term) -->
  401    { copy_term(Term, T2),
  402      numbervars(T2, 0, _, [singletons(true)])
  403    },
  404    [ '~p'-[T2] ]