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) 2019, CWI, Amsterdam 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_trace, 36 [ trace/1, % :Spec 37 trace/2, % :Spec, +Ports 38 tracing/2 % :Spec, -Ports 39 ]). 40:- autoload(library(apply),[maplist/2]). 41:- autoload(library(error),[instantiation_error/1]). 42:- autoload(library(prolog_wrap),[wrap_predicate/4]). 43 44 45/** <module> Print access to predicates 46 47This library prints accesses to specified predicates by wrapping the 48predicate. 49 50@see library(debug) for adding conditional print statements to a 51program. 52*/ 53 54:- meta_predicate 55 trace(), 56 trace(, ), 57 tracing(, ). 58 59:- dynamic tracing_mask/2. 60:- volatile tracing_mask/2. 61 62%! trace(:Pred) is det. 63%! trace(:Pred, +PortSpec) is det. 64% 65% Print passes through _ports_ of specified predicates. Pred is a, 66% possible partial, specification of a predicate as it is also used be 67% spy/1 and similar predicates. Where a full predicate specification 68% is of the shape `Module:Name/Arity` (or `//Arity for non-terminals), 69% both the module and arity may be omitted in which case Pred refers 70% to all matching predicates. PortSpec is either a single port 71% (`call`, `exit`, `fail` or `redo`), preceded with `+` or `-` or a 72% list of these. The predicate modifies the current trace 73% specification and then installs a suitable wrapper for the predicate 74% using wrap_predicate/4. For example: 75% 76% ``` 77% ?- trace(append). 78% % lists:append/2: [all] 79% % lists:append/3: [all] 80% % append/1: [all] 81% true. 82% 83% ?- append([a,b], [c], L). 84% T Call: lists:append([a, b], [c], _10478) 85% T Call: lists:append([b], [c], _11316) 86% T Call: lists:append([], [c], _11894) 87% T Exit: lists:append([], [c], [c]) 88% T Exit: lists:append([b], [c], [b, c]) 89% T Exit: lists:append([a, b], [c], [a, b, c]) 90% L = [a, b, c]. 91% 92% ?- trace(append, -all). 93% % lists:append/2: Not tracing 94% % lists:append/3: Not tracing 95% % append/1: Not tracing 96% 97% @compat This library replaces prior built-in functionality. Unlike 98% the built-in version, ports are printed regardless of the `debug` 99% flag. The built-in version printed the call-stack depth. That is 100% currently not provided by this replacement. 101 102trace(Pred) :- 103 trace(Pred, +all). 104 105trace(Pred, Spec) :- 106 '$find_predicate'(Pred, Preds), 107 Preds \== [], 108 maplist(set_trace(Spec), Preds). 109 110set_trace(Spec, Pred) :- 111 ( tracing_mask(Pred, Spec0) 112 -> true 113 ; Spec0 = 0 114 ), 115 modify(Spec, Spec0, Spec1), 116 retractall(tracing_mask(Pred, _)), 117 asserta(tracing_mask(Pred, Spec1)), 118 mask_ports(Spec1, Ports), 119 pi_head(Pred, Head), 120 ( Spec1 == 0 121 -> unwrap_predicate(Head, trace), 122 print_message(informational, trace(Head, Ports)) 123 ; wrapper(Spec1, Head, Wrapped, Wrapper), 124 wrap_predicate(Head, trace, Wrapped, Wrapper), 125 print_message(informational, trace(Head, Ports)) 126 ). 127 128modify(Var, _, _) :- 129 var(Var), 130 !, 131 instantiation_error(Var). 132modify([], Spec, Spec) :- 133 !. 134modify([H|T], Spec0, Spec) :- 135 !, 136 modify(H, Spec0, Spec1), 137 modify(T, Spec1, Spec). 138modify(+Port, Spec0, Spec) :- 139 !, 140 port_mask(Port, Mask), 141 Spec is Spec0 \/ Mask. 142modify(-Port, Spec0, Spec) :- 143 !, 144 port_mask(Port, Mask), 145 Spec is Spec0 /\ \Mask. 146modify(Port, Spec0, Spec) :- 147 port_mask(Port, Mask), 148 Spec is Spec0 \/ Mask. 149 150port_mask(all, 0x0f). 151port_mask(call, 0x01). 152port_mask(exit, 0x02). 153port_mask(redo, 0x04). 154port_mask(fail, 0x08). 155 156mask_ports(0, []) :- 157 !. 158mask_ports(Pattern, [H|T]) :- 159 is_masked(Pattern, H, Pattern1), 160 mask_ports(Pattern1, T). 161 162pi_head(M:PI, M:Head) :- 163 !, 164 pi_head(PI, Head). 165pi_head(Name/Arity, Head) :- 166 functor(Head, Name, Arity). 167pi_head(Name//Arity0, Head) :- 168 Arity is Arity0+1, 169 functor(Head, Name, Arity). 170 171wrapper(0, _, Wrapped, Wrapped) :- 172 !. 173wrapper(Pattern, Head, Wrapped, Call) :- 174 is_masked(Pattern, call, Pattern1), 175 !, 176 wrapper(Pattern1, Head, Wrapped, Call0), 177 Call = ( print_message(debug, frame(Head, trace(call))), 178 Call0 179 ). 180wrapper(Pattern, Head, Wrapped, Call) :- 181 is_masked(Pattern, exit, Pattern1), 182 !, 183 wrapper(Pattern1, Head, Wrapped, Call0), 184 Call = ( Call0, 185 print_message(debug, frame(Head, trace(exit))) 186 ). 187wrapper(Pattern, Head, Wrapped, Call) :- 188 is_masked(Pattern, redo, Pattern1), 189 !, 190 wrapper(Pattern1, Head, Wrapped, Call0), 191 Call = ( call_cleanup(Call0, Det = true), 192 ( Det == true 193 -> true 194 ; true 195 ; print_message(debug, frame(Head, trace(redo))), 196 fail 197 ) 198 ). 199wrapper(Pattern, Head, Wrapped, Call) :- 200 is_masked(Pattern, fail, Pattern1), 201 !, 202 wrapper(Pattern1, Head, Wrapped, Call0), 203 Call = call(( call_cleanup(Call0, Det = true), 204 ( Det == true 205 -> ! 206 ; true 207 ) 208 ; print_message(debug, frame(Head, trace(fail))), 209 fail 210 )). 211 212is_masked(Pattern0, Port, Pattern) :- 213 port_mask(Port, Mask), 214 Pattern0 /\ Mask =:= Mask, 215 !, 216 Pattern is Pattern0 /\ \Mask. 217 218%! tracing(:Spec, -Ports) 219% 220% True if Spec is traced using Ports 221 222tracing(Spec, Ports) :- 223 tracing_mask(Spec, Mask), 224 mask_ports(Mask, Ports)