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%     - goal(Term)
  325%     - location(File:Line)
  326%       This property is only available if Frame executes a Prolog
  327%       clause, the program counter is known and the clause layout
  328%       can be retrieved.
  329
  330prolog_stack_frame_property(frame(Level,_,_), level(Level)).
  331prolog_stack_frame_property(frame(_,Where,_), predicate(PI)) :-
  332    frame_predicate(Where, PI).
  333prolog_stack_frame_property(frame(_,clause(Clause,PC),_), location(File:Line)) :-
  334    subgoal_position(Clause, PC, File, CharA, _CharZ),
  335    File \= @(_),                   % XPCE Object reference
  336    lineno(File, CharA, Line).
  337prolog_stack_frame_property(frame(_,_,_,Goal), goal(Goal)) :-
  338    Goal \== 0.
  339
  340
  341frame_predicate(foreign(PI), PI).
  342frame_predicate(call(PI), PI).
  343frame_predicate(clause(Clause, _PC), PI) :-
  344    clause_property(Clause, predicate(PI)).
  345
  346default_backtrace_options(Options) :-
  347    (   current_prolog_flag(backtrace_show_lines, true),
  348        current_prolog_flag(iso, false)
  349    ->  Options = []
  350    ;   Options = [subgoal_positions(false)]
  351    ).
  352
  353%!  print_prolog_backtrace(+Stream, +Backtrace) is det.
  354%!  print_prolog_backtrace(+Stream, +Backtrace, +Options) is det.
  355%
  356%   Print a stacktrace in human readable form to Stream.
  357%   Options is an option list that accepts:
  358%
  359%       * subgoal_positions(+Boolean)
  360%       If `true`. print subgoal line numbers.  The default depends
  361%       on the Prolog flag `backtrace_show_lines`.
  362%       * show_file(+How)
  363%       How to display the file name.  How is one of `absolute` or
  364%       `basename`.
  365%
  366%   @arg Backtrace is a list of frame(Depth,Location,Goal) terms.
  367
  368print_prolog_backtrace(Stream, Backtrace) :-
  369    print_prolog_backtrace(Stream, Backtrace, []).
  370
  371print_prolog_backtrace(Stream, Backtrace, Options) :-
  372    default_backtrace_options(DefOptions),
  373    merge_options(Options, DefOptions, FinalOptions),
  374    phrase(message(Backtrace, FinalOptions), Lines),
  375    print_message_lines(Stream, '', Lines).
  376
  377:- public                               % Called from some handlers
  378    message//1.  379
  380message(Backtrace) -->
  381    {default_backtrace_options(Options)},
  382    message(Backtrace, Options).
  383
  384message(Backtrace, Options) -->
  385    message_frames(Backtrace, Options),
  386    warn_nodebug(Backtrace).
  387
  388message_frames([], _) -->
  389    [].
  390message_frames([H|T], Options) -->
  391    message_frames(H, Options),
  392    (   {T == []}
  393    ->  []
  394    ;   [nl],
  395        message_frames(T, Options)
  396    ).
  397
  398message_frames(frame(Level, Where, 0), Options) -->
  399    !,
  400    level(Level),
  401    where_no_goal(Where, Options).
  402message_frames(frame(Level, _Where, '$toplevel':toplevel_call(_)), _) -->
  403    !,
  404    level(Level),
  405    [ '<user>'-[] ].
  406message_frames(frame(Level, Where, Goal), Options) -->
  407    level(Level),
  408    [ ansi(code, '~p', [Goal]) ],
  409    where_goal(Where, Options).
  410
  411where_no_goal(foreign(PI), _) -->
  412    [ '~w <foreign>'-[PI] ].
  413where_no_goal(call(PI), _) -->
  414    [ '~w'-[PI] ].
  415where_no_goal(pred_line(PredName, File:Line), Options) -->
  416    !,
  417    [ '~w at '-[PredName] ], file_line(File:Line, Options).
  418where_no_goal(clause_name(ClauseName), _) -->
  419    !,
  420    [ '~w <no source>'-[ClauseName] ].
  421where_no_goal(clause(Clause, PC), Options) -->
  422    { nonvar(Clause),
  423      !,
  424      clause_where(false, Clause, PC, Where, Options)
  425    },
  426    where_no_goal(Where, Options).
  427where_no_goal(meta_call, _) -->
  428    [ '<meta call>' ].
  429
  430where_goal(foreign(_), _) -->
  431    [ ' <foreign>'-[] ],
  432    !.
  433where_goal(pred_line(_PredName, File:Line), Options) -->
  434    !,
  435    [ ' at ' ], file_line(File:Line, Options).
  436where_goal(clause_name(ClauseName), _) -->
  437    !,
  438    [ '~w <no source>'-[ClauseName] ].
  439where_goal(clause(Clause, PC), Options) -->
  440    { nonvar(Clause),
  441      !,
  442      clause_where(false, Clause, PC, Where, Options)
  443    },
  444    where_goal(Where, Options).
  445where_goal(clause(Clause, _PC), _) -->
  446    { clause_property(Clause, file(File)),
  447      clause_property(Clause, line_count(Line))
  448    },
  449    !,
  450    [ ' at ', url(File:Line) ].
  451where_goal(clause(Clause, _PC), _) -->
  452    { clause_name(Clause, ClauseName)
  453    },
  454    !,
  455    [ ' ~w <no source>'-[ClauseName] ].
  456where_goal(_, _) -->
  457    [].
  458
  459level(Level) -->
  460    [ ansi(bold, '~|~t[~D]~6+ ', [Level]) ].
  461
  462file_line(File:Line, Options), option(show_files(basename), Options) ==>
  463    { file_base_name(File, Base),
  464      format(string(Label), '~w:~d', [Base, Line])
  465    },
  466    [ url(File:Line, Label) ].
  467file_line(File:Line, _Options) ==>
  468    [ url(File:Line) ].
  469
  470warn_nodebug(Backtrace) -->
  471    { contiguous(Backtrace) },
  472    !.
  473warn_nodebug(_Backtrace) -->
  474    [ nl,nl,
  475      'Note: some frames are missing due to last-call optimization.'-[], nl,
  476      'Re-run your program in debug mode (:- debug.) to get more detail.'-[]
  477    ].
  478
  479contiguous([frame(D0,_,_)|Frames]) :-
  480    contiguous(Frames, D0).
  481
  482contiguous([], _).
  483contiguous([frame(D1,_,_)|Frames], D0) :-
  484    D1 =:= D0-1,
  485    contiguous(Frames, D1).
  486
  487
  488%!  clause_predicate_name(+ClauseRef, -Predname) is det.
  489%
  490%   Produce a name (typically  Functor/Arity)   for  a  predicate to
  491%   which Clause belongs.
  492
  493:- multifile
  494    user:prolog_clause_name/2.  495
  496clause_predicate_name(Clause, PredName) :-
  497    user:prolog_clause_name(Clause, PredName),
  498    !.
  499clause_predicate_name(Clause, PredName) :-
  500    nth_clause(Head, _N, Clause),
  501    !,
  502    predicate_name(user:Head, PredName).
  503
  504
  505%!  backtrace(+MaxDepth)
  506%
  507%   Get and print a stacktrace to the user_error stream.
  508
  509backtrace(MaxDepth) :-
  510    get_prolog_backtrace_lc(MaxDepth, Stack, []),
  511    print_prolog_backtrace(user_error, Stack).
  512
  513
  514subgoal_position(ClauseRef, PC, File, CharA, CharZ) :-
  515    debug(backtrace, 'Term-position in ~p at PC=~w:', [ClauseRef, PC]),
  516    clause_info(ClauseRef, File, TPos, _),
  517    '$clause_term_position'(ClauseRef, PC, List),
  518    debug(backtrace, '\t~p~n', [List]),
  519    find_subgoal(List, TPos, PosTerm),
  520    compound(PosTerm),
  521    arg(1, PosTerm, CharA),
  522    arg(2, PosTerm, CharZ).
  523
  524%!  find_subgoal(+PosList, +TermPos, -SubGoalPos).
  525%
  526%   @see Same as find_subgoal/3 in trace.pl from the GUI tracer.
  527
  528find_subgoal(_, Pos, Pos) :-
  529    var(Pos),
  530    !.
  531find_subgoal([A|T], term_position(_, _, _, _, PosL), SPos) :-
  532    nth1(A, PosL, Pos),
  533    !,
  534    find_subgoal(T, Pos, SPos).
  535find_subgoal([1|T], brace_term_position(_,_,Pos), SPos) :-
  536    !,
  537    find_subgoal(T, Pos, SPos).
  538find_subgoal(List, parentheses_term_position(_,_,Pos), SPos) :-
  539    !,
  540    find_subgoal(List, Pos, SPos).
  541find_subgoal(_, Pos, Pos).
  542
  543
  544%!  lineno(+File, +Char, -Line)
  545%
  546%   Translate a character location to  a   line-number.  Note  that this
  547%   calls prolog_clause:try_open_source/2, but this is  always loaded as
  548%   we would not have clause info without.
  549
  550lineno(File, Char, Line) :-
  551    setup_call_cleanup(
  552        ( prolog_clause:try_open_source(File, Fd),
  553          set_stream(Fd, newline(detect))
  554        ),
  555        lineno_(Fd, Char, Line),
  556        close(Fd)).
  557
  558lineno_(Fd, Char, L) :-
  559    stream_property(Fd, position(Pos)),
  560    stream_position_data(char_count, Pos, C),
  561    C > Char,
  562    !,
  563    stream_position_data(line_count, Pos, L0),
  564    L is L0-1.
  565lineno_(Fd, Char, L) :-
  566    skip(Fd, 0'\n),
  567    lineno_(Fd, Char, L).
  568
  569
  570		 /*******************************
  571		 *          CHOICEPOINTS	*
  572		 *******************************/
  573
  574%!  print_last_choicepoint is det.
  575%
  576%   Print details on the last open choice point.
  577
  578print_last_choicepoint :-
  579    prolog_current_choice(ChI0),         % Choice in print_last_choicepoint/0
  580    prolog_choice_attribute(ChI0, parent, ChI1),
  581    print_last_choicepoint(ChI1, []).
  582print_last_choicepoint.
  583
  584%!  print_last_choicepoint(+ChoiceRef, +Options) is det.
  585
  586print_last_choicepoint(ChI1, Options) :-
  587    real_choice(ChI1, ChI),
  588    prolog_choice_attribute(ChI, frame, F),
  589    prolog_frame_attribute(F, goal, Goal),
  590    Goal \= '$execute_goal2'(_,_,_),     % Toplevel REPL choicepoint
  591    !,
  592    option(message_level(Level), Options, warning),
  593    get_prolog_backtrace(2, [_|Stack], [frame(F)]),
  594    (   predicate_property(Goal, foreign)
  595    ->  print_message(Level, choicepoint(foreign(Goal), Stack))
  596    ;   prolog_frame_attribute(F, clause, Clause),
  597        (   prolog_choice_attribute(ChI, pc, PC)
  598        ->  Ctx = jump(PC)
  599        ;   prolog_choice_attribute(ChI, clause, Next)
  600        ->  Ctx = clause(Next)
  601        ),
  602        print_message(Level, choicepoint(clause(Goal, Clause, Ctx), Stack))
  603    ).
  604print_last_choicepoint(_, _).
  605
  606real_choice(Ch0, Ch) :-
  607    prolog_choice_attribute(Ch0, type, Type),
  608    dummy_type(Type),
  609    !,
  610    prolog_choice_attribute(Ch0, parent, Ch1),
  611    real_choice(Ch1, Ch).
  612real_choice(Ch, Ch).
  613
  614dummy_type(debug).
  615dummy_type(none).
  616
  617prolog:message(choicepoint(Choice, Stack)) -->
  618    choice(Choice),
  619    [ nl, 'Called from', nl ],
  620    message(Stack).
  621
  622choice(foreign(Goal)) -->
  623    success_goal(Goal, 'a foreign choice point').
  624choice(clause(Goal, ClauseRef, clause(Next))) -->
  625    success_goal(Goal, 'a choice point in alternate clause'),
  626    [ nl ],
  627    [ '  ' ], clause_descr(ClauseRef), [': clause succeeded', nl],
  628    [ '  ' ], clause_descr(Next),      [': next candidate clause' ].
  629choice(clause(Goal, ClauseRef, jump(PC))) -->
  630    { clause_where(false, ClauseRef, PC, Where,
  631                   [subgoal_positions(true)])
  632    },
  633    success_goal(Goal, 'an in-clause choice point'),
  634    [ nl, '  ' ],
  635    where_no_goal(Where).
  636
  637success_goal(Goal, Reason) -->
  638    [ ansi(code, '~p', [Goal]),
  639      ' left ~w (after success)'-[Reason]
  640    ].
  641
  642where_no_goal(pred_line(_PredName, File:Line)) -->
  643    !,
  644    [ url(File:Line) ].
  645where_no_goal(clause_name(ClauseName)) -->
  646    !,
  647    [ '~w <no source>'-[ClauseName] ].
  648
  649clause_descr(ClauseRef) -->
  650    { clause_property(ClauseRef, file(File)),
  651      clause_property(ClauseRef, line_count(Line))
  652    },
  653    !,
  654    [ url(File:Line) ].
  655clause_descr(ClauseRef) -->
  656    { clause_name(ClauseRef, Name)
  657    },
  658    [ '~w'-[Name] ].
  659
  660
  661                 /*******************************
  662                 *        DECORATE ERRORS       *
  663                 *******************************/
  664
  665%!  prolog_stack:stack_guard(+PI) is semidet.
  666%
  667%   Dynamic multifile hook that is normally not defined. The hook is
  668%   called with PI equal to =none= if   the  exception is not caught
  669%   and with a fully qualified   (e.g., Module:Name/Arity) predicate
  670%   indicator of the predicate that called  catch/3 if the exception
  671%   is caught.
  672%
  673%   The exception is of the form error(Formal, ImplDef) and this
  674%   hook succeeds, ImplDef is unified to a term
  675%   context(prolog_stack(StackData), Message).  This context
  676%   information is used by the message printing system to print a
  677%   human readable representation of the stack when the exception
  678%   was raised.
  679%
  680%   For example, using a clause   stack_guard(none)  prints contexts
  681%   for uncaught exceptions only.  Using   a  clause  stack_guard(_)
  682%   prints a full  stack-trace  for  any   error  exception  if  the
  683%   exception   is   given    to     print_message/2.    See    also
  684%   library(http/http_error), which limits printing of exceptions to
  685%   exceptions in user-code called from the HTTP server library.
  686%
  687%   Details of the exception decoration is  controlled by two Prolog
  688%   flags:
  689%
  690%       * backtrace_depth
  691%       Integer that controls the maximum number of frames
  692%       collected.  Default is 20.  If a guard is specified, callers
  693%       of the guard are removed from the stack-trace.
  694%
  695%       * backtrace_show_lines
  696%       Boolean that indicates whether the library tries to find
  697%       line numbers for the calls.  Default is =true=.
  698
  699:- multifile prolog:prolog_exception_hook/5.  700:- dynamic   prolog:prolog_exception_hook/5.  701
  702prolog:prolog_exception_hook(error(E, context(Ctx0,Msg)),
  703			     error(E, context(prolog_stack(Stack),Msg)),
  704			     Fr, GuardSpec, Debug) :-
  705    current_prolog_flag(backtrace, true),
  706    \+ is_stack(Ctx0, _Frames),
  707    (   atom(GuardSpec)
  708    ->  debug(backtrace, 'Got uncaught (guard = ~q) exception ~p (Ctx0=~p)',
  709              [GuardSpec, E, Ctx0]),
  710        stack_guard(GuardSpec),
  711        Guard = GuardSpec
  712    ;   prolog_frame_attribute(GuardSpec, predicate_indicator, Guard),
  713        debug(backtrace, 'Got exception ~p (Ctx0=~p, Catcher=~p)',
  714              [E, Ctx0, Guard]),
  715        stack_guard(Guard)
  716    ->  true
  717    ;   Debug == true,
  718        stack_guard(debug),
  719        Guard = none
  720    ),
  721    (   current_prolog_flag(backtrace_depth, Depth)
  722    ->  Depth > 0
  723    ;   Depth = 20                  % Thread created before lib was loaded
  724    ),
  725    get_prolog_backtrace(Depth, Stack0,
  726                         [ frame(Fr),
  727                           guard(Guard)
  728                         ]),
  729    debug(backtrace, 'Stack = ~p', [Stack0]),
  730    clean_stack(Stack0, Stack1),
  731    join_stacks(Ctx0, Stack1, Stack).
  732
  733clean_stack(List, List) :-
  734    stack_guard(X), var(X),
  735    !.      % Do not stop if we catch all
  736clean_stack(List, Clean) :-
  737    clean_stack2(List, Clean).
  738
  739clean_stack2([], []).
  740clean_stack2([H|_], [H]) :-
  741    guard_frame(H),
  742    !.
  743clean_stack2([H|T0], [H|T]) :-
  744    clean_stack2(T0, T).
  745
  746guard_frame(frame(_,clause(ClauseRef, _, _))) :-
  747    nth_clause(M:Head, _, ClauseRef),
  748    functor(Head, Name, Arity),
  749    stack_guard(M:Name/Arity).
  750
  751join_stacks(Ctx0, Stack1, Stack) :-
  752    nonvar(Ctx0),
  753    Ctx0 = prolog_stack(Stack0),
  754    is_list(Stack0), !,
  755    append(Stack0, Stack1, Stack).
  756join_stacks(_, Stack, Stack).
  757
  758
  759%!  stack_guard(+Reason) is semidet.
  760%
  761%   Dynamic multifile predicate. It is called  with `none`, `'C'` or
  762%   the predicate indicator of the   _guard_,  the predicate calling
  763%   catch/3. The exception must be of   _compatible_  with the shape
  764%   error(Formal, context(Stack, Msg)). The  default   is  to  catch
  765%   `none`, uncaught exceptions. `'C'`  implies   that  the callback
  766%   from C will handle the exception.
  767
  768stack_guard(none).
  769stack_guard(system:catch_with_backtrace/3).
  770stack_guard(debug).
  771
  772
  773                 /*******************************
  774                 *           MESSAGES           *
  775                 *******************************/
  776
  777:- multifile
  778    prolog:message//1.  779
  780prolog:message(error(Error, context(Stack, Message))) -->
  781    { Message \== 'DWIM could not correct goal',
  782      is_stack(Stack, Frames)
  783    },
  784    !,
  785    '$messages':translate_message(error(Error, context(_, Message))),
  786    [ nl, 'In:', nl ],
  787    (   {is_list(Frames)}
  788    ->  message(Frames)
  789    ;   ['~w'-[Frames]]
  790    ).
  791
  792is_stack(Stack, Frames) :-
  793    nonvar(Stack),
  794    Stack = prolog_stack(Frames)