interactive queries

[Fergus Henderson]

Someone mailed me asking about how to convert a read_term into
a pred again.  I got tired of giving the long-winded answer yet
again so I wrote the following code.  Here it is.  Maybe someone
will find this useful.

This would need a bit of work to clean it up, but the following
ought to be sufficient to demonstrate the proof of concept.
I tested it on a couple of simple queries on dec-alpha-osf3.2
and it seemed to work OK.

% Example interactive query program using dynamic linking.
% This module reads in a query, writes out Mercury code for it to `query.m',
% invokes the Mercury compiler mmc to compile `query.m' to `libquery.so',
% loads in the object code for the module `query'
% from the file `libquery.so', looks up the address of the
% procedure query/2 in that module, and then calls that procedure.

% This source file is hereby placed in the public domain.  -fjh (the author).

:- module interactive.
:- interface.
:- import_module io.

:- pred main(state::di, state::uo) is det.

:- implementation.
:- import_module std_util, bool, string, list, term, varset, term_io.
:- import_module dl, name_mangle.
:- import_module exception.

:- type prog ---> prog(imports, term, varset).
:- type imports == list(string).
:- type options == string.

main --> query([], "").

:- pred query(imports::in, options::in, state::di, state::uo) is det.

query(Imports, Options) -->
	print(Imports),
	print(" ?- "),
	term_io__read_term(Result),
	( { Result = eof },
		io__write_string("\nBye.\n")
	; { Result = error(Msg, _Line) },
		io__write_string(Msg), nl,
		main
	; { Result = term(VarSet, Term) },
		% io__write_string("Read term: "),
		% term_io__write_term(Term, VarSet),
		% io__write_string("\n"),
		(if { term_to_list(Term, ModuleList) } then
			{ list__append(Imports, ModuleList, NewImports) },
			query(NewImports, Options)
		else if { Term = term__functor(term__atom("options"),
				[term__functor(term__string(NewOptions),
					[], _)], _) } then
			print("Compilation options: "), print(Options), nl,
			query(Imports, NewOptions)
		else
			run_query(Options, prog(Imports, Term, VarSet)),
			query(Imports, Options)
		)
	).

:- pred term_to_list(term, list(string)).
:- mode term_to_list(in, out) is semidet.
term_to_list(term__functor(term__atom("[]"), [], _), []).
term_to_list(term__functor(term__atom("."),
		[term__functor(term__atom(Module), [], _C1), Rest], _C2),
		[Module | Modules]) :-
	term_to_list(Rest, Modules).

:- pred run_query(options, prog, io__state, io__state).
:- mode run_query(in, in, di, uo) is det.
run_query(Options, Program) -->
	{ SourceFile = "query.m" },
	write_prog_to_file(Program, SourceFile),
	compile_file(Options, Succeeded),
	(if { Succeeded = yes } then
		dynamically_load_and_run
	else
		{ true }
	).

%-----------------------------------------------------------------------------%
%
% print the program to a file
%

:- pred write_prog_to_file(prog, string, io__state, io__state).
:- mode write_prog_to_file(in, in, di, uo).

write_prog_to_file(Program, FileName) -->
	open_output_file(FileName, Stream),
	io__set_output_stream(Stream, OldStream),
	write_prog_to_stream(Program),
	io__set_output_stream(OldStream, _),
	io__close_output(Stream).

:- pred open_output_file(string::in, io__output_stream::out,
		io__state::di, io__state::uo) is det.

open_output_file(File, Stream) -->
	io__open_output(File, Result),
	( { Result = ok(Stream0) },
		{ Stream = Stream0 }
	; { Result = error(Error) },
		io__progname("interactive", Progname),
		{ io__error_message(Error, ErrorMessage) },
		{ string__append_list([
			Progname, ": ",
			"error opening file `", File, "' for input:\n\t",
			ErrorMessage, "\n"],
			Message) },
		io__write_string(Message),
		{ throw(Message) }
	).

:- pred write_prog_to_stream(prog::in, io__state::di, io__state::uo) is det.

