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-2021, University of Amsterdam
    7                              VU University Amsterdam
    8                              SWI-Prolog Solutions b.v.
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(prolog_stack,
   38          [ get_prolog_backtrace/2,     % +MaxDepth, -Stack
   39            get_prolog_backtrace/3,     % +MaxDepth, -Stack, +Options
   40            prolog_stack_frame_property/2, % +Frame, ?Property
   41            print_prolog_backtrace/2,   % +Stream, +Stack
   42            print_prolog_backtrace/3,   % +Stream, +Stack, +Options
   43            backtrace/1,                % +MaxDepth
   44            print_last_choicepoint/0,
   45            print_last_choicepoint/2    % +Choice, +Options
   46          ]).   47:- use_module(library(debug),[debug/3]).   48:- autoload(library(error),[must_be/2]).   49:- autoload(library(lists),[nth1/3,append/3]).   50:- autoload(library(option),[option/2,option/3,merge_options/3]).   51:- autoload(library(prolog_clause),
   52	    [clause_name/2,predicate_name/2,clause_info/4]).   53
   54
   55:- dynamic stack_guard/1.   56:- multifile stack_guard/1.   57
   58:- predicate_options(print_prolog_backtrace/3, 3,
   59                     [ subgoal_positions(boolean)
   60                     ]).   61
   62/** <module> Examine the Prolog stack
   63
   64This module defines  high-level  primitives   for  examining  the Prolog
   65stack,  primarily  intended  to  support   debugging.  It  provides  the
   66following functionality:
   67
   68    * get_prolog_backtrace/2 gets a Prolog representation of the
   69    Prolog stack.  This can be used for printing, but also to enrich
   70    exceptions using prolog:prolog_exception_hook/5.  Decorating exceptions
   71    is provided by this library and controlled by the hook
   72    stack_guard/1.
   73
   74    * print_prolog_backtrace/2 prints a backtrace as returned by
   75    get_prolog_backtrace/2
   76
   77    * The shorthand backtrace/1 fetches and prints a backtrace.
   78
   79This library may be enabled by default to improve interactive debugging,
   80for example by adding the lines   below  to your ``<config>/init.pl`` to
   81decorate uncaught exceptions:
   82
   83  ==
   84  :- use_module(library(prolog_stack)).
   85  ==
   86
   87@bug    Use of this library may negatively impact performance of
   88        applications that process (error-)exceptions frequently
   89        as part of their normal processing.
   90*/
   91
   92:- create_prolog_flag(backtrace,            true, [type(boolean), keep(true)]).   93:- create_prolog_flag(backtrace_depth,      20,   [type(integer), keep(true)]).   94:- create_prolog_flag(backtrace_goal_depth, 3,    [type(integer), keep(true)]).   95:- create_prolog_flag(backtrace_show_lines, true, [type(boolean), keep(true)]).   96
   97%!  get_prolog_backtrace(+MaxDepth, -Backtrace) is det.
   98%!  get_prolog_backtrace(+MaxDepth, -Backtrace, +Options) is det.
   99%
  100%   Obtain a backtrace from the current location. The backtrace is a
  101%   list of frames. Each  frame  is  an   opaque  term  that  can be
  102%   inspected using the predicate  prolog_stack_frame_property/2 can
  103%   be used to extract  information  from   these  frames.  Most use
  104%   scenarios will pass the stack   to print_prolog_backtrace/2. The
  105%   following options are provided:
  106%
  107%     * frame(+Frame)
  108%     Start at Frame instead of the current frame.
  109%     * goal_term_depth(+Depth)
  110%     If Depth > 0, include a shallow copy of the goal arguments
  111%     into the stack.  Default is set by the Prolog flag
  112%     `backtrace_goal_depth`, set to `3` initially, showing the
  113%     goal and toplevel of any argument.
  114%     * guard(+Guard)
  115%     Do not show stack frames above Guard.  See stack_guard/1.
  116%     * clause_references(+Bool)
  117%     Report locations as `Clause+PC` or as a location term that
  118%     does not use clause references, allowing the exception to
  119%     be printed safely in a different context.
  120%
  121%   @param Frame is the frame to start from. See prolog_current_frame/1.
  122%   @param MaxDepth defines the maximum number of frames returned.
  123%   @compat get_prolog_backtrace/3 used to have the parameters
  124%   +Frame, +MaxDepth, -Backtrace. A call that matches this
  125%   signature is mapped to get_prolog_backtrace(MaxDepth, Backtrace,
  126%   [frame(Frame)]).
  127
  128get_prolog_backtrace(MaxDepth, Stack) :-
  129    get_prolog_backtrace(MaxDepth, Stack, []).
  130
  131get_prolog_backtrace(Fr, MaxDepth, Stack) :-
  132    integer(Fr), integer(MaxDepth), var(Stack),
  133    !,
  134    get_prolog_backtrace_lc(MaxDepth, Stack, [frame(Fr)]),
  135    nlc.
  136get_prolog_backtrace(MaxDepth, Stack, Options) :-
  137    get_prolog_backtrace_lc(MaxDepth, Stack, Options),
  138    nlc.            % avoid last-call-optimization, such that
  139                        % the top of the stack is always a nice Prolog
  140                        % frame
  141
  142nlc.
  143
  144get_prolog_backtrace_lc(MaxDepth, Stack, Options) :-
  145    (   option(frame(Fr), Options)
  146    ->  PC = call
  147    ;   prolog_current_frame(Fr0),
  148        prolog_frame_attribute(Fr0, pc, PC),
  149        prolog_frame_attribute(Fr0, parent, Fr)
  150    ),
  151    (   option(goal_term_depth(GoalDepth), Options)
  152    ->  true
  153    ;   current_prolog_flag(backtrace_goal_depth, GoalDepth)
  154    ),
  155    option(guard(Guard), Options, none),
  156    (   def_no_clause_refs(Guard)
  157    ->  DefClauseRefs = false
  158    ;   DefClauseRefs = true
  159    ),
  160    option(clause_references(ClauseRefs), Options, DefClauseRefs),
  161    must_be(nonneg, GoalDepth),
  162    backtrace(MaxDepth, Fr, PC, GoalDepth, Guard, ClauseRefs, Stack, Options).
  163
  164def_no_clause_refs(system:catch_with_backtrace/3).
  165
  166backtrace(0, _, _, _, _, _, [], _) :- !.
  167backtrace(MaxDepth, Fr, PC, GoalDepth, Guard, ClauseRefs,
  168          [frame(Level, Where, Goal)|Stack], Options) :-
  169    prolog_frame_attribute(Fr, level, Level),
  170    (   PC == foreign
  171    ->  prolog_frame_attribute(Fr, predicate_indicator, Pred),
  172        Where = foreign(Pred)
  173    ;   PC == call
  174    ->  prolog_frame_attribute(Fr, predicate_indicator, Pred),
  175        Where = call(Pred)
  176    ;   prolog_frame_attribute(Fr, clause, Clause)
  177    ->  clause_where(ClauseRefs, Clause, PC, Where, Options)
  178    ;   Where = meta_call
  179    ),
  180    (   Where == meta_call
  181    ->  Goal = 0
  182    ;   copy_goal(GoalDepth, Fr, Goal)
  183    ),
  184    (   prolog_frame_attribute(Fr, pc, PC2)
  185    ->  true
  186    ;   PC2 = foreign
  187    ),
  188    (   prolog_frame_attribute(Fr, parent, Parent),
  189        prolog_frame_attribute(Parent, predicate_indicator, PI),
  190        PI == Guard                             % last frame
  191    ->  backtrace(1, Parent, PC2, GoalDepth, Guard, ClauseRefs, Stack, Options)
  192    ;   prolog_frame_attribute(Fr, parent, Parent),
  193        more_stack(Parent)
  194    ->  D2 is MaxDepth - 1,
  195        backtrace(D2, Parent, PC2, GoalDepth, Guard, ClauseRefs, Stack, Options)
  196    ;   Stack = []
  197    ).
  198
  199more_stack(Parent) :-
  200    prolog_frame_attribute(Parent, predicate_indicator, PI),
  201    \+ (   PI = ('$toplevel':G),
  202           G \== (toplevel_call/1)
  203       ),
  204    !.
  205more_stack(_) :-
  206    current_prolog_flag(break_level, Break),
  207    Break >= 1.
  208
  209%!  clause_where(+UseClauseRef, +Clause, +PC, -Where, +Options) is det.
  210%
  211%   Get a description of the frame source   location from Clause and the
  212%   PC inside clause. If UseClauseRef is  `true`,   this  is  the a term
  213%   clause(Clause,PC),  providing  all  abvailable  information  to  the
  214%   caller at low time overhead. If  however   the  exception need to be
  215%   printed in an environment where the   clause  references may differ,
  216%   for example because the program is not   loaded,  it is printed in a
  217%   different thread and contains references to dynamic predicates, etc,
  218%   it is better to use the information inside the clause here.
  219
  220clause_where(true, Clause, PC, clause(Clause, PC), _).
  221clause_where(false, Clause, PC, pred_line(PredName, File:Line), Options) :-
  222    option(subgoal_positions(true), Options, true),
  223    subgoal_position(Clause, PC, File, CharA, _CharZ),
  224    File \= @(_),                 % XPCE Object reference
  225    lineno(File, CharA, Line),
  226    clause_predicate_name(Clause, PredName),
  227    !.
  228clause_where(false, Clause, _PC, pred_line(PredName, File:Line), _Options) :-
  229    clause_property(Clause, file(File)),
  230    clause_property(Clause, line_count(Line)),
  231    clause_predicate_name(Clause, PredName),
  232    !.
  233clause_where(false, Clause, _PC, clause_name(ClauseName), _Options) :-
  234    clause_name(Clause, ClauseName).
  235
  236%!  copy_goal(+TermDepth, +Frame, -Goal) is det.
  237%
  238%   Create a shallow copy of the frame's  goal to help debugging. In
  239%   addition to shallow copying, high-arity   terms  are represented
  240%   as below.  Currently the 16 first arguments are hardcoded.
  241%
  242%     ==
  243%     name(A1, ..., A16, <skipped Skipped of Arity>, An)
  244%     ==
  245
  246copy_goal(0, _, 0) :- !.                        % 0 is not a valid goal
  247copy_goal(D, Fr, Goal) :-
  248    prolog_frame_attribute(Fr, goal, Goal0),
  249    (   Goal0 = Module:Goal1
  250    ->  copy_term_limit(D, Goal1, Goal2),
  251        (   hidden_module(Module)
  252        ->  Goal = Goal2
  253        ;   Goal = Module:Goal2
  254        )
  255    ;   copy_term_limit(D, Goal0, Goal)
  256    ).
  257
  258hidden_module(system).
  259hidden_module(user).
  260
  261copy_term_limit(0, In, '...') :-
  262    compound(In),
  263    !.
  264copy_term_limit(N, In, Out) :-
  265    is_dict(In),
  266    !,
  267    dict_pairs(In, Tag, PairsIn),
  268    N2 is N - 1,
  269    MaxArity = 16,
  270    copy_pairs(PairsIn, N2, MaxArity, PairsOut),
  271    dict_pairs(Out, Tag, PairsOut).
  272copy_term_limit(N, In, Out) :-
  273    compound(In),
  274    !,
  275    compound_name_arity(In, Functor, Arity),
  276    N2 is N - 1,
  277    MaxArity = 16,
  278    (   Arity =< MaxArity
  279    ->  compound_name_arity(Out, Functor, Arity),
  280        copy_term_args(0, Arity, N2, In, Out)
  281    ;   OutArity is MaxArity+2,
  282        compound_name_arity(Out, Functor, OutArity),
  283        copy_term_args(0, MaxArity, N2, In, Out),
  284        SkipArg is MaxArity+1,
  285        Skipped is Arity - MaxArity - 1,
  286        format(atom(Msg), '<skipped ~D of ~D>', [Skipped, Arity]),
  287        arg(SkipArg, Out, Msg),
  288        arg(Arity, In, InA),
  289        arg(OutArity, Out, OutA),
  290        copy_term_limit(N2, InA, OutA)
  291    ).
  292copy_term_limit(_, In, Out) :-
  293    copy_term_nat(In, Out).
  294
  295copy_term_args(I, Arity, Depth, In, Out) :-
  296    I < Arity,
  297    !,
  298    I2 is I + 1,
  299    arg(I2, In, InA),
  300    arg(I2, Out, OutA),
  301    copy_term_limit(Depth, InA, OutA),
  302    copy_term_args(I2, Arity, Depth, In, Out).
  303copy_term_args(_, _, _, _, _).
  304
  305copy_pairs([], _, _, []) :- !.
  306copy_pairs(Pairs, _, 0, ['<skipped>'-Skipped]) :-
  307    !,
  308    length(Pairs, Skipped).
  309copy_pairs([K-V0|T0], N, MaxArity, [K-V|T]) :-
  310    copy_term_limit(N, V0, V),
  311    MaxArity1 is MaxArity - 1,
  312    copy_pairs(T0, N, MaxArity1, T).
  313
  314
  315%!  prolog_stack_frame_property(+Frame, ?Property) is nondet.
  316%
  317%   True when Property is a property of   Frame. Frame is an element
  318%   of a stack-trace as produced by get_prolog_backtrace/2.  Defined
  319%   properties are:
  320%
  321%     * level(Level)
  322%     * predicate(PI)
  323%     * location(File:Line)
  324
  325prolog_stack_frame_property(frame(Level,_,_), level(Level)).
  326prolog_stack_frame_property(frame(_,Where,_), predicate(PI)) :-
  327    frame_predicate(Where, PI).
  328prolog_stack_frame_property(frame(_,clause(Clause,PC),_), location(File:Line)) :-
  329    subgoal_position(Clause, PC, File, CharA, _CharZ),
  330    File \= @(_),                   % XPCE Object reference
  331    lineno(File, CharA, Line).
  332prolog_stack_frame_property(frame(_,_,_,Goal), goal(Goal)) :-
  333    Goal \== 0.
  334
  335
  336frame_predicate(foreign(PI), PI).
  337frame_predicate(call(PI), PI).
  338frame_predicate(clause(Clause, _PC), PI) :-
  339    clause_property(Clause, predicate(PI)).
  340
  341default_backtrace_options(Options) :-
  342    (   current_prolog_flag(backtrace_show_lines, true),
  343        current_prolog_flag(iso, false)
  344    ->  Options = []
  345    ;   Options = [subgoal_positions(false)]
  346    ).
  347
  348%!  print_prolog_backtrace(+Stream, +Backtrace) is det.
  349%!  print_prolog_backtrace(+Stream, +Backtrace, +Options) is det.
  350%
  351%   Print a stacktrace in human readable form to Stream.
  352%   Options is an option list that accepts:
  353%
  354%       * subgoal_positions(+Boolean)
  355%       If =true=, print subgoal line numbers.  The default depends
  356%       on the Prolog flag =backtrace_show_lines=.
  357%
  358%   @arg Backtrace is a list of frame(Depth,Location,Goal) terms.
  359
  360print_prolog_backtrace(Stream, Backtrace) :-
  361    print_prolog_backtrace(Stream, Backtrace, []).
  362
  363print_prolog_backtrace(Stream, Backtrace, Options) :-
  364    default_backtrace_options(DefOptions),
  365    merge_options(Options, DefOptions, FinalOptions),
  366    phrase(message(Backtrace, FinalOptions), Lines),
  367    print_message_lines(Stream, '', Lines).
  368
  369:- public                               % Called from some handlers
  370    message//1.  371
  372message(Backtrace) -->
  373    {default_backtrace_options(Options)},
  374    message(Backtrace, Options).
  375
  376message(Backtrace, Options) -->
  377    message_frames(Backtrace, Options),
  378    warn_nodebug(Backtrace).
  379
  380message_frames([], _) -->
  381    [].
  382message_frames([H|T], Options) -->
  383    message_frames(H, Options),
  384    (   {T == []}
  385    ->  []
  386    ;   [nl],
  387        message_frames(T, Options)
  388    ).
  389
  390message_frames(frame(Level, Where, 0), Options) -->
  391    !,
  392    level(Level),
  393    where_no_goal(Where, Options).
  394message_frames(frame(Level, _Where, '$toplevel':toplevel_call(_)), _) -->
  395    !,
  396    level(Level),
  397    [ '<user>'-[] ].
  398message_frames(frame(Level, Where, Goal), Options) -->
  399    level(Level),
  400    [ ansi(code, '~p', [Goal]) ],
  401    where_goal(Where, Options).
  402
  403where_no_goal(foreign(PI), _) -->
  404    [ '~w <foreign>'-[PI] ].
  405where_no_goal(call(PI), _) -->
  406    [ '~w'-[PI] ].
  407where_no_goal(pred_line(PredName, File:Line), _) -->
  408    !,
  409    [ '~w at '-[PredName], url(File:Line) ].
  410where_no_goal(clause_name(ClauseName), _) -->
  411    !,
  412    [ '~w <no source>'-[ClauseName] ].
  413where_no_goal(clause(Clause, PC), Options) -->
  414    { nonvar(Clause),
  415      !,
  416      clause_where(false, Clause, PC, Where, Options)
  417    },
  418    where_no_goal(Where, Options).
  419where_no_goal(meta_call, _) -->
  420    [ '<meta call>' ].
  421
  422where_goal(foreign(_), _) -->
  423    [ ' <foreign>'-[] ],
  424    !.
  425where_goal(pred_line(_PredName, File:Line), _) -->
  426    !,
  427    [ ' at ', url(File:Line) ].
  428where_goal(clause_name(ClauseName), _) -->
  429    !,
  430    [ '~w <no source>'-[ClauseName] ].
  431where_goal(clause(Clause, PC), Options) -->
  432    { nonvar(Clause),
  433      !,
  434      clause_where(false, Clause, PC, Where, Options)
  435    },
  436    where_goal(Where, Options).
  437where_goal(clause(Clause, _PC), _) -->
  438    { clause_property(Clause, file(File)),
  439      clause_property(Clause, line_count(Line))
  440    },
  441    !,
  442    [ ' at ', url(File:Line) ].
  443where_goal(clause(Clause, _PC), _) -->
  444    { clause_name(Clause, ClauseName)
  445    },
  446    !,
  447    [ ' ~w <no source>'-[ClauseName] ].
  448where_goal(_, _) -->
  449    [].
  450
  451level(Level) -->
  452    [ '~|~t[~D]~6+ '-[Level] ].
  453
  454warn_nodebug(Backtrace) -->
  455    { contiguous(Backtrace) },
  456    !.
  457warn_nodebug(_Backtrace) -->
  458    [ nl,nl,
  459      'Note: some frames are missing due to last-call optimization.'-[], nl,
  460      'Re-run your program in debug mode (:- debug.) to get more detail.'-[]
  461    ].
  462
  463contiguous([frame(D0,_,_)|Frames]) :-
  464    contiguous(Frames, D0).
  465
  466contiguous([], _).
  467contiguous([frame(D1,_,_)|Frames], D0) :-
  468    D1 =:= D0-1,
  469    contiguous(Frames, D1).
  470
  471
  472%!  clause_predicate_name(+ClauseRef, -Predname) is det.
  473%
  474%   Produce a name (typically  Functor/Arity)   for  a  predicate to
  475%   which Clause belongs.
  476
  477:- multifile
  478    user:prolog_clause_name/2.  479
  480clause_predicate_name(Clause, PredName) :-
  481    user:prolog_clause_name(Clause, PredName),
  482    !.
  483clause_predicate_name(Clause, PredName) :-
  484    nth_clause(Head, _N, Clause),
  485    !,
  486    predicate_name(user:Head, PredName).
  487
  488
  489%!  backtrace(+MaxDepth)
  490%
  491%   Get and print a stacktrace to the user_error stream.
  492
  493backtrace(MaxDepth) :-
  494    get_prolog_backtrace_lc(MaxDepth, Stack, []),
  495    print_prolog_backtrace(user_error, Stack).
  496
  497
  498subgoal_position(ClauseRef, PC, File, CharA, CharZ) :-
  499    debug(backtrace, 'Term-position in ~p at PC=~w:', [ClauseRef, PC]),
  500    clause_info(ClauseRef, File, TPos, _),
  501    '$clause_term_position'(ClauseRef, PC, List),
  502    debug(backtrace, '\t~p~n', [List]),
  503    find_subgoal(List, TPos, PosTerm),
  504    compound(PosTerm),
  505    arg(1, PosTerm, CharA),
  506    arg(2, PosTerm, CharZ).
  507
  508%!  find_subgoal(+PosList, +TermPos, -SubGoalPos).
  509%
  510%   @see Same as find_subgoal/3 in trace.pl from the GUI tracer.
  511
  512find_subgoal(_, Pos, Pos) :-
  513    var(Pos),
  514    !.
  515find_subgoal([A|T], term_position(_, _, _, _, PosL), SPos) :-
  516    nth1(A, PosL, Pos),
  517    !,
  518    find_subgoal(T, Pos, SPos).
  519find_subgoal([1|T], brace_term_position(_,_,Pos), SPos) :-
  520    !,
  521    find_subgoal(T, Pos, SPos).
  522find_subgoal(List, parentheses_term_position(_,_,Pos), SPos) :-
  523    !,
  524    find_subgoal(List, Pos, SPos).
  525find_subgoal(_, Pos, Pos).
  526
  527
  528%!  lineno(+File, +Char, -Line)
  529%
  530%   Translate a character location to  a   line-number.  Note  that this
  531%   calls prolog_clause:try_open_source/2, but this is  always loaded as
  532%   we would not have clause info without.
  533
  534lineno(File, Char, Line) :-
  535    setup_call_cleanup(
  536        ( prolog_clause:try_open_source(File, Fd),
  537          set_stream(Fd, newline(detect))
  538        ),
  539        lineno_(Fd, Char, Line),
  540        close(Fd)).
  541
  542lineno_(Fd, Char, L) :-
  543    stream_property(Fd, position(Pos)),
  544    stream_position_data(char_count, Pos, C),
  545    C > Char,
  546    !,
  547    stream_position_data(line_count, Pos, L0),
  548    L is L0-1.
  549lineno_(Fd, Char, L) :-
  550    skip(Fd, 0'\n),
  551    lineno_(Fd, Char, L).
  552
  553
  554		 /*******************************
  555		 *          CHOICEPOINTS	*
  556		 *******************************/
  557
  558%!  print_last_choicepoint is det.
  559%
  560%   Print details on the last open choice point.
  561
  562print_last_choicepoint :-
  563    prolog_current_choice(ChI0),         % Choice in print_last_choicepoint/0
  564    prolog_choice_attribute(ChI0, parent, ChI1),
  565    print_last_choicepoint(ChI1, []).
  566print_last_choicepoint.
  567
  568%!  print_last_choicepoint(+ChoiceRef, +Options) is det.
  569
  570print_last_choicepoint(ChI1, Options) :-
  571    real_choice(ChI1, ChI),
  572    prolog_choice_attribute(ChI, frame, F),
  573    prolog_frame_attribute(F, goal, Goal),
  574    Goal \= '$execute_goal2'(_,_,_),     % Toplevel REPL choicepoint
  575    !,
  576    option(message_level(Level), Options, warning),
  577    get_prolog_backtrace(2, [_|Stack], [frame(F)]),
  578    (   predicate_property(Goal, foreign)
  579    ->  print_message(Level, choicepoint(foreign(Goal), Stack))
  580    ;   prolog_frame_attribute(F, clause, Clause),
  581        (   prolog_choice_attribute(ChI, pc, PC)
  582        ->  Ctx = jump(PC)
  583        ;   prolog_choice_attribute(ChI, clause, Next)
  584        ->  Ctx = clause(Next)
  585        ),
  586        print_message(Level, choicepoint(clause(Goal, Clause, Ctx), Stack))
  587    ).
  588print_last_choicepoint(_, _).
  589
  590real_choice(Ch0, Ch) :-
  591    prolog_choice_attribute(Ch0, type, Type),
  592    dummy_type(Type),
  593    !,
  594    prolog_choice_attribute(Ch0, parent, Ch1),
  595    real_choice(Ch1, Ch).
  596real_choice(Ch, Ch).
  597
  598dummy_type(debug).
  599dummy_type(none).
  600
  601prolog:message(choicepoint(Choice, Stack)) -->
  602    choice(Choice),
  603    [ nl, 'Called from', nl ],
  604    message(Stack).
  605
  606choice(foreign(Goal)) -->
  607    success_goal(Goal, 'a foreign choice point').
  608choice(clause(Goal, ClauseRef, clause(Next))) -->
  609    success_goal(Goal, 'a choice point in alternate clause'),
  610    [ nl ],
  611    [ '  ' ], clause_descr(ClauseRef), [': clause succeeded', nl],
  612    [ '  ' ], clause_descr(Next),      [': next candidate clause' ].
  613choice(clause(Goal, ClauseRef, jump(PC))) -->
  614    { clause_where(false, ClauseRef, PC, Where,
  615                   [subgoal_positions(true)])
  616    },
  617    success_goal(Goal, 'an in-clause choice point'),
  618    [ nl, '  ' ],
  619    where_no_goal(Where).
  620
  621success_goal(Goal, Reason) -->
  622    [ ansi(code, '~p', [Goal]),
  623      ' left ~w (after success)'-[Reason]
  624    ].
  625
  626where_no_goal(pred_line(_PredName, File:Line)) -->
  627    !,
  628    [ url(File:Line) ].
  629where_no_goal(clause_name(ClauseName)) -->
  630    !,
  631    [ '~w <no source>'-[ClauseName] ].
  632
  633clause_descr(ClauseRef) -->
  634    { clause_property(ClauseRef, file(File)),
  635      clause_property(ClauseRef, line_count(Line))
  636    },
  637    !,
  638    [ url(File:Line) ].
  639clause_descr(ClauseRef) -->
  640    { clause_name(ClauseRef, Name)
  641    },
  642    [ '~w'-[Name] ].
  643
  644
  645                 /*******************************
  646                 *        DECORATE ERRORS       *
  647                 *******************************/
  648
  649%!  prolog_stack:stack_guard(+PI) is semidet.
  650%
  651%   Dynamic multifile hook that is normally not defined. The hook is
  652%   called with PI equal to =none= if   the  exception is not caught
  653%   and with a fully qualified   (e.g., Module:Name/Arity) predicate
  654%   indicator of the predicate that called  catch/3 if the exception
  655%   is caught.
  656%
  657%   The exception is of the form error(Formal, ImplDef) and this
  658%   hook succeeds, ImplDef is unified to a term
  659%   context(prolog_stack(StackData), Message).  This context
  660%   information is used by the message printing system to print a
  661%   human readable representation of the stack when the exception
  662%   was raised.
  663%
  664%   For example, using a clause   stack_guard(none)  prints contexts
  665%   for uncaught exceptions only.  Using   a  clause  stack_guard(_)
  666%   prints a full  stack-trace  for  any   error  exception  if  the
  667%   exception   is   given    to     print_message/2.    See    also
  668%   library(http/http_error), which limits printing of exceptions to
  669%   exceptions in user-code called from the HTTP server library.
  670%
  671%   Details of the exception decoration is  controlled by two Prolog
  672%   flags:
  673%
  674%       * backtrace_depth
  675%       Integer that controls the maximum number of frames
  676%       collected.  Default is 20.  If a guard is specified, callers
  677%       of the guard are removed from the stack-trace.
  678%
  679%       * backtrace_show_lines
  680%       Boolean that indicates whether the library tries to find
  681%       line numbers for the calls.  Default is =true=.
  682
  683:- multifile prolog:prolog_exception_hook/5.  684:- dynamic   prolog:prolog_exception_hook/5.  685
  686prolog:prolog_exception_hook(error(E, context(Ctx0,Msg)),
  687			     error(E, context(prolog_stack(Stack),Msg)),
  688			     Fr, GuardSpec, Debug) :-
  689    current_prolog_flag(backtrace, true),
  690    \+ is_stack(Ctx0, _Frames),
  691    (   atom(GuardSpec)
  692    ->  debug(backtrace, 'Got uncaught (guard = ~q) exception ~p (Ctx0=~p)',
  693              [GuardSpec, E, Ctx0]),
  694        stack_guard(GuardSpec),
  695        Guard = GuardSpec
  696    ;   prolog_frame_attribute(GuardSpec, predicate_indicator, Guard),
  697        debug(backtrace, 'Got exception ~p (Ctx0=~p, Catcher=~p)',
  698              [E, Ctx0, Guard]),
  699        stack_guard(Guard)
  700    ->  true
  701    ;   Debug == true,
  702        stack_guard(debug),
  703        Guard = none
  704    ),
  705    (   current_prolog_flag(backtrace_depth, Depth)
  706    ->  Depth > 0
  707    ;   Depth = 20                  % Thread created before lib was loaded
  708    ),
  709    get_prolog_backtrace(Depth, Stack0,
  710                         [ frame(Fr),
  711                           guard(Guard)
  712                         ]),
  713    debug(backtrace, 'Stack = ~p', [Stack0]),
  714    clean_stack(Stack0, Stack1),
  715    join_stacks(Ctx0, Stack1, Stack).
  716
  717clean_stack(List, List) :-
  718    stack_guard(X), var(X),
  719    !.      % Do not stop if we catch all
  720clean_stack(List, Clean) :-
  721    clean_stack2(List, Clean).
  722
  723clean_stack2([], []).
  724clean_stack2([H|_], [H]) :-
  725    guard_frame(H),
  726    !.
  727clean_stack2([H|T0], [H|T]) :-
  728    clean_stack2(T0, T).
  729
  730guard_frame(frame(_,clause(ClauseRef, _, _))) :-
  731    nth_clause(M:Head, _, ClauseRef),
  732    functor(Head, Name, Arity),
  733    stack_guard(M:Name/Arity).
  734
  735join_stacks(Ctx0, Stack1, Stack) :-
  736    nonvar(Ctx0),
  737    Ctx0 = prolog_stack(Stack0),
  738    is_list(Stack0), !,
  739    append(Stack0, Stack1, Stack).
  740join_stacks(_, Stack, Stack).
  741
  742
  743%!  stack_guard(+Reason) is semidet.
  744%
  745%   Dynamic multifile predicate. It is called  with `none`, `'C'` or
  746%   the predicate indicator of the   _guard_,  the predicate calling
  747%   catch/3. The exception must be of   _compatible_  with the shape
  748%   error(Formal, context(Stack, Msg)). The  default   is  to  catch
  749%   `none`, uncaught exceptions. `'C'`  implies   that  the callback
  750%   from C will handle the exception.
  751
  752stack_guard(none).
  753stack_guard(system:catch_with_backtrace/3).
  754stack_guard(debug).
  755
  756
  757                 /*******************************
  758                 *           MESSAGES           *
  759                 *******************************/
  760
  761:- multifile
  762    prolog:message//1.  763
  764prolog:message(error(Error, context(Stack, Message))) -->
  765    { Message \== 'DWIM could not correct goal',
  766      is_stack(Stack, Frames)
  767    },
  768    !,
  769    '$messages':translate_message(error(Error, context(_, Message))),
  770    [ nl, 'In:', nl ],
  771    (   {is_list(Frames)}
  772    ->  message(Frames)
  773    ;   ['~w'-[Frames]]
  774    ).
  775
  776is_stack(Stack, Frames) :-
  777    nonvar(Stack),
  778    Stack = prolog_stack(Frames)