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-2015, University of Amsterdam
    7                              VU University Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(prolog_breakpoints,
   37          [ set_breakpoint/4,           % +File, +Line, +CharPos, -Id
   38            set_breakpoint/5,           % +Owner, +File, +Line, +CharPos, -Id
   39            delete_breakpoint/1,        % +Id
   40            breakpoint_property/2       % ?Id, ?Property
   41          ]).   42:- use_module(prolog_clause).   43:- use_module(library(debug)).   44:- use_module(library(error)).   45
   46
   47/** <module> Manage Prolog break-points
   48
   49This module provides an  interface  for   development  tools  to set and
   50delete break-points, giving a location in  the source. Development tools
   51that want to track changes to   breakpoints must use user:message_hook/3
   52to intercept these message terms:
   53
   54  * breakpoint(set, Id)
   55  * breakpoint(delete, Id)
   56
   57Note that the hook must fail  after   creating  its side-effects to give
   58other hooks the opportunity to react.
   59*/
   60
   61:- dynamic
   62    user:prolog_event_hook/1.   63:- multifile
   64    user:prolog_event_hook/1.   65
   66%!  set_breakpoint(+File, +Line, +Char, -Id) is det.
   67%!  set_breakpoint(+Owner, +File, +Line, +Char, -Id) is det.
   68%
   69%   Put a breakpoint at the  indicated   source-location.  File is a
   70%   current sourcefile (as reported by   source_file/1). Line is the
   71%   1-based line in which Char  is.  Char   is  the  position of the
   72%   break.
   73%
   74%   First, '$clause_from_source'/4 uses the SWI-Prolog clause-source
   75%   information to find  the  last   clause  starting  before  Line.
   76%   '$break_pc' generated (on backtracking),  a   list  of  possible
   77%   break-points.
   78%
   79%   Note that in addition to  setting   the  break-point, the system
   80%   must be in debug mode. With threading enabled, there are various
   81%   different ways this may  be  done.   See  debug/0,  tdebug/0 and
   82%   tdebug/1. Therefore, this predicate  does   *not*  enable  debug
   83%   mode.
   84%
   85%   @arg  Owner  denotes  the   file    that   _owns_   the  clause.
   86%   set_breakpoint/5 is used to set breakpoints  in an included file
   87%   in   the   context    of    the     Owner    main    file.   See
   88%   source_file_property/2.
   89
   90set_breakpoint(File, Line, Char, Id) :-
   91    set_breakpoint(File, File, Line, Char, Id).
   92set_breakpoint(Owner, File, Line, Char, Id) :-
   93    debug(break, 'break_at(~q, ~d, ~d).', [File, Line, Char]),
   94    '$clause_from_source'(Owner, File, Line, ClauseRef),
   95    clause_info(ClauseRef, InfoFile, TermPos, _NameOffset),
   96    (   InfoFile == File
   97    ->  '$break_pc'(ClauseRef, PC, NextPC),
   98        debug(break, 'Clause ~p, PC=~p NextPC=~p', [ClauseRef, PC, NextPC]),
   99        '$clause_term_position'(ClauseRef, NextPC, List),
  100        debug(break, 'Location = ~w', [List]),
  101        range(List, TermPos, _0A, Z),
  102        debug(break, 'Term from ~w-~w', [_0A, Z]),
  103        Z >= Char, !
  104    ;   format('Failed to unify clause ~p, using first break',
  105               [ClauseRef]),
  106        '$break_pc'(ClauseRef, PC, _), !
  107    ),
  108    debug(break, 'Break at clause ~w, PC=~w', [ClauseRef, PC]),
  109    with_mutex('$break', next_break_id(Id)),
  110    Location = file_position(File, Line, Char),
  111    asserta(known_breakpoint(ClauseRef, PC, Location, Id), Ref),
  112    catch('$break_at'(ClauseRef, PC, true), E,
  113          (erase(Ref), throw(E))).
  114
  115
  116range(_,  Pos, _, _) :-
  117    var(Pos), !, fail.
  118range([], Pos, A, Z) :-
  119    arg(1, Pos, A),
  120    arg(2, Pos, Z).
  121range([H|T], term_position(_, _, _, _, PosL), A, Z) :-
  122    nth1(H, PosL, Pos),
  123    range(T, Pos, A, Z).
  124
  125:- dynamic
  126    known_breakpoint/4,             %
  127    break_id/1.  128
  129next_break_id(Id) :-
  130    retract(break_id(Id0)),
  131    !,
  132    Id is Id0+1,
  133    asserta(break_id(Id)).
  134next_break_id(1) :-
  135    asserta(break_id(1)).
  136
  137%!  delete_breakpoint(+Id) is det.
  138%
  139%   Delete   breakpoint   with    given     Id.    If    successful,
  140%   print_message(breakpoint(delete, Id)) is called.   Message hooks
  141%   working on this message may still call breakpoint_property/2.
  142%
  143%   @error existence_error(breakpoint, Id).
  144
  145delete_breakpoint(Id) :-
  146    integer(Id),
  147    known_breakpoint(ClauseRef, PC, _Location, Id),
  148    !,
  149    '$break_at'(ClauseRef, PC, false).
  150delete_breakpoint(Id) :-
  151    existence_error(breakpoint, Id).
  152
  153%!  breakpoint_property(?Id, ?Property) is nondet.
  154%
  155%   True when Property is a property of the breakpoint Id.  Defined
  156%   properties are:
  157%
  158%       * file(File)
  159%       Provided if the breakpoint is in a clause associated to a
  160%       file.  May not be known.
  161%       * line_count(Line)
  162%       Line of the breakpoint.  May not be known.
  163%       * character_range(Start, Len)
  164%       One-based character offset of the break-point.  May not be
  165%       known.
  166%       * clause(Reference)
  167%       Reference of the clause in which the breakpoint resides.
  168
  169breakpoint_property(Id, file(File)) :-
  170    known_breakpoint(ClauseRef,_,_,Id),
  171    clause_property(ClauseRef, file(File)).
  172breakpoint_property(Id, line_count(Line)) :-
  173    known_breakpoint(_,_,Location,Id),
  174    location_line(Location, Line).
  175breakpoint_property(Id, character_range(Start, Len)) :-
  176    known_breakpoint(ClauseRef,PC,_,Id),
  177    (   known_breakpoint(_,_,file_character_range(Start,Len),Id)
  178    ;   break_location(ClauseRef, PC, _File, Start-End),
  179        Len is End+1-Start
  180    ).
  181breakpoint_property(Id, clause(Reference)) :-
  182    known_breakpoint(Reference,_,_,Id).
  183
  184location_line(file_position(_File, Line, _Char), Line).
  185location_line(file_character_range(File, Start, _Len), Line) :-
  186    file_line(File, Start, Line).
  187location_line(file_line(_File, Line), Line).
  188
  189
  190%!  file_line(+File, +StartIndex, -Line) is det.
  191%
  192%   True when Line is the  1-based  line   offset  in  which we find
  193%   character StartIndex.
  194
  195file_line(File, Start, Line) :-
  196    setup_call_cleanup(
  197        open(File, read, In),
  198        stream_line(In, Start, 1, Line),
  199        close(In)).
  200
  201stream_line(In, _, Line0, Line) :-
  202    at_end_of_stream(In),
  203    !,
  204    Line = Line0.
  205stream_line(In, Index, Line0, Line) :-
  206    skip(In, 0'\n),
  207    character_count(In, At),
  208    (   At > Index
  209    ->  Line = Line0
  210    ;   Line1 is Line0+1,
  211        stream_line(In, Index, Line1, Line)
  212    ).
  213
  214
  215                 /*******************************
  216                 *            FEEDBACK          *
  217                 *******************************/
  218
  219user:prolog_event_hook(break(ClauseRef, PC, Set)) :-
  220    break(Set, ClauseRef, PC).
  221
  222break(true, ClauseRef, PC) :-
  223    known_breakpoint(ClauseRef, PC, _Location, Id),
  224    !,
  225    print_message(informational, breakpoint(set, Id)).
  226break(true, ClauseRef, PC) :-
  227    !,
  228    debug(break, 'Trap in Clause ~p, PC ~d', [ClauseRef, PC]),
  229    with_mutex('$break', next_break_id(Id)),
  230    (   break_location(ClauseRef, PC, File, A-Z)
  231    ->  Len is Z+1-A,
  232        Location = file_character_range(File, A, Len)
  233    ;   clause_property(ClauseRef, file(File)),
  234        clause_property(ClauseRef, line_count(Line))
  235    ->  Location = file_line(File, Line)
  236    ;   Location = unknown
  237    ),
  238    asserta(known_breakpoint(ClauseRef, PC, Location, Id)),
  239    print_message(informational, breakpoint(set, Id)).
  240break(false, ClauseRef, PC) :-
  241    debug(break, 'Remove breakpoint from ~p, PC ~d', [ClauseRef, PC]),
  242    clause(known_breakpoint(ClauseRef, PC, _Location, Id), true, Ref),
  243    call_cleanup(print_message(informational, breakpoint(delete, Id)),
  244                 erase(Ref)).
  245
  246%!  break_location(+ClauseRef, +PC, -File, -AZ) is det.
  247%
  248%   True when File and AZ represent the  location of the goal called
  249%   at PC in ClauseRef.
  250%
  251%   @param AZ is a term A-Z, where   A and Z are character positions
  252%   in File.
  253
  254break_location(ClauseRef, PC, File, A-Z) :-
  255    clause_info(ClauseRef, File, TermPos, _NameOffset),
  256    '$fetch_vm'(ClauseRef, PC, NPC, _VMI),
  257    '$clause_term_position'(ClauseRef, NPC, List),
  258    debug(break, 'ClausePos = ~w', [List]),
  259    range(List, TermPos, A, Z),
  260    debug(break, 'Range: ~d .. ~d', [A, Z]).
  261
  262
  263                 /*******************************
  264                 *            MESSAGES          *
  265                 *******************************/
  266
  267:- multifile
  268    prolog:message/3.  269
  270prolog:message(breakpoint(SetClear, Id)) -->
  271    setclear(SetClear),
  272    breakpoint(Id).
  273
  274setclear(set) -->
  275    ['Breakpoint '].
  276setclear(delete) -->
  277    ['Deleted breakpoint '].
  278
  279breakpoint(Id) -->
  280    breakpoint_name(Id),
  281    (   { breakpoint_property(Id, file(File)),
  282          file_base_name(File, Base),
  283          breakpoint_property(Id, line_count(Line))
  284        }
  285    ->  [ ' at ~w:~d'-[Base, Line] ]
  286    ;   []
  287    ).
  288
  289breakpoint_name(Id) -->
  290    { breakpoint_property(Id, clause(ClauseRef)) },
  291    (   { clause_property(ClauseRef, erased) }
  292    ->  ['~w'-[Id]]
  293    ;   { clause_name(ClauseRef, Name) },
  294        ['~w in ~w'-[Id, Name]]
  295    )