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:- autoload(library(apply), [maplist/2]).   50:- autoload(library(broadcast), [broadcast/1]).   51
   52
   53/** <module> Manage Prolog break-points
   54
   55This module provides an  interface  for   development  tools  to set and
   56delete break-points, giving a location in  the source. Development tools
   57that want to track changes  to  breakpoints   must  use  listen/2 on the
   58messages below. See library(broadcast).
   59
   60  * prolog(breakpoint(set, Id))
   61  * prolog(breakpoint(delete, Id))
   62*/
   63
   64%!  set_breakpoint(+File, +Line, +Char, -Id) is det.
   65%!  set_breakpoint(+Owner, +File, +Line, +Char, -Id) is det.
   66%
   67%   Put a breakpoint at the indicated source-location. File is a current
   68%   sourcefile (as reported by source_file/1). Line  is the 1-based line
   69%   in which Char is. Char is the position of the break.
   70%
   71%   First, '$clause_from_source'/4 uses  the   SWI-Prolog  clause-source
   72%   information  to  find  the  last    clause   starting  before  Line.
   73%   '$break_pc'  generates  (on  backtracking),  a    list  of  possible
   74%   breakpoints.
   75%
   76%   Note that in addition to setting the breakpoint, the system must be
   77%   in debug mode for the  breakpoint   to  take  effect. With threading
   78%   enabled, there are various different  ways   this  may  be done. See
   79%   debug/0, tdebug/0 and tdebug/1. Therefore, this predicate does *not*
   80%   enable debug mode.
   81%
   82%   @arg Owner denotes the file that _owns_ the clause. set_breakpoint/5
   83%   is used to set breakpoints in an included file in the context of the
   84%   Owner main file. See source_file_property/2.
   85
   86set_breakpoint(File, Line, Char, Id) :-
   87    set_breakpoint(File, File, Line, Char, Id).
   88set_breakpoint(Owner, File, Line, Char, Id) :-
   89    debug(break, 'break_at(~q, ~d, ~d).', [File, Line, Char]),
   90    '$clause_from_source'(Owner, File, Line, ClauseRefs),
   91    member(ClauseRef, ClauseRefs),
   92    clause_info(ClauseRef, InfoFile, TermPos, _NameOffset),
   93    (   InfoFile == File
   94    ->  '$break_pc'(ClauseRef, PC, NextPC),
   95        debug(break, 'Clause ~p, PC=~p NextPC=~p', [ClauseRef, PC, NextPC]),
   96        '$clause_term_position'(ClauseRef, NextPC, List),
   97        debug(break, 'Location = ~w', [List]),
   98        range(List, TermPos, SubPos),
   99        arg(1, SubPos, A),
  100        arg(2, SubPos, Z),
  101        debug(break, 'Term from ~w-~w', [A, Z]),
  102        Z >= Char, !,
  103        Len is Z - A,
  104        b_setval('$breakpoint', file_location(File, Line, A, Len))
  105    ;   print_message(warning, breakpoint(no_source(ClauseRef, File, Line))),
  106        '$break_pc'(ClauseRef, PC, _), !,
  107        nb_delete('$breakpoint')
  108    ),
  109    debug(break, 'Break at clause ~w, PC=~w', [ClauseRef, PC]),
  110    '$break_at'(ClauseRef, PC, true),
  111    nb_delete('$breakpoint'),
  112    known_breakpoint(ClauseRef, PC, _Location, Id).
  113
  114range(_,  Pos, _), var(Pos) =>
  115    fail.
  116range(List, parentheses_term_position(_,_,Pos), SubPos) =>
  117    range(List, Pos, SubPos).
  118range([], Pos, SubPos) =>
  119    SubPos = Pos.
  120range([H|T], term_position(_, _, _, _, PosL), SubPos) =>
  121    nth1(H, PosL, Pos),
  122    range(T, Pos, SubPos).
  123range(exit, Pos, SubPos) =>
  124    arg(2, Pos, End),
  125    Dot is End,
  126    EndDot is Dot+1,
  127    SubPos = Dot-EndDot.
  128
  129:- dynamic
  130    known_breakpoint/4,             % ClauseRef, PC, Location, Id
  131    breakpoint_condition/4,         % Id, CondString, CondTerm, VarOffsets
  132    break_id/1.  133
  134next_break_id(Id) :-
  135    retract(break_id(Id0)),
  136    !,
  137    Id is Id0+1,
  138    asserta(break_id(Id)).
  139next_break_id(1) :-
  140    asserta(break_id(1)).
  141
  142%!  delete_breakpoint(+Id) is det.
  143%
  144%   Delete   breakpoint   with    given     Id.    If    successful,
  145%   print_message(breakpoint(delete, Id)) is called.   Message hooks
  146%   working on this message may still call breakpoint_property/2.
  147%
  148%   @error existence_error(breakpoint, Id).
  149
  150delete_breakpoint(Id) :-
  151    integer(Id),
  152    known_breakpoint(ClauseRef, PC, _Location, Id),
  153    !,
  154    '$break_at'(ClauseRef, PC, false).
  155delete_breakpoint(Id) :-
  156    existence_error(breakpoint, Id).
  157
  158%!  breakpoint_property(?Id, ?Property) is nondet.
  159%
  160%   True when Property is a property of the breakpoint Id.  Defined
  161%   properties are:
  162%
  163%       * file(File)
  164%       Provided if the breakpoint is in a clause associated to a
  165%       file.  May not be known.
  166%       * line_count(Line)
  167%       Line of the breakpoint.  May not be known.
  168%       * character_range(Start, Len)
  169%       One-based character offset of the break-point.  May not be
  170%       known.
  171%       * clause(Reference)
  172%       Reference of the clause in which the breakpoint resides.
  173
  174breakpoint_property(Id, file(File)) :-
  175    known_breakpoint(ClauseRef,_,_,Id),
  176    clause_property(ClauseRef, file(File)).
  177breakpoint_property(Id, line_count(Line)) :-
  178    known_breakpoint(_,_,Location,Id),
  179    location_line(Location, Line).
  180breakpoint_property(Id, character_range(Start, Len)) :-
  181    known_breakpoint(ClauseRef,PC,Location,Id),
  182    (   Location = file_location(_File, _Line, Start, Len)
  183    ->  true
  184    ;   break_location(ClauseRef, PC, _File, SubPos),
  185        compound(SubPos),
  186        arg(1, SubPos, Start),
  187        arg(2, Start, End),
  188        nonvar(Start), nonvar(End),
  189        Len is End+1-Start
  190    ).
  191breakpoint_property(Id, clause(Reference)) :-
  192    known_breakpoint(Reference,_,_,Id).
  193breakpoint_property(Id, condition(Cond)) :-
  194    known_breakpoint(_,_,_,Id),
  195    breakpoint_condition(Id, Cond, _CondTerm, _VarOffsets).
  196
  197location_line(file_location(_File, Line, _Start, _Len), Line).
  198location_line(file_character_range(File, Start, _Len), Line) :-
  199    file_line(File, Start, Line).
  200location_line(file_line(_File, Line), Line).
  201
  202
  203%!  file_line(+File, +StartIndex, -Line) is det.
  204%
  205%   True when Line is the  1-based  line   offset  in  which we find
  206%   character StartIndex.
  207
  208file_line(File, Start, Line) :-
  209    setup_call_cleanup(
  210        prolog_clause:try_open_source(File, In),
  211        stream_line(In, Start, 1, Line),
  212        close(In)).
  213
  214stream_line(In, _, Line0, Line) :-
  215    at_end_of_stream(In),
  216    !,
  217    Line = Line0.
  218stream_line(In, Index, Line0, Line) :-
  219    skip(In, 0'\n),
  220    character_count(In, At),
  221    (   At > Index
  222    ->  Line = Line0
  223    ;   Line1 is Line0+1,
  224        stream_line(In, Index, Line1, Line)
  225    ).
  226
  227
  228                 /*******************************
  229                 *            FEEDBACK          *
  230                 *******************************/
  231
  232:- initialization
  233    prolog_unlisten(break, onbreak),
  234    prolog_listen(break, onbreak).  235
  236onbreak(exist, ClauseRef, PC) :-
  237    known_breakpoint(ClauseRef, PC, _Location, Id),
  238    !,
  239    break_message(breakpoint(exist, Id)).
  240onbreak(true, ClauseRef, PC) :-
  241    !,
  242    debug(break, 'Trap in Clause ~p, PC ~d', [ClauseRef, PC]),
  243    with_mutex('$break', next_break_id(Id)),
  244    (   nb_current('$breakpoint', Location)
  245    ->  true
  246    ;   break_location(ClauseRef, PC, File, A-Z)
  247    ->  Len is Z+1-A,
  248        Location = file_character_range(File, A, Len)
  249    ;   clause_property(ClauseRef, file(File)),
  250        clause_property(ClauseRef, line_count(Line))
  251    ->  Location = file_line(File, Line)
  252    ;   Location = unknown
  253    ),
  254    asserta(known_breakpoint(ClauseRef, PC, Location, Id)),
  255    break_message(breakpoint(set, Id)).
  256onbreak(false, ClauseRef, PC) :-
  257    debug(break, 'Remove breakpoint from ~p, PC ~d', [ClauseRef, PC]),
  258    delete_breakpoint(ClauseRef, PC).
  259onbreak(retract, ClauseRef, PC) :-
  260    debug(break, 'Remove breakpoint from ~p, PC ~d (due to retract)',
  261          [ClauseRef, PC]),
  262    delete_breakpoint(ClauseRef, PC).
  263
  264delete_breakpoint(ClauseRef, PC) :-
  265    clause(known_breakpoint(ClauseRef, PC, _Location, Id), true, Ref),
  266    retractall(breakpoint_condition(Id, _, _, _)),
  267    call_cleanup(break_message(breakpoint(delete, Id)), erase(Ref)).
  268
  269break_message(Message) :-
  270    broadcast(prolog(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([], _, [])