1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker and Anjo Anjewierden
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org/
    6    Copyright (c)  2011-2022, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9                              SWI-Prolog Solutions b.v.
   10    All rights reserved.
   11
   12    Redistribution and use in source and binary forms, with or without
   13    modification, are permitted provided that the following conditions
   14    are met:
   15
   16    1. Redistributions of source code must retain the above copyright
   17       notice, this list of conditions and the following disclaimer.
   18
   19    2. Redistributions in binary form must reproduce the above copyright
   20       notice, this list of conditions and the following disclaimer in
   21       the documentation and/or other materials provided with the
   22       distribution.
   23
   24    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   25    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   26    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   27    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   28    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   29    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   30    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   31    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   32    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   33    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   34    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   35    POSSIBILITY OF SUCH DAMAGE.
   36*/
   37
   38:- module(prolog_breakpoints,
   39          [ set_breakpoint/4,           % +File, +Line, +CharPos, -Id
   40            set_breakpoint/5,           % +Owner, +File, +Line, +CharPos, -Id
   41            set_breakpoint_condition/2, % +Id, +Cond
   42            delete_breakpoint/1,        % +Id
   43            breakpoint_property/2       % ?Id, ?Property
   44          ]).   45:- use_module(library(debug), [debug/3]).   46:- autoload(library(error), [existence_error/2]).   47:- autoload(library(lists), [nth1/3, member/2]).   48:- autoload(library(prolog_clause), [clause_info/4, clause_name/2]).   49
   50
   51/** <module> Manage Prolog break-points
   52
   53This module provides an  interface  for   development  tools  to set and
   54delete break-points, giving a location in  the source. Development tools
   55that want to track changes to   breakpoints must use user:message_hook/3
   56to intercept these message terms:
   57
   58  * breakpoint(set, Id)
   59  * breakpoint(delete, Id)
   60
   61Note that the hook must fail  after   creating  its side-effects to give
   62other hooks the opportunity to react.
   63*/
   64
   65%!  set_breakpoint(+File, +Line, +Char, -Id) is det.
   66%!  set_breakpoint(+Owner, +File, +Line, +Char, -Id) is det.
   67%
   68%   Put a breakpoint at the indicated source-location. File is a current
   69%   sourcefile (as reported by source_file/1). Line  is the 1-based line
   70%   in which Char is. Char is the position of the break.
   71%
   72%   First, '$clause_from_source'/4 uses  the   SWI-Prolog  clause-source
   73%   information  to  find  the  last    clause   starting  before  Line.
   74%   '$break_pc'  generates  (on  backtracking),  a    list  of  possible
   75%   breakpoints.
   76%
   77%   Note that in addition to setting the breakpoint, the system must be
   78%   in debug mode for the  breakpoint   to  take  effect. With threading
   79%   enabled, there are various different  ways   this  may  be done. See
   80%   debug/0, tdebug/0 and tdebug/1. Therefore, this predicate does *not*
   81%   enable debug mode.
   82%
   83%   @arg Owner denotes the file that _owns_ the clause. set_breakpoint/5
   84%   is used to set breakpoints in an included file in the context of the
   85%   Owner main file. See source_file_property/2.
   86
   87set_breakpoint(File, Line, Char, Id) :-
   88    set_breakpoint(File, File, Line, Char, Id).
   89set_breakpoint(Owner, File, Line, Char, Id) :-
   90    debug(break, 'break_at(~q, ~d, ~d).', [File, Line, Char]),
   91    '$clause_from_source'(Owner, File, Line, ClauseRefs),
   92    member(ClauseRef, ClauseRefs),
   93    clause_info(ClauseRef, InfoFile, TermPos, _NameOffset),
   94    (   InfoFile == File
   95    ->  '$break_pc'(ClauseRef, PC, NextPC),
   96        debug(break, 'Clause ~p, PC=~p NextPC=~p', [ClauseRef, PC, NextPC]),
   97        '$clause_term_position'(ClauseRef, NextPC, List),
   98        debug(break, 'Location = ~w', [List]),
   99        range(List, TermPos, SubPos),
  100        arg(1, SubPos, A),
  101        arg(2, SubPos, Z),
  102        debug(break, 'Term from ~w-~w', [A, Z]),
  103        Z >= Char, !,
  104        Len is Z - A,
  105        b_setval('$breakpoint', file_location(File, Line, A, Len))
  106    ;   print_message(warning, breakpoint(no_source(ClauseRef, File, Line))),
  107        '$break_pc'(ClauseRef, PC, _), !,
  108        nb_delete('$breakpoint')
  109    ),
  110    debug(break, 'Break at clause ~w, PC=~w', [ClauseRef, PC]),
  111    '$break_at'(ClauseRef, PC, true),
  112    nb_delete('$breakpoint'),
  113    known_breakpoint(ClauseRef, PC, _Location, Id).
  114
  115range(_,  Pos, _), var(Pos) =>
  116    fail.
  117range(List, parentheses_term_position(_,_,Pos), SubPos) =>
  118    range(List, Pos, SubPos).
  119range([], Pos, SubPos) =>
  120    SubPos = Pos.
  121range([H|T], term_position(_, _, _, _, PosL), SubPos) =>
  122    nth1(H, PosL, Pos),
  123    range(T, Pos, SubPos).
  124range(exit, Pos, SubPos) =>
  125    arg(2, Pos, End),
  126    Dot is End,
  127    EndDot is Dot+1,
  128    SubPos = Dot-EndDot.
  129
  130:- dynamic
  131    known_breakpoint/4,             % ClauseRef, PC, Location, Id
  132    breakpoint_condition/4,         % Id, CondString, CondTerm, VarOffsets
  133    break_id/1.  134
  135next_break_id(Id) :-
  136    retract(break_id(Id0)),
  137    !,
  138    Id is Id0+1,
  139    asserta(break_id(Id)).
  140next_break_id(1) :-
  141    asserta(break_id(1)).
  142
  143%!  delete_breakpoint(+Id) is det.
  144%
  145%   Delete   breakpoint   with    given     Id.    If    successful,
  146%   print_message(breakpoint(delete, Id)) is called.   Message hooks
  147%   working on this message may still call breakpoint_property/2.
  148%
  149%   @error existence_error(breakpoint, Id).
  150
  151delete_breakpoint(Id) :-
  152    integer(Id),
  153    known_breakpoint(ClauseRef, PC, _Location, Id),
  154    !,
  155    '$break_at'(ClauseRef, PC, false).
  156delete_breakpoint(Id) :-
  157    existence_error(breakpoint, Id).
  158
  159%!  breakpoint_property(?Id, ?Property) is nondet.
  160%
  161%   True when Property is a property of the breakpoint Id.  Defined
  162%   properties are:
  163%
  164%       * file(File)
  165%       Provided if the breakpoint is in a clause associated to a
  166%       file.  May not be known.
  167%       * line_count(Line)
  168%       Line of the breakpoint.  May not be known.
  169%       * character_range(Start, Len)
  170%       One-based character offset of the break-point.  May not be
  171%       known.
  172%       * clause(Reference)
  173%       Reference of the clause in which the breakpoint resides.
  174
  175breakpoint_property(Id, file(File)) :-
  176    known_breakpoint(ClauseRef,_,_,Id),
  177    clause_property(ClauseRef, file(File)).
  178breakpoint_property(Id, line_count(Line)) :-
  179    known_breakpoint(_,_,Location,Id),
  180    location_line(Location, Line).
  181breakpoint_property(Id, character_range(Start, Len)) :-
  182    known_breakpoint(ClauseRef,PC,Location,Id),
  183    (   Location = file_location(_File, _Line, Start, Len)
  184    ->  true
  185    ;   break_location(ClauseRef, PC, _File, SubPos),
  186        compound(SubPos),
  187        arg(1, SubPos, Start),
  188        arg(2, Start, End),
  189        nonvar(Start), nonvar(End),
  190        Len is End+1-Start
  191    ).
  192breakpoint_property(Id, clause(Reference)) :-
  193    known_breakpoint(Reference,_,_,Id).
  194breakpoint_property(Id, condition(Cond)) :-
  195    known_breakpoint(_,_,_,Id),
  196    breakpoint_condition(Id, Cond, _CondTerm, _VarOffsets).
  197
  198location_line(file_location(_File, Line, _Start, _Len), Line).
  199location_line(file_character_range(File, Start, _Len), Line) :-
  200    file_line(File, Start, Line).
  201location_line(file_line(_File, Line), Line).
  202
  203
  204%!  file_line(+File, +StartIndex, -Line) is det.
  205%
  206%   True when Line is the  1-based  line   offset  in  which we find
  207%   character StartIndex.
  208
  209file_line(File, Start, Line) :-
  210    setup_call_cleanup(
  211        prolog_clause:try_open_source(File, In),
  212        stream_line(In, Start, 1, Line),
  213        close(In)).
  214
  215stream_line(In, _, Line0, Line) :-
  216    at_end_of_stream(In),
  217    !,
  218    Line = Line0.
  219stream_line(In, Index, Line0, Line) :-
  220    skip(In, 0'\n),
  221    character_count(In, At),
  222    (   At > Index
  223    ->  Line = Line0
  224    ;   Line1 is Line0+1,
  225        stream_line(In, Index, Line1, Line)
  226    ).
  227
  228
  229                 /*******************************
  230                 *            FEEDBACK          *
  231                 *******************************/
  232
  233:- initialization
  234    prolog_unlisten(break, onbreak),
  235    prolog_listen(break, onbreak).  236
  237onbreak(exist, ClauseRef, PC) :-
  238    known_breakpoint(ClauseRef, PC, _Location, Id),
  239    !,
  240    break_message(breakpoint(exist, Id)).
  241onbreak(true, ClauseRef, PC) :-
  242    !,
  243    debug(break, 'Trap in Clause ~p, PC ~d', [ClauseRef, PC]),
  244    with_mutex('$break', next_break_id(Id)),
  245    (   nb_current('$breakpoint', Location)
  246    ->  true
  247    ;   break_location(ClauseRef, PC, File, A-Z)
  248    ->  Len is Z+1-A,
  249        Location = file_character_range(File, A, Len)
  250    ;   clause_property(ClauseRef, file(File)),
  251        clause_property(ClauseRef, line_count(Line))
  252    ->  Location = file_line(File, Line)
  253    ;   Location = unknown
  254    ),
  255    asserta(known_breakpoint(ClauseRef, PC, Location, Id)),
  256    break_message(breakpoint(set, Id)).
  257onbreak(false, ClauseRef, PC) :-
  258    debug(break, 'Remove breakpoint from ~p, PC ~d', [ClauseRef, PC]),
  259    delete_breakpoint(ClauseRef, PC).
  260onbreak(retract, ClauseRef, PC) :-
  261    debug(break, 'Remove breakpoint from ~p, PC ~d (due to retract)',
  262          [ClauseRef, PC]),
  263    delete_breakpoint(ClauseRef, PC).
  264
  265delete_breakpoint(ClauseRef, PC) :-
  266    clause(known_breakpoint(ClauseRef, PC, _Location, Id), true, Ref),
  267    retractall(breakpoint_condition(Id, _, _, _)),
  268    call_cleanup(break_message(breakpoint(delete, Id)), erase(Ref)).
  269
  270break_message(Message) :-
  271    print_message(informational, Message).
  272
  273%!  break_location(+ClauseRef, +PC, -File, -Pos) is det.
  274%
  275%   True when File and Pos represent the  file and subterm position term
  276%   for the goal called at PC in ClauseRef.
  277%
  278%   @arg Pos is a subterm position  term (see `subterm_positions` option
  279%   of read_term/3, where positions are character positions in File. The
  280%   first two argument always hold the start and end of the term.
  281
  282break_location(ClauseRef, PC, File, SubPos) :-
  283    clause_info(ClauseRef, File, TermPos, _NameOffset),
  284    '$fetch_vm'(ClauseRef, PC, NPC, _VMI),
  285    '$clause_term_position'(ClauseRef, NPC, List),
  286    debug(break, 'ClausePos = ~w', [List]),
  287    range(List, TermPos, SubPos),
  288    debug(break, 'Subgoal at: ~p', [SubPos]).
  289
  290
  291                 /*******************************
  292                 *            MESSAGES          *
  293                 *******************************/
  294
  295:- multifile
  296    prolog:message/3.  297
  298prolog:message(breakpoint(no_source(ClauseRef, _File, Line))) -->
  299    [ 'Failed to find line ~d in body of clause ~p.  Breaking at start of body.'-
  300      [Line, ClauseRef]
  301    ].
  302prolog:message(breakpoint_condition_error(Id, Error)) -->
  303    [ 'Exception while evaluating breakpoint ~p condition:'-[Id], nl,
  304      prolog:translate_message(Error)
  305    ].
  306prolog:message(breakpoint(SetClear, Id)) -->
  307    setclear(SetClear),
  308    breakpoint(Id).
  309
  310setclear(set) -->
  311    ['Breakpoint '].
  312setclear(exist) -->
  313    ['Existing breakpoint '].
  314setclear(delete) -->
  315    ['Deleted breakpoint '].
  316
  317breakpoint(Id) -->
  318    breakpoint_name(Id),
  319    (   { breakpoint_property(Id, file(File)),
  320          breakpoint_property(Id, line_count(Line))
  321        }
  322    ->  [ ' at ', url(File:Line) ]
  323    ;   []
  324    ).
  325
  326breakpoint_name(Id) -->
  327    { breakpoint_property(Id, clause(ClauseRef)) },
  328    (   { clause_property(ClauseRef, erased) }
  329    ->  ['~w'-[Id]]
  330    ;   { clause_name(ClauseRef, Name) },
  331        ['~w in ~w'-[Id, Name]]
  332    ).
  333
  334
  335		 /*******************************
  336		 *    CONDITIONAL BREAKPOINTS   *
  337		 *******************************/
  338
  339%!  set_breakpoint_condition(+Id, +Cond) is det.
  340%
  341%   Set a condition for of the breakpoint   with given Id. The condition
  342%   Cond is a string  that  represents  a   Prolog  goal  to  be invoked
  343%   whenever the breakpoint is reached, if  goal fails the breakpoint is
  344%   skipped and execution commences normally.
  345%
  346%   Variables in Cond that match by  name   to  variables  in the source
  347%   definition of the clause in  which   the  breakpoint  is located are
  348%   unified with the corresponding runtime value of the clause variables
  349%   in the current execution  frame,   before  evaluating  the condition
  350%   goal.
  351%
  352%   @error existence_error(breakpoint, Id).
  353
  354set_breakpoint_condition(Id, Cond) :-
  355    known_breakpoint(ClauseRef, _PC, _Location, Id),
  356    !,
  357    term_string(CondGoal, Cond, [variable_names(Bindings)]),
  358    clause_info(ClauseRef, _InfoFile, _TermPos, NameOffset),
  359    clause_property(ClauseRef, module(Module)),
  360    names_offsets(Bindings, NameOffset, FrameOffsetsCondVars),
  361    retractall(breakpoint_condition(Id, _, _, _)),
  362    asserta(breakpoint_condition(Id, Cond, Module:CondGoal, FrameOffsetsCondVars)).
  363set_breakpoint_condition(Id, _Cond) :-
  364    existence_error(breakpoint, Id).
  365
  366:- multifile prolog:break_hook/7.  367
  368prolog:break_hook(Clause, PC, Frame, _Choice, _Goal, true, Action) :-
  369    known_breakpoint(Clause, PC, _, Id),
  370    (   breakpoint_condition(Id, _CondString, CondGoal, FrameOffsetsCondVars)
  371    ->  check_breakpoint_condition(Id, Frame, CondGoal,
  372                                   FrameOffsetsCondVars, Action)
  373    ;   Action = trace
  374    ).
  375
  376check_breakpoint_condition(Id, Frame, CondGoal, FrameOffsetsCondVars, Action) :-
  377    maplist(unify_with_frame_variable(Frame), FrameOffsetsCondVars),
  378    (   catch(CondGoal,
  379              Error,
  380              print_message(warning,
  381                            breakpoint_condition_error(Id, Error)))
  382    ->  Action = trace
  383    ;   Action = continue
  384    ).
  385
  386unify_with_frame_variable(Frame, Offset-Var) :-
  387    prolog_frame_attribute(Frame, argument(Offset), Var).
  388
  389
  390names_offsets([Name=Var|T], NameOffset, OffsetsVars) :-
  391    (   arg(Offset, NameOffset, Name)
  392    ->  OffsetsVars = [Offset-Var|R],
  393        names_offsets(T, NameOffset, R)
  394    ;   names_offsets(T, NameOffset, OffsetsVars)
  395    ).
  396names_offsets([], _, [])