Files
mercury/browser/interactive_query.m
Julien Fischer d77a8ff8a3 Fix the interactive query mechanism in the debugger.
Estimated hours taken: 0.2
Branches: main

Fix the interactive query mechanism in the debugger.  It wasn't
working because the generated query programs did not import the
solutions module.

browser/interactive_query.m:
	Import the solutions module in the generated query program.

	Minor formatting fixes.
2006-05-08 07:28:52 +00:00

646 lines
21 KiB
Mathematica

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1999-2006 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% File: interactive_query.m.
% Author: fjh.
%
% A module to invoke interactive queries using dynamic linking.
%
% This module reads in a query, writes out Mercury code for it to the file
% `mdb_query.m', invokes the Mercury compiler mmc to compile that file
% to `libmdb_query.so', dynamically loads in the object code for the module
% `mdb_query' from the file `libmdb_query.so', looks up the address of the
% procedure query/2 in that module, calls that procedure, and then
% cleans up the generated files.
%
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- module mdb.interactive_query.
:- interface.
:- import_module io.
:- import_module list.
%-----------------------------------------------------------------------------%
:- pred query(query_type::in, imports::in, options::in,
io.input_stream::in, io.output_stream::in, io::di, io::uo) is det.
% query_external/7 is the same as query/7 but for the use
% of the external debugger.
%
:- pred query_external(query_type::in, imports::in, options::in,
io.input_stream::in, io.output_stream::in, io::di, io::uo) is det.
:- type query_type
---> normal_query
; cc_query
; io_query.
:- type imports == list(string).
:- type options == string.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module mdb.dl.
:- import_module mdb.name_mangle.
:- import_module mdb.util.
:- import_module bool.
:- import_module maybe.
:- import_module parser.
:- import_module string.
:- import_module term.
:- import_module term_io.
:- import_module varset.
%-----------------------------------------------------------------------------%
:- pragma export(query(in, in, in, in, in, di, uo), "ML_query").
:- type prog
---> prog(query_type, imports, term, varset).
query(QueryType, Imports, Options, MDB_Stdin, MDB_Stdout, !IO) :-
% write_import_list(Imports),
util.trace_getline(query_prompt(QueryType), Result, MDB_Stdin, MDB_Stdout,
!IO),
(
Result = eof,
io.nl(MDB_Stdout, !IO)
;
Result = error(Error),
io.error_message(Error, Msg),
io.write_string(MDB_Stdout, Msg, !IO),
io.nl(MDB_Stdout, !IO),
query(QueryType, Imports, Options, MDB_Stdin, MDB_Stdout, !IO)
;
Result = ok(Line),
parser.read_term_from_string("", Line, _, ReadTerm),
query_2(QueryType, Imports, Options, MDB_Stdin, MDB_Stdout,
ReadTerm, !IO)
).
:- pred query_2(query_type::in, imports::in, options::in,
io.input_stream::in, io.output_stream::in, read_term(generic)::in,
io::di, io::uo) is det.
query_2(QueryType, Imports, Options, MDB_Stdin, MDB_Stdout, ReadTerm, !IO) :-
(
ReadTerm = eof,
io.nl(MDB_Stdout, !IO)
;
ReadTerm = error(Msg, _Line),
io.write_string(MDB_Stdout, Msg, !IO),
io.nl(MDB_Stdout, !IO),
query(QueryType, Imports, Options, MDB_Stdin, MDB_Stdout, !IO)
;
ReadTerm = term(VarSet, Term),
% io.write_string("Read term: "),
% term_io.write_term(Term, VarSet),
% io.write_string("\n"),
(
Term = term.functor(term.atom("quit"), [], _)
->
io.nl(MDB_Stdout, !IO)
;
Term = term.functor(term.atom("options"),
[term.functor(term.string(NewOptions), [], _)], _)
->
print(MDB_Stdout, "Compilation options: ", !IO),
print(MDB_Stdout, NewOptions, !IO),
io.nl(MDB_Stdout, !IO),
query(QueryType, Imports, NewOptions, MDB_Stdin, MDB_Stdout, !IO)
;
term_to_list(Term, ModuleList)
->
list.append(Imports, ModuleList, NewImports),
write_import_list(MDB_Stdout, NewImports, !IO),
query(QueryType, NewImports, Options, MDB_Stdin, MDB_Stdout, !IO)
;
% The flush ensures that all output generated by the debugger
% up to this point appears in the output stream before any messages
% generated by the compilation of the query, which is done
% by another process.
io.flush_output(MDB_Stdout, !IO),
run_query(Options, prog(QueryType, Imports, Term, VarSet), !IO),
query(QueryType, Imports, Options, MDB_Stdin, MDB_Stdout, !IO)
)
).
% interactive_query_response is type of the terms sent to the socket
% during an interactive query session under the control of the
% external debugger.
:- type interactive_query_response
---> iq_ok
; iq_imported(imports)
; iq_quit
; iq_eof
; iq_error(string).
:- pragma export(query_external(in, in, in, in, in, di, uo),
"ML_query_external").
query_external(QueryType, Imports, Options, SocketIn, SocketOut, !IO) :-
io.set_input_stream(SocketIn, OldStdin, !IO),
term_io.read_term(Result, !IO),
io.set_input_stream(OldStdin, _, !IO),
(
Result = eof,
send_term_to_socket(iq_eof, SocketOut, !IO)
;
Result = error(ErrorMsg, _Line),
send_term_to_socket(iq_error(ErrorMsg), SocketOut, !IO),
query_external(QueryType, Imports, Options, SocketIn, SocketOut, !IO)
;
Result = term(VarSet, Term),
(
Term = term.functor(term.atom("quit"), [], _)
->
send_term_to_socket(iq_quit, SocketOut, !IO)
;
Term = term.functor(term.atom("options"),
[term.functor(term.string(NewOptions), [], _)], _)
->
send_term_to_socket(iq_ok, SocketOut, !IO),
query_external(QueryType, Imports, NewOptions, SocketIn, SocketOut,
!IO)
;
term_to_list(Term, ModuleList)
->
list.append(Imports, ModuleList, NewImports),
send_term_to_socket(iq_imported(NewImports), SocketOut, !IO),
query_external(QueryType, NewImports, Options, SocketIn, SocketOut,
!IO)
;
run_query(Options, prog(QueryType, Imports, Term, VarSet), !IO),
send_term_to_socket(iq_ok, SocketOut, !IO),
query_external(QueryType, Imports, Options, SocketIn, SocketOut,
!IO)
)
).
:- pred send_term_to_socket(interactive_query_response::in,
io.output_stream::in, io::di, io::uo) is det.
send_term_to_socket(Term, SocketStream, !IO) :-
write(SocketStream, Term, !IO),
print(SocketStream, ".\n", !IO),
flush_output(SocketStream, !IO).
:- func query_prompt(query_type) = string.
query_prompt(normal_query) = "?- ".
query_prompt(cc_query) = "?- ".
query_prompt(io_query) = "run <-- ".
:- pred term_to_list(term::in, list(string)::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::in, prog::in, io::di, io::uo) is det.
run_query(Options, Program, !IO) :-
SourceFile = query_module_name ++ ".m",
io.get_environment_var("MERCURY_OPTIONS", MAYBE_MERCURY_OPTIONS, !IO),
( MAYBE_MERCURY_OPTIONS = yes(MERCURY_OPTIONS) ->
io.set_environment_var("MERCURY_OPTIONS", "", !IO),
write_prog_to_file(Program, SourceFile, !IO),
compile_file(Options, Succeeded, !IO),
( Succeeded = yes ->
dynamically_load_and_run(!IO)
;
true
),
cleanup_query(Options, !IO),
io.set_environment_var("MERCURY_OPTIONS", MERCURY_OPTIONS, !IO)
;
print("Unable to unset MERCURY_OPTIONS environment variable", !IO)
).
%-----------------------------------------------------------------------------%
%
% Print the program to a file
%
:- pred write_prog_to_file(prog::in, string::in, io::di, io::uo) is det.
write_prog_to_file(Program, FileName, !IO) :-
open_output_file(FileName, Stream, !IO),
io.set_output_stream(Stream, OldStream, !IO),
write_prog_to_stream(Program, !IO),
io.set_output_stream(OldStream, _, !IO),
io.close_output(Stream, !IO).
:- pred open_output_file(string::in, io.output_stream::out,
io::di, io::uo) is det.
open_output_file(File, Stream, !IO) :-
io.open_output(File, Result, !IO),
(
Result = ok(Stream0),
Stream = Stream0
;
Result = error(Error),
io.progname("interactive", Progname, !IO),
io.error_message(Error, ErrorMessage),
string.append_list([
Progname, ": ",
"error opening file `", File, "' for output:\n\t",
ErrorMessage, "\n"],
Message),
io.write_string(Message, !IO),
% XXX we really ought to throw an exception here;
% instead, we just return a bogus stream (stdout)
io.stdout_stream(Stream, !IO)
).
:- pred write_prog_to_stream(prog::in, io::di, io::uo) is det.
write_prog_to_stream(prog(QueryType, Imports, Term, VarSet), !IO) :-
io.write_string("
:- module mdb_query.
:- interface.
:- import_module io.
:- pred run(io.state::di, io.state::uo) is cc_multi.
:- implementation.
", !IO),
io.output_stream(Out, !IO),
write_import_list(Out, ["solutions" | Imports], !IO),
io.write_string("
:- pragma source_file(""<stdin>"").
run -->
", !IO),
(
QueryType = normal_query,
term.vars(Term, Vars0),
list.remove_dups(Vars0, Vars),
% For a normal query, we generate code that looks like this:
%
% run -->
% unsorted_aggregate(
% (pred(res(A,B,C)::out) is nondet :-
% query(A,B,C)),
% (pred(res(A,B,C)::in, di, uo) is cc_multi -->
% print("A = "), print_cc(A), print(","),
% print("B = "), print_cc(B), print(","),
% print("C = "), print_cc(C), print(","),
% print("true ;\n"))
% ),
% print(""fail.\n""),
% print(""No (more) solutions.\n"").
%
% :- type res(A, B, C) ---> res(A, B, C).
%
% % :- mode query(out, out, out) is nondet.
% query(res(A, B, C)) :-
% ...
io.write_string("
unsorted_aggregate(
(pred(res", !IO),
write_args(Vars, VarSet, !IO),
io.write_string("::out) is nondet :-
query", !IO),
write_args(Vars, VarSet, !IO),
io.write_string("),", !IO),
io.write_string("(pred(res", !IO),
write_args(Vars, VarSet, !IO),
io.write_string("::in, di, uo) is cc_multi -->
", !IO),
list.foldl(write_code_to_print_one_var(VarSet), Vars, !IO),
io.write_string("
io.write_string(""true ;\n""))
),
io.write_string(""fail.\n""),
io.write_string(""No (more) solutions.\n"").
:- type res", !IO),
write_args(Vars, VarSet, !IO),
io.write_string(" ---> res", !IO),
write_args(Vars, VarSet, !IO),
io.write_string(".\n", !IO),
% io.write_string("
% :- mode query"),
% ( Vars \= [] ->
% list.length(Vars, NumVars),
% list.duplicate(NumVars, "out", Modes),
% io.write_string("(", !IO),
% io.write_list(Modes, ", ", io.write_string, !IO),
% io.write_string(")", !IO)
% ;
% true
% ),
% io.write_string(" is nondet.", !IO),
io.write_string("
query", !IO),
write_args(Vars, VarSet, !IO),
io.write_string(" :- ", !IO),
write_line_directive(!IO),
term_io.write_term(VarSet, Term, !IO),
io.write_string(" .\n", !IO)
;
QueryType = cc_query,
%
% For a cc_query, we generate code that looks like this:
%
% run --> if { query(A, B, C) } then
% print("A = "), print(A), print(", "),
% print("B = "), print(B), print(", "),
% print("C = "), print(C), print(", "),
% print("Yes.\n"))
% else
% print("No solution.\n").
%
% query(A, B, C) :- ...
%
term.vars(Term, Vars0),
list.remove_dups(Vars0, Vars),
io.write_string("(if { query", !IO),
write_args(Vars, VarSet, !IO),
io.write_string(" } then\n", !IO),
list.foldl(write_code_to_print_one_var(VarSet), Vars, !IO),
io.write_string("
io.write_string(""true.\\n"")
else
io.write_string(""No solution.\\n"")
).
", !IO),
io.write_string("query", !IO),
write_args(Vars, VarSet, !IO),
io.write_string(" :-\n", !IO),
write_line_directive(!IO),
term_io.write_term(VarSet, Term, !IO),
io.write_string(" .\n", !IO)
;
QueryType = io_query,
%
% For an io_query, we just spit the code straight out:
%
% run --> ...
%
write_line_directive(!IO),
term_io.write_term(VarSet, Term, !IO),
io.write_string(" .\n", !IO)
).
:- pred write_line_directive(io::di, io::uo) is det.
write_line_directive(!IO) :-
io.write_string("\n#", !IO),
io.get_line_number(LineNum, !IO),
io.write_int(LineNum, !IO),
io.nl(!IO).
:- pred write_code_to_print_one_var(varset::in, var::in,
io::di, io::uo) is det.
write_code_to_print_one_var(VarSet, Var, !IO) :-
io.write_string("io.write_string(""", !IO),
term_io.write_variable(Var, VarSet, !IO),
io.write_string(" = ""), io.write_cc(", !IO),
term_io.write_variable(Var, VarSet, !IO),
print("), io.write_string("", ""), ", !IO).
:- pred write_args(list(var)::in, varset::in, io::di, io::uo) is det.
write_args(Vars, VarSet, !IO) :-
(
Vars = [_ | _],
io.write_string("(", !IO),
io.write_list(Vars, ", ", write_one_var(VarSet), !IO),
io.write_string(")", !IO)
;
Vars = []
).
:- pred write_one_var(varset::in, var::in, io::di, io::uo) is det.
write_one_var(VarSet, Var, !IO) :-
term_io.write_variable(Var, VarSet, !IO).
:- pred write_import_list(io.output_stream::in, imports::in,
io::di, io::uo) is det.
write_import_list(Out, Imports, !IO) :-
io.write_string(Out, ":- import_module ", !IO),
io.write_list(Out, Imports, ", ", term_io.quote_atom, !IO),
io.write_string(Out, ".\n", !IO).
%-----------------------------------------------------------------------------%
%
% Invoke the Mercury compile to compile the file to a shared object
%
:- pred compile_file(options::in, bool::out, io::di, io::uo) is det.
compile_file(Options, Succeeded, !IO) :-
%
% We use the following options:
% --grade
% make sure the grade of libmdb_query.so matches the
% grade of the executable it will be linked against
% --pic-reg
% needed for shared libraries / dynamic linking
% --infer-all
% for inferring the type etc. of query/N
% -O0 --no-c-optimize
% to improve compilation speed
% --no-verbose-make
% don't show which files are being made
% --output-compile-error-lines 10000
% output all errors
% --no-warn-det-decls-too-lax
% --no-warn-simple-code
% to avoid spurious warnings in the automatically
% generated parts of the query predicate
% --allow-undefined
% needed to allow the query to reference
% symbols defined in the program
%
string.append_list([
"mmc --infer-all --no-verbose-make -O0 --no-c-optimize ",
"--no-warn-simple-code --no-warn-det-decls-too-lax ",
"--output-compile-error-lines 10000 ",
"--allow-undefined ", Options,
" --grade ", grade_option,
" --pic-reg --compile-to-shared-lib ",
query_module_name],
Command),
invoke_system_command(Command, Succeeded, !IO).
:- pred cleanup_query(options::in, io::di, io::uo) is det.
cleanup_query(_Options) -->
io.remove_file(query_module_name ++ ".m", _),
io.remove_file(query_module_name ++ ".d", _),
io.remove_file("Mercury/ds/" ++ query_module_name ++ ".d", _),
io.remove_file(query_module_name ++ ".c", _),
io.remove_file("Mercury/cs/" ++ query_module_name ++ ".c", _),
io.remove_file(query_module_name ++ ".c_date", _),
io.remove_file("Mercury/c_dates/" ++ query_module_name ++ ".c_date",
_),
io.remove_file(query_module_name ++ ".o", _),
io.remove_file("Mercury/os/" ++ query_module_name ++ ".o", _),
io.remove_file("lib" ++ query_module_name ++ ".so", _).
:- func grade_option = string.
%
% `grade_option' returns MR_GRADE_OPT,
% which is defined in runtime/mercury_grade.h.
% This is a string containing the grade that the current
% executable was compiled in, in a form suitable for
% passing as a `--grade' option to mmc or ml.
%
:- pragma foreign_decl("C", "
#include ""mercury_grade.h""
#include ""mercury_string.h""
").
:- pragma foreign_proc("C",
grade_option = (GradeOpt::out),
[promise_pure, thread_safe, will_not_call_mercury],
"
MR_make_aligned_string(GradeOpt, (MR_String) MR_GRADE_OPT);
").
grade_option = _ :-
private_builtin.sorry("grade_option").
:- func verbose = bool.
verbose = no.
:- pred invoke_system_command(string::in, bool::out, io::di, io::uo) is det.
invoke_system_command(Command, Succeeded, !IO) :-
( verbose = yes ->
io.write_string("% Invoking system command `", !IO),
io.write_string(Command, !IO),
io.write_string("'...\n", !IO),
io.flush_output(!IO)
;
true
),
io.call_system(Command, Result, !IO),
( Result = ok(0) ->
( verbose = yes ->
print("% done.\n", !IO)
;
true
),
Succeeded = yes
; Result = ok(_) ->
print("Compilation error(s) occurred.\n", !IO),
Succeeded = no
;
print("Error: unable to invoke the compiler.\n", !IO),
Succeeded = no
).
%-----------------------------------------------------------------------------%
%
% dynamically load the shared object and execute the query
%
:- func query_module_name = string.
query_module_name = "mdb_query".
:- pred dynamically_load_and_run(io::di, io::uo) is det.
dynamically_load_and_run(!IO) :-
%
% Load in the object code for the module `query' from
% the file `libquery.so'.
%
dl.open("./lib" ++ query_module_name ++ ".so", lazy, local, MaybeHandle,
!IO),
(
MaybeHandle = dl_error(Msg),
print("dlopen failed: ", !IO),
print(Msg, !IO),
nl(!IO)
;
MaybeHandle = dl_ok(Handle),
%
% Look up the address of the first mode (mode number 0)
% of the predicate run/2 in the module query.
%
QueryProc = mercury_proc(predicate, unqualified(query_module_name),
"run", 2, 0),
dl.mercury_sym(Handle, QueryProc, MaybeQuery, !IO),
(
MaybeQuery = dl_error(Msg),
print("dlsym failed: ", !IO),
print(Msg, !IO),
nl(!IO)
;
MaybeQuery = dl_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.
%
call(QueryPred, !IO)
),
%
% unload the object code in the libquery.so file
%
dl.close(Handle, Result, !IO),
(
Result = dl_error(CloseMsg),
print("dlclose failed: ", !IO),
print(CloseMsg, !IO),
nl(!IO)
;
Result = dl_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, io).
:- 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 foreign_proc("C",
inst_cast(X::in) = (Y::out(io_pred)),
[promise_pure, will_not_call_mercury, thread_safe],
"
Y = X
").
inst_cast(_) = _ :-
private_builtin.sorry("inst_cast").
%-----------------------------------------------------------------------------%