[m-rev.] for review: Let mdb run an external command for 'list'.

Peter Wang novalazy at gmail.com
Fri Oct 2 16:36:39 AEST 2020


On Fri, 02 Oct 2020 15:22:50 +1000 "Zoltan Somogyi" <zoltan.somogyi at runbox.com> wrote:
> 
> 2020-10-02 13:59 GMT+10:00 "Peter Wang" <novalazy at gmail.com>:
> > --- a/NEWS
> > +++ b/NEWS
> > @@ -131,6 +131,14 @@ Changes to the Mercury compiler
> >   keep opt1 enabled even if opt1 is not normally enabled at optimization
> >   level N.
> > +Changes to the Mercury implementation
> > +-------------------------------------
> > +
> > +* The `list` command in mdb (the Mercury debugger) may now call an external
> > +  command to print source listings; the command is set using `list_cmd`.
> > +  For example, the command could produce syntax highlighted source listings.
> 
> Is there  a command that can do so for Mercury code?

Yes, bat (https://github.com/sharkdp/bat) can do so with a
.sublime-syntax definition in ~/.config/bat/syntaxes.

I automatically converted the tmLanguage file from
https://github.com/sebgod/mercury-tmlanguage using Sublime Text.
I'm sure it can be improved.

I've attached the syntax file and a screenshot.
The list_cmd is set to a script containing

     #!/bin/sh
     exec bat -l mercury -r "$2:$3" -H "$4" "$1"

Note that the decorations that bat adds by default can be turned off.

> > -:- func mercury_stream_to_c_FILE_star(io.input_stream) = c_file_ptr.
> > +:- pred find_file(search_path::in, file_name::in, maybe(file_name)::out,
> > +    io::di, io::uo) is det.
> > -:- pragma foreign_proc("C",
> > -    mercury_stream_to_c_FILE_star(InStream::in) = (InStrm::out),
> > -    [promise_pure, thread_safe, will_not_call_mercury],
> > -"
> > -    InStrm = MR_file(*(MR_unwrap_input_stream(InStream)));
> > -")
> 
> Shouldn't this be next to its almost-identical pair?
> 

Do you mean mercury_stream_to_c_FILE_star? I just moved it up.

> > +find_file([], _, no, !IO).
> > +find_file([Dir | Path], FileName0, Result, !IO) :-
> > +    FileName = Dir / FileName0,
> > +    io.check_file_accessibility(FileName, [read], AccessRes, !IO),
> > +    (
> > +        AccessRes = ok,
> > +        Result = yes(FileName)
> > +    ;
> > +        AccessRes = error(_),
> > +        find_file(Path, FileName0, Result, !IO)
> > +    ).
> 
> Why do you call this only for relative pathnames?

By "this", do you mean the call to io.check_file_accessibility?
The readability check was really a check for file existence.
I've replaced it with a call to io.file_type instead.

> > +to standard output, and report any errors to standard error.
> > + at sp 1
> > + at item list_cmd
> > +When invoked without arguments, the @samp{list_cmd} command
> > +prints the last value set by the @samp{list_cmd} command.
> 
> If you decide you don't like the selected external command,
> is there any way to undo a list_cmd, without restarting mdb?

There wasn't.

> > --- a/trace/mercury_trace_cmd_parameter.c
> > +++ b/trace/mercury_trace_cmd_parameter.c
> > @@ -61,6 +61,8 @@ MR_Word                 MR_listing_path;
> >  MR_Unsigned             MR_num_context_lines = 2;
> > +char                    *MR_listing_cmd = NULL;
> > +
> > MR_SpyWhen              MR_default_breakpoint_scope = MR_SPY_INTERFACE;
> >  ////////////////////////////////////////////////////////////////////////////
> > @@ -582,6 +584,34 @@ MR_trace_cmd_pop_list_dir(char **words, int word_count,
> >     return KEEP_INTERACTING;
> > }
> > +MR_Next
> > +MR_trace_cmd_list_cmd(char **words, int word_count,
> > +    MR_TraceCmdInfo *cmd, MR_EventInfo *event_info, MR_Code **jumpaddr)
> > +{
> > +    if (word_count == 2) {
> > +        char    *copied_value;
> > +        char    *aligned_value;
> > +
> > +        copied_value = (char *) MR_GC_malloc(strlen(words[1]) + 1);
> > +        strcpy(copied_value, words[1]);
> > +        MR_TRACE_USE_HP(
> > +            MR_make_aligned_string(aligned_value, copied_value);
> > +        );
> > +        MR_listing_cmd = aligned_value;
> 
> I would add a test here: if words[1] is "none", then set MR_listing_cmd
> to NULL.

Done.

I've followed your other suggestions. Here is the interdiff.

diff --git a/browser/listing.m b/browser/listing.m
index 8c79ebd47..c074bb692 100644
--- a/browser/listing.m
+++ b/browser/listing.m
@@ -94,8 +94,9 @@
     %
     %   FileName, FirstLine, LastLine, MarkLine
     %
-    % It should produce output on standard output, and report errors on
-    % standard error.
+    % The command should print all the lines from the first to the last,
+    % both inclusive, with the current line marked (or highlighted) in
+    % some fashion to standard output, and report any errors to standard error.
     %
 :- pred list_file_with_command(c_file_ptr::in, c_file_ptr::in, string::in,
     file_name::in, line_no::in, line_no::in, line_no::in, search_path::in,
@@ -106,6 +107,7 @@
 
 :- implementation.
 
+:- import_module bool.
 :- import_module dir.
 :- import_module int.
 :- import_module maybe.
@@ -176,39 +178,37 @@ list_file(OutStrm, ErrStrm, FileName, FirstLine, LastLine, MarkLine, Path,
         io.open_input(FileName, Result0, !IO),
         (
             Result0 = ok(InStream),
-            InStrm = mercury_stream_to_c_FILE_star(InStream),
+            InStrm = mercury_stream_to_c_file_ptr(InStream),
             print_lines_in_range_c(InStrm, OutStrm, 1, FirstLine, LastLine,
                 MarkLine, !IO),
             io.close_input(InStream, !IO)
         ;
             Result0 = error(Error),
             ErrorMsg = io.error_message(Error),
-            write_to_c_file(ErrStrm, "mdb: cannot open file ", !IO),
-            write_to_c_file(ErrStrm, FileName, !IO),
-            write_to_c_file(ErrStrm, ": ", !IO),
-            write_to_c_file(ErrStrm, ErrorMsg, !IO),
-            write_to_c_file(ErrStrm, "\n", !IO)
+            write_to_c_file(ErrStrm,
+                string.format("mdb: cannot open file %s: %s\n",
+                    [s(FileName), s(ErrorMsg)]), !IO)
         )
     else
         find_and_open_file([dir.this_directory | Path], FileName, Result, !IO),
         (
             Result = yes(InStream),
-            InStrm = mercury_stream_to_c_FILE_star(InStream),
+            InStrm = mercury_stream_to_c_file_ptr(InStream),
             print_lines_in_range_c(InStrm, OutStrm, 1, FirstLine, LastLine,
                 MarkLine, !IO),
             io.close_input(InStream, !IO)
         ;
             Result = no,
-            write_to_c_file(ErrStrm, "mdb: cannot find file ", !IO),
-            write_to_c_file(ErrStrm, FileName, !IO),
-            write_to_c_file(ErrStrm, "\n", !IO)
+            write_to_c_file(ErrStrm,
+                string.format("mdb: cannot find file %s\n",
+                    [s(FileName)]), !IO)
         )
     ).
 
-:- func mercury_stream_to_c_FILE_star(io.input_stream) = c_file_ptr.
+:- func mercury_stream_to_c_file_ptr(io.input_stream) = c_file_ptr.
 
 :- pragma foreign_proc("C",
-    mercury_stream_to_c_FILE_star(InStream::in) = (InStrm::out),
+    mercury_stream_to_c_file_ptr(InStream::in) = (InStrm::out),
     [promise_pure, thread_safe, will_not_call_mercury],
 "
     InStrm = MR_file(*(MR_unwrap_input_stream(InStream)));
@@ -277,15 +277,13 @@ list_file_with_command(OutStrm, ErrStrm, Command, FileName, FirstLine,
             CallResult = ok
         ;
             CallResult = error(Error),
-            write_to_c_file(ErrStrm, "mdb: error running command: ", !IO),
-            write_to_c_file(ErrStrm, Error, !IO),
-            write_to_c_file(ErrStrm, "\n", !IO)
+            write_to_c_file(ErrStrm,
+                string.format("mdb: %s: %s\n", [s(Command), s(Error)]), !IO)
         )
     ;
         FindResult = no,
-        write_to_c_file(ErrStrm, "mdb: cannot find file ", !IO),
-        write_to_c_file(ErrStrm, FileName, !IO),
-        write_to_c_file(ErrStrm, "\n", !IO)
+        write_to_c_file(ErrStrm,
+            string.format("mdb: cannot find file %s\n", [s(FileName)]), !IO)
     ).
 
 :- pred execute_command(c_file_ptr::in, c_file_ptr::in, string::in,
@@ -334,12 +332,30 @@ find_and_open_file([Dir | Path], FileName, Result, !IO) :-
 find_file([], _, no, !IO).
 find_file([Dir | Path], FileName0, Result, !IO) :-
     FileName = Dir / FileName0,
-    io.check_file_accessibility(FileName, [read], AccessRes, !IO),
+    FollowSymLinks = yes,
+    io.file_type(FollowSymLinks, FileName, FileTypeRes, !IO),
     (
-        AccessRes = ok,
+        FileTypeRes = ok(FileType),
+        (
+            ( FileType = regular_file
+            ; FileType = symbolic_link
+            ; FileType = named_pipe
+            ; FileType = socket
+            ; FileType = character_device
+            ; FileType = block_device
+            ; FileType = message_queue
+            ; FileType = semaphore
+            ; FileType = shared_memory
+            ; FileType = unknown
+            ),
             Result = yes(FileName)
         ;
-        AccessRes = error(_),
+            FileType = directory,
+            % It is debatable whether we should continue searching.
+            find_file(Path, FileName0, Result, !IO)
+        )
+    ;
+        FileTypeRes = error(_),
         find_file(Path, FileName0, Result, !IO)
     ).
 
diff --git a/doc/user_guide.texi b/doc/user_guide.texi
index eebd30ad7..8de22baae 100644
--- a/doc/user_guide.texi
+++ b/doc/user_guide.texi
@@ -4112,17 +4112,22 @@ on to the search path consulted by the @samp{list} command.
 Pops the leftmost (most recently pushed) directory
 from the search path consulted by the @samp{list} command.
 @sp 1
- at item list_cmd @var{command}
+ at item list_cmd @var{ExternalCommand}
 @kindex list_cmd (mdb command)
-Sets an external command to be executed by the @samp{list} command.
+Tells mdb that all future @samp{list} commands should be handled by
+ at var{ExternalCommand}.
 The command will be called with four arguments:
 the source file name,
 the first line number (counting from 1),
 the last line number,
 the current line number.
-The command should print the lines within the range given
+The command should print all the lines from the first to the last,
+both inclusive, with the current line marked (or highlighted) in some fashion
 to standard output, and report any errors to standard error.
 @sp 1
+If @var{ExternalCommand} is @samp{none} then the @samp{list} command
+will revert to printing source listings internally.
+ at sp 1
 @item list_cmd
 When invoked without arguments, the @samp{list_cmd} command
 prints the last value set by the @samp{list_cmd} command.
diff --git a/trace/mercury_trace_cmd_parameter.c b/trace/mercury_trace_cmd_parameter.c
index da105aa6c..07246a37f 100644
--- a/trace/mercury_trace_cmd_parameter.c
+++ b/trace/mercury_trace_cmd_parameter.c
@@ -589,6 +589,9 @@ MR_trace_cmd_list_cmd(char **words, int word_count,
     MR_TraceCmdInfo *cmd, MR_EventInfo *event_info, MR_Code **jumpaddr)
 {
     if (word_count == 2) {
+        if (MR_streq(words[1], "none")) {
+            MR_listing_cmd = NULL;
+        } else {
             char    *copied_value;
             char    *aligned_value;
 
@@ -598,12 +601,13 @@ MR_trace_cmd_list_cmd(char **words, int word_count,
                 MR_make_aligned_string(aligned_value, copied_value);
             );
             MR_listing_cmd = aligned_value;
+        }
     } else if (word_count == 1) {
         if (MR_listing_cmd != NULL && strlen(MR_listing_cmd) > 0) {
             fprintf(MR_mdb_out, "The external listing command is %s\n",
                 MR_listing_cmd);
         } else {
-            fprintf(MR_mdb_out, "The external listing command has not been set.\n");
+            fprintf(MR_mdb_out, "No external listing command has been set.\n");
         }
     } else {
         MR_trace_usage_cur_cmd();

Peter
-------------- next part --------------
%YAML 1.2
---
# http://www.sublimetext.com/docs/3/syntax.html
name: Mercury
file_extensions:
  - m
  - moo
scope: source.mercury
contexts:
  main:
    - include: number
    - include: string_quoted_double
    - include: inline_bin_op
    - include: atom
    - include: block_comment
    - include: line_comment
    - include: decl_keywords
    - include: purity_level
    - include: declarations
    - include: common_ops
    - include: determ_keywords
    - include: logic_keywords
    - include: foreign_mods
    - include: variables
  atom:
    - match: "'"
      captures:
        0: punctuation.definition.string.begin.source.mercury
      push:
        - meta_scope: string.quoted.single.source.mercury
        - match: "'(?!['])"
          captures:
            0: punctuation.definition.string.end.source.mercury
          pop: true
        - match: \\.
          scope: constant.character.escape.source.mercury
        - match: \'\'
          scope: constant.character.escape.quote.source.mercury
  block_comment:
    - match: /\*
      captures:
        0: punctuation.definition.comment.source.mercury
      push:
        - meta_scope: comment.block.source.mercury
        - match: \*/
          captures:
            0: punctuation.definition.comment.source.mercury
          pop: true
  common_ops:
    - match: '(-(?![>-])|[+](?![+])|[*][*]?|/(?![\\/])|//|\\(?![/=]))'
      scope: keyword.operator.arithmetic.source.mercury
    - match: "(=<|>=|<(?![=])|(?![-])>)"
      scope: keyword.operator.comparison.source.mercury
    - match: '(<=>|<=|=>|\\=|==|:-|=(?![=<>])|,|;|->|/\\(?![=])|\\/|@)'
      scope: keyword.operator.logic.source.mercury
    - match: '(-->|--->|[+][+](?![+])|::|:=|![\.:]?|\||\^)'
      scope: keyword.operator.other.source.mercury
    - match: '(\(|\)|\[|\]|\{|\})'
      scope: keyword.operator.list.source.mercury
    - match: '\.(?=[ \t]*($|%))'
      scope: keyword.operator.terminator.source.mercury
  decl_keywords:
    - match: \b(is|where)\b
      scope: keyword.control.declaration.source.mercury
  declarations:
    - match: '(?x)(^[ \t]*:-)[ ]((use|include|end|import|)_module|module |func|pred|type(class)?|inst(ance)? |mode|interface|implementation )\b'
      scope: keyword.control.declaration.source.mercury
      captures:
        1: keyword.operator.logic.source.mercury
    - match: '(?x)(^[ \t]*:-)[ ](pragma)[ ](check_termination|does_not_terminate|fact_table |inline|loop_check|memo|minimal_model|no_inline |obsolete|promise_equivalent_clauses|source_file |terminates|type_spec |foreign_(proc|type|decl|code|export(_enum)? |enum|import_module) )\b'
      scope: constant.language.pragma.source.mercury
      captures:
        1: keyword.operator.logic.source.mercury
        2: keyword.control.pragma.source.mercury
  determ_keywords:
    - match: (?x)\b(require_(_switch_arms)?)?(multi|cc_(multi|nondet) |det|semidet|nondet |errorneous|failure )\b
      scope: constant.language.determ.source.mercury
  foreign_mods:
    - match: (?x)\b(affects_liveness|(does_not|doesnt)_affect_liveness |attach_to_io_state |can_pass_as_mercury_type|stable |(may_call|will_not)(_call_mercury|_modify) |(may_)(not_)?_duplicate |(no_|unknown_)?sharing|tabled_for_io|local |(un)?trailed |(not_|maybe_)?thread_safe |will_not_throw_exception )\b
      scope: storage.type.source.mercury
  impl_defined_variable:
    - match: '[$][a-zA-Z0-9_]*\b'
      scope: variable.language.source.mercury
  inline_bin_op:
    - match: "`[^`]+`"
      scope: keyword.operator.other.source.mercury
  line_comment:
    - match: '(^[ \t]+)?(%([-]+%)?)'
      captures:
        1: punctuation.whitespace.comment.leading.source.mercury
        2: comment.line.percentage.source.mercury
      push:
        - meta_scope: comment.comment.source.mercury
        - match: (?!\G)
          pop: true
        - match: '(([ \t]+(XXX|TODO|FIXME|WARNING|IMPORTANT|NOTE(_TO_IMPLEMENTORS)?)\b)*)(.*)'
          captures:
            0: comment.comment.source.mercury
            1: constant.language.warn.source.mercury
  logic_keywords:
    - match: (?x)\b(yes|no|true|false|(semidet_)?succeed|(semidet_)?fail |some|all|require_complete_switch )\b
      scope: constant.language.logic.source.mercury
  number:
    - match: '\b(0(?![''])[0-7]*|0[''].|[1-9][0-9]*|\.[0-9]+([eE][0-9]+)?|0[xX][0-9a-fA-F]+|0[bB][01]+)\b'
      scope: constant.numeric.source.mercury
  purity_level:
    - match: \b((promise_)(semi)?pure|(im|semi)?pure)\b
      scope: storage.type.source.mercury
  singleton_variable:
    - match: '\b_[A-Z]?[a-zA-Z0-9_]*\b'
      scope: support.variable
  string_quoted_double:
    - match: '"'
      captures:
        0: punctuation.literal.string.begin.source.mercury
      push:
        - meta_scope: string.quoted.double.source.mercury
        - match: '"(?!")'
          captures:
            0: punctuation.literal.string.end.source.mercury
          pop: true
        - match: \\.
          scope: constant.character.escapesource.mercury
        - match: '""'
          scope: constant.character.escape.quote.source.mercury
        - match: '%[I]?[-+# *\.0-9]*[dioxXucsfeEgGp]'
          scope: constant.character.escape.format.source.mercury
  variable:
    - match: '\b[A-Z][a-zA-Z0-9_]*\b'
      scope: variable.other
  variables:
    - include: impl_defined_variable
    - include: singleton_variable
    - include: variable
-------------- next part --------------
A non-text attachment was scrubbed...
Name: mdb-list-bat.png
Type: image/png
Size: 28378 bytes
Desc: not available
URL: <http://lists.mercurylang.org/archives/reviews/attachments/20201002/6c7e93f4/attachment-0001.png>


More information about the reviews mailing list