[m-rev.] for post-commit review: new "addr" command in term browser

Zoltan Somogyi zs at csse.unimelb.edu.au
Mon Aug 31 09:09:09 AEST 2009


For post-commit review by anyone. Does anyone know where the documentation
referred to below is?

Zoltan.

Implement a command within the term browser that prints the representation
of the selected term. The command is named "addr" or "memory_addr", since
it adds new functionality only if the term is a possibly tagged pointer.
(If it is an integer or character, a plain "print" command would already
do the job.) This is intended mainly for Mercury system developers.

Note that this diff does not add documentation of the new browser command,
because I cannot find anyplace the existing browser commands are documented,
so I do not know where to add the documentation to.

browser/parse.m:
	Put the browser command types in a logical order, with related commands
	being together.

	Make the code that recognizes browser command types have the same order
	as the definition of the browser command type.

	Add code to recognize the new command for the new functionality.

	Add prefixes to the function symbols of the command and token types
	to avoid ambiguities, and avoid using graphic characters that need to
	be quoted.

browser/browser_info.m:
	Add prefixes to the function symbols of the debugger type
	to avoid using the keyword "external" as a function symbol.

browser/browse.m:
	Make the switch on the browser command type have the same order as the
	definition of the browser command type.

	Add code to implement the new command.

browser/declarative_user.m:
	Conform to the changes above.

cvs diff: Diffing .
Index: browse.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/browse.m,v
retrieving revision 1.73
diff -u -b -r1.73 browse.m
--- browse.m	23 Nov 2007 07:34:50 -0000	1.73
+++ browse.m	23 Aug 2009 12:13:53 -0000
@@ -488,7 +488,7 @@
     ;
         true
     ),
-    portray(internal, Caller, no, Info, !IO),
+    portray(debugger_internal, Caller, no, Info, !IO),
     io.set_output_stream(OldStream, _, !IO).
 
 %---------------------------------------------------------------------------%
@@ -498,30 +498,30 @@
 
 browse_browser_term_no_modes(Term, InputStream, OutputStream,
         MaybeTrack, !State, !IO) :-
-    browse_common(internal, Term, InputStream, OutputStream, no, no,
-        MaybeTrack, !State, !IO).
+    browse_common(debugger_internal, Term, InputStream, OutputStream,
+        no, no, MaybeTrack, !State, !IO).
 
 browse_browser_term(Term, InputStream, OutputStream, MaybeModeFunc,
         MaybeTrack, !State, !IO) :-
-    browse_common(internal, Term, InputStream, OutputStream, no,
-        MaybeModeFunc, MaybeTrack, !State, !IO).
+    browse_common(debugger_internal, Term, InputStream, OutputStream,
+        no, MaybeModeFunc, MaybeTrack, !State, !IO).
 
 browse_browser_term_format_no_modes(Term, InputStream, OutputStream,
         Format, !State, !IO) :-
-    browse_common(internal, Term, InputStream, OutputStream, yes(Format),
-        no, _, !State, !IO).
+    browse_common(debugger_internal, Term, InputStream, OutputStream,
+        yes(Format), no, _, !State, !IO).
 
 browse_browser_term_format(Term, InputStream, OutputStream,
         Format, MaybeModeFunc, !State, !IO) :-
-    browse_common(internal, Term, InputStream, OutputStream, yes(Format),
-        MaybeModeFunc, _, !State, !IO).
+    browse_common(debugger_internal, Term, InputStream, OutputStream,
+        yes(Format), MaybeModeFunc, _, !State, !IO).
 
 browse_external_no_modes(Term, InputStream, OutputStream, !State, !IO) :-
