[m-dev.] for review: use readline in browser/

[Mark Anthony BROWN]

Mark Anthony BROWN writes:
> 
> IMHO, it is a better design to avoid relying on global variables, so
> it is probably worth the extra effort to pass the streams through.
> I'll post a relative diff soon ...
> 

Actually, since I wound up undoing much of the previous diff, a
normal diff is probably shorter and easier to understand.  I have
omitted the diffs for parse.m and declarative_oracle.m --- the
changes are the same as first time round.

Cheers,
Mark.

Estimated hours taken: 6

If calling from the internal debugger, use readline input for the
interactive term browser and interactive queries.

browser/browse.m:
	Change some if-then-elses to switches, which will help
	catch errors if a new functor is added to the debugger type.

browser/parse.m:
browser/util.m:
	Return a string from util__trace_getline/4 rather than a
	list of chars, which saves converting from a string to a list
	of chars and then back again.

browser/util.m:
	Add a version of util__trace_getline that also takes I/O
	stream arguments.  Pass these arguments to MR_trace_getline.

browser/declarative_oracle.m:
	Call util__trace_getline/4 to do input via readline (if
	available).  Improve error handling.

browser/interactive_query.m:
	Call util__trace_getline to get user input, instead of
	standard library predicates.

runtime/mercury_init.h:
runtime/mercury_wrapper.c:
runtime/mercury_wrapper.h:
trace/mercury_trace_internal.c:
trace/mercury_trace_internal.h:
	Add two I/O stream arguments to MR_trace_getline.


Index: browser/browse.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/browse.m,v
retrieving revision 1.9
diff -u -r1.9 browse.m
--- browse.m	1999/05/21 14:38:18	1.9
+++ browse.m	1999/05/28 06:29:10
@@ -69,8 +69,9 @@
 	"ML_BROWSE_browse_external").
 
 %---------------------------------------------------------------------------%
-% If the term browser is called from the internal debugger, Input/Output are 
-% done via MR_mdb_in/MR_mdb_out. If it is called from the external debugger,
+% If the term browser is called from the internal debugger, input is
+% done via a call to the readline library (if available), using streams
+% MR_mdb_in and MR_mdb_out.  If it is called from the external debugger,
 % Input/Output are done via MR_debugger_socket_in/MR_debugger_socket_out. 
 % In the latter case we need to output terms; their type is 
 % term_browser_response.
@@ -205,6 +206,7 @@
 :- pred browse_common(debugger, T, io__input_stream, io__output_stream,
 			browser_state, browser_state, io__state, io__state).
 :- mode browse_common(in, in, in, in, in, out, di, uo) is det.
+
 browse_common(Debugger, Object, InputStream, OutputStream, State0, State) -->
 	{ type_to_univ(Object, Univ) },
 	{ set_term(Univ, State0, State1) },
@@ -219,18 +221,21 @@
 	io__state, io__state).
 :- mode browse_main_loop(in, in, out, di, uo) is det.
 browse_main_loop(Debugger, State0, State) -->
