[m-rev.] Add a listing facility to mdb

Ralph Becket rafe at cs.mu.OZ.AU
Tue Oct 11 17:00:05 AEST 2005


Estimated hours taken: 6
Branches: main

Add a file listing facility to mdb.

NEWS:
	Mention the new facility.

browser/listing.m:
	Functionality to search for files and list parts of them.

browser/mdb.m:
	Add listing.m to the browser library.

doc/user_guide.texi:
	Document the `list', `push_list_dir', and `pop_list_dir' commands.

trace/mercury_trace_internal.c:
	Implement the C part of the `list', `push_list_dir', and `pop_list_dir'
	commands

Index: browser/listing.m
===================================================================
RCS file: browser/listing.m
diff -N browser/listing.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ browser/listing.m	11 Oct 2005 06:38:06 -0000
@@ -0,0 +1,277 @@
+%-----------------------------------------------------------------------------%
+% listing.m
+% Ralph Becket <rafe at cs.mu.oz.au>
+% Thu Oct  6 16:07:01 EST 2005
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%
+% Support for providing file listing functionality in the debugger.
+%
+%-----------------------------------------------------------------------------%
+
+:- module mdb.listing.
+
+:- interface.
+
+:- import_module io.
+:- import_module string.
+
+
+
+:- type listings.
+:- type line_no   == int.
+:- type path_name == string.
+:- type file_name == string.
+
+
+
+    % Construct a new listings structure with a default search path of
+    % [dir.this_directory].
+    %
+:- func new_listings = listings.
+
+    % push_file_name_path(PathName, !Listings)
+    %   Push PathName on to the stack of directories searched for
+    %   FileName matches by list_file/7.
+    %
+:- pred push_file_name_path(path_name::in, listings::in, listings::out) is det.
+
+    % pop_file_name_path(!Listings)
+    %   Pop the last PathName pushed on to the stack of directories.
+    %   Does nothing if the search path stack is empty.
+    %
+:- pred pop_file_name_path(listings::in, listings::out) is det.
+
+    % list_file(FileName, FirstLine, LastLine, MarkLine, !Listings, !IO)
+    %
+    %   Print the lines from FileName with numbers in the range
+    %   FirstLine ..  LastLine (the first line is numbered 1).
+    %   The line numbered MarkLine is marked with a chevron, all
+    %   other lines are indented appropriately.
+    %
+    %   A file matching FileName is searched for by first looking
+    %   in the current working directory or, failing that, by
+    %   prepending each PathName on the search path stack in
+    %   turn until a match is found.  If no match is found then
+    %   an error message is printed.
+    %
+:- pred list_file(file_name::in, line_no::in, line_no::in, line_no::in,
+        listings::in, listings::out, io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module array.
+:- import_module char.
+:- import_module dir.
+:- import_module int.
+:- import_module list.
+:- import_module map.
+:- import_module std_util.
+
+
+
+:- type listings
+    --->    listings(
+                search_path             :: search_path,
+                file_name_line_offsets  :: file_name_line_offsets
+            ).
+
+:- type search_path  == list(path_name).
+:- type line_offsets == array(int).     % Offset into file of each newline.
+
+    % A mapping from file names to absolute file names and line offsets.
+    %
+:- type file_name_line_offsets == map(file_name, {file_name, line_offsets}).
+
+
+
+    % These predicates are called from trace/mercury_trace_internal.c.
+    %
+:- pragma export(new_listings = out,
+        "MR_listing__new_listings").
+:- pragma export(push_file_name_path(in, in, out),
+        "MR_listing__push_file_name_path").
+:- pragma export(pop_file_name_path(in, out),
+        "MR_listing__pop_file_name_path").
+:- pragma export(list_file(in, in, in, in, in, out, di, uo),
+        "MR_listing__list_file").
+
+%-----------------------------------------------------------------------------%
+
+new_listings = listings([dir.this_directory], map.init).
+
+%-----------------------------------------------------------------------------%
+
+push_file_name_path(PathName, Listings0, Listings) :-
+    Listings =
+        Listings0 ^ search_path := [PathName | Listings0 ^ search_path].
+
+%-----------------------------------------------------------------------------%
+
+pop_file_name_path(Listings0, Listings) :-
+    SearchPath0 = Listings0 ^ search_path,
+    (
+        SearchPath0 = [],
+        Listings = Listings0
+    ;
+        SearchPath0 = [_PathName | SearchPath],
+        Listings = Listings0 ^ search_path := SearchPath
+    ).
+
+%-----------------------------------------------------------------------------%
+
+list_file(FileName0, FirstLine, LastLine, MarkLine, !Listings, !IO) :-
+    ( if
+        !.Listings ^ file_name_line_offsets ^ elem(FileName0) =
+            {FileName, LineOffsets}
+      then
+        print_lines_in_range(FileName, FirstLine, LastLine, MarkLine,
+            LineOffsets, !IO)
+      else
+        SearchPath = !.Listings ^ search_path,
+        find_file_name_line_offsets(SearchPath, FileName0,
+            MaybeFileNameLineOffsets, !IO),
+        (
+            MaybeFileNameLineOffsets = yes({FileName, LineOffsets}),
+            !:Listings =
+                !.Listings ^ file_name_line_offsets ^ elem(FileName0) :=
+                    {FileName, LineOffsets},
+            print_lines_in_range(FileName, FirstLine, LastLine, MarkLine,
+                LineOffsets, !IO)
+        ;
+            MaybeFileNameLineOffsets = no,
+            io.write_string("cannot find file " ++ FileName0 ++ "\n", !IO)
+        )
+    ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred find_file_name_line_offsets(search_path::in, file_name::in,
+        maybe({file_name, line_offsets})::out, io::di, io::uo) is det.
+
+find_file_name_line_offsets(SearchPath, FileName0, Result, !IO) :-
+    find_file_stream(SearchPath, FileName0, MaybeFileNameStream, !IO),
+    (
+        MaybeFileNameStream = no,
+        Result = no
+    ;
+        MaybeFileNameStream = yes({FileName, Stream}),
+        find_line_offsets(Stream, 0, [0], LineOffsets, !IO),
+        Result = yes({FileName, LineOffsets})
+    ).
+
+%-----------------------------------------------------------------------------%
+
+    % Search for the first file with the given name on the search path
+    % that we can open for reading and return the complete file name
+    % (including the path component) and input stream handle.
+    %
+:- pred find_file_stream(search_path::in, file_name::in,
+        maybe({file_name, io.input_stream})::out, io::di, io::uo) is det.
+
+find_file_stream([], _, no, !IO).
+
+find_file_stream([Path | SearchPath], FileName0, MaybeFileNameStream, !IO) :-
+    FileName = Path / FileName0,
+    io.open_input(FileName, Result, !IO),
+    (
+        Result = ok(Stream),
+        MaybeFileNameStream = yes({FileName, Stream})
+    ;
+        Result = error(_),
+        find_file_stream(SearchPath, FileName0, MaybeFileNameStream, !IO)
+    ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred find_line_offsets(io.input_stream::in, int::in, list(int)::in,
+        line_offsets::out, io::di, io::uo) is det.
+
+find_line_offsets(Stream, I, RevOffsets0, LineOffsets, !IO) :-
+    io.read_char(Stream, Result, !IO),
+    (
+        Result = ok(Char),
+        ( if Char = '\n' then RevOffsets = [I + 1 | RevOffsets0]
+                         else RevOffsets = RevOffsets0 ),
+        find_line_offsets(Stream, I + 1, RevOffsets, LineOffsets, !IO)
+    ;
+        Result = eof,
+        LineOffsets = array(list.reverse(RevOffsets0))
+    ;
+        Result = error(Error),
+        report_io_error(Error, !IO),
+        LineOffsets = make_empty_array
+    ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred print_lines_in_range(file_name::in, line_no::in, line_no::in,
+        line_no::in, line_offsets::in, io::di, io::uo) is det.
+
+print_lines_in_range(FileName, FirstLine0, LastLine0, MarkLine0, LineOffsets,
+        !IO) :-
+    FirstLine = max(1, FirstLine0) - 1,
+    LastLine  = min(array.max(LineOffsets), LastLine0) - 1,
+    MarkLine  = MarkLine0 - 1,
+    io.open_binary_input(FileName, Result, !IO),
+    (
+        Result = ok(Stream),
+        ( if 0 =< FirstLine, FirstLine =< LastLine then
+            io.seek_binary(Stream, io.set, LineOffsets ^ elem(FirstLine), !IO)
+          else
+            true
+        ),
+        echo_lines(Stream, FirstLine, LastLine, MarkLine, !IO),
+        io.close_binary_input(Stream, !IO)
+    ;
+        Result = error(Error),
+        report_io_error(Error, !IO)
+    ).
+
+
+:- pred echo_lines(io.binary_input_stream::in, line_no::in, line_no::in,
+        line_no::in, io::di, io::uo) is det.
+
+echo_lines(Stream, CurrentLine, LastLine, MarkLine, !IO) :-
+    ( if CurrentLine > LastLine then
+        true
+      else
+        io.write_string((if CurrentLine = MarkLine then "> " else "  "), !IO),
+        echo_line(Stream, !IO),
+        echo_lines(Stream, CurrentLine + 1, LastLine, MarkLine, !IO)
+    ).
+
+
+:- pred echo_line(io.binary_input_stream::in, io::di, io::uo) is det.
+
+echo_line(Stream, !IO) :-
+    io.read_byte(Stream, Result, !IO),
+    (
+        Result = ok(Byte),
+        Char = char.det_from_int(Byte),
+        io.write_char(Char, !IO),
+        ( if   Char = '\n'
+          then true
+          else echo_line(Stream, !IO)
+        )
+    ;
+        Result = eof
+    ;
+        Result = error(Error),
+        io.nl(!IO),
+        report_io_error(Error, !IO)
+    ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred report_io_error(io.error::in, io::di, io::uo) is det.
+
+report_io_error(Error, !IO) :-
+    io.write_string("* ", !IO),
+    io.write_string(io.error_message(Error), !IO),
+    io.nl(!IO).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: browser/mdb.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/mdb.m,v
retrieving revision 1.21
diff -u -r1.21 mdb.m
--- browser/mdb.m	11 Jul 2005 07:30:21 -0000	1.21
+++ browser/mdb.m	10 Oct 2005 04:10:09 -0000
@@ -26,6 +26,7 @@
 :- include_module help.
 :- include_module interactive_query.
 :- include_module io_action.
+:- include_module listing.
 
 :- implementation.
 
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.453
diff -u -r1.453 user_guide.texi
--- doc/user_guide.texi	10 Oct 2005 06:54:56 -0000	1.453
+++ doc/user_guide.texi	11 Oct 2005 06:53:24 -0000
@@ -2886,6 +2886,22 @@
 @c if it is available,
 @c to the specified file. The option @samp{-x} (or @samp{--xml}) causes the
 @c output to be in XML.
+ at sp 1
+ at item list [@var{num}]
+ at kindex list (mdb command)
+Lists the source code text for the current environment, including
+ at var{num} preceding and following lines.  If @var{num} is not provided then
+a default of three is used.
+ at sp 1
+ at item push_list_dir @var{dir1} @var{dir2} ...
+ at kindex push_list_dir (mdb command)
+The @samp{list} command searches a list of directories when looking for a
+source code file.  The @samp{push_list_dir} pushes one or more such
+directories on to this list.
+ at sp 1
+ at item pop_list_dir
+ at kindex pop_list_dir (mdb command)
+Pops the most recent @samp{push_list_dir}' directory from the search list.
 @end table
 
 @sp 1
Index: trace/mercury_trace_internal.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.215
diff -u -r1.215 mercury_trace_internal.c
--- trace/mercury_trace_internal.c	5 Oct 2005 06:11:57 -0000	1.215
+++ trace/mercury_trace_internal.c	11 Oct 2005 06:41:52 -0000
@@ -36,6 +36,7 @@
 #include "mercury_trace_source.h"
 
 #include "mdb.browse.mh"
+#include "mdb.listing.mh"
 #include "mdb.diff.mh"
 #include "mdb.browser_info.mh"
 #include "mdb.declarative_execution.mh"
@@ -229,6 +230,20 @@
 
 static  MR_bool     MR_print_goal_paths = MR_TRUE;
 
+/*
+** MR_listings_state holds the current value of the listings structure
+** as defined in browser/listing.m.
+*/
+
+static  MR_Word     MR_listings_state;
+
+/*
+** MR_num_context_lines holds the current number of context lines to be
+** printed before and after the current callee/caller's file context.
+*/
+
+static  int         MR_num_context_lines = 2;
+
 typedef struct MR_Line_Struct {
     char            *MR_line_contents;
     struct MR_Line_Struct   *MR_line_next;
@@ -464,6 +479,9 @@
 static  MR_TraceCmdFunc MR_trace_cmd_hold;
 static  MR_TraceCmdFunc MR_trace_cmd_diff;
 static  MR_TraceCmdFunc MR_trace_cmd_save_to_file;
+static  MR_TraceCmdFunc MR_trace_list_part_of_file;
+static  MR_TraceCmdFunc MR_trace_push_list_dir;
+static  MR_TraceCmdFunc MR_trace_pop_list_dir;
 static  MR_TraceCmdFunc MR_trace_cmd_break;
 static  MR_TraceCmdFunc MR_trace_cmd_condition;
 static  MR_TraceCmdFunc MR_trace_cmd_ignore;
@@ -932,6 +950,12 @@
         }
 
         /*
+        ** Set up MR_listings_state.
+        */
+
+        MR_listings_state = MR_listing__new_listings();
+
+        /*
         ** These functions add the commands to the front of the queue, so
         ** we call them in the reverse order we want the commands executed.
         */
@@ -2644,6 +2668,100 @@
     return KEEP_INTERACTING;
 }
 
+    /*
+    ** list [num]
+    **  List num lines of context around the line number of the context of the
+    **  current point (i.e., level in the call stack).  If num is not given,
+    **  the number of context lines defaults to the value of the context_lines
+    **  setting.
+    **
+    ** TODO: add the following (use MR_parse_source_locn()):
+    ** list filename:num[-num]
+    **  List a range of lines from a given file.  If only one number is
+    **  given, the default number of lines of context is used.
+    */
+
+static MR_Next
+MR_trace_list_part_of_file(char **words, int word_count,
+    MR_Trace_Cmd_Info *cmd, MR_Event_Info *event_info,
+    MR_Event_Details *event_details, MR_Code **jumpaddr)
+{
+    const MR_Proc_Layout    *entry_ptr;
+    const char              *filename;
+    int                     lineno;
+    MR_Word                 *base_sp_ptr;
+    MR_Word                 *base_curfr_ptr;
+    MR_bool                 num = MR_num_context_lines;
+
+    if (word_count > 2) {
+        MR_trace_usage("browsing", "list");
+        return KEEP_INTERACTING;
+    }
+
+    if (word_count == 2) {
+        char *last_char_parsed;
+
+        num = strtoul(words[1], &last_char_parsed, 10);
+        if (*last_char_parsed != '\0') {
+            MR_trace_usage("browsing", "list");
+            return KEEP_INTERACTING;
+        }
+    }
+
+    MR_trace_current_level_details(&entry_ptr, &filename, &lineno,
+        &base_sp_ptr, &base_curfr_ptr);
+
+    /* rafe: XXX Maybe need to use MR_make_aligned_string() for filename? */
+
+    MR_TRACE_CALL_MERCURY(
+        MR_listing__list_file((char *) filename, lineno - num, lineno + num,
+            lineno, MR_listings_state, &MR_listings_state);
+    );
+
+    return KEEP_INTERACTING;
+}
+
+static MR_Next
+MR_trace_push_list_dir(char **words, int word_count,
+    MR_Trace_Cmd_Info *cmd, MR_Event_Info *event_info,
+    MR_Event_Details *event_details, MR_Code **jumpaddr)
+{
+    int i;
+
+    if (word_count < 2) {
+        MR_trace_usage("browsing", "push_list_dir");
+        return KEEP_INTERACTING;
+    }
+
+    /* rafe: XXX Maybe need to use MR_make_aligned_string() for filename? */
+
+    for(i = 1; i < word_count; i++) {
+        MR_TRACE_CALL_MERCURY(
+            MR_listing__push_file_name_path((MR_String) words[i],
+                MR_listings_state, &MR_listings_state);
+        );
+    }
+
+    return KEEP_INTERACTING;
+}
+
+static MR_Next
+MR_trace_pop_list_dir(char **words, int word_count,
+    MR_Trace_Cmd_Info *cmd, MR_Event_Info *event_info,
+    MR_Event_Details *event_details, MR_Code **jumpaddr)
+{
+    if (word_count > 1) {
+        MR_trace_usage("browsing", "pop_list_dir");
+        return KEEP_INTERACTING;
+    }
+
+    MR_TRACE_CALL_MERCURY(
+        MR_listing__pop_file_name_path(MR_listings_state, &MR_listings_state);
+    );
+
+    return KEEP_INTERACTING;
+}
+
 static MR_Next
 MR_trace_cmd_break(char **words, int word_count, MR_Trace_Cmd_Info *cmd,
     MR_Event_Info *event_info, MR_Event_Details *event_details,
@@ -8357,6 +8475,12 @@
         NULL, MR_trace_var_completer },
     { "browsing", "save_to_file", MR_trace_cmd_save_to_file,
         NULL, MR_trace_var_completer },
+    { "browsing", "list", MR_trace_list_part_of_file,
+        NULL, MR_trace_null_completer },
+    { "browsing", "push_list_dir", MR_trace_push_list_dir,
+        NULL, MR_trace_null_completer },
+    { "browsing", "pop_list_dir", MR_trace_pop_list_dir,
+        NULL, MR_trace_null_completer },
 
     { "breakpoint", "break", MR_trace_cmd_break,
         MR_trace_break_cmd_args, MR_trace_proc_spec_completer },

--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------



More information about the reviews mailing list