[m-rev.] For review: Add `set' command to declarative debugger

[Ian MacLarty]

For review by anyone.

Estimated hours taken: 2
Branches: main

Make `set' mdb command work from within the declarative debugger.

browser/browse.m
	Make set_browse_param call a new predicate set_param/5 in 
	browser_info.m.

browser/browser_info.m
	Add set_param/5 to set browser parameters from an option table.

browser/declarative_user.m
	Add and handle `set' command.
	Add help text.

browser/parse.m
	Make parse/2 public so it can be called from the declarative debugger.

tests/debugger/declarative/browse_arg.exp
tests/debugger/declarative/browse_arg.inp
	Add test case.

Index: browser/browse.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/browse.m,v
retrieving revision 1.45
diff -u -r1.45 browse.m
--- browser/browse.m	25 Oct 2004 05:32:22 -0000	1.45
+++ browser/browse.m	25 Oct 2004 06:32:45 -0000
@@ -536,17 +536,10 @@
 :- pred set_browse_param(option_table(setting_option)::in, setting::in,
 	browser_info::in, browser_info::out) is det.
 
-set_browse_param(OptionTable, Setting, Info0, Info) :-
-	browser_info__set_param(yes,
-		lookup_bool_option(OptionTable, print) `with_type` bool,
-		lookup_bool_option(OptionTable, browse) `with_type` bool,
-		lookup_bool_option(OptionTable, print_all) `with_type` bool,
-		lookup_bool_option(OptionTable, flat) `with_type` bool,
-		lookup_bool_option(OptionTable, raw_pretty) `with_type` bool,
-		lookup_bool_option(OptionTable, verbose) `with_type` bool,
-		lookup_bool_option(OptionTable, pretty) `with_type` bool,
-		Setting, Info0 ^ state, NewState),
-	Info = Info0 ^ state := NewState.
+set_browse_param(OptionTable, Setting, !Info) :-
+	browser_info.set_param(yes, OptionTable, Setting, !.Info ^ state, 
+		NewState),
+	!:Info = !.Info ^ state := NewState.
 
 :- pred help(debugger::in, io::di, io::uo) is det.
 
Index: browser/browser_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/browser_info.m,v
retrieving revision 1.15
diff -u -r1.15 browser_info.m
--- browser/browser_info.m	9 Aug 2004 03:05:20 -0000	1.15
+++ browser/browser_info.m	24 Oct 2004 05:46:10 -0000
@@ -17,8 +17,9 @@
 :- import_module mdbcomp.
 :- import_module mdbcomp__program_representation.
 :- import_module mdb__browser_term.
+:- import_module mdb.parse.
 
-:- import_module bool, list, std_util, io.
+:- import_module bool, list, std_util, io, getopt.
 
 	% The non-persistent browser information.  A new one of these is
 	% created every time the browser is called, based on the contents
@@ -146,6 +147,14 @@
 	bool::in, bool::in, bool::in, bool::in, setting::in, 
 	browser_persistent_state::in, browser_persistent_state::out) is det.
 
+	% browser_info.set_param(FromBrowser, OptionTable, Setting, !State)
+	% Same as set_param/11, but looks up the options in the
+	% supplied option table.
+	%
+:- pred browser_info.set_param(bool::in, option_table(setting_option)::in,
+	setting::in, browser_persistent_state::in,
+	browser_persistent_state::out) is det.
+	
 %---------------------------------------------------------------------------%
 
 % These three predicates are like the deconstruct, limited_deconstruct
@@ -396,6 +405,17 @@
 		State = browser_persistent_state(PParams, BParams, AParams,
 			State0 ^ num_printed_io_actions)
 	).
+
+browser_info.set_param(FromBrowser, OptionTable, Setting, !State) :-
+	browser_info.set_param(FromBrowser,
+		lookup_bool_option(OptionTable, print) `with_type` bool,
+		lookup_bool_option(OptionTable, browse) `with_type` bool,
+		lookup_bool_option(OptionTable, print_all) `with_type` bool,
+		lookup_bool_option(OptionTable, flat) `with_type` bool,
+		lookup_bool_option(OptionTable, raw_pretty) `with_type` bool,
+		lookup_bool_option(OptionTable, verbose) `with_type` bool,
+		lookup_bool_option(OptionTable, pretty) `with_type` bool,
+		Setting, !State).
 
 :- pred affected_caller_types(bool::in, maybe(browse_caller_type)::in,
 	bool::out, bool::out, bool::out) is det.
Index: browser/declarative_user.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_user.m,v
retrieving revision 1.30
diff -u -r1.30 declarative_user.m
--- browser/declarative_user.m	25 Oct 2004 05:30:18 -0000	1.30
+++ browser/declarative_user.m	26 Oct 2004 02:01:29 -0000
@@ -70,8 +70,9 @@
 :- import_module mdb__util.
 :- import_module mdb__declarative_execution.
 :- import_module mdbcomp__program_representation.
+:- import_module mdb.parse.
 
-:- import_module std_util, char, string, bool, int, deconstruct.
+:- import_module std_util, char, string, bool, int, deconstruct, getopt.
 
 :- type user_state
 	--->	user(
@@ -166,6 +167,20 @@
 	query_user_2([UserQuestion | UserQuestions], Skipped, Response,
 		User0, User).
 
+handle_command(set(MaybeOptionTable, Setting), UserQuestion, UserQuestions,
+		Skipped, Response, !User, !IO) :-
+	(
+		MaybeOptionTable = ok(OptionTable),
+		browser_info.set_param(no, OptionTable, Setting, 
+			!.User ^ browser, Browser),
+		!:User = !.User ^ browser := Browser
+	;
+		MaybeOptionTable = error(Msg),
+		io.write_string(Msg++"\n", !IO)
+	),
+	query_user_2([UserQuestion | UserQuestions], Skipped, Response, !User,
+		!IO).
+
 handle_command(browse_io(ActionNum), UserQuestion, UserQuestions, Skipped,
 		Response, User0, User) -->
 	{ Question = get_decl_question(UserQuestion) },
@@ -431,6 +446,8 @@
 					% before answering.
 	;	pd			% Commence procedural debugging from
 					% this point.
+	;	set(maybe_option_table(setting_option), setting) 
+					% Set a browser option.
 	;	abort			% Abort this diagnosis session.
 	;	help			% Request help before answering.
 	;	empty_command		% User just pressed return.
@@ -454,7 +471,9 @@
 		"\tp <n-m>\tprint <n-m>\tprint the nth to the mth arguments of the atom\n",
 		"\tp io <n>\tprint io <n>\tprint the atom's nth I/O action\n",
 		"\tp io <n-m>\tprint io <n-m>\tprint the atom's nth to mth I/O actions\n",
-		"\tpd\t\tcommence procedural debugging from this point\n",
+		"\tset [-APBfpv] <param> <value>\t",
+		"set a term browser parameter value\n",
+		"\tpd\t\t\tcommence procedural debugging from this point\n",
 		"\ta\tabort\t\t",
 			"abort this diagnosis session and return to mdb\n",
 		"\th, ?\thelp\t\tthis help message\n"
@@ -531,6 +550,7 @@
 cmd_handler("browse",	browse_arg_cmd).
 cmd_handler("p",	print_arg_cmd).
 cmd_handler("print",	print_arg_cmd).
+cmd_handler("set",	set_arg_cmd).
 
 :- func one_word_cmd(user_command::in, list(string)::in) = (user_command::out)
 	is semidet.
@@ -552,6 +572,12 @@
 	string_to_range(Arg, From, To).
 
 :- pred string_to_range(string::in, int::out, int::out) is semidet.
+
+:- func set_arg_cmd(list(string)::in) = (user_command::out) is semidet.
+
+set_arg_cmd(ArgWords) = set(MaybeOptionTable, Setting) :-
+	ArgWords \= [],
+	parse.parse(["set" | ArgWords], set(MaybeOptionTable, Setting)).
 
 string_to_range(Arg, From, To) :-
 	( string__to_int(Arg, Num) ->
Index: browser/parse.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/parse.m,v
retrieving revision 1.20
diff -u -r1.20 parse.m
--- browser/parse.m	25 Oct 2004 05:32:22 -0000	1.20
+++ browser/parse.m	25 Oct 2004 06:41:57 -0000
@@ -155,6 +155,11 @@
 
 :- pred parse__read_command_external(command::out, io::di, io::uo) is det.
 
+	% parse(Words, Command).
+	% Command is the command give by the list of strings Words.
+	%
+:- pred parse__parse(list(string)::in, command::out) is semidet.
+
 %---------------------------------------------------------------------------%
 
 :- implementation.
@@ -291,8 +296,6 @@
 	Toks = [name(Name) | Toks2].
 
 %---------------------------------------------------------------------------%
-
-:- pred parse(list(string)::in, command::out) is semidet.
 
 parse(Words, Command) :-
 	(
Index: tests/debugger/declarative/browse_arg.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/browse_arg.exp,v
retrieving revision 1.3
diff -u -r1.3 browse_arg.exp
--- tests/debugger/declarative/browse_arg.exp	13 Oct 2003 08:02:14 -0000	1.3
+++ tests/debugger/declarative/browse_arg.exp	26 Oct 2004 01:42:04 -0000
@@ -15,6 +15,22 @@
 baz(1, bar)
 browser> quit
 p(1, baz(1, bar))
+Valid? set format verbose
+p
+1-1
+2-baz
+  1-1
+  2-bar
+
+Valid? set -B format pretty
+p
+1-1
+2-baz
+  1-1
+  2-bar
+
+Valid? set -P format pretty
+p(1, baz(1, bar))
 Valid? no
 Found incorrect contour:
 p(1, baz(1, bar))
Index: tests/debugger/declarative/browse_arg.inp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/browse_arg.inp,v
retrieving revision 1.1
diff -u -r1.1 browse_arg.inp
--- tests/debugger/declarative/browse_arg.inp	17 Jan 2001 18:55:18 -0000	1.1
+++ tests/debugger/declarative/browse_arg.inp	25 Oct 2004 06:29:41 -0000
@@ -7,6 +7,9 @@
 browse 2
 ls
 quit
+set format verbose
+set -B format pretty
+set -P format pretty
 no
 yes
 continue
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------