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) 2004-2018, University of Amsterdam 7 VU University Amsterdam 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_stack, 37 [ get_prolog_backtrace/2, % +MaxDepth, -Stack 38 get_prolog_backtrace/3, % +Frame, -Stack, +Options 39 prolog_stack_frame_property/2, % +Frame, ?Property 40 print_prolog_backtrace/2, % +Stream, +Stack 41 print_prolog_backtrace/3, % +Stream, +Stack, +Options 42 backtrace/1 % +MaxDepth 43 ]). 44:- use_module(library(prolog_clause)). 45:- use_module(library(debug)). 46:- use_module(library(error)). 47:- use_module(library(lists)). 48:- use_module(library(option)). 49 50:- dynamic stack_guard/1. 51:- multifile stack_guard/1. 52 53:- predicate_options(print_prolog_backtrace/3, 3, 54 [ subgoal_positions(boolean) 55 ]).
87:- create_prolog_flag(backtrace, true, [type(boolean), keep(true)]). 88:- create_prolog_flag(backtrace_depth, 20, [type(integer), keep(true)]). 89:- create_prolog_flag(backtrace_goal_depth, 3, [type(integer), keep(true)]). 90:- create_prolog_flag(backtrace_show_lines, true, [type(boolean), keep(true)]).
backtrace_goal_depth
, set to 2
initially, showing the
goal and toplevel of any argument.Clause+PC
or as a location term that
does not use clause references, allowing the exception to
be printed safely in a different context.123get_prolog_backtrace(MaxDepth, Stack) :- 124 get_prolog_backtrace(MaxDepth, Stack, []). 125 126get_prolog_backtrace(Fr, MaxDepth, Stack) :- 127 integer(Fr), integer(MaxDepth), var(Stack), 128 !, 129 get_prolog_backtrace_lc(MaxDepth, Stack, [frame(Fr)]), 130 nlc. 131get_prolog_backtrace(MaxDepth, Stack, Options) :- 132 get_prolog_backtrace_lc(MaxDepth, Stack, Options), 133 nlc. % avoid last-call-optimization, such that 134 % the top of the stack is always a nice Prolog 135 % frame 136 137nlc. 138 139get_prolog_backtrace_lc(MaxDepth, Stack, Options) :- 140 ( option(frame(Fr), Options) 141 -> PC = call 142 ; prolog_current_frame(Fr0), 143 prolog_frame_attribute(Fr0, pc, PC), 144 prolog_frame_attribute(Fr0, parent, Fr) 145 ), 146 ( option(goal_term_depth(GoalDepth), Options) 147 -> true 148 ; current_prolog_flag(backtrace_goal_depth, GoalDepth) 149 ), 150 option(guard(Guard), Options, none), 151 ( def_no_clause_refs(Guard) 152 -> DefClauseRefs = false 153 ; DefClauseRefs = true 154 ), 155 option(clause_references(ClauseRefs), Options, DefClauseRefs), 156 must_be(nonneg, GoalDepth), 157 backtrace(MaxDepth, Fr, PC, GoalDepth, Guard, ClauseRefs, Stack, Options). 158 159def_no_clause_refs(system:catch_with_backtrace/3). 160 161backtrace(0, _, _, _, _, _, [], _) :- !. 162backtrace(MaxDepth, Fr, PC, GoalDepth, Guard, ClauseRefs, 163 [frame(Level, Where, Goal)|Stack], Options) :- 164 prolog_frame_attribute(Fr, level, Level), 165 ( PC == foreign 166 -> prolog_frame_attribute(Fr, predicate_indicator, Pred), 167 Where = foreign(Pred) 168 ; PC == call 169 -> prolog_frame_attribute(Fr, predicate_indicator, Pred), 170 Where = call(Pred) 171 ; prolog_frame_attribute(Fr, clause, Clause) 172 -> clause_where(ClauseRefs, Clause, PC, Where, Options) 173 ; Where = meta_call 174 ), 175 ( Where == meta_call 176 -> Goal = 0 177 ; copy_goal(GoalDepth, Fr, Goal) 178 ), 179 ( prolog_frame_attribute(Fr, pc, PC2) 180 -> true 181 ; PC2 = foreign 182 ), 183 ( prolog_frame_attribute(Fr, parent, Parent), 184 prolog_frame_attribute(Parent, predicate_indicator, PI), 185 PI == Guard % last frame 186 -> backtrace(1, Parent, PC2, GoalDepth, Guard, ClauseRefs, Stack, Options) 187 ; prolog_frame_attribute(Fr, parent, Parent), 188 more_stack(Parent) 189 -> D2 is MaxDepth - 1, 190 backtrace(D2, Parent, PC2, GoalDepth, Guard, ClauseRefs, Stack, Options) 191 ; Stack = [] 192 ). 193 194more_stack(Parent) :- 195 prolog_frame_attribute(Parent, predicate_indicator, PI), 196 \+ ( PI = ('$toplevel':G), 197 G \== (toplevel_call/1) 198 ), 199 !. 200more_stack(_) :- 201 current_prolog_flag(break_level, Break), 202 Break >= 1.
true
, this is the a term
clause(Clause,PC)
, providing all abvailable information to the
caller at low time overhead. If however the exception need to be
printed in an environment where the clause references may differ,
for example because the program is not loaded, it is printed in a
different thread and contains references to dynamic predicates, etc,
it is better to use the information inside the clause here.215clause_where(true, Clause, PC, clause(Clause, PC), _). 216clause_where(false, Clause, PC, pred_line(PredName, File:Line), Options) :- 217 option(subgoal_positions(true), Options, true), 218 subgoal_position(Clause, PC, File, CharA, _CharZ), 219 File \= @(_), % XPCE Object reference 220 lineno(File, CharA, Line), 221 clause_predicate_name(Clause, PredName), 222 !. 223clause_where(false, Clause, _PC, pred_line(PredName, File:Line), _Options) :- 224 clause_property(Clause, file(File)), 225 clause_property(Clause, line_count(Line)), 226 clause_predicate_name(Clause, PredName), 227 !. 228clause_where(false, Clause, _PC, clause_name(ClauseName), _Options) :- 229 clause_name(Clause, ClauseName).
name(A1, ..., A16, <skipped Skipped of Arity>, An)
241copy_goal(0, _, 0) :- !. % 0 is not a valid goal 242copy_goal(D, Fr, Goal) :- 243 prolog_frame_attribute(Fr, goal, Goal0), 244 ( Goal0 = Module:Goal1 245 -> copy_term_limit(D, Goal1, Goal2), 246 ( hidden_module(Module) 247 -> Goal = Goal2 248 ; Goal = Module:Goal2 249 ) 250 ; copy_term_limit(D, Goal0, Goal) 251 ). 252 (system). 254hidden_module(user). 255 256copy_term_limit(0, In, '...') :- 257 compound(In), 258 !. 259copy_term_limit(N, In, Out) :- 260 is_dict(In), 261 !, 262 dict_pairs(In, Tag, PairsIn), 263 N2 is N - 1, 264 MaxArity = 16, 265 copy_pairs(PairsIn, N2, MaxArity, PairsOut), 266 dict_pairs(Out, Tag, PairsOut). 267copy_term_limit(N, In, Out) :- 268 compound(In), 269 !, 270 compound_name_arity(In, Functor, Arity), 271 N2 is N - 1, 272 MaxArity = 16, 273 ( Arity =< MaxArity 274 -> compound_name_arity(Out, Functor, Arity), 275 copy_term_args(0, Arity, N2, In, Out) 276 ; OutArity is MaxArity+2, 277 compound_name_arity(Out, Functor, OutArity), 278 copy_term_args(0, MaxArity, N2, In, Out), 279 SkipArg is MaxArity+1, 280 Skipped is Arity - MaxArity - 1, 281 format(atom(Msg), '<skipped ~D of ~D>', [Skipped, Arity]), 282 arg(SkipArg, Out, Msg), 283 arg(Arity, In, InA), 284 arg(OutArity, Out, OutA), 285 copy_term_limit(N2, InA, OutA) 286 ). 287copy_term_limit(_, In, Out) :- 288 copy_term_nat(In, Out). 289 290copy_term_args(I, Arity, Depth, In, Out) :- 291 I < Arity, 292 !, 293 I2 is I + 1, 294 arg(I2, In, InA), 295 arg(I2, Out, OutA), 296 copy_term_limit(Depth, InA, OutA), 297 copy_term_args(I2, Arity, Depth, In, Out). 298copy_term_args(_, _, _, _, _). 299 300copy_pairs([], _, _, []) :- !. 301copy_pairs(Pairs, _, 0, ['<skipped>'-Skipped]) :- 302 !, 303 length(Pairs, Skipped). 304copy_pairs([K-V0|T0], N, MaxArity, [K-V|T]) :- 305 copy_term_limit(N, V0, V), 306 MaxArity1 is MaxArity - 1, 307 copy_pairs(T0, N, MaxArity1, T).
level(Level)
predicate(PI)
location(File:Line)
320prolog_stack_frame_property(frame(Level,_,_), level(Level)). 321prolog_stack_frame_property(frame(_,Where,_), predicate(PI)) :- 322 frame_predicate(Where, PI). 323prolog_stack_frame_property(frame(_,clause(Clause,PC),_), location(File:Line)) :- 324 subgoal_position(Clause, PC, File, CharA, _CharZ), 325 File \= @(_), % XPCE Object reference 326 lineno(File, CharA, Line). 327prolog_stack_frame_property(frame(_,_,_,Goal), goal(Goal)) :- 328 Goal \== 0. 329 330 331frame_predicate(foreign(PI), PI). 332frame_predicate(call(PI), PI). 333frame_predicate(clause(Clause, _PC), PI) :- 334 clause_property(Clause, PI). 335 336default_backtrace_options(Options) :- 337 ( current_prolog_flag(backtrace_show_lines, true) 338 -> Options = [] 339 ; Options = [subgoal_positions(false)] 340 ).
true
, print subgoal line numbers. The default depends
on the Prolog flag backtrace_show_lines
.354print_prolog_backtrace(Stream, Backtrace) :- 355 print_prolog_backtrace(Stream, Backtrace, []). 356 357print_prolog_backtrace(Stream, Backtrace, Options) :- 358 default_backtrace_options(DefOptions), 359 merge_options(Options, DefOptions, FinalOptions), 360 phrase(message(Backtrace, FinalOptions), Lines), 361 print_message_lines(Stream, '', Lines). 362 363:- public % Called from some handlers 364 message//1. 365 366message(Backtrace) --> 367 {default_backtrace_options(Options)}, 368 message(Backtrace, Options). 369 370message(Backtrace, Options) --> 371 message_frames(Backtrace, Options), 372 warn_nodebug(Backtrace). 373 374message_frames([], _) --> 375 []. 376message_frames([H|T], Options) --> 377 message_frames(H, Options), 378 ( {T == []} 379 -> [] 380 ; [nl], 381 message_frames(T, Options) 382 ). 383 384message_frames(frame(Level, Where, 0), Options) --> 385 !, 386 level(Level), 387 where_no_goal(Where, Options). 388message_frames(frame(Level, _Where, '$toplevel':toplevel_call(_)), _) --> 389 !, 390 level(Level), 391 [ '<user>'-[] ]. 392message_frames(frame(Level, Where, Goal), Options) --> 393 level(Level), 394 [ '~p'-[Goal] ], 395 where_goal(Where, Options). 396 397where_no_goal(foreign(PI), _) --> 398 [ '~w <foreign>'-[PI] ]. 399where_no_goal(call(PI), _) --> 400 [ '~w'-[PI] ]. 401where_no_goal(pred_line(PredName, File:Line), _) --> 402 !, 403 [ '~w at ~w:~d'-[PredName, File, Line] ]. 404where_no_goal(clause_name(ClauseName), _) --> 405 !, 406 [ '~w <no source>'-[ClauseName] ]. 407where_no_goal(clause(Clause, PC), Options) --> 408 { nonvar(Clause), 409 !, 410 clause_where(false, Clause, PC, Where, Options) 411 }, 412 where_no_goal(Where, Options). 413where_no_goal(meta_call, _) --> 414 [ '<meta call>' ]. 415 416where_goal(foreign(_), _) --> 417 [ ' <foreign>'-[] ], 418 !. 419where_goal(pred_line(_PredName, File:Line), _) --> 420 !, 421 [ ' at ~w:~d'-[File, Line] ]. 422where_goal(clause_name(ClauseName), _) --> 423 !, 424 [ '~w <no source>'-[ClauseName] ]. 425where_goal(clause(Clause, PC), Options) --> 426 { nonvar(Clause), 427 !, 428 clause_where(false, Clause, PC, Where, Options) 429 }, 430 where_goal(Where, Options). 431where_goal(clause(Clause, _PC), _) --> 432 { clause_property(Clause, file(File)), 433 clause_property(Clause, line_count(Line)) 434 }, 435 !, 436 [ ' at ~w:~d'-[ File, Line] ]. 437where_goal(clause(Clause, _PC), _) --> 438 { clause_name(Clause, ClauseName) 439 }, 440 !, 441 [ ' ~w <no source>'-[ClauseName] ]. 442where_goal(_, _) --> 443 []. 444 445level(Level) --> 446 [ '~|~t[~D]~6+ '-[Level] ]. 447 448warn_nodebug(Backtrace) --> 449 { contiguous(Backtrace) }, 450 !. 451warn_nodebug(_Backtrace) --> 452 [ nl,nl, 453 'Note: some frames are missing due to last-call optimization.'-[], nl, 454 'Re-run your program in debug mode (:- debug.) to get more detail.'-[] 455 ]. 456 457contiguous([frame(D0,_,_)|Frames]) :- 458 contiguous(Frames, D0). 459 460contiguous([], _). 461contiguous([frame(D1,_,_)|Frames], D0) :- 462 D1 =:= D0-1, 463 contiguous(Frames, D1).
471clause_predicate_name(Clause, PredName) :- 472 user:prolog_clause_name(Clause, PredName), 473 !. 474clause_predicate_name(Clause, PredName) :- 475 nth_clause(Head, _N, Clause), 476 !, 477 predicate_name(user:Head, PredName).
484backtrace(MaxDepth) :- 485 get_prolog_backtrace_lc(MaxDepth, Stack, []), 486 print_prolog_backtrace(user_error, Stack). 487 488 489subgoal_position(ClauseRef, PC, File, CharA, CharZ) :- 490 debug(backtrace, 'Term-position in ~p at PC=~w:', [ClauseRef, PC]), 491 clause_info(ClauseRef, File, TPos, _), 492 '$clause_term_position'(ClauseRef, PC, List), 493 debug(backtrace, '\t~p~n', [List]), 494 find_subgoal(List, TPos, PosTerm), 495 arg(1, PosTerm, CharA), 496 arg(2, PosTerm, CharZ). 497 498find_subgoal([A|T], term_position(_, _, _, _, PosL), SPos) :- 499 is_list(PosL), 500 nth1(A, PosL, Pos), 501 nonvar(Pos), 502 !, 503 find_subgoal(T, Pos, SPos). 504find_subgoal([], Pos, Pos).
513lineno(File, Char, Line) :- 514 setup_call_cleanup( 515 ( prolog_clause:try_open_source(File, Fd), 516 set_stream(Fd, newline(detect)) 517 ), 518 lineno_(Fd, Char, Line), 519 close(Fd)). 520 521lineno_(Fd, Char, L) :- 522 stream_property(Fd, position(Pos)), 523 stream_position_data(char_count, Pos, C), 524 C > Char, 525 !, 526 stream_position_data(line_count, Pos, L0), 527 L is L0-1. 528lineno_(Fd, Char, L) :- 529 skip(Fd, 0'\n), 530 lineno_(Fd, Char, L). 531 532 533 /******************************* 534 * DECORATE ERRORS * 535 *******************************/
none
if the exception is not caught
and with a fully qualified (e.g., Module:Name/Arity) predicate
indicator of the predicate that called catch/3 if the exception
is caught.
The exception is of the form error(Formal, ImplDef)
and this
hook succeeds, ImplDef is unified to a term
context(prolog_stack(StackData), Message)
. This context
information is used by the message printing system to print a
human readable representation of the stack when the exception
was raised.
For example, using a clause stack_guard(none)
prints contexts
for uncaught exceptions only. Using a clause stack_guard(_)
prints a full stack-trace for any error exception if the
exception is given to print_message/2. See also
library(http/http_error)
, which limits printing of exceptions to
exceptions in user-code called from the HTTP server library.
Details of the exception decoration is controlled by two Prolog flags:
true
.571:- multifile 572 user:prolog_exception_hook/4. 573:- dynamic 574 user:prolog_exception_hook/4. 575 576user:prolog_exception_hook(error(E, context(Ctx0,Msg)), 577 error(E, context(prolog_stack(Stack),Msg)), 578 Fr, GuardSpec) :- 579 current_prolog_flag(backtrace, true), 580 \+ is_stack(Ctx0, _Frames), 581 ( atom(GuardSpec) 582 -> debug(backtrace, 'Got uncaught (guard = ~q) exception ~p (Ctx0=~p)', 583 [GuardSpec, E, Ctx0]), 584 stack_guard(GuardSpec), 585 Guard = GuardSpec 586 ; prolog_frame_attribute(GuardSpec, predicate_indicator, Guard), 587 debug(backtrace, 'Got exception ~p (Ctx0=~p, Catcher=~p)', 588 [E, Ctx0, Guard]), 589 stack_guard(Guard) 590 ), 591 ( current_prolog_flag(backtrace_depth, Depth) 592 -> Depth > 0 593 ; Depth = 20 % Thread created before lib was loaded 594 ), 595 get_prolog_backtrace(Depth, Stack0, 596 [ frame(Fr), 597 guard(Guard) 598 ]), 599 debug(backtrace, 'Stack = ~p', [Stack0]), 600 clean_stack(Stack0, Stack1), 601 join_stacks(Ctx0, Stack1, Stack). 602 603clean_stack(List, List) :- 604 stack_guard(X), var(X), 605 !. % Do not stop if we catch all 606clean_stack(List, Clean) :- 607 clean_stack2(List, Clean). 608 609clean_stack2([], []). 610clean_stack2([H|_], [H]) :- 611 guard_frame(H), 612 !. 613clean_stack2([H|T0], [H|T]) :- 614 clean_stack2(T0, T). 615 616guard_frame(frame(_,clause(ClauseRef, _, _))) :- 617 nth_clause(M:Head, _, ClauseRef), 618 functor(Head, Name, Arity), 619 stack_guard(M:Name/Arity). 620 621join_stacks(Ctx0, Stack1, Stack) :- 622 nonvar(Ctx0), 623 Ctx0 = prolog_stack(Stack0), 624 is_list(Stack0), !, 625 append(Stack0, Stack1, Stack). 626join_stacks(_, Stack, Stack).
none
, 'C'
or
the predicate indicator of the guard, the predicate calling
catch/3. The exception must be of compatible with the shape
error(Formal, context(Stack, Msg))
. The default is to catch
none
, uncaught exceptions. 'C'
implies that the callback
from C will handle the exception.638stack_guard(none). 639stack_guard(system:catch_with_backtrace/3). 640 641 642 /******************************* 643 * MESSAGES * 644 *******************************/ 645 646:- multifile 647 prolog:message//1. 648 649prologmessage(error(Error, context(Stack, Message))) --> 650 { Message \== 'DWIM could not correct goal', 651 is_stack(Stack, Frames) 652 }, 653 !, 654 '$messages':translate_message(error(Error, context(_, Message))), 655 [ nl, 'In:', nl ], 656 ( {is_list(Frames)} 657 -> message(Frames) 658 ; ['~w'-[Frames]] 659 ). 660 661is_stack(Stack, Frames) :- 662 nonvar(Stack), 663 Stack = prolog_stack(Frames)
Examine the Prolog stack
This module defines high-level primitives for examining the Prolog stack, primarily intended to support debugging. It provides the following functionality:
This library may be enabled by default to improve interactive debugging, for example by adding the lines below to your
<config>/init.pl
to decorate uncaught exceptions: