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-2018, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    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_breakpoints,
   38          [ set_breakpoint/4,           % +File, +Line, +CharPos, -Id
   39            set_breakpoint/5,           % +Owner, +File, +Line, +CharPos, -Id
   40            delete_breakpoint/1,        % +Id
   41            breakpoint_property/2       % ?Id, ?Property
   42          ]).   43:- autoload(library(debug),[debug/3]).   44:- autoload(library(error),[existence_error/2]).   45:- autoload(library(lists),[nth1/3]).   46:- autoload(library(prolog_clause),[clause_info/4,clause_name/2]).   47
   48
   49/** <module> Manage Prolog break-points
   50
   51This module provides an  interface  for   development  tools  to set and
   52delete break-points, giving a location in  the source. Development tools
   53that want to track changes to   breakpoints must use user:message_hook/3
   54to intercept these message terms:
   55
   56  * breakpoint(set, Id)
   57  * breakpoint(delete, Id)
   58
   59Note that the hook must fail  after   creating  its side-effects to give
   60other hooks the opportunity to react.
   61*/
   62
   63%!  set_breakpoint(+File, +Line, +Char, -Id) is det.
   64%!  set_breakpoint(+Owner, +File, +Line, +Char, -Id) is det.
   65%
   66%   Put a breakpoint at the indicated source-location. File is a current
   67%   sourcefile (as reported by source_file/1). Line  is the 1-based line
   68%   in which Char is. Char is the position of the break.
   69%
   70%   First, '$clause_from_source'/4 uses  the   SWI-Prolog  clause-source
   71%   information  to  find  the  last    clause   starting  before  Line.
   72%   '$break_pc'  generated  (on  backtracking),  a    list  of  possible
   73%   break-points.
   74%
   75%   Note that in addition to setting the break-point, the system must be
   76%   in debug mode for the  breakpoint   to  take  effect. With threading
   77%   enabled, there are various different  ways   this  may  be done. See
   78%   debug/0, tdebug/0 and tdebug/1. Therefore, this predicate does *not*
   79%   enable debug mode.
   80%
   81%   @arg Owner denotes the file that _owns_ the clause. set_breakpoint/5
   82%   is used to set breakpoints in an included file in the context of the
   83%   Owner main file. See source_file_property/2.
   84
   85set_breakpoint(File, Line, Char, Id) :-
   86    set_breakpoint(File, File, Line, Char, Id).
   87set_breakpoint(Owner, File, Line, Char, Id) :-
   88    debug(break, 'break_at(~q, ~d, ~d).', [File, Line, Char]),
   89    '$clause_from_source'(Owner, File, Line, ClauseRef),
   90    clause_info(ClauseRef, InfoFile, TermPos, _NameOffset),
   91    (   InfoFile == File
   92    ->  '$break_pc'(ClauseRef, PC, NextPC),
   93        debug(break, 'Clause ~p, PC=~p NextPC=~p', [ClauseRef, PC, NextPC]),
   94        '$clause_term_position'(ClauseRef, NextPC, List),
   95        debug(break, 'Location = ~w', [List]),
   96        range(List, TermPos, A, Z),
   97        debug(break, 'Term from ~w-~w', [A, Z]),
   98        Z >= Char, !,
   99        Len is Z - A,
  100        b_setval('$breakpoint', file_location(File, Line, A, Len))
  101    ;   print_message(warning, breakpoint(no_source(ClauseRef, File, Line))),
  102        '$break_pc'(ClauseRef, PC, _), !,
  103        nb_delete('$breakpoint')
  104    ),
  105    debug(break, 'Break at clause ~w, PC=~w', [ClauseRef, PC]),
  106    '$break_at'(ClauseRef, PC, true),
  107    nb_delete('$breakpoint'),
  108    known_breakpoint(ClauseRef, PC, _Location, Id).
  109
  110range(_,  Pos, _, _) :-
  111    var(Pos), !, fail.
  112range([], Pos, A, Z) :-
  113    arg(1, Pos, A),
  114    arg(2, Pos, Z).
  115range([H|T], term_position(_, _, _, _, PosL), A, Z) :-
  116    nth1(H, PosL, Pos),
  117    range(T, Pos, A, Z).
  118
  119:- dynamic
  120    known_breakpoint/4,             % ClauseRef, PC, Location, Id
  121    break_id/1.  122
  123next_break_id(Id) :-
  124    retract(break_id(Id0)),
  125    !,
  126    Id is Id0+1,
  127    asserta(break_id(Id)).
  128next_break_id(1) :-
  129    asserta(break_id(1)).
  130
  131%!  delete_breakpoint(+Id) is det.
  132%
  133%   Delete   breakpoint   with    given     Id.    If    successful,
  134%   print_message(breakpoint(delete, Id)) is called.   Message hooks
  135%   working on this message may still call breakpoint_property/2.
  136%
  137%   @error existence_error(breakpoint, Id).
  138
  139delete_breakpoint(Id) :-
  140    integer(Id),
  141    known_breakpoint(ClauseRef, PC, _Location, Id),
  142    !,
  143    '$break_at'(ClauseRef, PC, false).
  144delete_breakpoint(Id) :-
  145    existence_error(breakpoint, Id).
  146
  147%!  breakpoint_property(?Id, ?Property) is nondet.
  148%
  149%   True when Property is a property of the breakpoint Id.  Defined
  150%   properties are:
  151%
  152%       * file(File)
  153%       Provided if the breakpoint is in a clause associated to a
  154%       file.  May not be known.
  155%       * line_count(Line)
  156%       Line of the breakpoint.  May not be known.
  157%       * character_range(Start, Len)
  158%       One-based character offset of the break-point.  May not be
  159%       known.
  160%       * clause(Reference)
  161%       Reference of the clause in which the breakpoint resides.
  162
  163breakpoint_property(Id, file(File)) :-
  164    known_breakpoint(ClauseRef,_,_,Id),
  165    clause_property(ClauseRef, file(File)).
  166breakpoint_property(Id, line_count(Line)) :-
  167    known_breakpoint(_,_,Location,Id),
  168    location_line(Location, Line).
  169breakpoint_property(Id, character_range(Start, Len)) :-
  170    known_breakpoint(ClauseRef,PC,Location,Id),
  171    (   Location = file_location(_File, _Line, Start, Len)
  172    ->  true
  173    ;   break_location(ClauseRef, PC, _File, Start-End),
  174        Len is End+1-Start
  175    ).
  176breakpoint_property(Id, clause(Reference)) :-
  177    known_breakpoint(Reference,_,_,Id).
  178
  179location_line(file_location(_File, Line, _Start, _Len), Line).
  180location_line(file_character_range(File, Start, _Len), Line) :-
  181    file_line(File, Start, Line).
  182location_line(file_line(_File, Line), Line).
  183
  184
  185%!  file_line(+File, +StartIndex, -Line) is det.
  186%
  187%   True when Line is the  1-based  line   offset  in  which we find
  188%   character StartIndex.
  189
  190file_line(File, Start, Line) :-
  191    setup_call_cleanup(
  192        prolog_clause:try_open_source(File, In),
  193        stream_line(In, Start, 1, Line),
  194        close(In)).
  195
  196stream_line(In, _, Line0, Line) :-
  197    at_end_of_stream(In),
  198    !,
  199    Line = Line0.
  200stream_line(In, Index, Line0, Line) :-
  201    skip(In, 0'\n),
  202    character_count(In, At),
  203    (   At > Index
  204    ->  Line = Line0
  205    ;   Line1 is Line0+1,
  206        stream_line(In, Index, Line1, Line)
  207    ).
  208
  209
  210                 /*******************************
  211                 *            FEEDBACK          *
  212                 *******************************/
  213
  214:- initialization
  215    prolog_unlisten(break, onbreak),
  216    prolog_listen(break, onbreak).  217
  218onbreak(exist, ClauseRef, PC) :-
  219    known_breakpoint(ClauseRef, PC, _Location, Id),
  220    !,
  221    break_message(breakpoint(exist, Id)).
  222onbreak(true, ClauseRef, PC) :-
  223    !,
  224    debug(break, 'Trap in Clause ~p, PC ~d', [ClauseRef, PC]),
  225    with_mutex('$break', next_break_id(Id)),
  226    (   nb_current('$breakpoint', Location)
  227    ->  true
  228    ;   break_location(ClauseRef, PC, File, A-Z)
  229    ->  Len is Z+1-A,
  230        Location = file_character_range(File, A, Len)
  231    ;   clause_property(ClauseRef, file(File)),
  232        clause_property(ClauseRef, line_count(Line))
  233    ->  Location = file_line(File, Line)
  234    ;   Location = unknown
  235    ),
  236    asserta(known_breakpoint(ClauseRef, PC, Location, Id)),
  237    break_message(breakpoint(set, Id)).
  238onbreak(false, ClauseRef, PC) :-
  239    debug(break, 'Remove breakpoint from ~p, PC ~d', [ClauseRef, PC]),
  240    clause(known_breakpoint(ClauseRef, PC, _Location, Id), true, Ref),
  241    call_cleanup(break_message(breakpoint(delete, Id)), erase(Ref)).
  242onbreak(gc, ClauseRef, PC) :-
  243    debug(break, 'Remove breakpoint from ~p, PC ~d (due to CGC)',
  244          [ClauseRef, PC]),
  245    retractall(known_breakpoint(ClauseRef, PC, _Location, _Id)).
  246
  247break_message(Message) :-
  248    print_message(informational, Message).
  249
  250%!  break_location(+ClauseRef, +PC, -File, -AZ) is det.
  251%
  252%   True when File and AZ represent the  location of the goal called
  253%   at PC in ClauseRef.
  254%
  255%   @param AZ is a term A-Z, where   A and Z are character positions
  256%   in File.
  257
  258break_location(ClauseRef, PC, File, A-Z) :-
  259    clause_info(ClauseRef, File, TermPos, _NameOffset),
  260    '$fetch_vm'(ClauseRef, PC, NPC, _VMI),
  261    '$clause_term_position'(ClauseRef, NPC, List),
  262    debug(break, 'ClausePos = ~w', [List]),
  263    range(List, TermPos, A, Z),
  264    debug(break, 'Range: ~d .. ~d', [A, Z]).
  265
  266
  267                 /*******************************
  268                 *            MESSAGES          *
  269                 *******************************/
  270
  271:- multifile
  272    prolog:message/3.  273
  274prolog:message(breakpoint(no_source(ClauseRef, _File, Line))) -->
  275    [ 'Failed to find line ~d in body of clause ~p.  Breaking at start of body.'-
  276      [Line, ClauseRef]
  277    ].
  278prolog:message(breakpoint(SetClear, Id)) -->
  279    setclear(SetClear),
  280    breakpoint(Id).
  281
  282setclear(set) -->
  283    ['Breakpoint '].
  284setclear(exist) -->
  285    ['Existing breakpoint '].
  286setclear(delete) -->
  287    ['Deleted breakpoint '].
  288
  289breakpoint(Id) -->
  290    breakpoint_name(Id),
  291    (   { breakpoint_property(Id, file(File)),
  292          file_base_name(File, Base),
  293          breakpoint_property(Id, line_count(Line))
  294        }
  295    ->  [ ' at ~w:~d'-[Base, Line] ]
  296    ;   []
  297    ).
  298
  299breakpoint_name(Id) -->
  300    { breakpoint_property(Id, clause(ClauseRef)) },
  301    (   { clause_property(ClauseRef, erased) }
  302    ->  ['~w'-[Id]]
  303    ;   { clause_name(ClauseRef, Name) },
  304        ['~w in ~w'-[Id, Name]]
  305    )