write_prog_to_stream(prog(Imports, Term, VarSet)) -->
	io__write_string("
		:- module query.
		:- interface.
		:- import_module io.
		:- pred query(io__state::di, io__state::uo) is cc_multi.
		:- implementation.
		:- import_module
		"),
	io__write_list(["io" | Imports], ", ", term_io__quote_atom),
	io__write_string(".
	
		:- pragma source_file(""<stdin>"").
		query -->
			(if
				{
#"),
	io__get_line_number(LineNum),
	io__write_int(LineNum),
	io__nl,
	term_io__write_term(VarSet, Term),
	print("
				}
			then
	"),
	{ term__vars(Term, Vars0) },
	{ list__remove_dups(Vars0, Vars) },
	list__foldl(write_one_var(VarSet), Vars),
	print("
				io__write_string(""Yes.\\n"")
			else
				io__write_string(""No solution.\\n"")
			).
	").

:- pred write_one_var(varset::in, var::in,
		io__state::di, io__state::uo) is det.

write_one_var(VarSet, Var) -->
	io__write_string("io__write_string("""),
	term_io__write_variable(Var, VarSet),
	io__write_string(" = ""), write("),
	term_io__write_variable(Var, VarSet),
	print("), nl, ").

%-----------------------------------------------------------------------------%
%
% invoke the Mercury compile to compile the file to a shared object
%

:- pred compile_file(options, bool, state, state).
:- mode compile_file(in, out, di, uo) is det.

compile_file(Options, Succeeded) -->
	{ string__append_list([
		"mmc --pic-reg --no-warn-simple-code ",
		"--no-warn-det-decls-too-lax -c ", Options,
		" query.m"], Command) },
	invoke_system_command(Command, Succeeded0),
	( { Succeeded0 = yes } ->
		{ string__append_list([
			"ml --make-shared-lib -o libquery.so ", Options,
			" query.o"], Command2) },
		invoke_system_command(Command2, Succeeded)
	;
		{ Succeeded = no }
	).

:- func verbose = bool.

verbose = yes.

:- pred invoke_system_command(string, bool, state, state).
:- mode invoke_system_command(in, out, di, uo).

invoke_system_command(Command, Succeeded) -->
	(if { verbose = yes } then
		io__write_string("% Invoking system command `"),
		io__write_string(Command),
		io__write_string("'...\n"),
		io__flush_output
	else
		[]
	),
	io__call_system(Command, Result),
	(if { Result = ok(0) } then
		( if { verbose = yes } then print("% done.\n") else [] ),
		{ Succeeded = yes }
	else if { Result = ok(_) } then
		print("Compilation error(s) occurred.\n"),
		{ Succeeded = no }
	else
		print("Error: unable to invoke the compiler.\n"),
		{ Succeeded = no }
	).

%-----------------------------------------------------------------------------%
%
% dynamically load the shared object and execute the query
%

:- pred dynamically_load_and_run(io__state::di, io__state::uo) is det.

dynamically_load_and_run -->
	%
	% Load in the object code for the module `query' from
	% the file `libquery.so'.
	%
	dl__open("./libquery.so", lazy, local, MaybeHandle),
	(	
		{ MaybeHandle = error(Msg) },
		print("dlopen failed: "), print(Msg), nl
	;
		{ MaybeHandle = ok(Handle) },
		%
		% Look up the address of the first mode (mode number 0)
		% of the predicate query/2 in the module query.
		%
		{ QueryProc = mercury_proc(predicate, unqualified("query"),
					"query", 2, 0) },
		dl__mercury_sym(Handle, QueryProc, MaybeQuery),
		(
			{ MaybeQuery = error(Msg) },
			print("dlsym failed: "), print(Msg), nl
		;
			{ MaybeQuery = ok(QueryPred0) },
			%
			% Cast the higher-order term that we obtained
			% to the correct higher-order inst.
			%
			{ QueryPred = inst_cast(QueryPred0) },
			%
			% Call the procedure whose address
			% we just obtained.
			%
			QueryPred
		),
		%
		% unload the object code in the libquery.so file
		%
		dl__close(Handle, Result),
		(
			{ Result = error(CloseMsg) },
			print("dlclose failed: "), print(CloseMsg), nl
		;
			{ Result = ok }
		)
	).

%
% dl__mercury_sym returns a higher-order term with inst `ground'.
% We need to cast it to the right higher-order inst, namely
% `pred(di, uo) is det' before we can actually call it.
% The function inst_cast/1 defined below does that.
%

:- type io_pred == pred(io__state, io__state).
:- inst io_pred == (pred(di, uo) is det).

:- func inst_cast(io_pred) = io_pred.
:- mode inst_cast(in) = out(io_pred) is det.

:- pragma c_code(inst_cast(X::in) = (Y::out(io_pred)),
	[will_not_call_mercury, thread_safe], "Y = X").

%-----------------------------------------------------------------------------%

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "Binaries may die
WWW: <http://www.cs.mu.oz.au/~fjh>  |   but source code lives forever"
PGP: finger fjh at 128.250.37.3        |     -- leaked Microsoft memo.