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:- 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 ]). 56
86
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)]). 91
116
117get_prolog_backtrace(MaxDepth, Stack) :-
118 get_prolog_backtrace(MaxDepth, Stack, []).
119
120get_prolog_backtrace(Fr, MaxDepth, Stack) :-
121 integer(Fr), integer(MaxDepth), var(Stack),
122 !,
123 get_prolog_backtrace_lc(MaxDepth, Stack, [frame(Fr)]),
124 nlc.
125get_prolog_backtrace(MaxDepth, Stack, Options) :-
126 get_prolog_backtrace_lc(MaxDepth, Stack, Options),
127 nlc. 128 129 130
131nlc.
132
133get_prolog_backtrace_lc(MaxDepth, Stack, Options) :-
134 ( option(frame(Fr), Options)
135 -> PC = call
136 ; prolog_current_frame(Fr0),
137 prolog_frame_attribute(Fr0, pc, PC),
138 prolog_frame_attribute(Fr0, parent, Fr)
139 ),
140 ( option(goal_term_depth(GoalDepth), Options)
141 -> true
142 ; current_prolog_flag(backtrace_goal_depth, GoalDepth)
143 ),
144 must_be(nonneg, GoalDepth),
145 backtrace(MaxDepth, Fr, PC, GoalDepth, Stack).
146
147backtrace(0, _, _, _, []) :- !.
148backtrace(MaxDepth, Fr, PC, GoalDepth,
149 [frame(Level, Where, Goal)|Stack]) :-
150 prolog_frame_attribute(Fr, level, Level),
151 ( PC == foreign
152 -> prolog_frame_attribute(Fr, predicate_indicator, Pred),
153 Where = foreign(Pred)
154 ; PC == call
155 -> prolog_frame_attribute(Fr, predicate_indicator, Pred),
156 Where = call(Pred)
157 ; prolog_frame_attribute(Fr, clause, Clause)
158 -> Where = clause(Clause, PC)
159 ; Where = meta_call
160 ),
161 ( Where == meta_call
162 -> Goal = 0
163 ; copy_goal(GoalDepth, Fr, Goal)
164 ),
165 ( prolog_frame_attribute(Fr, pc, PC2)
166 -> true
167 ; PC2 = foreign
168 ),
169 ( prolog_frame_attribute(Fr, parent, Parent),
170 more_stack(Parent)
171 -> D2 is MaxDepth - 1,
172 backtrace(D2, Parent, PC2, GoalDepth, Stack)
173 ; Stack = []
174 ).
175
176more_stack(Parent) :-
177 prolog_frame_attribute(Parent, predicate_indicator, PI),
178 \+ ( PI = '$toplevel':G,
179 G \== (toplevel_call/1)
180 ),
181 !.
182more_stack(_) :-
183 current_prolog_flag(break_level, Break),
184 Break >= 1.
185
195
196copy_goal(0, _, 0) :- !. 197copy_goal(D, Fr, Goal) :-
198 prolog_frame_attribute(Fr, goal, Goal0),
199 ( Goal0 = Module:Goal1
200 -> copy_term_limit(D, Goal1, Goal2),
201 ( hidden_module(Module)
202 -> Goal = Goal2
203 ; Goal = Module:Goal2
204 )
205 ; copy_term_limit(D, Goal0, Goal)
206 ).
207
208hidden_module(system).
209hidden_module(user).
210
211copy_term_limit(0, In, '...') :-
212 compound(In),
213 !.
214copy_term_limit(N, In, Out) :-
215 is_dict(In),
216 !,
217 dict_pairs(In, Tag, PairsIn),
218 N2 is N - 1,
219 MaxArity = 16,
220 copy_pairs(PairsIn, N2, MaxArity, PairsOut),
221 dict_pairs(Out, Tag, PairsOut).
222copy_term_limit(N, In, Out) :-
223 compound(In),
224 !,
225 compound_name_arity(In, Functor, Arity),
226 N2 is N - 1,
227 MaxArity = 16,
228 ( Arity =< MaxArity
229 -> compound_name_arity(Out, Functor, Arity),
230 copy_term_args(0, Arity, N2, In, Out)
231 ; OutArity is MaxArity+2,
232 compound_name_arity(Out, Functor, OutArity),
233 copy_term_args(0, MaxArity, N2, In, Out),
234 SkipArg is MaxArity+1,
235 Skipped is Arity - MaxArity - 1,
236 format(atom(Msg), '<skipped ~D of ~D>', [Skipped, Arity]),
237 arg(SkipArg, Out, Msg),
238 arg(Arity, In, InA),
239 arg(OutArity, Out, OutA),
240 copy_term_limit(N2, InA, OutA)
241 ).
242copy_term_limit(_, In, Out) :-
243 copy_term_nat(In, Out).
244
245copy_term_args(I, Arity, Depth, In, Out) :-
246 I < Arity,
247 !,
248 I2 is I + 1,
249 arg(I2, In, InA),
250 arg(I2, Out, OutA),
251 copy_term_limit(Depth, InA, OutA),
252 copy_term_args(I2, Arity, Depth, In, Out).
253copy_term_args(_, _, _, _, _).
254
255copy_pairs([], _, _, []) :- !.
256copy_pairs(Pairs, _, 0, ['<skipped>'-Skipped]) :-
257 !,
258 length(Pairs, Skipped).
259copy_pairs([K-V0|T0], N, MaxArity, [K-V|T]) :-
260 copy_term_limit(N, V0, V),
261 MaxArity1 is MaxArity - 1,
262 copy_pairs(T0, N, MaxArity1, T).
263
264
274
275prolog_stack_frame_property(frame(Level,_,_), level(Level)).
276prolog_stack_frame_property(frame(_,Where,_), predicate(PI)) :-
277 frame_predicate(Where, PI).
278prolog_stack_frame_property(frame(_,clause(Clause,PC),_), location(File:Line)) :-
279 subgoal_position(Clause, PC, File, CharA, _CharZ),
280 File \= @(_), 281 lineno(File, CharA, Line).
282prolog_stack_frame_property(frame(_,_,_,Goal), goal(Goal)) :-
283 Goal \== 0.
284
285
286frame_predicate(foreign(PI), PI).
287frame_predicate(call(PI), PI).
288frame_predicate(clause(Clause, _PC), PI) :-
289 clause_property(Clause, PI).
290
291default_backtrace_options(Options) :-
292 ( current_prolog_flag(backtrace_show_lines, true)
293 -> Options = []
294 ; Options = [subgoal_positions(false)]
295 ).
296
308
309print_prolog_backtrace(Stream, Backtrace) :-
310 print_prolog_backtrace(Stream, Backtrace, []).
311
312print_prolog_backtrace(Stream, Backtrace, Options) :-
313 default_backtrace_options(DefOptions),
314 merge_options(Options, DefOptions, FinalOptions),
315 phrase(message(Backtrace, FinalOptions), Lines),
316 print_message_lines(Stream, '', Lines).
317
318:- public 319 message//1. 320
321message(Backtrace) -->
322 {default_backtrace_options(Options)},
323 message(Backtrace, Options).
324
325message(Backtrace, Options) -->
326 message_frames(Backtrace, Options),
327 warn_nodebug(Backtrace).
328
329message_frames([], _) -->
330 [].
331message_frames([H|T], Options) -->
332 message_frames(H, Options),
333 ( {T == []}
334 -> []
335 ; [nl],
336 message_frames(T, Options)
337 ).
338
339message_frames(frame(Level, Where, 0), Options) -->
340 !,
341 level(Level),
342 where_no_goal(Where, Options).
343message_frames(frame(Level, _Where, '$toplevel':toplevel_call(_)), _) -->
344 !,
345 level(Level),
346 [ '<user>'-[] ].
347message_frames(frame(Level, Where, Goal), Options) -->
348 level(Level),
349 [ '~q'-[Goal] ],
350 where_goal(Where, Options).
351
352where_no_goal(foreign(PI), _) -->
353 [ '~w <foreign>'-[PI] ].
354where_no_goal(call(PI), _) -->
355 [ '~w'-[PI] ].
356where_no_goal(clause(Clause, PC), Options) -->
357 { option(subgoal_positions(true), Options, true),
358 subgoal_position(Clause, PC, File, CharA, _CharZ),
359 File \= @(_), 360 lineno(File, CharA, Line),
361 clause_predicate_name(Clause, PredName)
362 },
363 !,
364 [ '~w at ~w:~d'-[PredName, File, Line] ].
365where_no_goal(clause(Clause, _PC), _) -->
366 { clause_property(Clause, file(File)),
367 clause_property(Clause, line_count(Line)),
368 clause_predicate_name(Clause, PredName)
369 },
370 !,
371 [ '~w at ~w:~d'-[PredName, File, Line] ].
372where_no_goal(clause(Clause, _PC), _) -->
373 { clause_name(Clause, ClauseName)
374 },
375 [ '~w <no source>'-[ClauseName] ].
376where_no_goal(meta_call, _) -->
377 [ '<meta call>' ].
378
379where_goal(foreign(_), _) -->
380 [ ' <foreign>'-[] ],
381 !.
382where_goal(clause(Clause, PC), Options) -->
383 { option(subgoal_positions(true), Options, true),
384 subgoal_position(Clause, PC, File, CharA, _CharZ),
385 File \= @(_), 386 lineno(File, CharA, Line)
387 },
388 !,
389 [ ' at ~w:~d'-[File, Line] ].
390where_goal(clause(Clause, _PC), _) -->
391 { clause_property(Clause, file(File)),
392 clause_property(Clause, line_count(Line))
393 },
394 !,
395 [ ' at ~w:~d'-[ File, Line] ].
396where_goal(clause(Clause, _PC), _) -->
397 { clause_name(Clause, ClauseName)
398 },
399 !,
400 [ ' ~w <no source>'-[ClauseName] ].
401where_goal(_, _) -->
402 [].
403
404level(Level) -->
405 [ '~|~t[~D]~6+ '-[Level] ].
406
407warn_nodebug(Backtrace) -->
408 { contiguous(Backtrace) },
409 !.
410warn_nodebug(_Backtrace) -->
411 [ nl,nl,
412 'Note: some frames are missing due to last-call optimization.'-[], nl,
413 'Re-run your program in debug mode (:- debug.) to get more detail.'-[]
414 ].
415
416contiguous([frame(D0,_,_)|Frames]) :-
417 contiguous(Frames, D0).
418
419contiguous([], _).
420contiguous([frame(D1,_,_)|Frames], D0) :-
421 D1 =:= D0-1,
422 contiguous(Frames, D1).
423
424
429
430clause_predicate_name(Clause, PredName) :-
431 user:prolog_clause_name(Clause, PredName),
432 !.
433clause_predicate_name(Clause, PredName) :-
434 nth_clause(Head, _N, Clause),
435 !,
436 predicate_name(user:Head, PredName).
437
438
442
443backtrace(MaxDepth) :-
444 get_prolog_backtrace_lc(MaxDepth, Stack, []),
445 print_prolog_backtrace(user_error, Stack).
446
447
448subgoal_position(ClauseRef, PC, File, CharA, CharZ) :-
449 debug(backtrace, 'Term-position in ~p at PC=~w:', [ClauseRef, PC]),
450 clause_info(ClauseRef, File, TPos, _),
451 '$clause_term_position'(ClauseRef, PC, List),
452 debug(backtrace, '\t~p~n', [List]),
453 find_subgoal(List, TPos, PosTerm),
454 arg(1, PosTerm, CharA),
455 arg(2, PosTerm, CharZ).
456
457find_subgoal([A|T], term_position(_, _, _, _, PosL), SPos) :-
458 is_list(PosL),
459 nth1(A, PosL, Pos),
460 nonvar(Pos),
461 !,
462 find_subgoal(T, Pos, SPos).
463find_subgoal([], Pos, Pos).
464
465
469
470lineno(File, Char, Line) :-
471 setup_call_cleanup(
472 ( open(File, read, Fd),
473 set_stream(Fd, newline(detect))
474 ),
475 lineno_(Fd, Char, Line),
476 close(Fd)).
477
478lineno_(Fd, Char, L) :-
479 stream_property(Fd, position(Pos)),
480 stream_position_data(char_count, Pos, C),
481 C > Char,
482 !,
483 stream_position_data(line_count, Pos, L0),
484 L is L0-1.
485lineno_(Fd, Char, L) :-
486 skip(Fd, 0'\n),
487 lineno_(Fd, Char, L).
488
489
490 493
527
528:- multifile
529 user:prolog_exception_hook/4. 530:- dynamic
531 user:prolog_exception_hook/4. 532
533user:prolog_exception_hook(error(E, context(Ctx0,Msg)),
534 error(E, context(prolog_stack(Stack),Msg)),
535 Fr, Guard) :-
536 current_prolog_flag(backtrace, true),
537 ( atom(Guard)
538 -> debug(backtrace, 'Got uncaught (guard = ~q) exception ~p (Ctx0=~p)',
539 [Guard, E, Ctx0]),
540 stack_guard(Guard)
541 ; prolog_frame_attribute(Guard, predicate_indicator, PI),
542 debug(backtrace, 'Got exception ~p (Ctx0=~p, Catcher=~p)',
543 [E, Ctx0, PI]),
544 stack_guard(PI)
545 ),
546 ( current_prolog_flag(backtrace_depth, Depth)
547 -> Depth > 0
548 ; Depth = 20 549 ),
550 get_prolog_backtrace(Fr, Depth, Stack0),
551 debug(backtrace, 'Stack = ~p', [Stack0]),
552 clean_stack(Stack0, Stack1),
553 join_stacks(Ctx0, Stack1, Stack).
554
555clean_stack(List, List) :-
556 stack_guard(X), var(X),
557 !. 558clean_stack(List, Clean) :-
559 clean_stack2(List, Clean).
560
561clean_stack2([], []).
562clean_stack2([H|_], [H]) :-
563 guard_frame(H),
564 !.
565clean_stack2([H|T0], [H|T]) :-
566 clean_stack2(T0, T).
567
568guard_frame(frame(_,clause(ClauseRef, _, _))) :-
569 nth_clause(M:Head, _, ClauseRef),
570 functor(Head, Name, Arity),
571 stack_guard(M:Name/Arity).
572
573join_stacks(Ctx0, Stack1, Stack) :-
574 nonvar(Ctx0),
575 Ctx0 = prolog_stack(Stack0),
576 is_list(Stack0), !,
577 append(Stack0, Stack1, Stack).
578join_stacks(_, Stack, Stack).
579
580
589
590stack_guard(none).
591
592
593 596
597:- multifile
598 prolog:message//1. 599
600prolog:message(error(Error, context(Stack, Message))) -->
601 { Message \== 'DWIM could not correct goal',
602 is_stack(Stack, Frames)
603 },
604 !,
605 '$messages':translate_message(error(Error, context(_, Message))),
606 [ nl, 'In:', nl ],
607 ( {is_list(Frames)}
608 -> message(Frames)
609 ; ['~w'-[Frames]]
610 ).
611
612is_stack(Stack, Frames) :-
613 nonvar(Stack),
614 Stack = prolog_stack(Frames)