-	{ prompt(Prompt) },
-	( { Debugger = internal } ->
+	(
+		{ Debugger = internal },
+		{ prompt(Prompt) },
 		parse__read_command(Prompt, Command)
 	;
+		{ Debugger = external },
 		parse__read_command_external(Command)
 	),
 	( { Command = quit } ->
 		% write_string_debugger(Debugger, "quitting...\n")
-		( { Debugger = external } ->
+		(
+			{ Debugger = external },
 			send_term_to_socket(browser_quit)
 		;
-			{ true }
+			{ Debugger = internal }
 		),
 		{ State = State0 }
 	;
@@ -1002,30 +1007,24 @@
 
 :- pred write_string_debugger(debugger, string, io__state, io__state).
 :- mode write_string_debugger(in, in, di, uo) is det.
-write_string_debugger(Debugger, String) -->
-	( { Debugger = internal } ->
-		io__write_string(String)
-	;
-		send_term_to_socket(browser_str(String))
-	).
+write_string_debugger(internal, String) -->
+	io__write_string(String).
+write_string_debugger(external, String) -->
+	send_term_to_socket(browser_str(String)).
 
 :- pred nl_debugger(debugger, io__state, io__state).
 :- mode nl_debugger(in, di, uo) is det.
-nl_debugger(Debugger) -->
-	( { Debugger = internal } ->
-		io__nl
-	;
-		send_term_to_socket(browser_nl)
-	).
+nl_debugger(internal) -->
+	io__nl.
+nl_debugger(external) -->
+	send_term_to_socket(browser_nl).
 
 :- pred write_int_debugger(debugger, int, io__state, io__state).
 :- mode write_int_debugger(in, in, di, uo) is det.
-write_int_debugger(Debugger, Int) -->
-	( { Debugger = internal } ->
-		io__write_int(Int)
-	;
-		send_term_to_socket(browser_int(Int))
-	).
+write_int_debugger(internal, Int) -->
+	io__write_int(Int).
+write_int_debugger(external, Int) -->
+	send_term_to_socket(browser_int(Int)).
 
 
 :- pred print_format_debugger(debugger, portray_format, io__state, io__state).
Index: browser/interactive_query.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/interactive_query.m,v
retrieving revision 1.4
diff -u -r1.4 interactive_query.m
--- interactive_query.m	1999/05/28 02:22:51	1.4
+++ interactive_query.m	1999/05/28 06:30:21
@@ -33,8 +33,8 @@
 :- type options == string.
 
 :- implementation.
-:- import_module std_util, bool, string, term, varset, term_io.
-:- import_module dl, name_mangle.
+:- import_module std_util, bool, string, term, varset, term_io, parser.
+:- import_module dl, name_mangle, util.
 
 :- pragma export(query(in, in, in, in, in, di, uo), "ML_query").
 
@@ -42,17 +42,33 @@
 
 query(QueryType, Imports, Options, MDB_Stdin, MDB_Stdout) -->
 	% write_import_list(Imports),
-	print(MDB_Stdout, query_prompt(QueryType)),
-	io__flush_output(MDB_Stdout),
-	io__set_input_stream(MDB_Stdin, OldStdin),
-	term_io__read_term(Result),
-	io__set_input_stream(OldStdin, _),
+	util__trace_getline(query_prompt(QueryType), Result,
+			MDB_Stdin, MDB_Stdout),
 	( { Result = eof },
 		io__nl(MDB_Stdout)
-	; { Result = error(Msg, _Line) },
+	; { Result = error(Error) },
+		{ io__error_message(Error, Msg) },
 		io__write_string(MDB_Stdout, Msg), io__nl(MDB_Stdout),
 		query(QueryType, Imports, Options, MDB_Stdin, MDB_Stdout)
-	; { Result = term(VarSet, Term) },
+	; { Result = ok(Line) },
+		{ parser__read_term_from_string("", Line, _, ReadTerm) },
+		query_2(QueryType, Imports, Options, MDB_Stdin, MDB_Stdout,
+				ReadTerm)
+	).
+
+
+:- pred query_2(query_type::in, imports::in, options::in,
+		io__input_stream::in, io__output_stream::in,
+		read_term(generic)::in, state::di, state::uo) is det.
+
+query_2(QueryType, Imports, Options, MDB_Stdin, MDB_Stdout, ReadTerm) -->
+	( { ReadTerm = eof },
+		io__nl(MDB_Stdout)
+	; { ReadTerm = error(Msg, _Line) },
+		io__write_string(MDB_Stdout, Msg),
+		io__nl(MDB_Stdout),
+		query(QueryType, Imports, Options, MDB_Stdin, MDB_Stdout)
+	; { ReadTerm = term(VarSet, Term) },
 		% io__write_string("Read term: "),
 		% term_io__write_term(Term, VarSet),
 		% io__write_string("\n"),
Index: browser/util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/util.m,v
retrieving revision 1.2
diff -u -r1.2 util.m
--- util.m	1999/05/14 02:24:38	1.2
+++ util.m	1999/05/28 06:14:52
@@ -8,14 +8,18 @@
 
 :- interface.
 
-:- import_module list, string, char, io.
+:- import_module list, string, io.
 
 	% Get user input via the same method used by the internal
 	% debugger.
-:- pred util__trace_getline(string, io__result(list(char)), io__state,
+:- pred util__trace_getline(string, io__result(string), io__state,
 		io__state).
 :- mode util__trace_getline(in, out, di, uo) is det.
 
+:- pred util__trace_getline(string, io__result(string), io__input_stream,
+		io__output_stream, io__state, io__state).
+:- mode util__trace_getline(in, out, in, in, di, uo) is det.
+
 :- pred util__zip_with(pred(T1, T2, T3), list(T1), list(T2), list(T3)).
 :- mode util__zip_with(pred(in, in, out) is det, in, in, out) is det.
 
@@ -29,20 +33,24 @@
 
 :- import_module int, require.
 
-:- pragma promise_pure(util__trace_getline/4).
-
 util__trace_getline(Prompt, Result) -->
+	io__input_stream(MdbIn),
+	io__output_stream(MdbOut),
+	util__trace_getline(Prompt, Result, MdbIn, MdbOut).
+
+:- pragma promise_pure(util__trace_getline/6).
+
+util__trace_getline(Prompt, Result, MdbIn, MdbOut) -->
 	{
-		impure call_trace_getline(Prompt, Line)
+		impure call_trace_getline(MdbIn, MdbOut, Prompt, Line)
 	->
-		string__to_char_list(Line, Chars),
-		Result = ok(Chars)
+		Result = ok(Line)
 	;
 		Result = eof
 	}.
 
-:- impure pred call_trace_getline(string, string).
-:-        mode call_trace_getline(in, out) is semidet.
+:- impure pred call_trace_getline(input_stream, output_stream, string, string).
+:-        mode call_trace_getline(in, in, in, out) is semidet.
 
 :- pragma c_header_code("
 	#include ""mercury_wrapper.h""
@@ -51,14 +59,18 @@
 	#include ""mercury_trace_internal.h""
 ").
 
-:- pragma c_code(call_trace_getline(Prompt::in, Line::out),
+:- pragma c_code(call_trace_getline(MdbIn::in, MdbOut::in, Prompt::in,
+			Line::out),
 	[will_not_call_mercury],
 	"
 		char		*line;
 		char		*mercury_string;
+		MercuryFile	*mdb_in = (MercuryFile *) MdbIn;
+		MercuryFile	*mdb_out = (MercuryFile *) MdbOut;
 
 		if (MR_address_of_trace_getline != NULL) {
-			line = (*MR_address_of_trace_getline)((char *) Prompt);
+			line = (*MR_address_of_trace_getline)((char *) Prompt,
+					mdb_in->file, mdb_out->file);
 		} else {
 			MR_tracing_not_enabled();
 			/* not reached */
Index: runtime/mercury_init.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_init.h,v
retrieving revision 1.14
diff -u -r1.14 mercury_init.h
--- mercury_init.h	1999/05/28 05:29:07	1.14
+++ mercury_init.h	1999/05/28 05:44:47
@@ -118,7 +118,7 @@
 extern	void	ML_io_print_to_stream(Word, Word, Word);
 
 /* in trace/mercury_trace_internal.h */
-extern	char	*MR_trace_getline(const char *);
+extern	char	*MR_trace_getline(const char *, FILE *mdb_in, FILE *mdb_out);
 
 /* in trace/mercury_trace_declarative.h */
 extern	void	MR_edt_root_node(Word EDT, Word *Node);
Index: runtime/mercury_wrapper.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_wrapper.c,v
retrieving revision 1.40
diff -u -r1.40 mercury_wrapper.c
--- mercury_wrapper.c	1999/05/28 05:29:11	1.40
+++ mercury_wrapper.c	1999/05/28 05:44:50
@@ -138,7 +138,7 @@
 void	(*address_of_mercury_init_io)(void);
 void	(*address_of_init_modules)(void);
 
-char *	(*MR_address_of_trace_getline)(const char *);
+char *	(*MR_address_of_trace_getline)(const char *, FILE *, FILE *);
 
 #ifdef	MR_USE_EXTERNAL_DEBUGGER
 void	(*MR_address_of_trace_init_external)(void);
Index: runtime/mercury_wrapper.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_wrapper.h,v
retrieving revision 1.21
diff -u -r1.21 mercury_wrapper.h
--- mercury_wrapper.h	1999/05/28 05:29:12	1.21
+++ mercury_wrapper.h	1999/05/28 05:44:50
@@ -62,12 +62,14 @@
 #endif
 
 /*
-** MR_trace_getline(const char *) is defined in trace/mercury_trace_internal.c
-** but is called in browser/util.m.  As we cannot do direct calls from
-** browser/ to trace/, we do an indirect call via the following pointer.
+** MR_trace_getline(const char *, FILE *, FILE *) is defined in
+** trace/mercury_trace_internal.c but is called in browser/util.m.  As
+** we cannot do direct calls from browser/ to trace/, we do an indirect 
+** call via the following pointer.
 */
 
-extern	char *		(*MR_address_of_trace_getline)(const char *);
+extern	char *		(*MR_address_of_trace_getline)(const char *,
+				FILE *, FILE *);
 
 /*
 ** MR_trace_init_external() and MR_trace_final_external() are defined 
Index: trace/mercury_trace_internal.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.44
diff -u -r1.44 mercury_trace_internal.c
--- mercury_trace_internal.c	1999/05/27 01:01:33	1.44
+++ mercury_trace_internal.c	1999/05/28 02:49:13
@@ -233,7 +233,7 @@
 	jumpaddr = NULL;
 
 	do {
-		line = MR_trace_getline("mdb> ");
+		line = MR_trace_getline("mdb> ", MR_mdb_in, MR_mdb_out);
 		res = MR_trace_debug_cmd(line, cmd, event_info, &event_details,
 				&jumpaddr);
 	} while (res == KEEP_INTERACTING);
@@ -1356,7 +1356,8 @@
 				char	*line2;
 
 				line2 = MR_trace_getline("mdb: "
-					"are you sure you want to quit? ");
+					"are you sure you want to quit? ",
+					MR_mdb_in, MR_mdb_out);
 				if (line2 == NULL) {
 					/* This means the user input EOF. */
 					confirmed = TRUE;
@@ -1672,7 +1673,8 @@
 	int	i;
 
 	next_char_slot = 0;
-	while ((text = MR_trace_getline("cat> ")) != NULL) {
+	while ((text = MR_trace_getline("cat> ", MR_mdb_in, MR_mdb_out))
+			!= NULL) {
 		if (streq(text, "end")) {
 			free(text);
 			break;
@@ -1932,7 +1934,7 @@
 
 /*
 ** If there any lines waiting in the queue, return the first of these.
-** If not, print the prompt to MR_mdb_out, read a line from MR_mdb_in,
+** If not, print the prompt to mdb_out, read a line from mdb_in,
 ** and return it in a malloc'd buffer holding the line (without the final
 ** newline).
 ** If EOF occurs on a nonempty line, treat the EOF as a newline; if EOF
@@ -1940,7 +1942,7 @@
 */
 
 char *
-MR_trace_getline(const char *prompt)
+MR_trace_getline(const char *prompt, FILE *mdb_in, FILE *mdb_out)
 {
 	char	*line;
 
@@ -1951,13 +1953,13 @@
 
 	MR_trace_internal_interacting = TRUE;
 
-	line = MR_trace_readline(prompt, MR_mdb_in, MR_mdb_out);
+	line = MR_trace_readline(prompt, mdb_in, mdb_out);
 
 	/* if we're using readline, then readline does the echoing */
 #ifdef MR_NO_USE_READLINE
 	if (MR_echo_commands) {
-		fputs(line, MR_mdb_out);
-		putc('\n', MR_mdb_out);
+		fputs(line, mdb_out);
+		putc('\n', mdb_out);
 	}
 #endif
 
@@ -2038,7 +2040,7 @@
 	/* We try to leave one line for the prompt itself. */
 	if (MR_scroll_control && MR_scroll_next >= MR_scroll_limit - 1) {
 	try_again:
-		buf = MR_trace_getline("--more-- ");
+		buf = MR_trace_getline("--more-- ", MR_mdb_in, MR_mdb_out);
 		if (buf != NULL) {
 			for (i = 0; buf[i] != '\0' && MR_isspace(buf[i]); i++)
 				;
Index: trace/mercury_trace_internal.h
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_internal.h,v
retrieving revision 1.7
diff -u -r1.7 mercury_trace_internal.h
--- mercury_trace_internal.h	1999/05/14 02:25:46	1.7
+++ mercury_trace_internal.h	1999/05/28 02:45:51
@@ -55,6 +55,7 @@
 extern FILE *MR_mdb_out;
 extern FILE *MR_mdb_err;
 
-extern	char	*MR_trace_getline(const char *prompt);
+extern	char	*MR_trace_getline(const char *prompt, FILE *mdb_in,
+				FILE *mdb_out);
 
 #endif	/* MERCURY_TRACE_INTERNAL_H */

-- 
Mark Brown  (dougl at cs.mu.oz.au)       )O+   |  For Microsoft to win,
MEngSc student,                             |  the customer must lose
Dept of Computer Science, Melbourne Uni     |          -- Eric S. Raymond
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------