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, A, Z),
 102        debug(break, 'Term from ~w-~w', [A, 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    ).