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]).   47
   48
   49/** <module> Print access to predicates
   50
   51This library prints accesses to  specified   predicates  by wrapping the
   52predicate.
   53
   54@see  library(debug)  for  adding  conditional  print  statements  to  a
   55program.
   56*/
   57
   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
   65
   66%!  trace(:Pred) is det.
   67%!  trace(:Pred, +PortSpec) is det.
   68%
   69%   Print passes through _ports_ of  specified   predicates.  Pred is a,
   70%   possible partial, specification of a predicate as it is also used be
   71%   spy/1 and similar predicates. Where   a full predicate specification
   72%   is of the shape `Module:Name/Arity` (or `//Arity for non-terminals),
   73%   both the module and arity may be   omitted in which case Pred refers
   74%   to all matching  predicates.  PortSpec  is   either  a  single  port
   75%   (`call`, `exit`, `fail` or `redo`), preceded with   `+`  or `-` or a
   76%   list  of  these.  The   predicate    modifies   the   current  trace
   77%   specification and then installs a suitable wrapper for the predicate
   78%   using wrap_predicate/4.  For example:
   79%
   80%   ```
   81%   ?- trace(append).
   82%   %     lists:append/2: [all]
   83%   %     lists:append/3: [all]
   84%   %     append/1: [all]
   85%   true.
   86%
   87%   ?- append([a,b], [c], L).
   88%    T [10] Call: lists:append([a, b], [c], _18032)
   89%    T [19] Call: lists:append([b], [c], _19410)
   90%    T [28] Call: lists:append([], [c], _20400)
   91%    T [28 +0.1ms] Exit: lists:append([], [c], [c])
   92%    T [19 +0.2ms] Exit: lists:append([b], [c], [b, c])
   93%    T [10 +0.5ms] Exit: lists:append([a, b], [c], [a, b, c])
   94%   L = [a, b, c].
   95%
   96%   ?- trace(append, -all).
   97%   %     lists:append/2: Not tracing
   98%   %     lists:append/3: Not tracing
   99%   %     append/1: Not tracing
  100%   ```
  101%
  102%   The text between [] indicates the call  depth (first number) and for
  103%   all ports except the `call` port  the   _wall_  time since the start
  104%   (call port) in milliseconds. Note that the instrumentation and print
  105%   time is included in the time. In   the example above the actual time
  106%   is about 0.00001ms on todays hardware.
  107%
  108%   In addition, __conditions__ may be specified.   In this case the the
  109%   specification takes the shape ``trace(:Head, Port(Condition))``. For
  110%   example:
  111%
  112%       ?- trace(current_prolog_flag(Flag, Value), call(var(Flag))).
  113%       ?- list_tracing.
  114%       % Trace points (see trace/1,2) on:
  115%       %     system:current_prolog_flag(A,_): [call(var(A))]
  116%
  117%   This specification will only  print  the   goal  if  the  registered
  118%   condition succeeds. Note that we can use  the condition for its side
  119%   effect and then fail to avoid printing the event. Clearing the trace
  120%   event  on  all  relevant  ports  removes  the  condition.  There  is
  121%   currently no way to modify the  condition without clearing the trace
  122%   point first.
  123
  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).
  228
  229%!  wrapper(+Ports:integer, :Head, -Wrapped, -Wrapper) is det.
  230%!  wrapper(+Ports:integer, :Head, +Id, -Wrapped, -Wrapper) is det.
  231%
  232%   Adds calls to
  233%
  234%      print_message(debug, frame(Head, trace(Port, Id)))
  235%
  236%   @arg Id is a term  `#{frame:Frame, level:Level, start:Start}`, where
  237%   `Frame` is the (fragile) frame  identifier,   `Level`  is  the stack
  238%   depth and `Start` is the wall-time when the call was started.
  239
  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).
  321
  322%!  tracing(:Spec, -Ports)
  323%
  324%   True if Spec is traced using Ports.   Spec is a fully qualified head
  325%   term.
  326
  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).
  339
  340
  341%!  list_tracing.
  342%
  343%   List predicates we are currently tracing
  344
  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    ).
  357
  358
  359%!  notraceall is det.
  360%
  361%   Remove all trace points
  362
  363notraceall :-
  364    forall(tracing(M:Spec, _Ports),
  365           trace(M:Spec, -all))