mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-23 13:23:47 +00:00
752bb66f5b
Most modules that imported the old term.m need only a small subset
of its functionality. After this diff, most modules that used to import
term.m will need to import just one more module, and will import many
fewer predicates and functions in total.
library/term_int.m:
A new module carved out of term.m containing the predicates
that recognize terms containing integers, and the functions
that construct such terms.
While this job has *some* similarity to the job of the existing
term_conversion.m module, most modules in the compiler use only one
of those two modules, so merging them would not be a good idea.
library/term_subst.m:
A new module carved out of term.m containing code to do
substitutions and renames of various kinds.
Rename the occurs predicate as var_occurs_in_subst_term,
and occurs_list as var_occurs_in_subst_terms, since the latter
are much more descriptive. Change the argument order to match
the new names (var, subst, term/terms), as the old one did not
even have the term/terms and the substitution next to each other,
even though neither makes sense without the other.
library/term_unify.m:
A new module carved out of term.m containing code to do unifications.
Give all the predicates more meaningful names:
unify_term -> unify_terms
unify_term_list -> unify_term_lists
unify_term_dont_bind -> unify_terms_dont_bind
unify_term_list_dont_bind -> unify_term_lists_dont_bind
list_subsumes -> first_term_list_subsumes_second
library/term_vars.m:
A new module carved out of term.m containing code that find variables
in terms.
Give all the predicates more meaningful names:
vars -> vars_in_term
vars_2 -> vars_in_term_acc
vars_list -> vars_in_terms
contains_var -> term_contains_var
contains_var_list -> terms_contain_var
Don't move the function version of vars_2 to term_vars.m, effectively
deleting it, since operations that update an accumulator are awkward
for functions.
library/term.m:
Keep the moved predicates and functions in term.m, but
- change their implementation to simply call the moved copy, and
- obsolete the original in favor of the moved copy.
Eventually, after either the next release or the release after the next,
we should delete the obsoleted predicates and functions.
library/MODULES_DOC:
library/library.m:
Add the new modules as documented parts of the standard library.
browser/interactive_query.m:
compiler/analysis.file.m:
compiler/det_util.m:
compiler/hlds_out_goal.m:
compiler/hlds_out_pred.m:
compiler/hlds_out_util.m:
compiler/intermod.m:
compiler/make.module_dep_file.m:
compiler/make_hlds_passes.m:
compiler/parse_class.m:
compiler/parse_inst_mode_defn.m:
compiler/parse_item.m:
compiler/parse_mutable.m:
compiler/parse_pragma.m:
compiler/parse_pragma_analysis.m:
compiler/parse_sym_name.m:
compiler/parse_tree_to_term.m:
compiler/parse_type_defn.m:
compiler/parse_util.m:
compiler/prog_ctgc.m:
compiler/prog_util.m:
compiler/recompilation.used_file.m:
compiler/recompilation.version.m:
compiler/superhomogeneous.m:
compiler/switch_detection.m:
compiler/typecheck.m:
library/io.m:
library/term_conversion.m:
library/varset.m:
Conform to the changes above.
1024 lines
34 KiB
Mathematica
1024 lines
34 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 1999-2007, 2011 The University of Melbourne.
|
|
% Copyright (C) 2015-2018 The Mercury team.
|
|
% This file is distributed under the terms specified in COPYING.LIB.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% 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 io.call_system.
|
|
:- import_module io.environment.
|
|
:- import_module io.file.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module mercury_term_parser.
|
|
:- import_module string.
|
|
:- import_module term.
|
|
:- import_module term_io.
|
|
:- import_module term_vars.
|
|
:- 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_instream :: io.input_stream,
|
|
qe_outstream :: 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(Env ^ qe_instream, Env ^ qe_outstream,
|
|
Prompt, Result, !IO),
|
|
(
|
|
Result = eof,
|
|
io.nl(Env ^ qe_outstream, !IO)
|
|
;
|
|
Result = error(Error),
|
|
io.error_message(Error, Msg),
|
|
io.write_string(Env ^ qe_outstream, Msg, !IO),
|
|
io.nl(Env ^ qe_outstream, !IO),
|
|
query_2(Env, !IO)
|
|
;
|
|
Result = ok(Line),
|
|
mercury_term_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_outstream, !IO)
|
|
;
|
|
ReadTerm = error(Msg, _Line),
|
|
io.write_string(Env ^ qe_outstream, Msg, !IO),
|
|
io.nl(Env ^ qe_outstream, !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_outstream, !IO)
|
|
;
|
|
Cmd = qc_options(NewOptions),
|
|
io.print(Env ^ qe_outstream, "Compilation options: ", !IO),
|
|
io.print(Env ^ qe_outstream, NewOptions, !IO),
|
|
io.nl(Env ^ qe_outstream, !IO),
|
|
Env1 = Env ^ qe_options := NewOptions,
|
|
query_2(Env1, !IO)
|
|
;
|
|
Cmd = qc_imports(AddedImports),
|
|
Imports = (Env ^ qe_imports) ++ AddedImports,
|
|
Env1 = Env ^ qe_imports := Imports,
|
|
list.foldl(write_module_import(Env ^ qe_outstream), 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_outstream, !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) :-
|
|
mercury_term_parser.read_term(Env ^ qe_instream, Result, !IO),
|
|
(
|
|
Result = eof,
|
|
query_send_term_to_socket(Env ^ qe_outstream, iq_eof, !IO)
|
|
;
|
|
Result = error(ErrorMsg, _Line),
|
|
query_send_term_to_socket(Env ^ qe_outstream, iq_error(ErrorMsg), !IO),
|
|
query_external_2(Env, !IO)
|
|
;
|
|
Result = term(Varset, Term),
|
|
parse_query_command(Term, Cmd),
|
|
(
|
|
Cmd = qc_quit,
|
|
query_send_term_to_socket(Env ^ qe_outstream, iq_quit, !IO)
|
|
;
|
|
Cmd = qc_options(NewOptions),
|
|
query_send_term_to_socket(Env ^ qe_outstream, iq_ok, !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,
|
|
query_send_term_to_socket(Env ^ qe_outstream,
|
|
iq_imported(Imports), !IO),
|
|
query_external_2(Env1, !IO)
|
|
;
|
|
Cmd = qc_goal,
|
|
run_query(Env, Term, Varset, !IO),
|
|
query_send_term_to_socket(Env ^ qe_outstream, iq_ok, !IO),
|
|
query_external_2(Env, !IO)
|
|
)
|
|
).
|
|
|
|
:- pred query_send_term_to_socket(io.output_stream::in,
|
|
interactive_query_response::in, io::di, io::uo) is det.
|
|
|
|
query_send_term_to_socket(SocketStream, Term, !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("[|]"), [HeadTerm, TailTerms], _),
|
|
[HeadModule | TailModules]) :-
|
|
HeadTerm = term.functor(term.atom(HeadModule), [], _),
|
|
term_to_list(TailTerms, TailModules).
|
|
|
|
:- 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.environment.get_environment_var("MERCURY_OPTIONS",
|
|
MaybeMercuryOptions, !IO),
|
|
(
|
|
MaybeMercuryOptions = yes(MercuryOptions),
|
|
io.environment.set_environment_var("MERCURY_OPTIONS", "", !IO),
|
|
make_program(Env, Goal, Varset, Program),
|
|
% XXX Shouldn't our caller give us this information?
|
|
io.get_line_number(Env ^ qe_instream, LineNumberForDirective, !IO),
|
|
write_prog_to_file(Env ^ qe_outstream, LineNumberForDirective,
|
|
Program, SourceFile, !IO),
|
|
compile_file(Env ^ qe_outstream, Env ^ qe_options, Succeeded, !IO),
|
|
(
|
|
Succeeded = yes,
|
|
dynamically_load_and_run(Env ^ qe_outstream, Program, !IO)
|
|
;
|
|
Succeeded = no
|
|
),
|
|
cleanup_query(Env ^ qe_options, !IO),
|
|
io.environment.set_environment_var("MERCURY_OPTIONS",
|
|
MercuryOptions, !IO)
|
|
;
|
|
MaybeMercuryOptions = no,
|
|
io.write_string(Env ^ qe_outstream,
|
|
"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.vars_in_term(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(io.text_output_stream::in, int::in, prog::in,
|
|
string::in, io::di, io::uo) is det.
|
|
|
|
write_prog_to_file(OutputStream, LineNumberForDirective, Program,
|
|
FileName, !IO) :-
|
|
io.open_output(FileName, Result, !IO),
|
|
(
|
|
Result = ok(FileStream),
|
|
write_prog_to_stream(FileStream, LineNumberForDirective, Program, !IO),
|
|
io.close_output(FileStream, !IO)
|
|
;
|
|
Result = error(Error),
|
|
io.progname("interactive", Progname, !IO),
|
|
io.error_message(Error, ErrorMessage),
|
|
io.format(OutputStream,
|
|
"%s: error opening file `%s' for output:\n\t%s\n",
|
|
[s(Progname), s(FileName), s(ErrorMessage)], !IO)
|
|
|
|
% We used to write Program out to stdout here, followed by
|
|
% the *closing* stdout :-( I have no idea who wanted that behavior,
|
|
% or why.
|
|
%
|
|
% The comment on the code that returned stdout as it were
|
|
% the freshly opened stream to FileStream was:
|
|
%
|
|
% XXX we really ought to throw an exception here;
|
|
% instead, we just return a bogus stream (stdout)
|
|
%
|
|
% io.stdout_stream(StdoutStream, !IO),
|
|
% write_prog_to_stream(StdoutStream, Program, !IO)
|
|
).
|
|
|
|
:- pred write_prog_to_stream(io.text_output_stream::in, int::in, prog::in,
|
|
io::di, io::uo) is det.
|
|
|
|
write_prog_to_stream(OutputStream, LineNumberForDirective, Prog, !IO) :-
|
|
Prog = prog(QueryType, Imports, Bindings, Inputs, Outputs, Goal, Varset),
|
|
io.write_strings(OutputStream, [
|
|
":- 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(OutputStream), Inputs, !IO),
|
|
io.write_strings(OutputStream, [
|
|
" true\n",
|
|
" then\n",
|
|
" ", query_module_name, ".query(inputs"
|
|
], !IO),
|
|
write_args(OutputStream, Inputs, !IO),
|
|
list.foldl(write_comma_var(OutputStream), Outputs, !IO),
|
|
io.write_strings(OutputStream,
|
|
[query_type_extra_args(QueryType), "),\n"], !IO),
|
|
list.foldl(write_set_goal(OutputStream), Outputs, !IO),
|
|
io.write_strings(OutputStream, [
|
|
" Loaded = yes\n",
|
|
" else\n",
|
|
" Loaded = no\n",
|
|
" ).\n",
|
|
"\n",
|
|
":- type inputs ---> inputs"
|
|
], !IO),
|
|
write_arg_types(OutputStream, Bindings, Inputs, !IO),
|
|
io.write_strings(OutputStream, [".\n",
|
|
"\n",
|
|
":- pragma source_file(""<stdin>"").\n",
|
|
"#1\n"
|
|
], !IO),
|
|
list.foldl(write_module_import(OutputStream), Imports, !IO),
|
|
io.write_strings(OutputStream, [
|
|
"#1\n",
|
|
":- mode query(in"
|
|
], !IO),
|
|
list.foldl(
|
|
( pred(_::in, di, uo) is det -->
|
|
io.write_string(OutputStream, ", out")
|
|
), Outputs, !IO),
|
|
io.write_strings(OutputStream, [
|
|
query_type_extra_modes(QueryType),
|
|
") is ", query_type_detism(QueryType), ".\n",
|
|
"#1\n",
|
|
"query(inputs"
|
|
], !IO),
|
|
write_args(OutputStream, Inputs, !IO),
|
|
list.foldl(write_comma_var(OutputStream), Outputs, !IO),
|
|
io.write_strings(OutputStream, [") ", query_type_rule(QueryType)], !IO),
|
|
io.format(OutputStream, "\n#%d\n", [i(LineNumberForDirective)], !IO),
|
|
io.write_string(OutputStream, " ( ", !IO),
|
|
term_io.write_term(OutputStream, Varset, Goal, !IO),
|
|
io.write_string(OutputStream, " ).\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(io.text_output_stream::in, string::in,
|
|
io::di, io::uo) is det.
|
|
|
|
write_cast_goal(OutputStream, Var, !IO) :-
|
|
io.write_strings(OutputStream, [
|
|
" univ.univ_to_type(!.Bindings ^ elem(""", Var, """), ",
|
|
Var, "),\n"
|
|
], !IO).
|
|
|
|
:- pred write_set_goal(io.text_output_stream::in, string::in,
|
|
io::di, io::uo) is det.
|
|
|
|
write_set_goal(OutputStream, Var, !IO) :-
|
|
io.write_strings(OutputStream, [
|
|
" map.set(""", Var, """, univ.univ(", Var, "), !Bindings),\n"
|
|
], !IO).
|
|
|
|
:- pred write_arg_types(io.text_output_stream::in, bindings::in,
|
|
list(string)::in, io::di, io::uo) is det.
|
|
|
|
write_arg_types(OutputStream, Bindings, Vars, !IO) :-
|
|
(
|
|
Vars = [HeadVar | TailVars],
|
|
io.write_string(OutputStream, "(", !IO),
|
|
write_var_type(OutputStream, Bindings, HeadVar, !IO),
|
|
write_comma_var_type(OutputStream, Bindings, TailVars, !IO),
|
|
io.write_string(OutputStream, ")", !IO)
|
|
;
|
|
Vars = []
|
|
).
|
|
|
|
:- pred write_var_type(io.text_output_stream::in, bindings::in, string::in,
|
|
io::di, io::uo) is det.
|
|
|
|
write_var_type(OutputStream, Bindings, Var, !IO) :-
|
|
map.lookup(Bindings, Var, Univ),
|
|
io.write_string(OutputStream, type_name(type_of(univ_value(Univ))), !IO).
|
|
|
|
:- pred write_comma_var_type(io.text_output_stream::in, bindings::in,
|
|
list(string)::in, io::di, io::uo) is det.
|
|
|
|
write_comma_var_type(_OutputStream, _Bindings, [], !IO).
|
|
write_comma_var_type(OutputStream, Bindings, [Var | Vars], !IO) :-
|
|
io.write_string(OutputStream, ", ", !IO),
|
|
write_var_type(OutputStream, Bindings, Var, !IO),
|
|
write_comma_var_type(OutputStream, Bindings, Vars, !IO).
|
|
|
|
:- pred write_args(io.text_output_stream::in, list(string)::in,
|
|
io::di, io::uo) is det.
|
|
|
|
write_args(OutputStream, Vars, !IO) :-
|
|
(
|
|
Vars = [HeadVar | TailVars],
|
|
io.write_string(OutputStream, "(", !IO),
|
|
io.write_string(OutputStream, HeadVar, !IO),
|
|
write_comma_args(OutputStream, TailVars, !IO),
|
|
io.write_string(OutputStream, ")", !IO)
|
|
;
|
|
Vars = []
|
|
).
|
|
|
|
:- pred write_comma_args(io.text_output_stream::in, list(string)::in,
|
|
io::di, io::uo) is det.
|
|
|
|
write_comma_args(_OutputStream, [], !IO).
|
|
write_comma_args(OutputStream, [Var | Vars], !IO) :-
|
|
io.write_string(OutputStream, ", ", !IO),
|
|
io.write_string(OutputStream, Var, !IO),
|
|
write_comma_args(OutputStream, Vars, !IO).
|
|
|
|
:- pred write_comma_var(io.text_output_stream::in, string::in,
|
|
io::di, io::uo) is det.
|
|
|
|
write_comma_var(OutputStream, Var, !IO) :-
|
|
io.format(OutputStream, ", %s", [s(Var)], !IO).
|
|
|
|
:- pred write_module_import(io.text_output_stream::in, string::in,
|
|
io::di, io::uo) is det.
|
|
|
|
write_module_import(OutputStream, ModuleName, !IO) :-
|
|
io.write_string(OutputStream, ":- import_module ", !IO),
|
|
term_io.quote_atom(OutputStream, ModuleName, !IO),
|
|
io.write_string(OutputStream, ".\n", !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Invoke the Mercury compile to compile the file to a shared object.
|
|
%
|
|
:- pred compile_file(io.text_output_stream::in, options_string::in, bool::out,
|
|
io::di, io::uo) is det.
|
|
|
|
compile_file(OutputStream, 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(OutputStream, Command, Succeeded, !IO).
|
|
|
|
:- pred cleanup_query(string::in, io::di, io::uo) is det.
|
|
|
|
cleanup_query(_Options, !IO) :-
|
|
cleanup_file("", ".m", !IO),
|
|
cleanup_file("", ".mh", !IO),
|
|
cleanup_file("", ".d", !IO),
|
|
cleanup_file("Mercury/ds/", ".d", !IO),
|
|
cleanup_file("", ".c", !IO),
|
|
cleanup_file("Mercury/cs/", ".c", !IO),
|
|
cleanup_file("", ".c_date", !IO),
|
|
cleanup_file("Mercury/c_dates/", ".c_date", !IO),
|
|
cleanup_file("", ".o", !IO),
|
|
% XXX The extension for object files is not *always* ".o".
|
|
cleanup_file("Mercury/os/", ".o", !IO),
|
|
cleanup_file("", ".pic_o", !IO),
|
|
cleanup_file("Mercury/os/", ".pic_o", !IO),
|
|
cleanup_file("lib", shlib_extension, !IO).
|
|
|
|
:- pred cleanup_file(string::in, string::in, io::di, io::uo) is det.
|
|
|
|
cleanup_file(Prefix, Suffix, !IO) :-
|
|
io.file.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(io.text_output_stream::in, string::in, bool::out,
|
|
io::di, io::uo) is det.
|
|
|
|
invoke_system_command(OutputStream, Command, Succeeded, !IO) :-
|
|
Verbose = verbose,
|
|
(
|
|
Verbose = yes,
|
|
io.format(OutputStream, "%% Invoking system command `%s'...\n",
|
|
[s(Command)], !IO),
|
|
io.flush_output(OutputStream, !IO)
|
|
;
|
|
Verbose = no
|
|
),
|
|
io.call_system.call_system(Command, Result, !IO),
|
|
(
|
|
Result = ok(Status),
|
|
( if Status = 0 then
|
|
(
|
|
Verbose = yes,
|
|
io.write_string(OutputStream, "% done.\n", !IO)
|
|
;
|
|
Verbose = no
|
|
),
|
|
Succeeded = yes
|
|
else
|
|
io.write_string(OutputStream,
|
|
"Compilation error(s) occurred.\n", !IO),
|
|
Succeeded = no
|
|
)
|
|
;
|
|
Result = error(_),
|
|
io.write_string(OutputStream,
|
|
"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(io.text_output_stream::in, prog::in,
|
|
io::di, io::uo) is cc_multi.
|
|
|
|
dynamically_load_and_run(OutputStream, 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(OutputStream, "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(OutputStream, Bindings, Outputs, Handle, !IO)
|
|
;
|
|
QueryType = cc_query,
|
|
link_and_run_cc(OutputStream, Bindings, Outputs, Handle, !IO)
|
|
;
|
|
QueryType = io_query,
|
|
link_and_run_io(OutputStream, 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(OutputStream, "dlclose failed: %s\n", [s(CloseMsg)], !IO)
|
|
;
|
|
Result = dl_ok
|
|
)
|
|
).
|
|
|
|
:- pred link_and_run_normal(io.text_output_stream::in, bindings::in,
|
|
list(string)::in, handle::in, io::di, io::uo) is cc_multi.
|
|
|
|
link_and_run_normal(OutputStream, Bindings, Outputs, Handle, !IO) :-
|
|
get_query_closure(3, Handle, MaybeQuery, !IO),
|
|
(
|
|
MaybeQuery = dl_error(Msg),
|
|
io.format(OutputStream, "dlsym failed: %s\n", [s(Msg)], !IO)
|
|
;
|
|
MaybeQuery = dl_ok(QueryPred),
|
|
exception.try_all(call_run_normal(QueryPred, Bindings),
|
|
MaybeExcp, Solutions),
|
|
list.foldl(write_solution(OutputStream, Outputs, "true ;"),
|
|
Solutions, !IO),
|
|
(
|
|
MaybeExcp = yes(Excp),
|
|
report_exception(OutputStream, univ_value(Excp), !IO)
|
|
;
|
|
MaybeExcp = no,
|
|
io.write_string(OutputStream, "fail.\n", !IO)
|
|
),
|
|
io.write_string(OutputStream, "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(io.text_output_stream::in, bindings::in,
|
|
list(string)::in, handle::in, io::di, io::uo) is cc_multi.
|
|
|
|
link_and_run_cc(OutputStream, Bindings, Outputs, Handle, !IO) :-
|
|
get_query_closure(3, Handle, MaybeQuery, !IO),
|
|
(
|
|
MaybeQuery = dl_error(Msg),
|
|
io.format(OutputStream, "dlsym failed: %s\n", [s(Msg)], !IO)
|
|
;
|
|
MaybeQuery = dl_ok(QueryPred),
|
|
exception.try(call_run_cc(QueryPred, Bindings), Result),
|
|
(
|
|
Result = succeeded(Solution),
|
|
write_solution(OutputStream, Outputs, "true.", Solution, !IO)
|
|
;
|
|
Result = failed,
|
|
io.write_string(OutputStream, "No solution.\n", !IO)
|
|
;
|
|
Result = exception(Excp),
|
|
report_exception(OutputStream, 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(io.text_output_stream::in, bindings::in,
|
|
list(string)::in, handle::in, io::di, io::uo) is cc_multi.
|
|
|
|
link_and_run_io(OutputStream, Bindings, _Outputs, Handle, !IO) :-
|
|
get_query_closure(5, Handle, MaybeQuery, !IO),
|
|
(
|
|
MaybeQuery = dl_error(Msg),
|
|
io.format(OutputStream, "dlsym failed: %s\n", [s(Msg)], !IO)
|
|
;
|
|
MaybeQuery = dl_ok(QueryPred),
|
|
exception.try_io(call_run_io(QueryPred, Bindings), Result, !IO),
|
|
(
|
|
Result = succeeded(_)
|
|
;
|
|
Result = exception(Excp),
|
|
report_exception(OutputStream, 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(io.text_output_stream::in, list(string)::in, string::in,
|
|
solution::in, io::di, io::uo) is cc_multi.
|
|
|
|
write_solution(OutputStream, Outputs, End, Solution, !IO) :-
|
|
(
|
|
Solution = load_failure,
|
|
io.write_string(OutputStream, "Error loading some variables.\n", !IO)
|
|
;
|
|
Solution = solution(Bindings),
|
|
list.foldl(write_binding(OutputStream, Bindings), Outputs, !IO),
|
|
io.write_string(OutputStream, End, !IO),
|
|
io.write_string(OutputStream, "\n", !IO)
|
|
).
|
|
|
|
:- pred write_binding(io.text_output_stream::in, bindings::in, string::in,
|
|
io::di, io::uo) is cc_multi.
|
|
|
|
write_binding(OutputStream, Bindings, Output, !IO) :-
|
|
map.lookup(Bindings, Output, Univ),
|
|
io.write_string(OutputStream, Output, !IO),
|
|
io.write_string(OutputStream, " = ", !IO),
|
|
io.write_cc(OutputStream, univ_value(Univ), !IO),
|
|
io.write_string(OutputStream, ", ", !IO).
|
|
|
|
:- pred report_exception(io.text_output_stream::in, T::in, io::di, io::uo)
|
|
is cc_multi.
|
|
|
|
report_exception(OutputStream, Excp, !IO) :-
|
|
io.write_string(OutputStream, "*** caught exception: ", !IO),
|
|
io.write_line_cc(OutputStream, Excp, !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
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module mdb.interactive_query.
|
|
%---------------------------------------------------------------------------%
|