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