[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