View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        jan@swi-prolog.org
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2019-2024, CWI, Amsterdam
    7                              SWI-Prolog Solutions b.v.
    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_trace,
   37          [ trace/1,                            % :Spec
   38            trace/2,                            % :Spec, +Ports
   39            tracing/2,                          % :Spec, -Ports
   40            list_tracing/0,
   41            notraceall/0
   42          ]).   43:- autoload(library(apply),[maplist/2]).   44:- autoload(library(error),[instantiation_error/1]).   45:- autoload(library(prolog_wrap),[wrap_predicate/4]).   46:- autoload(library(prolog_code), [pi_head/2]).

Print access to predicates

This library prints accesses to specified predicates by wrapping the predicate.

See also
- library(debug) for adding conditional print statements to a program. */
   58:- meta_predicate
   59    trace(:),
   60    trace(:, +),
   61    tracing(:, -).   62
   63:- dynamic tracing_mask/2 as volatile.          % :Head, Bitmask
   64:- dynamic trace_condition/3 as volatile.       % :Head, Port, Cond
 trace(:Pred) is det
 trace(:Pred, +PortSpec) is det
Print passes through ports of specified predicates. Pred is a, possible partial, specification of a predicate as it is also used be spy/1 and similar predicates. Where a full predicate specification is of the shape Module:Name/Arity (or `//Arity for non-terminals), both the module and arity may be omitted in which case Pred refers to all matching predicates. PortSpec is either a single port (call, exit, fail or redo), preceded with + or - or a list of these. The predicate modifies the current trace specification and then installs a suitable wrapper for the predicate using wrap_predicate/4. For example:
?- trace(append).
%     lists:append/2: [all]
%     lists:append/3: [all]
%     append/1: [all]
true.

?- append([a,b], [c], L).
 T [10] Call: lists:append([a, b], [c], _18032)
 T [19] Call: lists:append([b], [c], _19410)
 T [28] Call: lists:append([], [c], _20400)
 T [28 +0.1ms] Exit: lists:append([], [c], [c])
 T [19 +0.2ms] Exit: lists:append([b], [c], [b, c])
 T [10 +0.5ms] Exit: lists:append([a, b], [c], [a, b, c])
L = [a, b, c].

?- trace(append, -all).
%     lists:append/2: Not tracing
%     lists:append/3: Not tracing
%     append/1: Not tracing

The text between [] indicates the call depth (first number) and for all ports except the call port the wall time since the start (call port) in milliseconds. Note that the instrumentation and print time is included in the time. In the example above the actual time is about 0.00001ms on todays hardware.

In addition, conditions may be specified. In this case the the specification takes the shape trace(:Head, Port(Condition)). For example:

?- trace(current_prolog_flag(Flag, Value), call(var(Flag))).
?- list_tracing.
% Trace points (see trace/1,2) on:
%     system:current_prolog_flag(A,_): [call(var(A))]

This specification will only print the goal if the registered condition succeeds. Note that we can use the condition for its side effect and then fail to avoid printing the event. Clearing the trace event on all relevant ports removes the condition. There is currently no way to modify the condition without clearing the trace point first.

  124trace(Pred) :-
  125    trace(Pred, +all).
  126
  127trace(Pred, Spec) :-
  128    Pred = Ctx:_,
  129    '$find_predicate'(Pred, Preds),
  130    Preds \== [],
  131    maplist(set_trace_pi(Spec, Pred, Ctx), Preds).
  132
  133set_trace_pi(Spec, PredSpec, Ctx, Pred) :-
  134    pi_head(Pred, Head0),
  135    resolve_predicate(Head0, Head),
  136    bind_head(PredSpec, Head),
  137    set_trace(Spec, Head, Ctx).
  138
  139bind_head(Head, Head) :- !.
  140bind_head(_:Head, _:Head) :- !.
  141bind_head(_, _).
  142
  143set_trace(Spec, Head, Ctx) :-
  144    (   tracing_mask(Head, Spec0)
  145    ->  true
  146    ;   Spec0 = 0
  147    ),
  148    modify(Spec, Head, Spec0, Spec1, Ctx),
  149    retractall(tracing_mask(Head, _)),
  150    (   Spec1 == [] ; Spec1 == 0
  151    ->  true
  152    ;   asserta(tracing_mask(Head, Spec1))
  153    ),
  154    mask_ports(Spec1, Ports),
  155    (   Spec1 == 0
  156    ->  unwrap_predicate(Head, trace),
  157        print_message(informational, trace(Head, Ports))
  158    ;   wrapper(Spec1, Head, Wrapped, Wrapper),
  159        wrap_predicate(Head, trace, Wrapped, Wrapper),
  160        print_message(informational, trace(Head, Ports))
  161    ).
  162
  163resolve_predicate(Head0, Head) :-
  164    (   predicate_property(Head0, imported_from(M))
  165    ->  requalify(Head0, M, Head)
  166    ;   Head = Head0
  167    ).
  168
  169requalify(Term, M, M:Plain) :-
  170    strip_module(Term, _, Plain).
  171
  172modify(Var, _, _, _, _) :-
  173    var(Var),
  174    !,
  175    instantiation_error(Var).
  176modify([], _, Spec, Spec, _) :-
  177    !.
  178modify([H|T], Head, Spec0, Spec, Ctx) :-
  179    !,
  180    modify(H, Head, Spec0, Spec1, Ctx),
  181    modify(T, Head, Spec1, Spec, Ctx).
  182modify(+PortSpec, Head, Spec0, Spec, Ctx) :-
  183    !,
  184    port_spec(PortSpec, Head, Port, Ctx),
  185    port_mask(Port, Mask),
  186    Spec is Spec0 \/ Mask.
  187modify(-Port, Head, Spec0, Spec, _) :-
  188    !,
  189    port_mask(Port, Mask),
  190    remove_condition(Head, Mask),
  191    Spec is Spec0 /\ \Mask.
  192modify(Port, Head, Spec0, Spec, Ctx) :-
  193    modify(+Port, Head, Spec0, Spec, Ctx).
  194
  195port_spec(Spec, _, Port, _), atom(Spec) =>
  196    Port = Spec.
  197port_spec(Spec, Head, Port, Ctx),
  198    compound(Spec),
  199    compound_name_arguments(Spec, Name, [Cond]) =>
  200    Port = Name,
  201    port_mask(Port, Mask),
  202    strip_module(Ctx:Cond, M, PCond),
  203    (   predicate_property(M:PCond, iso)
  204    ->  TheCond = PCond
  205    ;   TheCond = M:PCond
  206    ),
  207    asserta(trace_condition(Head, Mask, TheCond)).
  208
  209remove_condition(Head, Mask) :-
  210    (   trace_condition(Head, TraceMask, TheCond),
  211        Mask /\ TraceMask =:= TraceMask,
  212        retractall(trace_condition(Head, TraceMask, TheCond)),
  213        fail
  214    ;   true
  215    ).
  216
  217port_mask(all,  0x0f).
  218port_mask(call, 0x01).
  219port_mask(exit, 0x02).
  220port_mask(redo, 0x04).
  221port_mask(fail, 0x08).
  222
  223mask_ports(0, []) :-
  224    !.
  225mask_ports(Pattern, [H|T]) :-
  226    is_masked(Pattern, H, Pattern1),
  227    mask_ports(Pattern1, T).
 wrapper(+Ports:integer, :Head, -Wrapped, -Wrapper) is det
 wrapper(+Ports:integer, :Head, +Id, -Wrapped, -Wrapper) is det
Adds calls to

print_message(debug, frame(Head, trace(Port, Id)))

Arguments:
Id- is a term #{frame:Frame, level:Level, start:Start}, where Frame is the (fragile) frame identifier, Level is the stack depth and Start is the wall-time when the call was started.
  240wrapper(Ports, Head, Wrapped, Wrapper) :-
  241    wrapper(Ports, Head,
  242            #{frame:Frame, level:Level, start:Start},
  243            Wrapped, Wrapped1),
  244    Wrapper = (   prolog_current_frame(Frame),
  245                  prolog_frame_attribute(Frame, level, Level),
  246                  get_time(Start),
  247                  Wrapped1
  248              ).
  249
  250wrapper(0, _, _, Wrapped, Wrapped) :-
  251    !.
  252wrapper(Pattern, Head, Id, Wrapped, Call) :-
  253    is_masked(Pattern, call, Pattern1),
  254    !,
  255    wrapper(Pattern1, Head, Id, Wrapped, Call0),
  256    Call = (   prolog_trace:on_port(call, Head, Id),
  257               Call0
  258           ).
  259wrapper(Pattern, Head, Id, Wrapped, Call) :-
  260    is_masked(Pattern, exit, Pattern1),
  261    !,
  262    wrapper(Pattern1, Head, Id, Wrapped, Call0),
  263    Call = (   Call0,
  264               prolog_trace:on_port(exit, Head, Id)
  265           ).
  266wrapper(Pattern, Head, Id, Wrapped, Call) :-
  267    is_masked(Pattern, redo, Pattern1),
  268    !,
  269    wrapper(Pattern1, Head, Id, Wrapped, Call0),
  270    Call = (   call_cleanup(Call0, Det = true),
  271               (   Det == true
  272               ->  true
  273               ;   true
  274               ;   prolog_trace:on_port(redo, Head, Id),
  275                   fail
  276               )
  277           ).
  278wrapper(Pattern, Head, Id, Wrapped, Call) :-
  279    is_masked(Pattern, fail, Pattern1),
  280    !,
  281    wrapper(Pattern1, Head, Id, Wrapped, Call0),
  282    Call = call((   call_cleanup(Call0, Det = true),
  283                    (   Det == true
  284                    ->  !
  285                    ;   true
  286                    )
  287                ;   prolog_trace:on_port(fail, Head, Id),
  288                    fail
  289                )).
  290
  291is_masked(Pattern0, Port, Pattern) :-
  292    port_mask(Port, Mask),
  293    Pattern0 /\ Mask =:= Mask,
  294    !,
  295    Pattern is Pattern0 /\ \Mask.
  296
  297%   on_port(+Port, +Head, +Id)
  298%
  299%   Called on the various ports. Succeeds on the `call` and `exit` ports
  300%   and fails otherwise.
  301
  302:- public on_port/3.  303on_port(Port, Head, Id) :-
  304    (   do_trace(Port, Head)
  305    ->  print_message(debug, frame(Head, trace(Port, Id)))
  306    ;   true
  307    ),
  308    success_port(Port).
  309
  310do_trace(Port, Head) :-
  311    forall(active_trace_condition(Port, Head, Cond),
  312           Cond).
  313
  314active_trace_condition(Port, Head, Cond) :-
  315    trace_condition(Head, Mask, Cond),
  316    port_mask(Port, PortMask),
  317    Mask /\ PortMask =\= 0.
  318
  319success_port(call).                     % on the other ports we must fail.
  320success_port(exit).
 tracing(:Spec, -Ports)
True if Spec is traced using Ports. Spec is a fully qualified head term.
  327tracing(Spec, Ports) :-
  328    tracing_mask(Spec, Mask),
  329    mask_ports(Mask, Ports0),
  330    maplist(add_condition(Spec), Ports0, Ports).
  331
  332add_condition(Head, Port, PortCond) :-
  333    trace_condition(Head, Mask, Cond),
  334    port_mask(Port, PortMask),
  335    Mask /\ PortMask =\= 0,
  336    !,
  337    PortCond =.. [Port,Cond].
  338add_condition(_, Port, Port).
 list_tracing
List predicates we are currently tracing
  345list_tracing :-
  346    Head = _:_,
  347    findall(trace(Head, Ports), tracing(Head, Ports), Tracing),
  348    print_message(informational, tracing(Tracing)).
  349
  350:- multifile
  351    prolog_debug_tools:debugging_hook/0.  352
  353prolog_debug_tools:debugging_hook :-
  354    (   tracing(_:_, _)
  355    ->  list_tracing
  356    ).
 notraceall is det
Remove all trace points
  363notraceall :-
  364    forall(tracing(M:Spec, _Ports),
  365           trace(M:Spec, -all))