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, member/2]).   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, ClauseRefs),
   90    member(ClauseRef, ClauseRefs),
   91    clause_info(ClauseRef, InfoFile, TermPos, _NameOffset),
   92    (   InfoFile == File
   93    ->  '$break_pc'(ClauseRef, PC, NextPC),
   94        debug(break, 'Clause ~p, PC=~p NextPC=~p', [ClauseRef, PC, NextPC]),
   95        '$clause_term_position'(ClauseRef, NextPC, List),
   96        debug(break, 'Location = ~w', [List]),
   97        range(List, TermPos, SubPos),
   98        arg(1, SubPos, A),
   99        arg(2, SubPos, Z),
  100        debug(break, 'Term from ~w-~w', [A, Z]),
  101        Z >= Char, !,
  102        Len is Z - A,
  103        b_setval('$breakpoint', file_location(File, Line, A, Len))
  104    ;   print_message(warning, breakpoint(no_source(ClauseRef, File, Line))),
  105        '$break_pc'(ClauseRef, PC, _), !,
  106        nb_delete('$breakpoint')
  107    ),
  108    debug(break, 'Break at clause ~w, PC=~w', [ClauseRef, PC]),
  109    '$break_at'(ClauseRef, PC, true),
  110    nb_delete('$breakpoint'),
  111    known_breakpoint(ClauseRef, PC, _Location, Id).
  112
  113range(_,  Pos, _), var(Pos) =>
  114    fail.
  115range(List, parentheses_term_position(_,_,Pos), SubPos) =>
  116    range(List, Pos, SubPos).
  117range([], Pos, SubPos) =>
  118    SubPos = Pos.
  119range([H|T], term_position(_, _, _, _, PosL), SubPos) =>
  120    nth1(H, PosL, Pos),
  121    range(T, Pos, SubPos).
  122range(exit, Pos, SubPos) =>
  123    arg(2, Pos, End),
  124    Dot is End,
  125    EndDot is Dot+1,
  126    SubPos = Dot-EndDot.
  127
  128:- dynamic
  129    known_breakpoint/4,             % ClauseRef, PC, Location, Id
  130    break_id/1.  131
  132next_break_id(Id) :-
  133    retract(break_id(Id0)),
  134    !,
  135    Id is Id0+1,
  136    asserta(break_id(Id)).
  137next_break_id(1) :-
  138    asserta(break_id(1)).
  139
  140%!  delete_breakpoint(+Id) is det.
  141%
  142%   Delete   breakpoint   with    given     Id.    If    successful,
  143%   print_message(breakpoint(delete, Id)) is called.   Message hooks
  144%   working on this message may still call breakpoint_property/2.
  145%
  146%   @error existence_error(breakpoint, Id).
  147
  148delete_breakpoint(Id) :-
  149    integer(Id),
  150    known_breakpoint(ClauseRef, PC, _Location, Id),
  151    !,
  152    '$break_at'(ClauseRef, PC, false).
  153delete_breakpoint(Id) :-
  154    existence_error(breakpoint, Id).
  155
  156%!  breakpoint_property(?Id, ?Property) is nondet.
  157%
  158%   True when Property is a property of the breakpoint Id.  Defined
  159%   properties are:
  160%
  161%       * file(File)
  162%       Provided if the breakpoint is in a clause associated to a
  163%       file.  May not be known.
  164%       * line_count(Line)
  165%       Line of the breakpoint.  May not be known.
  166%       * character_range(Start, Len)
  167%       One-based character offset of the break-point.  May not be
  168%       known.
  169%       * clause(Reference)
  170%       Reference of the clause in which the breakpoint resides.
  171
  172breakpoint_property(Id, file(File)) :-
  173    known_breakpoint(ClauseRef,_,_,Id),
  174    clause_property(ClauseRef, file(File)).
  175breakpoint_property(Id, line_count(Line)) :-
  176    known_breakpoint(_,_,Location,Id),
  177    location_line(Location, Line).
  178breakpoint_property(Id, character_range(Start, Len)) :-
  179    known_breakpoint(ClauseRef,PC,Location,Id),
  180    (   Location = file_location(_File, _Line, Start, Len)
  181    ->  true
  182    ;   break_location(ClauseRef, PC, _File, Start-End),
  183        Len is End+1-Start
  184    ).
  185breakpoint_property(Id, clause(Reference)) :-
  186    known_breakpoint(Reference,_,_,Id).
  187
  188location_line(file_location(_File, Line, _Start, _Len), Line).
  189location_line(file_character_range(File, Start, _Len), Line) :-
  190    file_line(File, Start, Line).
  191location_line(file_line(_File, Line), Line).
  192
  193
  194%!  file_line(+File, +StartIndex, -Line) is det.
  195%
  196%   True when Line is the  1-based  line   offset  in  which we find
  197%   character StartIndex.
  198
  199file_line(File, Start, Line) :-
  200    setup_call_cleanup(
  201        prolog_clause:try_open_source(File, In),
  202        stream_line(In, Start, 1, Line),
  203        close(In)).
  204
  205stream_line(In, _, Line0, Line) :-
  206    at_end_of_stream(In),
  207    !,
  208    Line = Line0.
  209stream_line(In, Index, Line0, Line) :-
  210    skip(In, 0'\n),
  211    character_count(In, At),
  212    (   At > Index
  213    ->  Line = Line0
  214    ;   Line1 is Line0+1,
  215        stream_line(In, Index, Line1, Line)
  216    ).
  217
  218
  219                 /*******************************
  220                 *            FEEDBACK          *
  221                 *******************************/
  222
  223:- initialization
  224    prolog_unlisten(break, onbreak),
  225    prolog_listen(break, onbreak).  226
  227onbreak(exist, ClauseRef, PC) :-
  228    known_breakpoint(ClauseRef, PC, _Location, Id),
  229    !,
  230    break_message(breakpoint(exist, Id)).
  231onbreak(true, ClauseRef, PC) :-
  232    !,
  233    debug(break, 'Trap in Clause ~p, PC ~d', [ClauseRef, PC]),
  234    with_mutex('$break', next_break_id(Id)),
  235    (   nb_current('$breakpoint', Location)
  236    ->  true
  237    ;   break_location(ClauseRef, PC, File, A-Z)
  238    ->  Len is Z+1-A,
  239        Location = file_character_range(File, A, Len)
  240    ;   clause_property(ClauseRef, file(File)),
  241        clause_property(ClauseRef, line_count(Line))
  242    ->  Location = file_line(File, Line)
  243    ;   Location = unknown
  244    ),
  245    asserta(known_breakpoint(ClauseRef, PC, Location, Id)),
  246    break_message(breakpoint(set, Id)).
  247onbreak(false, ClauseRef, PC) :-
  248    debug(break, 'Remove breakpoint from ~p, PC ~d', [ClauseRef, PC]),
  249    clause(known_breakpoint(ClauseRef, PC, _Location, Id), true, Ref),
  250    call_cleanup(break_message(breakpoint(delete, Id)), erase(Ref)).
  251onbreak(gc, ClauseRef, PC) :-
  252    debug(break, 'Remove breakpoint from ~p, PC ~d (due to CGC)',
  253          [ClauseRef, PC]),
  254    retractall(known_breakpoint(ClauseRef, PC, _Location, _Id)).
  255
  256break_message(Message) :-
  257    print_message(informational, Message).
  258
  259%!  break_location(+ClauseRef, +PC, -File, -AZ) is det.
  260%
  261%   True when File and AZ represent the  location of the goal called
  262%   at PC in ClauseRef.
  263%
  264%   @param AZ is a term A-Z, where   A and Z are character positions
  265%   in File.
  266
  267break_location(ClauseRef, PC, File, A-Z) :-
  268    clause_info(ClauseRef, File, TermPos, _NameOffset),
  269    '$fetch_vm'(ClauseRef, PC, NPC, _VMI),
  270    '$clause_term_position'(ClauseRef, NPC, List),
  271    debug(break, 'ClausePos = ~w', [List]),
  272    range(List, TermPos, A, Z),
  273    debug(break, 'Range: ~d .. ~d', [A, Z]).
  274
  275
  276                 /*******************************
  277                 *            MESSAGES          *
  278                 *******************************/
  279
  280:- multifile
  281    prolog:message/3.  282
  283prolog:message(breakpoint(no_source(ClauseRef, _File, Line))) -->
  284    [ 'Failed to find line ~d in body of clause ~p.  Breaking at start of body.'-
  285      [Line, ClauseRef]
  286    ].
  287prolog:message(breakpoint(SetClear, Id)) -->
  288    setclear(SetClear),
  289    breakpoint(Id).
  290
  291setclear(set) -->
  292    ['Breakpoint '].
  293setclear(exist) -->
  294    ['Existing breakpoint '].
  295setclear(delete) -->
  296    ['Deleted breakpoint '].
  297
  298breakpoint(Id) -->
  299    breakpoint_name(Id),
  300    (   { breakpoint_property(Id, file(File)),
  301          breakpoint_property(Id, line_count(Line))
  302        }
  303    ->  [ ' at ', url(File:Line) ]
  304    ;   []
  305    ).
  306
  307breakpoint_name(Id) -->
  308    { breakpoint_property(Id, clause(ClauseRef)) },
  309    (   { clause_property(ClauseRef, erased) }
  310    ->  ['~w'-[Id]]
  311    ;   { clause_name(ClauseRef, Name) },
  312        ['~w in ~w'-[Id, Name]]
  313    )