[m-rev.] diff: more cleanups, part 1
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Apr 5 15:05:13 AEST 2004
analysis/analysis.m:
browser/browse.m:
compiler/accumulator.m:
compiler/assertion.m:
compiler/atsort.m:
compiler/c_util.m:
compiler/check_typeclass.m:
compiler/clause_to_proc.m:
compiler/code_gen.m:
compiler/code_model.m:
compiler/const_prop.m:
compiler/constraint.m:
compiler/dead_proc_elim.m:
compiler/delay_construct.m:
compiler/dependency_graph.m:
compiler/det_analysis.m:
compiler/det_report.m:
compiler/export.m:
compiler/fact_table.m:
compiler/follow_code.m:
compiler/graph_colour.m:
compiler/hlds_module.m:
compiler/inlining.m:
compiler/llds.m:
compiler/make_hlds.m:
compiler/mercury_to_mercury.m:
compiler/ml_tailcall.m:
compiler/ml_unify_gen.m:
compiler/mmc_analysis.m:
compiler/mode_errors.m:
compiler/passes_aux.m:
compiler/post_typecheck.m:
compiler/size_prof.m:
compiler/switch_util.m:
compiler/table_gen.m:
compiler/term_errors.m:
compiler/transform_llds.m:
compiler/type_util.m:
compiler/unify_gen.m:
compiler/unneeded_code.m:
compiler/unused_args.m:
Bring these modules up to our current coding standards. Use predmode
declarations and state variable syntax where relevant. Reorder
arguments where this is needed for the use state variables. Make the
orders of predicate definitions correspond to the order of their
declarations. Replace some overly large lambda expressions with named
predicates. Convert some predicates to functions where this makes
their use more convenient. Use field access notation where convenient.
Fix any inconsistent indentation. Remove module prefixes on predicate
names where this is necessary to allow sane indentation.
In several places, use predicates from error_util.m to print error
messages. Apart from this, there are no changes in algorithms.
In some places, conform to the changes below.
compiler/error_util.m:
compiler/hlds_error_util.m:
Add new variants of existing predicates for use in some of the
changed modules above.
compiler/hlds_out.m:
Add some functions to convert values of some HLDS types as strings,
for use in preparing the arguments of the new calls to predicates in
error_util.m. Change the implementations of the predicates that print
values of those types to call those functions instead of allowing
code duplication.
compiler/llds.m:
Add some field names to allow use of field updates where relevant.
tests/invalid/assert_in_interface.err_exp:
tests/invalid/multisoln_func.err_exp:
tests/invalid/tricky_assert1.err_exp:
Update the expected outputs of these test cases to allow for them being
generated by error_util.m, and hence being better formatted than
before.
Zoltan.
cvs diff: Diffing .
cvs diff: Diffing analysis
Index: analysis/analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/analysis/analysis.m,v
retrieving revision 1.1
diff -u -b -r1.1 analysis.m
--- analysis/analysis.m 2 Jan 2003 06:53:53 -0000 1.1
+++ analysis/analysis.m 3 Apr 2004 17:52:19 -0000
@@ -61,9 +61,8 @@
func analysis_version_number(FuncInfo::unused, Call::unused,
Answer::unused) = (int::out) is det,
- func preferred_fixpoint_type(FuncInfo::unused,
- Call::unused, Answer::unused) =
- (fixpoint_type::out) is det
+ func preferred_fixpoint_type(FuncInfo::unused, Call::unused,
+ Answer::unused) = (fixpoint_type::out) is det
].
:- type fixpoint_type
@@ -74,8 +73,7 @@
;
% Start at `top'.
% Can stop at any time.
- greatest_fixpoint
- .
+ greatest_fixpoint.
:- typeclass call_pattern(FuncInfo, Call)
<= (partial_order(FuncInfo, Call), to_string(Call)) where [].
@@ -87,10 +85,8 @@
].
:- typeclass partial_order(FuncInfo, Call) where [
- pred more_precise_than(FuncInfo::in,
- Call::in, Call::in) is semidet,
- pred equivalent(FuncInfo::in,
- Call::in, Call::in) is semidet
+ pred more_precise_than(FuncInfo::in, Call::in, Call::in) is semidet,
+ pred equivalent(FuncInfo::in, Call::in, Call::in) is semidet
].
:- typeclass to_string(S) where [
@@ -215,8 +211,8 @@
ResultList = []
).
-lookup_best_result(ModuleId, FuncId, FuncInfo, Call,
- MaybeBestResult, !Info, !IO) :-
+lookup_best_result(ModuleId, FuncId, FuncInfo, Call, MaybeBestResult,
+ !Info, !IO) :-
%io__write_string("looking up best result for ", !IO),
%io__write_string(FuncId, !IO),
%io__nl(!IO),
@@ -331,4 +327,3 @@
Info ^ analysis_requests, !IO),
empty_request_file(Info, ModuleId, !IO).
-
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
Index: browser/browse.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/browse.m,v
retrieving revision 1.40
diff -u -b -r1.40 browse.m
--- browser/browse.m 27 Oct 2003 06:19:08 -0000 1.40
+++ browser/browse.m 2 Apr 2004 06:41:52 -0000
@@ -29,14 +29,14 @@
:- pred browse__browse(T::in, io__input_stream::in,
io__output_stream::in, maybe(list(dir))::out,
browser_persistent_state::in, browser_persistent_state::out,
- io__state::di, io__state::uo) is cc_multi.
+ io::di, io::uo) is cc_multi.
% As above, except that the supplied format will override the default.
%
:- pred browse__browse_format(T::in, io__input_stream::in,
io__output_stream::in, portray_format::in,
browser_persistent_state::in, browser_persistent_state::out,
- io__state::di, io__state::uo) is cc_multi.
+ io::di, io::uo) is cc_multi.
% A version of browse__browse that works on synthetic terms
% in the sense of browser_info:browser_term.
@@ -44,7 +44,7 @@
:- pred browse__browse_synthetic(string::in, list(univ)::in, bool::in,
io__input_stream::in, io__output_stream::in, maybe(list(dir))::out,
browser_persistent_state::in, browser_persistent_state::out,
- io__state::di, io__state::uo) is cc_multi.
+ io::di, io::uo) is cc_multi.
% A version of browse__browse_format that works on synthetic terms
% in the sense of browser_info:browser_term.
@@ -52,7 +52,7 @@
:- pred browse__browse_format_synthetic(string::in, list(univ)::in, bool::in,
io__input_stream::in, io__output_stream::in, portray_format::in,
browser_persistent_state::in, browser_persistent_state::out,
- io__state::di, io__state::uo) is cc_multi.
+ io::di, io::uo) is cc_multi.
% The browser interface for the external debugger. The caller type
% will be `browse', and the default format will be used.
@@ -60,38 +60,34 @@
:- pred browse__browse_external(T::in, io__input_stream::in,
io__output_stream::in,
browser_persistent_state::in, browser_persistent_state::out,
- io__state::di, io__state::uo) is cc_multi.
+ io::di, io::uo) is cc_multi.
% The non-interactive term browser. The caller type should be either
% `print' or `print_all'. The default portray format for that
% caller type is used.
%
:- pred browse__print(T::in, io__output_stream::in, browse_caller_type::in,
- browser_persistent_state::in, io__state::di, io__state::uo)
- is cc_multi.
+ browser_persistent_state::in, io::di, io::uo) is cc_multi.
% A version of browse__print that works on synthetic terms
% in the sense of browser_info:browser_term.
%
:- pred browse__print_synthetic(string::in, list(univ)::in, bool::in,
io__output_stream::in, browse_caller_type::in,
- browser_persistent_state::in, io__state::di, io__state::uo)
- is cc_multi.
+ browser_persistent_state::in, io::di, io::uo) is cc_multi.
% As above, except that the supplied format will override the default.
%
:- pred browse__print_format(T::in, io__output_stream::in,
browse_caller_type::in, portray_format::in,
- browser_persistent_state::in, io__state::di, io__state::uo)
- is cc_multi.
+ browser_persistent_state::in, io::di, io::uo) is cc_multi.
% A version of browse__print_format that works on synthetic terms
% in the sense of browser_info:browser_term.
%
:- pred browse__print_format_synthetic(string::in, list(univ)::in, bool::in,
io__output_stream::in, browse_caller_type::in, portray_format::in,
- browser_persistent_state::in, io__state::di, io__state::uo)
- is cc_multi.
+ browser_persistent_state::in, io::di, io::uo) is cc_multi.
% Estimate the total term size, in characters,
% We count the number of characters in the functor,
@@ -175,101 +171,101 @@
% Non-interactive display
%
-browse__print(Term, OutputStream, Caller, State) -->
+browse__print(Term, OutputStream, Caller, State, !IO) :-
browse__print_common(plain_term(univ(Term)), OutputStream,
- Caller, no, State).
+ Caller, no, State, !IO).
-browse__print_format(Term, OutputStream, Caller, Format, State) -->
+browse__print_format(Term, OutputStream, Caller, Format, State, !IO):-
browse__print_common(plain_term(univ(Term)), OutputStream,
- Caller, yes(Format), State).
+ Caller, yes(Format), State, !IO).
browse__print_synthetic(FunctorString, Args, IsFunc, OutputStream,
- Caller, State) -->
- { synthetic_term_to_browser_term(FunctorString, Args, IsFunc,
- BrowserTerm) },
- browse__print_common(BrowserTerm, OutputStream, Caller, no, State).
+ Caller, State, !IO):-
+ synthetic_term_to_browser_term(FunctorString, Args, IsFunc,
+ BrowserTerm),
+ browse__print_common(BrowserTerm, OutputStream, Caller, no, State,
+ !IO).
browse__print_format_synthetic(FunctorString, Args, IsFunc, OutputStream,
- Caller, Format, State) -->
- { synthetic_term_to_browser_term(FunctorString, Args, IsFunc,
- BrowserTerm) },
+ Caller, Format, State, !IO):-
+ synthetic_term_to_browser_term(FunctorString, Args, IsFunc,
+ BrowserTerm),
browse__print_common(BrowserTerm, OutputStream,
- Caller, yes(Format), State).
+ Caller, yes(Format), State, !IO).
:- pred browse__print_common(browser_term::in, io__output_stream::in,
browse_caller_type::in, maybe(portray_format)::in,
- browser_persistent_state::in, io__state::di, io__state::uo)
- is cc_multi.
+ browser_persistent_state::in, io::di, io::uo) is cc_multi.
-browse__print_common(BrowserTerm, OutputStream, Caller, MaybeFormat, State) -->
- { Info = browser_info__init(BrowserTerm, Caller, MaybeFormat, State) },
- io__set_output_stream(OutputStream, OldStream),
- { browser_info__get_format(Info, Caller, MaybeFormat, Format) },
+browse__print_common(BrowserTerm, OutputStream, Caller, MaybeFormat, State,
+ !IO):-
+ Info = browser_info__init(BrowserTerm, Caller, MaybeFormat, State),
+ io__set_output_stream(OutputStream, OldStream, !IO),
+ browser_info__get_format(Info, Caller, MaybeFormat, Format),
%
% For plain terms, we assume that the variable name has been printed
% on the first part of the line. If the format is something other than
% `flat', then we need to start on the next line.
%
(
- { BrowserTerm = plain_term(_) },
- { Format \= flat }
+ BrowserTerm = plain_term(_),
+ Format \= flat
->
- io__nl
+ io__nl(!IO)
;
- []
+ true
),
- portray(internal, Caller, no, Info),
- io__set_output_stream(OldStream, _).
+ portray(internal, Caller, no, Info, !IO),
+ io__set_output_stream(OldStream, _, !IO).
%---------------------------------------------------------------------------%
%
% Interactive display
%
-browse__browse(Object, InputStream, OutputStream, MaybeMark, State0, State) -->
+browse__browse(Object, InputStream, OutputStream, MaybeMark, !State, !IO) :-
browse_common(internal, plain_term(univ(Object)),
- InputStream, OutputStream, no, MaybeMark, State0, State).
+ InputStream, OutputStream, no, MaybeMark, !State, !IO).
browse__browse_format(Object, InputStream, OutputStream, Format,
- State0, State) -->
+ !State, !IO) :-
browse_common(internal, plain_term(univ(Object)),
- InputStream, OutputStream, yes(Format), _, State0, State).
+ InputStream, OutputStream, yes(Format), _, !State, !IO).
browse__browse_synthetic(FunctorString, Args, IsFunc,
- InputStream, OutputStream, MaybeMark, State0, State) -->
- { synthetic_term_to_browser_term(FunctorString, Args, IsFunc,
- BrowserTerm) },
+ InputStream, OutputStream, MaybeMark, !State, !IO) :-
+ synthetic_term_to_browser_term(FunctorString, Args, IsFunc,
+ BrowserTerm),
browse_common(internal, BrowserTerm,
- InputStream, OutputStream, no, MaybeMark, State0, State).
+ InputStream, OutputStream, no, MaybeMark, !State, !IO).
browse__browse_format_synthetic(FunctorString, Args, IsFunc,
- InputStream, OutputStream, Format, State0, State) -->
- { synthetic_term_to_browser_term(FunctorString, Args, IsFunc,
- BrowserTerm) },
+ InputStream, OutputStream, Format, !State, !IO) :-
+ synthetic_term_to_browser_term(FunctorString, Args, IsFunc,
+ BrowserTerm),
browse_common(internal, BrowserTerm,
- InputStream, OutputStream, yes(Format), _, State0, State).
+ InputStream, OutputStream, yes(Format), _, !State, !IO).
-browse__browse_external(Object, InputStream, OutputStream, State0, State) -->
+browse__browse_external(Object, InputStream, OutputStream, !State, !IO) :-
browse_common(external, plain_term(univ(Object)),
- InputStream, OutputStream, no, _, State0, State).
+ InputStream, OutputStream, no, _, !State, !IO).
:- pred browse_common(debugger::in, browser_term::in, io__input_stream::in,
io__output_stream::in, maybe(portray_format)::in,
maybe(list(dir))::out, browser_persistent_state::in,
- browser_persistent_state::out, io__state::di, io__state::uo)
- is cc_multi.
+ browser_persistent_state::out, io::di, io::uo) is cc_multi.
browse_common(Debugger, Object, InputStream, OutputStream, MaybeFormat,
- MaybeMark, State0, State) -->
- { Info0 = browser_info__init(Object, browse, MaybeFormat, State0) },
- io__set_input_stream(InputStream, OldInputStream),
- io__set_output_stream(OutputStream, OldOutputStream),
+ MaybeMark, !State, !IO) :-
+ Info0 = browser_info__init(Object, browse, MaybeFormat, !.State),
+ io__set_input_stream(InputStream, OldInputStream, !IO),
+ io__set_output_stream(OutputStream, OldOutputStream, !IO),
% startup_message,
- browse_main_loop(Debugger, Info0, Info),
- io__set_input_stream(OldInputStream, _),
- io__set_output_stream(OldOutputStream, _),
- { MaybeMark = Info ^ maybe_mark },
- { State = Info ^ state }.
+ browse_main_loop(Debugger, Info0, Info, !IO),
+ io__set_input_stream(OldInputStream, _, !IO),
+ io__set_output_stream(OldOutputStream, _, !IO),
+ MaybeMark = Info ^ maybe_mark,
+ !:State = Info ^ state.
% This predicate converts synthetic terms from the representation used in the
% trace directory (as a list of arguments, the last of which represents the
@@ -295,34 +291,33 @@
).
:- pred browse_main_loop(debugger::in, browser_info::in, browser_info::out,
- io__state::di, io__state::uo) is cc_multi.
+ io::di, io::uo) is cc_multi.
-browse_main_loop(Debugger, Info0, Info) -->
+browse_main_loop(Debugger, !Info, !IO) :-
(
- { Debugger = internal },
- { prompt(Prompt) },
- parse__read_command(Prompt, Command)
+ Debugger = internal,
+ prompt(Prompt),
+ parse__read_command(Prompt, Command, !IO)
;
- { Debugger = external },
- parse__read_command_external(Command)
+ Debugger = external,
+ parse__read_command_external(Command, !IO)
),
- run_command(Debugger, Command, Quit, Info0, Info1),
+ run_command(Debugger, Command, Quit, !Info, !IO),
(
- { Quit = yes },
- % write_string_debugger(Debugger, "quitting...\n")
+ Quit = yes,
+ % write_string_debugger(Debugger, "quitting...\n", !IO)
(
- { Debugger = external },
- send_term_to_socket(browser_quit)
+ Debugger = external,
+ send_term_to_socket(browser_quit, !IO)
;
- { Debugger = internal }
- ),
- { Info = Info1 }
+ Debugger = internal
+ )
;
- { Quit = no },
- browse_main_loop(Debugger, Info1, Info)
+ Quit = no,
+ browse_main_loop(Debugger, !Info, !IO)
).
-:- pred startup_message(debugger::in, io__state::di, io__state::uo) is det.
+:- pred startup_message(debugger::in, io::di, io::uo) is det.
startup_message(Debugger) -->
write_string_debugger(Debugger, "-- Simple Mercury Term Browser.\n"),
@@ -333,8 +328,7 @@
prompt("browser> ").
:- pred run_command(debugger::in, command::in, bool::out,
- browser_info::in, browser_info::out, io__state::di, io__state::uo)
- is cc_multi.
+ browser_info::in, browser_info::out, io::di, io::uo) is cc_multi.
run_command(Debugger, Command, Quit, !Info, !IO) :-
% XXX The commands `set', `ls' and `print' should allow the format
@@ -429,7 +423,7 @@
:- pred do_portray(debugger::in, browse_caller_type::in,
maybe(maybe_option_table(format_option))::in, browser_info::in,
- maybe(path)::in, io__state::di, io__state::uo) is cc_multi.
+ maybe(path)::in, io::di, io::uo) is cc_multi.
do_portray(Debugger, CallerType, MaybeMaybeOptionTable, Info,
MaybePath, !IO) :-
@@ -507,7 +501,7 @@
Setting, Info0 ^ state, NewState),
Info = Info0 ^ state := NewState.
-:- pred help(debugger::in, io__state::di, io__state::uo) is det.
+:- pred help(debugger::in, io::di, io::uo) is det.
help(Debugger) -->
{ string__append_list([
@@ -545,7 +539,7 @@
:- pred portray_maybe_path(debugger::in, browse_caller_type::in,
maybe(portray_format)::in, browser_info::in,
- maybe(path)::in, io__state::di, io__state::uo) is cc_multi.
+ maybe(path)::in, io::di, io::uo) is cc_multi.
portray_maybe_path(Debugger, Caller, MaybeFormat, Info, MaybePath, !IO) :-
(
@@ -558,44 +552,44 @@
:- pred portray(debugger::in, browse_caller_type::in,
maybe(portray_format)::in, browser_info::in,
- io__state::di, io__state::uo) is cc_multi.
+ io::di, io::uo) is cc_multi.
-portray(Debugger, Caller, MaybeFormat, Info) -->
- { browser_info__get_format(Info, Caller, MaybeFormat, Format) },
- { browser_info__get_format_params(Info, Caller, Format, Params) },
+portray(Debugger, Caller, MaybeFormat, Info, !IO) :-
+ browser_info__get_format(Info, Caller, MaybeFormat, Format),
+ browser_info__get_format_params(Info, Caller, Format, Params),
(
- { deref_subterm(Info ^ term, Info ^ dirs, SubUniv) }
+ deref_subterm(Info ^ term, Info ^ dirs, SubUniv)
->
(
- { Format = flat },
- portray_flat(Debugger, SubUniv, Params)
+ Format = flat,
+ portray_flat(Debugger, SubUniv, Params, !IO)
;
- { Format = raw_pretty },
- portray_raw_pretty(Debugger, SubUniv, Params)
+ Format = raw_pretty,
+ portray_raw_pretty(Debugger, SubUniv, Params, !IO)
;
- { Format = verbose },
- portray_verbose(Debugger, SubUniv, Params)
+ Format = verbose,
+ portray_verbose(Debugger, SubUniv, Params, !IO)
;
- { Format = pretty },
- portray_pretty(Debugger, SubUniv, Params)
+ Format = pretty,
+ portray_pretty(Debugger, SubUniv, Params, !IO)
)
;
- write_string_debugger(Debugger, "error: no such subterm")
+ write_string_debugger(Debugger, "error: no such subterm", !IO)
),
- nl_debugger(Debugger).
+ nl_debugger(Debugger, !IO).
:- pred portray_path(debugger::in, browse_caller_type::in,
maybe(portray_format)::in, browser_info::in, path::in,
- io__state::di, io__state::uo) is cc_multi.
+ io::di, io::uo) is cc_multi.
-portray_path(Debugger, Caller, MaybeFormat, Info0, Path) -->
- { set_path(Path, Info0, Info) },
- portray(Debugger, Caller, MaybeFormat, Info).
+portray_path(Debugger, Caller, MaybeFormat, Info0, Path, !IO) :-
+ set_path(Path, Info0, Info),
+ portray(Debugger, Caller, MaybeFormat, Info, !IO).
:- pred portray_flat(debugger::in, browser_term::in, format_params::in,
- io__state::di, io__state::uo) is cc_multi.
+ io::di, io::uo) is cc_multi.
-portray_flat(Debugger, BrowserTerm, Params) -->
+portray_flat(Debugger, BrowserTerm, Params, !IO) :-
%
% io__write handles the special cases such as lists,
% operators, etc. better, so we prefer to use it if we
@@ -606,76 +600,70 @@
%
% XXX this ignores the maximum number of lines
%
- { browser_term_size_left_from_max(BrowserTerm, max_print_size,
- RemainingSize) },
- ( { RemainingSize >= 0 } ->
- portray_flat_write_browser_term(BrowserTerm)
- ;
- io__get_stream_db(StreamDb),
- { BrowserDb = browser_db(StreamDb) },
- { browser_term_to_string(BrowserDb, BrowserTerm, Params ^ size,
- Params ^ depth, Str) },
- write_string_debugger(Debugger, Str)
+ browser_term_size_left_from_max(BrowserTerm, max_print_size,
+ RemainingSize),
+ ( RemainingSize >= 0 ->
+ portray_flat_write_browser_term(BrowserTerm, !IO)
+ ;
+ io__get_stream_db(StreamDb, !IO),
+ BrowserDb = browser_db(StreamDb),
+ browser_term_to_string(BrowserDb, BrowserTerm, Params ^ size,
+ Params ^ depth, Str),
+ write_string_debugger(Debugger, Str, !IO)
).
:- pred portray_flat_write_browser_term(browser_term::in,
- io__state::di, io__state::uo) is cc_multi.
+ io::di, io::uo) is cc_multi.
-portray_flat_write_browser_term(plain_term(Univ)) -->
- io__output_stream(Stream),
- io__write_univ(Stream, include_details_cc, Univ).
-portray_flat_write_browser_term(synthetic_term(Functor, Args, MaybeReturn)) -->
- io__write_string(Functor),
- io__output_stream(Stream),
- ( { Args = [] } ->
- []
- ;
- io__write_string("("),
- io__write_list(Args, ", ", pred(U::in, di, uo) is cc_multi -->
- (
- { univ_to_type(U, _ `with_type` unbound) }
- ->
- io__write_char(Stream, '_')
+portray_flat_write_browser_term(plain_term(Univ), !IO) :-
+ io__output_stream(Stream, !IO),
+ io__write_univ(Stream, include_details_cc, Univ, !IO).
+portray_flat_write_browser_term(synthetic_term(Functor, Args, MaybeReturn),
+ !IO) :-
+ io__write_string(Functor, !IO),
+ io__output_stream(Stream, !IO),
+ ( Args = [] ->
+ true
;
- io__write_univ(Stream, include_details_cc, U)
- )),
- io__write_string(")")
+ io__write_string("(", !IO),
+ io__write_list(Args, ", ", write_univ_or_unbound(Stream), !IO),
+ io__write_string(")", !IO)
),
(
- { MaybeReturn = yes(Return) },
- io__write_string(" = "),
- io__write_univ(Stream, include_details_cc, Return)
+ MaybeReturn = yes(Return),
+ io__write_string(" = ", !IO),
+ io__write_univ(Stream, include_details_cc, Return, !IO)
;
- { MaybeReturn = no }
+ MaybeReturn = no
).
:- pred portray_verbose(debugger::in, browser_term::in, format_params::in,
- io__state::di, io__state::uo) is cc_multi.
+ io::di, io::uo) is cc_multi.
-portray_verbose(Debugger, BrowserTerm, Params) -->
- io__get_stream_db(StreamDb),
- { BrowserDb = browser_db(StreamDb) },
- { browser_term_to_string_verbose(BrowserDb, BrowserTerm, Params ^ size,
- Params ^ depth, Params ^ width, Params ^ lines, Str) },
- write_string_debugger(Debugger, Str).
+portray_verbose(Debugger, BrowserTerm, Params, !IO) :-
+ io__get_stream_db(StreamDb, !IO),
+ BrowserDb = browser_db(StreamDb),
+ browser_term_to_string_verbose(BrowserDb, BrowserTerm, Params ^ size,
+ Params ^ depth, Params ^ width, Params ^ lines, Str),
+ write_string_debugger(Debugger, Str, !IO).
:- pred portray_raw_pretty(debugger::in, browser_term::in, format_params::in,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
-portray_raw_pretty(Debugger, BrowserTerm, Params) -->
- { browser_term_to_string_raw_pretty(BrowserTerm, Params ^ width,
- Params ^ depth, Str) },
- write_string_debugger(Debugger, Str).
+portray_raw_pretty(Debugger, BrowserTerm, Params, !IO) :-
+ browser_term_to_string_raw_pretty(BrowserTerm, Params ^ width,
+ Params ^ depth, Str),
+ write_string_debugger(Debugger, Str, !IO).
:- pred portray_pretty(debugger::in, browser_term::in, format_params::in,
- io__state::di, io__state::uo) is cc_multi.
+ io::di, io::uo) is cc_multi.
-portray_pretty(Debugger, BrowserTerm, Params) -->
- io__get_stream_db(StreamDb),
- { BrowserDb = browser_db(StreamDb) },
- { sized_pretty__browser_term_to_string_line(BrowserDb, BrowserTerm,
- Params ^ width, Params ^ lines, Str) },
- write_string_debugger(Debugger, Str).
+portray_pretty(Debugger, BrowserTerm, Params, !IO) :-
+ io__get_stream_db(StreamDb, !IO),
+ BrowserDb = browser_db(StreamDb),
+ sized_pretty__browser_term_to_string_line(BrowserDb, BrowserTerm,
+ Params ^ width, Params ^ lines, Str),
+ write_string_debugger(Debugger, Str, !IO).
% The maximum estimated size for which we use `io__write'.
:- func max_print_size = int.
@@ -726,6 +714,16 @@
Args, MaxArgsSize, RemainingSize)
).
+:- pred write_univ_or_unbound(io__output_stream::in, univ::in, io::di, io::uo)
+ is cc_multi.
+
+write_univ_or_unbound(Stream, Univ, !IO) :-
+ ( univ_to_type(Univ, _ `with_type` unbound) ->
+ io__write_char(Stream, '_', !IO)
+ ;
+ io__write_univ(Stream, include_details_cc, Univ, !IO)
+ ).
+
%---------------------------------------------------------------------------%
%
% Single-line representation of a term.
@@ -1055,58 +1053,58 @@
% Miscellaneous path handling
%
-:- pred write_path(debugger, list(dir), io__state, io__state).
-:- mode write_path(in, in, di, uo) is det.
-write_path(Debugger, []) -->
- write_string_debugger(Debugger, "/").
-write_path(Debugger, [Dir]) -->
- (
- { Dir = parent },
- write_string_debugger(Debugger, "/")
- ;
- { Dir = child_num(N) },
- write_string_debugger(Debugger, "/"),
- write_int_debugger(Debugger, N)
- ;
- { Dir = child_name(Name) },
- write_string_debugger(Debugger, "/"),
- write_string_debugger(Debugger, Name)
- ).
-write_path(Debugger, [Dir, Dir2 | Dirs]) -->
- write_path_2(Debugger, [Dir, Dir2 | Dirs]).
-
-:- pred write_path_2(debugger, list(dir), io__state, io__state).
-:- mode write_path_2(in, in, di, uo) is det.
-write_path_2(Debugger, []) -->
- write_string_debugger(Debugger, "/").
-write_path_2(Debugger, [Dir]) -->
- (
- { Dir = parent },
- write_string_debugger(Debugger, "/..")
- ;
- { Dir = child_num(N) },
- write_string_debugger(Debugger, "/"),
- write_int_debugger(Debugger, N)
- ;
- { Dir = child_name(Name) },
- write_string_debugger(Debugger, "/"),
- write_string_debugger(Debugger, Name)
- ).
-write_path_2(Debugger, [Dir, Dir2 | Dirs]) -->
- (
- { Dir = parent },
- write_string_debugger(Debugger, "/.."),
- write_path_2(Debugger, [Dir2 | Dirs])
- ;
- { Dir = child_num(N) },
- write_string_debugger(Debugger, "/"),
- write_int_debugger(Debugger, N),
- write_path_2(Debugger, [Dir2 | Dirs])
- ;
- { Dir = child_name(Name) },
- write_string_debugger(Debugger, "/"),
- write_string_debugger(Debugger, Name),
- write_path_2(Debugger, [Dir2 | Dirs])
+:- pred write_path(debugger::in, list(dir)::in, io::di, io::uo) is det.
+
+write_path(Debugger, [], !IO) :-
+ write_string_debugger(Debugger, "/", !IO).
+write_path(Debugger, [Dir], !IO) :-
+ (
+ Dir = parent,
+ write_string_debugger(Debugger, "/", !IO)
+ ;
+ Dir = child_num(N),
+ write_string_debugger(Debugger, "/", !IO),
+ write_int_debugger(Debugger, N, !IO)
+ ;
+ Dir = child_name(Name),
+ write_string_debugger(Debugger, "/", !IO),
+ write_string_debugger(Debugger, Name, !IO)
+ ).
+write_path(Debugger, [Dir, Dir2 | Dirs], !IO) :-
+ write_path_2(Debugger, [Dir, Dir2 | Dirs], !IO).
+
+:- pred write_path_2(debugger::in, list(dir)::in, io::di, io::uo) is det.
+
+write_path_2(Debugger, [], !IO) :-
+ write_string_debugger(Debugger, "/", !IO).
+write_path_2(Debugger, [Dir], !IO) :-
+ (
+ Dir = parent,
+ write_string_debugger(Debugger, "/..", !IO)
+ ;
+ Dir = child_num(N),
+ write_string_debugger(Debugger, "/", !IO),
+ write_int_debugger(Debugger, N, !IO)
+ ;
+ Dir = child_name(Name),
+ write_string_debugger(Debugger, "/", !IO),
+ write_string_debugger(Debugger, Name, !IO)
+ ).
+write_path_2(Debugger, [Dir, Dir2 | Dirs], !IO) :-
+ (
+ Dir = parent,
+ write_string_debugger(Debugger, "/..", !IO),
+ write_path_2(Debugger, [Dir2 | Dirs], !IO)
+ ;
+ Dir = child_num(N),
+ write_string_debugger(Debugger, "/", !IO),
+ write_int_debugger(Debugger, N, !IO),
+ write_path_2(Debugger, [Dir2 | Dirs], !IO)
+ ;
+ Dir = child_name(Name),
+ write_string_debugger(Debugger, "/", !IO),
+ write_string_debugger(Debugger, Name, !IO),
+ write_path_2(Debugger, [Dir2 | Dirs], !IO)
).
% We assume a root-relative path. We assume Term is the entire term
@@ -1190,18 +1188,18 @@
%---------------------------------------------------------------------------%
-:- pred get_path(browser_info, path).
-:- mode get_path(in, out) is det.
+:- pred get_path(browser_info::in, path::out) is det.
+
get_path(Info, root_rel(Info ^ dirs)).
-:- pred set_path(path, browser_info, browser_info).
-:- mode set_path(in, in, out) is det.
+:- pred set_path(path::in, browser_info::in, browser_info::out) is det.
+
set_path(NewPath, Info0, Info) :-
change_dir(Info0 ^ dirs, NewPath, NewDirs),
Info = Info0 ^ dirs := NewDirs.
-:- pred change_dir(list(dir), path, list(dir)).
-:- mode change_dir(in, in, out) is det.
+:- pred change_dir(list(dir)::in, path::in, list(dir)::out) is det.
+
change_dir(PwdDirs, Path, RootRelDirs) :-
(
Path = root_rel(Dirs),
@@ -1231,7 +1229,7 @@
%
:- pred show_settings(debugger::in, browser_info::in,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
show_settings(Debugger, Info, !IO) :-
show_settings_caller(Debugger, Info, browse, "Browser", !IO),
@@ -1250,7 +1248,7 @@
:- pred show_settings_caller(debugger::in, browser_info::in,
browse_caller_type::in, string::in,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
show_settings_caller(Debugger, Info, Caller, CallerName, !IO) :-
browser_info__get_format(Info, Caller, no, Format),
@@ -1283,7 +1281,7 @@
:- pred show_settings_caller_format(debugger::in, browser_info::in,
browse_caller_type::in, string::in, portray_format::in, string::in,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
show_settings_caller_format(Debugger, Info, Caller, CallerName,
Format, FormatName, !IO) :-
@@ -1318,15 +1316,13 @@
x_len = 10.
y_len = 10.
-:- pred string_to_path(string, path).
-:- mode string_to_path(in, out) is semidet.
+:- pred string_to_path(string::in, path::out) is semidet.
string_to_path(Str, Path) :-
string__to_char_list(Str, Cs),
chars_to_path(Cs, Path).
-:- pred chars_to_path(list(char), path).
-:- mode chars_to_path(in, out) is semidet.
+:- pred chars_to_path(list(char)::in, path::out) is semidet.
chars_to_path([C | Cs], Path) :-
( C = ('/') ->
@@ -1337,15 +1333,13 @@
chars_to_dirs([C | Cs], Dirs)
).
-:- pred chars_to_dirs(list(char), list(dir)).
-:- mode chars_to_dirs(in, out) is semidet.
+:- pred chars_to_dirs(list(char)::in, list(dir)::out) is semidet.
chars_to_dirs(Cs, Dirs) :-
split_dirs(Cs, Names),
names_to_dirs(Names, Dirs).
-:- pred names_to_dirs(list(string), list(dir)).
-:- mode names_to_dirs(in, out) is semidet.
+:- pred names_to_dirs(list(string)::in, list(dir)::out) is semidet.
names_to_dirs([], []).
names_to_dirs([Name | Names], Dirs) :-
@@ -1362,8 +1356,7 @@
names_to_dirs(Names, RestDirs)
).
-:- pred split_dirs(list(char), list(string)).
-:- mode split_dirs(in, out) is det.
+:- pred split_dirs(list(char)::in, list(string)::out) is det.
split_dirs(Cs, Names) :-
takewhile(not_slash, Cs, NameCs, Rest),
@@ -1379,8 +1372,7 @@
error("split_dirs: software error")
).
-:- pred not_slash(char).
-:- mode not_slash(in) is semidet.
+:- pred not_slash(char::in) is semidet.
not_slash(C) :-
C \= ('/').
@@ -1389,8 +1381,7 @@
% a form that lacks ".." entries.
% NB: This can be done more efficiently than simple iteration
% to a limit.
-:- pred simplify_dirs(list(dir), list(dir)).
-:- mode simplify_dirs(in, out) is det.
+:- pred simplify_dirs(list(dir)::in, list(dir)::out) is det.
simplify_dirs(Dirs, SimpleDirs) :-
util__limit(simplify, Dirs, SimpleDirs).
@@ -1401,8 +1392,7 @@
% or:
% - "/.." (parent of root is root)
%
-:- pred simplify(list(dir), list(dir)).
-:- mode simplify(in, out) is det.
+:- pred simplify(list(dir)::in, list(dir)::out) is det.
simplify([], []).
simplify([First | Rest], Simplified) :-
@@ -1419,57 +1409,53 @@
%---------------------------------------------------------------------------%
-:- pred write_string_debugger(debugger, string, io__state, io__state).
-:- mode write_string_debugger(in, in, di, uo) is det.
+:- pred write_string_debugger(debugger::in, string::in, io::di, io::uo) is det.
-write_string_debugger(internal, String) -->
- io__write_string(String).
-write_string_debugger(external, String) -->
- send_term_to_socket(browser_str(String)).
+write_string_debugger(internal, String, !IO) :-
+ io__write_string(String, !IO).
+write_string_debugger(external, String, !IO) :-
+ send_term_to_socket(browser_str(String), !IO).
-:- pred nl_debugger(debugger, io__state, io__state).
-:- mode nl_debugger(in, di, uo) is det.
+:- pred nl_debugger(debugger::in, io::di, io::uo) is det.
-nl_debugger(internal) -->
- io__nl.
-nl_debugger(external) -->
- send_term_to_socket(browser_nl).
+nl_debugger(internal, !IO) :-
+ io__nl(!IO).
+nl_debugger(external, !IO) :-
+ send_term_to_socket(browser_nl, !IO).
-:- pred write_int_debugger(debugger, int, io__state, io__state).
-:- mode write_int_debugger(in, in, di, uo) is det.
+:- pred write_int_debugger(debugger::in, int::in, io::di, io::uo) is det.
-write_int_debugger(internal, Int) -->
- io__write_int(Int).
-write_int_debugger(external, Int) -->
- send_term_to_socket(browser_int(Int)).
+write_int_debugger(internal, Int, !IO) :-
+ io__write_int(Int, !IO).
+write_int_debugger(external, Int, !IO) :-
+ send_term_to_socket(browser_int(Int), !IO).
-:- pred print_format_debugger(debugger, portray_format, io__state, io__state).
-:- mode print_format_debugger(in, in, di, uo) is det.
+:- pred print_format_debugger(debugger::in, portray_format::in,
+ io::di, io::uo) is det.
-print_format_debugger(internal, X) -->
- io__print(X).
-print_format_debugger(external, X) -->
+print_format_debugger(internal, X, !IO) :-
+ io__print(X, !IO).
+print_format_debugger(external, X, !IO) :-
(
- { X = flat },
- send_term_to_socket(browser_str("flat"))
+ X = flat,
+ send_term_to_socket(browser_str("flat"), !IO)
;
- { X = raw_pretty },
- send_term_to_socket(browser_str("raw_pretty"))
+ X = raw_pretty,
+ send_term_to_socket(browser_str("raw_pretty"), !IO)
;
- { X = verbose },
- send_term_to_socket(browser_str("verbose"))
+ X = verbose,
+ send_term_to_socket(browser_str("verbose"), !IO)
;
- { X = pretty },
- send_term_to_socket(browser_str("pretty"))
+ X = pretty,
+ send_term_to_socket(browser_str("pretty"), !IO)
).
-:- pred send_term_to_socket(term_browser_response, io__state, io__state).
-:- mode send_term_to_socket(in, di, uo) is det.
+:- pred send_term_to_socket(term_browser_response::in, io::di, io::uo) is det.
-send_term_to_socket(Term) -->
- write(Term),
- print(".\n"),
- flush_output.
+send_term_to_socket(Term, !IO) :-
+ write(Term, !IO),
+ print(".\n", !IO),
+ flush_output(!IO).
%---------------------------------------------------------------------------%
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/accumulator.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/accumulator.m,v
retrieving revision 1.27
diff -u -b -r1.27 accumulator.m
--- compiler/accumulator.m 19 Mar 2004 10:19:18 -0000 1.27
+++ compiler/accumulator.m 4 Apr 2004 06:49:38 -0000
@@ -148,9 +148,9 @@
:- import_module hlds__hlds_pred.
:- import_module io.
-:- pred accumulator__process_proc(pred_id::in, proc_id::in, proc_info::in,
- proc_info::out, module_info::in, module_info::out,
- io__state::di, io__state::uo) is det.
+:- pred accumulator__process_proc(pred_id::in, proc_id::in,
+ proc_info::in, proc_info::out, module_info::in, module_info::out,
+ io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -217,43 +217,44 @@
% Attempt to transform a procedure into accumulator
% recursive form.
%
-process_proc(PredId, ProcId, ProcInfo0, ProcInfo,
- ModuleInfo0, ModuleInfo) -->
- globals__io_lookup_bool_option(optimize_constructor_last_call, DoLCO),
- globals__io_lookup_bool_option(fully_strict, FullyStrict),
- (
- { module_info_pred_info(ModuleInfo0, PredId, PredInfo) },
- { attempt_transform(ProcId, ProcInfo0, PredId,
- PredInfo, DoLCO, FullyStrict, ModuleInfo0,
- ProcInfo1, ModuleInfo1, Warnings) }
- ->
- globals__io_lookup_bool_option(very_verbose, VeryVerbose),
- (
- { VeryVerbose = yes }
- ->
- io__write_string("% Accumulators introduced into "),
- hlds_out__write_pred_id(ModuleInfo1, PredId),
- io__write_string("\n")
+process_proc(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
+ globals__io_lookup_bool_option(optimize_constructor_last_call, DoLCO,
+ !IO),
+ globals__io_lookup_bool_option(fully_strict, FullyStrict,
+ !IO),
+ (
+ module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
+ attempt_transform(ProcId, PredId, PredInfo, DoLCO, FullyStrict,
+ !ProcInfo, !ModuleInfo, Warnings)
+ ->
+ globals__io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
+ (
+ VeryVerbose = yes
+ ->
+ io__write_string("% Accumulators introduced into ",
+ !IO),
+ hlds_out__write_pred_id(!.ModuleInfo, PredId, !IO),
+ io__write_string("\n", !IO)
;
- []
+ true
),
globals__io_lookup_bool_option(inhibit_accumulator_warnings,
- InhibitWarnings),
+ InhibitWarnings, !IO),
(
- { InhibitWarnings = yes ; Warnings = [] }
+ ( InhibitWarnings = yes ; Warnings = [] )
->
- { ModuleInfo = ModuleInfo1 }
+ true
;
- { describe_one_pred_name(ModuleInfo1, PredId,
- PredName) },
- { pred_info_context(PredInfo, Context) },
+ describe_one_pred_name(!.ModuleInfo, PredId,
+ PredName),
+ pred_info_context(PredInfo, Context),
error_util__write_error_pieces(Context, 0,
- [words("In"), words(PredName)]),
+ [words("In"), words(PredName)], !IO),
- { proc_info_varset(ProcInfo, VarSet) },
- output_warnings(Warnings, VarSet, ModuleInfo1),
+ proc_info_varset(!.ProcInfo, VarSet),
+ output_warnings(Warnings, VarSet, !.ModuleInfo, !IO),
error_util__write_error_pieces(Context, 2,
[
@@ -264,12 +265,12 @@
words("These warnings can"),
words("be suppressed by"),
words("`--inhibit-accumulator-warnings'.")
- ]),
+ ], !IO),
globals__io_lookup_bool_option(verbose_errors,
- VerboseErrors),
+ VerboseErrors, !IO),
(
- { VerboseErrors = yes }
+ VerboseErrors = yes
->
error_util__write_error_pieces(Context, 2,
[
@@ -295,41 +296,37 @@
words("off, or"),
words("`--inhibit-accumulator-warnings'"),
words("to turn off the warnings.")
- ])
+ ], !IO)
;
- []
+ true
),
globals__io_lookup_bool_option(halt_at_warn,
- HaltAtWarn),
+ HaltAtWarn, !IO),
(
- { HaltAtWarn = yes }
+ HaltAtWarn = yes
->
- io__set_exit_status(1),
- { module_info_incr_errors(ModuleInfo1,
- ModuleInfo) }
+ io__set_exit_status(1, !IO),
+ module_info_incr_errors(!ModuleInfo)
;
- { ModuleInfo = ModuleInfo1 }
+ true
+ )
)
- ),
- { ProcInfo = ProcInfo1 }
;
- { ProcInfo = ProcInfo0 },
- { ModuleInfo = ModuleInfo0 }
+ true
).
-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- pred output_warnings(list(warning)::in, prog_varset::in,
- module_info::in, io__state::di, io__state::uo) is det.
+ module_info::in, io::di, io::uo) is det.
-output_warnings([], _, _) --> [].
-output_warnings([W | Ws], VarSet, ModuleInfo) -->
- { output_warning(W, VarSet, ModuleInfo, Context, Format) },
- error_util__write_error_pieces(Context, 2, Format),
- output_warnings(Ws, VarSet, ModuleInfo).
+output_warnings([], _, _, !IO).
+output_warnings([W | Ws], VarSet, ModuleInfo, !IO) :-
+ output_warning(W, VarSet, ModuleInfo, Context, Format),
+ error_util__write_error_pieces(Context, 2, Format, !IO),
+ output_warnings(Ws, VarSet, ModuleInfo, !IO).
:- pred output_warning(warning::in, prog_varset::in, module_info::in,
prog_context::out, list(format_component)::out) is det.
@@ -357,32 +354,26 @@
% proc has been transformed to call the newly created
% accumulator proc.
%
-:- pred attempt_transform(proc_id::in, proc_info::in,
- pred_id::in, pred_info::in, bool::in, bool::in, module_info::in,
- proc_info::out, module_info::out, warnings::out) is semidet.
-
-attempt_transform(ProcId, ProcInfo0, PredId, PredInfo, DoLCO,
- FullyStrict, ModuleInfo0, ProcInfo, ModuleInfo, Warnings) :-
- proc_info_goal(ProcInfo0, Goal0),
- proc_info_headvars(ProcInfo0, HeadVars),
- proc_info_get_initial_instmap(ProcInfo0, ModuleInfo0, InitialInstMap),
-
+:- pred attempt_transform(proc_id::in, pred_id::in, pred_info::in,
+ bool::in, bool::in, proc_info::in, proc_info::out,
+ module_info::in, module_info::out, warnings::out) is semidet.
+
+attempt_transform(ProcId, PredId, PredInfo, DoLCO, FullyStrict,
+ !ProcInfo, !ModuleInfo, Warnings) :-
+ proc_info_goal(!.ProcInfo, Goal0),
+ proc_info_headvars(!.ProcInfo, HeadVars),
+ proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo,
+ InitialInstMap),
standardize(Goal0, Goal),
-
identify_goal_type(PredId, ProcId, Goal, InitialInstMap,
TopLevel, Base, BaseInstMap, Rec, RecInstMap),
C = initialize_goal_store(Rec, RecInstMap, Base, BaseInstMap),
-
identify_recursive_calls(PredId, ProcId, C, RecCallIds),
-
M = list__length(Rec),
-
attempt_transform_2(RecCallIds, C, M, Rec, HeadVars, InitialInstMap,
TopLevel, DoLCO, FullyStrict, PredInfo,
- ProcInfo0, ModuleInfo0, Warnings, ProcInfo, ModuleInfo).
-
-
+ !ProcInfo, !ModuleInfo, Warnings).
%
% attempt_transform_2 takes a list of locations of the recursive
@@ -398,43 +389,35 @@
%
:- pred attempt_transform_2(list(goal_id)::in, goal_store::in, int::in,
hlds_goals::in, prog_vars::in, instmap::in, top_level::in,
- bool::in, bool::in, pred_info::in, proc_info::in,
- module_info::in, warnings::out,
- proc_info::out, module_info::out) is semidet.
+ bool::in, bool::in, pred_info::in, proc_info::in, proc_info::out,
+ module_info::in, module_info::out, warnings::out) is semidet.
attempt_transform_2([Id | Ids], C, M, Rec, HeadVars, InitialInstMap, TopLevel,
- DoLCO, FullyStrict, PredInfo, ProcInfo0, ModuleInfo0,
- Warnings, ProcInfo, ModuleInfo) :-
+ DoLCO, FullyStrict, PredInfo, !ProcInfo, !ModuleInfo,
+ Warnings) :-
(
- proc_info_vartypes(ProcInfo0, VarTypes0),
+ proc_info_vartypes(!.ProcInfo, VarTypes0),
identify_out_and_out_prime(Id, Rec, HeadVars,
- InitialInstMap, VarTypes0, ModuleInfo0, Out,
+ InitialInstMap, VarTypes0, !.ModuleInfo, Out,
OutPrime, HeadToCallSubst, CallToHeadSubst),
-
- stage1(Id, M, C, DoLCO, FullyStrict, VarTypes0, ModuleInfo0,
+ stage1(Id, M, C, DoLCO, FullyStrict, VarTypes0, !.ModuleInfo,
Sets),
-
- stage2(Id, C, Sets, OutPrime, Out, ModuleInfo0, ProcInfo0,
- VarSet - VarTypes, Accs, BaseCase, BasePairs,
+ stage2(Id, C, Sets, OutPrime, Out, !.ModuleInfo, !.ProcInfo,
+ VarSet, VarTypes, Accs, BaseCase, BasePairs,
Substs, CS, Warnings0),
stage3(Id, Accs, VarSet, VarTypes, C, CS, Substs,
HeadToCallSubst, CallToHeadSubst,
BaseCase, BasePairs, Sets, TopLevel, PredInfo,
- ProcInfo0, ModuleInfo0, ProcInfo1,
- ModuleInfo1)
+ !ProcInfo, !ModuleInfo)
->
- Warnings = Warnings0,
- ProcInfo = ProcInfo1,
- ModuleInfo = ModuleInfo1
+ Warnings = Warnings0
;
attempt_transform_2(Ids, C, M, Rec, HeadVars, InitialInstMap,
TopLevel, DoLCO, FullyStrict,
- PredInfo, ProcInfo0, ModuleInfo0,
- Warnings, ProcInfo, ModuleInfo)
+ PredInfo, !ProcInfo, !ModuleInfo, Warnings)
).
-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -451,8 +434,7 @@
% base and recursive cases into a single base and recursive
% case.
%
-:- pred standardize(hlds_goal, hlds_goal).
-:- mode standardize(in, out) is det.
+:- pred standardize(hlds_goal::in, hlds_goal::out) is det.
standardize(Goal0, Goal) :-
(
@@ -467,7 +449,6 @@
Goal = Goal0
).
-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -489,15 +470,11 @@
goal_to_conj_list(GoalA, GoalAList),
goal_to_conj_list(GoalB, GoalBList)
->
- (
- is_recursive_case(GoalAList, proc(PredId, ProcId))
- ->
+ ( is_recursive_case(GoalAList, proc(PredId, ProcId)) ->
Type = switch_rec_base,
Base = GoalBList,
Rec = GoalAList
- ;
- is_recursive_case(GoalBList, proc(PredId, ProcId))
- ->
+ ; is_recursive_case(GoalBList, proc(PredId, ProcId)) ->
Type = switch_base_rec,
Base = GoalAList,
Rec = GoalBList
@@ -512,15 +489,11 @@
goal_to_conj_list(GoalA, GoalAList),
goal_to_conj_list(GoalB, GoalBList)
->
- (
- is_recursive_case(GoalAList, proc(PredId, ProcId))
- ->
+ ( is_recursive_case(GoalAList, proc(PredId, ProcId)) ->
Type = disj_rec_base,
Base = GoalBList,
Rec = GoalAList
- ;
- is_recursive_case(GoalBList, proc(PredId, ProcId))
- ->
+ ; is_recursive_case(GoalBList, proc(PredId, ProcId)) ->
Type = disj_base_rec,
Base = GoalAList,
Rec = GoalBList
@@ -538,9 +511,7 @@
goal_to_conj_list(Then, GoalAList),
goal_to_conj_list(Else, GoalBList)
->
- (
- is_recursive_case(GoalAList, proc(PredId, ProcId))
- ->
+ ( is_recursive_case(GoalAList, proc(PredId, ProcId)) ->
Type = ite_rec_base,
Base = GoalBList,
Rec = GoalAList,
@@ -548,9 +519,7 @@
BaseInstMap = InitialInstMap,
instmap__apply_instmap_delta(InitialInstMap,
IfInstMapDelta, RecInstMap)
- ;
- is_recursive_case(GoalBList, proc(PredId, ProcId))
- ->
+ ; is_recursive_case(GoalBList, proc(PredId, ProcId)) ->
Type = ite_base_rec,
Base = GoalAList,
Rec = GoalBList,
@@ -565,7 +534,6 @@
fail
).
-
%
% is_recursive_case(Gs, Id) is true iff the list of goals, Gs,
% contains a call to the procedure specified by Id, where the
@@ -594,15 +562,14 @@
%
% Initialise the goal_store, which will hold the C_{a,b} goals.
%
-:- func initialize_goal_store(hlds_goals, instmap,
- hlds_goals, instmap) = goal_store.
+:- func initialize_goal_store(hlds_goals, instmap, hlds_goals, instmap)
+ = goal_store.
initialize_goal_store(Rec, RecInstMap, Base, BaseInstMap) = C :-
goal_store__init(C0),
list__foldl(store(rec), Rec, store_info(1, RecInstMap, C0),
store_info(_, _, C1)),
- list__foldl(store(base), Base,
- store_info(1, BaseInstMap, C1),
+ list__foldl(store(base), Base, store_info(1, BaseInstMap, C1),
store_info(_, _, C)).
%
@@ -669,7 +636,6 @@
instmap__apply_instmap_delta(InitialInstMap,
InitInstMapDelta, InstMapBeforeRest),
-
goal_list_instmap_delta(Rest, InstMapDelta),
instmap__apply_instmap_delta(InstMapBeforeRest,
InstMapDelta, InstMapAfterRest),
@@ -695,7 +661,6 @@
error("accumulator__identify_out_and_out_prime")
).
-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -741,19 +706,16 @@
not set__empty(Update)
),
(
- DoLCO = no
- ->
+ DoLCO = no,
% If LCMC is not turned on then there must be no
% construction unifications after the recursive
% call.
set__empty(Construct),
set__empty(ConstructAssoc)
;
- true
+ DoLCO = yes
).
-
-
%
% For each goal after the recursive call decide which set the
% goal belongs to.
@@ -763,9 +725,7 @@
stage1_2(N - I, K, M, GoalStore, FullyStrict, VarTypes, ModuleInfo,
Sets0, Sets) :-
- (
- I > M
- ->
+ ( I > M ->
Sets0 = Sets
;
(
@@ -838,16 +798,13 @@
:- func set_upto(int, int) = set(goal_id).
set_upto(N, K) = Set :-
- (
- K =< 0
- ->
+ ( K =< 0 ->
set__init(Set)
;
Set0 = set_upto(N, K-1),
set__insert(Set0, pair(N, K), Set)
).
-
%-----------------------------------------------------------------------------%
%
@@ -1014,7 +971,6 @@
bool % is the predicate commutative?
).
-
%
% If accumulator_is_associative is true, it returns the two
% arguments which are associative and the variable which depends
@@ -1027,12 +983,9 @@
is_associative(PredId, ProcId, ModuleInfo, Args, Result) :-
module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
PredInfo, _ProcInfo),
-
pred_info_get_assertions(PredInfo, Assertions),
-
associativity_assertion(set__to_sorted_list(Assertions),
ModuleInfo, Args, AssociativeVars, OutputVar),
-
(
commutativity_assertion(set__to_sorted_list(Assertions),
ModuleInfo, Args, _CommutativeVars)
@@ -1043,7 +996,6 @@
),
Result = assoc(AssociativeVars, OutputVar, IsCommutative).
-
%
% associativity_assertion
%
@@ -1111,12 +1063,12 @@
pred_info_get_assertions(PredInfo, Assertions),
- list__filter_map((pred(AssertId::in, StateVars::out) is semidet :-
+ list__filter_map(
+ (pred(AssertId::in, StateVars::out) is semidet :-
assertion__is_update_assertion(AssertId, ModuleInfo,
PredId, Args, StateVars)
),
- set__to_sorted_list(Assertions),
- Result),
+ set__to_sorted_list(Assertions), Result),
% XXX maybe we should just match on the first result,
% just in case there is duplicate promises.
@@ -1136,33 +1088,35 @@
pred_info_get_assertions(PredInfo, Assertions),
- list__filter((pred(AssertId::in) is semidet :-
+ list__filter(
+ (pred(AssertId::in) is semidet :-
assertion__is_construction_equivalence_assertion(
AssertId, ModuleInfo, ConsId, PredId)
),
- set__to_sorted_list(Assertions),
- Result),
+ set__to_sorted_list(Assertions), Result),
Result \= [].
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- type substs
- ---> substs(
- subst, % acc_var_subst
- subst, % rec_call_subst
- subst, % assoc_call_subst
- subst % update_subst
- ).
-
-:- type base
- ---> base(
- set(goal_id), % goals which initialize update
- set(goal_id), % goals which initialize assoc
- set(goal_id) % other goals
+:- type substs --->
+ substs(
+ acc_var_subst :: subst,
+ rec_call_subst :: subst,
+ assoc_call_subst :: subst,
+ update_subst :: subst
+ ).
+
+:- type base --->
+ base(
+ init_update :: set(goal_id),
+ % goals which initialize update
+ init_assoc :: set(goal_id),
+ % goals which initialize assoc
+ other :: set(goal_id)
+ % other goals
).
-
%
% Stage 2 is responsible for identifying the substitutions which
% are needed to mimic the unfold/fold process that was used as
@@ -1176,15 +1130,14 @@
%
:- pred stage2(goal_id::in, goal_store::in, sets::in,
prog_vars::in, prog_vars::in, module_info::in, proc_info::in,
- pair(prog_varset, vartypes)::out,
+ prog_varset::out, vartypes::out,
prog_vars::out, base::out, list(pair(prog_var))::out,
substs::out, goal_store::out, warnings::out) is semidet.
stage2(N - K, GoalStore, Sets, OutPrime, Out, ModuleInfo, ProcInfo0,
- VarSetVarTypesPair, Accs, BaseCase, BasePairs,
+ !:VarSet, !:VarTypes, Accs, BaseCase, BasePairs,
Substs, CS, Warnings) :-
-
- Sets = sets(Before0, Assoc, ConstructAssoc, Construct, Update, _Reject),
+ Sets = sets(Before0, Assoc, ConstructAssoc, Construct, Update, _),
Before = Before0 `union` set_upto(N, K-1),
% Note Update set is not placed in the after set, as the
@@ -1198,65 +1151,60 @@
goal_info_get_nonlocals(GoalInfo, NonLocals),
Set = NonLocals `union` Set0
),
- list__foldl(P, set__to_sorted_list(Before), set__init, BeforeNonLocals),
- list__foldl(P, set__to_sorted_list(After), set__init, AfterNonLocals),
+ list__foldl(P, set__to_sorted_list(Before), set__init,
+ BeforeNonLocals),
+ list__foldl(P, set__to_sorted_list(After), set__init,
+ AfterNonLocals),
InitAccs = BeforeNonLocals `intersect` AfterNonLocals,
- proc_info_varset(ProcInfo0, VarSet0),
- proc_info_vartypes(ProcInfo0, VarTypes0),
+ proc_info_varset(ProcInfo0, !:VarSet),
+ proc_info_vartypes(ProcInfo0, !:VarTypes),
- substs_init(set__to_sorted_list(InitAccs), VarSet0, VarTypes0,
- VarSet1, VarTypes1, Substs0),
+ substs_init(set__to_sorted_list(InitAccs), !VarSet, !VarTypes,
+ Substs0),
process_assoc_set(set__to_sorted_list(Assoc), GoalStore,
- set__list_to_set(OutPrime), ModuleInfo, Substs0,
- VarSet1 - VarTypes1, Substs1, VarSetVarTypesPair1, CS,
- Warnings),
+ set__list_to_set(OutPrime), ModuleInfo, Substs0, Substs1,
+ !VarSet, !VarTypes, CS, Warnings),
process_update_set(set__to_sorted_list(Update), GoalStore,
set__list_to_set(OutPrime), ModuleInfo,
- Substs1, VarSetVarTypesPair1,
- Substs, VarSetVarTypesPair, UpdateOut,
+ Substs1, Substs, !VarSet, !VarTypes, UpdateOut,
UpdateAccOut, BasePairs),
Accs = set__to_sorted_list(InitAccs) `append` UpdateAccOut,
- VarSetVarTypesPair = _ - VarTypes,
- divide_base_case(UpdateOut, Out, GoalStore, VarTypes, ModuleInfo,
+ divide_base_case(UpdateOut, Out, GoalStore, !.VarTypes, ModuleInfo,
UpdateBase, AssocBase, OtherBase),
BaseCase = base(UpdateBase, AssocBase, OtherBase).
%-----------------------------------------------------------------------------%
-:- pred substs_init(prog_vars::in, prog_varset::in, vartypes::in,
- prog_varset::out, vartypes::out, substs::out) is det.
+:- pred substs_init(prog_vars::in, prog_varset::in, prog_varset::out,
+ vartypes::in, vartypes::out, substs::out) is det.
-substs_init(InitAccs, VarSet0, VarTypes0, VarSet, VarTypes, Substs) :-
+substs_init(InitAccs, !VarSet, !VarTypes, Substs) :-
map__init(Subst),
- acc_var_subst_init(InitAccs, VarSet0, VarTypes0,
- VarSet, VarTypes, AccVarSubst),
+ acc_var_subst_init(InitAccs, !VarSet, !VarTypes, AccVarSubst),
RecCallSubst = Subst,
AssocCallSubst = Subst,
UpdateSubst = Subst,
- Substs = substs(AccVarSubst, RecCallSubst, AssocCallSubst, UpdateSubst).
+ Substs = substs(AccVarSubst, RecCallSubst, AssocCallSubst,
+ UpdateSubst).
%
% Initialise the acc_var_subst to be from Var to A_Var where
% Var is a member of InitAccs and A_Var is a fresh variable of
% the same type of Var.
%
-:- pred acc_var_subst_init(prog_vars::in, prog_varset::in, vartypes::in,
- prog_varset::out, vartypes::out, subst::out) is det.
-
-acc_var_subst_init([], VarSet, VarTypes, VarSet, VarTypes, Subst) :-
- map__init(Subst).
-acc_var_subst_init([Var | Vars], VarSet0, VarTypes0,
- VarSet, VarTypes, Subst) :-
- create_new_var(Var, "A_", AccVar, VarSet0 - VarTypes0,
- VarSet1 - VarTypes1),
- acc_var_subst_init(Vars, VarSet1, VarTypes1, VarSet, VarTypes, Subst0),
+:- pred acc_var_subst_init(prog_vars::in, prog_varset::in, prog_varset::out,
+ vartypes::in, vartypes::out, subst::out) is det.
+acc_var_subst_init([], !VarSet, !VarTypes, map__init).
+acc_var_subst_init([Var | Vars], !VarSet, !VarTypes, Subst) :-
+ create_new_var(Var, "A_", AccVar, !VarSet, !VarTypes),
+ acc_var_subst_init(Vars, !VarSet, !VarTypes, Subst0),
map__det_insert(Subst0, Var, AccVar, Subst).
%
@@ -1265,16 +1213,14 @@
% prefix.
%
:- pred create_new_var(prog_var::in, string::in, prog_var::out,
- pair(prog_varset, vartypes)::in,
- pair(prog_varset, vartypes)::out) is det.
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out) is det.
-create_new_var(OldVar, Prefix, NewVar, VarSet0 - VarTypes0,
- VarSet - VarTypes) :-
- varset__lookup_name(VarSet0, OldVar, OldName),
+create_new_var(OldVar, Prefix, NewVar, !VarSet, !VarTypes) :-
+ varset__lookup_name(!.VarSet, OldVar, OldName),
string__append(Prefix, OldName, NewName),
- varset__new_named_var(VarSet0, NewName, NewVar, VarSet),
- map__lookup(VarTypes0, OldVar, Type),
- map__det_insert(VarTypes0, NewVar, Type, VarTypes).
+ varset__new_named_var(!.VarSet, NewName, NewVar, !:VarSet),
+ map__lookup(!.VarTypes, OldVar, Type),
+ map__det_insert(!.VarTypes, NewVar, Type, !:VarTypes).
%-----------------------------------------------------------------------------%
@@ -1284,16 +1230,16 @@
% worsened by reordering the arguments to a call.
%
:- pred process_assoc_set(list(goal_id)::in, goal_store::in, set(prog_var)::in,
- module_info::in, substs::in, pair(prog_varset, vartypes)::in,
- substs::out, pair(prog_varset, vartypes)::out,
+ module_info::in, substs::in, substs::out,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
goal_store::out, warnings::out) is semidet.
-process_assoc_set([], _GS, _OutPrime, _ModuleInfo, Substs, Types,
- Substs, Types, CS, []) :-
+process_assoc_set([], _GS, _OutPrime, _ModuleInfo, !Substs,
+ !VarSet, !VarTypes, CS, []) :-
goal_store__init(CS).
-process_assoc_set([Id | Ids], GS, OutPrime, ModuleInfo, Substs0, Types0,
- Substs, Types, CS, Warnings) :-
- Substs0 = substs(AccVarSubst, RecCallSubst0, AssocCallSubst0,
+process_assoc_set([Id | Ids], GS, OutPrime, ModuleInfo, !Substs,
+ !VarSet, !VarTypes, CS, Warnings) :-
+ !.Substs = substs(AccVarSubst, RecCallSubst0, AssocCallSubst0,
UpdateSubst),
lookup_call(GS, Id, Goal - InstMap),
@@ -1306,8 +1252,7 @@
BeforeAssocVar),
map__lookup(AccVarSubst, BeforeAssocVar, AccVar),
- create_new_var(BeforeAssocVar, "NewAcc_", NewAcc, Types0, Types1),
-
+ create_new_var(BeforeAssocVar, "NewAcc_", NewAcc, !VarSet, !VarTypes),
map__det_insert(AssocCallSubst0, DuringAssocVar, AccVar,
AssocCallSubst1),
@@ -1317,7 +1262,7 @@
RecCallSubst1),
map__det_insert(RecCallSubst1, BeforeAssocVar, NewAcc, RecCallSubst),
- Substs1 = substs(AccVarSubst, RecCallSubst, AssocCallSubst,
+ !:Substs = substs(AccVarSubst, RecCallSubst, AssocCallSubst,
UpdateSubst),
% ONLY swap the order of the variables if the goal is
@@ -1351,28 +1296,24 @@
goal_info_get_context(GoalInfo, ProgContext),
Warning = [warn(ProgContext, PredId,
BeforeAssocVar, DuringAssocVar)]
-
),
% Swap the arguments.
- [A,B] = set__to_sorted_list(Vars),
+ [A, B] = set__to_sorted_list(Vars),
map__from_assoc_list([A-B, B-A], Subst),
goal_util__rename_vars_in_goal(Goal, Subst, SwappedGoal),
CSGoal = SwappedGoal - InstMap
),
- process_assoc_set(Ids, GS, OutPrime, ModuleInfo, Substs1, Types1,
- Substs, Types, CS0, Warnings0),
-
+ process_assoc_set(Ids, GS, OutPrime, ModuleInfo, !Substs,
+ !VarSet, !VarTypes, CS0, Warnings0),
goal_store__det_insert(CS0, Id, CSGoal, CS),
list__append(Warnings0, Warning, Warnings).
-
:- pred has_heuristic(module_name::in, string::in, arity::in) is semidet.
has_heuristic(unqualified("list"), "append", 3).
-
%
% heuristic returns the set of which head variables are
% important in the running time of the predicate.
@@ -1392,26 +1333,24 @@
% variable to get the result from.
%
:- pred process_update_set(list(goal_id)::in, goal_store::in, set(prog_var)::in,
- module_info::in, substs::in, pair(prog_varset, vartypes)::in,
- substs::out, pair(prog_varset, vartypes)::out,
+ module_info::in, substs::in, substs::out,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
prog_vars::out, prog_vars::out,
list(pair(prog_var))::out) is semidet.
-process_update_set([], _GS, _OutPrime, _ModuleInfo, Substs, Types, Substs,
- Types, [], [], []).
-process_update_set([Id | Ids], GS, OutPrime, ModuleInfo, Substs0, Types0,
- Substs, Types, StateOutputVars, Accs, BasePairs) :-
+process_update_set([], _GS, _OutPrime, _ModuleInfo, !Substs,
+ !VarSet, !VarTypes, [], [], []).
+process_update_set([Id | Ids], GS, OutPrime, ModuleInfo, !Substs,
+ !VarSet, !VarTypes, StateOutputVars, Accs, BasePairs) :-
- Substs0 = substs(AccVarSubst0, RecCallSubst0, AssocCallSubst,
+ !.Substs = substs(AccVarSubst0, RecCallSubst0, AssocCallSubst,
UpdateSubst0),
lookup_call(GS, Id, Goal - _InstMap),
Goal = call(PredId, ProcId, Args, _, _, _) - _GoalInfo,
is_update(PredId, ProcId, ModuleInfo, Args, StateVarA - StateVarB),
- (
- set__member(StateVarA, OutPrime)
- ->
+ ( set__member(StateVarA, OutPrime) ->
StateInputVar = StateVarA,
StateOutputVar = StateVarB
;
@@ -1419,22 +1358,19 @@
StateOutputVar = StateVarA
),
- create_new_var(StateInputVar, "Acc_", Acc0, Types0, Types1),
- create_new_var(StateOutputVar, "Acc_", Acc, Types1, Types2),
+ create_new_var(StateInputVar, "Acc_", Acc0, !VarSet, !VarTypes),
+ create_new_var(StateOutputVar, "Acc_", Acc, !VarSet, !VarTypes),
map__det_insert(UpdateSubst0, StateInputVar, Acc0, UpdateSubst1),
map__det_insert(UpdateSubst1, StateOutputVar, Acc, UpdateSubst),
-
map__det_insert(RecCallSubst0, StateInputVar, StateOutputVar,
RecCallSubst),
-
map__det_insert(AccVarSubst0, Acc, Acc0, AccVarSubst),
-
- Substs1 = substs(AccVarSubst, RecCallSubst, AssocCallSubst,
+ !:Substs = substs(AccVarSubst, RecCallSubst, AssocCallSubst,
UpdateSubst),
- process_update_set(Ids, GS, OutPrime, ModuleInfo, Substs1, Types2,
- Substs, Types, StateOutputVars0, Accs0, BasePairs0),
+ process_update_set(Ids, GS, OutPrime, ModuleInfo, !Substs,
+ !VarSet, !VarTypes, StateOutputVars0, Accs0, BasePairs0),
% Rather then concatenating to start of the list we
% concatenate to the end of the list. This allows the
@@ -1478,7 +1414,8 @@
Set = base_case_ids_set(C) `difference` (UpdateBase `union` AssocBase),
set__to_sorted_list(Set, List),
- list__map((pred(GoalId::in, Ancestors::out) is det :-
+ list__map(
+ (pred(GoalId::in, Ancestors::out) is det :-
goal_store__all_ancestors(C, GoalId, VarTypes,
ModuleInfo, no, Ancestors)
), List, OtherBaseList),
@@ -1497,7 +1434,8 @@
set(goal_id)::out) is det.
related(GS, VarTypes, ModuleInfo, Var, Related) :-
- solutions((pred(Key::out) is nondet :-
+ solutions(
+ (pred(Key::out) is nondet :-
goal_store__member(GS, Key, Goal - InstMap0),
Key = base - _,
Goal = _GoalExpr - GoalInfo,
@@ -1507,9 +1445,7 @@
ModuleInfo, ChangedVars),
set__singleton_set(ChangedVars, Var)
), Ids),
- (
- Ids = [Id]
- ->
+ ( Ids = [Id] ->
goal_store__all_ancestors(GS, Id, VarTypes, ModuleInfo, no,
Ancestors),
list__filter((pred((base - _)::in) is semidet),
@@ -1528,14 +1464,12 @@
% Do a goal_store__lookup where the result is known to be a
% call.
-:- pred lookup_call(goal_store, goal_id, goal_store__goal) is det.
-:- mode lookup_call(in, in, out(call_goal)) is det.
+:- pred lookup_call(goal_store::in, goal_id::in,
+ goal_store__goal::out(call_goal)) is det.
lookup_call(GoalStore, Id, Call - InstMap) :-
goal_store__lookup(GoalStore, Id, Goal - InstMap),
- (
- Goal = call(_, _, _, _, _, _) - _
- ->
+ ( Goal = call(_, _, _, _, _, _) - _ ->
Call = Goal
;
error("accumulator__lookup_call: not a call.")
@@ -1553,43 +1487,37 @@
:- pred stage3(goal_id::in, prog_vars::in, prog_varset::in, vartypes::in,
goal_store::in, goal_store::in, substs::in, subst::in,
subst::in, base::in, list(pair(prog_var))::in, sets::in,
- top_level::in, pred_info::in, proc_info::in,
- module_info::in, proc_info::out, module_info::out) is
- det.
+ top_level::in, pred_info::in, proc_info::in, proc_info::out,
+ module_info::in, module_info::out) is det.
stage3(RecCallId, Accs, VarSet, VarTypes, C, CS, Substs,
HeadToCallSubst, CallToHeadSubst, BaseCase, BasePairs,
- Sets, TopLevel, OrigPredInfo, OrigProcInfo0,
- ModuleInfo0, OrigProcInfo, ModuleInfo) :-
+ Sets, TopLevel, OrigPredInfo, !OrigProcInfo, !ModuleInfo) :-
- acc_proc_info(Accs, VarSet, VarTypes, Substs,
- OrigProcInfo0, AccTypes, AccProcInfo),
+ acc_proc_info(Accs, VarSet, VarTypes, Substs, !.OrigProcInfo,
+ AccTypes, AccProcInfo),
acc_pred_info(AccTypes, AccProcInfo, OrigPredInfo, AccProcId,
AccPredInfo),
-
AccName = unqualified(pred_info_name(AccPredInfo)),
- module_info_get_predicate_table(ModuleInfo0, PredTable0),
+ module_info_get_predicate_table(!.ModuleInfo, PredTable0),
predicate_table_insert(AccPredInfo, AccPredId, PredTable0, PredTable),
- module_info_set_predicate_table(PredTable, ModuleInfo0, ModuleInfo1),
+ module_info_set_predicate_table(PredTable, !ModuleInfo),
create_goal(RecCallId, Accs, AccPredId, AccProcId, AccName, Substs,
HeadToCallSubst, CallToHeadSubst, BaseCase,
BasePairs, Sets, C, CS, OrigBaseGoal,
OrigRecGoal, AccBaseGoal, AccRecGoal),
- proc_info_goal(OrigProcInfo0, OrigGoal0),
-
+ proc_info_goal(!.OrigProcInfo, OrigGoal0),
top_level(TopLevel, OrigGoal0, OrigBaseGoal, OrigRecGoal,
AccBaseGoal, AccRecGoal, OrigGoal, AccGoal),
- proc_info_set_goal(OrigGoal, OrigProcInfo0, OrigProcInfo1),
- proc_info_set_varset(VarSet, OrigProcInfo1, OrigProcInfo2),
- proc_info_set_vartypes(VarTypes, OrigProcInfo2, OrigProcInfo3),
-
- requantify_proc(OrigProcInfo3, OrigProcInfo),
+ proc_info_set_goal(OrigGoal, !OrigProcInfo),
+ proc_info_set_varset(VarSet, !OrigProcInfo),
+ proc_info_set_vartypes(VarTypes, !OrigProcInfo),
- update_accumulator_pred(AccPredId, AccProcId, AccGoal,
- ModuleInfo1, ModuleInfo).
+ requantify_proc(!OrigProcInfo),
+ update_accumulator_pred(AccPredId, AccProcId, AccGoal, !ModuleInfo).
%-----------------------------------------------------------------------------%
@@ -1599,8 +1527,7 @@
% Construct a proc_info for the introduced predicate.
%
:- pred acc_proc_info(prog_vars::in, prog_varset::in, vartypes::in,
- substs::in, proc_info::in,
- list(type)::out, proc_info::out) is det.
+ substs::in, proc_info::in, list(type)::out, proc_info::out) is det.
acc_proc_info(Accs0, VarSet, VarTypes, Substs,
OrigProcInfo, AccTypes, AccProcInfo) :-
@@ -1617,7 +1544,6 @@
proc_info_typeclass_info_varmap(OrigProcInfo, TCVarsMap),
proc_info_is_address_taken(OrigProcInfo, IsAddressTaken),
-
Substs = substs(AccVarSubst, _RecCallSubst, _AssocCallSubst,
_UpdateSubst),
list__map(map__lookup(AccVarSubst), Accs0, Accs),
@@ -1680,9 +1606,8 @@
Line, Counter, SymName),
pred_info_create(ModuleName, SymName, TypeVarSet, ExistQVars, Types,
- Cond, PredContext, local, Markers, PredOrFunc,
- ClassContext, Owner, Assertions, NewProcInfo, NewProcId,
- NewPredInfo).
+ Cond, PredContext, local, Markers, PredOrFunc, ClassContext,
+ Owner, Assertions, NewProcInfo, NewProcId, NewPredInfo).
%-----------------------------------------------------------------------------%
@@ -1692,12 +1617,10 @@
% and recursive cases of accumulator version (AccBaseGoal and
% AccRecGoal).
%
-:- pred create_goal(goal_id, prog_vars, pred_id, proc_id, sym_name,
- substs, subst, subst, base, list(pair(prog_var)), sets,
- goal_store, goal_store, hlds_goal, hlds_goal, hlds_goal,
- hlds_goal).
-:- mode create_goal(in, in, in, in, in, in,
- in, in, in, in, in, in, in, out, out, out, out) is det.
+:- pred create_goal(goal_id::in, prog_vars::in, pred_id::in, proc_id::in,
+ sym_name::in, substs::in, subst::in, subst::in, base::in,
+ list(pair(prog_var))::in, sets::in, goal_store::in, goal_store::in,
+ hlds_goal::out, hlds_goal::out, hlds_goal::out, hlds_goal::out) is det.
create_goal(RecCallId, Accs, AccPredId, AccProcId, AccName, Substs,
HeadToCallSubst, CallToHeadSubst, BaseIds, BasePairs,
@@ -1705,25 +1628,19 @@
AccRecGoal) :-
lookup_call(C, RecCallId, OrigCall - _InstMap),
-
- Call = create_acc_call(OrigCall, Accs, AccPredId,
- AccProcId, AccName),
-
+ Call = create_acc_call(OrigCall, Accs, AccPredId, AccProcId, AccName),
create_orig_goal(Call, Substs, HeadToCallSubst, CallToHeadSubst,
BaseIds, Sets, C, OrigBaseGoal, OrigRecGoal),
-
create_acc_goal(Call, Substs, HeadToCallSubst, BaseIds, BasePairs,
Sets, C, CS, AccBaseGoal, AccRecGoal).
-
%
% create_acc_call takes the original call and generates a call
% to the accumulator version of the call, which can have the
% substitutions applied to it easily.
%
-:- func create_acc_call(hlds_goal, prog_vars, pred_id, proc_id,
- sym_name) = hlds_goal.
-:- mode create_acc_call(in(hlds_call), in, in, in, in) = out(hlds_call) is det.
+:- func create_acc_call(hlds_goal::in(hlds_call), prog_vars::in, pred_id::in,
+ proc_id::in, sym_name::in) = (hlds_goal::out(hlds_call)) is det.
create_acc_call(OrigCall, Accs, AccPredId, AccProcId, AccName) = Call :-
OrigCall = call(_PredId, _ProcId, Args, Builtin, Context, _Name) - GI,
@@ -1744,25 +1661,21 @@
UpdateSubst),
BaseIds = base(UpdateBase, _AssocBase, _OtherBase),
- Sets = sets(Before, _Assoc, _ConstructAssoc,
- _Construct, Update, _Reject),
+ Sets = sets(Before, _Assoc, _ConstructAssoc, _Construct, Update,
+ _Reject),
U = create_new_orig_recursive_goals(UpdateBase, Update,
HeadToCallSubst, UpdateSubst, C),
goal_util__rename_vars_in_goal(Call, CallToHeadSubst, BaseCall),
-
Cbefore = goal_list(set__to_sorted_list(Before), C),
-
Uupdate = goal_list(set__to_sorted_list(UpdateBase) `append`
set__to_sorted_list(Update), U),
Cbase = goal_list(base_case_ids(C), C),
-
- calculate_goal_info(conj(Cbefore `append` Uupdate `append`
- [BaseCall]), OrigRecGoal),
+ calculate_goal_info(conj(Cbefore `append` Uupdate `append` [BaseCall]),
+ OrigRecGoal),
calculate_goal_info(conj(Cbase), OrigBaseGoal).
-
%
% Create the goals which are to go in the new accumulator
% version of the predicate.
@@ -1787,8 +1700,7 @@
% Create the goals which will be used in the new
% recursive case.
R = create_new_recursive_goals(Assoc, Construct `union` ConstructAssoc,
- Update, AssocCallSubst, AccVarSubst,
- UpdateSubst, C, CS),
+ Update, AssocCallSubst, AccVarSubst, UpdateSubst, C, CS),
Rassoc = goal_list(set__to_sorted_list(Assoc), R),
Rupdate = goal_list(set__to_sorted_list(Update), R),
@@ -1808,11 +1720,9 @@
list__map(acc_unification, BasePairs, UpdateBase),
calculate_goal_info(conj(Cbefore `append` Rassoc `append`
- Rupdate `append` [RecCall] `append` Rconstruct),
- AccRecGoal),
+ Rupdate `append` [RecCall] `append` Rconstruct), AccRecGoal),
calculate_goal_info(conj(UpdateBase `append` BaseCase), AccBaseGoal).
-
%
% Create the U set of goals (those that will be used in the
% original recursive case) by renaming all the goals which are
@@ -1853,14 +1763,13 @@
% head_to_call and all the members of (assoc U construct U
% construct_assoc) of C with acc_var_subst.
%
-:- func create_new_base_goals(set(goal_id), goal_store, subst, subst) =
- goal_store.
+:- func create_new_base_goals(set(goal_id), goal_store, subst, subst)
+ = goal_store.
create_new_base_goals(Ids, C, AccVarSubst, HeadToCallSubst)
= rename(set__to_sorted_list(Ids), AccVarSubst, C, Bbase) :-
Bbase = rename(base_case_ids(C), HeadToCallSubst, C, goal_store__init).
-
%
% acc_unification(O-A, G)
%
@@ -1872,18 +1781,14 @@
out_mode(LHSMode),
in_mode(RHSMode),
UniMode = LHSMode - RHSMode,
-
Context = unify_context(explicit, []),
Expr = unify(Out, var(Acc), UniMode, assign(Out,Acc), Context),
set__list_to_set([Out,Acc], NonLocalVars),
instmap_delta_from_assoc_list([Out - ground(shared, none)],
InstMapDelta),
-
goal_info_init(NonLocalVars, InstMapDelta, det, pure, Info),
-
Goal = Expr - Info.
-
%-----------------------------------------------------------------------------%
%
@@ -1955,11 +1860,11 @@
(
Goal = if_then_else(Vars, If, _, _) - GoalInfo
->
- OrigGoal = if_then_else(Vars, If,
- OrigBaseGoal, OrigRecGoal) - GoalInfo,
+ OrigGoal = if_then_else(Vars, If, OrigBaseGoal, OrigRecGoal)
+ - GoalInfo,
- NewGoal = if_then_else(Vars, If,
- NewBaseGoal, NewRecGoal) - GoalInfo
+ NewGoal = if_then_else(Vars, If, NewBaseGoal, NewRecGoal)
+ - GoalInfo
;
error("top_level: not the correct top level")
).
@@ -1968,11 +1873,11 @@
(
Goal = if_then_else(Vars, If, _, _) - GoalInfo
->
- OrigGoal = if_then_else(Vars, If,
- OrigRecGoal, OrigBaseGoal) - GoalInfo,
+ OrigGoal = if_then_else(Vars, If, OrigRecGoal, OrigBaseGoal)
+ - GoalInfo,
- NewGoal = if_then_else(Vars, If,
- NewRecGoal, NewBaseGoal) - GoalInfo
+ NewGoal = if_then_else(Vars, If, NewRecGoal, NewBaseGoal)
+ - GoalInfo
;
error("top_level: not the correct top level")
).
@@ -2010,7 +1915,8 @@
:- func rename(list(goal_id), subst, goal_store, goal_store) = goal_store.
rename(Ids, Subst, From, Initial) = Final :-
- list__foldl((pred(Id::in, GS0::in, GS::out) is det :-
+ list__foldl(
+ (pred(Id::in, GS0::in, GS::out) is det :-
goal_store__lookup(From, Id, Goal0 - InstMap),
goal_util__rename_vars_in_goal(Goal0, Subst, Goal),
goal_store__det_insert(GS0, Id, Goal - InstMap, GS)
@@ -2022,7 +1928,8 @@
:- func base_case_ids(goal_store) = list(goal_id).
base_case_ids(GS) = Base :-
- solutions((pred(Key::out) is nondet :-
+ solutions(
+ (pred(Key::out) is nondet :-
goal_store__member(GS, Key, _Goal),
Key = base - _
), Base).
@@ -2038,7 +1945,8 @@
:- func goal_list(list(goal_id), goal_store) = hlds_goals.
goal_list(Ids, GS) = Goals :-
- list__map((pred(Key::in, G::out) is det :-
+ list__map(
+ (pred(Key::in, G::out) is det :-
goal_store__lookup(GS, Key, G - _)
), Ids, Goals).
@@ -2096,14 +2004,11 @@
chain_subst_2([A|As], AtoB, BtoC, AtoC) :-
chain_subst_2(As, AtoB, BtoC, AtoC0),
map__lookup(AtoB, A, B),
- (
- map__search(BtoC, B, C)
- ->
+ ( map__search(BtoC, B, C) ->
map__det_insert(AtoC0, A, C, AtoC)
;
AtoC = AtoC0
).
-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/assertion.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/assertion.m,v
retrieving revision 1.27
diff -u -b -r1.27 assertion.m
--- compiler/assertion.m 3 Dec 2003 16:12:08 -0000 1.27
+++ compiler/assertion.m 4 Apr 2004 10:33:37 -0000
@@ -129,8 +129,7 @@
% defined in the implementation of that module.
%
:- pred assertion__in_interface_check(hlds_goal::in, pred_info::in,
- module_info::in, module_info::out,
- io__state::di, io__state::uo) is det.
+ module_info::in, module_info::out, io::di, io::uo) is det.
%
% assertion__normalise_goal
@@ -149,10 +148,11 @@
:- import_module hlds__hlds_out.
:- import_module libs__globals.
:- import_module libs__options.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__prog_out.
:- import_module parse_tree__prog_util.
-:- import_module assoc_list, bool, list, map, require, set, std_util.
+:- import_module string, bool, list, assoc_list, map, set, require, std_util.
:- type subst == map(prog_var, prog_var).
@@ -179,10 +179,8 @@
:- pred commutative_var_ordering(prog_vars::in, prog_vars::in,
prog_vars::in, pair(prog_var)::out) is semidet.
-commutative_var_ordering([P|Ps], [Q|Qs], [V|Vs], CommutativeVars) :-
- (
- P = Q
- ->
+commutative_var_ordering([P | Ps], [Q | Qs], [V | Vs], CommutativeVars) :-
+ ( P = Q ->
commutative_var_ordering(Ps, Qs, Vs, CommutativeVars)
;
commutative_var_ordering_2(P, Q, Ps, Qs, Vs, CallVarB),
@@ -192,10 +190,9 @@
:- pred commutative_var_ordering_2(prog_var::in, prog_var::in, prog_vars::in,
prog_vars::in, prog_vars::in, prog_var::out) is semidet.
-commutative_var_ordering_2(VarP, VarQ, [P|Ps], [Q|Qs], [V|Vs], CallVarB) :-
- (
- P = Q
- ->
+commutative_var_ordering_2(VarP, VarQ, [P | Ps], [Q | Qs], [V | Vs],
+ CallVarB) :-
+ ( P = Q ->
commutative_var_ordering_2(VarP, VarQ, Ps, Qs, Vs, CallVarB)
;
CallVarB = V,
@@ -227,12 +224,10 @@
Q = conj(QCalls) - _QGoalInfo
),
-
AssociativeVars - OutputVar =
promise_only_solution(associative(PCalls, QCalls,
UniversiallyQuantifiedVars, CallVars)).
-
% associative(Ps, Qs, Us, R)
%
% If the assertion was in the form
@@ -300,8 +295,7 @@
% L <= XY and Ps <= [X - XY, Y - Z, XY - XYZ]
:- pred process_one_side(hlds_goals::in, set(prog_var)::in, pred_id::out,
- prog_var::out, assoc_list(prog_var)::out,
- prog_vars::out) is semidet.
+ prog_var::out, assoc_list(prog_var)::out, prog_vars::out) is semidet.
process_one_side(Goals, UniversiallyQuantifiedVars, PredId,
LinkingVar, Vars, VarsA) :-
@@ -314,13 +308,12 @@
list__length(Vars, number_of_associative_vars).
:- func number_of_associative_vars = int.
+
number_of_associative_vars = 3.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-
-
%
% assertion__is_update_assertion(Id, MI, PId, Ss)
%
@@ -341,9 +334,7 @@
assertion__is_update_assertion(AssertId, Module, _PredId, CallVars,
StateA - StateB) :-
assertion__goal(AssertId, Module, Goal - GoalInfo),
-
equivalent(Goal - GoalInfo, P, Q),
-
goal_info_get_nonlocals(GoalInfo, UniversiallyQuantifiedVars),
% There may or may not be an explicit some [Vars] there,
@@ -407,8 +398,8 @@
% variables of the first call.
%
:- pred process_two_linked_calls(hlds_goals::in, set(prog_var)::in,
- pred_id::out, prog_var::out,
- assoc_list(prog_var)::out, prog_vars::out) is semidet.
+ pred_id::out, prog_var::out, assoc_list(prog_var)::out, prog_vars::out)
+ is semidet.
process_two_linked_calls(Goals, UniversiallyQuantifiedVars, PredId,
LinkingVar, Vars, VarsA) :-
@@ -425,7 +416,6 @@
% Set up mapping between the variables in the two calls.
assoc_list__from_corresponding_lists(VarsA, VarsB, Vars).
-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -461,9 +451,7 @@
:- pred predicate_call(hlds_goal::in, pred_id::in) is semidet.
predicate_call(Goal, PredId) :-
- (
- Goal = conj(Goals) - _
- ->
+ ( Goal = conj(Goals) - _ ->
list__member(Call, Goals),
Call = call(PredId, _, _, _, _, _) - _,
list__delete(Goals, Call, Unifications),
@@ -487,9 +475,7 @@
module_info_pred_info(Module, PredId, PredInfo),
pred_info_clauses_info(PredInfo, ClausesInfo),
clauses_info_clauses(ClausesInfo, Clauses),
- (
- Clauses = [clause(_ProcIds, Goal0, _Lang, _Context)]
- ->
+ ( Clauses = [clause(_ProcIds, Goal0, _Lang, _Context)] ->
assertion__normalise_goal(Goal0, Goal)
;
error("assertion__goal: not an assertion")
@@ -504,9 +490,7 @@
% Goal = (P => Q)
Goal = not(conj(GoalList) - GI) - _,
list__reverse(GoalList) = [NotQ | Ps],
- (
- Ps = [P0]
- ->
+ ( Ps = [P0] ->
P = P0
;
P = conj(list__reverse(Ps)) - GI
@@ -538,116 +522,111 @@
:- pred equal_goals(hlds_goal::in, hlds_goal::in,
subst::in, subst::out) is semidet.
-equal_goals(conj(GoalAs) - _, conj(GoalBs) - _, Subst0, Subst) :-
- equal_goals_list(GoalAs, GoalBs, Subst0, Subst).
+equal_goals(conj(GoalAs) - _, conj(GoalBs) - _, !Subst) :-
+ equal_goals_list(GoalAs, GoalBs, !Subst).
equal_goals(call(PredId, _, VarsA, _, _, _) - _,
- call(PredId, _, VarsB, _, _, _) - _, Subst0, Subst) :-
- equal_vars(VarsA, VarsB, Subst0, Subst).
+ call(PredId, _, VarsB, _, _, _) - _, !Subst) :-
+ equal_vars(VarsA, VarsB, !Subst).
equal_goals(generic_call(Type, VarsA, _, _) - _,
- generic_call(Type, VarsB, _, _) - _, Subst0, Subst) :-
- equal_vars(VarsA, VarsB, Subst0, Subst).
+ generic_call(Type, VarsB, _, _) - _, !Subst) :-
+ equal_vars(VarsA, VarsB, !Subst).
equal_goals(switch(Var, CanFail, CasesA) - _,
- switch(Var, CanFail, CasesB) - _, Subst0, Subst) :-
- equal_goals_cases(CasesA, CasesB, Subst0, Subst).
+ switch(Var, CanFail, CasesB) - _, !Subst) :-
+ equal_goals_cases(CasesA, CasesB, !Subst).
equal_goals(unify(VarA, RHSA, _, _, _) - _, unify(VarB, RHSB, _, _, _) - _,
- Subst0, Subst) :-
- equal_vars([VarA], [VarB], Subst0, Subst1),
- equal_unification(RHSA, RHSB, Subst1, Subst).
-equal_goals(disj(GoalAs) - _, disj(GoalBs) - _, Subst0, Subst) :-
- equal_goals_list(GoalAs, GoalBs, Subst0, Subst).
-equal_goals(not(GoalA) - _, not(GoalB) - _, Subst0, Subst) :-
- equal_goals(GoalA, GoalB, Subst0, Subst).
+ !Subst) :-
+ equal_vars([VarA], [VarB], !Subst),
+ equal_unification(RHSA, RHSB, !Subst).
+equal_goals(disj(GoalAs) - _, disj(GoalBs) - _, !Subst) :-
+ equal_goals_list(GoalAs, GoalBs, !Subst).
+equal_goals(not(GoalA) - _, not(GoalB) - _, !Subst) :-
+ equal_goals(GoalA, GoalB, !Subst).
equal_goals(some(VarsA, _, GoalA) - _, some(VarsB, _, GoalB) - _,
- Subst0, Subst) :-
- equal_vars(VarsA, VarsB, Subst0, Subst1),
- equal_goals(GoalA, GoalB, Subst1, Subst).
+ !Subst) :-
+ equal_vars(VarsA, VarsB, !Subst),
+ equal_goals(GoalA, GoalB, !Subst).
equal_goals(if_then_else(VarsA, IfA, ThenA, ElseA) - _,
- if_then_else(VarsB, IfB, ThenB, ElseB) - _, Subst0, Subst) :-
- equal_vars(VarsA, VarsB, Subst0, Subst1),
- equal_goals(IfA, IfB, Subst1, Subst2),
- equal_goals(ThenA, ThenB, Subst2, Subst3),
- equal_goals(ElseA, ElseB, Subst3, Subst).
-equal_goals(foreign_proc(Attribs, PredId, _, VarsA, _, _, _) - _,
- foreign_proc(Attribs, PredId, _, VarsB, _, _, _) -
- _, Subst0, Subst) :-
- equal_vars(VarsA, VarsB, Subst0, Subst).
-equal_goals(par_conj(GoalAs) - _, par_conj(GoalBs) - _, Subst0, Subst) :-
- equal_goals_list(GoalAs, GoalBs, Subst0, Subst).
+ if_then_else(VarsB, IfB, ThenB, ElseB) - _, !Subst) :-
+ equal_vars(VarsA, VarsB, !Subst),
+ equal_goals(IfA, IfB, !Subst),
+ equal_goals(ThenA, ThenB, !Subst),
+ equal_goals(ElseA, ElseB, !Subst).
+equal_goals(foreign_proc(Attribs, PredId, _, VarsA, _,_,_) - _,
+ foreign_proc(Attribs, PredId, _, VarsB, _,_,_) - _, !Subst) :-
+ equal_vars(VarsA, VarsB, !Subst).
+equal_goals(par_conj(GoalAs) - _, par_conj(GoalBs) - _, !Subst) :-
+ equal_goals_list(GoalAs, GoalBs, !Subst).
equal_goals(shorthand(ShorthandGoalA) - GoalInfoA,
- shorthand(ShorthandGoalB) - GoalInfoB, Subst0, Subst) :-
+ shorthand(ShorthandGoalB) - GoalInfoB, !Subst) :-
equal_goals_shorthand(ShorthandGoalA - GoalInfoA,
- ShorthandGoalB - GoalInfoB, Subst0, Subst).
+ ShorthandGoalB - GoalInfoB, !Subst).
:- pred equal_goals_shorthand(pair(shorthand_goal_expr, hlds_goal_info)::in,
- pair(shorthand_goal_expr, hlds_goal_info)::in, subst::in,
- subst::out) is semidet.
+ pair(shorthand_goal_expr, hlds_goal_info)::in, subst::in, subst::out)
+ is semidet.
equal_goals_shorthand(bi_implication(LeftGoalA, RightGoalA) - GoalInfo,
- bi_implication(LeftGoalB, RightGoalB) - GoalInfo, Subst0, Subst)
- :-
- equal_goals(LeftGoalA, LeftGoalB, Subst0, Subst1),
- equal_goals(RightGoalA, RightGoalB, Subst1, Subst).
-
-:- pred equal_vars(prog_vars::in, prog_vars::in, subst::in,
- subst::out) is semidet.
-
-equal_vars([], [], Subst, Subst).
-equal_vars([VA | VAs], [VB | VBs], Subst0, Subst) :-
- (
- map__search(Subst0, VA, SubstVA)
- ->
+ bi_implication(LeftGoalB, RightGoalB) - GoalInfo, !Subst) :-
+ equal_goals(LeftGoalA, LeftGoalB, !Subst),
+ equal_goals(RightGoalA, RightGoalB, !Subst).
+
+:- pred equal_vars(prog_vars::in, prog_vars::in, subst::in, subst::out)
+ is semidet.
+
+equal_vars([], [], !Subst).
+equal_vars([VA | VAs], [VB | VBs], !Subst) :-
+ ( map__search(!.Subst, VA, SubstVA) ->
SubstVA = VB,
- equal_vars(VAs, VBs, Subst0, Subst)
+ equal_vars(VAs, VBs, !Subst)
;
- map__insert(Subst0, VA, VB, Subst1),
- equal_vars(VAs, VBs, Subst1, Subst)
+ map__insert(!.Subst, VA, VB, !:Subst),
+ equal_vars(VAs, VBs, !Subst)
).
-:- pred equal_unification(unify_rhs::in, unify_rhs::in, subst::in,
- subst::out) is semidet.
+:- pred equal_unification(unify_rhs::in, unify_rhs::in, subst::in, subst::out)
+ is semidet.
-equal_unification(var(A), var(B), Subst0, Subst) :-
- equal_vars([A], [B], Subst0, Subst).
+equal_unification(var(A), var(B), !Subst) :-
+ equal_vars([A], [B], !Subst).
equal_unification(functor(ConsId, E, VarsA), functor(ConsId, E, VarsB),
- Subst0, Subst) :-
- equal_vars(VarsA, VarsB, Subst0, Subst).
-equal_unification(lambda_goal(Purity, PredOrFunc, EvalMethod, FixModes,
+ !Subst) :-
+ equal_vars(VarsA, VarsB, !Subst).
+equal_unification(LambdaGoalA, LambdaGoalB, !Subst) :-
+ LambdaGoalA = lambda_goal(Purity, PredOrFunc, EvalMethod, FixModes,
NLVarsA, LVarsA, Modes, Det, GoalA),
- lambda_goal(Purity, PredOrFunc, EvalMethod, FixModes,
+ LambdaGoalB = lambda_goal(Purity, PredOrFunc, EvalMethod, FixModes,
NLVarsB, LVarsB, Modes, Det, GoalB),
- Subst0, Subst) :-
- equal_vars(NLVarsA, NLVarsB, Subst0, Subst1),
- equal_vars(LVarsA, LVarsB, Subst1, Subst2),
- equal_goals(GoalA, GoalB, Subst2, Subst).
+ equal_vars(NLVarsA, NLVarsB, !Subst),
+ equal_vars(LVarsA, LVarsB, !Subst),
+ equal_goals(GoalA, GoalB, !Subst).
+
+:- pred equal_goals_list(hlds_goals::in, hlds_goals::in, subst::in, subst::out)
+ is semidet.
+
+equal_goals_list([], [], !Subst).
+equal_goals_list([GoalA | GoalAs], [GoalB | GoalBs], !Subst) :-
+ equal_goals(GoalA, GoalB, !Subst),
+ equal_goals_list(GoalAs, GoalBs, !Subst).
+:- pred equal_goals_cases(list(case)::in, list(case)::in,
+ subst::in, subst::out) is semidet.
-:- pred equal_goals_list(hlds_goals::in, hlds_goals::in, subst::in,
- subst::out) is semidet.
-
-equal_goals_list([], [], Subst, Subst).
-equal_goals_list([GoalA | GoalAs], [GoalB | GoalBs], Subst0, Subst) :-
- equal_goals(GoalA, GoalB, Subst0, Subst1),
- equal_goals_list(GoalAs, GoalBs, Subst1, Subst).
-
-:- pred equal_goals_cases(list(case)::in, list(case)::in, subst::in,
- subst::out) is semidet.
-
-equal_goals_cases([], [], Subst, Subst).
-equal_goals_cases([CaseA | CaseAs], [CaseB | CaseBs], Subst0, Subst) :-
+equal_goals_cases([], [], !Subst).
+equal_goals_cases([CaseA | CaseAs], [CaseB | CaseBs], !Subst) :-
CaseA = case(ConsId, GoalA),
CaseB = case(ConsId, GoalB),
- equal_goals(GoalA, GoalB, Subst0, Subst1),
- equal_goals_cases(CaseAs, CaseBs, Subst1, Subst).
+ equal_goals(GoalA, GoalB, !Subst),
+ equal_goals_cases(CaseAs, CaseBs, !Subst).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-assertion__record_preds_used_in(Goal, AssertId, Module0, Module) :-
+assertion__record_preds_used_in(Goal, AssertId, !Module) :-
% Explicit lambda expression needed since
% goal_calls_pred_id has multiple modes.
P = (pred(PredId::out) is nondet :- goal_calls_pred_id(Goal, PredId)),
solutions(P, PredIds),
- list__foldl(update_pred_info(AssertId), PredIds, Module0, Module).
+ list__foldl(update_pred_info(AssertId), PredIds, !Module).
%-----------------------------------------------------------------------------%
@@ -711,7 +690,6 @@
assertion__normalise_goal(LHS0, LHS),
assertion__normalise_goal(RHS0, RHS).
-
%-----------------------------------------------------------------------------%
:- pred assertion__normalise_conj(hlds_goals::in, hlds_goals::out) is det.
@@ -742,152 +720,136 @@
%-----------------------------------------------------------------------------%
assertion__in_interface_check(call(PredId,_,_,_,_,SymName) - GoalInfo,
- _PredInfo, Module0, Module) -->
- { module_info_pred_info(Module0, PredId, CallPredInfo) },
- { pred_info_import_status(CallPredInfo, ImportStatus) },
- (
- { is_defined_in_implementation_section(ImportStatus, yes) }
- ->
- { goal_info_get_context(GoalInfo, Context) },
- { PredOrFunc = pred_info_is_pred_or_func(CallPredInfo) },
- { Arity = pred_info_arity(CallPredInfo) },
+ _PredInfo, !Module, !IO) :-
+ module_info_pred_info(!.Module, PredId, CallPredInfo),
+ pred_info_import_status(CallPredInfo, ImportStatus),
+ ( is_defined_in_implementation_section(ImportStatus) = yes ->
+ goal_info_get_context(GoalInfo, Context),
+ PredOrFunc = pred_info_is_pred_or_func(CallPredInfo),
+ Arity = pred_info_arity(CallPredInfo),
write_assertion_interface_error(Context,
- call(PredOrFunc, SymName, Arity),
- Module0, Module)
+ call(PredOrFunc, SymName, Arity), !Module, !IO)
;
- { Module = Module0 }
+ true
).
-assertion__in_interface_check(generic_call(_,_,_,_) - _, _,
- Module, Module) --> [].
-assertion__in_interface_check(unify(Var,RHS,_,_,_) - GoalInfo,
- PredInfo, Module0, Module) -->
- { goal_info_get_context(GoalInfo, Context) },
+assertion__in_interface_check(generic_call(_, _, _, _) - _, _,
+ !Module, !IO).
+assertion__in_interface_check(unify(Var, RHS, _, _, _) - GoalInfo,
+ PredInfo, !Module, !IO) :-
+ goal_info_get_context(GoalInfo, Context),
assertion__in_interface_check_unify_rhs(RHS, Var, Context,
- PredInfo, Module0, Module).
-assertion__in_interface_check(foreign_proc(_,PredId,_,_,_,_,_) -
- GoalInfo, _PredInfo, Module0, Module) -->
- { module_info_pred_info(Module0, PredId, PragmaPredInfo) },
- { pred_info_import_status(PragmaPredInfo, ImportStatus) },
- (
- { is_defined_in_implementation_section(ImportStatus, yes) }
- ->
- { goal_info_get_context(GoalInfo, Context) },
- { PredOrFunc = pred_info_is_pred_or_func(PragmaPredInfo) },
- { Name = pred_info_name(PragmaPredInfo) },
- { SymName = unqualified(Name) },
- { Arity = pred_info_arity(PragmaPredInfo) },
+ PredInfo, !Module, !IO).
+assertion__in_interface_check(foreign_proc(_, PredId, _, _, _, _, _) -
+ GoalInfo, _PredInfo, !Module, !IO) :-
+ module_info_pred_info(!.Module, PredId, PragmaPredInfo),
+ pred_info_import_status(PragmaPredInfo, ImportStatus),
+ ( is_defined_in_implementation_section(ImportStatus) = yes ->
+ goal_info_get_context(GoalInfo, Context),
+ PredOrFunc = pred_info_is_pred_or_func(PragmaPredInfo),
+ Name = pred_info_name(PragmaPredInfo),
+ SymName = unqualified(Name),
+ Arity = pred_info_arity(PragmaPredInfo),
write_assertion_interface_error(Context,
- call(PredOrFunc, SymName, Arity),
- Module0, Module)
+ call(PredOrFunc, SymName, Arity), !Module, !IO)
;
- { Module = Module0 }
+ true
).
-assertion__in_interface_check(conj(Goals) - _, PredInfo, Module0, Module) -->
- assertion__in_interface_check_list(Goals, PredInfo, Module0, Module).
-assertion__in_interface_check(switch(_,_,_) - _, _, _, _) -->
- { error("assertion__in_interface_check: assertion contains switch.") }.
-assertion__in_interface_check(disj(Goals) - _, PredInfo, Module0, Module) -->
- assertion__in_interface_check_list(Goals, PredInfo, Module0, Module).
-assertion__in_interface_check(not(Goal) - _, PredInfo, Module0, Module) -->
- assertion__in_interface_check(Goal, PredInfo, Module0, Module).
-assertion__in_interface_check(some(_,_,Goal) - _, PredInfo, Module0, Module) -->
- assertion__in_interface_check(Goal, PredInfo, Module0, Module).
+assertion__in_interface_check(conj(Goals) - _, PredInfo, !Module, !IO) :-
+ assertion__in_interface_check_list(Goals, PredInfo, !Module, !IO).
+assertion__in_interface_check(switch(_, _, _) - _, _, _, _, !IO) :-
+ error("assertion__in_interface_check: assertion contains switch.").
+assertion__in_interface_check(disj(Goals) - _, PredInfo, !Module, !IO) :-
+ assertion__in_interface_check_list(Goals, PredInfo, !Module, !IO).
+assertion__in_interface_check(not(Goal) - _, PredInfo, !Module, !IO) :-
+ assertion__in_interface_check(Goal, PredInfo, !Module, !IO).
+assertion__in_interface_check(some(_, _, Goal) - _, PredInfo, !Module, !IO) :-
+ assertion__in_interface_check(Goal, PredInfo, !Module, !IO).
assertion__in_interface_check(if_then_else(_, If, Then, Else) - _,
- PredInfo, Module0, Module) -->
- assertion__in_interface_check(If, PredInfo, Module0, Module1),
- assertion__in_interface_check(Then, PredInfo, Module1, Module2),
- assertion__in_interface_check(Else, PredInfo, Module2, Module).
-assertion__in_interface_check(par_conj(Goals) - _, PredInfo,
- Module0, Module) -->
- assertion__in_interface_check_list(Goals, PredInfo, Module0, Module).
+ PredInfo, !Module, !IO) :-
+ assertion__in_interface_check(If, PredInfo, !Module, !IO),
+ assertion__in_interface_check(Then, PredInfo, !Module, !IO),
+ assertion__in_interface_check(Else, PredInfo, !Module, !IO).
+assertion__in_interface_check(par_conj(Goals) - _, PredInfo, !Module, !IO) :-
+ assertion__in_interface_check_list(Goals, PredInfo, !Module, !IO).
assertion__in_interface_check(shorthand(ShorthandGoal) - _GoalInfo, PredInfo,
- Module0, Module) -->
+ !Module, !IO) :-
assertion__in_interface_check_shorthand(ShorthandGoal,
- PredInfo, Module0, Module).
+ PredInfo, !Module, !IO).
:- pred assertion__in_interface_check_shorthand(shorthand_goal_expr::in,
pred_info::in, module_info::in, module_info::out,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
assertion__in_interface_check_shorthand(bi_implication(LHS, RHS), PredInfo,
- Module0, Module) -->
- assertion__in_interface_check(LHS, PredInfo, Module0, Module1),
- assertion__in_interface_check(RHS, PredInfo, Module1, Module).
+ !Module, !IO) :-
+ assertion__in_interface_check(LHS, PredInfo, !Module, !IO),
+ assertion__in_interface_check(RHS, PredInfo, !Module, !IO).
%-----------------------------------------------------------------------------%
:- pred assertion__in_interface_check_unify_rhs(unify_rhs::in, prog_var::in,
- prog_context::in, pred_info::in, module_info::in,
- module_info::out, io__state::di, io__state::uo) is det.
+ prog_context::in, pred_info::in, module_info::in, module_info::out,
+ io::di, io::uo) is det.
-assertion__in_interface_check_unify_rhs(var(_), _, _, _, Module, Module) --> [].
+assertion__in_interface_check_unify_rhs(var(_), _, _, _, !Module, !IO).
assertion__in_interface_check_unify_rhs(functor(ConsId, _, _), Var, Context,
- PredInfo, Module0, Module) -->
- { pred_info_clauses_info(PredInfo, ClausesInfo) },
- { clauses_info_vartypes(ClausesInfo, VarTypes) },
- { map__lookup(VarTypes, Var, Type) },
- (
- { type_to_ctor_and_args(Type, TypeCtor, _) }
- ->
- { module_info_types(Module0, Types) },
- { map__lookup(Types, TypeCtor, TypeDefn) },
- { hlds_data__get_type_defn_status(TypeDefn, TypeStatus) },
- (
- { is_defined_in_implementation_section(TypeStatus,
- yes) }
- ->
- write_assertion_interface_error(Context,
- cons(ConsId), Module0, Module)
+ PredInfo, !Module, !IO) :-
+ pred_info_clauses_info(PredInfo, ClausesInfo),
+ clauses_info_vartypes(ClausesInfo, VarTypes),
+ map__lookup(VarTypes, Var, Type),
+ ( type_to_ctor_and_args(Type, TypeCtor, _) ->
+ module_info_types(!.Module, Types),
+ map__lookup(Types, TypeCtor, TypeDefn),
+ hlds_data__get_type_defn_status(TypeDefn, TypeStatus),
+ ( is_defined_in_implementation_section(TypeStatus) = yes ->
+ write_assertion_interface_error(Context, cons(ConsId),
+ !Module, !IO)
;
- { Module = Module0 }
+ true
)
;
- { error("assertion__in_interface_check_unify_rhs: type_to_ctor_and_args failed.") }
+ error("assertion__in_interface_check_unify_rhs: " ++
+ "type_to_ctor_and_args failed.")
).
assertion__in_interface_check_unify_rhs(lambda_goal(_,_,_,_,_,_,_,_,Goal),
- _Var, _Context, PredInfo, Module0, Module) -->
- assertion__in_interface_check(Goal, PredInfo, Module0, Module).
+ _Var, _Context, PredInfo, !Module, !IO) :-
+ assertion__in_interface_check(Goal, PredInfo, !Module, !IO).
%-----------------------------------------------------------------------------%
:- pred assertion__in_interface_check_list(hlds_goals::in, pred_info::in,
- module_info::in, module_info::out,
- io__state::di, io__state::uo)is det.
+ module_info::in, module_info::out, io::di, io::uo)is det.
-assertion__in_interface_check_list([], _, Module, Module) --> [].
-assertion__in_interface_check_list([Goal0 | Goal0s], PredInfo,
- Module0, Module) -->
- assertion__in_interface_check(Goal0, PredInfo, Module0, Module1),
- assertion__in_interface_check_list(Goal0s, PredInfo, Module1, Module).
+assertion__in_interface_check_list([], _, !Module, !IO).
+assertion__in_interface_check_list([Goal0 | Goal0s], PredInfo, !Module, !IO) :-
+ assertion__in_interface_check(Goal0, PredInfo, !Module, !IO),
+ assertion__in_interface_check_list(Goal0s, PredInfo, !Module, !IO).
%-----------------------------------------------------------------------------%
%
- % is_defined_in_implementation_section
- %
% Returns yes if the import_status indicates the item came form
% the implementation section.
%
-:- pred is_defined_in_implementation_section(import_status::in,
- bool::out) is det.
+:- func is_defined_in_implementation_section(import_status) = bool.
-is_defined_in_implementation_section(abstract_exported, yes).
-is_defined_in_implementation_section(exported_to_submodules, yes).
-is_defined_in_implementation_section(local, yes).
-is_defined_in_implementation_section(imported(implementation), yes).
-
-is_defined_in_implementation_section(imported(interface), no).
-is_defined_in_implementation_section(imported(ancestor), no).
-is_defined_in_implementation_section(imported(ancestor_private_interface), no).
-is_defined_in_implementation_section(opt_imported, no).
-is_defined_in_implementation_section(abstract_imported, no).
-is_defined_in_implementation_section(pseudo_imported, no).
-is_defined_in_implementation_section(exported, no).
-is_defined_in_implementation_section(opt_exported, yes).
-is_defined_in_implementation_section(pseudo_exported, no).
+is_defined_in_implementation_section(abstract_exported) = yes.
+is_defined_in_implementation_section(exported_to_submodules) = yes.
+is_defined_in_implementation_section(local) = yes.
+is_defined_in_implementation_section(imported(implementation)) = yes.
+
+is_defined_in_implementation_section(imported(interface)) = no.
+is_defined_in_implementation_section(imported(ancestor)) = no.
+is_defined_in_implementation_section(imported(ancestor_private_interface)) = no.
+is_defined_in_implementation_section(opt_imported) = no.
+is_defined_in_implementation_section(abstract_imported) = no.
+is_defined_in_implementation_section(pseudo_imported) = no.
+is_defined_in_implementation_section(exported) = no.
+is_defined_in_implementation_section(opt_exported) = yes.
+is_defined_in_implementation_section(pseudo_exported) = no.
-is_defined_in_implementation_section(external(Status), IsDefined) :-
- is_defined_in_implementation_section(Status, IsDefined).
+is_defined_in_implementation_section(external(Status)) =
+ is_defined_in_implementation_section(Status).
%-----------------------------------------------------------------------------%
@@ -895,52 +857,42 @@
---> call(pred_or_func, sym_name, arity)
; cons(cons_id).
-:- pred write_assertion_interface_error(prog_context::in,
- call_or_consid::in, module_info::in, module_info::out,
- io__state::di, io__state::uo) is det.
-
-write_assertion_interface_error(Context, Type, Module0, Module) -->
- { module_info_incr_errors(Module0, Module) },
- { module_info_name(Module, ModuleName) },
- prog_out__write_context(Context),
- io__write_string("In interface for module `"),
- prog_out__write_sym_name(ModuleName),
- io__write_string("':\n"),
+:- pred write_assertion_interface_error(prog_context::in, call_or_consid::in,
+ module_info::in, module_info::out, io::di, io::uo) is det.
- prog_out__write_context(Context),
- io__write_string(" error: exported promise refers to "),
- (
- { Type = call(PredOrFunc, SymName, Arity) },
- hlds_out__write_simple_call_id(PredOrFunc, SymName, Arity),
- io__nl
- ;
- { Type = cons(ConsId) },
- io__write_string("constructor `"),
- hlds_out__write_cons_id(ConsId),
- io__write_string("'\n")
+write_assertion_interface_error(Context, Type, !Module, !IO) :-
+ module_info_incr_errors(!Module),
+ module_info_name(!.Module, ModuleName),
+ ModuleStr = describe_sym_name(ModuleName),
+ write_error_pieces(Context, 0,
+ [words("In interface for module"), fixed(ModuleStr ++ ":")],
+ !IO),
+
+ (
+ Type = call(PredOrFunc, SymName, Arity),
+ IdStr = simple_call_id_to_string(PredOrFunc, SymName, Arity)
+ ;
+ Type = cons(ConsId),
+ ConsIdStr = cons_id_to_string(ConsId),
+ IdStr = "constructor `" ++ ConsIdStr ++ "'"
),
- prog_out__write_context(Context),
- io__write_string(" which is defined in the implementation "),
- io__write_string("of module `"),
- prog_out__write_sym_name(ModuleName),
- io__write_string("'.\n"),
-
- globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
- (
- { VerboseErrors = yes }
- ->
- prog_out__write_context(Context),
- io__write_string(" Either move the promise into the "),
- io__write_string("implementation section\n"),
-
- prog_out__write_context(Context),
- io__write_string(" or move the definition "),
- io__write_string("into the interface.\n")
+ write_error_pieces_not_first_line(Context, 0,
+ [words("error: exported promise refers to"),
+ words(IdStr), words("which is defined in the "),
+ words("implementation section of module"),
+ fixed(ModuleStr ++ ".")], !IO),
+
+ globals__io_lookup_bool_option(verbose_errors, VerboseErrors, !IO),
+ (
+ VerboseErrors = yes,
+ write_error_pieces_not_first_line(Context, 0,
+ [words("Either move the promise into the "),
+ words("implementation section or move "),
+ words("the definition into the interface.")], !IO)
;
- []
+ VerboseErrors = no
).
-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/atsort.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/atsort.m,v
retrieving revision 1.12
diff -u -b -r1.12 atsort.m
--- compiler/atsort.m 20 Mar 2002 12:35:49 -0000 1.12
+++ compiler/atsort.m 3 Apr 2004 12:25:37 -0000
@@ -18,12 +18,26 @@
:- type relmap(T) == map(T, list(T)).
-:- pred atsort(relmap(T), relmap(T), relmap(T), relmap(T), list(T),
- list(list(T))).
-:- mode atsort(in, in, in, in, in, out) is det.
+ % atsort(Succmap, Predmap, MustSuccmap, MustPredmap, PrefOrder,
+ % Sortlist):
+ %
+ % Succmap and Predmap describe the graph to sort: they map nodes to
+ % the list of their successors and predecessors respectively. This
+ % graph may have cycles. MustSuccmap and MustPredmap describe an
+ % acyclic subset of this graph. The final node order, Sortlist, must
+ % obey the order described by MustSuccmap and MustPredmap. PrefOrder
+ % gives a preference for the order of the nodes.
+
+:- pred atsort(relmap(T)::in, relmap(T)::in, relmap(T)::in, relmap(T)::in,
+ list(T)::in, list(list(T))::out) is det.
+
+ % atsort__closure(Nodes, Map, Reachable):
+ %
+ % Set Reachable to the set of nodes reachable from Nodes via Map.
+ % Reachable is in no particular order, and won't include members of
+ % Nodes unless they are reachable from other members.
-:- pred atsort__closure(list(T), relmap(T), list(T)).
-:- mode atsort__closure(in, in, out) is det.
+:- pred atsort__closure(list(T)::in, relmap(T)::in, list(T)::out) is det.
%-----------------------------------------------------------------------------%
@@ -65,9 +79,8 @@
atsort__main(Nodelist, Succmap, Predmap, MustSuccmap, MustPredmap,
PrefOrder, Sortlist).
-:- pred atsort__main(list(T), relmap(T), relmap(T), relmap(T), relmap(T),
- list(T), list(list(T))).
-:- mode atsort__main(in, in, in, in, in, in, out) is det.
+:- pred atsort__main(list(T)::in, relmap(T)::in, relmap(T)::in,
+ relmap(T)::in, relmap(T)::in, list(T)::in, list(list(T))::out) is det.
atsort__main(Nodes0, Succmap0, Predmap0, MustSuccmap, MustPredmap, PrefOrder,
Sorted) :-
@@ -95,9 +108,10 @@
%-----------------------------------------------------------------------------%
-:- pred atsort__choose(list(T), relmap(T), relmap(T), relmap(T), relmap(T),
- relmap(T), relmap(T), list(T), T, list(T)).
-:- mode atsort__choose(in, in, out, in, out, in, in, in, out, out) is det.
+:- pred atsort__choose(list(T)::in,
+ relmap(T)::in, relmap(T)::out, relmap(T)::in, relmap(T)::out,
+ relmap(T)::in, relmap(T)::in, list(T)::in, T::out, list(T)::out)
+ is det.
atsort__choose(Nodes, Succmap0, Succmap, Predmap0, Predmap,
_MustSuccmap, MustPredmap, PrefOrder, Chosen, NotChosen) :-
@@ -114,9 +128,8 @@
% See whether this node can be chosen ahead of the given list of nodes.
% Do not give preference to nodes that occur in MustPredmap.
-:- pred atsort__can_choose(list(T), list(T), relmap(T), list(T), list(T)).
-% :- mode atsort__can_choose(in, in, in, di, uo) is det.
-:- mode atsort__can_choose(in, in, in, in, out) is det.
+:- pred atsort__can_choose(list(T)::in, list(T)::in, relmap(T)::in,
+ list(T)::in, list(T)::out) is det.
atsort__can_choose([], _All, _MustPredmap, CanChoose, CanChoose).
atsort__can_choose([Node | Nodes], All, MustPredmap, CanChoose0, CanChoose) :-
@@ -133,16 +146,14 @@
% None of the members of the first list occur in the second.
-:- pred atsort__must_avoid(list(T), list(T)).
-:- mode atsort__must_avoid(in, in) is semidet.
+:- pred atsort__must_avoid(list(T)::in, list(T)::in) is semidet.
atsort__must_avoid([], _).
atsort__must_avoid([Head | Tail], Avoidlist) :-
\+ list__member(Head, Avoidlist),
atsort__must_avoid(Tail, Avoidlist).
-:- pred atsort__choose_pref(list(T), list(T), T).
-:- mode atsort__choose_pref(in, in, out) is det.
+:- pred atsort__choose_pref(list(T)::in, list(T)::in, T::out) is det.
atsort__choose_pref([], _CanChoose, _Chosen) :-
error("cannot choose any node in atsort").
@@ -155,13 +166,10 @@
%-----------------------------------------------------------------------------%
-:- pred atsort__repeat_source_sink(list(T),
- relmap(T), relmap(T), relmap(T), relmap(T),
- list(list(T)), list(list(T)), list(T), list(list(T)), list(list(T))).
-% :- mode atsort__repeat_source_sink(in, di, uo, di, uo,
-% di, uo, out, di, uo) is det.
-:- mode atsort__repeat_source_sink(in, in, out, in, out,
- in, out, out, in, out) is det.
+:- pred atsort__repeat_source_sink(list(T)::in,
+ relmap(T)::in, relmap(T)::out, relmap(T)::in, relmap(T)::out,
+ list(list(T))::in, list(list(T))::out, list(T)::out,
+ list(list(T))::in, list(list(T))::out) is det.
atsort__repeat_source_sink(Nodes0, Succmap0, Succmap, Predmap0, Predmap,
Source0, Source, Mid, Sink0, Sink) :-
@@ -201,85 +209,67 @@
%-----------------------------------------------------------------------------%
-:- pred atsort__source_sink(list(T), relmap(T), relmap(T),
- list(T), list(T), list(T), list(T), list(T), list(T)).
-% :- mode atsort__source_sink(in, in, in, di, uo, di, uo, di, uo) is det.
-:- mode atsort__source_sink(in, in, in, in, out, in, out, in, out) is det.
-
-atsort__source_sink([], _, _, Source, Source, Mid, Mid, Sink, Sink).
-atsort__source_sink([Node | Nodes], Succmap, Predmap,
- Source0, Source, Mid0, Mid, Sink0, Sink) :-
+:- pred atsort__source_sink(list(T)::in, relmap(T)::in, relmap(T)::in,
+ list(T)::in, list(T)::out, list(T)::in, list(T)::out,
+ list(T)::in, list(T)::out) is det.
+
+atsort__source_sink([], _, _, !Source, !Mid, !Sink).
+atsort__source_sink([Node | Nodes], Succmap, Predmap, !Source, !Mid, !Sink) :-
(
map__search(Succmap, Node, Succnodes),
Succnodes = []
->
- Source1 = Source0,
- Mid1 = Mid0,
- Sink1 = [Node | Sink0]
+ !:Sink = [Node | !.Sink]
;
map__search(Predmap, Node, Prednodes),
Prednodes = []
->
- Source1 = [Node | Source0],
- Mid1 = Mid0,
- Sink1 = Sink0
- ;
- Source1 = Source0,
- Mid1 = [Node | Mid0],
- Sink1 = Sink0
+ !:Source = [Node | !.Source]
+ ;
+ !:Mid = [Node | !.Mid]
),
- atsort__source_sink(Nodes, Succmap, Predmap,
- Source1, Source, Mid1, Mid, Sink1, Sink).
+ atsort__source_sink(Nodes, Succmap, Predmap, !Source, !Mid, !Sink).
%-----------------------------------------------------------------------------%
-:- pred atsort__map_delete_all_source_links(list(T),
- relmap(T), relmap(T), relmap(T)).
-% :- mode atsort__map_delete_all_source_links(in, in, di, uo) is det.
-:- mode atsort__map_delete_all_source_links(in, in, in, out) is det.
-
-atsort__map_delete_all_source_links([], _Succmap, Predmap, Predmap).
-atsort__map_delete_all_source_links([Source | Sources],
- Succmap, Predmap0, Predmap) :-
+:- pred atsort__map_delete_all_source_links(list(T)::in,
+ relmap(T)::in, relmap(T)::in, relmap(T)::out) is det.
+
+atsort__map_delete_all_source_links([], _Succmap, !Predmap).
+atsort__map_delete_all_source_links([Source | Sources], Succmap, !Predmap) :-
map__lookup(Succmap, Source, Succnodes),
- atsort__map_delete_this_element(Succnodes, Source, Predmap0, Predmap1),
- atsort__map_delete_all_source_links(Sources,
- Succmap, Predmap1, Predmap).
-
-:- pred atsort__map_delete_all_sink_links(list(T),
- relmap(T), relmap(T), relmap(T)).
-% :- mode atsort__map_delete_all_sink_links(in, in, di, uo) is det.
-:- mode atsort__map_delete_all_sink_links(in, in, in, out) is det.
-
-atsort__map_delete_all_sink_links([], _Predmap, Succmap, Succmap).
-atsort__map_delete_all_sink_links([Sink | Sinks],
- Predmap, Succmap0, Succmap) :-
+ atsort__map_delete_this_element(Succnodes, Source, !Predmap),
+ atsort__map_delete_all_source_links(Sources, Succmap, !Predmap).
+
+:- pred atsort__map_delete_all_sink_links(list(T)::in,
+ relmap(T)::in, relmap(T)::in, relmap(T)::out) is det.
+
+atsort__map_delete_all_sink_links([], _Predmap, !Succmap).
+atsort__map_delete_all_sink_links([Sink | Sinks], Predmap, !Succmap) :-
map__lookup(Predmap, Sink, Prednodes),
- atsort__map_delete_this_element(Prednodes, Sink, Succmap0, Succmap1),
- atsort__map_delete_all_sink_links(Sinks,
- Predmap, Succmap1, Succmap).
-
-:- pred atsort__map_delete_this_element(list(T), T, relmap(T), relmap(T)).
-:- mode atsort__map_delete_this_element(in, in, in, out) is det.
-
-atsort__map_delete_this_element([], _, Map, Map).
-atsort__map_delete_this_element([Node | Nodes], Elt, Map0, Map) :-
- ( map__search(Map0, Node, List0) ->
+ atsort__map_delete_this_element(Prednodes, Sink, !Succmap),
+ atsort__map_delete_all_sink_links(Sinks, Predmap, !Succmap).
+
+:- pred atsort__map_delete_this_element(list(T)::in, T::in,
+ relmap(T)::in, relmap(T)::out) is det.
+
+atsort__map_delete_this_element([], _, !Map).
+atsort__map_delete_this_element([Node | Nodes], Elt, !Map) :-
+ ( map__search(!.Map, Node, List0) ->
list__delete_all(List0, Elt, List1),
- map__det_update(Map0, Node, List1, Map1)
+ map__det_update(!.Map, Node, List1, !:Map)
;
- Map1 = Map0
+ true
),
- atsort__map_delete_this_element(Nodes, Elt, Map1, Map).
+ atsort__map_delete_this_element(Nodes, Elt, !Map).
+
+:- pred atsort__map_delete_all_nodes(list(T)::in,
+ relmap(T)::in, relmap(T)::out) is det.
-:- pred atsort__map_delete_all_nodes(list(T), relmap(T), relmap(T)).
-% :- mode atsort__map_delete_all_nodes(in, di, uo) is det.
-:- mode atsort__map_delete_all_nodes(in, in, out) is det.
-
-atsort__map_delete_all_nodes([], Map, Map).
-atsort__map_delete_all_nodes([Node | Nodes], Map0, Map) :-
- map__delete(Map0, Node, Map1),
- atsort__map_delete_all_nodes(Nodes, Map1, Map).
+atsort__map_delete_all_nodes([], !Map).
+atsort__map_delete_all_nodes([Node | Nodes], !Map) :-
+ map__delete(!.Map, Node, !:Map),
+ atsort__map_delete_all_nodes(Nodes, !Map).
%-----------------------------------------------------------------------------%
@@ -292,33 +282,29 @@
% XXX Should think about making Reachable be a bintree set.
-:- pred atsort__closure_2(list(T), relmap(T), list(T), list(T)).
-% :- mode atsort__closure_2(in, in, di, uo) is det.
-:- mode atsort__closure_2(in, in, in, out) is det.
-
-atsort__closure_2([], _, Reachable, Reachable).
-atsort__closure_2([Node | Nodes0], Map, Reachable0, Reachable) :-
- ( list__member(Node, Reachable0) ->
- Nodes1 = Nodes0,
- Reachable1 = Reachable0
+:- pred atsort__closure_2(list(T)::in, relmap(T)::in,
+ list(T)::in, list(T)::out) is det.
+
+atsort__closure_2([], _, !Reachable).
+atsort__closure_2([Node | Nodes0], Map, !Reachable) :-
+ ( list__member(Node, !.Reachable) ->
+ Nodes1 = Nodes0
;
map__lookup(Map, Node, Neighbours),
atsort__maybe_insert(Neighbours, Nodes0, Nodes1),
- Reachable1 = [Node | Reachable0]
+ !:Reachable = [Node | !.Reachable]
),
- atsort__closure_2(Nodes1, Map, Reachable1, Reachable).
+ atsort__closure_2(Nodes1, Map, !Reachable).
+
+:- pred atsort__maybe_insert(list(T)::in, list(T)::in, list(T)::out) is det.
-:- pred atsort__maybe_insert(list(T), list(T), list(T)).
-% :- mode atsort__maybe_insert(in, di, uo) is det.
-:- mode atsort__maybe_insert(in, in, out) is det.
-
-atsort__maybe_insert([], List, List).
-atsort__maybe_insert([Node | Nodes], List0, List) :-
- ( list__member(Node, List0) ->
- List1 = List0
+atsort__maybe_insert([], !List).
+atsort__maybe_insert([Node | Nodes], !List) :-
+ ( list__member(Node, !.List) ->
+ !:List = !.List
;
- List1 = [Node | List0]
+ !:List = [Node | !.List]
),
- atsort__maybe_insert(Nodes, List1, List).
+ atsort__maybe_insert(Nodes, !List).
%-----------------------------------------------------------------------------%
Index: compiler/c_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/c_util.m,v
retrieving revision 1.18
diff -u -b -r1.18 c_util.m
--- compiler/c_util.m 26 May 2003 08:59:50 -0000 1.18
+++ compiler/c_util.m 4 Apr 2004 06:37:34 -0000
@@ -33,14 +33,12 @@
% emit a #line directive to set the specified filename & linenum
% so that C compiler error messages etc. will refer to the
% correct location in the original source file location.
-:- pred c_util__set_line_num(string, int, io__state, io__state).
-:- mode c_util__set_line_num(in, in, di, uo) is det.
+:- pred c_util__set_line_num(string::in, int::in, io::di, io::uo) is det.
% emit a #line directive to cancel the effect of any previous
% #line directives, so that C compiler error messages etc. will
% refer to the appropriate location in the generated .c file.
-:- pred c_util__reset_line_num(io__state, io__state).
-:- mode c_util__reset_line_num(di, uo) is det.
+:- pred c_util__reset_line_num(io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%
@@ -50,34 +48,29 @@
% Print out a string suitably escaped for use as a C string literal.
% This doesn't actually print out the enclosing double quotes --
% that is the caller's responsibility.
-:- pred c_util__output_quoted_string(string, io__state, io__state).
-:- mode c_util__output_quoted_string(in, di, uo) is det.
+:- pred c_util__output_quoted_string(string::in, io::di, io::uo) is det.
% output_quoted_multi_string is like output_quoted_string
% except that the string may contain embedded NUL characters
% (i.e. '\0'). The int specifies the length of the string.
:- type multi_string == string.
-:- pred c_util__output_quoted_multi_string(int, multi_string,
- io__state, io__state).
-:- mode c_util__output_quoted_multi_string(in, in, di, uo) is det.
+:- pred c_util__output_quoted_multi_string(int::in, multi_string::in,
+ io::di, io::uo) is det.
% Print out a char suitably escaped for use as a C char literal.
% This doesn't actually print out the enclosing single quotes --
% that is the caller's responsibility.
-:- pred c_util__output_quoted_char(char, io__state, io__state).
-:- mode c_util__output_quoted_char(in, di, uo) is det.
+:- pred c_util__output_quoted_char(char::in, io::di, io::uo) is det.
% Convert a string to a form that is suitably escaped for use as a
% C string literal. This doesn't actually add the enclosing double
% quotes -- that is the caller's responsibility.
-:- pred c_util__quote_string(string, string).
-:- mode c_util__quote_string(in, out) is det.
+:- pred c_util__quote_string(string::in, string::out) is det.
% Convert a character to a form that is suitably escaped for use as a
% C character literal. This doesn't actually add the enclosing single
% quotes -- that is the caller's responsibility.
-:- pred c_util__quote_char(char, string).
-:- mode c_util__quote_char(in, out) is det.
+:- pred c_util__quote_char(char::in, string::out) is det.
%-----------------------------------------------------------------------------%
%
@@ -106,45 +99,38 @@
% The operator returned will be <, >, etc.;
% it can be used in the form `strcmp(<Arg1>, <Arg2>) <Op> 0'.
%
-:- pred c_util__string_compare_op(binary_op, string).
-:- mode c_util__string_compare_op(in, out) is semidet.
+:- pred c_util__string_compare_op(binary_op::in, string::out) is semidet.
% The operator returned will be +, *, etc.;
% the arguments should be floats and the result will be a float.
-:- pred c_util__float_op(binary_op, string).
-:- mode c_util__float_op(in, out) is semidet.
+:- pred c_util__float_op(binary_op::in, string::out) is semidet.
% The operator returned will be <, >, etc.;
% the arguments should be floats and the result will be a boolean.
-:- pred c_util__float_compare_op(binary_op, string).
-:- mode c_util__float_compare_op(in, out) is semidet.
+:- pred c_util__float_compare_op(binary_op::in, string::out) is semidet.
% The operator returned will be an infix operator.
% The arguments should be cast to MR_Unsigned,
% and the result will be a boolean.
-:- pred c_util__unsigned_compare_op(binary_op, string).
-:- mode c_util__unsigned_compare_op(in, out) is semidet.
+:- pred c_util__unsigned_compare_op(binary_op::in, string::out) is semidet.
% The operator returned will be either a prefix operator
% or a macro or function name. The operand needs
% to be placed in parentheses after the operator name.
-:- pred c_util__unary_prefix_op(unary_op, string).
-:- mode c_util__unary_prefix_op(in, out) is det.
+:- pred c_util__unary_prefix_op(unary_op::in, string::out) is det.
% The operator returned will be an infix operator.
% The arguments should be integer or booleans
% and the result will be an integer or a boolean.
-:- pred c_util__binary_infix_op(binary_op, string).
-:- mode c_util__binary_infix_op(in, out) is semidet.
+:- pred c_util__binary_infix_op(binary_op::in, string::out) is semidet.
%-----------------------------------------------------------------------------%
% Currently the `.rlo' files are stored as static data in the
% executable. It may be better to store them in separate files
% in a known location and load them at runtime.
-:- pred c_util__output_rl_file(module_name, maybe(rl_file),
- io__state, io__state).
-:- mode c_util__output_rl_file(in, in, di, uo) is det.
+:- pred c_util__output_rl_file(module_name::in, maybe(rl_file)::in,
+ io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
@@ -155,8 +141,8 @@
% configuration. SourceFileName is the name of the file from
% which the C is generated, while Version is the version name
% of the mercury compiler.
-:- pred output_c_file_intro_and_grade(string, string, io__state, io__state).
-:- mode output_c_file_intro_and_grade(in, in, di, uo) is det.
+:- pred output_c_file_intro_and_grade(string::in, string::in,
+ io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -174,44 +160,43 @@
% Line numbering.
%
-c_util__set_line_num(File, Line) -->
- globals__io_lookup_bool_option(line_numbers, LineNumbers),
- ( { LineNumbers = yes } ->
+c_util__set_line_num(File, Line, !IO) :-
+ globals__io_lookup_bool_option(line_numbers, LineNumbers, !IO),
+ ( LineNumbers = yes ->
(
- { Line > 0 },
- { File \= "" }
+ Line > 0,
+ File \= ""
->
- io__write_string("#line "),
- io__write_int(Line),
- io__write_string(" """),
- c_util__output_quoted_string(File),
- io__write_string("""\n")
+ io__write_string("#line ", !IO),
+ io__write_int(Line, !IO),
+ io__write_string(" """, !IO),
+ c_util__output_quoted_string(File, !IO),
+ io__write_string("""\n", !IO)
;
- c_util__reset_line_num
+ c_util__reset_line_num(!IO)
)
;
- []
+ true
).
-c_util__reset_line_num -->
+c_util__reset_line_num(!IO) :-
% We want to generate another #line directive to reset the C compiler's
% idea of what it is processing back to the file we are generating.
- io__get_output_line_number(Line),
- io__output_stream_name(FileName),
- globals__io_lookup_bool_option(line_numbers, LineNumbers),
+ io__get_output_line_number(Line, !IO),
+ io__output_stream_name(FileName, !IO),
+ globals__io_lookup_bool_option(line_numbers, LineNumbers, !IO),
(
- { Line > 0 },
- { FileName \= "" },
- { LineNumbers = yes }
+ Line > 0,
+ FileName \= "",
+ LineNumbers = yes
->
- io__write_string("#line "),
- { NextLine = Line + 1 },
- io__write_int(NextLine),
- io__write_string(" """),
- c_util__output_quoted_string(FileName),
- io__write_string("""\n")
+ io__write_string("#line ", !IO),
+ io__write_int(Line + 1, !IO),
+ io__write_string(" """, !IO),
+ c_util__output_quoted_string(FileName, !IO),
+ io__write_string("""\n", !IO)
;
- []
+ true
).
%-----------------------------------------------------------------------------%
@@ -222,40 +207,40 @@
% trigraph sequences in string literals.
%
-c_util__output_quoted_string(S0) -->
- c_util__output_quoted_multi_string(string__length(S0), S0).
+c_util__output_quoted_string(S0, !IO) :-
+ c_util__output_quoted_multi_string(string__length(S0), S0, !IO).
-c_util__output_quoted_multi_string(Len, S) -->
- c_util__output_quoted_multi_string_2(0, Len, S).
+c_util__output_quoted_multi_string(Len, S, !IO) :-
+ c_util__output_quoted_multi_string_2(0, Len, S, !IO).
:- pred c_util__output_quoted_multi_string_2(int::in, int::in, string::in,
io__state::di, io__state::uo) is det.
-c_util__output_quoted_multi_string_2(Cur, Len, S) -->
- ( { Cur < Len } ->
+c_util__output_quoted_multi_string_2(Cur, Len, S, !IO) :-
+ ( Cur < Len ->
% Avoid a limitation in the MSVC compiler where
% string literals can be no longer then 2048
% chars. However if you output the string in
% chunks, eg "part a" "part b" it will accept a
% string longer then 2048 chars, go figure!
- ( { Cur \= 0, Cur mod 512 = 0 } ->
- io__write_string("\" \"")
+ ( Cur \= 0, Cur mod 512 = 0 ->
+ io__write_string("\" \"", !IO)
;
- []
+ true
),
% we must use unsafe index, because we want to be able
% to access chars beyond the first NUL
- { string__unsafe_index(S, Cur, Char) },
- c_util__output_quoted_char(Char),
- output_quoted_multi_string_2(Cur + 1, Len, S)
+ string__unsafe_index(S, Cur, Char),
+ c_util__output_quoted_char(Char, !IO),
+ output_quoted_multi_string_2(Cur + 1, Len, S, !IO)
;
- []
+ true
).
-c_util__output_quoted_char(Char) -->
- { c_util__quote_char(Char, EscapedChars) },
- io__write_string(EscapedChars).
+c_util__output_quoted_char(Char, !IO) :-
+ c_util__quote_char(Char, EscapedChars),
+ io__write_string(EscapedChars, !IO).
c_util__quote_char(Char, QuotedChar) :-
c_util__quote_one_char(Char, [], RevQuotedChar),
@@ -267,6 +252,7 @@
:- pred c_util__quote_one_char(char::in, list(char)::in, list(char)::out)
is det.
+
c_util__quote_one_char(Char, RevChars0, RevChars) :-
( c_util__escape_special_char(Char, EscapeChar) ->
RevChars = [EscapeChar, '\\' | RevChars0]
@@ -280,6 +266,7 @@
).
:- pred c_util__escape_special_char(char::in, char::out) is semidet.
+
c_util__escape_special_char('"', '"').
c_util__escape_special_char('\\', '\\').
c_util__escape_special_char('\n', 'n').
@@ -290,30 +277,32 @@
c_util__escape_special_char('\r', 'r').
c_util__escape_special_char('\f', 'f').
-% This succeeds iff the specified character is allowed as an (unescaped)
-% character in standard-conforming C source code.
+ % This succeeds iff the specified character is allowed as an (unescaped)
+ % character in standard-conforming C source code.
+
:- pred c_util__is_c_source_char(char::in) is semidet.
+
c_util__is_c_source_char(Char) :-
( char__is_alnum(Char)
; string__contains_char(c_graphic_chars, Char)
).
-% This returns a string containing all the characters that the C standard
-% specifies as being included in the "basic execution character set",
-% except for the letters (a-z A-Z) and digits (0-9).
+ % This returns a string containing all the characters that the C
+ % standard specifies as being included in the "basic execution
+ % character set", except for the letters (a-z A-Z) and digits (0-9).
+
:- func c_graphic_chars = string.
-c_graphic_chars = " !\"#%&'()*+,-./:;<=>?[\\]^_{|}~".
+c_graphic_chars = " !\"#%&'()*+,-./:;<=>?[\\]^_{|}~".
% reverse_append(Xs, Ys, Zs) <=> Zs = list__reverse(Xs) ++ Ys.
-:- pred reverse_append(list(T), list(T), list(T)).
-:- mode reverse_append(in, in, out) is det.
+:- pred reverse_append(list(T)::in, list(T)::in, list(T)::out) is det.
+
reverse_append([], L, L).
-reverse_append([X|Xs], L0, L) :-
- reverse_append(Xs, [X|L0], L).
+reverse_append([X | Xs], L0, L) :-
+ reverse_append(Xs, [X | L0], L).
-:- pred escape_any_char(char, list(char)).
-:- mode escape_any_char(in, out) is det.
+:- pred escape_any_char(char::in, list(char)::out) is det.
% Convert a character to the corresponding C octal escape code.
% XXX This assumes that the target language compiler's representation
@@ -340,8 +329,8 @@
%
make_float_literal(Float) = string__format("%#.17g", [f(Float)]).
-output_float_literal(Float) -->
- io__write_string(make_float_literal(Float)).
+output_float_literal(Float, !IO) :-
+ io__write_string(make_float_literal(Float), !IO).
%-----------------------------------------------------------------------------%
%
@@ -433,8 +422,7 @@
io__write_string(";\n\n")
).
-:- pred c_util__output_rl_byte(int, io__state, io__state).
-:- mode c_util__output_rl_byte(in, di, uo) is det.
+:- pred c_util__output_rl_byte(int::in, io::di, io::uo) is det.
c_util__output_rl_byte(Byte) -->
io__write_int(Byte),
@@ -448,9 +436,10 @@
globals__io_lookup_bool_option(unboxed_float, UnboxedFloat),
{ UnboxedFloatStr = convert_bool_to_string(UnboxedFloat) },
- io__write_strings(["/*\n",
- "** Automatically generated from `", SourceFileName,
- "' by the Mercury compiler,\n",
+ io__write_strings([
+ "/*\n",
+ "** Automatically generated from `", SourceFileName, "'\n",
+ "** by the Mercury compiler,\n",
"** version ", Version, ".\n",
"** Do not edit.\n",
"**\n",
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.56
diff -u -b -r1.56 check_typeclass.m
--- compiler/check_typeclass.m 23 Mar 2004 10:52:01 -0000 1.56
+++ compiler/check_typeclass.m 4 Apr 2004 07:40:53 -0000
@@ -116,15 +116,14 @@
).
% check all the instances of one class.
-:- pred check_one_class(class_table,
- pair(class_id, list(hlds_instance_defn)),
- pair(class_id, list(hlds_instance_defn)),
- check_tc_info, check_tc_info,
- io__state, io__state).
-:- mode check_one_class(in, in, out, in, out, di, uo) is det.
+:- pred check_one_class(class_table::in,
+ pair(class_id, list(hlds_instance_defn))::in,
+ pair(class_id, list(hlds_instance_defn))::out,
+ check_tc_info::in, check_tc_info::out,
+ io::di, io::uo) is det.
check_one_class(ClassTable, ClassId - InstanceDefns0,
- ClassId - InstanceDefns, CheckTCInfo0, CheckTCInfo, IO0, IO) :-
+ ClassId - InstanceDefns, !CheckTCInfo, !IO) :-
map__lookup(ClassTable, ClassId, ClassDefn),
ClassDefn = hlds_class_defn(ImportStatus, SuperClasses, ClassVars,
@@ -142,11 +141,10 @@
words(string__append_list(["`", ClassNameStr, "'."]))
],
- Messages0 = CheckTCInfo0 ^ error_messages,
- CheckTCInfo = CheckTCInfo0 ^ error_messages :=
+ Messages0 = !.CheckTCInfo ^ error_messages,
+ !:CheckTCInfo = !.CheckTCInfo ^ error_messages :=
[TermContext - ErrorPieces | Messages0],
- InstanceDefns = InstanceDefns0,
- IO = IO0
+ InstanceDefns = InstanceDefns0
;
solutions(
(pred(PredId::out) is nondet :-
@@ -159,38 +157,58 @@
ClassVars, ClassInterface, Interface,
ClassVarSet, PredIds),
InstanceDefns0, InstanceDefns,
- CheckTCInfo0, CheckTCInfo,
- IO0, IO)
+ !CheckTCInfo, !IO)
).
% check one instance of one class
-:- pred check_class_instance(class_id, list(class_constraint), list(tvar),
- hlds_class_interface, class_interface, tvarset, list(pred_id),
- hlds_instance_defn, hlds_instance_defn,
- check_tc_info, check_tc_info,
- io__state, io__state).
-:- mode check_class_instance(in, in, in, in, in, in, in, in, out, in, out,
- di, uo) is det.
+:- pred check_class_instance(class_id::in, list(class_constraint)::in,
+ list(tvar)::in, hlds_class_interface::in, class_interface::in,
+ tvarset::in, list(pred_id)::in,
+ hlds_instance_defn::in, hlds_instance_defn::out,
+ check_tc_info::in, check_tc_info::out,
+ io::di, io::uo) is det.
check_class_instance(ClassId, SuperClasses, Vars, HLDSClassInterface,
- ClassInterface, ClassVarSet, PredIds, InstanceDefn0,
- InstanceDefn,
+ ClassInterface, ClassVarSet, PredIds,
+ InstanceDefn0, InstanceDefn,
check_tc_info(Errors0, ModuleInfo0, QualInfo0),
check_tc_info(Errors, ModuleInfo, QualInfo),
- IO0, IO):-
+ !IO):-
% check conformance of the instance body
InstanceDefn0 = hlds_instance_defn(_, _, TermContext, _, _,
InstanceBody, _, _, _),
(
InstanceBody = abstract,
- InstanceDefn2 = InstanceDefn0,
- ModuleInfo1 = ModuleInfo0,
+ InstanceDefn1 = InstanceDefn0,
+ ModuleInfo = ModuleInfo0,
QualInfo = QualInfo0,
- Errors2 = Errors0,
- IO = IO0
+ Errors1 = Errors0
;
InstanceBody = concrete(InstanceMethods),
+ check_concrete_class_instance(ClassId, Vars,
+ HLDSClassInterface, ClassInterface,
+ PredIds, TermContext, InstanceMethods,
+ InstanceDefn0, InstanceDefn1, Errors0, Errors1,
+ ModuleInfo0, ModuleInfo, QualInfo0, QualInfo, !IO)
+ ),
+ % check that the superclass constraints are satisfied for the
+ % types in this instance declaration
+ check_superclass_conformance(ClassId, SuperClasses, Vars, ClassVarSet,
+ ModuleInfo, InstanceDefn1, InstanceDefn, Errors1, Errors).
+
+:- pred check_concrete_class_instance(class_id::in, list(tvar)::in,
+ hlds_class_interface::in, class_interface::in,
+ list(pred_id)::in, term__context::in,
+ instance_methods::in, hlds_instance_defn::in, hlds_instance_defn::out,
+ error_messages::in, error_messages::out,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
+ io::di, io::uo) is det.
+
+check_concrete_class_instance(ClassId, Vars, HLDSClassInterface,
+ ClassInterface, PredIds, TermContext,
+ InstanceMethods, !InstanceDefn, !Errors, !ModuleInfo,
+ !QualInfo, !IO) :-
(
ClassInterface = abstract,
ClassId = class_id(ClassName, ClassArity),
@@ -201,22 +219,17 @@
words("abstract typeclass"),
words(string__append_list(["`", ClassNameStr, "'."]))
],
- Errors2 = [TermContext - ErrorPieces | Errors0],
- InstanceDefn2 = InstanceDefn0,
- ModuleInfo1 = ModuleInfo0,
- QualInfo = QualInfo0,
- IO = IO0
+ !:Errors = [TermContext - ErrorPieces | !.Errors]
;
ClassInterface = concrete(_),
- InstanceCheckInfo0 = instance_check_info(InstanceDefn0,
- [], Errors0, ModuleInfo0, QualInfo0),
+ InstanceCheckInfo0 = instance_check_info(!.InstanceDefn,
+ [], !.Errors, !.ModuleInfo, !.QualInfo),
list__foldl2(
check_instance_pred(ClassId, Vars, HLDSClassInterface),
- PredIds, InstanceCheckInfo0, InstanceCheckInfo,
- IO0, IO),
- InstanceCheckInfo = instance_check_info(InstanceDefn1,
- RevInstanceMethods, Errors1, ModuleInfo1,
- QualInfo),
+ PredIds, InstanceCheckInfo0, InstanceCheckInfo, !IO),
+ InstanceCheckInfo = instance_check_info(!:InstanceDefn,
+ RevInstanceMethods, !:Errors, !:ModuleInfo,
+ !:QualInfo),
%
% We need to make sure that the MaybePredProcs field is
@@ -224,8 +237,7 @@
% handled by check_instance_pred, but we also need to handle
% it below, in case the class has no methods.
%
- InstanceDefn1 = hlds_instance_defn(A, B, C, D, E, _,
- MaybePredProcs1, H, I),
+ MaybePredProcs1 = !.InstanceDefn ^ instance_hlds_interface,
(
MaybePredProcs1 = yes(_),
MaybePredProcs = MaybePredProcs1
@@ -240,27 +252,19 @@
% relies on this
OrderedInstanceMethods = list__reverse(RevInstanceMethods),
- InstanceDefn2 = hlds_instance_defn(A, B, C, D, E,
- concrete(OrderedInstanceMethods),
- MaybePredProcs, H, I),
+ !:InstanceDefn = ((!.InstanceDefn
+ ^ instance_hlds_interface := MaybePredProcs)
+ ^ instance_body := concrete(OrderedInstanceMethods)),
%
% Check if there are any instance methods left over,
% which did not match any of the methods from the
% class interface.
%
- InstanceDefn2 = hlds_instance_defn(_, _, Context,
- _, _, _, _, _, _),
+ Context = !.InstanceDefn ^ instance_context,
check_for_bogus_methods(InstanceMethods, ClassId, PredIds,
- Context, ModuleInfo1, Errors1, Errors2)
- )
- ),
-
- % check that the superclass constraints are satisfied for the
- % types in this instance declaration
- check_superclass_conformance(ClassId, SuperClasses, Vars, ClassVarSet,
- InstanceDefn2, InstanceDefn,
- Errors2 - ModuleInfo1, Errors - ModuleInfo).
+ Context, !.ModuleInfo, !Errors)
+ ).
%
% Check if there are any instance methods left over,
@@ -268,18 +272,17 @@
% class interface. If so, add an appropriate error
% message to the list of error messages.
%
-:- pred check_for_bogus_methods(list(instance_method), class_id, list(pred_id),
- prog_context, module_info, error_messages, error_messages).
-:- mode check_for_bogus_methods(in, in, in, in, in, in, out) is det.
+:- pred check_for_bogus_methods(list(instance_method)::in, class_id::in,
+ list(pred_id)::in, prog_context::in, module_info::in,
+ error_messages::in, error_messages::out) is det.
check_for_bogus_methods(InstanceMethods, ClassId, ClassPredIds, Context,
- ModuleInfo1, Errors0, Errors) :-
+ ModuleInfo1, !Errors) :-
module_info_get_predicate_table(ModuleInfo1, PredTable),
DefnIsOK = (pred(Method::in) is semidet :-
% Find this method definition's p/f, name, arity
Method = instance_method(MethodPredOrFunc,
- MethodName, _MethodDefn,
- MethodArity, _Context),
+ MethodName, _MethodDefn, MethodArity, _Context),
% Search for pred_ids matching that p/f, name, arity,
% and succeed if the method definition p/f, name, and
% arity matches at least one of the methods from the
@@ -298,16 +301,14 @@
BogusInstanceMethods),
(
BogusInstanceMethods = []
- ->
- Errors = Errors0
;
+ BogusInstanceMethods = [_ | _],
%
% There were one or more bogus methods.
% Construct an appropriate error message.
%
ClassId = class_id(ClassName, ClassArity),
- prog_out__sym_name_to_string(ClassName,
- ClassNameString),
+ prog_out__sym_name_to_string(ClassName, ClassNameString),
string__int_to_string(ClassArity, ClassArityString),
string__append_list([
"In instance declaration for `",
@@ -320,20 +321,21 @@
ErrorMsgBody0),
ErrorMsgBody = list__append(ErrorMsgBody0, [words(".")]),
NewError = Context - [words(ErrorMsgStart) | ErrorMsgBody],
- Errors = [NewError | Errors0]
+ !:Errors = [NewError | !.Errors]
).
:- func format_method_name(instance_method) = string.
+
format_method_name(Method) = StringName :-
Method = instance_method(PredOrFunc, Name, _Defn, Arity, _Context),
adjust_func_arity(PredOrFunc, Arity, PredArity),
- hlds_out__simple_call_id_to_string(
- PredOrFunc - Name/PredArity, StringName).
+ StringName = hlds_out__simple_call_id_to_string(
+ PredOrFunc - Name/PredArity).
%----------------------------------------------------------------------------%
-:- type instance_check_info
- ---> instance_check_info(
+:- type instance_check_info --->
+ instance_check_info(
hlds_instance_defn,
instance_methods, % The instance methods in reverse
% order of the methods in the class
@@ -345,7 +347,8 @@
% This structure holds the information about a particular instance
% method
-:- type instance_method_info ---> instance_method_info(
+:- type instance_method_info --->
+ instance_method_info(
module_info,
qual_info,
sym_name, % Name that the
@@ -378,17 +381,15 @@
%----------------------------------------------------------------------------%
% check one pred in one instance of one class
-:- pred check_instance_pred(class_id, list(tvar), hlds_class_interface,
- pred_id, instance_check_info, instance_check_info,
- io__state, io__state).
-:- mode check_instance_pred(in,in, in, in, in, out, di, uo) is det.
+:- pred check_instance_pred(class_id::in, list(tvar)::in,
+ hlds_class_interface::in, pred_id::in,
+ instance_check_info::in, instance_check_info::out,
+ io::di, io::uo) is det.
check_instance_pred(ClassId, ClassVars, ClassInterface, PredId,
- InstanceCheckInfo0, InstanceCheckInfo, IO0, IO) :-
-
- InstanceCheckInfo0 = instance_check_info(InstanceDefn0,
- OrderedMethods0, Errors0, ModuleInfo0,
- QualInfo0),
+ !InstanceCheckInfo, !IO) :-
+ !.InstanceCheckInfo = instance_check_info(InstanceDefn0,
+ OrderedMethods0, Errors0, ModuleInfo0, QualInfo0),
solutions((pred(ProcId::out) is nondet :-
list__member(ClassProc, ClassInterface),
ClassProc = hlds_class_proc(PredId, ProcId)
@@ -403,9 +404,7 @@
% a member. Seeing that we are checking an instance
% declaration, we don't check that constraint... the instance
% declaration itself satisfies it!
- (
- ClassContext0 = constraints([_|OtherUnivCs], ExistCs)
- ->
+ ( ClassContext0 = constraints([_ | OtherUnivCs], ExistCs) ->
UnivCs = OtherUnivCs,
ClassContext = constraints(UnivCs, ExistCs)
;
@@ -441,19 +440,19 @@
make_introduced_pred_name(ClassId, MethodName, Arity,
InstanceTypes, PredName),
- Info0 = instance_method_info(ModuleInfo0, QualInfo0, PredName,
+ MethodInfo0 = instance_method_info(ModuleInfo0, QualInfo0, PredName,
Arity, ExistQVars, ArgTypes, ClassContext, ArgModes,
Errors0, ArgTypeVars, Status, PredOrFunc),
check_instance_pred_procs(ClassId, ClassVars, MethodName, Markers,
InstanceDefn0, InstanceDefn, OrderedMethods0, OrderedMethods,
- Info0, Info, IO0, IO),
+ MethodInfo0, MethodInfo, !IO),
- Info = instance_method_info(ModuleInfo, QualInfo, _PredName,
+ MethodInfo = instance_method_info(ModuleInfo, QualInfo, _PredName,
_Arity, _ExistQVars, _ArgTypes, _ClassContext, _ArgModes,
Errors, _ArgTypeVars, _Status, _PredOrFunc),
- InstanceCheckInfo = instance_check_info(InstanceDefn,
+ !:InstanceCheckInfo = instance_check_info(InstanceDefn,
OrderedMethods, Errors, ModuleInfo, QualInfo).
:- type modes_and_detism
@@ -477,8 +476,7 @@
get_matching_instance_defns(InstanceBody, PredOrFunc, MethodName,
Arity, MatchingInstanceMethods),
(
- MatchingInstanceMethods = [InstanceMethod]
- ->
+ MatchingInstanceMethods = [InstanceMethod],
OrderedInstanceMethods =
[InstanceMethod | OrderedInstanceMethods0],
InstanceMethod = instance_method(_, _, InstancePredDefn,
@@ -506,8 +504,7 @@
Context, InstanceConstraints, InstanceTypes,
InstanceBody, yes(InstancePredProcs), InstanceVarSet, I)
;
- MatchingInstanceMethods = [I1, I2 | Is]
- ->
+ MatchingInstanceMethods = [I1, I2 | Is],
%
% duplicate method definition error
%
@@ -544,6 +541,7 @@
Arity, ExistQVars, ArgTypes, ClassContext,
ArgModes, Errors, ArgTypeVars, Status, PredOrFunc)
;
+ MatchingInstanceMethods = [],
%
% undefined method error
%
@@ -575,9 +573,8 @@
% predicate/function name/arity, with multiple clause definitions
% being combined into a single definition.
%
-:- pred get_matching_instance_defns(instance_body, pred_or_func,
- sym_name, arity, list(instance_method)).
-:- mode get_matching_instance_defns(in, in, in, in, out) is det.
+:- pred get_matching_instance_defns(instance_body::in, pred_or_func::in,
+ sym_name::in, arity::in, list(instance_method)::out) is det.
get_matching_instance_defns(abstract, _, _, _, []).
get_matching_instance_defns(concrete(InstanceMethods), PredOrFunc, MethodName,
@@ -752,9 +749,8 @@
ExistQVars, ArgTypes, ClassContext, ArgModes, Errors,
ArgTypeVars, Status, PredOrFunc).
-:- pred apply_substitution_to_var_list(list(var(T)), map(var(T), term(T)),
- list(var(T))).
-:- mode apply_substitution_to_var_list(in, in, out) is det.
+:- pred apply_substitution_to_var_list(list(var(T))::in,
+ map(var(T), term(T))::in, list(var(T))::out) is det.
apply_substitution_to_var_list(Vars0, RenameSubst, Vars) :-
term__var_list_to_term_list(Vars0, Terms0),
@@ -762,13 +758,14 @@
term__term_list_to_var_list(Terms, Vars).
%---------------------------------------------------------------------------%
+
% Make the name of the introduced pred used to check a particular
% instance of a particular class method
%
% XXX This isn't quite perfect, I suspect
-:- pred make_introduced_pred_name(class_id, sym_name, arity, list(type),
- sym_name).
-:- mode make_introduced_pred_name(in, in, in, in, out) is det.
+
+:- pred make_introduced_pred_name(class_id::in, sym_name::in, arity::in,
+ list(type)::in, sym_name::out) is det.
make_introduced_pred_name(ClassId, MethodName, Arity,
InstanceTypes, PredName) :-
@@ -796,17 +793,16 @@
%---------------------------------------------------------------------------%
-% check that the superclass constraints are satisfied for the
-% types in this instance declaration
+ % Check that the superclass constraints are satisfied for the
+ % types in this instance declaration.
-:- pred check_superclass_conformance(class_id, list(class_constraint),
- list(tvar), tvarset, hlds_instance_defn, hlds_instance_defn,
- pair(error_messages, module_info), pair(error_messages, module_info)).
-:- mode check_superclass_conformance(in, in, in, in, in, out, in, out) is det.
+:- pred check_superclass_conformance(class_id::in, list(class_constraint)::in,
+ list(tvar)::in, tvarset::in, module_info::in,
+ hlds_instance_defn::in, hlds_instance_defn::out,
+ error_messages::in, error_messages::out) is det.
check_superclass_conformance(ClassId, SuperClasses0, ClassVars0, ClassVarSet,
- InstanceDefn0, InstanceDefn,
- Errors0 - ModuleInfo, Errors - ModuleInfo) :-
+ ModuleInfo, InstanceDefn0, InstanceDefn, Errors0, Errors) :-
InstanceDefn0 = hlds_instance_defn(A, B, Context, InstanceConstraints,
InstanceTypes, F, G, InstanceVarSet0, Proofs0),
@@ -818,9 +814,7 @@
% Now handle the class variables
map__apply_to_list(ClassVars0, Subst, ClassVarTerms),
- (
- term__var_list_to_term_list(ClassVars1, ClassVarTerms)
- ->
+ ( term__var_list_to_term_list(ClassVars1, ClassVarTerms) ->
ClassVars = ClassVars1
;
error("ClassVarTerms are not vars")
@@ -841,13 +835,13 @@
SuperClasses, UnprovenConstraints),
(
- UnprovenConstraints = []
- ->
+ UnprovenConstraints = [],
Errors = Errors0,
InstanceDefn = hlds_instance_defn(A, B, Context,
InstanceConstraints, InstanceTypes, F, G,
InstanceVarSet2, Proofs1)
;
+ UnprovenConstraints = [_ | _],
ClassId = class_id(ClassName, _ClassArity),
prog_out__sym_name_to_string(ClassName, ClassNameString),
InstanceTypesString = mercury_type_list_to_string(
@@ -864,20 +858,20 @@
InstanceDefn = InstanceDefn0
).
-:- pred constraint_list_to_string(tvarset, list(class_constraint), string).
-:- mode constraint_list_to_string(in, in, out) is det.
+:- pred constraint_list_to_string(tvarset::in, list(class_constraint)::in,
+ string::out) is det.
constraint_list_to_string(_, [], "").
-constraint_list_to_string(VarSet, [C|Cs], String) :-
+constraint_list_to_string(VarSet, [C | Cs], String) :-
String0 = mercury_constraint_to_string(VarSet, C),
constraint_list_to_string_2(VarSet, Cs, String1),
string__append_list(["`", String0, "'", String1], String).
-:- pred constraint_list_to_string_2(tvarset, list(class_constraint), string).
-:- mode constraint_list_to_string_2(in, in, out) is det.
+:- pred constraint_list_to_string_2(tvarset::in, list(class_constraint)::in,
+ string::out) is det.
constraint_list_to_string_2(_VarSet, [], "").
-constraint_list_to_string_2(VarSet, [C|Cs], String) :-
+constraint_list_to_string_2(VarSet, [C | Cs], String) :-
String0 = mercury_constraint_to_string(VarSet, C),
constraint_list_to_string_2(VarSet, Cs, String1),
string__append_list([", `", String0, "'", String1], String).
Index: compiler/clause_to_proc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/clause_to_proc.m,v
retrieving revision 1.39
diff -u -b -r1.39 clause_to_proc.m
--- compiler/clause_to_proc.m 21 Dec 2003 05:04:32 -0000 1.39
+++ compiler/clause_to_proc.m 3 Apr 2004 12:06:03 -0000
@@ -27,24 +27,23 @@
% we select the clauses for that mode, disjoin them together,
% and save this in the proc_info.
-:- pred copy_module_clauses_to_procs(list(pred_id), module_info, module_info).
-:- mode copy_module_clauses_to_procs(in, in, out) is det.
+:- pred copy_module_clauses_to_procs(list(pred_id)::in,
+ module_info::in, module_info::out) is det.
-:- pred copy_clauses_to_procs(pred_info, pred_info).
-:- mode copy_clauses_to_procs(in, out) is det.
+:- pred copy_clauses_to_procs(pred_info::in, pred_info::out) is det.
-:- pred copy_clauses_to_proc(proc_id, clauses_info, proc_info, proc_info).
-:- mode copy_clauses_to_proc(in, in, in, out) is det.
+:- pred copy_clauses_to_proc(proc_id::in, clauses_info::in,
+ proc_info::in, proc_info::out) is det.
% Before copying the clauses to the procs, we need to add
% a default mode of `:- mode foo(in, in, ..., in) = out is det.'
% for functions that don't have an explicit mode declaration.
-:- pred maybe_add_default_func_modes(list(pred_id), pred_table, pred_table).
-:- mode maybe_add_default_func_modes(in, in, out) is det.
+:- pred maybe_add_default_func_modes(list(pred_id)::in,
+ pred_table::in, pred_table::out) is det.
-:- pred maybe_add_default_func_mode(pred_info, pred_info, maybe(proc_id)).
-:- mode maybe_add_default_func_mode(in, out, out) is det.
+:- pred maybe_add_default_func_mode(pred_info::in, pred_info::out,
+ maybe(proc_id)::out) is det.
%-----------------------------------------------------------------------------%
@@ -112,8 +111,8 @@
copy_module_clauses_to_procs_2(PredIds, Preds0, Preds),
module_info_set_preds(Preds, !ModuleInfo).
-:- pred copy_module_clauses_to_procs_2(list(pred_id), pred_table, pred_table).
-:- mode copy_module_clauses_to_procs_2(in, in, out) is det.
+:- pred copy_module_clauses_to_procs_2(list(pred_id)::in,
+ pred_table::in, pred_table::out) is det.
copy_module_clauses_to_procs_2([], Preds, Preds).
copy_module_clauses_to_procs_2([PredId | PredIds], Preds0, Preds) :-
@@ -139,9 +138,8 @@
copy_clauses_to_procs_2(ProcIds, ClausesInfo, Procs0, Procs),
pred_info_set_procedures(Procs, !PredInfo).
-:- pred copy_clauses_to_procs_2(list(proc_id), clauses_info,
- proc_table, proc_table).
-:- mode copy_clauses_to_procs_2(in, in, in, out) is det.
+:- pred copy_clauses_to_procs_2(list(proc_id)::in, clauses_info::in,
+ proc_table::in, proc_table::out) is det.
copy_clauses_to_procs_2([], _, Procs, Procs).
copy_clauses_to_procs_2([ProcId | ProcIds], ClausesInfo, Procs0, Procs) :-
@@ -156,10 +154,8 @@
select_matching_clauses(Clauses, ProcId, MatchingClauses),
get_clause_goals(MatchingClauses, GoalList),
( GoalList = [SingleGoal] ->
- (
- SingleGoal = foreign_proc(_, _, _, Args,
- ArgNames, _, _) - _
- ->
+ SingleGoal = SingleExpr - _,
+ ( SingleExpr = foreign_proc(_, _, _, Args, ArgNames, _, _) ->
%
% Use the original variable names for the headvars
% of foreign_proc clauses, not the introduced
@@ -167,17 +163,8 @@
%
ArgsAndNames = assoc_list__from_corresponding_lists(
Args, ArgNames),
- VarSet = list__foldl(
- (func(Arg - MaybeArgName, Vars0) = Vars :-
- (
- MaybeArgName = yes(ArgName - _),
- varset__name_var(Vars0, Arg, ArgName, Vars)
- ;
- MaybeArgName = no,
- Vars = Vars0
- )
- ),
- ArgsAndNames, VarSet0)
+ VarSet = list__foldl(set_arg_names, ArgsAndNames,
+ VarSet0)
;
VarSet = VarSet0
),
@@ -231,14 +218,25 @@
proc_info_set_body(Proc0, VarSet, VarTypes, HeadVars, Goal,
TI_VarMap, TCI_VarMap, Proc).
-:- pred get_purity(hlds_goal, purity).
-:- mode get_purity(in, out) is det.
+:- func set_arg_names(pair(prog_var, maybe(pair(string, mode))), prog_varset)
+ = prog_varset.
+
+set_arg_names(Arg - MaybeArgName, Vars0) = Vars :-
+ (
+ MaybeArgName = yes(ArgName - _),
+ varset__name_var(Vars0, Arg, ArgName, Vars)
+ ;
+ MaybeArgName = no,
+ Vars = Vars0
+ ).
+
+:- pred get_purity(hlds_goal::in, purity::out) is det.
get_purity(_Goal - GoalInfo, Purity) :-
infer_goal_info_purity(GoalInfo, Purity).
-:- pred select_matching_clauses(list(clause), proc_id, list(clause)).
-:- mode select_matching_clauses(in, in, out) is det.
+:- pred select_matching_clauses(list(clause)::in, proc_id::in,
+ list(clause)::out) is det.
select_matching_clauses([], _, []).
select_matching_clauses([Clause | Clauses], ProcId, MatchingClauses) :-
@@ -261,4 +259,3 @@
goal_to_disj_list(Goal, GoalList),
list__append(GoalList, Goals1, Goals),
get_clause_goals(Clauses, Goals1).
-
Index: compiler/code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_gen.m,v
retrieving revision 1.121
diff -u -b -r1.121 code_gen.m
--- compiler/code_gen.m 23 Mar 2004 10:52:01 -0000 1.121
+++ compiler/code_gen.m 4 Apr 2004 07:57:53 -0000
@@ -1328,7 +1328,7 @@
;
FullPredName = PredName
),
- pred_or_func_to_str(PredOrFunc, PredOrFuncString),
+ PredOrFuncString = pred_or_func_to_str(PredOrFunc),
prog_out__sym_name_to_string(ModuleName, ModuleNameString),
string__int_to_string(Arity, ArityStr),
proc_id_to_int(ProcId, ProcNum),
Index: compiler/code_model.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_model.m,v
retrieving revision 1.4
diff -u -b -r1.4 code_model.m
--- compiler/code_model.m 23 Mar 2004 10:52:01 -0000 1.4
+++ compiler/code_model.m 3 Apr 2004 13:46:21 -0000
@@ -34,11 +34,9 @@
:- mode determinism_to_code_model(in, out) is det.
:- mode determinism_to_code_model(out, in) is multi.
-:- pred proc_info_interface_code_model(proc_info, code_model).
-:- mode proc_info_interface_code_model(in, out) is det.
+:- pred proc_info_interface_code_model(proc_info::in, code_model::out) is det.
-:- pred goal_info_get_code_model(hlds_goal_info, code_model).
-:- mode goal_info_get_code_model(in, out) is det.
+:- pred goal_info_get_code_model(hlds_goal_info::in, code_model::out) is det.
%-----------------------------------------------------------------------------%
Index: compiler/const_prop.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/const_prop.m,v
retrieving revision 1.23
diff -u -b -r1.23 const_prop.m
--- compiler/const_prop.m 23 Mar 2004 10:52:02 -0000 1.23
+++ compiler/const_prop.m 3 Apr 2004 13:15:24 -0000
@@ -67,8 +67,8 @@
% This type groups the information from the HLDS
% about a procedure call argument.
-:- type arg_hlds_info
- ---> arg_hlds_info(
+:- type arg_hlds_info --->
+ arg_hlds_info(
arg_var :: prog_var,
arg_type :: prog_data__type,
arg_inst :: (inst)
@@ -97,18 +97,12 @@
% -- not yet:
% Module = qualified(unqualified("std"), Mod),
Module = unqualified(Mod),
- (
- evaluate_det_call(Mod, Pred, ModeNum, Args, OutputArg, Cons)
- ->
+ ( evaluate_det_call(Mod, Pred, ModeNum, Args, OutputArg, Cons) ->
make_construction_goal(OutputArg, Cons, GoalInfo0,
Goal, GoalInfo)
- ;
- evaluate_test(Mod, Pred, ModeNum, Args, Succeeded)
- ->
+ ; evaluate_test(Mod, Pred, ModeNum, Args, Succeeded) ->
make_true_or_fail(Succeeded, GoalInfo0, Goal, GoalInfo)
- ;
- evaluate_semidet_call(Mod, Pred, ModeNum, Args, Result)
- ->
+ ; evaluate_semidet_call(Mod, Pred, ModeNum, Args, Result) ->
(
Result = yes(OutputArg - const(Cons)),
make_construction_goal(OutputArg, Cons, GoalInfo0,
@@ -140,8 +134,7 @@
% Otherwise it fails.
:- pred evaluate_det_call(string::in, string::in, int::in,
- list(arg_hlds_info)::in, arg_hlds_info::out, cons_id::out)
- is semidet.
+ list(arg_hlds_info)::in, arg_hlds_info::out, cons_id::out) is semidet.
%
% Unary operators
@@ -454,8 +447,8 @@
; var(arg_hlds_info).
:- pred evaluate_semidet_call(string::in, string::in, int::in,
- list(arg_hlds_info)::in,
- maybe(pair(arg_hlds_info, arg_val))::out) is semidet.
+ list(arg_hlds_info)::in, maybe(pair(arg_hlds_info, arg_val))::out)
+ is semidet.
evaluate_semidet_call("std_util", "dynamic_cast", 0, Args, Result) :-
evaluate_semidet_call("private_builtin", "typed_unify", 1,
@@ -488,6 +481,7 @@
% cannot be statically evaluated), evaluate_unify fails.
:- pred eval_unify(arg_hlds_info::in, arg_hlds_info::in, bool::out) is semidet.
+
eval_unify(X, Y, Result) :-
(
X ^ arg_var = Y ^ arg_var
@@ -515,8 +509,8 @@
%------------------------------------------------------------------------------%
:- pred make_assignment_goal(arg_hlds_info::in, arg_hlds_info::in,
- hlds_goal_info::in, hlds_goal_expr::out, hlds_goal_info::out)
- is det.
+ hlds_goal_info::in, hlds_goal_expr::out, hlds_goal_info::out) is det.
+
make_assignment_goal(OutputArg, InputArg, GoalInfo0, Goal, GoalInfo) :-
make_assignment(OutputArg, InputArg, Goal),
goal_info_get_instmap_delta(GoalInfo0, Delta0),
@@ -527,8 +521,8 @@
:- pred make_construction_goal(arg_hlds_info::in, cons_id::in,
- hlds_goal_info::in, hlds_goal_expr::out, hlds_goal_info::out)
- is det.
+ hlds_goal_info::in, hlds_goal_expr::out, hlds_goal_info::out) is det.
+
make_construction_goal(OutputArg, Cons, GoalInfo0, Goal, GoalInfo) :-
make_construction(OutputArg, Cons, Goal),
goal_info_get_instmap_delta(GoalInfo0, Delta0),
@@ -553,16 +547,16 @@
% recompute_instmap_delta is run by simplify.m if anything changes,
% so the insts are not important here.
-:- pred make_construction(arg_hlds_info, cons_id, hlds_goal_expr).
-:- mode make_construction(in, in, out) is det.
+:- pred make_construction(arg_hlds_info::in, cons_id::in, hlds_goal_expr::out)
+ is det.
make_construction(Arg, ConsId, Goal) :-
make_const_construction(Arg ^ arg_var, ConsId, Goal - _).
%------------------------------------------------------------------------------%
-:- pred make_true_or_fail(bool, hlds_goal_info, hlds_goal_expr, hlds_goal_info).
-:- mode make_true_or_fail(in, in, out, out) is det.
+:- pred make_true_or_fail(bool::in, hlds_goal_info::in,
+ hlds_goal_expr::out, hlds_goal_info::out) is det.
make_true_or_fail(yes, GoalInfo, conj([]), GoalInfo).
make_true_or_fail(no, GoalInfo, disj([]), GoalInfo).
Index: compiler/constraint.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/constraint.m,v
retrieving revision 1.53
diff -u -b -r1.53 constraint.m
--- compiler/constraint.m 28 Nov 2003 02:23:06 -0000 1.53
+++ compiler/constraint.m 3 Apr 2004 13:45:24 -0000
@@ -18,30 +18,28 @@
:- interface.
:- import_module hlds__hlds_goal.
+:- import_module hlds__hlds_pred.
:- import_module hlds__hlds_module.
:- import_module hlds__instmap.
:- import_module parse_tree__prog_data.
-:- import_module bool, map.
+:- import_module bool.
:- type constraint_info.
- % constraint__propagate_constraints_in_goal pushes constraints
+ % propagate_constraints_in_goal pushes constraints
% left and inward within a single goal. Specialized versions of
% procedures which are called with constrained outputs are created
% by deforest.m. Goals which deforest.m should try to propagate
% into calls are annotated with a `constraint' goal feature.
-:- pred constraint__propagate_constraints_in_goal(hlds_goal, hlds_goal,
- constraint_info, constraint_info).
-:- mode constraint__propagate_constraints_in_goal(in, out, in, out) is det.
-
-:- pred constraint_info_init(module_info, map(prog_var, type), prog_varset,
- instmap, constraint_info).
-:- mode constraint_info_init(in, in, in, in, out) is det.
-
-:- pred constraint_info_deconstruct(constraint_info, module_info,
- map(prog_var, type), prog_varset, bool).
-:- mode constraint_info_deconstruct(in, out, out, out, out) is det.
+:- pred propagate_constraints_in_goal(hlds_goal::in,
+ hlds_goal::out, constraint_info::in, constraint_info::out) is det.
+
+:- pred constraint_info_init(module_info::in, vartypes::in, prog_varset::in,
+ instmap::in, constraint_info::out) is det.
+
+:- pred constraint_info_deconstruct(constraint_info::in, module_info::out,
+ vartypes::out, prog_varset::out, bool::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -60,147 +58,146 @@
:- import_module libs__globals.
:- import_module libs__options.
-:- import_module assoc_list, list, require, set, std_util.
+:- import_module assoc_list, list, require, set, map, std_util.
:- import_module string, term, varset.
%-----------------------------------------------------------------------------%
-constraint__propagate_constraints_in_goal(Goal0, Goal) -->
+propagate_constraints_in_goal(Goal0, Goal, !Info) :-
% We need to strip off any existing constraint markers first.
% Constraint markers are meant to indicate where a constraint
% is meant to be attached to a call, and that deforest.m should
% consider creating a specialized version for the call.
% If deforest.m rearranges the goal, the constraints may
% not remain next to the call.
- { Goal1 = strip_constraint_markers(Goal0) },
- constraint__propagate_goal(Goal1, [], Goal).
+ Goal1 = strip_constraint_markers(Goal0),
+ propagate_goal(Goal1, [], Goal, !Info).
-:- pred constraint__propagate_goal(hlds_goal, list(constraint),
- hlds_goal, constraint_info, constraint_info).
-:- mode constraint__propagate_goal(in, in, out, in, out) is det.
+:- pred propagate_goal(hlds_goal::in, list(constraint)::in,
+ hlds_goal::out, constraint_info::in, constraint_info::out) is det.
-constraint__propagate_goal(Goal0, Constraints, Goal) -->
+propagate_goal(Goal0, Constraints, Goal, !Info) :-
% We need to treat all single goals as conjunctions so that
- % constraint__propagate_conj can move the constraints to the
+ % propagate_conj can move the constraints to the
% left of the goal if that is allowed.
- { goal_to_conj_list(Goal0, Goals0) },
- constraint__propagate_conj(Goals0, Constraints, Goals),
- { goal_list_nonlocals(Goals, NonLocals) },
- { goal_list_instmap_delta(Goals, Delta) },
- { goal_list_determinism(Goals, ConjDetism) },
- { goal_list_purity(Goals, Purity) },
- { goal_info_init(NonLocals, Delta, ConjDetism, Purity, GoalInfo) },
- { conj_list_to_goal(Goals, GoalInfo, Goal) }.
-
-:- pred constraint__propagate_conj_sub_goal(hlds_goal, list(constraint),
- hlds_goals, constraint_info, constraint_info).
-:- mode constraint__propagate_conj_sub_goal(in, in, out,
- in, out) is det.
-
-constraint__propagate_conj_sub_goal(Goal0, Constraints, Goals) -->
- { Goal0 = GoalExpr0 - _ },
- ( { goal_is_atomic(GoalExpr0) } ->
- []
+ goal_to_conj_list(Goal0, Goals0),
+ propagate_conj(Goals0, Constraints, Goals, !Info),
+ goal_list_nonlocals(Goals, NonLocals),
+ goal_list_instmap_delta(Goals, Delta),
+ goal_list_determinism(Goals, ConjDetism),
+ goal_list_purity(Goals, Purity),
+ goal_info_init(NonLocals, Delta, ConjDetism, Purity, GoalInfo),
+ conj_list_to_goal(Goals, GoalInfo, Goal).
+
+:- pred propagate_conj_sub_goal(hlds_goal::in,
+ list(constraint)::in, hlds_goals::out,
+ constraint_info::in, constraint_info::out) is det.
+
+propagate_conj_sub_goal(Goal0, Constraints, Goals, !Info) :-
+ Goal0 = GoalExpr0 - _,
+ ( goal_is_atomic(GoalExpr0) ->
+ true
;
% If a non-empty list of constraints is pushed into a sub-goal,
% quantification, instmap_deltas and determinism need to be
% recomputed.
- constraint_info_update_changed(Constraints)
+ constraint_info_update_changed(Constraints, !Info)
),
- InstMap0 =^ instmap,
- constraint__propagate_conj_sub_goal_2(Goal0, Constraints, Goals),
- ^ instmap := InstMap0.
-
-:- pred constraint__propagate_conj_sub_goal_2(hlds_goal, list(constraint),
- list(hlds_goal), constraint_info, constraint_info).
-:- mode constraint__propagate_conj_sub_goal_2(in, in, out, in, out) is det.
-
-constraint__propagate_conj_sub_goal_2(conj(Goals0) - Info, Constraints,
- [conj(Goals) - Info]) -->
- constraint__propagate_conj(Goals0, Constraints, Goals).
-
-constraint__propagate_conj_sub_goal_2(disj(Goals0) - Info, Constraints,
- [disj(Goals) - Info]) -->
- constraint__propagate_disj(Goals0, Constraints, Goals).
-
-constraint__propagate_conj_sub_goal_2(switch(Var, CanFail, Cases0) - Info,
- Constraints, [switch(Var, CanFail, Cases) - Info]) -->
- constraint__propagate_cases(Var, Cases0, Constraints, Cases).
+ InstMap0 = !.Info ^ instmap,
+ propagate_conj_sub_goal_2(Goal0, Constraints, Goals, !Info),
+ !:Info = !.Info ^ instmap := InstMap0.
+
+:- pred propagate_conj_sub_goal_2(hlds_goal::in, list(constraint)::in,
+ list(hlds_goal)::out, constraint_info::in, constraint_info::out)
+ is det.
+
+propagate_conj_sub_goal_2(conj(Goals0) - Info, Constraints,
+ [conj(Goals) - Info], !Info) :-
+ propagate_conj(Goals0, Constraints, Goals, !Info).
+
+propagate_conj_sub_goal_2(disj(Goals0) - Info, Constraints,
+ [disj(Goals) - Info], !Info) :-
+ propagate_disj(Goals0, Constraints, Goals, !Info).
+
+propagate_conj_sub_goal_2(switch(Var, CanFail, Cases0) - Info,
+ Constraints, [switch(Var, CanFail, Cases) - Info], !Info) :-
+ propagate_cases(Var, Constraints, Cases0, Cases, !Info).
-constraint__propagate_conj_sub_goal_2(
+propagate_conj_sub_goal_2(
if_then_else(Vars, Cond0, Then0, Else0) - Info,
Constraints,
- [if_then_else(Vars, Cond, Then, Else) - Info]) -->
- InstMap0 =^ instmap,
+ [if_then_else(Vars, Cond, Then, Else) - Info], !Info) :-
+ InstMap0 = !.Info ^ instmap,
% We can't safely propagate constraints into
% the condition of an if-then-else, because that
% would change the answers generated by the procedure.
- constraint__propagate_goal(Cond0, [], Cond),
- constraint_info_update_goal(Cond),
- constraint__propagate_goal(Then0, Constraints, Then),
- ^ instmap := InstMap0,
- constraint__propagate_goal(Else0, Constraints, Else).
+ propagate_goal(Cond0, [], Cond, !Info),
+ constraint_info_update_goal(Cond, !Info),
+ propagate_goal(Then0, Constraints, Then, !Info),
+ !:Info = !.Info ^ instmap := InstMap0,
+ propagate_goal(Else0, Constraints, Else, !Info).
% XXX propagate constraints into par_conjs -- this isn't
% possible at the moment because par_conj goals must have
% determinism det.
-constraint__propagate_conj_sub_goal_2(par_conj(Goals0) - GoalInfo,
+propagate_conj_sub_goal_2(par_conj(Goals0) - GoalInfo,
Constraints0,
- [par_conj(Goals) - GoalInfo | Constraints]) -->
+ [par_conj(Goals) - GoalInfo | Constraints], !Info) :-
% Propagate constraints within the goals of the conjunction.
- % constraint__propagate_disj treats its list of goals as
+ % propagate_disj treats its list of goals as
% independent rather than specifically disjoint, so we can
% use it to process a list of independent parallel conjuncts.
- constraint__propagate_disj(Goals0, [], Goals),
- { constraint__flatten_constraints(Constraints0, Constraints) }.
+ propagate_disj(Goals0, [], Goals, !Info),
+ flatten_constraints(Constraints0, Constraints).
-constraint__propagate_conj_sub_goal_2(some(Vars, CanRemove, Goal0) - GoalInfo,
- Constraints, [some(Vars, CanRemove, Goal) - GoalInfo]) -->
- constraint__propagate_goal(Goal0, Constraints, Goal).
+propagate_conj_sub_goal_2(some(Vars, CanRemove, Goal0) - GoalInfo,
+ Constraints, [some(Vars, CanRemove, Goal) - GoalInfo], !Info)
+ :-
+ propagate_goal(Goal0, Constraints, Goal, !Info).
-constraint__propagate_conj_sub_goal_2(not(NegGoal0) - GoalInfo, Constraints0,
- [not(NegGoal) - GoalInfo | Constraints]) -->
+propagate_conj_sub_goal_2(not(NegGoal0) - GoalInfo, Constraints0,
+ [not(NegGoal) - GoalInfo | Constraints], !Info) :-
% We can't safely propagate constraints into a negation,
% because that would change the answers computed by the
% procedure.
- constraint__propagate_goal(NegGoal0, [], NegGoal),
- { constraint__flatten_constraints(Constraints0, Constraints) }.
+ propagate_goal(NegGoal0, [], NegGoal, !Info),
+ flatten_constraints(Constraints0, Constraints).
-constraint__propagate_conj_sub_goal_2(Goal, Constraints0,
- [Goal | Constraints]) -->
- % constraint__propagate_conj will move the constraints
+propagate_conj_sub_goal_2(Goal, Constraints0,
+ [Goal | Constraints], !Info) :-
+ % propagate_conj will move the constraints
% to the left of the call if that is possible, so nothing
% needs to be done here.
- { Goal = call(_, _, _, _, _, _) - _ },
- { constraint__flatten_constraints(Constraints0, Constraints) }.
+ Goal = call(_, _, _, _, _, _) - _,
+ flatten_constraints(Constraints0, Constraints).
-constraint__propagate_conj_sub_goal_2(Goal, Constraints0,
- [Goal | Constraints]) -->
- { Goal = generic_call(_, _, _, _) - _ },
- { constraint__flatten_constraints(Constraints0, Constraints) }.
-
-constraint__propagate_conj_sub_goal_2(Goal, Constraints0,
- [Goal | Constraints]) -->
- { Goal = foreign_proc(_, _, _, _, _, _, _) - _ },
- { constraint__flatten_constraints(Constraints0, Constraints) }.
-
-constraint__propagate_conj_sub_goal_2(Goal, _, _) -->
- { Goal = shorthand(_) - _ },
- { error("constraint__propagate_conj_sub_goal_2: shorthand") }.
-
-constraint__propagate_conj_sub_goal_2(Goal, Constraints0,
- [Goal | Constraints]) -->
- { Goal = unify(_, _, _, _, _) - _ },
- { constraint__flatten_constraints(Constraints0, Constraints) }.
+propagate_conj_sub_goal_2(Goal, Constraints0,
+ [Goal | Constraints], !Info) :-
+ Goal = generic_call(_, _, _, _) - _,
+ flatten_constraints(Constraints0, Constraints).
+
+propagate_conj_sub_goal_2(Goal, Constraints0,
+ [Goal | Constraints], !Info) :-
+ Goal = foreign_proc(_, _, _, _, _, _, _) - _,
+ flatten_constraints(Constraints0, Constraints).
+
+propagate_conj_sub_goal_2(Goal, _, _, !Info) :-
+ Goal = shorthand(_) - _,
+ error("propagate_conj_sub_goal_2: shorthand").
+
+propagate_conj_sub_goal_2(Goal, Constraints0,
+ [Goal | Constraints], !Info) :-
+ Goal = unify(_, _, _, _, _) - _,
+ flatten_constraints(Constraints0, Constraints).
%-----------------------------------------------------------------------------%
% Put the constant constructions in front of the constraint.
-:- pred constraint__flatten_constraints(list(constraint)::in,
+:- pred flatten_constraints(list(constraint)::in,
list(hlds_goal)::out) is det.
-constraint__flatten_constraints(Constraints0, Goals) :-
+flatten_constraints(Constraints0, Goals) :-
list__map((pred(Constraint::in, Lists::out) is det :-
Constraint = constraint(Goal, _, _, Constructs),
Lists = [Constructs, [Goal]]
@@ -210,71 +207,68 @@
%-----------------------------------------------------------------------------%
-:- pred constraint__propagate_disj(list(hlds_goal), list(constraint),
- list(hlds_goal), constraint_info, constraint_info).
-:- mode constraint__propagate_disj(in, in, out,
- in, out) is det.
+:- pred propagate_disj(list(hlds_goal)::in, list(constraint)::in,
+ list(hlds_goal)::out, constraint_info::in, constraint_info::out)
+ is det.
-constraint__propagate_disj([], _, []) --> [].
-constraint__propagate_disj([Goal0 | Goals0], Constraints, [Goal | Goals]) -->
- InstMap0 =^ instmap,
- constraint__propagate_goal(Goal0, Constraints, Goal),
- ^ instmap := InstMap0,
- constraint__propagate_disj(Goals0, Constraints, Goals).
+propagate_disj([], _, [], !Info).
+propagate_disj([Goal0 | Goals0], Constraints, [Goal | Goals], !Info) :-
+ InstMap0 = !.Info ^ instmap,
+ propagate_goal(Goal0, Constraints, Goal, !Info),
+ !:Info = !.Info ^ instmap := InstMap0,
+ propagate_disj(Goals0, Constraints, Goals, !Info).
%-----------------------------------------------------------------------------%
-:- pred constraint__propagate_cases(prog_var, list(case), list(constraint),
- list(case), constraint_info, constraint_info).
-:- mode constraint__propagate_cases(in, in, in, out,
- in, out) is det.
+:- pred propagate_cases(prog_var::in, list(constraint)::in,
+ list(case)::in, list(case)::out,
+ constraint_info::in, constraint_info::out) is det.
-constraint__propagate_cases(_, [], _, []) --> [].
-constraint__propagate_cases(Var, [case(ConsId, Goal0) | Cases0], Constraints,
- [case(ConsId, Goal) | Cases]) -->
- InstMap0 =^ instmap,
- constraint_info_bind_var_to_functor(Var, ConsId),
- constraint__propagate_goal(Goal0, Constraints, Goal),
- ^ instmap := InstMap0,
- constraint__propagate_cases(Var, Cases0, Constraints, Cases).
+propagate_cases(_, _, [], [], !Info).
+propagate_cases(Var, Constraints, [case(ConsId, Goal0) | Cases0],
+ [case(ConsId, Goal) | Cases], !Info) :-
+ InstMap0 = !.Info ^ instmap,
+ constraint_info_bind_var_to_functor(Var, ConsId, !Info),
+ propagate_goal(Goal0, Constraints, Goal, !Info),
+ !:Info = !.Info ^ instmap := InstMap0,
+ propagate_cases(Var, Constraints, Cases0, Cases, !Info).
%-----------------------------------------------------------------------------%
- % constraint__propagate_conj detects the constraints in
+ % propagate_conj detects the constraints in
% a conjunction and moves them to as early as possible
% in the list. Some effort is made to keep the constraints
% in the same order as they are encountered to increase
% the likelihood of folding recursive calls.
-:- pred constraint__propagate_conj(list(hlds_goal), list(constraint),
- list(hlds_goal), constraint_info, constraint_info).
-:- mode constraint__propagate_conj(in, in, out,
- in, out) is det.
-
-constraint__propagate_conj(Goals0, Constraints, Goals) -->
- constraint_info_update_changed(Constraints),
- ( { Goals0 = [] } ->
- { constraint__flatten_constraints(Constraints, Goals) }
- ; { Goals0 = [Goal0], Constraints = [] } ->
- constraint__propagate_conj_sub_goal(Goal0, [], Goals)
- ;
- InstMap0 =^ instmap,
- ModuleInfo =^ module_info,
- VarTypes =^ vartypes,
- { constraint__annotate_conj_output_vars(Goals0, ModuleInfo,
- VarTypes, InstMap0, [], RevGoals1) },
- constraint__annotate_conj_constraints(ModuleInfo, RevGoals1,
- Constraints, [], Goals2),
- constraint__propagate_conj_constraints(Goals2, [], Goals)
+:- pred propagate_conj(list(hlds_goal)::in, list(constraint)::in,
+ list(hlds_goal)::out, constraint_info::in, constraint_info::out)
+ is det.
+
+propagate_conj(Goals0, Constraints, Goals, !Info) :-
+ constraint_info_update_changed(Constraints, !Info),
+ ( Goals0 = [] ->
+ flatten_constraints(Constraints, Goals)
+ ; Goals0 = [Goal0], Constraints = [] ->
+ propagate_conj_sub_goal(Goal0, [], Goals, !Info)
+ ;
+ InstMap0 = !.Info ^ instmap,
+ ModuleInfo = !.Info ^ module_info,
+ VarTypes = !.Info ^ vartypes,
+ annotate_conj_output_vars(Goals0, ModuleInfo,
+ VarTypes, InstMap0, [], RevGoals1),
+ annotate_conj_constraints(ModuleInfo, RevGoals1,
+ Constraints, [], Goals2, !Info),
+ propagate_conj_constraints(Goals2, [], Goals, !Info)
).
% Annotate each conjunct with the variables it produces.
-:- pred constraint__annotate_conj_output_vars(list(hlds_goal), module_info,
- vartypes, instmap, annotated_conj, annotated_conj).
-:- mode constraint__annotate_conj_output_vars(in, in, in, in, in, out) is det.
-
-constraint__annotate_conj_output_vars([], _, _, _, RevGoals, RevGoals).
-constraint__annotate_conj_output_vars([Goal | Goals], ModuleInfo, VarTypes,
- InstMap0, RevGoals0, RevGoals) :-
+:- pred annotate_conj_output_vars(list(hlds_goal)::in, module_info::in,
+ vartypes::in, instmap::in, annotated_conj::in, annotated_conj::out)
+ is det.
+
+annotate_conj_output_vars([], _, _, _, !RevGoals).
+annotate_conj_output_vars([Goal | Goals], ModuleInfo, VarTypes, InstMap0,
+ !RevGoals) :-
Goal = _ - GoalInfo,
goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
@@ -321,8 +315,8 @@
AnnotatedConjunct = annotated_conjunct(Goal, ChangedVars, BoundVars,
IncompatibleInstVars),
- constraint__annotate_conj_output_vars(Goals, ModuleInfo, VarTypes,
- InstMap, [AnnotatedConjunct | RevGoals0], RevGoals).
+ annotate_conj_output_vars(Goals, ModuleInfo, VarTypes,
+ InstMap, [AnnotatedConjunct | !.RevGoals], !:RevGoals).
%-----------------------------------------------------------------------------%
@@ -375,25 +369,23 @@
% Pass backwards over the conjunction, annotating each conjunct
% with the constraints that should be pushed into it.
-:- pred constraint__annotate_conj_constraints(module_info, annotated_conj,
- list(constraint), constrained_conj, constrained_conj,
- constraint_info, constraint_info).
-:- mode constraint__annotate_conj_constraints(in, in, in,
- in, out, in, out) is det.
-
-constraint__annotate_conj_constraints(_, [], Constraints0, Goals0, Goals) -->
- { constraint__flatten_constraints(Constraints0, Constraints1) },
- { list__map((pred(Goal::in, CnstrGoal::out) is det :-
+:- pred annotate_conj_constraints(module_info::in, annotated_conj::in,
+ list(constraint)::in, constrained_conj::in, constrained_conj::out,
+ constraint_info::in, constraint_info::out) is det.
+
+annotate_conj_constraints(_, [], Constraints0, Goals0, Goals, !Info) :-
+ flatten_constraints(Constraints0, Constraints1),
+ list__map((pred(Goal::in, CnstrGoal::out) is det :-
CnstrGoal = Goal - []
- ), Constraints1, Constraints) },
- { list__append(Constraints, Goals0, Goals) }.
-constraint__annotate_conj_constraints(ModuleInfo,
+ ), Constraints1, Constraints),
+ list__append(Constraints, Goals0, Goals).
+annotate_conj_constraints(ModuleInfo,
[Conjunct | RevConjuncts0],
- Constraints0, Goals0, Goals) -->
- { Conjunct = annotated_conjunct(Goal, ChangedVars,
- OutputVars, IncompatibleInstVars) },
- { Goal = GoalExpr - GoalInfo },
- { goal_info_get_nonlocals(GoalInfo, NonLocals) },
+ Constraints0, Goals0, Goals, !Info) :-
+ Conjunct = annotated_conjunct(Goal, ChangedVars, OutputVars,
+ IncompatibleInstVars),
+ Goal = GoalExpr - GoalInfo,
+ goal_info_get_nonlocals(GoalInfo, NonLocals),
(
% Propagate goals with no output variables which can fail.
% Propagating cc_nondet goals would be tricky, because we
@@ -401,30 +393,30 @@
% (the cc_nondet goal can't be moved before any goals
% which can fail).
%
- { goal_info_get_determinism(GoalInfo, Detism) },
- { Detism = semidet
+ goal_info_get_determinism(GoalInfo, Detism),
+ ( Detism = semidet
; Detism = failure
- },
+ ),
%
% XXX This is probably a bit too conservative. For
% example, `any->any' moded non-locals are considered
% to be outputs.
%
- { set__empty(OutputVars) },
+ set__empty(OutputVars),
% Don't propagate impure goals.
- { goal_info_is_pure(GoalInfo) },
+ goal_info_is_pure(GoalInfo),
% Don't propagate goals that can loop.
- { goal_cannot_loop_or_throw(Goal) }
+ goal_cannot_loop_or_throw(Goal)
->
% It's a constraint, add it to the list of constraints
% to be attached to goals earlier in the conjunction.
- { Goals1 = Goals0 },
- { Constraint = constraint(GoalExpr - GoalInfo,
- ChangedVars, IncompatibleInstVars, []) },
- { Constraints1 = [Constraint | Constraints0] }
+ Goals1 = Goals0,
+ Constraint = constraint(GoalExpr - GoalInfo, ChangedVars,
+ IncompatibleInstVars, []),
+ Constraints1 = [Constraint | Constraints0]
;
%
% Look for a simple goal which some constraint depends
@@ -438,67 +430,65 @@
% the constraint as well, so that a copy of the constant
% doesn't need to be kept on the stack.
%
- { Goal = unify(_, _, _, Unify, _) - _ },
- { Unify = construct(ConstructVar, _, [], _, _, _, _) }
+ Goal = unify(_, _, _, Unify, _) - _,
+ Unify = construct(ConstructVar, _, [], _, _, _, _)
->
- { Goals1 = [Goal - [] | Goals0] },
- constraint__add_constant_construction(ConstructVar, Goal,
- Constraints0, Constraints1),
+ Goals1 = [Goal - [] | Goals0],
+ add_constant_construction(ConstructVar, Goal,
+ Constraints0, Constraints1, !Info),
% If the constraint was the only use of the constant,
% the old goal can be removed. We need to rerun
% quantification to work that out.
- ^ changed := yes
+ !:Info = !.Info ^ changed := yes
;
% Prune away the constraints after a goal
% which cannot succeed -- they can never be
% executed.
- { goal_info_get_determinism(GoalInfo, Detism) },
- { determinism_components(Detism, _, at_most_zero) }
+ goal_info_get_determinism(GoalInfo, Detism),
+ determinism_components(Detism, _, at_most_zero)
->
- constraint_info_update_changed(Constraints0),
- { Constraints1 = [] },
- { Goals1 = [Goal - [] | Goals0] }
+ constraint_info_update_changed(Constraints0, !Info),
+ Constraints1 = [],
+ Goals1 = [Goal - [] | Goals0]
;
% Don't propagate constraints into or past impure goals.
- { Goal = _ - GoalInfo },
- { goal_info_is_impure(GoalInfo) }
+ Goal = _ - GoalInfo,
+ goal_info_is_impure(GoalInfo)
->
- { Constraints1 = [] },
- { constraint__flatten_constraints(Constraints0,
- ConstraintGoals) },
- { list__map(add_empty_constraints, [Goal | ConstraintGoals],
- GoalsAndConstraints) },
- { list__append(GoalsAndConstraints, Goals0, Goals1) }
+ Constraints1 = [],
+ flatten_constraints(Constraints0,
+ ConstraintGoals),
+ list__map(add_empty_constraints, [Goal | ConstraintGoals],
+ GoalsAndConstraints),
+ list__append(GoalsAndConstraints, Goals0, Goals1)
;
% Don't move goals which can fail before a goal which
% can loop if `--fully-strict' is set.
- { \+ goal_cannot_loop_or_throw(Goal) },
- { module_info_globals(ModuleInfo, Globals) },
- { globals__lookup_bool_option(Globals, fully_strict, yes) }
+ \+ goal_cannot_loop_or_throw(Goal),
+ module_info_globals(ModuleInfo, Globals),
+ globals__lookup_bool_option(Globals, fully_strict, yes)
->
- { constraint__filter_dependent_constraints(NonLocals,
+ filter_dependent_constraints(NonLocals,
ChangedVars, Constraints0, DependentConstraints,
- IndependentConstraints) },
- { constraint__flatten_constraints(IndependentConstraints,
- IndependentConstraintGoals) },
- { list__map(add_empty_constraints, IndependentConstraintGoals,
- GoalsAndConstraints) },
- { Goals1 =
- [attach_constraints(Goal, DependentConstraints)
- | GoalsAndConstraints]
- ++ Goals0 },
- { Constraints1 = [] }
+ IndependentConstraints),
+ flatten_constraints(IndependentConstraints,
+ IndependentConstraintGoals),
+ list__map(add_empty_constraints, IndependentConstraintGoals,
+ GoalsAndConstraints),
+ Goals1 = [attach_constraints(Goal, DependentConstraints)
+ | GoalsAndConstraints] ++ Goals0,
+ Constraints1 = []
;
- { constraint__filter_dependent_constraints(NonLocals,
+ filter_dependent_constraints(NonLocals,
OutputVars, Constraints0, DependentConstraints,
- IndependentConstraints) },
- { Constraints1 = IndependentConstraints },
- { Goals1 = [attach_constraints(Goal, DependentConstraints)
- | Goals0] }
+ IndependentConstraints),
+ Constraints1 = IndependentConstraints,
+ Goals1 = [attach_constraints(Goal, DependentConstraints)
+ | Goals0]
),
- constraint__annotate_conj_constraints(ModuleInfo, RevConjuncts0,
- Constraints1, Goals1, Goals).
+ annotate_conj_constraints(ModuleInfo, RevConjuncts0,
+ Constraints1, Goals1, Goals, !Info).
:- pred add_empty_constraints(hlds_goal::in,
pair(hlds_goal, list(constraint))::out) is det.
@@ -527,42 +517,41 @@
%-----------------------------------------------------------------------------%
-:- pred constraint__add_constant_construction(prog_var::in, hlds_goal::in,
+:- pred add_constant_construction(prog_var::in, hlds_goal::in,
list(constraint)::in, list(constraint)::out,
constraint_info::in, constraint_info::out) is det.
-constraint__add_constant_construction(_, _, [], []) --> [].
-constraint__add_constant_construction(ConstructVar, Construct0,
+add_constant_construction(_, _, [], [], !Info).
+add_constant_construction(ConstructVar, Construct0,
[Constraint0 | Constraints0],
- [Constraint | Constraints]) -->
- { Constraint0 = constraint(ConstraintGoal0, ChangedVars,
- IncompatibleInstVars, Constructs0) },
+ [Constraint | Constraints], !Info) :-
+ Constraint0 = constraint(ConstraintGoal0, ChangedVars,
+ IncompatibleInstVars, Constructs0),
(
- { ConstraintGoal0 = _ - ConstraintInfo },
- { goal_info_get_nonlocals(ConstraintInfo,
- ConstraintNonLocals) },
- { set__member(ConstructVar, ConstraintNonLocals) }
+ ConstraintGoal0 = _ - ConstraintInfo,
+ goal_info_get_nonlocals(ConstraintInfo,
+ ConstraintNonLocals),
+ set__member(ConstructVar, ConstraintNonLocals)
->
- VarSet0 =^ varset,
- VarTypes0 =^ vartypes,
- { varset__new_var(VarSet0, NewVar, VarSet) },
- { map__lookup(VarTypes0, ConstructVar, VarType) },
- { map__det_insert(VarTypes0, NewVar, VarType, VarTypes) },
- ^ varset := VarSet,
- ^ vartypes := VarTypes,
- { map__from_assoc_list([ConstructVar - NewVar], Subn) },
- { goal_util__rename_vars_in_goal(Construct0,
- Subn, Construct) },
- { Constructs = [Construct | Constructs0] },
- { goal_util__rename_vars_in_goal(ConstraintGoal0,
- Subn, ConstraintGoal) },
- { Constraint = constraint(ConstraintGoal, ChangedVars,
- IncompatibleInstVars, Constructs) }
+ VarSet0 = !.Info ^ varset,
+ VarTypes0 = !.Info ^ vartypes,
+ varset__new_var(VarSet0, NewVar, VarSet),
+ map__lookup(VarTypes0, ConstructVar, VarType),
+ map__det_insert(VarTypes0, NewVar, VarType, VarTypes),
+ !:Info = !.Info ^ varset := VarSet,
+ !:Info = !.Info ^ vartypes := VarTypes,
+ map__from_assoc_list([ConstructVar - NewVar], Subn),
+ goal_util__rename_vars_in_goal(Construct0, Subn, Construct),
+ Constructs = [Construct | Constructs0],
+ goal_util__rename_vars_in_goal(ConstraintGoal0, Subn,
+ ConstraintGoal),
+ Constraint = constraint(ConstraintGoal, ChangedVars,
+ IncompatibleInstVars, Constructs)
;
- { Constraint = Constraint0 }
+ Constraint = Constraint0
),
- constraint__add_constant_construction(ConstructVar, Construct0,
- Constraints0, Constraints).
+ add_constant_construction(ConstructVar, Construct0,
+ Constraints0, Constraints, !Info).
%-----------------------------------------------------------------------------%
@@ -576,29 +565,26 @@
% The IndependentConstraints should be moved to the left of
% the current goal, if the purity and termination properties
% of the current goal allow that.
-:- pred constraint__filter_dependent_constraints(set(prog_var), set(prog_var),
- list(constraint), list(constraint), list(constraint)).
-:- mode constraint__filter_dependent_constraints(in, in, in,
- out, out) is det.
-
-constraint__filter_dependent_constraints(NonLocals, GoalOutputVars,
- Constraints, Dependent, Independent) :-
- constraint__filter_dependent_constraints(NonLocals, GoalOutputVars,
- Constraints, [], Dependent, [], Independent).
-
-:- pred constraint__filter_dependent_constraints(set(prog_var), set(prog_var),
- list(constraint), list(constraint), list(constraint),
- list(constraint), list(constraint)).
-:- mode constraint__filter_dependent_constraints(in, in, in,
- in, out, in, out) is det.
-
-constraint__filter_dependent_constraints(_NonLocals, _OutputVars, [],
- RevDependent, Dependent, RevIndependent, Independent) :-
+:- pred filter_dependent_constraints(set(prog_var)::in, set(prog_var)::in,
+ list(constraint)::in, list(constraint)::out, list(constraint)::out)
+ is det.
+
+filter_dependent_constraints(NonLocals, GoalOutputVars, Constraints,
+ Dependent, Independent) :-
+ filter_dependent_constraints(NonLocals, GoalOutputVars, Constraints,
+ [], RevDependent, [], RevIndependent),
list__reverse(RevDependent, Dependent),
list__reverse(RevIndependent, Independent).
-constraint__filter_dependent_constraints(NonLocals, GoalOutputVars,
- [Constraint | Constraints], Dependent0, Dependent,
- Independent0, Independent) :-
+
+:- pred filter_dependent_constraints(set(prog_var)::in, set(prog_var)::in,
+ list(constraint)::in,
+ list(constraint)::in, list(constraint)::out,
+ list(constraint)::in, list(constraint)::out) is det.
+
+filter_dependent_constraints(_NonLocals, _OutputVars, [],
+ !RevDependent, !RevIndependent).
+filter_dependent_constraints(NonLocals, GoalOutputVars,
+ [Constraint | Constraints], !RevDependent, !RevIndependent) :-
Constraint = constraint(ConstraintGoal, _, IncompatibleInstVars, _),
ConstraintGoal = _ - ConstraintGoalInfo,
goal_info_get_nonlocals(ConstraintGoalInfo, ConstraintNonLocals),
@@ -630,26 +616,23 @@
% changed by any the of the constraints already
% attached to the goal (the dependent constraints
% will be attached to the goal to be pushed into
- % it by constraint__propagate_conj_sub_goal).
+ % it by propagate_conj_sub_goal).
%
- list__member(EarlierConstraint, Dependent0),
+ list__member(EarlierConstraint, !.RevDependent),
\+ can_reorder_constraints(EarlierConstraint,
Constraint)
)
->
- Independent1 = Independent0,
- Dependent1 = [Constraint | Dependent0]
+ !:RevDependent = [Constraint | !.RevDependent]
;
- Independent1 = [Constraint | Independent0],
- Dependent1 = Dependent0
+ !:RevIndependent = [Constraint | !.RevIndependent]
),
- constraint__filter_dependent_constraints(NonLocals, GoalOutputVars,
- Constraints, Dependent1, Dependent, Independent1, Independent).
+ filter_dependent_constraints(NonLocals, GoalOutputVars, Constraints,
+ !RevDependent, !RevIndependent).
%-----------------------------------------------------------------------------%
-:- pred can_reorder_constraints(constraint, constraint).
-:- mode can_reorder_constraints(in, in) is semidet.
+:- pred can_reorder_constraints(constraint::in, constraint::in) is semidet.
can_reorder_constraints(EarlierConstraint, Constraint) :-
EarlierConstraint = constraint(_, EarlierChangedVars, _, _),
@@ -663,76 +646,70 @@
%-----------------------------------------------------------------------------%
% Push the constraints into each conjunct.
-:- pred constraint__propagate_conj_constraints(constrained_conj,
- list(hlds_goal), list(hlds_goal),
- constraint_info, constraint_info).
-:- mode constraint__propagate_conj_constraints(in, in, out, in, out) is det.
-
-constraint__propagate_conj_constraints([], RevGoals, Goals) -->
- { list__reverse(RevGoals, Goals) }.
-constraint__propagate_conj_constraints([Goal0 - Constraints0 | Goals0],
- RevGoals0, RevGoals) -->
- { constraint__filter_complex_constraints(Constraints0,
- SimpleConstraints, ComplexConstraints0) },
- constraint__propagate_conj_sub_goal(Goal0,
- SimpleConstraints, GoalList1),
- { constraint__flatten_constraints(ComplexConstraints0,
- ComplexConstraints) },
- { list__reverse(ComplexConstraints, RevComplexConstraints) },
- { list__reverse(GoalList1, RevGoalList1) },
- { list__condense([RevComplexConstraints, RevGoalList1, RevGoals0],
- RevGoals1) },
- constraint_info_update_goal(Goal0),
- constraint__propagate_conj_constraints(Goals0, RevGoals1, RevGoals).
-
-:- pred constraint__filter_complex_constraints(list(constraint),
- list(constraint), list(constraint)).
-:- mode constraint__filter_complex_constraints(in, out, out) is det.
+:- pred propagate_conj_constraints(constrained_conj::in,
+ list(hlds_goal)::in, list(hlds_goal)::out,
+ constraint_info::in, constraint_info::out) is det.
+
+propagate_conj_constraints([], RevGoals, Goals, !Info) :-
+ list__reverse(RevGoals, Goals).
+propagate_conj_constraints([Goal0 - Constraints0 | Goals0],
+ RevGoals0, RevGoals, !Info) :-
+ filter_complex_constraints(Constraints0,
+ SimpleConstraints, ComplexConstraints0),
+ propagate_conj_sub_goal(Goal0, SimpleConstraints, GoalList1, !Info),
+ flatten_constraints(ComplexConstraints0, ComplexConstraints),
+ list__reverse(ComplexConstraints, RevComplexConstraints),
+ list__reverse(GoalList1, RevGoalList1),
+ list__condense([RevComplexConstraints, RevGoalList1, RevGoals0],
+ RevGoals1),
+ constraint_info_update_goal(Goal0, !Info),
+ propagate_conj_constraints(Goals0, RevGoals1, RevGoals, !Info).
-constraint__filter_complex_constraints(Constraints,
+:- pred filter_complex_constraints(list(constraint)::in,
+ list(constraint)::out, list(constraint)::out) is det.
+
+filter_complex_constraints(Constraints,
SimpleConstraints, ComplexConstraints) :-
- constraint__filter_complex_constraints(Constraints,
- [], SimpleConstraints, [], ComplexConstraints).
+ filter_complex_constraints(Constraints,
+ [], RevSimpleConstraints, [], RevComplexConstraints),
+ SimpleConstraints = list__reverse(RevSimpleConstraints),
+ ComplexConstraints = list__reverse(RevComplexConstraints).
% Don't attempt to push branched goals into other goals.
-:- pred constraint__filter_complex_constraints(list(constraint),
- list(constraint), list(constraint),
- list(constraint), list(constraint)).
-:- mode constraint__filter_complex_constraints(in, in, out, in, out) is det.
-
-constraint__filter_complex_constraints([], SimpleConstraints,
- list__reverse(SimpleConstraints),
- ComplexConstraints, list__reverse(ComplexConstraints)).
-constraint__filter_complex_constraints([Constraint | Constraints],
- SimpleConstraints0, SimpleConstraints,
- ComplexConstraints0, ComplexConstraints) :-
+:- pred filter_complex_constraints(list(constraint)::in,
+ list(constraint)::in, list(constraint)::out,
+ list(constraint)::in, list(constraint)::out) is det.
+
+filter_complex_constraints([], !RevSimpleConstraints, !RevComplexConstraints).
+filter_complex_constraints([Constraint | Constraints],
+ !RevSimpleConstraints, !RevComplexConstraints) :-
Constraint = constraint(ConstraintGoal, _, _, _),
(
- constraint__goal_is_simple(ConstraintGoal),
+ goal_is_simple(ConstraintGoal),
%
% Check whether this simple constraint can be reordered
% with the complex constraints we've already found.
%
\+ (
- list__member(ComplexConstraint, ComplexConstraints0),
+ list__member(ComplexConstraint,
+ !.RevComplexConstraints),
\+ can_reorder_constraints(ComplexConstraint,
Constraint)
)
->
- SimpleConstraints1 = [Constraint | SimpleConstraints0],
- ComplexConstraints1 = ComplexConstraints0
+ !:RevSimpleConstraints =
+ [Constraint | !.RevSimpleConstraints]
;
- SimpleConstraints1 = SimpleConstraints0,
- ComplexConstraints1 = [Constraint | ComplexConstraints0]
+ !:RevComplexConstraints =
+ [Constraint | !.RevComplexConstraints]
),
- constraint__filter_complex_constraints(Constraints, SimpleConstraints1,
- SimpleConstraints, ComplexConstraints1, ComplexConstraints).
+ filter_complex_constraints(Constraints, !RevSimpleConstraints,
+ !RevComplexConstraints).
-:- pred constraint__goal_is_simple(hlds_goal).
-:- mode constraint__goal_is_simple(in) is semidet.
+:- pred goal_is_simple(hlds_goal::in) is semidet.
-constraint__goal_is_simple(Goal) :-
+goal_is_simple(Goal) :-
Goal = GoalExpr - _,
(
goal_is_atomic(GoalExpr)
@@ -740,7 +717,7 @@
( GoalExpr = some(_, _, SubGoal)
; GoalExpr = not(SubGoal)
),
- constraint__goal_is_simple(SubGoal)
+ goal_is_simple(SubGoal)
).
%-----------------------------------------------------------------------------%
@@ -748,7 +725,7 @@
:- type constraint_info
---> constraint_info(
module_info :: module_info,
- vartypes :: map(prog_var, type),
+ vartypes :: vartypes,
varset :: prog_varset,
instmap :: instmap,
changed :: bool % has anything changed.
@@ -766,24 +743,24 @@
:- pred constraint_info_update_goal(hlds_goal::in,
constraint_info::in, constraint_info::out) is det.
-constraint_info_update_goal(_ - GoalInfo) -->
- InstMap0 =^ instmap,
- { goal_info_get_instmap_delta(GoalInfo, InstMapDelta) },
- { instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMap) },
- ^ instmap := InstMap.
+constraint_info_update_goal(_ - GoalInfo, !Info) :-
+ InstMap0 = !.Info ^ instmap,
+ goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
+ instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMap),
+ !:Info = !.Info ^ instmap := InstMap.
:- pred constraint_info_bind_var_to_functor(prog_var::in, cons_id::in,
constraint_info::in, constraint_info::out) is det.
-constraint_info_bind_var_to_functor(Var, ConsId) -->
- InstMap0 =^ instmap,
- ModuleInfo0 =^ module_info,
- VarTypes =^ vartypes,
- { map__lookup(VarTypes, Var, Type) },
- { instmap__bind_var_to_functor(Var, Type, ConsId, InstMap0, InstMap,
- ModuleInfo0, ModuleInfo) },
- ^ instmap := InstMap,
- ^ module_info := ModuleInfo.
+constraint_info_bind_var_to_functor(Var, ConsId, !Info) :-
+ InstMap0 = !.Info ^ instmap,
+ ModuleInfo0 = !.Info ^ module_info,
+ VarTypes = !.Info ^ vartypes,
+ map__lookup(VarTypes, Var, Type),
+ instmap__bind_var_to_functor(Var, Type, ConsId, InstMap0, InstMap,
+ ModuleInfo0, ModuleInfo),
+ !:Info = !.Info ^ instmap := InstMap,
+ !:Info = !.Info ^ module_info := ModuleInfo.
% If a non-empty list of constraints is pushed into a sub-goal,
% quantification, instmap_deltas and determinism need to be
@@ -791,11 +768,11 @@
:- pred constraint_info_update_changed(list(constraint)::in,
constraint_info::in, constraint_info::out) is det.
-constraint_info_update_changed(Constraints) -->
- ( { Constraints = [] } ->
- []
+constraint_info_update_changed(Constraints, !Info) :-
+ ( Constraints = [] ->
+ true
;
- ^ changed := yes
+ !:Info = !.Info ^ changed := yes
).
%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list