35
36:- module(prolog_stack,
37 [ get_prolog_backtrace/2, 38 get_prolog_backtrace/3, 39 prolog_stack_frame_property/2, 40 print_prolog_backtrace/2, 41 print_prolog_backtrace/3, 42 backtrace/1 43 ]). 44:- autoload(library(debug),[debug/3]). 45:- autoload(library(error),[must_be/2]). 46:- autoload(library(lists),[nth1/3,append/3]). 47:- autoload(library(option),[option/2,option/3,merge_options/3]). 48:- autoload(library(prolog_clause),
49 [clause_name/2,predicate_name/2,clause_info/4]). 50
51
52:- dynamic stack_guard/1. 53:- multifile stack_guard/1. 54
55:- predicate_options(print_prolog_backtrace/3, 3,
56 [ subgoal_positions(boolean)
57 ]). 58
88
89:- create_prolog_flag(backtrace, true, [type(boolean), keep(true)]). 90:- create_prolog_flag(backtrace_depth, 20, [type(integer), keep(true)]). 91:- create_prolog_flag(backtrace_goal_depth, 3, [type(integer), keep(true)]). 92:- create_prolog_flag(backtrace_show_lines, true, [type(boolean), keep(true)]). 93
124
125get_prolog_backtrace(MaxDepth, Stack) :-
126 get_prolog_backtrace(MaxDepth, Stack, []).
127
128get_prolog_backtrace(Fr, MaxDepth, Stack) :-
129 integer(Fr), integer(MaxDepth), var(Stack),
130 !,
131 get_prolog_backtrace_lc(MaxDepth, Stack, [frame(Fr)]),
132 nlc.
133get_prolog_backtrace(MaxDepth, Stack, Options) :-
134 get_prolog_backtrace_lc(MaxDepth, Stack, Options),
135 nlc. 136 137 138
139nlc.
140
141get_prolog_backtrace_lc(MaxDepth, Stack, Options) :-
142 ( option(frame(Fr), Options)
143 -> PC = call
144 ; prolog_current_frame(Fr0),
145 prolog_frame_attribute(Fr0, pc, PC),
146 prolog_frame_attribute(Fr0, parent, Fr)
147 ),
148 ( option(goal_term_depth(GoalDepth), Options)
149 -> true
150 ; current_prolog_flag(backtrace_goal_depth, GoalDepth)
151 ),
152 option(guard(Guard), Options, none),
153 ( def_no_clause_refs(Guard)
154 -> DefClauseRefs = false
155 ; DefClauseRefs = true
156 ),
157 option(clause_references(ClauseRefs), Options, DefClauseRefs),
158 must_be(nonneg, GoalDepth),
159 backtrace(MaxDepth, Fr, PC, GoalDepth, Guard, ClauseRefs, Stack, Options).
160
161def_no_clause_refs(system:catch_with_backtrace/3).
162
163backtrace(0, _, _, _, _, _, [], _) :- !.
164backtrace(MaxDepth, Fr, PC, GoalDepth, Guard, ClauseRefs,
165 [frame(Level, Where, Goal)|Stack], Options) :-
166 prolog_frame_attribute(Fr, level, Level),
167 ( PC == foreign
168 -> prolog_frame_attribute(Fr, predicate_indicator, Pred),
169 Where = foreign(Pred)
170 ; PC == call
171 -> prolog_frame_attribute(Fr, predicate_indicator, Pred),
172 Where = call(Pred)
173 ; prolog_frame_attribute(Fr, clause, Clause)
174 -> clause_where(ClauseRefs, Clause, PC, Where, Options)
175 ; Where = meta_call
176 ),
177 ( Where == meta_call
178 -> Goal = 0
179 ; copy_goal(GoalDepth, Fr, Goal)
180 ),
181 ( prolog_frame_attribute(Fr, pc, PC2)
182 -> true
183 ; PC2 = foreign
184 ),
185 ( prolog_frame_attribute(Fr, parent, Parent),
186 prolog_frame_attribute(Parent, predicate_indicator, PI),
187 PI == Guard 188 -> backtrace(1, Parent, PC2, GoalDepth, Guard, ClauseRefs, Stack, Options)
189 ; prolog_frame_attribute(Fr, parent, Parent),
190 more_stack(Parent)
191 -> D2 is MaxDepth - 1,
192 backtrace(D2, Parent, PC2, GoalDepth, Guard, ClauseRefs, Stack, Options)
193 ; Stack = []
194 ).
195
196more_stack(Parent) :-
197 prolog_frame_attribute(Parent, predicate_indicator, PI),
198 \+ ( PI = ('$toplevel':G),
199 G \== (toplevel_call/1)
200 ),
201 !.
202more_stack(_) :-
203 current_prolog_flag(break_level, Break),
204 Break >= 1.
205
216
217clause_where(true, Clause, PC, clause(Clause, PC), _).
218clause_where(false, Clause, PC, pred_line(PredName, File:Line), Options) :-
219 option(subgoal_positions(true), Options, true),
220 subgoal_position(Clause, PC, File, CharA, _CharZ),
221 File \= @(_), 222 lineno(File, CharA, Line),
223 clause_predicate_name(Clause, PredName),
224 !.
225clause_where(false, Clause, _PC, pred_line(PredName, File:Line), _Options) :-
226 clause_property(Clause, file(File)),
227 clause_property(Clause, line_count(Line)),
228 clause_predicate_name(Clause, PredName),
229 !.
230clause_where(false, Clause, _PC, clause_name(ClauseName), _Options) :-
231 clause_name(Clause, ClauseName).
232
242
243copy_goal(0, _, 0) :- !. 244copy_goal(D, Fr, Goal) :-
245 prolog_frame_attribute(Fr, goal, Goal0),
246 ( Goal0 = Module:Goal1
247 -> copy_term_limit(D, Goal1, Goal2),
248 ( hidden_module(Module)
249 -> Goal = Goal2
250 ; Goal = Module:Goal2
251 )
252 ; copy_term_limit(D, Goal0, Goal)
253 ).
254
255hidden_module(system).
256hidden_module(user).
257
258copy_term_limit(0, In, '...') :-
259 compound(In),
260 !.
261copy_term_limit(N, In, Out) :-
262 is_dict(In),
263 !,
264 dict_pairs(In, Tag, PairsIn),
265 N2 is N - 1,
266 MaxArity = 16,
267 copy_pairs(PairsIn, N2, MaxArity, PairsOut),
268 dict_pairs(Out, Tag, PairsOut).
269copy_term_limit(N, In, Out) :-
270 compound(In),
271 !,
272 compound_name_arity(In, Functor, Arity),
273 N2 is N - 1,
274 MaxArity = 16,
275 ( Arity =< MaxArity
276 -> compound_name_arity(Out, Functor, Arity),
277 copy_term_args(0, Arity, N2, In, Out)
278 ; OutArity is MaxArity+2,
279 compound_name_arity(Out, Functor, OutArity),
280 copy_term_args(0, MaxArity, N2, In, Out),
281 SkipArg is MaxArity+1,
282 Skipped is Arity - MaxArity - 1,
283 format(atom(Msg), '<skipped ~D of ~D>', [Skipped, Arity]),
284 arg(SkipArg, Out, Msg),
285 arg(Arity, In, InA),
286 arg(OutArity, Out, OutA),
287 copy_term_limit(N2, InA, OutA)
288 ).
289copy_term_limit(_, In, Out) :-
290 copy_term_nat(In, Out).
291
292copy_term_args(I, Arity, Depth, In, Out) :-
293 I < Arity,
294 !,
295 I2 is I + 1,
296 arg(I2, In, InA),
297 arg(I2, Out, OutA),
298 copy_term_limit(Depth, InA, OutA),
299 copy_term_args(I2, Arity, Depth, In, Out).
300copy_term_args(_, _, _, _, _).
301
302copy_pairs([], _, _, []) :- !.
303copy_pairs(Pairs, _, 0, ['<skipped>'-Skipped]) :-
304 !,
305 length(Pairs, Skipped).
306copy_pairs([K-V0|T0], N, MaxArity, [K-V|T]) :-
307 copy_term_limit(N, V0, V),
308 MaxArity1 is MaxArity - 1,
309 copy_pairs(T0, N, MaxArity1, T).
310
311
321
322prolog_stack_frame_property(frame(Level,_,_), level(Level)).
323prolog_stack_frame_property(frame(_,Where,_), predicate(PI)) :-
324 frame_predicate(Where, PI).
325prolog_stack_frame_property(frame(_,clause(Clause,PC),_), location(File:Line)) :-
326 subgoal_position(Clause, PC, File, CharA, _CharZ),
327 File \= @(_), 328 lineno(File, CharA, Line).
329prolog_stack_frame_property(frame(_,_,_,Goal), goal(Goal)) :-
330 Goal \== 0.
331
332
333frame_predicate(foreign(PI), PI).
334frame_predicate(call(PI), PI).
335frame_predicate(clause(Clause, _PC), PI) :-
336 clause_property(Clause, PI).
337
338default_backtrace_options(Options) :-
339 ( current_prolog_flag(backtrace_show_lines, true)
340 -> Options = []
341 ; Options = [subgoal_positions(false)]
342 ).
343
355
356print_prolog_backtrace(Stream, Backtrace) :-
357 print_prolog_backtrace(Stream, Backtrace, []).
358
359print_prolog_backtrace(Stream, Backtrace, Options) :-
360 default_backtrace_options(DefOptions),
361 merge_options(Options, DefOptions, FinalOptions),
362 phrase(message(Backtrace, FinalOptions), Lines),
363 print_message_lines(Stream, '', Lines).
364
365:- public 366 message//1. 367
368message(Backtrace) -->
369 {default_backtrace_options(Options)},
370 message(Backtrace, Options).
371
372message(Backtrace, Options) -->
373 message_frames(Backtrace, Options),
374 warn_nodebug(Backtrace).
375
376message_frames([], _) -->
377 [].
378message_frames([H|T], Options) -->
379 message_frames(H, Options),
380 ( {T == []}
381 -> []
382 ; [nl],
383 message_frames(T, Options)
384 ).
385
386message_frames(frame(Level, Where, 0), Options) -->
387 !,
388 level(Level),
389 where_no_goal(Where, Options).
390message_frames(frame(Level, _Where, '$toplevel':toplevel_call(_)), _) -->
391 !,
392 level(Level),
393 [ '<user>'-[] ].
394message_frames(frame(Level, Where, Goal), Options) -->
395 level(Level),
396 [ '~p'-[Goal] ],
397 where_goal(Where, Options).
398
399where_no_goal(foreign(PI), _) -->
400 [ '~w <foreign>'-[PI] ].
401where_no_goal(call(PI), _) -->
402 [ '~w'-[PI] ].
403where_no_goal(pred_line(PredName, File:Line), _) -->
404 !,
405 [ '~w at ~w:~d'-[PredName, File, Line] ].
406where_no_goal(clause_name(ClauseName), _) -->
407 !,
408 [ '~w <no source>'-[ClauseName] ].
409where_no_goal(clause(Clause, PC), Options) -->
410 { nonvar(Clause),
411 !,
412 clause_where(false, Clause, PC, Where, Options)
413 },
414 where_no_goal(Where, Options).
415where_no_goal(meta_call, _) -->
416 [ '<meta call>' ].
417
418where_goal(foreign(_), _) -->
419 [ ' <foreign>'-[] ],
420 !.
421where_goal(pred_line(_PredName, File:Line), _) -->
422 !,
423 [ ' at ~w:~d'-[File, Line] ].
424where_goal(clause_name(ClauseName), _) -->
425 !,
426 [ '~w <no source>'-[ClauseName] ].
427where_goal(clause(Clause, PC), Options) -->
428 { nonvar(Clause),
429 !,
430 clause_where(false, Clause, PC, Where, Options)
431 },
432 where_goal(Where, Options).
433where_goal(clause(Clause, _PC), _) -->
434 { clause_property(Clause, file(File)),
435 clause_property(Clause, line_count(Line))
436 },
437 !,
438 [ ' at ~w:~d'-[ File, Line] ].
439where_goal(clause(Clause, _PC), _) -->
440 { clause_name(Clause, ClauseName)
441 },
442 !,
443 [ ' ~w <no source>'-[ClauseName] ].
444where_goal(_, _) -->
445 [].
446
447level(Level) -->
448 [ '~|~t[~D]~6+ '-[Level] ].
449
450warn_nodebug(Backtrace) -->
451 { contiguous(Backtrace) },
452 !.
453warn_nodebug(_Backtrace) -->
454 [ nl,nl,
455 'Note: some frames are missing due to last-call optimization.'-[], nl,
456 'Re-run your program in debug mode (:- debug.) to get more detail.'-[]
457 ].
458
459contiguous([frame(D0,_,_)|Frames]) :-
460 contiguous(Frames, D0).
461
462contiguous([], _).
463contiguous([frame(D1,_,_)|Frames], D0) :-
464 D1 =:= D0-1,
465 contiguous(Frames, D1).
466
467
472
473clause_predicate_name(Clause, PredName) :-
474 user:prolog_clause_name(Clause, PredName),
475 !.
476clause_predicate_name(Clause, PredName) :-
477 nth_clause(Head, _N, Clause),
478 !,
479 predicate_name(user:Head, PredName).
480
481
485
486backtrace(MaxDepth) :-
487 get_prolog_backtrace_lc(MaxDepth, Stack, []),
488 print_prolog_backtrace(user_error, Stack).
489
490
491subgoal_position(ClauseRef, PC, File, CharA, CharZ) :-
492 debug(backtrace, 'Term-position in ~p at PC=~w:', [ClauseRef, PC]),
493 clause_info(ClauseRef, File, TPos, _),
494 '$clause_term_position'(ClauseRef, PC, List),
495 debug(backtrace, '\t~p~n', [List]),
496 find_subgoal(List, TPos, PosTerm),
497 arg(1, PosTerm, CharA),
498 arg(2, PosTerm, CharZ).
499
500find_subgoal([A|T], term_position(_, _, _, _, PosL), SPos) :-
501 is_list(PosL),
502 nth1(A, PosL, Pos),
503 nonvar(Pos),
504 !,
505 find_subgoal(T, Pos, SPos).
506find_subgoal([], Pos, Pos).
507
508
514
515lineno(File, Char, Line) :-
516 setup_call_cleanup(
517 ( prolog_clause:try_open_source(File, Fd),
518 set_stream(Fd, newline(detect))
519 ),
520 lineno_(Fd, Char, Line),
521 close(Fd)).
522
523lineno_(Fd, Char, L) :-
524 stream_property(Fd, position(Pos)),
525 stream_position_data(char_count, Pos, C),
526 C > Char,
527 !,
528 stream_position_data(line_count, Pos, L0),
529 L is L0-1.
530lineno_(Fd, Char, L) :-
531 skip(Fd, 0'\n),
532 lineno_(Fd, Char, L).
533
534
535 538
572
573:- multifile
574 user:prolog_exception_hook/4. 575:- dynamic
576 user:prolog_exception_hook/4. 577
578user:prolog_exception_hook(error(E, context(Ctx0,Msg)),
579 error(E, context(prolog_stack(Stack),Msg)),
580 Fr, GuardSpec) :-
581 current_prolog_flag(backtrace, true),
582 \+ is_stack(Ctx0, _Frames),
583 ( atom(GuardSpec)
584 -> debug(backtrace, 'Got uncaught (guard = ~q) exception ~p (Ctx0=~p)',
585 [GuardSpec, E, Ctx0]),
586 stack_guard(GuardSpec),
587 Guard = GuardSpec
588 ; prolog_frame_attribute(GuardSpec, predicate_indicator, Guard),
589 debug(backtrace, 'Got exception ~p (Ctx0=~p, Catcher=~p)',
590 [E, Ctx0, Guard]),
591 stack_guard(Guard)
592 ),
593 ( current_prolog_flag(backtrace_depth, Depth)
594 -> Depth > 0
595 ; Depth = 20 596 ),
597 get_prolog_backtrace(Depth, Stack0,
598 [ frame(Fr),
599 guard(Guard)
600 ]),
601 debug(backtrace, 'Stack = ~p', [Stack0]),
602 clean_stack(Stack0, Stack1),
603 join_stacks(Ctx0, Stack1, Stack).
604
605clean_stack(List, List) :-
606 stack_guard(X), var(X),
607 !. 608clean_stack(List, Clean) :-
609 clean_stack2(List, Clean).
610
611clean_stack2([], []).
612clean_stack2([H|_], [H]) :-
613 guard_frame(H),
614 !.
615clean_stack2([H|T0], [H|T]) :-
616 clean_stack2(T0, T).
617
618guard_frame(frame(_,clause(ClauseRef, _, _))) :-
619 nth_clause(M:Head, _, ClauseRef),
620 functor(Head, Name, Arity),
621 stack_guard(M:Name/Arity).
622
623join_stacks(Ctx0, Stack1, Stack) :-
624 nonvar(Ctx0),
625 Ctx0 = prolog_stack(Stack0),
626 is_list(Stack0), !,
627 append(Stack0, Stack1, Stack).
628join_stacks(_, Stack, Stack).
629
630
639
640stack_guard(none).
641stack_guard(system:catch_with_backtrace/3).
642
643
644 647
648:- multifile
649 prolog:message//1. 650
651prolog:message(error(Error, context(Stack, Message))) -->
652 { Message \== 'DWIM could not correct goal',
653 is_stack(Stack, Frames)
654 },
655 !,
656 '$messages':translate_message(error(Error, context(_, Message))),
657 [ nl, 'In:', nl ],
658 ( {is_list(Frames)}
659 -> message(Frames)
660 ; ['~w'-[Frames]]
661 ).
662
663is_stack(Stack, Frames) :-
664 nonvar(Stack),
665 Stack = prolog_stack(Frames)