-    browse_common(external, plain_term(univ(Term)),
+    browse_common(debugger_external, plain_term(univ(Term)),
         InputStream, OutputStream, no, no, _, !State, !IO).
 
 browse_external(Term, InputStream, OutputStream, MaybeModeFunc, !State, !IO) :-
-    browse_common(external, plain_term(univ(Term)),
+    browse_common(debugger_external, plain_term(univ(Term)),
         InputStream, OutputStream, no, MaybeModeFunc, _, !State, !IO).
 
 :- pred browse_common(debugger::in, browser_term::in, io.input_stream::in,
@@ -548,10 +548,10 @@
 
 browse_main_loop(Debugger, !Info, !IO) :-
     (
-        Debugger = internal,
+        Debugger = debugger_internal,
         parse.read_command(prompt, Command, !IO)
     ;
-        Debugger = external,
+        Debugger = debugger_external,
         parse.read_command_external(Command, !IO)
     ),
     run_command(Debugger, Command, Quit, !Info, !IO),
@@ -559,10 +559,10 @@
         Quit = yes,
         % write_string_debugger(Debugger, "quitting...\n", !IO)
         (
-            Debugger = external,
+            Debugger = debugger_external,
             send_term_to_socket(browser_quit, !IO)
         ;
-            Debugger = internal
+            Debugger = debugger_internal
         )
     ;
         Quit = no,
@@ -583,61 +583,59 @@
     browser_info::in, browser_info::out, io::di, io::uo) is cc_multi.
 
 run_command(Debugger, Command, Quit, !Info, !IO) :-
+    % Please keep the code implementing commands in the same order
+    % as the definition of the command type.
+
     % XXX The commands `set', `ls' and `print' should allow the format
     % to be specified by an option. In each case we instead pass `no' to
     % the respective handler.
     (
-        Command = empty,
+        Command = cmd_print(PrintOption, MaybePath),
+        do_portray(Debugger, browse, PrintOption, !.Info, MaybePath, !IO),
         Quit = no
     ;
-        Command = unknown,
-        write_string_debugger(Debugger,
-            "Error: unknown command or syntax error.\n", !IO),
-        write_string_debugger(Debugger, "Type \"help\" for help.\n", !IO),
+        Command = cmd_display,
+        write_string_debugger(Debugger, "command not yet implemented\n", !IO),
         Quit = no
     ;
-        Command = help,
-        help(Debugger, !IO),
+        Command = cmd_write,
+        write_string_debugger(Debugger, "command not yet implemented\n", !IO),
         Quit = no
     ;
-        Command = param_command(ParamCmd),
-        run_param_command(Debugger, ParamCmd, yes, !Info, !IO),
+        Command = cmd_memory_addr(MaybePath),
+        do_print_memory_addr(Debugger, !.Info, MaybePath, !IO),
         Quit = no
     ;
-        Command = cd_no_path,
+        Command = cmd_cd_no_path,
         set_path(root_rel([]), !Info),
         Quit = no
     ;
-        Command = cd_path(Path),
+        Command = cmd_cd_path(Path),
         change_dir(!.Info ^ dirs, Path, NewPwd),
-        deref_subterm(!.Info ^ term, NewPwd, [], Result),
+        deref_subterm(!.Info ^ term, NewPwd, Result),
         (
             Result = deref_result(_),
-            !:Info = !.Info ^ dirs := NewPwd
+            !Info ^ dirs := NewPwd
         ;
             Result = deref_error(OKPath, ErrorDir),
             report_deref_error(Debugger, OKPath, ErrorDir, !IO)
         ),
         Quit = no
     ;
-        Command = print(PrintOption, MaybePath),
-        do_portray(Debugger, browse, PrintOption, !.Info, MaybePath, !IO),
-        Quit = no
-    ;
-        Command = pwd,
+        Command = cmd_pwd,
         write_path(Debugger, !.Info ^ dirs, !IO),
         nl_debugger(Debugger, !IO),
         Quit = no
     ;
-        Command = track(HowTrack, ShouldAssertInvalid, MaybePath),
+        Command = cmd_track(HowTrack, ShouldAssertInvalid, MaybePath),
         (
             MaybePath = yes(Path),
             change_dir(!.Info ^ dirs, Path, NewPwd),
-            deref_subterm(!.Info ^ term, NewPwd, [], SubResult),
+            deref_subterm(!.Info ^ term, NewPwd, SubResult),
             (
                 SubResult = deref_result(_),
-                !:Info = !.Info ^ maybe_track := track(HowTrack,
-                    ShouldAssertInvalid, NewPwd),
+                !Info ^ maybe_track :=
+                    track(HowTrack, ShouldAssertInvalid, NewPwd),
                 Quit = yes
             ;
                 SubResult = deref_error(_, _),
@@ -647,39 +645,47 @@
             )
         ;
             MaybePath = no,
-            !:Info = !.Info ^ maybe_track :=
+            !Info ^ maybe_track :=
                 track(HowTrack, ShouldAssertInvalid, !.Info ^ dirs),
             Quit = yes
         )
     ;
-        Command = mode_query,
+        Command = cmd_mode_query(Path),
+        change_dir(!.Info ^ dirs, Path, NewPwd),
         MaybeModeFunc = !.Info ^ maybe_mode_func,
-        write_term_mode_debugger(Debugger, MaybeModeFunc, !.Info ^ dirs, !IO),
+        write_term_mode_debugger(Debugger, MaybeModeFunc, NewPwd, !IO),
         Quit = no
     ;
-        Command = mode_query(Path),
-        change_dir(!.Info ^ dirs, Path, NewPwd),
+        Command = cmd_mode_query_no_path,
         MaybeModeFunc = !.Info ^ maybe_mode_func,
-        write_term_mode_debugger(Debugger, MaybeModeFunc, NewPwd, !IO),
+        write_term_mode_debugger(Debugger, MaybeModeFunc, !.Info ^ dirs, !IO),
         Quit = no
     ;
-        Command = quit,
+        Command = cmd_param(ParamCmd),
+        run_param_command(Debugger, ParamCmd, yes, !Info, !IO),
+        Quit = no
+    ;
+        Command = cmd_help,
+        help(Debugger, !IO),
+        Quit = no
+    ;
+        Command = cmd_quit,
         Quit = yes
     ;
-        Command = display,
-        write_string_debugger(Debugger, "command not yet implemented\n", !IO),
+        Command = cmd_empty,
         Quit = no
     ;
-        Command = write,
+        Command = cmd_unknown,
         write_string_debugger(Debugger,
-            "command not yet implemented\n", !IO),
+            "Error: unknown command or syntax error.\n", !IO),
+        write_string_debugger(Debugger, "Type \"help\" for help.\n", !IO),
         Quit = no
     ),
     (
-        Debugger = external,
+        Debugger = debugger_external,
         send_term_to_socket(browser_end_command, !IO)
     ;
-        Debugger = internal
+        Debugger = debugger_internal
     ).
 
 :- pred do_portray(debugger::in, browse_caller_type::in,
@@ -710,6 +716,50 @@
         )
     ).
 
+:- pred do_print_memory_addr(debugger::in, browser_info::in, maybe(path)::in,
+    io::di, io::uo) is cc_multi.
+
+do_print_memory_addr(Debugger, Info, MaybePath, !IO) :-
+    Dirs0 = Info ^ dirs,
+    (
+        MaybePath = no,
+        Dirs = Dirs0
+    ;
+        MaybePath = yes(Path),
+        change_dir(Dirs0, Path, Dirs)
+    ),
+    deref_subterm(Info ^ term, Dirs, DerefResult),
+    (
+        DerefResult = deref_result(BrowserTerm),
+        (
+            BrowserTerm = plain_term(Univ),
+            Value = univ_value(Univ),
+            get_value_representation(Value, Addr),
+            string.format("addr = %x\n", [i(Addr)], Str)
+        ;
+            BrowserTerm = synthetic_term(_, _, _),
+            Str = "synthetic terms have no addresses\n"
+        ),
+        write_string_debugger(Debugger, Str, !IO)
+    ;
+        DerefResult = deref_error(OKPath, ErrorDir),
+        report_deref_error(Debugger, OKPath, ErrorDir, !IO),
+        nl_debugger(Debugger, !IO)
+    ).
+
+:- pred get_value_representation(T::in, int::out) is cc_multi.
+
+:- pragma foreign_proc("C",
+    get_value_representation(Value::in, Addr::out),
+    [will_not_call_mercury, promise_pure],
+"
+    Addr = (MR_Integer) Value;
+").
+
+% The debugger does not yet work on non-C backends, so what we return
+% does not matter.
+get_value_representation(_Value, 0).
+
 :- pred interpret_format_options(option_table(format_option)::in,
     maybe_error(maybe(portray_format))::out) is det.
 
@@ -806,7 +856,7 @@
 portray(Debugger, Caller, MaybeFormat, Info, !IO) :-
     browser_info.get_format(Info, Caller, MaybeFormat, Format),
     browser_info.get_format_params(Info, Caller, Format, Params),
-    deref_subterm(Info ^ term, Info ^ dirs, [], SubResult),
+    deref_subterm(Info ^ term, Info ^ dirs, SubResult),
     (
         SubResult = deref_result(SubUniv),
         (
@@ -1327,14 +1377,15 @@
 
     % We assume a root-relative path. We assume Term is the entire term
     % passed into browse/3, not a subterm.
-:- pred deref_subterm(browser_term::in, list(dir)::in, list(dir)::in,
+    %
+:- pred deref_subterm(browser_term::in, list(dir)::in,
     deref_result(browser_term)::out) is cc_multi.
 
-deref_subterm(BrowserTerm, Path, RevPath0, Result) :-
+deref_subterm(BrowserTerm, Path, Result) :-
     simplify_dirs(Path, SimplifiedPath),
     (
         BrowserTerm = plain_term(Univ),
-        deref_subterm_2(Univ, SimplifiedPath, RevPath0, SubResult),
+        deref_subterm_2(Univ, SimplifiedPath, [], SubResult),
         deref_result_univ_to_browser_term(SubResult, Result)
     ;
         BrowserTerm = synthetic_term(_Functor, Args, MaybeReturn),
@@ -1363,11 +1414,11 @@
                     MaybeReturn = yes(ArgUniv)
                 )
             ->
-                deref_subterm_2(ArgUniv, SimplifiedPathTail,
-                    [Step | RevPath0], SubResult),
+                deref_subterm_2(ArgUniv, SimplifiedPathTail, [Step],
+                    SubResult),
                 deref_result_univ_to_browser_term(SubResult, Result)
             ;
-                Result = deref_error(list.reverse(RevPath0), Step)
+                Result = deref_error([], Step)
             )
         )
     ).
Index: browser_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/browser_info.m,v
retrieving revision 1.35
diff -u -b -r1.35 browser_info.m
--- browser_info.m	23 Nov 2007 07:34:50 -0000	1.35
+++ browser_info.m	23 Aug 2009 11:20:50 -0000
@@ -267,8 +267,8 @@
 %   ;       xml_tmp_filename(string)
 
 :- type debugger
-    --->    internal
-    ;       external.
+    --->    debugger_internal
+    ;       debugger_external.
 %
 % If the term browser is called from the internal debugger, input is
 % done via a call to the readline library (if available), using streams
@@ -952,24 +952,24 @@
 width_len     = 10.
 lines_len     = 10.
 
-nl_debugger(internal, !IO) :-
+nl_debugger(debugger_internal, !IO) :-
     io.nl(!IO).
-nl_debugger(external, !IO) :-
+nl_debugger(debugger_external, !IO) :-
     send_term_to_socket(browser_nl, !IO).
 
-write_string_debugger(internal, String, !IO) :-
+write_string_debugger(debugger_internal, String, !IO) :-
     io.write_string(String, !IO).
-write_string_debugger(external, String, !IO) :-
+write_string_debugger(debugger_external, String, !IO) :-
     send_term_to_socket(browser_str(String), !IO).
 
-write_int_debugger(internal, Int, !IO) :-
+write_int_debugger(debugger_internal, Int, !IO) :-
     io.write_int(Int, !IO).
-write_int_debugger(external, Int, !IO) :-
+write_int_debugger(debugger_external, Int, !IO) :-
     send_term_to_socket(browser_int(Int), !IO).
 
-print_format_debugger(internal, X, !IO) :-
+print_format_debugger(debugger_internal, X, !IO) :-
     io.print(X, !IO).
-print_format_debugger(external, X, !IO) :-
+print_format_debugger(debugger_external, X, !IO) :-
     (
         X = flat,
         send_term_to_socket(browser_str("flat"), !IO)
@@ -1048,10 +1048,10 @@
 ].
 
 :- instance stream.output(debugger, io) where [
-    (flush(internal, !IO) :-
+    (flush(debugger_internal, !IO) :-
         io.flush_output(!IO)
     ),
-    (flush(external, !IO) :-
+    (flush(debugger_external, !IO) :-
         % XXX
         true
     )
Index: declarative_user.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/declarative_user.m,v
retrieving revision 1.68
diff -u -b -r1.68 declarative_user.m
--- declarative_user.m	30 Dec 2007 11:11:06 -0000	1.68
+++ declarative_user.m	23 Aug 2009 11:52:33 -0000
@@ -340,7 +340,7 @@
     Browser0 = !.User ^ browser,
     DummyTerm = synthetic_term("", [], no),
     Info0 = browser_info(DummyTerm, [], print, no, Browser0, no_track, no),
-    run_param_command(internal, ParamCommand, no, Info0, Info, !IO),
+    run_param_command(debugger_internal, ParamCommand, no, Info0, Info, !IO),
     Info = browser_info(_, _, _, _, Browser, _, _),
     !:User = !.User ^ browser := Browser,
     query_user(UserQuestion, Response, !User, !IO).
@@ -960,11 +960,12 @@
 
 :- pred format_arg_cmd(list(string)::in, user_command::out) is semidet.
 
-format_arg_cmd(ArgWords,
-        user_cmd_param_command(format(MaybeOptionTable, Setting))) :-
+format_arg_cmd(ArgWords, UserCommand) :-
     ArgWords = [_ | _],
-    parse.parse(["format" | ArgWords],
-        param_command(format(MaybeOptionTable, Setting))).
+    parse.parse(["format" | ArgWords], Command),
+    Command = cmd_param(FormatCmd),
+    FormatCmd = format(MaybeOptionTable, Setting),
+    UserCommand = user_cmd_param_command(format(MaybeOptionTable, Setting)).
 
 :- pred format_param_arg_cmd(string::in, list(string)::in,
     user_command::out) is semidet.
@@ -977,9 +978,10 @@
         ArgWords = ArgWords0,
         HasIOArg = no : bool
     ),
-    ArgWords \= [],
+    ArgWords = [_ | _],
     parse.parse([Cmd | ArgWords], ParsedCommand),
-    ParsedCommand = param_command(format_param(MaybeOptionTable0, Setting)),
+    ParsedCommand = cmd_param(FormatCmd),
+    FormatCmd = format_param(MaybeOptionTable0, Setting),
     ( 
         HasIOArg = yes,
         % Since the command was invoked with the `io' argument we want to
Index: parse.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/parse.m,v
retrieving revision 1.35
diff -u -b -r1.35 parse.m
--- parse.m	30 Dec 2007 11:11:06 -0000	1.35
+++ parse.m	29 Aug 2009 20:38:46 -0000
@@ -128,20 +128,21 @@
 %---------------------------------------------------------------------------%
 
 :- type command
-    --->    print(maybe(maybe_option_table(format_option)), maybe(path))
-    ;       cd_path(path)
-    ;       cd_no_path
-    ;       track(how_track_subterm, should_assert_invalid, maybe(path))
-    ;       mode_query(path)
-    ;       mode_query
-    ;       pwd
-    ;       help
-    ;       param_command(param_cmd)
-    ;       quit
-    ;       display
-    ;       write
-    ;       empty
-    ;       unknown.
+    --->    cmd_print(maybe(maybe_option_table(format_option)), maybe(path))
+    ;       cmd_display
+    ;       cmd_write
+    ;       cmd_memory_addr(maybe(path))
+    ;       cmd_cd_path(path)
+    ;       cmd_cd_no_path
+    ;       cmd_pwd
+    ;       cmd_track(how_track_subterm, should_assert_invalid, maybe(path))
+    ;       cmd_mode_query(path)
+    ;       cmd_mode_query_no_path
+    ;       cmd_param(param_cmd)
+    ;       cmd_help
+    ;       cmd_quit
+    ;       cmd_empty
+    ;       cmd_unknown.
 
 :- type format_param_cmd
     --->    param_depth
@@ -198,24 +199,24 @@
 :- import_module string.
 
 :- type token
-    --->    (.)
-    ;       (..)
-    ;       (/)
-    ;       (?)
-    ;       (^)
-    ;       (<)
-    ;       num(int)
-    ;       name(string)
-    ;       arg(string)
-    ;       unknown(char).
+    --->    token_dot
+    ;       token_dot_dot
+    ;       token_slash
+    ;       token_question
+    ;       token_up
+    ;       token_lessthan
+    ;       token_num(int)
+    ;       token_name(string)
+    ;       token_arg(string)
+    ;       token_unknown(char).
 
 read_command(Prompt, Command, !IO) :-
     util.trace_get_command(Prompt, Line, !IO),
     string.words_separator(char.is_whitespace, Line) = Words,
-    ( parse(Words, Command2) ->
-        Command = Command2
+    ( parse(Words, CommandPrime) ->
+        Command = CommandPrime
     ;
-        Command = unknown
+        Command = cmd_unknown
     ).
 
 read_command_external(Command, !IO) :-
@@ -223,17 +224,17 @@
     (
         Result = ok(external_request(StringToParse)),
         string.words_separator(char.is_whitespace, StringToParse) = Words,
-        ( parse(Words, Command2) ->
-            Command = Command2
+        ( parse(Words, CommandPrime) ->
+            Command = CommandPrime
         ;
-            Command = unknown
+            Command = cmd_unknown
         )
     ;
         Result = eof,
-        Command = quit
+        Command = cmd_quit
     ;
         Result = error(_, _),
-        Command = unknown
+        Command = cmd_unknown
     ).
 
 :- pred lexer_words(list(string)::in, list(token)::out) is det.
@@ -257,16 +258,16 @@
     ( C = ('.') ->
         lexer_dots(Cs, Toks)
     ; C = ('/') ->
-        Toks = [(/) | Toks2],
+        Toks = [token_slash | Toks2],
         lexer_word_chars(Cs, Toks2)
     ; C = ('?') ->
-        Toks = [(?) | Toks2],
+        Toks = [token_question | Toks2],
         lexer_word_chars(Cs, Toks2)
     ; C = ('^') ->
-        Toks = [(^) | Toks2],
+        Toks = [token_up | Toks2],
         lexer_word_chars(Cs, Toks2)
     ; C = ('<') ->
-        Toks = [(<) | Toks2],
+        Toks = [token_lessthan | Toks2],
         lexer_word_chars(Cs, Toks2)
     ; C = ('-'), Cs = [H | T] ->
         lexer_arg([H | T], Toks)
@@ -278,7 +279,7 @@
     ; char.is_whitespace(C) ->
         lexer_word_chars(Cs, Toks)
     ;
-        Toks = [unknown(C) | Toks2],
+        Toks = [token_unknown(C) | Toks2],
         lexer_word_chars(Cs, Toks2)
     ).
 
@@ -287,13 +288,11 @@
 lexer_dots([], []).
 lexer_dots([C | Cs], Toks) :-
     ( C = ('.') ->
-        Tok = (..),
         lexer_word_chars(Cs, Toks2),
-        Toks = [Tok | Toks2]
+        Toks = [token_dot_dot | Toks2]
     ;
-        Tok = (.),
         lexer_word_chars([C | Cs], Toks2),
-        Toks = [Tok | Toks2]
+        Toks = [token_dot | Toks2]
     ).
 
 :- pred dig_to_int(char::in, int::out) is det.
@@ -311,14 +310,14 @@
     ;
         string.from_char_list([Head | Tail], ArgName)
     ),
-    Toks = [arg(ArgName)].
+    Toks = [token_arg(ArgName)].
 
 :- pred lexer_num(int::in, list(char)::in, list(token)::out) is det.
 
 lexer_num(N, Cs, Toks) :-
     list.takewhile(char.is_digit, Cs, Digits, Rest),
     digits_to_int_acc(N, Digits, Num),
-    Toks = [num(Num) | Toks2],
+    Toks = [token_num(Num) | Toks2],
     lexer_word_chars(Rest, Toks2).
 
 :- pred digits_to_int_acc(int::in, list(char)::in, int::out) is det.
@@ -335,14 +334,14 @@
     list.takewhile(char.is_alnum_or_underscore, Cs, Letters, Rest),
     string.from_char_list([C | Letters], Name),
     lexer_word_chars(Rest, Toks2),
-    Toks = [name(Name) | Toks2].
+    Toks = [token_name(Name) | Toks2].
 
 %---------------------------------------------------------------------------%
 
 parse(Words, Command) :-
     (
         Words = [],
-        Command = empty
+        Command = cmd_empty
     ;
         Words = [CmdWord | ArgWords],
         lexer_word(CmdWord, CmdTokens),
@@ -360,7 +359,7 @@
         list.append(CmdTokens, ArgTokens, AllTokens),
         (
             AllTokens = [],
-            Command = empty
+            Command = cmd_empty
         ;
             AllTokens = [FirstToken | LaterTokens],
             parse_cmd(FirstToken, LaterTokens, MaybeArgWords, Command)
@@ -371,52 +370,102 @@
     command::out) is semidet.
 
 parse_cmd(CmdToken, ArgTokens, MaybeArgWords, Command) :-
+    % Please keep the code recognizing commands in the same order
+    % as the definition of the command type.
     (
-        ( CmdToken = name("help")
-        ; CmdToken = (?)
-        ; CmdToken = name("h")
+        ( CmdToken = token_name("print")
+        ; CmdToken = token_name("p")
+        ; CmdToken = token_name("ls")
+        )
+    ->
+        (
+            MaybeArgWords = no,
+            MaybeMaybeOptionTable = no,
+            RemainingTokens = ArgTokens
+        ;
+            MaybeArgWords = yes(ArgWords),
+            OptionOps = option_ops_multi(short_format_option,
+                long_format_option, format_option_defaults),
+            getopt.process_options(OptionOps, ArgWords,
+                RemainingWords, MaybeOptionTable),
+            MaybeMaybeOptionTable = yes(MaybeOptionTable),
+            lexer_words(RemainingWords, RemainingTokens)
+        ),
+        (
+            RemainingTokens = [],
+            MaybePath = no
+        ;
+            RemainingTokens = [_ | _],
+            parse_path(RemainingTokens, Path),
+            MaybePath = yes(Path)
+        ),
+        Command = cmd_print(MaybeMaybeOptionTable, MaybePath)
+    ;
+        ( CmdToken = token_name("display")
+        ; CmdToken = token_name("d")
         )
     ->
         ArgTokens = [],
-        Command = help
+        Command = cmd_display
     ;
-        ( CmdToken = name("cd")
-        ; CmdToken = (^)
+        ( CmdToken = token_name("write")
+        ; CmdToken = token_name("w")
+        )
+    ->
+        ArgTokens = [],
+        Command = cmd_write
+    ;
+        ( CmdToken = token_name("memory_addr")
+        ; CmdToken = token_name("addr")         % "m" and "a" are both taken.
         )
     ->
         (
             ArgTokens = [],
-            Command = cd_no_path
+            MaybePath = no
         ;
             ArgTokens = [_ | _],
             parse_path(ArgTokens, Path),
-            Command = cd_path(Path)
-        )
+            MaybePath = yes(Path)
+        ),
+        Command = cmd_memory_addr(MaybePath)
     ;
-        CmdToken = name("cdr")
+        CmdToken = token_name("cdr")
     ->
-        ArgTokens = [num(Repetitions) | TokenPath],
+        ArgTokens = [token_num(Repetitions) | TokenPath],
         list.duplicate(Repetitions, TokenPath, DupTokenPath),
         list.condense(DupTokenPath, RepeatedTokenPath),
         parse_path(RepeatedTokenPath, RepeatedPath),
-        Command = cd_path(RepeatedPath)
+        Command = cmd_cd_path(RepeatedPath)
     ;
-        CmdToken = name("pwd")
+        ( CmdToken = token_name("cd")
+        ; CmdToken = token_up
+        )
+    ->
+        (
+            ArgTokens = [_ | _],
+            parse_path(ArgTokens, Path),
+            Command = cmd_cd_path(Path)
+        ;
+            ArgTokens = [],
+            Command = cmd_cd_no_path
+        )
+    ;
+        CmdToken = token_name("pwd")
     ->
         ArgTokens = [],
-        Command = pwd
+        Command = cmd_pwd
     ;
         (
-            CmdToken = name("track"),
+            CmdToken = token_name("track"),
             AssertInvalid = no_assert_invalid
         ;
-            CmdToken = name("t"),
+            CmdToken = token_name("t"),
             AssertInvalid = no_assert_invalid
         ;
-            CmdToken = name("mark"),
+            CmdToken = token_name("mark"),
             AssertInvalid = assert_invalid
         ;
-            CmdToken = name("m"),
+            CmdToken = token_name("m"),
             AssertInvalid = assert_invalid
         )
     ->
@@ -427,8 +476,8 @@
         ;
             ArgTokens = [HeadArgToken | TailArgTokens],
             (
-                ( HeadArgToken = arg("accurate")
-                ; HeadArgToken = arg("a")
+                ( HeadArgToken = token_arg("accurate")
+                ; HeadArgToken = token_arg("a")
                 )
             ->
                 HowTrack = track_accurate,
@@ -446,24 +495,24 @@
                 MaybePath = yes(Path)
             )
         ),
-        Command = track(HowTrack, AssertInvalid, MaybePath)
+        Command = cmd_track(HowTrack, AssertInvalid, MaybePath)
     ;
-        CmdToken = name("mode")
+        CmdToken = token_name("mode")
     ->
         (
-            ArgTokens = [],
-            Command = mode_query
-        ;
             ArgTokens = [_ | _],
             parse_path(ArgTokens, Path),
-            Command = mode_query(Path)
+            Command = cmd_mode_query(Path)
+        ;
+            ArgTokens = [],
+            Command = cmd_mode_query_no_path
         )
     ;
-        CmdToken = name("format")
+        CmdToken = token_name("format")
     ->
         (
             ArgTokens = [],
-            Command = param_command(print_params)
+            FormatCmd = print_params
         ;
             ArgTokens = [_ | _],
             MaybeArgWords = yes(ArgWords),
@@ -473,26 +522,27 @@
                 RemainingWords, MaybeOptionTable),
             lexer_words(RemainingWords, RemainingTokens),
             parse_format(RemainingTokens, Setting),
-            Command = param_command(format(MaybeOptionTable, Setting))
-        )
+            FormatCmd = format(MaybeOptionTable, Setting)
+        ),
+        Command = cmd_param(FormatCmd)
     ;
         (
-            CmdToken = name("depth"),
+            CmdToken = token_name("depth"),
             ParamCmd = param_depth
         ;
-            CmdToken = name("size"),
+            CmdToken = token_name("size"),
             ParamCmd = param_size
         ;
-            CmdToken = name("width"),
+            CmdToken = token_name("width"),
             ParamCmd = param_width
         ;
-            CmdToken = name("lines"),
+            CmdToken = token_name("lines"),
             ParamCmd = param_lines
         )
     ->
         (
             ArgTokens = [],
-            Command = param_command(print_params)
+            FormatCmd = print_params
         ;
             ArgTokens = [_ | _],
             MaybeArgWords = yes(ArgWords),
@@ -502,75 +552,42 @@
             getopt.process_options(OptionOps, ArgWords,
                 RemainingWords, MaybeOptionTable),
             lexer_words(RemainingWords, RemainingTokens),
-            RemainingTokens = [num(N)],
+            RemainingTokens = [token_num(N)],
             param_cmd_to_setting(ParamCmd, N, Setting),
-            Command = param_command(format_param(MaybeOptionTable, Setting))
-        )
+            FormatCmd = format_param(MaybeOptionTable, Setting)
+        ),
+        Command = cmd_param(FormatCmd)
     ;
-        CmdToken = name("params")
+        CmdToken = token_lessthan
     ->
-        Command = param_command(print_params)
+        ArgTokens = [token_num(Depth)],
+        OptionOps = option_ops_multi(short_format_param_cmd_option,
+            long_format_param_cmd_option, format_param_cmd_option_defaults),
+        getopt.process_options(OptionOps, [], _, MaybeOptionTable),
+        FormatCmd = format_param(MaybeOptionTable, setting_depth(Depth)),
+        Command = cmd_param(FormatCmd)
     ;
-        CmdToken = name("num_io_actions")
+        CmdToken = token_name("params")
     ->
-        ArgTokens = [num(N)],
-        Command = param_command(num_io_actions(N))
+        Command = cmd_param(print_params)
     ;
-        CmdToken = name("quit")
+        CmdToken = token_name("num_io_actions")
     ->
-        ArgTokens = [],
-        Command = quit
+        ArgTokens = [token_num(N)],
+        Command = cmd_param(num_io_actions(N))
     ;
-        ( CmdToken = name("display")
-        ; CmdToken = name("d")
+        ( CmdToken = token_name("help")
+        ; CmdToken = token_name("h")
+        ; CmdToken = token_question
         )
     ->
         ArgTokens = [],
-        Command = display
+        Command = cmd_help
     ;
-        ( CmdToken = name("write")
-        ; CmdToken = name("w")
-        )
+        CmdToken = token_name("quit")
     ->
         ArgTokens = [],
-        Command = write
-    ;
-        ( CmdToken = name("print")
-        ; CmdToken = name("p")
-        ; CmdToken = name("ls")
-        )
-    ->
-        (
-            MaybeArgWords = no,
-            MaybeMaybeOptionTable = no,
-            RemainingTokens = ArgTokens
-        ;
-            MaybeArgWords = yes(ArgWords),
-            OptionOps = option_ops_multi(short_format_option,
-                long_format_option, format_option_defaults),
-            getopt.process_options(OptionOps, ArgWords,
-                RemainingWords, MaybeOptionTable),
-            MaybeMaybeOptionTable = yes(MaybeOptionTable),
-            lexer_words(RemainingWords, RemainingTokens)
-        ),
-        (
-            RemainingTokens = [],
-            MaybePath = no
-        ;
-            RemainingTokens = [_ | _],
-            parse_path(RemainingTokens, Path),
-            MaybePath = yes(Path)
-        ),
-        Command = print(MaybeMaybeOptionTable, MaybePath)
-    ;
-        CmdToken = (<)
-    ->
-        ArgTokens = [num(Depth)],
-        OptionOps = option_ops_multi(short_format_param_cmd_option,
-            long_format_param_cmd_option, format_param_cmd_option_defaults),
-        getopt.process_options(OptionOps, [], _, MaybeOptionTable),
-        Command = param_command(format_param(MaybeOptionTable,
-            setting_depth(Depth)))
+        Command = cmd_quit
     ;
         fail
     ).
@@ -588,7 +605,7 @@
     % SICStus is forgiving in the syntax of paths, hence so are we.
     % XXX: Be less forgiving?
 parse_path([Token | Tokens], Path) :-
-    ( Token = (/) ->
+    ( Token = token_slash ->
         Path = root_rel(Dirs),
         parse_dirs(Tokens, Dirs)
     ;
@@ -601,38 +618,39 @@
 parse_dirs([], []).
 parse_dirs([Token | Tokens], Dirs) :-
     (
-        Token = num(Subdir),
+        Token = token_num(Subdir),
         Dirs = [child_num(Subdir) | RestDirs],
         parse_dirs(Tokens, RestDirs)
     ;
-        Token = name(NamedSubdir),
+        Token = token_name(NamedSubdir),
         Dirs = [child_name(NamedSubdir) | RestDirs],
         parse_dirs(Tokens, RestDirs)
     ;
-        Token = (..),
+        Token = token_dot_dot,
         Dirs = [parent | RestDirs],
         parse_dirs(Tokens, RestDirs)
     ;
         % We can effectively ignore slashes (for Unix-style
         % pathnames) and carets (for SICStus-style pathnames),
         % but anything else is not allowed.
-        Token = (/),
+        Token = token_slash,
         parse_dirs(Tokens, Dirs)
     ;
-        Token = (^),
+        Token = token_up,
         parse_dirs(Tokens, Dirs)
     ).
 
 :- pred parse_format(list(token)::in, setting::out) is semidet.
 
-parse_format([Fmt], Setting) :-
-    ( Fmt = name("flat") ->
+parse_format([Token], Setting) :-
+    Token = token_name(TokenName),
+    ( TokenName = "flat" ->
         Setting = setting_format(flat)
-    ; Fmt = name("raw_pretty") ->
+    ; TokenName = "raw_pretty" ->
         Setting = setting_format(raw_pretty)
-    ; Fmt = name("verbose") ->
+    ; TokenName = "verbose" ->
         Setting = setting_format(verbose)
-    ; Fmt = name("pretty") ->
+    ; TokenName = "pretty" ->
         Setting = setting_format(pretty)
     ;
         fail
@@ -641,17 +659,18 @@
 :- pred parse_format_param(list(token)::in, setting::out) is semidet.
 
 parse_format_param([Token | Tokens], Setting) :-
-    ( Token = name("depth") ->
-        Tokens = [num(Depth)],
+    Token = token_name(TokenName),
+    ( TokenName = "depth" ->
+        Tokens = [token_num(Depth)],
         Setting = setting_depth(Depth)
-    ; Token = name("size") ->
-        Tokens = [num(Size)],
+    ; TokenName = "size" ->
+        Tokens = [token_num(Size)],
         Setting = setting_size(Size)
-    ; Token = name("width") ->
-        Tokens = [num(X)],
+    ; TokenName = "width" ->
+        Tokens = [token_num(X)],
         Setting = setting_width(X)
-    ; Token = name("lines") ->
-        Tokens = [num(Y)],
+    ; TokenName = "lines" ->
+        Tokens = [token_num(Y)],
         Setting = setting_lines(Y)
     ;
         fail
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------



More information about the reviews mailing list