mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-16 22:35:41 +00:00
6ea8406ac8
browser/browse.m:
browser/browser_info.m:
browser/collect_lib.m:
browser/debugger_interface.m:
browser/declarative_analyser.m:
browser/declarative_debugger.m:
browser/declarative_edt.m:
browser/declarative_execution.m:
browser/declarative_oracle.m:
browser/declarative_test.m:
browser/declarative_tree.m:
browser/declarative_user.m:
browser/diff.m:
browser/dl.m:
browser/frame.m:
browser/help.m:
browser/interactive_query.m:
browser/io_action.m:
browser/listing.m:
browser/mdb.m:
browser/mer_browser.m:
browser/name_mangle.m:
browser/term_rep.m:
browser/tree234_cc.m:
Fix inconsistencies between (a) the order in which functions and predicates
are declared, and (b) the order in which they are defined.
In most modules, either the order of the declarations or the order
of the definitions made sense, and I changed the other to match.
In some modules, neither made sense, so I changed *both* to an order
that *does* make sense (i.e. it has related predicates together).
In some places, put dividers between groups of related
functions/predicates, to make the groups themselves more visible.
In some places, fix comments or programming style.
browser/MDB_FLAGS.in:
Since all the modules in this directory are now free from any warnings
generated by --warn-inconsistent-pred-order-clauses, specify that option
by default in this directory to keep it that way.
984 lines
31 KiB
Mathematica
984 lines
31 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 1999-2007, 2011 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,dylib}', dynamically loads in the object code for the
|
|
% module `mdb_query' from the file `libmdb_query.{so,dylib}', 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.
|
|
:- import_module univ.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% query(QueryType, Imports, Options, Names, Values, MdbStdin, MdbStdout)
|
|
%
|
|
% Start the query loop for the given query type. Imports is the list of
|
|
% modules to import, Options is the string of additional options to pass
|
|
% to mmc for compiling the generated code, Names and Values are the
|
|
% corresponding lists of variable names and values in the current
|
|
% environment, and MdbStdin and MdbStdout are the input and output
|
|
% streams to use.
|
|
%
|
|
:- pred query(query_type::in, imports::in, options_string::in,
|
|
list(string)::in, list(univ)::in,
|
|
io.input_stream::in, io.output_stream::in, io::di, io::uo) is cc_multi.
|
|
|
|
% query_external/9 is the same as query/9 but for the use
|
|
% of the external debugger.
|
|
%
|
|
:- pred query_external(query_type::in, imports::in, options_string::in,
|
|
list(string)::in, list(univ)::in,
|
|
io.input_stream::in, io.output_stream::in, io::di, io::uo) is cc_multi.
|
|
|
|
:- type query_type
|
|
---> normal_query
|
|
; cc_query
|
|
; io_query.
|
|
|
|
:- type imports == list(string).
|
|
:- type options_string == string.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module mdb.dl.
|
|
:- import_module mdb.name_mangle.
|
|
:- import_module mdb.util.
|
|
|
|
:- import_module bool.
|
|
:- import_module exception.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module parser.
|
|
:- import_module string.
|
|
:- import_module term.
|
|
:- import_module term_io.
|
|
:- import_module type_desc.
|
|
:- import_module varset.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type query_env
|
|
---> query_env(
|
|
qe_query_type :: query_type,
|
|
qe_imports :: imports,
|
|
qe_options :: options_string,
|
|
qe_bindings :: bindings,
|
|
qe_in :: io.input_stream,
|
|
qe_out :: io.output_stream
|
|
).
|
|
|
|
:- type bindings == map(string, univ).
|
|
|
|
:- pragma foreign_export("C", query(in, in, in, in, in, in, in, di, uo),
|
|
"ML_query").
|
|
|
|
query(QueryType, Imports, Options, Names, Values, MdbStdin, MdbStdout, !IO) :-
|
|
% write_import_list(Imports),
|
|
map.from_corresponding_lists(Names, Values, Bindings),
|
|
Env = query_env(QueryType, Imports, Options, Bindings,
|
|
MdbStdin, MdbStdout),
|
|
query_2(Env, !IO).
|
|
|
|
:- pred query_2(query_env::in, io::di, io::uo) is cc_multi.
|
|
|
|
query_2(Env, !IO) :-
|
|
Prompt = query_prompt(Env ^ qe_query_type),
|
|
util.trace_getline(Prompt, Result, Env ^ qe_in, Env ^ qe_out, !IO),
|
|
(
|
|
Result = eof,
|
|
io.nl(Env ^ qe_out, !IO)
|
|
;
|
|
Result = error(Error),
|
|
io.error_message(Error, Msg),
|
|
io.write_string(Env ^ qe_out, Msg, !IO),
|
|
io.nl(Env ^ qe_out, !IO),
|
|
query_2(Env, !IO)
|
|
;
|
|
Result = ok(Line),
|
|
parser.read_term_from_string("", Line, _, ReadTerm),
|
|
query_3(Env, ReadTerm, !IO)
|
|
).
|
|
|
|
:- pred query_3(query_env::in, read_term(generic)::in, io::di, io::uo)
|
|
is cc_multi.
|
|
|
|
query_3(Env, ReadTerm, !IO) :-
|
|
(
|
|
ReadTerm = eof,
|
|
io.nl(Env ^ qe_out, !IO)
|
|
;
|
|
ReadTerm = error(Msg, _Line),
|
|
io.write_string(Env ^ qe_out, Msg, !IO),
|
|
io.nl(Env ^ qe_out, !IO),
|
|
query_2(Env, !IO)
|
|
;
|
|
ReadTerm = term(Varset, Term),
|
|
% io.write_string("Read term: "),
|
|
% term_io.write_term(Term, Varset),
|
|
% io.write_string("\n"),
|
|
parse_query_command(Term, Cmd),
|
|
(
|
|
Cmd = qc_quit,
|
|
io.nl(Env ^ qe_out, !IO)
|
|
;
|
|
Cmd = qc_options(NewOptions),
|
|
print(Env ^ qe_out, "Compilation options: ", !IO),
|
|
print(Env ^ qe_out, NewOptions, !IO),
|
|
io.nl(Env ^ qe_out, !IO),
|
|
Env1 = Env ^ qe_options := NewOptions,
|
|
query_2(Env1, !IO)
|
|
;
|
|
Cmd = qc_imports(AddedImports),
|
|
Imports = (Env ^ qe_imports) ++ AddedImports,
|
|
Env1 = Env ^ qe_imports := Imports,
|
|
write_import_list(Env ^ qe_out, Imports, !IO),
|
|
query_2(Env1, !IO)
|
|
;
|
|
Cmd = qc_goal,
|
|
% 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(Env ^ qe_out, !IO),
|
|
run_query(Env, Term, Varset, !IO),
|
|
query_2(Env, !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 foreign_export("C",
|
|
query_external(in, in, in, in, in, in, in, di, uo),
|
|
"ML_query_external").
|
|
|
|
query_external(QueryType, Imports, Options, Names, Values, SocketIn, SocketOut,
|
|
!IO) :-
|
|
map.from_corresponding_lists(Names, Values, Bindings),
|
|
Env = query_env(QueryType, Imports, Options, Bindings,
|
|
SocketIn, SocketOut),
|
|
query_external_2(Env, !IO).
|
|
|
|
:- pred query_external_2(query_env::in, io::di, io::uo) is cc_multi.
|
|
|
|
query_external_2(Env, !IO) :-
|
|
io.set_input_stream(Env ^ qe_in, OldInputStream, !IO),
|
|
term_io.read_term(Result, !IO),
|
|
io.set_input_stream(OldInputStream, _, !IO),
|
|
(
|
|
Result = eof,
|
|
send_term_to_socket(iq_eof, Env ^ qe_out, !IO)
|
|
;
|
|
Result = error(ErrorMsg, _Line),
|
|
send_term_to_socket(iq_error(ErrorMsg), Env ^ qe_out, !IO),
|
|
query_external_2(Env, !IO)
|
|
;
|
|
Result = term(Varset, Term),
|
|
parse_query_command(Term, Cmd),
|
|
(
|
|
Cmd = qc_quit,
|
|
send_term_to_socket(iq_quit, Env ^ qe_out, !IO)
|
|
;
|
|
Cmd = qc_options(NewOptions),
|
|
send_term_to_socket(iq_ok, Env ^ qe_out, !IO),
|
|
Env1 = Env ^ qe_options := NewOptions,
|
|
query_external_2(Env1, !IO)
|
|
;
|
|
Cmd = qc_imports(AddedImports),
|
|
Imports = (Env ^ qe_imports) ++ AddedImports,
|
|
Env1 = Env ^ qe_imports := Imports,
|
|
send_term_to_socket(iq_imported(Imports), Env ^ qe_out, !IO),
|
|
query_external_2(Env1, !IO)
|
|
;
|
|
Cmd = qc_goal,
|
|
run_query(Env, Term, Varset, !IO),
|
|
send_term_to_socket(iq_ok, Env ^ qe_out, !IO),
|
|
query_external_2(Env, !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) :-
|
|
io.write(SocketStream, Term, !IO),
|
|
io.write_string(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 <-- ".
|
|
|
|
:- type query_command
|
|
---> qc_quit
|
|
; qc_options(string)
|
|
; qc_imports(imports)
|
|
; qc_goal.
|
|
|
|
:- pred parse_query_command(term::in, query_command::out) is det.
|
|
|
|
parse_query_command(Term, Cmd) :-
|
|
( if
|
|
Term = term.functor(term.atom("quit"), [], _)
|
|
then
|
|
Cmd = qc_quit
|
|
else if
|
|
Term = term.functor(term.atom("options"), [Subterm], _),
|
|
Subterm = term.functor(term.string(Options), [], _)
|
|
then
|
|
Cmd = qc_options(Options)
|
|
else if
|
|
term_to_list(Term, Imports)
|
|
then
|
|
Cmd = qc_imports(Imports)
|
|
else
|
|
Cmd = qc_goal
|
|
).
|
|
|
|
:- 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(query_env::in, term::in, varset::in, io::di, io::uo)
|
|
is cc_multi.
|
|
|
|
run_query(Env, Goal, Varset, !IO) :-
|
|
SourceFile = query_module_name ++ ".m",
|
|
io.get_environment_var("MERCURY_OPTIONS", MaybeMercuryOptions, !IO),
|
|
(
|
|
MaybeMercuryOptions = yes(MercuryOptions),
|
|
io.set_environment_var("MERCURY_OPTIONS", "", !IO),
|
|
make_program(Env, Goal, Varset, Program),
|
|
write_prog_to_file(Program, SourceFile, !IO),
|
|
compile_file(Env ^ qe_options, Succeeded, !IO),
|
|
(
|
|
Succeeded = yes,
|
|
dynamically_load_and_run(Program, !IO)
|
|
;
|
|
Succeeded = no
|
|
),
|
|
cleanup_query(Env ^ qe_options, !IO),
|
|
io.set_environment_var("MERCURY_OPTIONS", MercuryOptions, !IO)
|
|
;
|
|
MaybeMercuryOptions = no,
|
|
io.write_string("Unable to unset MERCURY_OPTIONS environment variable",
|
|
!IO)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Print the program to a file.
|
|
%
|
|
% For normal queries we generate programs as follows, assuming input variables
|
|
% A:int and B:float and output variables X, Y and Z. (The types of the latter
|
|
% will be inferred.)
|
|
%
|
|
% :- module mdb_query.
|
|
% :- interface.
|
|
%
|
|
% :- import_module bool.
|
|
% :- import_module map.
|
|
% :- import_module univ.
|
|
%
|
|
% :- pred run(map(string, univ)::in, map(string, univ)::out, bool::out)
|
|
% is nondet.
|
|
%
|
|
% :- implementation.
|
|
%
|
|
% run(!Bindings, Loaded) :-
|
|
% ( if
|
|
% univ.univ_to_type(!.Bindings ^ elem("A"), A),
|
|
% univ.univ_to_type(!.Bindings ^ elem("B"), B),
|
|
% true
|
|
% then
|
|
% mdb_query.query(inputs(A, B), X, Y, Z),
|
|
% map.set("X", univ.univ(X), !Bindings),
|
|
% map.set("Y", univ.univ(Y), !Bindings),
|
|
% map.set("Z", univ.univ(Z), !Bindings),
|
|
% Loaded = yes
|
|
% else
|
|
% Loaded = no
|
|
% ).
|
|
%
|
|
% :- type inputs ---> inputs(int, float).
|
|
%
|
|
% :- pragma source_file("<<stdin>>").
|
|
% #1
|
|
% ... user imports ...
|
|
% #1
|
|
% :- mode query(in, out, out, out) is nondet.
|
|
% #1
|
|
% query(inputs(A, B), X, Y, Z) :-
|
|
% #1
|
|
% ( ... user query term ... ).
|
|
%
|
|
% For cc queries we do the same, except that run and query have determinism
|
|
% cc_nondet instead of nondet.
|
|
%
|
|
% For io queries, the io state is threaded through run and query, and the
|
|
% latter is defined using a DCG-rule. The determinism is cc_multi.
|
|
%
|
|
|
|
:- type prog
|
|
---> prog(
|
|
prog_query_type :: query_type,
|
|
prog_imports :: imports,
|
|
prog_bindings :: bindings,
|
|
prog_inputs :: list(string),
|
|
prog_outputs :: list(string),
|
|
prog_goal :: term,
|
|
prog_varset :: varset
|
|
).
|
|
|
|
:- pred make_program(query_env::in, term::in, varset::in, prog::out) is det.
|
|
|
|
make_program(Env, Goal, Varset, Program) :-
|
|
QueryType = Env ^ qe_query_type,
|
|
term.vars(Goal, Vars0),
|
|
list.remove_dups(Vars0, Vars1),
|
|
list.filter_map(varset.search_name(Varset), Vars1, Vars),
|
|
list.filter(map.contains(Env ^ qe_bindings), Vars, Inputs, Outputs0),
|
|
(
|
|
( QueryType = normal_query
|
|
; QueryType = cc_query
|
|
),
|
|
list.filter((pred(S::in) is semidet :- not string.index(S, 0, '_')),
|
|
Outputs0, Outputs)
|
|
;
|
|
QueryType = io_query,
|
|
Outputs = []
|
|
),
|
|
Program = prog(QueryType, Env ^ qe_imports, Env ^ qe_bindings,
|
|
Inputs, Outputs, Goal, Varset).
|
|
|
|
:- 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, !IO) :-
|
|
Prog = prog(QueryType, Imports, Bindings, Inputs, Outputs, Goal, Varset),
|
|
io.write_strings([
|
|
":- module mdb_query.\n",
|
|
":- interface.\n",
|
|
"\n",
|
|
":- import_module bool.\n",
|
|
query_type_extra_imports(QueryType),
|
|
":- import_module map.\n",
|
|
":- import_module univ.\n",
|
|
"\n",
|
|
":- pred run(map(string, univ)::in, map(string, univ)::out,\n",
|
|
" bool::out", query_type_extra_decls(QueryType),
|
|
") is ", query_type_detism(QueryType), ".\n",
|
|
"\n",
|
|
":- implementation.\n",
|
|
"\n",
|
|
"run(!Bindings, Loaded", query_type_extra_args(QueryType), ") :-\n",
|
|
" ( if\n"
|
|
], !IO),
|
|
list.foldl(write_cast_goal, Inputs, !IO),
|
|
io.write_strings([
|
|
" true\n",
|
|
" then\n",
|
|
" ", query_module_name, ".query(inputs"
|
|
], !IO),
|
|
write_args(Inputs, !IO),
|
|
list.foldl(write_comma_var, Outputs, !IO),
|
|
io.write_strings([query_type_extra_args(QueryType), "),\n"], !IO),
|
|
list.foldl(write_set_goal, Outputs, !IO),
|
|
io.write_strings([
|
|
" Loaded = yes\n",
|
|
" else\n",
|
|
" Loaded = no\n",
|
|
" ).\n",
|
|
"\n",
|
|
":- type inputs ---> inputs"
|
|
], !IO),
|
|
write_arg_types(Bindings, Inputs, !IO),
|
|
io.write_strings([".\n",
|
|
"\n",
|
|
":- pragma source_file(""<stdin>"").\n",
|
|
"#1\n"
|
|
], !IO),
|
|
io.output_stream(Out, !IO),
|
|
write_import_list(Out, Imports, !IO),
|
|
io.write_strings([
|
|
"#1\n",
|
|
":- mode query(in"
|
|
], !IO),
|
|
list.foldl((pred(_::in, di, uo) is det --> io.write_string(", out")),
|
|
Outputs, !IO),
|
|
io.write_strings([
|
|
query_type_extra_modes(QueryType),
|
|
") is ", query_type_detism(QueryType), ".\n",
|
|
"#1\n",
|
|
"query(inputs"
|
|
], !IO),
|
|
write_args(Inputs, !IO),
|
|
list.foldl(write_comma_var, Outputs, !IO),
|
|
io.write_strings([") ", query_type_rule(QueryType)], !IO),
|
|
write_line_directive(!IO),
|
|
io.write_string(" ( ", !IO),
|
|
term_io.write_term(Varset, Goal, !IO),
|
|
io.write_string(" ).\n", !IO).
|
|
|
|
:- func query_type_detism(query_type) = string.
|
|
|
|
query_type_detism(normal_query) = "nondet".
|
|
query_type_detism(cc_query) = "cc_nondet".
|
|
query_type_detism(io_query) = "cc_multi".
|
|
|
|
:- func query_type_extra_imports(query_type) = string.
|
|
|
|
query_type_extra_imports(normal_query) = "".
|
|
query_type_extra_imports(cc_query) = "".
|
|
query_type_extra_imports(io_query) = ":- import_module io.\n".
|
|
|
|
:- func query_type_extra_decls(query_type) = string.
|
|
|
|
query_type_extra_decls(normal_query) = "".
|
|
query_type_extra_decls(cc_query) = "".
|
|
query_type_extra_decls(io_query) = ", io::di, io::uo".
|
|
|
|
:- func query_type_extra_modes(query_type) = string.
|
|
|
|
query_type_extra_modes(normal_query) = "".
|
|
query_type_extra_modes(cc_query) = "".
|
|
query_type_extra_modes(io_query) = ", di, uo".
|
|
|
|
:- func query_type_extra_args(query_type) = string.
|
|
|
|
query_type_extra_args(normal_query) = "".
|
|
query_type_extra_args(cc_query) = "".
|
|
query_type_extra_args(io_query) = ", !IO".
|
|
|
|
:- func query_type_rule(query_type) = string.
|
|
|
|
query_type_rule(normal_query) = ":-".
|
|
query_type_rule(cc_query) = ":-".
|
|
query_type_rule(io_query) = "-->".
|
|
|
|
:- pred write_cast_goal(string::in, io::di, io::uo) is det.
|
|
|
|
write_cast_goal(Var, !IO) :-
|
|
io.write_strings([
|
|
" univ.univ_to_type(!.Bindings ^ elem(""", Var, """), ",
|
|
Var, "),\n"
|
|
], !IO).
|
|
|
|
:- pred write_set_goal(string::in, io::di, io::uo) is det.
|
|
|
|
write_set_goal(Var, !IO) :-
|
|
io.write_strings([
|
|
" map.set(""", Var, """, univ.univ(", Var, "), !Bindings),\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_arg_types(bindings::in, list(string)::in, io::di, io::uo) is det.
|
|
|
|
write_arg_types(Bindings, Vars, !IO) :-
|
|
(
|
|
Vars = [_ | _],
|
|
io.write_string("(", !IO),
|
|
io.write_list(Vars, ", ", write_var_type(Bindings), !IO),
|
|
io.write_string(")", !IO)
|
|
;
|
|
Vars = []
|
|
).
|
|
|
|
:- pred write_var_type(bindings::in, string::in, io::di, io::uo)
|
|
is det.
|
|
|
|
write_var_type(Bindings, Var, !IO) :-
|
|
map.lookup(Bindings, Var, Univ),
|
|
io.write_string(type_name(type_of(univ_value(Univ))), !IO).
|
|
|
|
:- pred write_args(list(string)::in, io::di, io::uo) is det.
|
|
|
|
write_args(Vars, !IO) :-
|
|
(
|
|
Vars = [_ | _],
|
|
io.write_string("(", !IO),
|
|
io.write_list(Vars, ", ", io.write_string, !IO),
|
|
io.write_string(")", !IO)
|
|
;
|
|
Vars = []
|
|
).
|
|
|
|
:- pred write_comma_var(string::in, io::di, io::uo) is det.
|
|
|
|
write_comma_var(Var, !IO) :-
|
|
io.write_string(", ", !IO),
|
|
io.write_string(Var, !IO).
|
|
|
|
:- pred write_import_list(io.output_stream::in, imports::in,
|
|
io::di, io::uo) is det.
|
|
|
|
write_import_list(Out, Imports, !IO) :-
|
|
(
|
|
Imports = []
|
|
;
|
|
Imports = [_ | _],
|
|
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_string::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
|
|
% --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,
|
|
" --compile-to-shared-lib ",
|
|
query_module_name],
|
|
Command),
|
|
invoke_system_command(Command, Succeeded, !IO).
|
|
|
|
:- pred cleanup_query(string::in, io::di, io::uo) is det.
|
|
|
|
cleanup_query(_Options) -->
|
|
cleanup_file("", ".m"),
|
|
cleanup_file("", ".mh"),
|
|
cleanup_file("", ".d"),
|
|
cleanup_file("Mercury/ds/", ".d"),
|
|
cleanup_file("", ".c"),
|
|
cleanup_file("Mercury/cs/", ".c"),
|
|
cleanup_file("", ".c_date"),
|
|
cleanup_file("Mercury/c_dates/", ".c_date"),
|
|
cleanup_file("", ".o"),
|
|
cleanup_file("Mercury/os/", ".o"),
|
|
cleanup_file("", ".pic_o"),
|
|
cleanup_file("Mercury/os/", ".pic_o"),
|
|
cleanup_file("lib", ".so").
|
|
|
|
:- pred cleanup_file(string::in, string::in, io::di, io::uo) is det.
|
|
|
|
cleanup_file(Prefix, Suffix, !IO) :-
|
|
io.remove_file(Prefix ++ query_module_name ++ Suffix, _, !IO).
|
|
|
|
% `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.
|
|
%
|
|
:- func grade_option = string.
|
|
|
|
:- 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) :-
|
|
( if verbose = yes then
|
|
io.format("%% Invoking system command `%s'...\n", [s(Command)], !IO),
|
|
io.flush_output(!IO)
|
|
else
|
|
true
|
|
),
|
|
io.call_system(Command, Result, !IO),
|
|
(
|
|
Result = ok(Status),
|
|
( if Status = 0 then
|
|
( if verbose = yes then
|
|
io.write_string("% done.\n", !IO)
|
|
else
|
|
true
|
|
),
|
|
Succeeded = yes
|
|
else
|
|
io.write_string("Compilation error(s) occurred.\n", !IO),
|
|
Succeeded = no
|
|
)
|
|
;
|
|
Result = error(_),
|
|
io.write_string("Error: unable to invoke the compiler.\n", !IO),
|
|
Succeeded = no
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- func query_module_name = string.
|
|
|
|
query_module_name = "mdb_query".
|
|
|
|
% Dynamically load the shared object and execute the query.
|
|
%
|
|
:- pred dynamically_load_and_run(prog::in, io::di, io::uo) is cc_multi.
|
|
|
|
dynamically_load_and_run(Program, !IO) :-
|
|
% Load in the object code for the module `query' from
|
|
% the file `libmdb_query.{so,dylib}'.
|
|
Filename = "./lib" ++ query_module_name ++ shlib_extension,
|
|
dl.open(Filename, lazy, scope_local, MaybeHandle, !IO),
|
|
(
|
|
MaybeHandle = dl_error(Msg),
|
|
io.format("dlopen failed: %s\n", [s(Msg)], !IO)
|
|
;
|
|
MaybeHandle = dl_ok(Handle),
|
|
QueryType = Program ^ prog_query_type,
|
|
Bindings = Program ^ prog_bindings,
|
|
Outputs = Program ^ prog_outputs,
|
|
(
|
|
QueryType = normal_query,
|
|
link_and_run_normal(Bindings, Outputs, Handle, !IO)
|
|
;
|
|
QueryType = cc_query,
|
|
link_and_run_cc(Bindings, Outputs, Handle, !IO)
|
|
;
|
|
QueryType = io_query,
|
|
link_and_run_io(Bindings, Outputs, Handle, !IO)
|
|
),
|
|
% Unload the object code in the libmdb_query.{so,dylib} file.
|
|
dl.close(Handle, Result, !IO),
|
|
(
|
|
Result = dl_error(CloseMsg),
|
|
io.format("dlclose failed: %s\n", [s(CloseMsg)], !IO)
|
|
;
|
|
Result = dl_ok
|
|
)
|
|
).
|
|
|
|
:- pred link_and_run_normal(bindings::in, list(string)::in, handle::in,
|
|
io::di, io::uo) is cc_multi.
|
|
|
|
link_and_run_normal(Bindings, Outputs, Handle, !IO) :-
|
|
get_query_closure(3, Handle, MaybeQuery, !IO),
|
|
(
|
|
MaybeQuery = dl_error(Msg),
|
|
io.write_strings(["dlsym failed: ", Msg, "\n"], !IO)
|
|
;
|
|
MaybeQuery = dl_ok(QueryPred),
|
|
exception.try_all(call_run_normal(QueryPred, Bindings),
|
|
MaybeExcp, Solutions),
|
|
list.foldl(write_solution(Outputs, "true ;"), Solutions, !IO),
|
|
(
|
|
MaybeExcp = yes(Excp),
|
|
report_exception(univ_value(Excp), !IO)
|
|
;
|
|
MaybeExcp = no,
|
|
io.write_string("fail.\n", !IO)
|
|
),
|
|
io.write_string("No (more) solutions.\n", !IO)
|
|
).
|
|
|
|
:- type run_normal_pred == pred(bindings, bindings, bool).
|
|
:- inst run_normal_pred == (pred(in, out, out) is nondet).
|
|
|
|
:- pred call_run_normal(run_normal_pred::in, bindings::in, solution::out)
|
|
is nondet.
|
|
|
|
call_run_normal(QueryPred0, Bindings0, Solution) :-
|
|
QueryPred = inst_cast_normal(QueryPred0),
|
|
QueryPred(Bindings0, Bindings, Loaded),
|
|
(
|
|
Loaded = no,
|
|
Solution = load_failure
|
|
;
|
|
Loaded = yes,
|
|
Solution = solution(Bindings)
|
|
).
|
|
|
|
:- pred link_and_run_cc(bindings::in, list(string)::in, handle::in,
|
|
io::di, io::uo) is cc_multi.
|
|
|
|
link_and_run_cc(Bindings, Outputs, Handle, !IO) :-
|
|
get_query_closure(3, Handle, MaybeQuery, !IO),
|
|
(
|
|
MaybeQuery = dl_error(Msg),
|
|
io.write_strings(["dlsym failed: ", Msg, "\n"], !IO)
|
|
;
|
|
MaybeQuery = dl_ok(QueryPred),
|
|
exception.try(call_run_cc(QueryPred, Bindings), Result),
|
|
(
|
|
Result = succeeded(Solution),
|
|
write_solution(Outputs, "true.", Solution, !IO)
|
|
;
|
|
Result = failed,
|
|
io.write_string("No solution.\n", !IO)
|
|
;
|
|
Result = exception(Excp),
|
|
report_exception(univ_value(Excp), !IO)
|
|
)
|
|
).
|
|
|
|
:- type run_cc_pred == pred(bindings, bindings, bool).
|
|
:- inst run_cc_pred == (pred(in, out, out) is cc_nondet).
|
|
|
|
:- pred call_run_cc(run_cc_pred::in, bindings::in, solution::out) is cc_nondet.
|
|
|
|
call_run_cc(QueryPred0, Bindings0, Solution) :-
|
|
QueryPred = inst_cast_cc(QueryPred0),
|
|
QueryPred(Bindings0, Bindings, Loaded),
|
|
(
|
|
Loaded = no,
|
|
Solution = load_failure
|
|
;
|
|
Loaded = yes,
|
|
Solution = solution(Bindings)
|
|
).
|
|
|
|
:- pred link_and_run_io(bindings::in, list(string)::in, handle::in,
|
|
io::di, io::uo) is cc_multi.
|
|
|
|
link_and_run_io(Bindings, _Outputs, Handle, !IO) :-
|
|
get_query_closure(5, Handle, MaybeQuery, !IO),
|
|
(
|
|
MaybeQuery = dl_error(Msg),
|
|
io.write_strings(["dlsym failed: ", Msg, "\n"], !IO)
|
|
;
|
|
MaybeQuery = dl_ok(QueryPred),
|
|
exception.try_io(call_run_io(QueryPred, Bindings), Result, !IO),
|
|
(
|
|
Result = succeeded(_)
|
|
;
|
|
Result = exception(Excp),
|
|
report_exception(univ_value(Excp), !IO)
|
|
)
|
|
).
|
|
|
|
:- type run_io_pred == pred(bindings, bindings, bool, io, io).
|
|
:- inst run_io_pred == (pred(in, out, out, di, uo) is cc_multi).
|
|
|
|
:- pred call_run_io(run_io_pred::in, bindings::in, solution::out,
|
|
io::di, io::uo) is cc_multi.
|
|
|
|
call_run_io(QueryPred0, Bindings0, Solution, !IO) :-
|
|
QueryPred = inst_cast_io(QueryPred0),
|
|
QueryPred(Bindings0, Bindings, Loaded, !IO),
|
|
(
|
|
Loaded = no,
|
|
Solution = load_failure
|
|
;
|
|
Loaded = yes,
|
|
Solution = solution(Bindings)
|
|
).
|
|
|
|
:- pred get_query_closure(int::in, handle::in, dl_result(T)::out,
|
|
io::di, io::uo) is det.
|
|
|
|
get_query_closure(Arity, Handle, Result, !IO) :-
|
|
%
|
|
% Look up the address of the first mode (mode number 0)
|
|
% of the predicate run with the given arity in the mdb_query module.
|
|
%
|
|
QueryProc = mercury_proc(predicate, unqualified(query_module_name),
|
|
"run", Arity, 0),
|
|
dl.mercury_sym(Handle, QueryProc, Result, !IO).
|
|
|
|
:- type solution
|
|
---> load_failure
|
|
; solution(bindings).
|
|
|
|
:- pred write_solution(list(string)::in, string::in, solution::in,
|
|
io::di, io::uo) is cc_multi.
|
|
|
|
write_solution(Outputs, End, Solution, !IO) :-
|
|
(
|
|
Solution = load_failure,
|
|
io.write_string("Error loading some variables.\n", !IO)
|
|
;
|
|
Solution = solution(Bindings),
|
|
list.foldl(write_binding(Bindings), Outputs, !IO),
|
|
io.write_string(End, !IO),
|
|
io.write_string("\n", !IO)
|
|
).
|
|
|
|
:- pred write_binding(bindings::in, string::in, io::di, io::uo) is cc_multi.
|
|
|
|
write_binding(Bindings, Output, !IO) :-
|
|
map.lookup(Bindings, Output, Univ),
|
|
io.write_string(Output, !IO),
|
|
io.write_string(" = ", !IO),
|
|
io.write_cc(univ_value(Univ), !IO),
|
|
io.write_string(", ", !IO).
|
|
|
|
:- pred report_exception(T::in, io::di, io::uo) is cc_multi.
|
|
|
|
report_exception(Excp, !IO) :-
|
|
io.write_string("*** caught exception: ", !IO),
|
|
io.write_cc(Excp, !IO),
|
|
io.nl(!IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% dl.mercury_sym returns a higher-order term with inst `ground'. We need to
|
|
% cast it to the right higher-order inst before we can actually call it. The
|
|
% functions inst_cast_*/1 defined below do that.
|
|
%
|
|
|
|
:- func inst_cast_normal(run_normal_pred) = run_normal_pred.
|
|
:- mode inst_cast_normal(in) = out(run_normal_pred) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
inst_cast_normal(X::in) = (Y::out(run_normal_pred)),
|
|
[promise_pure, will_not_call_mercury, thread_safe],
|
|
"
|
|
Y = X
|
|
").
|
|
|
|
inst_cast_normal(_) = _ :-
|
|
private_builtin.sorry("inst_cast_normal").
|
|
|
|
:- func inst_cast_cc(run_cc_pred) = run_cc_pred.
|
|
:- mode inst_cast_cc(in) = out(run_cc_pred) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
inst_cast_cc(X::in) = (Y::out(run_cc_pred)),
|
|
[promise_pure, will_not_call_mercury, thread_safe],
|
|
"
|
|
Y = X
|
|
").
|
|
|
|
inst_cast_cc(_) = _ :-
|
|
private_builtin.sorry("inst_cast_cc").
|
|
|
|
:- func inst_cast_io(run_io_pred) = run_io_pred.
|
|
:- mode inst_cast_io(in) = out(run_io_pred) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
inst_cast_io(X::in) = (Y::out(run_io_pred)),
|
|
[promise_pure, will_not_call_mercury, thread_safe],
|
|
"
|
|
Y = X
|
|
").
|
|
|
|
inst_cast_io(_) = _ :-
|
|
private_builtin.sorry("inst_cast_io").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- func shlib_extension = string.
|
|
|
|
shlib_extension =
|
|
( if system_is_darwin then ".dylib" else ".so" ).
|
|
|
|
:- pred system_is_darwin is semidet.
|
|
:- pragma foreign_proc("C",
|
|
system_is_darwin,
|
|
[promise_pure, will_not_call_mercury, thread_safe],
|
|
"
|
|
#if defined(MR_MAC_OSX)
|
|
SUCCESS_INDICATOR = MR_TRUE;
|
|
#else
|
|
SUCCESS_INDICATOR = MR_FALSE;
|
|
#endif
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|