[m-rev.] diff: more four space conversions
Zoltan Somogyi
zs at cs.mu.OZ.AU
Wed Oct 19 15:37:44 AEST 2005
browser/*.m:
compiler/*.m:
mdbcomp/*.m:
Convert a bunch more modules to four-space indentation.
Zoltan.
cvs diff: Diffing .
cvs diff: Diffing analysis
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.52
diff -u -b -r1.52 browse.m
--- browser/browse.m 11 Jul 2005 07:30:19 -0000 1.52
+++ browser/browse.m 18 Oct 2005 01:54:02 -0000
@@ -1,4 +1,6 @@
%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
% Copyright (C) 1998-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
@@ -6,12 +8,12 @@
% browse - implements a very simple term browser.
% There are a number of features that haven't been incorporated:
+%
% - Scripting language that allows precise control over
% how types are printed.
% - User preferences, which use the scripting language
% to allow user control beyond the provided defaults.
-% - Node expansion and contraction in the style of
-% Windows Explorer.
+% - Node expansion and contraction in the style of Windows Explorer.
%
% authors: aet
% stability: low
@@ -32,7 +34,7 @@
% this predicate is exported to be used by C code, no browser term
% mode function can be supplied.
%
-:- pred browse__browse_browser_term_no_modes(browser_term::in,
+:- pred browse_browser_term_no_modes(browser_term::in,
io__input_stream::in, io__output_stream::in, maybe(list(dir))::out,
browser_persistent_state::in, browser_persistent_state::out,
io::di, io::uo) is cc_multi.
@@ -40,7 +42,7 @@
% The interactive term browser. The caller type will be `browse' and
% the default format for the `browse' caller type will be used.
%
-:- pred browse__browse_browser_term(browser_term::in,
+:- pred browse_browser_term(browser_term::in,
io__input_stream::in, io__output_stream::in,
maybe(browser_mode_func)::in, maybe(list(dir))::out,
browser_persistent_state::in, browser_persistent_state::out,
@@ -49,7 +51,7 @@
% Dump the term as an XML file and launch the XML browser specified
% by the xml_browser_cmd field in the browser_persistent_state.
%
-:- pred browse__save_and_browse_browser_term_xml(browser_term::in,
+:- pred save_and_browse_browser_term_xml(browser_term::in,
io__output_stream::in, io__output_stream::in,
browser_persistent_state::in, io::di, io::uo) is cc_multi.
@@ -57,14 +59,14 @@
% Again, this is exported to C code, so the browser term mode function
% can't be supplied.
%
-:- pred browse__browse_browser_term_format_no_modes(browser_term::in,
+:- pred browse_browser_term_format_no_modes(browser_term::in,
io__input_stream::in, io__output_stream::in, portray_format::in,
browser_persistent_state::in, browser_persistent_state::out,
io::di, io::uo) is cc_multi.
% As above, except that the supplied format will override the default.
%
-:- pred browse__browse_browser_term_format(browser_term::in,
+:- pred browse_browser_term_format(browser_term::in,
io__input_stream::in, io__output_stream::in, portray_format::in,
maybe(browser_mode_func)::in,
browser_persistent_state::in, browser_persistent_state::out,
@@ -75,7 +77,7 @@
% This version is exported for use in C code, so no browser term mode
% function can be supplied.
%
-:- pred browse__browse_external_no_modes(T::in, io__input_stream::in,
+:- pred browse_external_no_modes(T::in, io__input_stream::in,
io__output_stream::in,
browser_persistent_state::in, browser_persistent_state::out,
io::di, io::uo) is cc_multi.
@@ -83,7 +85,7 @@
% The browser interface for the external debugger. The caller type
% will be `browse', and the default format will be used.
%
-:- pred browse__browse_external(T::in, io__input_stream::in,
+:- pred browse_external(T::in, io__input_stream::in,
io__output_stream::in, maybe(browser_mode_func)::in,
browser_persistent_state::in, browser_persistent_state::out,
io::di, io::uo) is cc_multi.
@@ -92,23 +94,21 @@
% `print' or `print_all'. The default portray format for that
% caller type is used.
%
-:- pred browse__print_browser_term(browser_term::in,
+:- pred print_browser_term(browser_term::in,
io__output_stream::in, browse_caller_type::in,
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_browser_term_format(browser_term::in,
+:- pred print_browser_term_format(browser_term::in,
io__output_stream::in, browse_caller_type::in, portray_format::in,
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,
- % plus two characters for each argument: "(" and ")"
- % for the first, and ", " for each of the rest,
- % plus the sizes of the arguments themselves.
- % This is only approximate since it doesn't take into
- % account all the special cases such as operators.
+ % Estimate the total term size, in characters, We count the number of
+ % characters in the functor, plus two characters for each argument:
+ % "(" and ")" for the first, and ", " for each of the rest, plus the
+ % sizes of the arguments themselves. This is only approximate since it
+ % doesn't take into account all the special cases such as operators.
%
% This predicate returns not the estimated total term size,
% but the difference between the given maximum size the caller
@@ -118,26 +118,28 @@
% negative, term_size_left_from_max will return a negative difference
% but the value will usually not be accurate, since in such cases
% by definition the caller is not interested in the accurate value.
+ %
:- pred term_size_left_from_max(univ::in, int::in, int::out) is cc_multi.
-
:- pred browser_term_size_left_from_max(browser_term::in,
int::in, int::out) is cc_multi.
%---------------------------------------------------------------------------%
% save_term_to_file(FileName, Format, BrowserTerm, Out, !IO):
+ %
% Save BrowserTerm to the file FileName. If there is an error,
% print an error message to Out.
%
% The format of the saved term can be influenced by the Format
% argument, but how this works is not specified.
-
+ %
:- pred save_term_to_file(string::in, string::in, browser_term::in,
io__output_stream::in, io::di, io::uo) is cc_multi.
% save_term_to_file_xml(FileName, BrowserTerm, Out, !IO):
- % Save BrowserTerm to FileName as an XML document. If there
- % is an error, print an error message to Out.
+ %
+ % Save BrowserTerm to FileName as an XML document. If there is an error,
+ % print an error message to Out.
%
:- pred save_term_to_file_xml(string::in, browser_term::in,
io__output_stream::in, io::di, io::uo) is cc_multi.
@@ -170,15 +172,15 @@
% they are used in trace/mercury_trace_browser.c.
%
-:- pragma export(browse__browse_browser_term_no_modes(in, in, in, out, in, out,
+:- pragma export(browse_browser_term_no_modes(in, in, in, out, in, out,
di, uo), "ML_BROWSE_browse_browser_term").
-:- pragma export(browse__browse_browser_term_format_no_modes(in, in, in, in,
+:- pragma export(browse_browser_term_format_no_modes(in, in, in, in,
in, out, di, uo), "ML_BROWSE_browse_browser_term_format").
-:- pragma export(browse__browse_external_no_modes(in, in, in, in, out, di, uo),
+:- pragma export(browse_external_no_modes(in, in, in, in, out, di, uo),
"ML_BROWSE_browse_external").
-:- pragma export(browse__print_browser_term(in, in, in, in, di, uo),
+:- pragma export(print_browser_term(in, in, in, in, di, uo),
"ML_BROWSE_print_browser_term").
-:- pragma export(browse__print_browser_term_format(in, in, in, in, in, di, uo),
+:- pragma export(print_browser_term_format(in, in, in, in, in, di, uo),
"ML_BROWSE_print_browser_term_format").
:- pragma export(save_term_to_file(in, in, in, in, di, uo),
@@ -187,7 +189,7 @@
:- pragma export(save_term_to_file_xml(in, in, in, di, uo),
"ML_BROWSE_save_term_to_file_xml").
-:- pragma export(browse__save_and_browse_browser_term_xml(in, in, in, in,
+:- pragma export(save_and_browse_browser_term_xml(in, in, in, in,
di, uo), "ML_BROWSE_browse_term_xml").
%---------------------------------------------------------------------------%
@@ -304,43 +306,36 @@
FileStreamRes = error(_)
).
-browse__save_and_browse_browser_term_xml(Term, OutStream, ErrStream, State,
- !IO) :-
+save_and_browse_browser_term_xml(Term, OutStream, ErrStream, State, !IO) :-
MaybeXMLBrowserCmd = State ^ xml_browser_cmd,
(
MaybeXMLBrowserCmd = yes(CommandStr),
MaybeTmpFileName = State ^ xml_tmp_filename,
(
MaybeTmpFileName = yes(TmpFileName),
- io.write_string(OutStream,
- "Saving term to XML file...\n", !IO),
+ io.write_string(OutStream, "Saving term to XML file...\n", !IO),
maybe_save_term_to_file_xml(TmpFileName, Term,
SaveResult, !IO),
(
SaveResult = ok,
- launch_xml_browser(OutStream, ErrStream,
- CommandStr, !IO)
+ launch_xml_browser(OutStream, ErrStream, CommandStr, !IO)
;
SaveResult = error(Error),
io.error_message(Error, Msg),
io.write_string(ErrStream,
- "Error opening file `" ++
- TmpFileName ++ "': ", !IO),
+ "Error opening file `" ++ TmpFileName ++ "': ", !IO),
io.write_string(ErrStream, Msg, !IO),
io.nl(!IO)
)
;
MaybeTmpFileName = no,
- io.write_string(ErrStream,
- "mdb: You need to issue a " ++
- "\"set xml_tmp_filename '<filename>'\" " ++
- " command first.\n", !IO)
+ io.write_string(ErrStream, "mdb: You need to issue a " ++
+ "\"set xml_tmp_filename '<filename>'\" command first.\n", !IO)
)
;
MaybeXMLBrowserCmd = no,
io.write_string(ErrStream, "mdb: You need to issue a " ++
- "\"set xml_browser_cmd '<command>'\" " ++
- " command first.\n", !IO)
+ "\"set xml_browser_cmd '<command>'\" command first.\n", !IO)
).
:- pred launch_xml_browser(io.output_stream::in, io.output_stream::in,
@@ -364,19 +359,16 @@
;
io.write_string(ErrStream,
"mdb: The command `" ++ CommandStr ++
- "' terminated with a non-zero exit "++
- "code.\n", !IO)
+ "' terminated with a non-zero exit code.\n", !IO)
)
;
ExitStatus = signalled(_),
- io.write_string(ErrStream, "mdb: The browser " ++
- "was killed.\n", !IO)
+ io.write_string(ErrStream, "mdb: The browser was killed.\n", !IO)
)
;
Result = error(Error),
- io.write_string(ErrStream, "mdb: Error launching browser"
- ++ ": " ++ string.string(Error) ++
- ".\n", !IO)
+ io.write_string(ErrStream, "mdb: Error launching browser: "
+ ++ string.string(Error) ++ ".\n", !IO)
).
:- pred save_univ(int::in, univ::in, io::di, io::uo) is cc_multi.
@@ -457,28 +449,24 @@
% Non-interactive display
%
-browse__print_browser_term(Term, OutputStream, Caller, State, !IO) :-
- browse__print_common(Term, OutputStream, Caller, no, State, !IO).
+print_browser_term(Term, OutputStream, Caller, State, !IO) :-
+ print_common(Term, OutputStream, Caller, no, State, !IO).
-browse__print_browser_term_format(Term, OutputStream, Caller, Format,
- State, !IO):-
- browse__print_common(Term, OutputStream, Caller, yes(Format),
- State, !IO).
+print_browser_term_format(Term, OutputStream, Caller, Format, State, !IO):-
+ print_common(Term, OutputStream, Caller, yes(Format), State, !IO).
-:- pred browse__print_common(browser_term::in, io__output_stream::in,
+:- pred print_common(browser_term::in, io__output_stream::in,
browse_caller_type::in, maybe(portray_format)::in,
browser_persistent_state::in, io::di, io::uo) is cc_multi.
-browse__print_common(BrowserTerm, OutputStream, Caller, MaybeFormat, State,
- !IO):-
+print_common(BrowserTerm, OutputStream, Caller, MaybeFormat, State, !IO):-
Info = browser_info__init(BrowserTerm, Caller, MaybeFormat, no, 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
@@ -495,33 +483,31 @@
% Interactive display
%
-browse__browse_browser_term_no_modes(Term, InputStream, OutputStream,
+browse_browser_term_no_modes(Term, InputStream, OutputStream,
MaybeMark, !State, !IO) :-
browse_common(internal, Term, InputStream, OutputStream, no, no,
MaybeMark, !State, !IO).
-browse__browse_browser_term(Term, InputStream, OutputStream, MaybeModeFunc,
+browse_browser_term(Term, InputStream, OutputStream, MaybeModeFunc,
MaybeMark, !State, !IO) :-
browse_common(internal, Term, InputStream, OutputStream, no,
MaybeModeFunc, MaybeMark, !State, !IO).
-browse__browse_browser_term_format_no_modes(Term, InputStream, OutputStream,
+browse_browser_term_format_no_modes(Term, InputStream, OutputStream,
Format, !State, !IO) :-
browse_common(internal, Term, InputStream, OutputStream, yes(Format),
no, _, !State, !IO).
-browse__browse_browser_term_format(Term, InputStream, OutputStream,
+browse_browser_term_format(Term, InputStream, OutputStream,
Format, MaybeModeFunc, !State, !IO) :-
browse_common(internal, Term, InputStream, OutputStream, yes(Format),
MaybeModeFunc, _, !State, !IO).
-browse__browse_external_no_modes(Term, InputStream, OutputStream, !State, !IO)
- :-
+browse_external_no_modes(Term, InputStream, OutputStream, !State, !IO) :-
browse_common(external, plain_term(univ(Term)),
InputStream, OutputStream, no, no, _, !State, !IO).
-browse__browse_external(Term, InputStream, OutputStream, MaybeModeFunc, !State,
- !IO) :-
+browse_external(Term, InputStream, OutputStream, MaybeModeFunc, !State, !IO) :-
browse_common(external, plain_term(univ(Term)),
InputStream, OutputStream, no, MaybeModeFunc, _, !State, !IO).
@@ -550,8 +536,7 @@
browse_main_loop(Debugger, !Info, !IO) :-
(
Debugger = internal,
- prompt(Prompt),
- parse__read_command(Prompt, Command, !IO)
+ parse__read_command(prompt, Command, !IO)
;
Debugger = external,
parse__read_command_external(Command, !IO)
@@ -577,9 +562,9 @@
write_string_debugger(Debugger, "-- Simple Mercury Term Browser.\n"),
write_string_debugger(Debugger, "-- Type \"help\" for help.\n\n").
-:- pred prompt(string::out) is det.
+:- func prompt = string.
-prompt("browser> ").
+prompt = "browser> ".
:- pred run_command(debugger::in, command::in, bool::out,
browser_info::in, browser_info::out, io::di, io::uo) is cc_multi.
@@ -595,8 +580,7 @@
Command = unknown,
write_string_debugger(Debugger,
"Error: unknown command or syntax error.\n", !IO),
- write_string_debugger(Debugger,
- "Type \"help\" for help.\n", !IO),
+ write_string_debugger(Debugger, "Type \"help\" for help.\n", !IO),
Quit = no
;
Command = help,
@@ -634,8 +618,7 @@
Quit = no
;
Command = print(PrintOption, MaybePath),
- do_portray(Debugger, browse, PrintOption, !.Info,
- MaybePath, !IO),
+ do_portray(Debugger, browse, PrintOption, !.Info, MaybePath, !IO),
Quit = no
;
Command = pwd,
@@ -656,15 +639,14 @@
Quit = yes
;
SubResult = deref_error(_, _),
- write_string_debugger(Debugger,
- "error: cannot mark subterm\n", !IO),
+ write_string_debugger(Debugger, "error: cannot mark subterm\n",
+ !IO),
Quit = no
)
;
Command = mode_query,
MaybeModeFunc = !.Info ^ maybe_mode_func,
- write_term_mode_debugger(Debugger, MaybeModeFunc,
- !.Info ^ dirs, !IO),
+ write_term_mode_debugger(Debugger, MaybeModeFunc, !.Info ^ dirs, !IO),
Quit = no
;
Command = mode_query(Path),
@@ -677,8 +659,7 @@
Quit = yes
;
Command = display,
- write_string_debugger(Debugger,
- "command not yet implemented\n", !IO),
+ write_string_debugger(Debugger, "command not yet implemented\n", !IO),
Quit = no
;
Command = write,
@@ -686,22 +667,22 @@
"command not yet implemented\n", !IO),
Quit = no
),
- ( Debugger = external ->
+ (
+ Debugger = external,
send_term_to_socket(browser_end_command, !IO)
;
- true
+ Debugger = internal
).
:- pred do_portray(debugger::in, browse_caller_type::in,
maybe(maybe_option_table(format_option))::in, browser_info::in,
maybe(path)::in, io::di, io::uo) is cc_multi.
-do_portray(Debugger, CallerType, MaybeMaybeOptionTable, Info,
- MaybePath, !IO) :-
+do_portray(Debugger, CallerType, MaybeMaybeOptionTable, Info, MaybePath,
+ !IO) :-
(
MaybeMaybeOptionTable = no,
- portray_maybe_path(Debugger, CallerType, no, Info,
- MaybePath, !IO)
+ portray_maybe_path(Debugger, CallerType, no, Info, MaybePath, !IO)
;
MaybeMaybeOptionTable = yes(MaybeOptionTable),
(
@@ -709,8 +690,8 @@
interpret_format_options(OptionTable, FormatResult),
(
FormatResult = ok(MaybeFormat),
- portray_maybe_path(Debugger, CallerType,
- MaybeFormat, Info, MaybePath, !IO)
+ portray_maybe_path(Debugger, CallerType, MaybeFormat, Info,
+ MaybePath, !IO)
;
FormatResult = error(Msg),
write_string_debugger(Debugger, Msg, !IO)
@@ -858,16 +839,14 @@
io::di, io::uo) is cc_multi.
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
- % can. However, io__write doesn't have a depth or size limit,
- % so we need to check the size first; if the term is small
- % enough, we use io__write (actually io__write_univ), otherwise
+ % io__write handles the special cases such as lists, operators, etc better,
+ % so we prefer to use it if we can. However, io__write doesn't have
+ % a depth or size limit, so we need to check the size first; if the term
+ % is small enough, we use io__write (actually io__write_univ), otherwise
% we use term_to_string/4.
%
- % XXX this ignores the maximum number of lines
- %
+ % XXX This ignores the maximum number of lines.
+
browser_term_size_left_from_max(BrowserTerm, max_print_size,
RemainingSize),
( RemainingSize >= 0 ->
@@ -890,9 +869,10 @@
!IO) :-
io__write_string(Functor, !IO),
io__output_stream(Stream, !IO),
- ( Args = [] ->
- true
+ (
+ Args = []
;
+ Args = [_ | _],
io__write_string("(", !IO),
io__write_list(Args, ", ", write_univ_or_unbound(Stream), !IO),
io__write_string(")", !IO)
@@ -934,6 +914,7 @@
write_string_debugger(Debugger, Str, !IO).
% The maximum estimated size for which we use `io__write'.
+ %
:- func max_print_size = int.
max_print_size = 60.
@@ -950,8 +931,8 @@
% "()", plus Arity-1 times ", "
PrincipalSize = FunctorSize + Arity * 2,
MaxArgsSize = MaxSize - PrincipalSize,
- list__foldl(term_size_left_from_max,
- Args, MaxArgsSize, RemainingSize)
+ list__foldl(term_size_left_from_max, Args,
+ MaxArgsSize, RemainingSize)
;
MaybeFunctorArityArgs = no,
RemainingSize = -1
@@ -978,8 +959,7 @@
PrincipalSize = FunctorSize + Arity * 2
),
MaxArgsSize = MaxSize - PrincipalSize,
- list__foldl(term_size_left_from_max,
- Args, MaxArgsSize, RemainingSize)
+ list__foldl(term_size_left_from_max, Args, MaxArgsSize, RemainingSize)
).
:- pred write_univ_or_unbound(io__output_stream::in, univ::in, io::di, io::uo)
@@ -1021,10 +1001,10 @@
browser_term_to_string_2(BrowserDb, BrowserTerm,
MaxSize, CurSize, _NewSize, MaxDepth, CurDepth, Str).
- % Note: When the size limit is reached, we simply display
- % further subterms compressed. This is consistent with the
- % User's Guide, which describes the size limit as a "suggested
- % maximum".
+ % Note: When the size limit is reached, we simply display further subterms
+ % compressed. This is consistent with the User's Guide, which describes
+ % the size limit as a "suggested maximum".
+ %
:- pred browser_term_to_string_2(browser_db::in, browser_term::in,
int::in, int::in, int::out, int::in, int::in, string::out) is cc_multi.
@@ -1055,9 +1035,8 @@
Args = [ListHead, ListTail],
MaybeReturn = no
->
- % For the purposes of size and depth, we treat lists as if
- % they consist of one functor plus an argument for each
- % element of the list.
+ % For the purposes of size and depth, we treat lists as if they consist
+ % of one functor plus an argument for each element of the list.
Size1 = Size0 + 1,
Depth1 = Depth0 + 1,
browser_term_to_string_2(BrowserDb, plain_term(ListHead),
@@ -1082,10 +1061,9 @@
(
MaybeReturn = yes(Return),
browser_term_to_string_2(BrowserDb, plain_term(Return),
- MaxSize, Size2, Size, MaxDepth, Depth1,
- ReturnStr),
- string__append_list([Functor, BracketedArgsStr,
- " = ", ReturnStr], Str)
+ MaxSize, Size2, Size, MaxDepth, Depth1, ReturnStr),
+ string__append_list([Functor, BracketedArgsStr, " = ", ReturnStr],
+ Str)
;
MaybeReturn = no,
Size = Size2,
@@ -1099,7 +1077,6 @@
list_tail_to_string_list(BrowserDb, TailUniv, MaxSize, Size0, Size,
MaxDepth, Depth0, TailStrs) :-
-
% We want the limit to be at least two to ensure that the limited
% deconstruct won't fail for any list term.
Limit = max(MaxSize, 2),
@@ -1123,13 +1100,10 @@
Size0 < MaxSize,
Depth0 < MaxDepth
->
- browser_term_to_string_2(BrowserDb,
- plain_term(ListHead),
- MaxSize, Size0, Size1,
- MaxDepth, Depth0, HeadStr),
- list_tail_to_string_list(BrowserDb, ListTail,
- MaxSize, Size1, Size, MaxDepth, Depth0,
- TailStrs0),
+ browser_term_to_string_2(BrowserDb, plain_term(ListHead),
+ MaxSize, Size0, Size1, MaxDepth, Depth0, HeadStr),
+ list_tail_to_string_list(BrowserDb, ListTail, MaxSize,
+ Size1, Size, MaxDepth, Depth0, TailStrs0),
TailStrs = [", ", HeadStr | TailStrs0]
;
Size = Size0,
@@ -1140,15 +1114,12 @@
Size0 < MaxSize,
Depth0 < MaxDepth
->
- browser_term_to_string_3(BrowserDb,
- Functor, Args, MaybeReturn,
- MaxSize, Size0, Size,
- MaxDepth, Depth0, TailStr),
+ browser_term_to_string_3(BrowserDb, Functor, Args, MaybeReturn,
+ MaxSize, Size0, Size, MaxDepth, Depth0, TailStr),
TailStrs = [" | ", TailStr]
;
Size = Size0,
- browser_term_compress(BrowserDb,
- plain_term(TailUniv),
+ browser_term_compress(BrowserDb, plain_term(TailUniv),
TailCompressedStr),
TailStrs = [" | ", TailCompressedStr]
)
@@ -1180,9 +1151,11 @@
:- func bracket_string_list(list(string)) = string.
bracket_string_list(Args) = Str :-
- ( Args = [] ->
+ (
+ Args = [],
Str = ""
;
+ Args = [_ | _],
string__append_list(["(", comma_string_list(Args), ")"], Str)
).
@@ -1220,12 +1193,11 @@
).
%---------------------------------------------------------------------------%
-%
-% Print using the pretty printer from the standard library.
-% XXX the size of the term is not limited---the pretty printer
-% provides no way of doing this.
-%
+ % Print using the pretty printer from the standard library.
+ % XXX The size of the term is not limited -- the pretty printer
+ % provides no way of doing this.
+ %
:- pred browser_term_to_string_pretty(browser_term::in, int::in, int::in,
string::out) is det.
@@ -1239,11 +1211,10 @@
Str = to_string(Width, Doc).
%---------------------------------------------------------------------------%
-%
-% Verbose printing. Tree layout with numbered branches.
-% Numbering makes it easier to change to subterms.
-%
+ % Verbose printing. Tree layout with numbered branches.
+ % Numbering makes it easier to change to subterms.
+ %
:- pred browser_term_to_string_verbose(browser_db::in, browser_term::in,
int::in, int::in, int::in, int::in, string::out) is cc_multi.
@@ -1253,7 +1224,7 @@
CurDepth = 0,
browser_term_to_string_verbose_2(BrowserDb, BrowserTerm,
MaxSize, CurSize, _NewSize, MaxDepth, CurDepth, Frame),
- frame__clip(X-Y, Frame, ClippedFrame),
+ ClippedFrame = frame__clip(X-Y, Frame),
unlines(ClippedFrame, Str).
:- pred browser_term_to_string_verbose_2(browser_db::in, browser_term::in,
@@ -1268,7 +1239,7 @@
CurDepth < MaxDepth,
MaybeFunctorArityArgs = yes({Functor, _Arity, Args0})
->
- % XXX we should consider formatting function terms differently.
+ % XXX We should consider formatting function terms differently.
(
MaybeReturn = yes(Return),
list__append(Args0, [Return], Args)
@@ -1280,9 +1251,8 @@
CurDepth1 = CurDepth + 1,
ArgNum = 1,
args_to_string_verbose_list(BrowserDb, Args, ArgNum,
- MaxSize, CurSize1, NewSize, MaxDepth, CurDepth1,
- ArgsFrame),
- frame__vglue([Functor], ArgsFrame, Frame)
+ MaxSize, CurSize1, NewSize, MaxDepth, CurDepth1, ArgsFrame),
+ Frame = frame__vglue([Functor], ArgsFrame)
;
browser_term_compress(BrowserDb, BrowserTerm, Line),
Frame = [Line],
@@ -1303,25 +1273,23 @@
% XXX: ArgNumS must have fixed length 2.
string__int_to_string(ArgNum, ArgNumS),
string__append_list([ArgNumS, "-"], LastBranchS),
- frame__hglue([LastBranchS], TreeFrame, Frame).
+ Frame = frame__hglue([LastBranchS], TreeFrame).
args_to_string_verbose_list(BrowserDb, [Univ1, Univ2 | Univs], ArgNum, MaxSize,
CurSize, NewSize, MaxDepth, CurDepth, Frame) :-
browser_term_to_string_verbose_2(BrowserDb, plain_term(Univ1),
MaxSize, CurSize, NewSize1, MaxDepth, CurDepth, TreeFrame),
ArgNum1 = ArgNum + 1,
args_to_string_verbose_list(BrowserDb, [Univ2 | Univs], ArgNum1,
- MaxSize, NewSize1, NewSize2, MaxDepth, CurDepth,
- RestTreesFrame),
+ MaxSize, NewSize1, NewSize2, MaxDepth, CurDepth, RestTreesFrame),
NewSize = NewSize2,
% XXX: ArgNumS must have fixed length 2.
string__int_to_string(ArgNum, ArgNumS),
string__append_list([ArgNumS, "-"], BranchFrameS),
- frame__vsize(TreeFrame, Height),
- Height1 = Height - 1,
- list__duplicate(Height1, "|", VBranchFrame),
- frame__vglue([BranchFrameS], VBranchFrame, LeftFrame),
- frame__hglue(LeftFrame, TreeFrame, TopFrame),
- frame__vglue(TopFrame, RestTreesFrame, Frame).
+ Height = frame__vsize(TreeFrame) - 1,
+ list__duplicate(Height, "|", VBranchFrame),
+ LeftFrame = frame__vglue([BranchFrameS], VBranchFrame),
+ TopFrame = frame__hglue(LeftFrame, TreeFrame),
+ Frame = frame__vglue(TopFrame, RestTreesFrame).
:- pred unlines(list(string)::in, string::out) is det.
@@ -1433,11 +1401,9 @@
->
deref_subterm_2(ArgUniv, SimplifiedPathTail,
[Step | RevPath0], SubResult),
- deref_result_univ_to_browser_term(SubResult,
- Result)
+ deref_result_univ_to_browser_term(SubResult, Result)
;
- Result = deref_error(list__reverse(RevPath0),
- Step)
+ Result = deref_error(list__reverse(RevPath0), Step)
)
)
).
@@ -1470,18 +1436,14 @@
(
TypeCtor = type_ctor(univ_type(Univ)),
type_ctor_name(TypeCtor) = "array",
- type_ctor_module_name(TypeCtor) =
- "array"
+ type_ctor_module_name(TypeCtor) = "array"
->
- % The first element of an array
- % is at index zero.
+ % The first element of an array is at index zero.
ArgN = argument(univ_value(Univ), N)
;
- % The first argument of a non-array is
- % numbered argument 1 by the user
- % but argument 0 by std_util:argument.
- ArgN = argument(univ_value(Univ),
- N - 1)
+ % The first argument of a non-array is numbered argument 1
+ % by the user but argument 0 by deconstruct.argument.
+ ArgN = argument(univ_value(Univ), N - 1)
)
;
Dir = child_name(Name),
@@ -1563,21 +1525,15 @@
show_settings_caller(Debugger, Info, Caller, CallerName, !IO) :-
browser_info__get_format(Info, Caller, no, Format),
- write_string_debugger(Debugger,
- CallerName ++ " default format: ", !IO),
+ write_string_debugger(Debugger, CallerName ++ " default format: ", !IO),
print_format_debugger(Debugger, Format, !IO),
nl_debugger(Debugger, !IO),
- write_string_debugger(Debugger,
- pad_right("", ' ', row_name_len), !IO),
- write_string_debugger(Debugger,
- pad_right("depth", ' ', depth_len), !IO),
- write_string_debugger(Debugger,
- pad_right("size", ' ', size_len), !IO),
- write_string_debugger(Debugger,
- pad_right("x clip", ' ', x_len), !IO),
- write_string_debugger(Debugger,
- pad_right("y clip", ' ', y_len), !IO),
+ write_string_debugger(Debugger, pad_right("", ' ', row_name_len), !IO),
+ write_string_debugger(Debugger, pad_right("depth", ' ', depth_len), !IO),
+ write_string_debugger(Debugger, pad_right("size", ' ', size_len), !IO),
+ write_string_debugger(Debugger, pad_right("x clip", ' ', x_len), !IO),
+ write_string_debugger(Debugger, pad_right("y clip", ' ', y_len), !IO),
nl_debugger(Debugger, !IO),
show_settings_caller_format(Debugger, Info, Caller, CallerName,
@@ -1598,8 +1554,7 @@
Format, FormatName, !IO) :-
browser_info__get_format_params(Info, Caller, Format, Params),
write_string_debugger(Debugger,
- pad_right(CallerName ++ " " ++ FormatName ++ ":",
- ' ', row_name_len),
+ pad_right(CallerName ++ " " ++ FormatName ++ ":", ' ', row_name_len),
!IO),
write_string_debugger(Debugger,
pad_right(" ", ' ', centering_len), !IO),
@@ -1697,7 +1652,8 @@
list.reverse(Dirs, RevDirs),
simplify_rev_dirs(RevDirs, 0, [], SimpleDirs).
- % simplify_rev_dirs(RevDirs, N, SoFar, SimpleDirs).
+ % simplify_rev_dirs(RevDirs, N, SoFar, SimpleDirs):
+ %
% Assumes a reverse list of directories and removes redundant `..'
% entries by scanning from the bottom most directory to the top,
% counting how many `..' occured (N) and removing entries accordingly.
@@ -1813,7 +1769,7 @@
% is not a natural term, but a synthetic term defined by a functor, a list
% of arguments, and if the synthetic term is a function application, then
% the result of that function application.
-
+ %
:- func synthetic_term_to_doc(string, list(univ), maybe(univ)) = doc.
:- func synthetic_term_to_doc(int, string, list(univ), maybe(univ)) = doc.
@@ -1832,8 +1788,7 @@
poly(i(Arity)) `<>` text("+1")
;
MaybeReturn = no,
- Doc = text(Functor) `<>` text("/") `<>`
- poly(i(Arity))
+ Doc = text(Functor) `<>` text("/") `<>` poly(i(Arity))
)
)
;
@@ -1845,20 +1800,15 @@
MaybeReturn = yes(Return),
Doc = group(
text(Functor) `<>`
- parentheses(
- nest(2, ArgDocs)
- ) `<>`
+ parentheses(nest(2, ArgDocs)) `<>`
nest(2, text(" = ") `<>`
- to_doc(Depth - 1,
- univ_value(Return))
+ to_doc(Depth - 1, univ_value(Return))
)
)
;
MaybeReturn = no,
Doc = group(
- text(Functor) `<>` parentheses(
- nest(2, ArgDocs)
- )
+ text(Functor) `<>` parentheses(nest(2, ArgDocs))
)
)
)
Index: browser/frame.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/frame.m,v
retrieving revision 1.8
diff -u -b -r1.8 frame.m
--- browser/frame.m 11 Jul 2005 07:30:20 -0000 1.8
+++ browser/frame.m 18 Oct 2005 01:40:26 -0000
@@ -1,16 +1,17 @@
%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
% Copyright (C) 1998-2000, 2003, 2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%---------------------------------------------------------------------------%
-
+%
% frame - minimally implements ASCII graphics frames.
% This module is used by the term browser for displaying terms.
%
% XXX: This implementation is:
% - very inefficient.
-% - specific to our immediate needs, and could be made more
-% general.
+% - specific to our immediate needs, and could be made more general.
%
% authors: aet
% stability: low
@@ -23,144 +24,125 @@
:- import_module std_util.
% XXX: Make frame type abstract instead?
-% :- type frame.
:- type frame == list(string).
% We always clip from top-left corner, hence only one pair of
% coordinates is needed.
-:- type frame__clip_rect == pair(int, int).
+:- type clip_rect == pair(int, int).
% Width of a frame (horizontal size).
-:- pred frame__hsize(frame, int).
-:- mode frame__hsize(in, out) is det.
+ %
+:- func hsize(frame) = int.
% Height of a frame (vertical size).
-:- pred frame__vsize(frame, int).
-:- mode frame__vsize(in, out) is det.
+ %
+:- func vsize(frame) = int.
% Create a frame from a string.
-:- pred frame__from_string(string, frame).
-:- mode frame__from_string(in, out) is det.
+ %
+:- func from_string(string) = frame.
% Stack (vertically glue) two frames, left-aligned.
-:- pred frame__vglue(frame, frame, frame).
-:- mode frame__vglue(in, in, out) is det.
+ %
+:- func vglue(frame, frame) = frame.
% Juxtapose (horizontally glue) two frames, top-aligned.
-:- pred frame__hglue(frame, frame, frame).
-:- mode frame__hglue(in, in, out) is det.
+ %
+:- func frame__hglue(frame, frame) = frame.
- % clip a frame, where cliprect originates in top-left corner of frame.
-:- pred frame__clip(frame__clip_rect, frame, frame).
-:- mode frame__clip(in, in, out) is det.
+ % Clip a frame to the rectangle ((0,0),(X,Y)) where origin is on the
+ % top-left. Coordinate axes go down and right.
+ %
+:- func clip(clip_rect, frame) = frame.
%---------------------------------------------------------------------------%
+
:- implementation.
:- import_module mdb.util.
+:- import_module assoc_list.
:- import_module int.
-:- import_module io.
:- import_module list.
:- import_module require.
:- import_module string.
-frame__from_string(Str, [Str]).
+from_string(Str) = [Str].
- % glue frames vertically (stack). align to left.
-frame__vglue(TopFrame, BottomFrame, StackedFrame) :-
+vglue(TopFrame, BottomFrame) = StackedFrame :-
+ % Glue frames vertically (stack). Align to left.
list__append(TopFrame, BottomFrame, StackedFrame).
- % glue frames horizontally (juxtapose). align to top.
-frame__hglue(LeftFrame, RightFrame, GluedFrame) :-
- frame__vsize(RightFrame, RVSize),
- frame__vsize(LeftFrame, LVSize),
+hglue(LeftFrame, RightFrame) = GluedFrame :-
+ % Glue frames horizontally (juxtapose). align to top.
+ RVSize = vsize(RightFrame),
+ LVSize = vsize(LeftFrame),
( RVSize < LVSize ->
PadLines = LVSize - RVSize,
- frame_lower_pad(RightFrame, PadLines, RightFrameNew),
+ RightFrameNew = frame_lower_pad(RightFrame, PadLines),
LeftFrameNew = LeftFrame
; LVSize < RVSize ->
PadLines = RVSize - LVSize,
- frame_lower_pad(LeftFrame, PadLines, LeftFrameNew),
+ LeftFrameNew = frame_lower_pad(LeftFrame, PadLines),
RightFrameNew = RightFrame
;
LeftFrameNew = LeftFrame,
RightFrameNew = RightFrame
),
frame_right_pad(LeftFrameNew, PaddedLeftFrameNew),
- % XXX: mmc doesn't yet handle this. Use more verbose version instead.
- % zip_with(string__append, PaddedLeftFrameNew, RightFrameNew,
- % GluedFrame).
util__zip_with((pred(S1::in, S2::in, S3::out) is det :-
- string__append(S1,S2,S3)),
+ string__append(S1, S2, S3)),
PaddedLeftFrameNew, RightFrameNew, GluedFrame).
% Add right padding. That is, add whitespace on right so that
% lines are all equal length.
-:- pred frame_right_pad(frame, frame).
-:- mode frame_right_pad(in, out) is det.
+ %
+:- pred frame_right_pad(frame::in, frame::out) is det.
+
frame_right_pad(Frame, PaddedFrame) :-
Lengths = list__map((func(Str) = string__length(Str)), Frame),
list__foldl(int__max, Lengths, 0, MaxLen),
list__map(subtract(MaxLen), Lengths, Paddings),
- add_right_padding(Frame, Paddings, PaddedFrame).
+ list__map(add_right_padding,
+ assoc_list__from_corresponding_lists(Frame, Paddings), PaddedFrame).
+
+:- pred add_right_padding(pair(string, int)::in, string::out) is det.
-:- pred add_right_padding(frame, list(int), frame).
-:- mode add_right_padding(in, in, out) is det.
-add_right_padding(Strs, Lens, PaddedFrame) :-
- ( (Strs = [], Lens = []) ->
- PaddedFrame = []
- ; (Strs = [S|Ss], Lens = [L|Ls]) ->
- list__duplicate(L, ' ', PadChars),
+add_right_padding(Str - Len, PaddedFrameStr) :-
+ list__duplicate(Len, ' ', PadChars),
string__from_char_list(PadChars, Padding),
- string__append(S, Padding, SP),
- add_right_padding(Ss, Ls, Rest),
- PaddedFrame = [SP|Rest]
- ;
- error("add_right_padding: list arguments are of unequal length")
- ).
+ string__append(Str, Padding, PaddedFrameStr).
% We need this since Mercury has no Haskell-ese operation sections.
-:- pred subtract(int, int, int).
-:- mode subtract(in, in, out) is det.
+ %
+:- pred subtract(int::in, int::in, int::out) is det.
+
subtract(M, X, Z) :-
Z = M - X.
% Add empty lines of padding to the bottom of a frame.
-:- pred frame_lower_pad(frame, int, frame).
-:- mode frame_lower_pad(in, in, out) is det.
-frame_lower_pad(Frame, PadLines, PaddedFrame) :-
+ %
+:- func frame_lower_pad(frame, int) = frame.
+
+frame_lower_pad(Frame, PadLines) = PaddedFrame :-
list__duplicate(PadLines, "", Padding),
list__append(Frame, Padding, PaddedFrame).
- % Horizontal size (width) of a frame
-frame__hsize(Frame, HSize) :-
+hsize(Frame) = HSize :-
Lengths = list__map(func(Str) = string__length(Str), Frame),
list__foldl(int__max, Lengths, 0, MaxLen),
HSize = MaxLen.
- % Vertical size (height) of a frame.
-frame__vsize(Frame, VSize) :-
+vsize(Frame) = VSize :-
length(Frame, VSize).
- % Clip a frame to the rectangle ((0,0),(X,Y)) where
- % origin is on the top-left. Coordinate axes go down and right.
-frame__clip(X-Y, Frame, ClippedFrame) :-
+clip(X-Y, Frame) = ClippedFrame :-
list__take_upto(Y, Frame, YClippedFrame),
list__map(left(X), YClippedFrame, ClippedFrame).
-:- pred left(int, string, string).
-:- mode left(in, in, out) is det.
+:- pred left(int::in, string::in, string::out) is det.
+
left(N, Str, Left) :-
string__left(Str, N, Left).
-
-:- pred frame__print(frame, io__state, io__state).
-:- mode frame__print(in, di, uo) is det.
-frame__print([]) -->
- { true }.
-frame__print([L|Ls]) -->
- io__write_string(L),
- io__nl,
- frame__print(Ls).
%---------------------------------------------------------------------------%
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/add_mode.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_mode.m,v
retrieving revision 1.3
diff -u -b -r1.3 add_mode.m
--- compiler/add_mode.m 30 Sep 2005 08:08:15 -0000 1.3
+++ compiler/add_mode.m 17 Oct 2005 14:54:46 -0000
@@ -108,7 +108,7 @@
map__search(InstDefns, InstId0, InstDefn),
InstDefn = hlds_inst_defn(_, Params, Body, _, _),
Body = eqv_inst(EqvInst0),
- inst_substitute_arg_list(EqvInst0, Params, Args0, EqvInst),
+ inst_substitute_arg_list(Params, Args0, EqvInst0, EqvInst),
EqvInst = defined_inst(user_inst(Name, Args))
->
Arity = list__length(Args),
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.79
diff -u -b -r1.79 check_typeclass.m
--- compiler/check_typeclass.m 30 Sep 2005 08:08:16 -0000 1.79
+++ compiler/check_typeclass.m 17 Oct 2005 17:23:30 -0000
@@ -1,4 +1,6 @@
%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
% Copyright (C) 1996-2001, 2003-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -72,8 +74,8 @@
:- import_module io.
:- pred check_typeclass__check_typeclasses(make_hlds_qual_info::in,
- make_hlds_qual_info::out, module_info::in, module_info::out,
- bool::out, io::di, io::uo) is det.
+ make_hlds_qual_info::out, module_info::in, module_info::out, bool::out,
+ io::di, io::uo) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
@@ -129,15 +131,13 @@
maybe_write_string(Verbose,
"% Checking for missing concrete instances...\n", !IO),
- check_for_missing_concrete_instances(!ModuleInfo, FoundMissingError,
- !IO),
+ check_for_missing_concrete_instances(!ModuleInfo, FoundMissingError, !IO),
maybe_write_string(Verbose,
"% Checking functional dependencies on instances...\n", !IO),
check_functional_dependencies(!ModuleInfo, FoundFunDepError, !IO),
- maybe_write_string(Verbose,
- "% Checking typeclass constraints...\n", !IO),
+ maybe_write_string(Verbose, "% Checking typeclass constraints...\n", !IO),
check_constraints(!ModuleInfo, FoundConstraintsError, !IO),
FoundError = bool.or_list([FoundInstanceError, FoundCycleError,
@@ -170,8 +170,7 @@
list__reverse(Errors, ErrorList),
WriteError = (pred(E::in, IO0::di, IO::uo) is det :-
E = ErrorContext - ErrorPieces,
- write_error_pieces(ErrorContext, 0, ErrorPieces,
- IO0, IO)
+ write_error_pieces(ErrorContext, 0, ErrorPieces, IO0, IO)
),
list__foldl(WriteError, ErrorList, !IO),
io__set_exit_status(1, !IO),
@@ -215,15 +214,14 @@
InstanceDefns = InstanceDefns0
;
solutions(
- (pred(PredId::out) is nondet :-
+ ( pred(PredId::out) is nondet :-
list__member(ClassProc, ClassInterface),
ClassProc = hlds_class_proc(PredId, _)
),
PredIds),
list__map_foldl2(
- check_class_instance(ClassId, SuperClasses,
- ClassVars, ClassInterface, Interface,
- ClassVarSet, PredIds),
+ check_class_instance(ClassId, SuperClasses, ClassVars,
+ ClassInterface, Interface, ClassVarSet, PredIds),
InstanceDefns0, InstanceDefns,
!CheckTCInfo, !IO)
).
@@ -238,18 +236,16 @@
io::di, io::uo) is det.
check_class_instance(ClassId, SuperClasses, Vars, HLDSClassInterface,
- ClassInterface, ClassVarSet, PredIds,
- InstanceDefn0, InstanceDefn,
+ ClassInterface, ClassVarSet, PredIds, !InstanceDefn,
check_tc_info(Errors0, ModuleInfo0, QualInfo0),
check_tc_info(Errors, ModuleInfo, QualInfo),
!IO):-
- % check conformance of the instance body
- InstanceDefn0 = hlds_instance_defn(_, _, TermContext, _, _,
+ % Check conformance of the instance body.
+ !.InstanceDefn = hlds_instance_defn(_, _, TermContext, _, _,
InstanceBody, _, _, _),
(
InstanceBody = abstract,
- InstanceDefn1 = InstanceDefn0,
ModuleInfo = ModuleInfo0,
QualInfo = QualInfo0,
Errors1 = Errors0
@@ -258,13 +254,13 @@
check_concrete_class_instance(ClassId, Vars,
HLDSClassInterface, ClassInterface,
PredIds, TermContext, InstanceMethods,
- InstanceDefn0, InstanceDefn1, Errors0, Errors1,
+ !InstanceDefn, Errors0, Errors1,
ModuleInfo0, ModuleInfo, QualInfo0, QualInfo, !IO)
),
- % 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.
check_superclass_conformance(ClassId, SuperClasses, Vars, ClassVarSet,
- ModuleInfo, InstanceDefn1, InstanceDefn, Errors1, Errors).
+ ModuleInfo, !InstanceDefn, Errors1, Errors).
:- pred check_concrete_class_instance(class_id::in, list(tvar)::in,
hlds_class_interface::in, class_interface::in,
@@ -272,13 +268,11 @@
instance_methods::in, hlds_instance_defn::in, hlds_instance_defn::out,
error_messages::in, error_messages::out,
module_info::in, module_info::out,
- make_hlds_qual_info::in, make_hlds_qual_info::out, io::di, io::uo)
- is det.
+ make_hlds_qual_info::in, make_hlds_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, PredIds, TermContext, InstanceMethods, !InstanceDefn,
+ !Errors, !ModuleInfo, !QualInfo, !IO) :-
(
ClassInterface = abstract,
ClassId = class_id(ClassName, ClassArity),
@@ -293,19 +287,15 @@
ClassInterface = concrete(_),
InstanceCheckInfo0 = instance_check_info(!.InstanceDefn,
[], !.Errors, !.ModuleInfo, !.QualInfo),
- list__foldl2(
- check_instance_pred(ClassId, Vars, HLDSClassInterface),
+ list__foldl2(check_instance_pred(ClassId, Vars, HLDSClassInterface),
PredIds, InstanceCheckInfo0, InstanceCheckInfo, !IO),
InstanceCheckInfo = instance_check_info(!:InstanceDefn,
- RevInstanceMethods, !:Errors, !:ModuleInfo,
- !:QualInfo),
+ RevInstanceMethods, !:Errors, !:ModuleInfo, !:QualInfo),
- %
- % We need to make sure that the MaybePredProcs field is
- % set to yes(_) after this pass. Normally that will be
- % handled by check_instance_pred, but we also need to handle
- % it below, in case the class has no methods.
- %
+ % We need to make sure that the MaybePredProcs field is set to yes(_)
+ % after this pass. Normally that will be handled by
+ % check_instance_pred, but we also need to handle it below,
+ % in case the class has no methods.
MaybePredProcs1 = !.InstanceDefn ^ instance_hlds_interface,
(
MaybePredProcs1 = yes(_),
@@ -315,52 +305,43 @@
MaybePredProcs = yes([])
),
- %
- % Make sure the list of instance methods is in the same
- % order as the methods in the class definition. intermod.m
- % relies on this
+ % Make sure the list of instance methods is in the same order
+ % as the methods in the class definition. intermod.m relies on this.
OrderedInstanceMethods = list__reverse(RevInstanceMethods),
- !:InstanceDefn = ((!.InstanceDefn
- ^ instance_hlds_interface := MaybePredProcs)
- ^ instance_body := concrete(OrderedInstanceMethods)),
+ !:InstanceDefn = !.InstanceDefn ^ instance_hlds_interface
+ := MaybePredProcs,
+ !:InstanceDefn = !.InstanceDefn ^ 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.
- %
+ % Check if there are any instance methods left over, which did not
+ % match any of the methods from the class interface.
Context = !.InstanceDefn ^ instance_context,
check_for_bogus_methods(InstanceMethods, ClassId, PredIds,
Context, !.ModuleInfo, !Errors)
).
- %
- % Check if there are any instance methods left over,
- % which did not match any of the methods from the
- % class interface. If so, add an appropriate error
- % message to the list of error messages.
+ % Check if there are any instance methods left over, which did not match
+ % any of the methods from the class interface. If so, add an appropriate
+ % error message to the list of error messages.
%
:- 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, !Errors) :-
- module_info_get_predicate_table(ModuleInfo1, PredTable),
+ ModuleInfo, !Errors) :-
+ module_info_get_predicate_table(ModuleInfo, PredTable),
DefnIsOK = (pred(Method::in) is semidet :-
% Find this method definition's p/f, name, arity
- Method = instance_method(MethodPredOrFunc,
- 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
- % class interface
- adjust_func_arity(MethodPredOrFunc, MethodArity,
- MethodPredArity),
- predicate_table_search_pf_sym_arity(PredTable,
- is_fully_qualified, MethodPredOrFunc,
- MethodName, MethodPredArity, MatchingPredIds),
+ Method = instance_method(MethodPredOrFunc, 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 class interface.
+ adjust_func_arity(MethodPredOrFunc, MethodArity, MethodPredArity),
+ predicate_table_search_pf_sym_arity(PredTable, is_fully_qualified,
+ MethodPredOrFunc, MethodName, MethodPredArity, MatchingPredIds),
some [PredId] (
list__member(PredId, MatchingPredIds),
list__member(PredId, ClassPredIds)
@@ -372,10 +353,8 @@
BogusInstanceMethods = []
;
BogusInstanceMethods = [_ | _],
- %
% There were one or more bogus methods.
% Construct an appropriate error message.
- %
ClassId = class_id(ClassName, ClassArity),
ErrorMsgStart = [
words("In instance declaration for"),
@@ -383,8 +362,7 @@
suffix(":"),
words("incorrect method name(s):")
],
- ErrorMsgBody0 = list.map(format_method_name,
- BogusInstanceMethods),
+ ErrorMsgBody0 = list.map(format_method_name, BogusInstanceMethods),
ErrorMsgBody1 = list.condense(ErrorMsgBody0),
ErrorMsgBody = list__append(ErrorMsgBody1, [suffix(".")]),
NewError = Context - ( ErrorMsgStart ++ ErrorMsgBody ),
@@ -403,8 +381,8 @@
%----------------------------------------------------------------------------%
-:- 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
@@ -415,41 +393,35 @@
).
% This structure holds the information about a particular instance
- % method
-:- type instance_method_info --->
- instance_method_info(
+ % method.
+:- type instance_method_info
+ ---> instance_method_info(
module_info,
make_hlds_qual_info,
- sym_name, % Name that the
- % introduced pred
+ sym_name, % Name that the introduced pred
% should be given.
arity, % Arity of the method.
% (For funcs, this is
% the original arity,
% not the arity as a
% predicate.)
- existq_tvars, % Existentially quant.
- % type variables
- list(type), % Expected types of
- % arguments.
- prog_constraints, % Constraints from
- % class method.
- list(modes_and_detism), % Modes and
- % determinisms of the
+ existq_tvars, % Existentially quantified
+ % type variables.
+ list(type), % Expected types of arguments.
+ prog_constraints, % Constraints from class method.
+ list(modes_and_detism), % Modes and determinisms of the
% required procs.
- error_messages, % Error messages
- % that have been
+ error_messages, % Error messages that have been
% generated.
tvarset,
- import_status, % Import status of
- % instance decl.
- pred_or_func % Is method pred or
- % func?
+ import_status, % Import status of instance decl.
+ pred_or_func % Is method pred or func?
).
%----------------------------------------------------------------------------%
- % check one pred in one instance of one class
+ % Check one pred in one instance of one class.
+ %
:- 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,
@@ -468,11 +440,10 @@
pred_info_get_class_context(PredInfo, ClassContext0),
pred_info_get_markers(PredInfo, Markers0),
remove_marker(class_method, Markers0, Markers),
- % The first constraint in the class context of a class method
- % is always the constraint for the class of which it is
- % a member. Seeing that we are checking an instance
- % declaration, we don't check that constraint... the instance
- % declaration itself satisfies it!
+ % The first constraint in the class context of a class method is always
+ % the constraint for the class of which it is 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) ->
UnivCs = OtherUnivCs,
ClassContext = constraints(UnivCs, ExistCs)
@@ -480,7 +451,6 @@
unexpected(this_file,
"check_instance_pred: no constraint on class method")
),
-
MethodName0 = pred_info_name(PredInfo),
PredModule = pred_info_module(PredInfo),
MethodName = qualified(PredModule, MethodName0),
@@ -488,18 +458,16 @@
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
adjust_func_arity(PredOrFunc, Arity, PredArity),
pred_info_procedures(PredInfo, ProcTable),
- list__map((pred(TheProcId::in, ModesAndDetism::out) is det :-
+ list__map(
+ (pred(TheProcId::in, ModesAndDetism::out) is det :-
map__lookup(ProcTable, TheProcId, ProcInfo),
proc_info_argmodes(ProcInfo, Modes),
- % if the determinism declaration on the method
- % was omitted, then make_hlds.m will have
- % already issued an error message, so
- % don't complain here.
- proc_info_declared_determinism(ProcInfo,
- MaybeDetism),
+ % If the determinism declaration on the method was omitted,
+ % then make_hlds will have already issued an error message,
+ % so don't complain here.
+ proc_info_declared_determinism(ProcInfo, MaybeDetism),
proc_info_inst_varset(ProcInfo, InstVarSet),
- ModesAndDetism = modes_and_detism(Modes,
- InstVarSet, MaybeDetism)
+ ModesAndDetism = modes_and_detism(Modes, InstVarSet, MaybeDetism)
), ProcIds, ArgModes),
InstanceDefn0 = hlds_instance_defn(_, Status, _, _, InstanceTypes,
@@ -526,7 +494,11 @@
OrderedMethods, Errors, ModuleInfo, QualInfo).
:- type modes_and_detism
- ---> modes_and_detism(list(mode), inst_varset, maybe(determinism)).
+ ---> modes_and_detism(
+ list(mode),
+ inst_varset,
+ maybe(determinism)
+ ).
:- pred check_instance_pred_procs(class_id::in, list(tvar)::in, sym_name::in,
pred_markers::in, hlds_instance_defn::in, hlds_instance_defn::out,
@@ -547,10 +519,8 @@
Arity, MatchingInstanceMethods),
(
MatchingInstanceMethods = [InstanceMethod],
- OrderedInstanceMethods =
- [InstanceMethod | OrderedInstanceMethods0],
- InstanceMethod = instance_method(_, _, InstancePredDefn,
- _, Context),
+ OrderedInstanceMethods = [InstanceMethod | OrderedInstanceMethods0],
+ InstanceMethod = instance_method(_, _, InstancePredDefn, _, Context),
produce_auxiliary_procs(ClassId, ClassVars, Markers,
InstanceTypes, InstanceConstraints,
InstanceVarSet, InstanceModuleName,
@@ -558,8 +528,7 @@
InstancePredId, InstanceProcIds, Info0, Info, !IO),
MakeClassProc = (pred(TheProcId::in, PredProcId::out) is det :-
- PredProcId = hlds_class_proc(InstancePredId,
- TheProcId)
+ PredProcId = hlds_class_proc(InstancePredId, TheProcId)
),
list__map(MakeClassProc, InstanceProcIds, InstancePredProcs1),
(
@@ -575,20 +544,16 @@
InstanceBody, yes(InstancePredProcs), InstanceVarSet, I)
;
MatchingInstanceMethods = [I1, I2 | Is],
- %
- % duplicate method definition error
- %
+ % Duplicate method definition error.
OrderedInstanceMethods = OrderedInstanceMethods0,
InstanceDefn = InstanceDefn0,
ClassId = class_id(ClassName, _ClassArity),
- mdbcomp__prim_data__sym_name_to_string(MethodName,
- MethodNameString),
- mdbcomp__prim_data__sym_name_to_string(ClassName,
- ClassNameString),
+ sym_name_to_string(MethodName, MethodNameString),
+ sym_name_to_string(ClassName, ClassNameString),
PredOrFuncString = pred_or_func_to_string(PredOrFunc),
string__int_to_string(Arity, ArityString),
- InstanceTypesString = mercury_type_list_to_string(
- InstanceVarSet, InstanceTypes),
+ InstanceTypesString = mercury_type_list_to_string(InstanceVarSet,
+ InstanceTypes),
string__append_list([
"In instance declaration for `",
ClassNameString, "(", InstanceTypesString, ")': ",
@@ -606,24 +571,21 @@
ContextAndError = TheContext - Error
), [I2 | Is], SubsequentErrors),
- % errors are built up in reverse.
+ % Errors are built up in reverse.
list__append(SubsequentErrors, Heading, NewErrors),
list__append(NewErrors, Errors0, Errors),
- Info = instance_method_info(ModuleInfo, QualInfo, PredName,
- Arity, ExistQVars, ArgTypes, ClassContext,
- ArgModes, Errors, ArgTypeVars, Status, PredOrFunc)
+ Info = instance_method_info(ModuleInfo, QualInfo, PredName, Arity,
+ ExistQVars, ArgTypes, ClassContext, ArgModes, Errors, ArgTypeVars,
+ Status, PredOrFunc)
;
MatchingInstanceMethods = [],
- %
- % undefined method error
- %
+ % Undefined method error.
OrderedInstanceMethods = OrderedInstanceMethods0,
InstanceDefn = InstanceDefn0,
ClassId = class_id(ClassName, _ClassArity),
- mdbcomp__prim_data__sym_name_to_string(ClassName,
- ClassNameString),
- InstanceTypesString = mercury_type_list_to_string(
- InstanceVarSet, InstanceTypes),
+ sym_name_to_string(ClassName, ClassNameString),
+ InstanceTypesString = mercury_type_list_to_string(InstanceVarSet,
+ InstanceTypes),
Error = [words("In instance declaration for"),
fixed("`" ++ ClassNameString
@@ -643,7 +605,6 @@
ArgTypeVars, Status, PredOrFunc)
).
- %
% Get all the instance definitions which match the specified
% predicate/function name/arity, with multiple clause definitions
% being combined into a single definition.
@@ -654,14 +615,11 @@
get_matching_instance_defns(abstract, _, _, _, []).
get_matching_instance_defns(concrete(InstanceMethods), PredOrFunc, MethodName,
MethodArity, ResultList) :-
- %
% First find the instance method definitions that match this
% predicate/function's name and arity
- %
list__filter(
(pred(Method::in) is semidet :-
- Method = instance_method(PredOrFunc,
- MethodName, _MethodDefn,
+ Method = instance_method(PredOrFunc, MethodName, _MethodDefn,
MethodArity, _Context)
),
InstanceMethods, MatchingMethods),
@@ -673,27 +631,21 @@
DefnViaName = instance_method(_, _, name(_), _, _)
)
->
- %
- % If all of the instance method definitions for this
- % pred/func are clauses, and there are more than one
- % of them, then we must combine them all into a
- % single definition.
- %
+ % If all of the instance method definitions for this pred/func
+ % are clauses, and there are more than one of them, then we must
+ % combine them all into a single definition.
MethodToClause = (pred(Method::in, Clauses::out) is semidet :-
Method = instance_method(_, _, Defn, _, _),
Defn = clauses(Clauses)),
list__filter_map(MethodToClause, MatchingMethods, ClausesList),
list__condense(ClausesList, FlattenedClauses),
- CombinedMethod = instance_method(PredOrFunc,
- MethodName, clauses(FlattenedClauses),
- MethodArity, FirstContext),
+ CombinedMethod = instance_method(PredOrFunc, MethodName,
+ clauses(FlattenedClauses), MethodArity, FirstContext),
ResultList = [CombinedMethod]
;
- %
% If there are less than two matching method definitions,
- % or if any of the instance method definitions is a method
- % name, then we're done.
- %
+ % or if any of the instance method definitions is a method name,
+ % then we're done.
ResultList = MatchingMethods
).
@@ -713,7 +665,7 @@
Arity, ExistQVars0, ArgTypes0, ClassMethodClassContext0,
ArgModes, Errors, ArgTypeVars0, Status0, PredOrFunc),
- % Rename the instance variables apart from the class variables
+ % Rename the instance variables apart from the class variables.
tvarset_merge_renaming(ArgTypeVars0, InstanceVarSet, ArgTypeVars1,
Renaming),
apply_variable_renaming_to_type_list(Renaming, InstanceTypes0,
@@ -728,7 +680,7 @@
apply_subst_to_prog_constraints(TypeSubst, ClassMethodClassContext0,
ClassMethodClassContext1),
- % Get rid of any unwanted type variables
+ % Get rid of any unwanted type variables.
prog_type__vars_list(ArgTypes1, VarsToKeep0),
list__sort_and_remove_dups(VarsToKeep0, VarsToKeep),
varset__squash(ArgTypeVars1, VarsToKeep, ArgTypeVars, SquashSubst),
@@ -741,12 +693,10 @@
apply_variable_renaming_to_prog_constraint_list(SquashSubst,
InstanceConstraints1, InstanceConstraints),
- % Add the constraints from the instance declaration to the
- % constraints from the class method. This allows an instance
- % method to have constraints on it which are not part of the
- % instance declaration as a whole.
- ClassMethodClassContext = constraints(UnivConstraints1,
- ExistConstraints),
+ % Add the constraints from the instance declaration to the constraints
+ % from the class method. This allows an instance method to have constraints
+ % on it which are not part of the instance declaration as a whole.
+ ClassMethodClassContext = constraints(UnivConstraints1, ExistConstraints),
list__append(InstanceConstraints, UnivConstraints1, UnivConstraints),
ClassContext = constraints(UnivConstraints, ExistConstraints),
@@ -756,11 +706,10 @@
map__init(ConstraintMap),
add_marker(class_instance_method, Markers0, Markers1),
( InstancePredDefn = name(_) ->
- % For instance methods which are defined using the named
- % syntax (e.g. "pred(...) is ...") rather than the clauses
- % syntax, we record an additional marker; the only effect
- % of this marker is that we output slightly different
- % error messages for such predicates.
+ % For instance methods which are defined using the named syntax
+ % (e.g. "pred(...) is ...") rather than the clauses syntax, we record
+ % an additional marker; the only effect of this marker is that we
+ % output slightly different error messages for such predicates.
add_marker(named_class_instance_method, Markers1, Markers)
;
Markers = Markers1
@@ -779,9 +728,9 @@
PredArity, ArgTypes, Markers, Context, Status, ClausesInfo,
ModuleInfo0, ModuleInfo1, QualInfo0, QualInfo, !IO),
- % Fill in some information in the pred_info which is
- % used by polymorphism to make sure the type-infos
- % and typeclass-infos are added in the correct order.
+ % Fill in some information in the pred_info which is used by polymorphism
+ % to make sure the type-infos and typeclass-infos are added in the correct
+ % order.
MethodConstraints = instance_method_constraints(ClassId,
InstanceTypes, InstanceConstraints, ClassMethodClassContext),
pred_info_init(InstanceModuleName, PredName, PredArity, PredOrFunc,
@@ -798,17 +747,15 @@
MaybeDet, Context, address_is_taken,
OldPredInfo, NewPredInfo, NewProcId)
),
- list__map_foldl(AddProc, ArgModes, InstanceProcIds,
- PredInfo1, PredInfo),
+ list__map_foldl(AddProc, ArgModes, InstanceProcIds, PredInfo1, PredInfo),
module_info_get_predicate_table(ModuleInfo1, PredicateTable1),
module_info_get_partial_qualifier_info(ModuleInfo1, PQInfo),
- % XXX why do we need to pass may_be_unqualified here,
+ % XXX Why do we need to pass may_be_unqualified here,
% rather than passing must_be_qualified or calling the /4 version?
- predicate_table_insert(PredInfo, may_be_unqualified, PQInfo,
- PredId, PredicateTable1, PredicateTable),
- module_info_set_predicate_table(PredicateTable,
- ModuleInfo1, ModuleInfo),
+ predicate_table_insert(PredInfo, may_be_unqualified, PQInfo, PredId,
+ PredicateTable1, PredicateTable),
+ module_info_set_predicate_table(PredicateTable, ModuleInfo1, ModuleInfo),
Info = instance_method_info(ModuleInfo, QualInfo, PredName, Arity,
ExistQVars, ArgTypes, ClassContext, ArgModes, Errors,
@@ -820,19 +767,16 @@
% instance of a particular class method
%
% XXX This isn't quite perfect, I suspect
-
+ %
:- 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) :-
+make_introduced_pred_name(ClassId, MethodName, Arity, InstanceTypes,
+ PredName) :-
ClassId = class_id(ClassName, _ClassArity),
- mdbcomp__prim_data__sym_name_to_string(ClassName, "__",
- ClassNameString),
- mdbcomp__prim_data__sym_name_to_string(MethodName, "__",
- MethodNameString),
- % Perhaps we should include the arity in this mangled
- % string?
+ sym_name_to_string(ClassName, "__", ClassNameString),
+ sym_name_to_string(MethodName, "__", MethodNameString),
+ % Perhaps we should include the arity in this mangled string?
string__int_to_string(Arity, ArityString),
make_instance_string(InstanceTypes, InstanceString),
string__append_list(
@@ -846,6 +790,7 @@
% The prefix added to the class method name for the predicate
% used to call a class method for a specific instance.
+ %
:- func check_typeclass__introduced_pred_name_prefix = string.
check_typeclass__introduced_pred_name_prefix = "ClassMethod_for_".
@@ -854,55 +799,50 @@
% Check that the superclass constraints are satisfied for the
% types in this instance declaration.
-
+ %
:- pred check_superclass_conformance(class_id::in, list(prog_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, ProgSuperClasses0, ClassVars0,
- ClassVarSet, ModuleInfo, InstanceDefn0, InstanceDefn,
- Errors0, Errors) :-
+ ClassVarSet, ModuleInfo, InstanceDefn0, InstanceDefn, !Errors) :-
- InstanceDefn0 = hlds_instance_defn(A, B, Context,
- InstanceProgConstraints, InstanceTypes, F, G, InstanceVarSet0,
- Proofs0),
+ InstanceDefn0 = hlds_instance_defn(A, B, Context, InstanceProgConstraints,
+ InstanceTypes, F, G, InstanceVarSet0, Proofs0),
tvarset_merge_renaming(InstanceVarSet0, ClassVarSet, InstanceVarSet1,
Renaming),
- % Make the constraints in terms of the instance variables
+ % Make the constraints in terms of the instance variables.
apply_variable_renaming_to_prog_constraint_list(Renaming,
ProgSuperClasses0, ProgSuperClasses),
- % Now handle the class variables
+ % Now handle the class variables.
apply_variable_renaming_to_tvar_list(Renaming, ClassVars0, ClassVars),
- % Calculate the bindings
+ % Calculate the bindings.
map__from_corresponding_lists(ClassVars, InstanceTypes, TypeSubst),
module_info_get_class_table(ModuleInfo, ClassTable),
module_info_get_instance_table(ModuleInfo, InstanceTable),
module_info_get_superclass_table(ModuleInfo, SuperClassTable),
- % Build a suitable constraint context for checking the
- % instance. To do this, we assume any constraints on the
- % instance declaration (that is, treat them as universal
- % constraints on a predicate) and try to prove the constraints
- % on the class declaration (that is, treat them as existential
- % constraints on a predicate).
+ % Build a suitable constraint context for checking the instance.
+ % To do this, we assume any constraints on the instance declaration
+ % (that is, treat them as universal constraints on a predicate) and try
+ % to prove the constraints on the class declaration (that is, treat them
+ % as existential constraints on a predicate).
%
- % We don't bother assigning ids to these constraints, since
- % the resulting constraint map is not used anyway.
+ % We don't bother assigning ids to these constraints, since the resulting
+ % constraint map is not used anyway.
%
init_hlds_constraint_list(ProgSuperClasses, SuperClasses),
- init_hlds_constraint_list(InstanceProgConstraints,
- InstanceConstraints),
+ init_hlds_constraint_list(InstanceProgConstraints, InstanceConstraints),
make_hlds_constraints(ClassTable, InstanceVarSet1, SuperClasses,
InstanceConstraints, Constraints0),
- % Try to reduce the superclass constraints, using the declared
- % instance constraints and the usual context reduction rules.
- %
+ % Try to reduce the superclass constraints, using the declared instance
+ % constraints and the usual context reduction rules.
map__init(ConstraintMap0),
typeclasses__reduce_context_by_rule_application(ClassTable,
InstanceTable, SuperClassTable, ClassVars, TypeSubst, _,
@@ -913,17 +853,15 @@
(
UnprovenConstraints = [],
- Errors = Errors0,
InstanceDefn = hlds_instance_defn(A, B, Context,
InstanceProgConstraints, InstanceTypes, F, G,
InstanceVarSet2, Proofs1)
;
UnprovenConstraints = [_ | _],
ClassId = class_id(ClassName, _ClassArity),
- mdbcomp__prim_data__sym_name_to_string(ClassName,
- ClassNameString),
- InstanceTypesString = mercury_type_list_to_string(
- InstanceVarSet2, InstanceTypes),
+ sym_name_to_string(ClassName, ClassNameString),
+ InstanceTypesString = mercury_type_list_to_string(InstanceVarSet2,
+ InstanceTypes),
constraint_list_to_string(ClassVarSet, UnprovenConstraints,
ConstraintsString),
string__append_list([
@@ -932,7 +870,7 @@
"superclass constraint(s) not satisfied: ",
ConstraintsString, "."],
NewError),
- Errors = [Context - [words(NewError)] | Errors0],
+ !:Errors = [Context - [words(NewError)] | !.Errors],
InstanceDefn = InstanceDefn0
).
@@ -957,21 +895,17 @@
string__append_list([", `", String0, "'", String1], String).
%---------------------------------------------------------------------------%
-%
-% Check that every abstract instance in the interface of a module
-% has a corresponding concrete instance in the implementation.
-%
+ % Check that every abstract instance in the interface of a module
+ % has a corresponding concrete instance in the implementation.
+ %
:- pred check_for_missing_concrete_instances(
module_info::in, module_info::out, bool::out, io::di, io::uo) is det.
check_for_missing_concrete_instances(!ModuleInfo, FoundError, !IO) :-
module_info_get_instance_table(!.ModuleInfo, InstanceTable),
- %
- % Grab all the abstract instance declarations in the interface
- % of this module and all the concrete instances defined in the
- % implementation.
- %
+ % Grab all the abstract instance declarations in the interface of this
+ % module and all the concrete instances defined in the implementation.
gather_abstract_and_concrete_instances(InstanceTable,
AbstractInstances, ConcreteInstances),
map.foldl2(check_for_corresponding_instances(ConcreteInstances),
@@ -997,8 +931,7 @@
% class into two groups, those that are abstract and in the
% module interface and those that are concrete and in the module
% implementation. Concrete instances cannot occur in the
- % interface and we ignore abstract instances in the
- % implementation.
+ % interface and we ignore abstract instances in the implementation.
%
:- pred partition_instances_for_class(class_id::in,
list(hlds_instance_defn)::in, instance_table::in, instance_table::out,
@@ -1021,19 +954,16 @@
Body = InstanceDefn ^ instance_body,
(
Body = abstract,
- status_is_exported_to_non_submodules(ImportStatus,
- IsExported),
+ status_is_exported_to_non_submodules(ImportStatus, IsExported),
(
IsExported = yes,
- svmulti_map.add(ClassId, InstanceDefn,
- !Abstracts)
+ svmulti_map.add(ClassId, InstanceDefn, !Abstracts)
;
IsExported = no
)
;
Body = concrete(_),
- svmulti_map.add(ClassId, InstanceDefn,
- !Concretes)
+ svmulti_map.add(ClassId, InstanceDefn, !Concretes)
)
;
IsImported = yes
@@ -1062,20 +992,18 @@
->
MissingConcreteError = no
;
- % There were concrete instances for ClassId in the
- % implementation but none of them matches the
- % abstract instance we have.
+ % There were concrete instances for ClassId in the implementation
+ % but none of them matches the abstract instance we have.
MissingConcreteError = yes
)
;
- % There were no concrete instances for ClassId in the
- % implementation.
+ % There were no concrete instances for ClassId in the implementation.
MissingConcreteError = yes
),
(
MissingConcreteError = yes,
ClassId = class_id(ClassName, _),
- prim_data.sym_name_to_string(ClassName, ClassNameString),
+ sym_name_to_string(ClassName, ClassNameString),
AbstractTypesString = mercury_type_list_to_string(
AbstractInstance ^ instance_tvarset, AbstractTypes),
AbstractInstanceName = "`" ++ ClassNameString ++
@@ -1088,8 +1016,7 @@
words("instance in the implementation.")
],
AbstractInstanceContext = AbstractInstance ^ instance_context,
- write_error_pieces(AbstractInstanceContext, 0, ErrorPieces,
- !IO),
+ write_error_pieces(AbstractInstanceContext, 0, ErrorPieces, !IO),
!:FoundError = yes,
io.set_exit_status(1, !IO)
;
@@ -1097,13 +1024,12 @@
).
%-----------------------------------------------------------------------------%
-%
-% Check for cyclic classes in the class table by traversing the
-% class hierarchy for each class. While we are doing this, calculate
-% the set of ancestors with functional dependencies for each class,
-% and enter this information in the class table.
-%
+ % Check for cyclic classes in the class table by traversing the class
+ % hierarchy for each class. While we are doing this, calculate the set
+ % of ancestors with functional dependencies for each class, and enter
+ % this information in the class table.
+ %
:- pred check_for_cyclic_classes(module_info::in, module_info::out, bool::out,
io::di, io::uo) is det.
@@ -1128,8 +1054,8 @@
%
% Perform a depth first traversal of the class hierarchy, starting
% from ClassId. Path contains a list of nodes joining the current
- % node to the root. When we reach a node that has already been
- % visited, check whether there is a cycle in the Path.
+ % node to the root. When we reach a node that has already been visited,
+ % check whether there is a cycle in the Path.
%
:- pred find_cycles(class_path::in, class_id::in,
class_table::in, class_table::out,
@@ -1152,9 +1078,7 @@
Params = ClassDefn0 ^ class_vars,
Kinds = ClassDefn0 ^ class_kinds,
( set.member(ClassId, !.Visited) ->
- (
- find_cycle(ClassId, Path, [ClassId], Cycle)
- ->
+ ( find_cycle(ClassId, Path, [ClassId], Cycle) ->
!:Cycles = [Cycle | !.Cycles]
;
true
@@ -1163,10 +1087,7 @@
;
svset.insert(ClassId, !Visited),
- %
- % Make this class its own ancestor, but only if it
- % has fundeps on it.
- %
+ % Make this class its own ancestor, but only if it has fundeps on it.
FunDeps = ClassDefn0 ^ class_fundeps,
(
FunDeps = [],
@@ -1206,7 +1127,7 @@
NewAncestors),
list.append(NewAncestors, !Ancestors).
- % find_cycle(ClassId, PathRemaining, PathSoFar, Cycle)
+ % find_cycle(ClassId, PathRemaining, PathSoFar, Cycle):
%
% Check if ClassId is present in PathRemaining, and if so then make
% a cycle out of the front part of the path up to the point where
@@ -1235,8 +1156,7 @@
report_cyclic_classes(ClassTable, ClassPath, !IO) :-
(
ClassPath = [],
- unexpected(this_file,
- "report_cyclic_classes: empty cycle found.")
+ unexpected(this_file, "report_cyclic_classes: empty cycle found.")
;
ClassPath = [ClassId | Tail],
Context = map.lookup(ClassTable, ClassId) ^ class_context,
@@ -1327,19 +1247,19 @@
UnboundVars = []
;
UnboundVars = [_ | _],
- report_range_restriction_error(ClassId, InstanceDefn,
- UnboundVars, !IO),
+ report_range_restriction_error(ClassId, InstanceDefn, UnboundVars,
+ !IO),
!:FoundError = yes,
module_info_incr_errors(!ModuleInfo)
).
-% The error message is intended to look like this:
-%
-% very_long_module_name:001: In instance for typeclass `long_class/2':
-% very_long_module_name:001: functional dependency not satisfied: type
-% very_long_module_name:001: variables T1, T2 and T3 occur in the range of a
-% very_long_module_name:001: functional dependency, but are not in the
-% very_long_module_name:001: domain.
+ % The error message is intended to look like this:
+ %
+ % long_module_name:001: In instance for typeclass `long_class/2':
+ % long_module_name:001: functional dependency not satisfied: type
+ % long_module_name:001: variables T1, T2 and T3 occur in the range of a
+ % long_module_name:001: functional dependency, but are not in the
+ % long_module_name:001: domain.
:- pred report_range_restriction_error(class_id::in, hlds_instance_defn::in,
list(tvar)::in, io::di, io::uo) is det.
@@ -1349,8 +1269,7 @@
TVarSet = InstanceDefn ^ instance_tvarset,
Context = InstanceDefn ^ instance_context,
- VarsStrs = list.map(
- (func(Var) = mercury_var_to_string(Var, TVarSet, no)),
+ VarsStrs = list.map((func(Var) = mercury_var_to_string(Var, TVarSet, no)),
Vars),
Msg = [ words("In instance for typeclass"),
@@ -1376,8 +1295,7 @@
check_consistency(_, _, [], _, !ModuleInfo, !FoundError, !IO).
check_consistency(ClassId, ClassDefn, [Instance | Instances], FunDeps,
!ModuleInfo, !FoundError, !IO) :-
- list.foldl3(
- check_consistency_pair(ClassId, ClassDefn, FunDeps, Instance),
+ list.foldl3(check_consistency_pair(ClassId, ClassDefn, FunDeps, Instance),
Instances, !ModuleInfo, !FoundError, !IO),
check_consistency(ClassId, ClassDefn, Instances, FunDeps, !ModuleInfo,
!FoundError, !IO).
@@ -1390,8 +1308,7 @@
check_consistency_pair(ClassId, ClassDefn, FunDeps, InstanceA, InstanceB,
!ModuleInfo, !FoundError, !IO) :-
list.foldl3(
- check_consistency_pair_2(ClassId, ClassDefn, InstanceA,
- InstanceB),
+ check_consistency_pair_2(ClassId, ClassDefn, InstanceA, InstanceB),
FunDeps, !ModuleInfo, !FoundError, !IO).
:- pred check_consistency_pair_2(class_id::in, hlds_class_defn::in,
@@ -1413,16 +1330,12 @@
DomainA = restrict_list_elements(Domain, TypesA),
DomainB = restrict_list_elements(Domain, TypesB),
- (
- type_unify_list(DomainA, DomainB, [], map.init, Subst)
- ->
+ ( type_unify_list(DomainA, DomainB, [], map.init, Subst) ->
RangeA0 = restrict_list_elements(Range, TypesA),
RangeB0 = restrict_list_elements(Range, TypesB),
apply_rec_subst_to_type_list(Subst, RangeA0, RangeA),
apply_rec_subst_to_type_list(Subst, RangeB0, RangeB),
- (
- RangeA = RangeB
- ->
+ ( RangeA = RangeB ->
true
;
report_consistency_error(ClassId, ClassDefn, InstanceA,
@@ -1500,11 +1413,9 @@
->
true
;
- write_pred_progress_message(
- "% Checking typeclass constraints on ",
+ write_pred_progress_message("% Checking typeclass constraints on ",
PredId, !.ModuleInfo, !IO),
- check_pred_type_ambiguities(PredInfo, !ModuleInfo, !FoundError,
- !IO),
+ check_pred_type_ambiguities(PredInfo, !ModuleInfo, !FoundError, !IO),
check_constraint_quant(PredInfo, !ModuleInfo, !FoundError, !IO)
).
@@ -1525,11 +1436,9 @@
get_unbound_tvars(TVars, Constraints, !.ModuleInfo, UnboundTVars),
(
UnboundTVars = []
- ->
- true
;
- report_unbound_tvars_in_pred_context(UnboundTVars, PredInfo,
- !IO),
+ UnboundTVars = [_ | _],
+ report_unbound_tvars_in_pred_context(UnboundTVars, PredInfo, !IO),
!:FoundError = yes,
module_info_incr_errors(!ModuleInfo)
).
@@ -1540,9 +1449,7 @@
check_ctor_constraints(TypeTable, TypeCtor, !ModuleInfo, !FoundError, !IO) :-
map.lookup(TypeTable, TypeCtor, TypeDefn),
get_type_defn_body(TypeDefn, Body),
- (
- Body = du_type(Ctors, _, _, _, _, _)
- ->
+ ( Body = du_type(Ctors, _, _, _, _, _) ->
list.foldl3(check_ctor_type_ambiguities(TypeCtor, TypeDefn),
Ctors, !ModuleInfo, !FoundError, !IO)
;
@@ -1564,9 +1471,8 @@
!.ModuleInfo, UnboundTVars),
(
UnboundTVars = []
- ->
- true
;
+ UnboundTVars = [_ | _],
report_unbound_tvars_in_ctor_context(UnboundTVars, TypeCtor,
TypeDefn, !IO),
!:FoundError = yes,
@@ -1616,8 +1522,7 @@
induced_fundeps_2(ClassTable, constraint(Name, Args), FunDeps0) = FunDeps :-
Arity = length(Args),
ClassDefn = map.lookup(ClassTable, class_id(Name, Arity)),
- FunDeps = foldl(induced_fundep(Args), ClassDefn ^ class_fundeps,
- FunDeps0).
+ FunDeps = foldl(induced_fundep(Args), ClassDefn ^ class_fundeps, FunDeps0).
:- func induced_fundep(list(type), hlds_class_fundep, induced_fundeps)
= induced_fundeps.
@@ -1641,9 +1546,7 @@
:- func fundeps_closure_2(induced_fundeps, set(tvar), set(tvar)) = set(tvar).
fundeps_closure_2(FunDeps0, NewVars0, Result0) = Result :-
- (
- set.empty(NewVars0)
- ->
+ ( set.empty(NewVars0) ->
Result = Result0
;
Result1 = set.union(Result0, NewVars0),
@@ -1663,31 +1566,29 @@
induced_fundeps::out, set(tvar)::in, set(tvar)::out) is det.
collect_determined_vars(FunDep @ fundep(Domain, Range), !FunDeps, !Vars) :-
- (
- set.empty(Domain)
- ->
+ ( set.empty(Domain) ->
!:Vars = set.union(Range, !.Vars)
;
!:FunDeps = [FunDep | !.FunDeps]
).
-% The error message is intended to look like this:
-%
-% very_long_module_name:001: In declaration for function `long_function/2':
-% very_long_module_name:001: error in type class constraints: type variables
-% very_long_module_name:001: T1, T2 and T3 occur in the constraints, but are
-% very_long_module_name:001: not determined by the function's argument or
-% very_long_module_name:001: result types.
-%
-% very_long_module_name:002: In declaration for predicate `long_predicate/3':
-% very_long_module_name:002: error in type class constraints: type variable
-% very_long_module_name:002: T occurs in the constraints, but is not
-% very_long_module_name:002: determined by the predicate's argument types.
-%
-% very_long_module_name:002: In declaration for type `long_type/3':
-% very_long_module_name:002: error in type class constraints: type variable
-% very_long_module_name:002: T occurs in the constraints, but is not
-% very_long_module_name:002: determined by the constructor's argument types.
+ % The error message is intended to look like this:
+ %
+ % long_module_name:001: In declaration for function `long_function/2':
+ % long_module_name:001: error in type class constraints: type variables
+ % long_module_name:001: T1, T2 and T3 occur in the constraints, but are
+ % long_module_name:001: not determined by the function's argument or
+ % long_module_name:001: result types.
+ %
+ % long_module_name:002: In declaration for predicate `long_predicate/3':
+ % long_module_name:002: error in type class constraints: type variable
+ % long_module_name:002: T occurs in the constraints, but is not
+ % long_module_name:002: determined by the predicate's argument types.
+ %
+ % long_module_name:002: In declaration for type `long_type/3':
+ % long_module_name:002: error in type class constraints: type variable
+ % long_module_name:002: T occurs in the constraints, but is not
+ % long_module_name:002: determined by the constructor's argument types.
:- pred report_unbound_tvars_in_pred_context(list(tvar)::in, pred_info::in,
io::di, io::uo) is det.
@@ -1701,8 +1602,7 @@
Arity = length(ArgTypes),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
- VarsStrs = list.map(
- (func(Var) = mercury_var_to_string(Var, TVarSet, no)),
+ VarsStrs = list.map((func(Var) = mercury_var_to_string(Var, TVarSet, no)),
Vars),
Msg0 = [words("In declaration for"),
@@ -1734,8 +1634,7 @@
get_type_defn_tvarset(TypeDefn, TVarSet),
TypeCtor = SymName - Arity,
- VarsStrs = list.map(
- (func(Var) = mercury_var_to_string(Var, TVarSet, no)),
+ VarsStrs = list.map((func(Var) = mercury_var_to_string(Var, TVarSet, no)),
Vars),
Msg = [words("In declaration for type"),
@@ -1794,11 +1693,10 @@
).
%---------------------------------------------------------------------------%
-%
-% Check that all types appearing in universal (existential) constraints are
-% universally (existentially) quantified.
-%
+ % Check that all types appearing in universal (existential) constraints are
+ % universally (existentially) quantified.
+ %
:- pred check_constraint_quant(pred_info::in,
module_info::in, module_info::out, bool::in, bool::out,
io::di, io::uo) is det.
@@ -1833,8 +1731,7 @@
TVars = []
;
TVars = [_ | _],
- report_badly_quantified_vars(PredInfo, QuantErrorType, TVars,
- !IO),
+ report_badly_quantified_vars(PredInfo, QuantErrorType, TVars, !IO),
module_info_incr_errors(!ModuleInfo),
!:FoundError = yes,
io.set_exit_status(1, !IO)
Index: compiler/equiv_type.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/equiv_type.m,v
retrieving revision 1.49
diff -u -b -r1.49 equiv_type.m
--- compiler/equiv_type.m 12 Sep 2005 05:24:04 -0000 1.49
+++ compiler/equiv_type.m 17 Oct 2005 14:55:13 -0000
@@ -779,7 +779,7 @@
map__search(EqvInstMap, InstId,
eqv_inst_body(_, EqvInstParams, EqvInst))
->
- inst_substitute_arg_list(EqvInst, EqvInstParams, ArgInsts, Inst1),
+ inst_substitute_arg_list(EqvInstParams, ArgInsts, EqvInst, Inst1),
equiv_type__record_expanded_item(item_id(inst, InstId), !Info),
equiv_type__replace_in_inst(Inst1, EqvInstMap,
set__insert(ExpandedInstIds, InstId), Inst, !Info)
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.139
diff -u -b -r1.139 hlds_goal.m
--- compiler/hlds_goal.m 10 Oct 2005 07:54:34 -0000 1.139
+++ compiler/hlds_goal.m 18 Oct 2005 01:37:37 -0000
@@ -1045,7 +1045,9 @@
; first
; later.
-:- type maybe_cut ---> cut ; no_cut.
+:- type maybe_cut
+ ---> cut
+ ; no_cut.
% Convert a goal path to a string, using the format documented
% in the Mercury user's guide.
Index: compiler/mode_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.174
diff -u -b -r1.174 mode_util.m
--- compiler/mode_util.m 30 Sep 2005 08:08:28 -0000 1.174
+++ compiler/mode_util.m 17 Oct 2005 15:06:32 -0000
@@ -883,7 +883,7 @@
sym_name::in, list(inst)::in, (inst)::out) is det.
inst_lookup_subst_args(eqv_inst(Inst0), Params, _Name, Args, Inst) :-
- inst_substitute_arg_list(Inst0, Params, Args, Inst).
+ inst_substitute_arg_list(Params, Args, Inst0, Inst).
inst_lookup_subst_args(abstract_inst, _Params, Name, Args,
abstract_inst(Name, Args)).
@@ -1263,7 +1263,7 @@
InitialInsts, InstVarSub0), InstVarSub, !RI),
% Apply the inst_var substitution to the argument modes.
- mode_list_apply_substitution(ArgModes1, InstVarSub, ArgModes2),
+ mode_list_apply_substitution(InstVarSub, ArgModes1, ArgModes2),
% Calculate the final insts of the argument variables from their
% initial insts and the final insts of the called procedure
Index: compiler/modecheck_call.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modecheck_call.m,v
retrieving revision 1.59
diff -u -b -r1.59 modecheck_call.m
--- compiler/modecheck_call.m 27 Aug 2005 09:41:57 -0000 1.59
+++ compiler/modecheck_call.m 17 Oct 2005 14:55:34 -0000
@@ -315,7 +315,7 @@
modecheck_var_has_inst_list(Args0, InitialInsts, NeedExactMatch,
ArgOffset, InstVarSub, !ModeInfo),
mode_list_get_final_insts(ModuleInfo0, Modes, FinalInsts0),
- inst_list_apply_substitution(FinalInsts0, InstVarSub, FinalInsts),
+ inst_list_apply_substitution(InstVarSub, FinalInsts0, FinalInsts),
modecheck_set_var_inst_list(Args0, InitialInsts, FinalInsts,
ArgOffset, Args, ExtraGoals, !ModeInfo).
@@ -439,9 +439,9 @@
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
mode_list_get_initial_insts(ModuleInfo, ProcArgModes, InitialInsts0),
- inst_list_apply_substitution(InitialInsts0, InstVarSub, InitialInsts),
+ inst_list_apply_substitution(InstVarSub, InitialInsts0, InitialInsts),
mode_list_get_final_insts(ModuleInfo, ProcArgModes, FinalInsts0),
- inst_list_apply_substitution(FinalInsts0, InstVarSub, FinalInsts),
+ inst_list_apply_substitution(InstVarSub, FinalInsts0, FinalInsts),
modecheck_set_var_inst_list(ArgVars0, InitialInsts, FinalInsts,
ArgOffset, ArgVars, ExtraGoals, !ModeInfo),
proc_info_never_succeeds(ProcInfo, NeverSucceeds),
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.81
diff -u -b -r1.81 post_typecheck.m
--- compiler/post_typecheck.m 5 Oct 2005 06:33:50 -0000 1.81
+++ compiler/post_typecheck.m 17 Oct 2005 16:35:24 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1997-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -28,7 +30,6 @@
% so they need to be a separate "post-typecheck pass". For efficiency
% reasons, this is in fact done at the same time as purity analysis --
% the routines here are called from purity.m rather than mercury_compile.m.
-%
:- module check_hlds__post_typecheck.
:- interface.
@@ -45,75 +46,73 @@
:- import_module std_util.
:- import_module term.
- % post_typecheck__finish_preds(PredIds, ReportTypeErrors,
- % NumErrors, FoundTypeError, Module0, Module)
+ % finish_preds(PredIds, ReportTypeErrors, NumErrors, FoundTypeError,
+ % !Module):
%
% Check that all Aditi predicates have an `aditi__state' argument.
- % Check that the all of the types which have been inferred
- % for the variables in the clause do not contain any unbound type
- % variables other than those that occur in the types of head
- % variables, and that there are no unsatisfied type class
- % constraints, and if ReportErrors = yes, print appropriate
- % warning/error messages.
- % Also bind any unbound type variables to the type `void'.
- % Note that when checking assertions we take the conservative
- % approach of warning about unbound type variables. There may
- % be cases for which this doesn't make sense.
- % FoundTypeError will be `yes' if there were errors which
- % should prevent further processing (e.g. polymorphism or
- % mode analysis).
+ % Check that the all of the types which have been inferred for the
+ % variables in the clause do not contain any unbound type variables
+ % other than those that occur in the types of head variables, and that
+ % there are no unsatisfied type class constraints, and if
+ % ReportErrors = yes, print appropriate warning/error messages.
+ % Also bind any unbound type variables to the type `void'. Note that
+ % when checking assertions we take the conservative approach of warning
+ % about unbound type variables. There may be cases for which this doesn't
+ % make sense. FoundTypeError will be `yes' if there were errors which
+ % should prevent further processing (e.g. polymorphism or mode analysis).
%
-:- pred post_typecheck__finish_preds(list(pred_id)::in, bool::in,
- int::out, bool::out, module_info::in, module_info::out,
- io::di, io::uo) is det.
+:- pred finish_preds(list(pred_id)::in, bool::in, int::out, bool::out,
+ module_info::in, module_info::out, io::di, io::uo) is det.
% As above, but don't check for `aditi__state's and return
% the list of procedures containing unbound inst variables
% instead of reporting the errors directly.
%
-:- pred post_typecheck__finish_pred_no_io(module_info::in, list(proc_id)::out,
+:- pred finish_pred_no_io(module_info::in, list(proc_id)::out,
pred_info::in, pred_info::out) is det.
-:- pred post_typecheck__finish_imported_pred_no_io(module_info::in,
+:- pred finish_imported_pred_no_io(module_info::in,
list(proc_id)::out, pred_info::in, pred_info::out) is det.
-:- pred post_typecheck__finish_ill_typed_pred(module_info::in, pred_id::in,
+:- pred finish_ill_typed_pred(module_info::in, pred_id::in,
pred_info::in, pred_info::out, io::di, io::uo) is det.
- % Now that the assertion has finished being typechecked,
- % remove it from further processing and store it in the
- % assertion_table.
-:- pred post_typecheck__finish_promise(promise_type::in, pred_id::in,
+ % Now that the assertion has finished being typechecked, remove it
+ % from further processing and store it in the assertion_table.
+ %
+:- pred finish_promise(promise_type::in, pred_id::in,
module_info::in, module_info::out, io::di, io::uo) is det.
% Handle any unresolved overloading for a predicate call.
%
-:- pred post_typecheck__resolve_pred_overloading(list(prog_var)::in,
+:- pred resolve_pred_overloading(list(prog_var)::in,
pred_info::in, module_info::in, sym_name::in, sym_name::out,
pred_id::in, pred_id::out) is det.
- % Resolve overloading and fill in the argument modes
- % of a call to an Aditi builtin.
- % Check that a relation modified by one of the Aditi update
- % goals is a base relation.
+ % Resolve overloading and fill in the argument modes of a call
+ % to an Aditi builtin. Check that a relation modified by one of the
+ % Aditi update goals is a base relation.
%
-:- pred post_typecheck__finish_aditi_builtin(module_info::in, pred_info::in,
+:- pred finish_aditi_builtin(module_info::in, pred_info::in,
list(prog_var)::in, term__context::in,
aditi_builtin::in, aditi_builtin::out,
simple_call_id::in, simple_call_id::out, list(mode)::out,
maybe(aditi_builtin_error)::out) is det.
:- type aditi_builtin_error
- ---> aditi_update_of_derived_relation(prog_context,
- aditi_builtin, simple_call_id).
+ ---> aditi_update_of_derived_relation(
+ prog_context,
+ aditi_builtin,
+ simple_call_id
+ ).
:- pred report_aditi_builtin_error(aditi_builtin_error::in, io::di, io::uo)
is det.
- % Work out whether a var-functor unification is actually a function
- % call. If so, replace the unification goal with a call.
+ % Work out whether a var-functor unification is actually a function call.
+ % If so, replace the unification goal with a call.
%
-:- pred post_typecheck__resolve_unify_functor(prog_var::in, cons_id::in,
+:- pred resolve_unify_functor(prog_var::in, cons_id::in,
list(prog_var)::in, unify_mode::in, unification::in, unify_context::in,
hlds_goal_info::in, module_info::in, pred_info::in, pred_info::out,
vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
@@ -125,14 +124,15 @@
:- implementation.
:- import_module check_hlds__inst_match.
+:- import_module check_hlds__modecheck_call.
:- import_module check_hlds__mode_errors.
:- import_module check_hlds__mode_util.
-:- import_module check_hlds__modecheck_call.
-:- import_module check_hlds__type_util.
:- import_module check_hlds__typecheck.
+:- import_module check_hlds__type_util.
:- import_module hlds__assertion.
:- import_module hlds__goal_util.
:- import_module hlds__hlds_data.
+:- import_module hlds__hlds_error_util.
:- import_module hlds__hlds_out.
:- import_module hlds__special_pred.
:- import_module libs__globals.
@@ -141,8 +141,8 @@
:- import_module parse_tree__mercury_to_mercury.
:- import_module parse_tree__prog_mode.
:- import_module parse_tree__prog_out.
-:- import_module parse_tree__prog_util.
:- import_module parse_tree__prog_type.
+:- import_module parse_tree__prog_util.
:- import_module assoc_list.
:- import_module int.
@@ -154,111 +154,99 @@
%-----------------------------------------------------------------------------%
-post_typecheck__finish_preds(PredIds, ReportTypeErrors, NumErrors,
+finish_preds(PredIds, ReportTypeErrors, NumErrors,
FoundTypeError, !ModuleInfo, !IO) :-
- post_typecheck__finish_preds(PredIds, ReportTypeErrors,
- !ModuleInfo, 0, NumErrors0, no, FoundTypeError0, !IO),
- check_for_missing_definitions(!.ModuleInfo,
- NumErrors0, NumErrors, FoundTypeError0, FoundTypeError,
- !IO).
+ finish_preds(PredIds, ReportTypeErrors, !ModuleInfo,
+ 0, NumErrors0, no, FoundTypeError0, !IO),
+ check_for_missing_definitions(!.ModuleInfo, NumErrors0, NumErrors,
+ FoundTypeError0, FoundTypeError, !IO).
-:- pred post_typecheck__finish_preds(list(pred_id)::in, bool::in,
+:- pred finish_preds(list(pred_id)::in, bool::in,
module_info::in, module_info::out, int::in, int::out,
bool::in, bool::out, io::di, io::uo) is det.
-post_typecheck__finish_preds([], _, !ModuleInfo, !NumErrors,
- !PostTypecheckError, !IO).
-post_typecheck__finish_preds([PredId | PredIds], ReportTypeErrors,
- !ModuleInfo, !NumErrors, !FoundTypeError, !IO) :-
- module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
+finish_preds([], _, !ModuleInfo, !NumErrors, !PostTypecheckError, !IO).
+finish_preds([PredId | PredIds], ReportTypeErrors, !ModuleInfo, !NumErrors,
+ !FoundTypeError, !IO) :-
+ some [!PredInfo] (
+ module_info_pred_info(!.ModuleInfo, PredId, !:PredInfo),
(
- ( pred_info_is_imported(PredInfo0)
- ; pred_info_is_pseudo_imported(PredInfo0)
+ ( pred_info_is_imported(!.PredInfo)
+ ; pred_info_is_pseudo_imported(!.PredInfo)
)
->
- post_typecheck__finish_imported_pred(!.ModuleInfo, PredId,
- PredInfo0, PredInfo, !IO)
+ finish_imported_pred(!.ModuleInfo, PredId, !PredInfo, !IO)
;
- %
% Only report error messages for unbound type variables
% if we didn't get any type errors already; this avoids
% a lot of spurious diagnostics.
- %
- post_typecheck__check_type_bindings(!.ModuleInfo, PredId,
- PredInfo0, PredInfo1, ReportTypeErrors,
- UnboundTypeErrsInThisPred, !IO),
+ check_type_bindings(!.ModuleInfo, PredId, !PredInfo,
+ ReportTypeErrors, UnboundTypeErrsInThisPred, !IO),
- %
- % if there were any unsatisfied type class constraints,
- % then that can cause internal errors in polymorphism.m
- % if we try to continue, so we need to halt compilation
- % after this pass.
- %
+ % If there were any unsatisfied type class constraints, then that
+ % can cause internal errors in polymorphism.m if we try to continue,
+ % so we need to halt compilation after this pass.
( UnboundTypeErrsInThisPred \= 0 ->
!:FoundTypeError = yes
;
true
),
- post_typecheck__finish_pred_no_io(!.ModuleInfo,
- ErrorProcs, PredInfo1, PredInfo2),
- report_unbound_inst_vars(!.ModuleInfo, PredId,
- ErrorProcs, PredInfo2, PredInfo3, !IO),
+ finish_pred_no_io(!.ModuleInfo, ErrorProcs, !PredInfo),
+ report_unbound_inst_vars(!.ModuleInfo, PredId, ErrorProcs,
+ !PredInfo, !IO),
check_for_indistinguishable_modes(!.ModuleInfo, PredId,
- PredInfo3, PredInfo, !IO),
+ !PredInfo, !IO),
- %
- % check that main/2 has the right type
- %
- ( ReportTypeErrors = yes ->
- check_type_of_main(PredInfo, !IO)
+ % Check that main/2 has the right type.
+ (
+ ReportTypeErrors = yes,
+ check_type_of_main(!.PredInfo, !IO)
;
- true
+ ReportTypeErrors = no
),
- %
- % Check that all Aditi predicates have an `aditi__state'
- % argument. This must be done after typechecking because
- % of type inference -- the types of some Aditi predicates
- % may not be known before.
- %
- pred_info_get_markers(PredInfo, Markers),
- ( ReportTypeErrors = yes, check_marker(Markers, aditi) ->
- check_aditi_state(!.ModuleInfo, PredInfo, !IO)
+ % Check that all Aditi predicates have an `aditi__state' argument.
+ % This must be done after typechecking because of type inference
+ % -- the types of some Aditi predicates may not be known before.
+ pred_info_get_markers(!.PredInfo, Markers),
+ (
+ ReportTypeErrors = yes,
+ check_marker(Markers, aditi)
+ ->
+ check_aditi_state(!.ModuleInfo, !.PredInfo, !IO)
;
true
),
!:NumErrors = !.NumErrors + UnboundTypeErrsInThisPred
),
- module_info_set_pred_info(PredId, PredInfo, !ModuleInfo),
- post_typecheck__finish_preds(PredIds, ReportTypeErrors,
- !ModuleInfo, !NumErrors, !FoundTypeError, !IO).
+ module_info_set_pred_info(PredId, !.PredInfo, !ModuleInfo),
+ finish_preds(PredIds, ReportTypeErrors,
+ !ModuleInfo, !NumErrors, !FoundTypeError, !IO)
+ ).
%-----------------------------------------------------------------------------%
-% Check for unbound type variables
-%
-% Check that the all of the types which have been inferred
-% for the variables in the clause do not contain any unbound type
-% variables other than those that occur in the types of head
-% variables, and that there are no unsatisfied type class constraints.
-:- pred post_typecheck__check_type_bindings(module_info::in, pred_id::in,
- pred_info::in, pred_info::out, bool::in, int::out, io::di, io::uo)
- is det.
+ % Check that the all of the types which have been inferred for the
+ % variables in the clause do not contain any unbound type variables
+ % other than those that occur in the types of head variables, and that
+ % there are no unsatisfied type class constraints.
+ %
+:- pred check_type_bindings(module_info::in, pred_id::in,
+ pred_info::in, pred_info::out, bool::in, int::out, io::di, io::uo) is det.
-post_typecheck__check_type_bindings(ModuleInfo, PredId, !PredInfo, ReportErrs,
- NumErrors, !IO) :-
+check_type_bindings(ModuleInfo, PredId, !PredInfo, ReportErrs, NumErrors,
+ !IO) :-
(
ReportErrs = yes,
pred_info_get_unproven_body_constraints(!.PredInfo,
UnprovenConstraints0),
- UnprovenConstraints0 \= []
+ UnprovenConstraints0 = [_ | _]
->
- list__sort_and_remove_dups(UnprovenConstraints0,
- UnprovenConstraints),
- report_unsatisfied_constraints(UnprovenConstraints,
- PredId, !.PredInfo, ModuleInfo, !IO),
+ list__sort_and_remove_dups(UnprovenConstraints0, UnprovenConstraints),
+ report_unsatisfied_constraints(UnprovenConstraints, PredId,
+ !.PredInfo, ModuleInfo, !IO),
list__length(UnprovenConstraints, NumErrors)
;
NumErrors = 0
@@ -270,30 +258,25 @@
clauses_info_vartypes(ClausesInfo0, VarTypesMap0),
map__to_assoc_list(VarTypesMap0, VarTypesList),
set__init(Set0),
- check_type_bindings_2(VarTypesList, HeadTypeParams, [], Errs,
- Set0, Set),
- ( Errs = [] ->
- true
+ check_type_bindings_2(VarTypesList, HeadTypeParams, [], Errs, Set0, Set),
+ (
+ Errs = []
;
- ( ReportErrs = yes ->
- %
- % report the warning
- %
- report_unresolved_type_warning(Errs, PredId,
- !.PredInfo, ModuleInfo, VarSet, !IO)
+ Errs = [_ | _],
+ (
+ ReportErrs = yes,
+ report_unresolved_type_warning(Errs, PredId, !.PredInfo,
+ ModuleInfo, VarSet, !IO)
;
- true
+ ReportErrs = no
),
- %
- % bind all the type variables in `Set' to `void' ...
- %
+ % Bind all the type variables in `Set' to `void' ...
pred_info_get_constraint_proofs(!.PredInfo, Proofs0),
pred_info_get_constraint_map(!.PredInfo, ConstraintMap0),
- bind_type_vars_to_void(Set, VarTypesMap0, VarTypesMap,
- Proofs0, Proofs, ConstraintMap0, ConstraintMap),
- clauses_info_set_vartypes(VarTypesMap,
- ClausesInfo0, ClausesInfo),
+ bind_type_vars_to_void(Set, VarTypesMap0, VarTypesMap, Proofs0, Proofs,
+ ConstraintMap0, ConstraintMap),
+ clauses_info_set_vartypes(VarTypesMap, ClausesInfo0, ClausesInfo),
pred_info_set_clauses_info(ClausesInfo, !PredInfo),
pred_info_set_constraint_proofs(Proofs, !PredInfo),
pred_info_set_constraint_map(ConstraintMap, !PredInfo)
@@ -316,99 +299,91 @@
),
check_type_bindings_2(VarTypes, HeadTypeParams, !Errs, !Set).
-%
-% bind all the type variables in `UnboundTypeVarsSet' to the type `void' ...
-%
+ % Bind all the type variables in `UnboundTypeVarsSet' to the type `void'.
+ %
:- pred bind_type_vars_to_void(set(tvar)::in, vartypes::in, vartypes::out,
constraint_proof_map::in, constraint_proof_map::out,
constraint_map::in, constraint_map::out) is det.
bind_type_vars_to_void(UnboundTypeVarsSet, !VarTypesMap, !Proofs,
!ConstraintMap) :-
- %
% Create a substitution that maps all of the unbound type variables
% to `void'.
- %
MapToVoid = (pred(TVar::in, Subst0::in, Subst::out) is det :-
map__det_insert(Subst0, TVar, void_type, Subst)
),
set__fold(MapToVoid, UnboundTypeVarsSet, map__init, VoidSubst),
- %
% Then apply the substitution we just created to the various maps.
- %
apply_subst_to_type_map(VoidSubst, !VarTypesMap),
apply_subst_to_constraint_proofs(VoidSubst, !Proofs),
apply_subst_to_constraint_map(VoidSubst, !ConstraintMap).
%-----------------------------------------------------------------------------%
-%
-% report an error: unsatisfied type class constraints
-%
+
+ % Report an error: unsatisfied type class constraints.
+ %
:- pred report_unsatisfied_constraints(list(prog_constraint)::in,
pred_id::in, pred_info::in, module_info::in, io::di, io::uo) is det.
-report_unsatisfied_constraints(Constraints, PredId, PredInfo, ModuleInfo) -->
- io__set_exit_status(1),
+report_unsatisfied_constraints(Constraints, PredId, PredInfo, ModuleInfo,
+ !IO) :-
+ io__set_exit_status(1, !IO),
+
+ pred_info_typevarset(PredInfo, TVarSet),
+ pred_info_context(PredInfo, Context),
- { pred_info_typevarset(PredInfo, TVarSet) },
- { pred_info_context(PredInfo, Context) },
+ prog_out__write_context(Context, !IO),
+ io__write_string("In ", !IO),
+ hlds_out__write_pred_id(ModuleInfo, PredId, !IO),
+ io__write_string(":\n", !IO),
- prog_out__write_context(Context),
- io__write_string("In "),
- hlds_out__write_pred_id(ModuleInfo, PredId),
- io__write_string(":\n"),
-
- prog_out__write_context(Context),
- io__write_string(
- " type error: unsatisfied typeclass constraint(s):\n"),
-
- prog_out__write_context(Context),
- io__write_string(" "),
- { AppendVarnums = no },
+ prog_out__write_context(Context, !IO),
+ io__write_string(" type error: unsatisfied typeclass constraint(s):\n",
+ !IO),
+
+ prog_out__write_context(Context, !IO),
+ io__write_string(" ", !IO),
+ AppendVarnums = no,
io__write_list(Constraints, ", ",
- mercury_output_constraint(TVarSet, AppendVarnums)),
- io__write_string(".\n").
+ mercury_output_constraint(TVarSet, AppendVarnums), !IO),
+ io__write_string(".\n", !IO).
-%
-% report a warning: uninstantiated type parameter
-%
+ % Report a warning: uninstantiated type parameter.
+ %
:- pred report_unresolved_type_warning(assoc_list(prog_var, (type))::in,
pred_id::in, pred_info::in, module_info::in, prog_varset::in,
io::di, io::uo) is det.
-report_unresolved_type_warning(Errs, PredId, PredInfo, ModuleInfo, VarSet) -->
- globals__io_lookup_bool_option(halt_at_warn, HaltAtWarn),
- ( { HaltAtWarn = yes } ->
- io__set_exit_status(1)
- ;
- []
- ),
-
- { pred_info_typevarset(PredInfo, TypeVarSet) },
- { pred_info_context(PredInfo, Context) },
-
- prog_out__write_context(Context),
- io__write_string("In "),
- hlds_out__write_pred_id(ModuleInfo, PredId),
- io__write_string(":\n"),
-
- prog_out__write_context(Context),
- io__write_string(" warning: unresolved polymorphism.\n"),
- prog_out__write_context(Context),
- ( { Errs = [_] } ->
- io__write_string(" The variable with an unbound type was:\n")
- ;
- io__write_string(" The variables with unbound types were:\n")
- ),
- write_type_var_list(Errs, Context, VarSet, TypeVarSet),
- prog_out__write_context(Context),
- io__write_string(" The unbound type variable(s) will be implicitly\n"),
- prog_out__write_context(Context),
- io__write_string(" bound to the builtin type `void'.\n"),
- globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
+report_unresolved_type_warning(Errs, PredId, PredInfo, ModuleInfo, VarSet,
+ !IO) :-
+ record_warning(!IO),
+
+ pred_info_typevarset(PredInfo, TypeVarSet),
+ pred_info_context(PredInfo, Context),
+
+ prog_out__write_context(Context, !IO),
+ io__write_string("In ", !IO),
+ hlds_out__write_pred_id(ModuleInfo, PredId, !IO),
+ io__write_string(":\n", !IO),
+
+ prog_out__write_context(Context, !IO),
+ io__write_string(" warning: unresolved polymorphism.\n", !IO),
+ prog_out__write_context(Context, !IO),
+ ( Errs = [_] ->
+ io__write_string(" The variable with an unbound type was:\n", !IO)
+ ;
+ io__write_string(" The variables with unbound types were:\n", !IO)
+ ),
+ write_type_var_list(Errs, Context, VarSet, TypeVarSet, !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string(" The unbound type variable(s) will be implicitly\n",
+ !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string(" bound to the builtin type `void'.\n", !IO),
+ globals__io_lookup_bool_option(verbose_errors, VerboseErrors, !IO),
(
- { VerboseErrors = yes },
+ VerboseErrors = yes,
io__write_strings([
"\tThe body of the clause contains a call to a polymorphic predicate,\n",
"\tbut I can't determine which version should be called,\n",
@@ -417,10 +392,10 @@
% XXX improve error message
"\t(I ought to tell you which call caused the problem, but I'm afraid\n",
"\tyou'll have to work it out yourself. My apologies.)\n"
- ])
+ ], !IO)
;
- { VerboseErrors = no },
- globals.io_set_extra_error_info(yes)
+ VerboseErrors = no,
+ globals.io_set_extra_error_info(yes, !IO)
).
:- pred write_type_var_list(assoc_list(prog_var, (type))::in, prog_context::in,
@@ -437,28 +412,24 @@
write_type_var_list(Rest, Context, VarSet, TVarSet, !IO).
%-----------------------------------------------------------------------------%
-% resolve predicate overloading
-% In the case of a call to an overloaded predicate, typecheck.m
-% does not figure out the correct pred_id. We must do that here.
+resolve_pred_overloading(Args0, CallerPredInfo, ModuleInfo, !PredName,
+ !PredId) :-
+ % In the case of a call to an overloaded predicate, typecheck.m
+ % does not figure out the correct pred_id. We must do that here.
-post_typecheck__resolve_pred_overloading(Args0, CallerPredInfo,
- ModuleInfo, PredName0, PredName, PredId0, PredId) :-
- ( PredId0 = invalid_pred_id ->
- %
+ ( !.PredId = invalid_pred_id ->
% Find the set of candidate pred_ids for predicates which
- % have the specified name and arity
- %
+ % have the specified name and arity.
pred_info_typevarset(CallerPredInfo, TVarSet),
pred_info_get_markers(CallerPredInfo, Markers),
pred_info_clauses_info(CallerPredInfo, ClausesInfo),
clauses_info_vartypes(ClausesInfo, VarTypes),
map__apply_to_list(Args0, VarTypes, ArgTypes),
typecheck__resolve_pred_overloading(ModuleInfo, Markers,
- ArgTypes, TVarSet, PredName0, PredName, PredId)
+ ArgTypes, TVarSet, !PredName, !:PredId)
;
- PredId = PredId0,
- PredName = get_qualified_pred_name(ModuleInfo, PredId)
+ !:PredName = get_qualified_pred_name(ModuleInfo, !.PredId)
).
:- func get_qualified_pred_name(module_info, pred_id) = sym_name.
@@ -471,16 +442,15 @@
%-----------------------------------------------------------------------------%
-post_typecheck__finish_aditi_builtin(ModuleInfo, CallerPredInfo, Args, Context,
+finish_aditi_builtin(ModuleInfo, CallerPredInfo, Args, Context,
aditi_tuple_update(Update, PredId0), Builtin,
- PredOrFunc - SymName0/Arity, InsertCallId,
- Modes, MaybeError) :-
- % make_hlds.m checks the arity, so this is guaranteed to succeed.
+ PredOrFunc - SymName0/Arity, InsertCallId, Modes, MaybeError) :-
+ % Make_hlds checks the arity, so this is guaranteed to succeed.
get_state_args_det(Args, OtherArgs, _, _),
- % The tuple to insert has the same argument types as
- % the relation being inserted into.
- post_typecheck__resolve_pred_overloading(OtherArgs, CallerPredInfo,
+ % The tuple to insert has the same argument types as the relation
+ % being inserted into.
+ resolve_pred_overloading(OtherArgs, CallerPredInfo,
ModuleInfo, SymName0, SymName, PredId0, PredId),
Builtin = aditi_tuple_update(Update, PredId),
@@ -499,10 +469,9 @@
aditi_builtin_modes(InMode, AditiStateMode, ArgTypes, InsertArgModes),
list__append(InsertArgModes, [aditi_di_mode, aditi_uo_mode], Modes).
-post_typecheck__finish_aditi_builtin(ModuleInfo, CallerPredInfo, Args, Context,
- Builtin0, Builtin, PredOrFunc - SymName0/Arity,
- UpdateCallId, Modes, MaybeError) :-
- Builtin0 = aditi_bulk_update(Update, PredId0, Syntax),
+finish_aditi_builtin(ModuleInfo, CallerPredInfo, Args, Context, !Builtin,
+ PredOrFunc - SymName0/Arity, UpdateCallId, Modes, MaybeError) :-
+ !.Builtin = aditi_bulk_update(Update, PredId0, Syntax),
UnchangedArgTypes = (pred(X::in, X::out) is det),
(
Update = bulk_insert,
@@ -522,66 +491,63 @@
( list__split_list(HalfLength, Types0, Types1, _) ->
Types = Types1
;
- error(
- "post_typecheck__finish_aditi_builtin: aditi_modify")
+ error("finish_aditi_builtin: aditi_modify")
)
)
),
resolve_aditi_builtin_overloading(ModuleInfo, CallerPredInfo, Args,
AdjustArgTypes, PredId0, PredId, SymName0, SymName),
- Builtin = aditi_bulk_update(Update, PredId, Syntax),
+ !:Builtin = aditi_bulk_update(Update, PredId, Syntax),
UpdateCallId = PredOrFunc - SymName/Arity,
module_info_pred_info(ModuleInfo, PredId, RelationPredInfo),
- check_base_relation(Context, RelationPredInfo,
- Builtin, UpdateCallId, MaybeError),
+ check_base_relation(Context, RelationPredInfo, !.Builtin, UpdateCallId,
+ MaybeError),
pred_info_arg_types(RelationPredInfo, ArgTypes),
- post_typecheck__bulk_update_closure_info(Update,
- PredOrFunc, ArgTypes, ClosurePredOrFunc,
- ClosureArgModes, ClosureDetism),
+ bulk_update_closure_info(Update, PredOrFunc, ArgTypes,
+ ClosurePredOrFunc, ClosureArgModes, ClosureDetism),
Inst = ground(shared, higher_order(pred_inst_info(ClosurePredOrFunc,
ClosureArgModes, ClosureDetism))),
Modes = [(Inst -> Inst), aditi_di_mode, aditi_uo_mode].
-:- pred post_typecheck__bulk_update_closure_info(aditi_bulk_update::in,
+:- pred bulk_update_closure_info(aditi_bulk_update::in,
pred_or_func::in, list(type)::in, pred_or_func::out, list(mode)::out,
determinism::out) is det.
-post_typecheck__bulk_update_closure_info(bulk_insert, PredOrFunc,
- ArgTypes, PredOrFunc, ClosureArgModes, nondet) :-
+bulk_update_closure_info(bulk_insert, PredOrFunc, ArgTypes, PredOrFunc,
+ ClosureArgModes, nondet) :-
out_mode(OutMode),
AditiStateMode = aditi_mui_mode,
- aditi_builtin_modes(OutMode, AditiStateMode,
- ArgTypes, ClosureArgModes).
-post_typecheck__bulk_update_closure_info(bulk_delete,
- PredOrFunc, ArgTypes, PredOrFunc, ClosureArgModes, nondet) :-
+ aditi_builtin_modes(OutMode, AditiStateMode, ArgTypes, ClosureArgModes).
+bulk_update_closure_info(bulk_delete, PredOrFunc, ArgTypes, PredOrFunc,
+ ClosureArgModes, nondet) :-
ArgMode = out_mode,
AditiStateMode = aditi_mui_mode,
aditi_builtin_modes(ArgMode, AditiStateMode,
ArgTypes, ClosureArgModes).
-post_typecheck__bulk_update_closure_info(bulk_modify,
- _PredOrFunc, ArgTypes, LambdaPredOrFunc,
+bulk_update_closure_info(bulk_modify, _PredOrFunc, ArgTypes, LambdaPredOrFunc,
ClosureArgModes, nondet) :-
LambdaPredOrFunc = predicate,
out_mode(OutMode),
unused_mode(UnusedMode),
DeleteArgMode = OutMode,
DeleteAditiStateMode = aditi_mui_mode,
- aditi_builtin_modes(DeleteArgMode, DeleteAditiStateMode,
- ArgTypes, DeleteArgModes),
+ aditi_builtin_modes(DeleteArgMode, DeleteAditiStateMode, ArgTypes,
+ DeleteArgModes),
InsertArgMode = OutMode,
InsertAditiStateMode = UnusedMode,
- aditi_builtin_modes(InsertArgMode, InsertAditiStateMode,
- ArgTypes, InsertArgModes),
+ aditi_builtin_modes(InsertArgMode, InsertAditiStateMode, ArgTypes,
+ InsertArgModes),
list__append(DeleteArgModes, InsertArgModes, ClosureArgModes).
% Use the type of the closure passed to an `aditi_delete',
% `aditi_bulk_insert', `aditi_bulk_delete' or `aditi_modify'
% call to work out which predicate is being updated.
+ %
:- pred resolve_aditi_builtin_overloading(module_info::in, pred_info::in,
list(prog_var)::in,
pred(list(type), list(type))::in(pred(in, out) is det),
@@ -598,28 +564,25 @@
pred_info_clauses_info(CallerPredInfo, ClausesInfo),
clauses_info_vartypes(ClausesInfo, VarTypes),
map__lookup(VarTypes, HOArg, HOArgType),
- type_is_higher_order(HOArgType, _Purity,
- _, EvalMethod, ArgTypes0),
+ type_is_higher_order(HOArgType, _Purity, _, EvalMethod, ArgTypes0),
EvalMethod \= normal
->
call(AdjustArgTypes, ArgTypes0, ArgTypes),
pred_info_get_markers(CallerPredInfo, Markers),
- typecheck__resolve_pred_overloading(ModuleInfo,
- Markers, ArgTypes, TVarSet,
- SymName0, SymName, PredId)
+ typecheck__resolve_pred_overloading(ModuleInfo, Markers, ArgTypes,
+ TVarSet, SymName0, SymName, PredId)
;
- error(
- "post_typecheck__resolve_aditi_builtin_overloading")
+ error("resolve_aditi_builtin_overloading")
)
;
PredId = PredId0,
SymName = get_qualified_pred_name(ModuleInfo, PredId)
).
- % Work out the modes of the arguments of a closure passed
- % to an Aditi update.
- % The `Mode' passed is the mode of all arguments apart
- % from the `aditi__state'.
+ % Work out the modes of the arguments of a closure passed to an Aditi
+ % update. The `Mode' passed is the mode of all arguments apart from
+ % the `aditi__state'.
+ %
:- pred aditi_builtin_modes((mode)::in, (mode)::in, list(type)::in,
list(mode)::out) is det.
@@ -635,6 +598,7 @@
% Report an error if a predicate modified by an Aditi builtin
% is not a base relation.
+ %
:- pred check_base_relation(prog_context::in, pred_info::in, aditi_builtin::in,
simple_call_id::in, maybe(aditi_builtin_error)::out) is det.
@@ -642,51 +606,44 @@
( hlds_pred__pred_info_is_base_relation(PredInfo) ->
MaybeError = no
;
- MaybeError = yes(aditi_update_of_derived_relation(Context,
- Builtin, CallId))
+ MaybeError = yes(aditi_update_of_derived_relation(Context, Builtin,
+ CallId))
).
report_aditi_builtin_error(
- aditi_update_of_derived_relation(Context, Builtin, CallId)) -->
- io__set_exit_status(1),
- prog_out__write_context(Context),
- io__write_string("In "),
- hlds_out__write_call_id(generic_call(aditi_builtin(Builtin, CallId))),
- io__write_string(":\n"),
- prog_out__write_context(Context),
- io__write_string(" error: the modified "),
- { CallId = PredOrFunc - _ },
- prog_out__write_pred_or_func(PredOrFunc),
- io__write_string(" is not a base relation.\n").
+ aditi_update_of_derived_relation(Context, Builtin, CallId), !IO) :-
+ io__set_exit_status(1, !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string("In ", !IO),
+ hlds_out__write_call_id(generic_call(aditi_builtin(Builtin, CallId)), !IO),
+ io__write_string(":\n", !IO),
+ prog_out__write_context(Context, !IO),
+ io__write_string(" error: the modified ", !IO),
+ CallId = PredOrFunc - _,
+ prog_out__write_pred_or_func(PredOrFunc, !IO),
+ io__write_string(" is not a base relation.\n", !IO).
%-----------------------------------------------------------------------------%
-post_typecheck__finish_pred_no_io(ModuleInfo, ErrorProcs,
- PredInfo0, PredInfo) :-
- post_typecheck__propagate_types_into_modes(ModuleInfo,
- ErrorProcs, PredInfo0, PredInfo).
+finish_pred_no_io(ModuleInfo, ErrorProcs, !PredInfo) :-
+ propagate_types_into_modes(ModuleInfo, ErrorProcs, !PredInfo).
- %
% For ill-typed preds, we just need to set the modes up correctly
% so that any calls to that pred from correctly-typed predicates
% won't result in spurious mode errors.
%
-post_typecheck__finish_ill_typed_pred(ModuleInfo, PredId, !PredInfo, !IO) :-
- post_typecheck__propagate_types_into_modes(ModuleInfo, ErrorProcs,
- !PredInfo),
- report_unbound_inst_vars(ModuleInfo, PredId, ErrorProcs, !PredInfo,
- !IO),
+finish_ill_typed_pred(ModuleInfo, PredId, !PredInfo, !IO) :-
+ propagate_types_into_modes(ModuleInfo, ErrorProcs, !PredInfo),
+ report_unbound_inst_vars(ModuleInfo, PredId, ErrorProcs, !PredInfo, !IO),
check_for_indistinguishable_modes(ModuleInfo, PredId, !PredInfo, !IO).
+ % For imported preds, we just need to ensure that all constructors
+ % occurring in predicate mode declarations are module qualified.
%
- % For imported preds, we just need to ensure that all
- % constructors occurring in predicate mode declarations are
- % module qualified.
- %
-:- pred post_typecheck__finish_imported_pred(module_info::in, pred_id::in,
+:- pred finish_imported_pred(module_info::in, pred_id::in,
pred_info::in, pred_info::out, io::di, io::uo) is det.
-post_typecheck__finish_imported_pred(ModuleInfo, PredId, !PredInfo, !IO) :-
+finish_imported_pred(ModuleInfo, PredId, !PredInfo, !IO) :-
pred_info_get_markers(!.PredInfo, Markers),
(
check_marker(Markers, base_relation),
@@ -697,19 +654,16 @@
;
true
),
- % XXX maybe the rest should be replaced with a call to
- % post_typecheck__finish_ill_typed_pred? [zs]
- post_typecheck__finish_imported_pred_no_io(ModuleInfo, ErrorProcs,
- !PredInfo),
- report_unbound_inst_vars(ModuleInfo, PredId, ErrorProcs, !PredInfo,
- !IO),
+ % XXX Maybe the rest should be replaced with a call to
+ % finish_ill_typed_pred? [zs]
+ finish_imported_pred_no_io(ModuleInfo, ErrorProcs, !PredInfo),
+ report_unbound_inst_vars(ModuleInfo, PredId, ErrorProcs, !PredInfo, !IO),
check_for_indistinguishable_modes(ModuleInfo, PredId, !PredInfo, !IO).
-post_typecheck__finish_imported_pred_no_io(ModuleInfo, Errors, !PredInfo) :-
- % Make sure the var-types field in the clauses_info is
- % valid for imported predicates.
- % Unification procedures have clauses generated, so
- % they already have valid var-types.
+finish_imported_pred_no_io(ModuleInfo, Errors, !PredInfo) :-
+ % Make sure the var-types field in the clauses_info is valid for imported
+ % predicates. Unification procedures have clauses generated, so they
+ % already have valid var-types.
( pred_info_is_pseudo_imported(!.PredInfo) ->
true
;
@@ -720,33 +674,28 @@
clauses_info_set_vartypes(VarTypes, ClausesInfo0, ClausesInfo),
pred_info_set_clauses_info(ClausesInfo, !PredInfo)
),
- post_typecheck__propagate_types_into_modes(ModuleInfo, Errors,
- !PredInfo).
+ propagate_types_into_modes(ModuleInfo, Errors, !PredInfo).
- %
- % Now that the promise has finished being typechecked,
- % and has had all of its pred_ids identified,
- % remove the promise from the list of pred ids to be processed
- % in the future and place the pred_id associated with the
- % promise into the assertion or promise_ex table.
- % For each assertion that is in the interface, you need to check
- % that it doesn't refer to any symbols which are local to that
- % module.
- % Also record for each predicate that is used in an assertion
- % which assertion it is used in, or for a promise ex declaration
- % record in the promise ex table the predicates used by the
- % declaration.
- %
-post_typecheck__finish_promise(PromiseType, PromiseId, !Module, !IO) :-
- % Store the declaration in the appropriate table and get
- % the goal for the promise
+ % Now that the promise has finished being typechecked, and has had all
+ % of its pred_ids identified, remove the promise from the list of pred ids
+ % to be processed in the future and place the pred_id associated with the
+ % promise into the assertion or promise_ex table. For each assertion
+ % that is in the interface, you need to check that it doesn't refer
+ % to any symbols which are local to that module. Also record for each
+ % predicate that is used in an assertion which assertion it is used in,
+ % or for a promise ex declaration record in the promise ex table
+ % the predicates used by the declaration.
+ %
+finish_promise(PromiseType, PromiseId, !Module, !IO) :-
+ % Store the declaration in the appropriate table and get the goal
+ % for the promise.
store_promise(PromiseType, PromiseId, !Module, Goal),
% Remove from further processing.
module_info_remove_predid(PromiseId, !Module),
- % If the promise is in the interface, then ensure that
- % it doesn't refer to any local symbols.
+ % If the promise is in the interface, then ensure that it doesn't refer
+ % to any local symbols.
module_info_pred_info(!.Module, PromiseId, PredInfo),
( pred_info_is_exported(PredInfo) ->
assertion__in_interface_check(Goal, PredInfo, !Module, !IO)
@@ -754,14 +703,15 @@
true
).
- % store promise declaration, normalise goal and return new
- % module_info and the goal for further processing
+ % Store promise declaration, normalise goal and return new module_info
+ % and the goal for further processing.
+ %
:- pred store_promise(promise_type::in, pred_id::in,
module_info::in, module_info::out, hlds_goal::out) is det.
store_promise(PromiseType, PromiseId, !Module, Goal) :-
(
- % case for assertions
+ % Case for assertions.
PromiseType = true
->
module_info_get_assertion_table(!.Module, AssertTable0),
@@ -771,7 +721,7 @@
assertion__goal(AssertionId, !.Module, Goal),
assertion__record_preds_used_in(Goal, AssertionId, !Module)
;
- % case for exclusivity
+ % Case for exclusivity.
(
PromiseType = exclusive
;
@@ -781,25 +731,22 @@
promise_ex_goal(PromiseId, !.Module, Goal),
predids_from_goal(Goal, PredIds),
module_info_get_exclusive_table(!.Module, Table0),
- list__foldl(exclusive_table_add(PromiseId), PredIds,
- Table0, Table),
+ list__foldl(exclusive_table_add(PromiseId), PredIds, Table0, Table),
module_info_set_exclusive_table(Table, !Module)
-
;
- % case for exhaustiveness -- XXX not yet implemented
+ % Case for exhaustiveness -- XXX not yet implemented.
promise_ex_goal(PromiseId, !.Module, Goal)
).
- % get the goal from a promise_ex declaration
+ % Get the goal from a promise_ex declaration.
+ %
:- pred promise_ex_goal(pred_id::in, module_info::in, hlds_goal::out) is det.
promise_ex_goal(ExclusiveDecl, Module, Goal) :-
module_info_pred_info(Module, ExclusiveDecl, PredInfo),
pred_info_clauses_info(PredInfo, ClausesInfo),
clauses_info_clauses_only(ClausesInfo, Clauses),
- (
- Clauses = [clause(_ProcIds, Goal0, _Lang, _Context)]
- ->
+ ( Clauses = [clause(_ProcIds, Goal0, _Lang, _Context)] ->
assertion__normalise_goal(Goal0, Goal)
;
error("promise_ex__goal: not an promise")
@@ -811,18 +758,12 @@
check_type_of_main(PredInfo, !IO) :-
(
- %
- % Check if this predicate is the
- % program entry point main/2.
- %
+ % Check if this predicate is the program entry point main/2.
pred_info_name(PredInfo) = "main",
pred_info_orig_arity(PredInfo) = 2,
pred_info_is_exported(PredInfo)
->
- %
- % Check that the arguments of main/2
- % have type `io__state'.
- %
+ % Check that the arguments of main/2 have type `io__state'.
pred_info_arg_types(PredInfo, ArgTypes),
(
ArgTypes = [Arg1, Arg2],
@@ -843,15 +784,13 @@
%-----------------------------------------------------------------------------%
- %
% Ensure that all constructors occurring in predicate mode
% declarations are module qualified.
%
-:- pred post_typecheck__propagate_types_into_modes(module_info::in,
+:- pred propagate_types_into_modes(module_info::in,
list(proc_id)::out, pred_info::in, pred_info::out) is det.
-post_typecheck__propagate_types_into_modes(ModuleInfo, ErrorProcs,
- !PredInfo) :-
+propagate_types_into_modes(ModuleInfo, ErrorProcs, !PredInfo) :-
pred_info_arg_types(!.PredInfo, ArgTypes),
pred_info_procedures(!.PredInfo, Procs0),
ProcIds = pred_info_procids(!.PredInfo),
@@ -874,12 +813,10 @@
propagate_types_into_mode_list(ModuleInfo, ArgTypes,
ArgModes0, ArgModes),
- %
- % check for unbound inst vars
- % (this needs to be done after propagate_types_into_mode_list,
- % because we need the insts to be module-qualified; and it
- % needs to be done before mode analysis, to avoid internal errors)
- %
+ % Check for unbound inst vars. (This needs to be done after
+ % propagate_types_into_mode_list, because we need the insts
+ % to be module-qualified; and it needs to be done before mode analysis,
+ % to avoid internal errors.)
( mode_list_contains_inst_var(ArgModes, ModuleInfo, _InstVar) ->
!:ErrorProcs = [ProcId | !.ErrorProcs]
;
@@ -894,9 +831,10 @@
io::di, io::uo) is det.
report_unbound_inst_vars(ModuleInfo, PredId, ErrorProcs, !PredInfo, !IO) :-
- ( ErrorProcs = [] ->
- true
+ (
+ ErrorProcs = []
;
+ ErrorProcs = [_ | _],
pred_info_procedures(!.PredInfo, ProcTable0),
list__foldl2(report_unbound_inst_var_error(ModuleInfo, PredId),
ErrorProcs, ProcTable0, ProcTable, !IO),
@@ -917,17 +855,15 @@
:- pred unbound_inst_var_error(pred_id::in, proc_info::in, module_info::in,
io::di, io::uo) is det.
-unbound_inst_var_error(PredId, ProcInfo, ModuleInfo) -->
- { proc_info_context(ProcInfo, Context) },
- io__set_exit_status(1),
- prog_out__write_context(Context),
- io__write_string("In mode declaration for "),
- hlds_out__write_pred_id(ModuleInfo, PredId),
- io__write_string(":\n"),
- prog_out__write_context(Context),
- io__write_string(" error: unbound inst variable(s).\n"),
- prog_out__write_context(Context),
- io__write_string(" (Sorry, polymorphic modes are not supported.)\n").
+unbound_inst_var_error(PredId, ProcInfo, ModuleInfo, !IO) :-
+ proc_info_context(ProcInfo, Context),
+ io__set_exit_status(1, !IO),
+ Pieces = [words("In mode declaration for")] ++
+ describe_one_pred_name(ModuleInfo, should_not_module_qualify, PredId)
+ ++ [suffix(":"), nl,
+ words("error: unbound inst variable(s)."), nl,
+ words("(Sorry, polymorphic modes are not supported.)"), nl],
+ write_error_pieces(Context, 0, Pieces, !IO).
%-----------------------------------------------------------------------------%
@@ -936,16 +872,12 @@
check_for_indistinguishable_modes(ModuleInfo, PredId, !PredInfo, !IO) :-
(
- %
- % Don't check for indistinguishable modes in unification
- % predicates. The default (in, in) mode must be
- % semidet, but for single-value types we also want to
- % create a det mode which will be indistinguishable
- % from the semidet mode.
- % (When the type is known, the det mode is called,
- % but the polymorphic unify needs to be able to call
+ % Don't check for indistinguishable modes in unification predicates.
+ % The default (in, in) mode must be semidet, but for single-value types
+ % we also want to create a det mode which will be indistinguishable
+ % from the semidet mode. (When the type is known, the det mode is
+ % called, but the polymorphic unify needs to be able to call
% the semidet mode.)
- %
pred_info_get_origin(!.PredInfo, Origin),
Origin = special_pred(spec_pred_unify - _)
->
@@ -965,9 +897,12 @@
PrevProcIds, !PredInfo, !IO) :-
check_for_indistinguishable_mode(ModuleInfo, PredId, ProcId,
PrevProcIds, Removed, !PredInfo, !IO),
- PrevProcIds1 =
- ( if Removed = yes then PrevProcIds
- else [ProcId | PrevProcIds]
+ (
+ Removed = yes,
+ PrevProcIds1 = PrevProcIds
+ ;
+ Removed = no,
+ PrevProcIds1 = [ProcId | PrevProcIds]
),
check_for_indistinguishable_modes(ModuleInfo, PredId, ProcIds,
PrevProcIds1, !PredInfo, !IO).
@@ -979,10 +914,7 @@
check_for_indistinguishable_mode(_, _, _, [], no, !PredInfo, !IO).
check_for_indistinguishable_mode(ModuleInfo, PredId, ProcId1,
[ProcId | ProcIds], Removed, !PredInfo, !IO) :-
- (
- modes_are_indistinguishable(ProcId, ProcId1,
- !.PredInfo, ModuleInfo)
- ->
+ ( modes_are_indistinguishable(ProcId, ProcId1, !.PredInfo, ModuleInfo) ->
pred_info_import_status(!.PredInfo, Status),
globals__io_lookup_bool_option(intermodule_optimization,
Intermod, !IO),
@@ -1020,18 +952,19 @@
check_aditi_state(ModuleInfo, PredInfo, !IO) :-
pred_info_arg_types(PredInfo, ArgTypes),
list__filter(type_is_aditi_state, ArgTypes, AditiStateTypes),
- ( AditiStateTypes = [] ->
+ (
+ AditiStateTypes = [],
report_no_aditi_state(PredInfo, !IO)
;
+ AditiStateTypes = [_ | _],
ProcIds = pred_info_procids(PredInfo),
- list__foldl(
- check_aditi_state_modes(ModuleInfo,
- PredInfo, ArgTypes),
+ list__foldl(check_aditi_state_modes(ModuleInfo, PredInfo, ArgTypes),
ProcIds, !IO)
).
- % If the procedure has declared modes, check that there
- % is an input `aditi__state' argument.
+ % If the procedure has declared modes, check that there is an input
+ % `aditi__state' argument.
+ %
:- pred check_aditi_state_modes(module_info::in, pred_info::in, list(type)::in,
proc_id::in, io::di, io::uo) is det.
@@ -1086,7 +1019,7 @@
report_aditi_pragma(PredInfo, PredErrorPieces),
list__append(PredErrorPieces,
[words("without an `aditi__state' argument.")], ErrorPieces),
- error_util__write_error_pieces(Context, 0, ErrorPieces, !IO).
+ write_error_pieces(Context, 0, ErrorPieces, !IO).
:- pred report_no_input_aditi_state(pred_info::in, prog_context::in,
io::di, io::uo) is det.
@@ -1095,8 +1028,7 @@
io__set_exit_status(1, !IO),
report_aditi_pragma(PredInfo, PredErrorPieces),
list__append(PredErrorPieces,
- [words(
- "without an `aditi__state' argument with mode `aditi_mui'.")],
+ [words("without an `aditi__state' argument with mode `aditi_mui'.")],
ErrorPieces),
error_util__write_error_pieces(Context, 0, ErrorPieces, !IO).
@@ -1122,20 +1054,15 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-post_typecheck__resolve_unify_functor(X0, ConsId0, ArgVars0, Mode0,
- Unification0, UnifyContext, GoalInfo0,
- ModuleInfo, !PredInfo, !VarTypes, !VarSet, Goal) :-
-
+resolve_unify_functor(X0, ConsId0, ArgVars0, Mode0, Unification0, UnifyContext,
+ GoalInfo0, ModuleInfo, !PredInfo, !VarTypes, !VarSet, Goal) :-
map__lookup(!.VarTypes, X0, TypeOfX),
list__length(ArgVars0, Arity),
(
- %
- % Is the function symbol apply/N or ''/N,
- % representing a higher-order function call?
- % Or the impure/semipure equivalents impure_apply/N
+ % Is the function symbol apply/N or ''/N, representing a higher-order
+ % function call? Or the impure/semipure equivalents impure_apply/N
% and semipure_apply/N?
% (XXX FIXME We should use nicer syntax for impure apply/N.)
- %
ConsId0 = cons(unqualified(ApplyName), _),
( ApplyName = "apply", Purity = (pure)
; ApplyName = "", Purity = (pure)
@@ -1145,12 +1072,9 @@
Arity >= 1,
ArgVars0 = [FuncVar | FuncArgVars]
->
- %
- % Convert the higher-order function call (apply/N)
- % into a higher-order predicate call
- % (i.e., replace `X = apply(F, A, B, C)'
+ % Convert the higher-order function call (apply/N) into a higher-order
+ % predicate call (i.e., replace `X = apply(F, A, B, C)'
% with `call(F, A, B, C, X)')
- %
list__append(FuncArgVars, [X0], ArgVars),
Modes = [],
Det = erroneous,
@@ -1160,34 +1084,25 @@
ArgVars, Modes, Det),
Goal = HOCall - GoalInfo0
;
- %
- % Is the function symbol a user-defined function, rather
- % than a functor which represents a data constructor?
- %
+ % Is the function symbol a user-defined function, rather than
+ % a functor which represents a data constructor?
% Find the set of candidate predicates which have the
% specified name and arity (and module, if module-qualified)
ConsId0 = cons(PredName, _),
- %
- % We don't do this for compiler-generated predicates;
- % they are assumed to have been generated with all
- % functions already expanded.
- % If we did this check for compiler-generated
- % predicates, it would cause the wrong behaviour
- % in the case where there is a user-defined function
- % whose type is exactly the same as the type of
- % a constructor. (Normally that would cause
- % a type ambiguity error, but compiler-generated
- % predicates are not type-checked.)
- %
+ % We don't do this for compiler-generated predicates; they are assumed
+ % to have been generated with all functions already expanded. If we did
+ % this check for compiler-generated predicates, it would cause the
+ % wrong behaviour in the case where there is a user-defined function
+ % whose type is exactly the same as the type of a constructor.
+ % (Normally that would cause a type ambiguity error, but
+ % compiler-generated predicates are not type-checked.)
\+ is_unify_or_compare_pred(!.PredInfo),
- %
- % We don't do this for the clause introduced by the
- % compiler for a field access function -- that needs
- % to be expanded into unifications below.
- %
+ % We don't do this for the clause introduced by the compiler for a
+ % field access function -- that needs to be expanded into
+ % unifications below.
\+ pred_info_is_field_access_function(ModuleInfo, !.PredInfo),
pred_info_get_markers(!.PredInfo, Markers),
@@ -1196,20 +1111,16 @@
calls_are_fully_qualified(Markers),
PredName, Arity, PredIds),
- % Check if any of the candidate functions have
- % argument/return types which subsume the actual
- % argument/return types of this function call
-
+ % Check if any of the candidate functions have argument/return types
+ % which subsume the actual argument/return types of this function call.
pred_info_typevarset(!.PredInfo, TVarSet),
map__apply_to_list(ArgVars0, !.VarTypes, ArgTypes0),
list__append(ArgTypes0, [TypeOfX], ArgTypes),
typecheck__find_matching_pred_id(PredIds, ModuleInfo,
TVarSet, ArgTypes, PredId, QualifiedFuncName)
->
- %
% Convert function calls into predicate calls:
- % replace `X = f(A, B, C)'
- % with `f(A, B, C, X)'
+ % replace `X = f(A, B, C)' with `f(A, B, C, X)'.
%
ProcId = invalid_proc_id,
list__append(ArgVars0, [X0], ArgVars),
@@ -1219,24 +1130,18 @@
yes(FuncCallUnifyContext), QualifiedFuncName),
Goal = FuncCall - GoalInfo0
;
- %
% Is the function symbol a higher-order predicate
% or function constant?
- %
ConsId0 = cons(Name, _),
type_is_higher_order(TypeOfX, _Purity, PredOrFunc,
EvalMethod, HOArgTypes),
- %
- % We don't do this for the clause introduced by the
- % compiler for a field access function -- that needs
- % to be expanded into unifications below.
- %
+ % We don't do this for the clause introduced by the compiler
+ % for a field access function -- that needs to be expanded
+ % into unifications below.
\+ pred_info_is_field_access_function(ModuleInfo, !.PredInfo),
- %
% Find the pred_id of the constant.
- %
map__apply_to_list(ArgVars0, !.VarTypes, ArgTypes0),
AllArgTypes = ArgTypes0 ++ HOArgTypes,
pred_info_typevarset(!.PredInfo, TVarSet),
@@ -1245,49 +1150,37 @@
PredOrFunc, TVarSet, AllArgTypes, ModuleInfo, PredId)
->
get_proc_id(ModuleInfo, PredId, ProcId),
- ShroudedPredProcId =
- shroud_pred_proc_id(proc(PredId, ProcId)),
+ ShroudedPredProcId = shroud_pred_proc_id(proc(PredId, ProcId)),
ConsId = pred_const(ShroudedPredProcId, EvalMethod),
Goal = unify(X0, functor(ConsId, no, ArgVars0), Mode0,
Unification0, UnifyContext) - GoalInfo0
;
- %
- % Is it a call to an automatically generated field access
- % function. This test must come after the tests for
- % function calls and higher-order terms above.
- % It's done that way because it's easier to check
- % that the types match for functions calls and
- % higher-order terms.
- %
+ % Is it a call to an automatically generated field access function.
+ % This test must come after the tests for function calls and
+ % higher-order terms above. It's done that way because it's easier
+ % to check that the types match for functions calls and higher-order
+ % terms.
ConsId0 = cons(Name, Arity),
is_field_access_function_name(ModuleInfo, Name, Arity,
AccessType, FieldName),
- %
% We don't do this for compiler-generated predicates --
% they will never contain calls to field access functions.
- %
\+ is_unify_or_compare_pred(!.PredInfo),
- %
- % If there is a constructor for which the argument types
- % match, this unification couldn't be a call to a field
- % access function, otherwise there would have been an
- % error reported for unresolved overloading.
- %
+ % If there is a constructor for which the argument types match,
+ % this unification couldn't be a call to a field access function,
+ % otherwise there would have been an error reported for unresolved
+ % overloading.
pred_info_typevarset(!.PredInfo, TVarSet),
map__apply_to_list(ArgVars0, !.VarTypes, ArgTypes0),
- \+ find_matching_constructor(ModuleInfo, TVarSet,
- ConsId0, TypeOfX, ArgTypes0)
+ \+ find_matching_constructor(ModuleInfo, TVarSet, ConsId0,
+ TypeOfX, ArgTypes0)
->
- post_typecheck__finish_field_access_function(ModuleInfo,
- !PredInfo, !VarTypes, !VarSet, AccessType, FieldName,
- UnifyContext, X0, ArgVars0, GoalInfo0, Goal)
+ finish_field_access_function(ModuleInfo, !PredInfo, !VarTypes, !VarSet,
+ AccessType, FieldName, UnifyContext, X0, ArgVars0, GoalInfo0, Goal)
;
- %
- % Module qualify ordinary construction/deconstruction
- % unifications.
- %
+ % Module qualify ordinary construction/deconstruction unifications.
(
ConsId0 = cons(Name0, Arity),
type_to_ctor_and_args(TypeOfX, TypeCtorOfX, _),
@@ -1304,8 +1197,9 @@
%-----------------------------------------------------------------------------%
- % Succeed if there is a constructor which matches the given
- % cons_id, type and argument types.
+ % Succeed if there is a constructor which matches the given cons_id,
+ % type and argument types.
+ %
:- pred find_matching_constructor(module_info::in, tvarset::in,
cons_id::in, (type)::in, list(type)::in) is semidet.
@@ -1316,8 +1210,7 @@
list__member(ConsDefn, ConsDefns),
% Overloading resolution ignores the class constraints.
- ConsDefn = hlds_cons_defn(ConsExistQVars, _,
- ConsArgs, ConsTypeCtor, _),
+ ConsDefn = hlds_cons_defn(ConsExistQVars, _, ConsArgs, ConsTypeCtor, _),
ConsTypeCtor = TypeCtor,
module_info_get_type_table(ModuleInfo, Types),
@@ -1336,40 +1229,37 @@
% The error messages from mode analysis and determinism analysis
% shouldn't be too much worse than if the goals were special cases.
%
-:- pred post_typecheck__finish_field_access_function(module_info::in,
+:- pred finish_field_access_function(module_info::in,
pred_info::in, pred_info::out, vartypes::in, vartypes::out,
prog_varset::in, prog_varset::out,
field_access_type::in, ctor_field_name::in,
unify_context::in, prog_var::in, list(prog_var)::in,
hlds_goal_info::in, hlds_goal::out) is det.
-post_typecheck__finish_field_access_function(ModuleInfo, !PredInfo,
- !VarTypes, !VarSet, AccessType, FieldName, UnifyContext,
- Var, Args, GoalInfo, GoalExpr - GoalInfo) :-
+finish_field_access_function(ModuleInfo, !PredInfo, !VarTypes, !VarSet,
+ AccessType, FieldName, UnifyContext, Var, Args, GoalInfo,
+ GoalExpr - GoalInfo) :-
(
AccessType = get,
field_extraction_function_args(Args, TermVar),
- post_typecheck__translate_get_function(ModuleInfo,
- !PredInfo, !VarTypes, !VarSet, FieldName, UnifyContext,
- Var, TermVar, GoalInfo, GoalExpr)
+ translate_get_function(ModuleInfo, !PredInfo, !VarTypes, !VarSet,
+ FieldName, UnifyContext, Var, TermVar, GoalInfo, GoalExpr)
;
AccessType = set,
field_update_function_args(Args, TermInputVar, FieldVar),
- post_typecheck__translate_set_function(ModuleInfo,
- !PredInfo, !VarTypes, !VarSet, FieldName, UnifyContext,
- FieldVar, TermInputVar, Var,
+ translate_set_function(ModuleInfo, !PredInfo, !VarTypes, !VarSet,
+ FieldName, UnifyContext, FieldVar, TermInputVar, Var,
GoalInfo, GoalExpr)
).
-:- pred post_typecheck__translate_get_function(module_info::in,
+:- pred translate_get_function(module_info::in,
pred_info::in, pred_info::out, vartypes::in, vartypes::out,
prog_varset::in, prog_varset::out, ctor_field_name::in,
unify_context::in, prog_var::in, prog_var::in,
hlds_goal_info::in, hlds_goal_expr::out) is det.
-post_typecheck__translate_get_function(ModuleInfo, !PredInfo,
- !VarTypes, !VarSet, FieldName, UnifyContext,
- FieldVar, TermInputVar, OldGoalInfo, GoalExpr) :-
+translate_get_function(ModuleInfo, !PredInfo, !VarTypes, !VarSet, FieldName,
+ UnifyContext, FieldVar, TermInputVar, OldGoalInfo, GoalExpr) :-
map__lookup(!.VarTypes, TermInputVar, TermType),
get_constructor_containing_field(ModuleInfo, TermType, FieldName,
ConsId, FieldNumber),
@@ -1377,7 +1267,6 @@
get_cons_id_arg_types_adding_existq_tvars(ModuleInfo, ConsId,
TermType, ArgTypes0, ExistQVars, !PredInfo),
- %
% If the type of the field we are extracting contains existentially
% quantified type variables then we need to rename any other
% occurrences of those type variables in the arguments of the
@@ -1386,26 +1275,22 @@
% existentially quantified type variables occur in field to set
% and other fields then the field update should have been disallowed
% by typecheck.m because the result can't be well-typed).
- %
- ( ExistQVars \= [] ->
+ (
+ ExistQVars = [_ | _],
map__lookup(!.VarTypes, FieldVar, FieldType),
list__index1_det(ArgTypes0, FieldNumber, FieldArgType),
- (
- type_list_subsumes([FieldArgType], [FieldType],
- FieldSubst)
- ->
- apply_rec_subst_to_type_list(FieldSubst, ArgTypes0,
- ArgTypes)
+ ( type_list_subsumes([FieldArgType], [FieldType], FieldSubst) ->
+ apply_rec_subst_to_type_list(FieldSubst, ArgTypes0, ArgTypes)
;
- error("post_typecheck__translate_get_function: " ++
- "type_list_subsumes failed")
+ error("translate_get_function: type_list_subsumes failed")
)
;
+ ExistQVars = [],
ArgTypes = ArgTypes0
),
- split_list_at_index(FieldNumber, ArgTypes,
- TypesBeforeField, _, TypesAfterField),
+ split_list_at_index(FieldNumber, ArgTypes, TypesBeforeField,
+ _, TypesAfterField),
make_new_vars(TypesBeforeField, VarsBeforeField, !VarTypes, !VarSet),
make_new_vars(TypesAfterField, VarsAfterField, !VarTypes, !VarSet),
@@ -1419,15 +1304,15 @@
UnifyContext, FunctorGoal),
FunctorGoal = GoalExpr - _.
-:- pred post_typecheck__translate_set_function(module_info::in,
+:- pred translate_set_function(module_info::in,
pred_info::in, pred_info::out, vartypes::in, vartypes::out,
prog_varset::in, prog_varset::out, ctor_field_name::in,
unify_context::in, prog_var::in, prog_var::in, prog_var::in,
hlds_goal_info::in, hlds_goal_expr::out) is det.
-post_typecheck__translate_set_function(ModuleInfo, !PredInfo,
- !VarTypes, !VarSet, FieldName, UnifyContext,
- FieldVar, TermInputVar, TermOutputVar, OldGoalInfo, Goal) :-
+translate_set_function(ModuleInfo, !PredInfo, !VarTypes, !VarSet,
+ FieldName, UnifyContext, FieldVar, TermInputVar, TermOutputVar,
+ OldGoalInfo, Goal) :-
map__lookup(!.VarTypes, TermInputVar, TermType),
get_constructor_containing_field(ModuleInfo, TermType, FieldName,
@@ -1443,9 +1328,7 @@
make_new_var(TermFieldType, SingletonFieldVar, !VarTypes, !VarSet),
make_new_vars(TypesAfterField, VarsAfterField, !VarTypes, !VarSet),
- %
% Build a goal to deconstruct the input.
- %
list__append(VarsBeforeField, [SingletonFieldVar | VarsAfterField],
DeconstructArgs),
goal_info_get_nonlocals(OldGoalInfo, OldNonLocals),
@@ -1458,9 +1341,7 @@
DeconstructRestrictNonLocals, [TermInputVar | DeconstructArgs],
UnifyContext, DeconstructGoal),
- %
% Build a goal to construct the output.
- %
list__append(VarsBeforeField, [FieldVar | VarsAfterField],
ConstructArgs),
set__insert_list(OldNonLocals, NonLocalArgs,
@@ -1477,8 +1358,7 @@
remove_new_prefix(ConsName, ConsName0),
ConsId = cons(ConsName, ConsArity)
;
- error("post_typecheck__translate_set_function: " ++
- "invalid cons_id")
+ error("translate_set_function: invalid cons_id")
)
),
@@ -1499,29 +1379,24 @@
get_cons_id_arg_types_adding_existq_tvars(ModuleInfo, ConsId, TermType,
ArgTypes, NewExistQVars, !PredInfo) :-
- %
% Split the list of argument types at the named field.
- %
- type_util__get_type_and_cons_defn(ModuleInfo, TermType,
- ConsId, TypeDefn, ConsDefn),
+ type_util__get_type_and_cons_defn(ModuleInfo, TermType, ConsId,
+ TypeDefn, ConsDefn),
ConsDefn = hlds_cons_defn(ExistQVars, _, Args, _, _),
assoc_list__values(Args, ArgTypes0),
- ( ExistQVars = [] ->
+ (
+ ExistQVars = [],
ArgTypes1 = ArgTypes0,
NewExistQVars = []
;
- %
+ ExistQVars = [_ | _],
% Rename apart the existentially quantified type variables.
- %
list__length(ExistQVars, NumExistQVars),
pred_info_typevarset(!.PredInfo, TVarSet0),
- varset__new_vars(TVarSet0, NumExistQVars, NewExistQVars,
- TVarSet),
+ varset__new_vars(TVarSet0, NumExistQVars, NewExistQVars, TVarSet),
pred_info_set_typevarset(TVarSet, !PredInfo),
- map__from_corresponding_lists(ExistQVars, NewExistQVars,
- TVarSubst),
- apply_variable_renaming_to_type_list(TVarSubst, ArgTypes0,
- ArgTypes1)
+ map__from_corresponding_lists(ExistQVars, NewExistQVars, TVarSubst),
+ apply_variable_renaming_to_type_list(TVarSubst, ArgTypes0, ArgTypes1)
),
hlds_data__get_type_defn_tparams(TypeDefn, TypeParams),
( type_to_ctor_and_args(TermType, _, TypeArgs) ->
@@ -1545,13 +1420,14 @@
At = At0,
After = After0
;
- error("post_typecheck__split_list_at_index")
+ error("split_list_at_index")
).
%-----------------------------------------------------------------------------%
% Work out which constructor of the type has an argument with the
% given field name.
+ %
:- pred get_constructor_containing_field(module_info::in, (type)::in,
ctor_field_name::in, cons_id::out, int::out) is det.
@@ -1646,18 +1522,16 @@
map__det_insert(!.VarTypes, Var, Type, !:VarTypes).
%-----------------------------------------------------------------------------%
-%
-% Check that every abstract type in a module has at least one definition
-% in either the interface or implementation of the module. A type may
-% have several definitions, e.g. some foreign definitions and a default
-% Mercury definition.
-%
+ % Check that every abstract type in a module has at least one definition
+ % in either the interface or implementation of the module. A type may
+ % have several definitions, e.g. some foreign definitions and a default
+ % Mercury definition.
+ %
:- pred check_for_missing_definitions(module_info::in,
int::in, int::out, bool::in, bool::out, io::di, io::uo) is det.
-check_for_missing_definitions(ModuleInfo, !NumErrors, !FoundTypeError,
- !IO) :-
+check_for_missing_definitions(ModuleInfo, !NumErrors, !FoundTypeError, !IO) :-
module_info_get_type_table(ModuleInfo, TypeTable),
map.foldl3(check_for_missing_definitions_2, TypeTable,
!NumErrors, !FoundTypeError, !IO).
@@ -1687,16 +1561,15 @@
% we also don't bother checking for corresponding
% definitions in any of the builtin modules in the
% standard library.
- %
+
TypeCtor = SymName - Arity,
BuiltinTypeCtors = builtin_type_ctors_with_no_hlds_type_defn,
(
sym_name_get_module_name(SymName, ModuleName),
not any_mercury_builtin_module(ModuleName),
- %
+
% Several of the type defined in type_desc do not
% have Mercury definitions.
- %
not ModuleName = unqualified("type_desc"),
not list.member(TypeCtor, BuiltinTypeCtors)
->
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.254
diff -u -b -r1.254 prog_io.m
--- compiler/prog_io.m 6 Oct 2005 08:26:09 -0000 1.254
+++ compiler/prog_io.m 19 Oct 2005 04:59:57 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------e
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------e
% Copyright (C) 1993-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -40,7 +42,7 @@
% Implication and equivalence implemented by squirrel, who would also
% like to get her hands on this file and give it a good clean up and
% put it into good clean "mercury" style!
-
+%
% Wishlist:
%
% 1. implement importing/exporting operators with a particular fixity
@@ -74,122 +76,120 @@
:- type file_name == string.
:- type dir_name == string.
- % Open a source or interface file, returning `ok(FileInfo)' on
- % success (where FileInfo is information about the file such as
- % the file name or the directory in which it was found), or
- % `error(Message)' on failure.
+ % Open a source or interface file, returning `ok(FileInfo)' on success
+ % (where FileInfo is information about the file such as the file name
+ % or the directory in which it was found), or `error(Message)' on failure.
:- type open_file(FileInfo) == pred(maybe_error(FileInfo), io, io).
:- inst open_file == (pred(out, di, uo) is det).
- % prog_io__read_module(OpenFile, FileName, DefaultModuleName,
- % ReturnTimestamp, Error, MaybeFileInfo,
- % ActualModuleName, Messages, Program,
- % MaybeModuleTimestamp)
- % Reads and parses the file opened by OpenFile
- % using the default module name DefaultModuleName.
- % If ReturnTimestamp is `yes', attempt to return the
- % modification timestamp in MaybeModuleTimestamp.
- % Error is `fatal' if the file coudn't be opened, `yes'
- % if a syntax error was detected, and `no' otherwise.
- % MaybeFileInfo is the information about the file (usually
- % the file or directory name) returned by OpenFile.
- % ActualModuleName is the module name specified in the
- % `:- module' declaration, if any, or the DefaultModuleName
- % if there is no `:- module' declaration.
- % Messages is a list of warning/error messages.
- % Program is the parse tree.
-
:- type module_error
---> no_module_errors % no errors
; some_module_errors % some syntax errors
; fatal_module_errors. % couldn't open the file
-:- pred prog_io__read_module(open_file(FileInfo)::in(open_file),
+ % read_module(OpenFile, FileName, DefaultModuleName,
+ % ReturnTimestamp, Error, MaybeFileInfo, ActualModuleName, Messages,
+ % Program, MaybeModuleTimestamp):
+ %
+ % Reads and parses the file opened by OpenFile using the default module
+ % name DefaultModuleName. If ReturnTimestamp is `yes', attempt to return
+ % the modification timestamp in MaybeModuleTimestamp. Error is
+ % `fatal_module_errors' if the file coudn't be opened, `some_module_errors'
+ % if a syntax error was detected, and `no_module_errors' otherwise.
+ % MaybeFileInfo is the information about the file (usually the file or
+ % directory name) returned by OpenFile. ActualModuleName is the module name
+ % specified in the `:- module' declaration, if any, or the
+ % DefaultModuleName if there is no `:- module' declaration.
+ % Messages is a list of warning/error messages. Program is the parse tree.
+ %
+:- pred read_module(open_file(FileInfo)::in(open_file),
module_name::in, bool::in, module_error::out, maybe(FileInfo)::out,
module_name::out, message_list::out, item_list::out,
maybe(io__res(timestamp))::out, io::di, io::uo) is det.
-:- pred prog_io__read_module_if_changed(open_file(FileInfo)::in(open_file),
+:- pred read_module_if_changed(open_file(FileInfo)::in(open_file),
module_name::in, timestamp::in, module_error::out,
maybe(FileInfo)::out, module_name::out, message_list::out,
item_list::out, maybe(io__res(timestamp))::out, io::di, io::uo) is det.
- % Same as prog_io__read_module, but use intermod_directories
- % instead of search_directories when searching for the file.
+ % Same as read_module, but use intermod_directories instead of
+ % search_directories when searching for the file.
% Also report an error if the actual module name doesn't match
% the expected module name.
-:- pred prog_io__read_opt_file(file_name::in, module_name::in,
- module_error::out, message_list::out, item_list::out, io::di, io::uo)
- is det.
+ %
+:- pred read_opt_file(file_name::in, module_name::in, module_error::out,
+ message_list::out, item_list::out, io::di, io::uo) is det.
% check_module_has_expected_name(FileName, ExpectedName, ActualName):
- % Check that two module names are equal,
- % and report an error if they aren't.
+ %
+ % Check that two module names are equal, and report an error if they
+ % aren't.
+ %
:- pred check_module_has_expected_name(file_name::in, module_name::in,
module_name::in, io::di, io::uo) is det.
- % search_for_file(Dirs, FileName, FoundFileName, IO0, IO)
+ % search_for_file(Dirs, FileName, FoundFileName, !IO):
%
% Search Dirs for FileName, opening the file if it is found,
% and returning the path name of the file that was found.
+ %
:- pred search_for_file(list(dir_name)::in, file_name::in,
maybe_error(file_name)::out, io::di, io::uo) is det.
- % search_for_file_returning_dir(Dirs, FileName, FoundDirName, IO0, IO)
+ % search_for_file_returning_dir(Dirs, FileName, FoundDirName, !IO):
+ %
+ % Search Dirs for FileName, opening the file if it is found, and returning
+ % the name of the directory in which the file was found.
%
- % Search Dirs for FileName, opening the file if it is found,
- % and returning the name of the directory in which the file
- % was found.
:- pred search_for_file_returning_dir(list(dir_name)::in, file_name::in,
maybe_error(dir_name)::out, io::di, io::uo) is det.
- % search_for_module_source(Dirs, ModuleName,
- % FoundSourceFileName, IO0, IO)
+ % search_for_module_source(Dirs, ModuleName, FoundSourceFileName, !IO):
+ %
+ % Look for the source for ModuleName in Dirs. This will also search for
+ % files matching partially qualified versions of ModuleName. For example,
+ % module foo.bar.baz can be found in foo.bar.m, bar.baz.m or bar.m.
%
- % Look for the source for ModuleName in Dirs.
- % This will also search for files matching partially
- % qualified versions of ModuleName.
- % For example, module foo:bar:baz can be found
- % in foo.bar.m, bar.baz.m or bar.m.
:- pred search_for_module_source(list(dir_name)::in, module_name::in,
maybe_error(file_name)::out, io::di, io::uo) is det.
% Read the first item from the given file to find the module name.
+ %
:- pred find_module_name(file_name::in, maybe(module_name)::out,
io::di, io::uo) is det.
- % parse_item(ModuleName, VarSet, Term, MaybeItem)
+ % parse_item(ModuleName, VarSet, Term, MaybeItem):
+ %
+ % Parse Term. If successful, MaybeItem is bound to the parsed item,
+ % otherwise it is bound to an appropriate error message. Qualify
+ % appropriate parts of the item, with ModuleName as the module name.
%
- % parse Term. If successful, MaybeItem is bound to the parsed item,
- % otherwise it is bound to an appropriate error message.
- % Qualify appropriate parts of the item, with ModuleName as the
- % module name.
:- pred parse_item(module_name::in, varset::in, term::in,
maybe_item_and_context::out) is det.
- % parse_decl(ModuleName, VarSet, Term, Result)
+ % parse_decl(ModuleName, VarSet, Term, Result):
%
- % parse Term as a declaration. If successful, Result is bound to the
+ % Parse Term as a declaration. If successful, Result is bound to the
% parsed item, otherwise it is bound to an appropriate error message.
% Qualify appropriate parts of the item, with ModuleName as the module
% name.
+ %
:- pred parse_decl(module_name::in, varset::in, term::in,
maybe_item_and_context::out) is det.
- % parse_type_defn_head(ModuleName, Head, Body, HeadResult).
+ % parse_type_defn_head(ModuleName, Head, Body, HeadResult):
%
% Check the head of a type definition for errors.
+ %
:- pred parse_type_defn_head(module_name::in, term::in, term::in,
maybe2(sym_name, list(type_param))::out) is det.
% parse_type_decl_where_part_if_present(TypeSymName, Arity,
% IsSolverType, Inst, ModuleName, Term0, Term, Result):
- % Checks if Term0 is a term of the form
- % `<body> where <attributes>'
- % If so, returns the `<body>' in Term and the parsed
- % `<attributes>' in Result.
- % If not, returns Term = Term0 and
- % Result = no.
+ %
+ % Checks if Term0 is a term of the form `<body> where <attributes>'.
+ % If so, returns the `<body>' in Term and the parsed `<attributes>'
+ % in Result. If not, returns Term = Term0 and Result = no.
%
:- pred parse_type_decl_where_part_if_present(is_solver_type::in,
module_name::in, term::in, term::out,
@@ -197,49 +197,48 @@
%-----------------------------------------------------------------------------%
- % A QualifiedTerm is one of
- % Name(Args)
- % Module:Name(Args)
- % (or if Args is empty, one of
- % Name
- % Module:Name)
- % where Module is a SymName.
- % For backwards compatibility, we allow `__'
- % as an alternative to `:'.
-
- % sym_name_and_args takes a term and returns a sym_name and a list of
- % argument terms.
- % It fails if the input is not valid syntax for a QualifiedTerm.
+% A QualifiedTerm is one of
+% Name(Args)
+% Module.Name(Args)
+% (or if Args is empty, one of
+% Name
+% Module.Name)
+% where Module is a SymName. For backwards compatibility, we allow `__'
+% as an alternative to `.'.
+
+ % Sym_name_and_args takes a term and returns a sym_name and a list of
+ % argument terms. It fails if the input is not valid syntax for a
+ % QualifiedTerm.
+ %
:- pred sym_name_and_args(term(T)::in, sym_name::out, list(term(T))::out)
is semidet.
- % parse_qualified_term/4 takes a term (and also the containing
- % term, and a string describing the context from which it
- % was called [e.g. "clause head"])
- % and returns a sym_name and a list of argument terms.
- % Returns an error on ill-formed input.
- % See also parse_implicitly_qualified_term/5 (below).
+ % parse_qualified_term/4 takes a term (and also the containing term,
+ % and a string describing the context from which it was called
+ % [e.g. "clause head"]) and returns a sym_name and a list of argument
+ % terms. Returns an error on ill-formed input. See also
+ % parse_implicitly_qualified_term/5 (below).
+ %
:- pred parse_qualified_term(term(T)::in, term(T)::in, string::in,
maybe_functor(T)::out) is det.
% parse_implicitly_qualified_term(DefaultModName, Term,
% ContainingTerm, Msg, Result):
%
- % parse_implicitly_qualified_term/5 takes a default module name
- % and a term,
- % (and also the containing term, and a string describing
- % the context from which it was called (e.g. "clause head"),
- % and returns a sym_name and a list of argument terms.
- % Returns an error on ill-formed input or a module qualifier that
- % doesn't match the DefaultModName.
+ % parse_implicitly_qualified_term/5 takes a default module name and a term,
+ % (and also the containing term, and a string describing the context from
+ % which it was called (e.g. "clause head"), and returns a sym_name and
+ % a list of argument terms. Returns an error on ill-formed input or
+ % a module qualifier that doesn't match the DefaultModName.
%
- % Note: parse_qualified_term/4 is used for places where a symbol
- % is _used_, in which case no default module name exists, whereas
+ % Note: parse_qualified_term/4 is used for places where a symbol is _used_,
+ % in which case no default module name exists, whereas
% parse_implicitly_qualified_term/5 is used for places where a symbol
- % is _defined_; in that case, there is a default module name (the
- % name of the current module) -- specifying a module qualifier
- % explicitly is redundant, but it is allowed, so long as the
- % module qualifier specified matches the default.
+ % is _defined_; in that case, there is a default module name (the name
+ % of the current module) -- specifying a module qualifier explicitly
+ % is redundant, but it is allowed, so long as the module qualifier
+ % specified matches the default.
+ %
:- pred parse_implicitly_qualified_term(module_name::in, term(T)::in,
term(T)::in, string::in, maybe_functor(T)::out) is det.
@@ -247,11 +246,13 @@
% Replace all occurrences of inst_var(I) with
% constrained_inst_var(I, ground(shared, none)).
+ %
:- pred constrain_inst_vars_in_mode((mode)::in, (mode)::out) is det.
% Replace all occurrences of inst_var(I) with
% constrained_inst_var(I, Inst) where I -> Inst is in the inst_var_sub.
% If I is not in the inst_var_sub, default to ground(shared, none).
+ %
:- pred constrain_inst_vars_in_mode(inst_var_sub::in, (mode)::in, (mode)::out)
is det.
@@ -259,6 +260,7 @@
% Check that for each constrained_inst_var all occurrences have the
% same constraint.
+ %
:- pred inst_var_constraints_are_consistent_in_modes(list(mode)::in)
is semidet.
@@ -297,25 +299,23 @@
%-----------------------------------------------------------------------------%
-prog_io__read_module(OpenFile, DefaultModuleName,
+read_module(OpenFile, DefaultModuleName,
ReturnTimestamp, Error, FileData, ModuleName,
Messages, Items, MaybeModuleTimestamp, !IO) :-
- prog_io__read_module_2(OpenFile, DefaultModuleName,
+ read_module_2(OpenFile, DefaultModuleName,
no, ReturnTimestamp, Error, FileData, ModuleName,
Messages, Items, MaybeModuleTimestamp, !IO).
-prog_io__read_module_if_changed(OpenFile, DefaultModuleName,
+read_module_if_changed(OpenFile, DefaultModuleName,
OldTimestamp, Error, FileData, ModuleName, Messages,
Items, MaybeModuleTimestamp, !IO) :-
- prog_io__read_module_2(OpenFile, DefaultModuleName,
+ read_module_2(OpenFile, DefaultModuleName,
yes(OldTimestamp), yes, Error, FileData,
ModuleName, Messages, Items, MaybeModuleTimestamp, !IO).
-prog_io__read_opt_file(FileName, DefaultModuleName, Error, Messages, Items,
- !IO) :-
- globals__io_lookup_accumulating_option(intermod_directories, Dirs,
- !IO),
- prog_io__read_module_2(search_for_file(Dirs, FileName),
+read_opt_file(FileName, DefaultModuleName, Error, Messages, Items, !IO) :-
+ globals__io_lookup_accumulating_option(intermod_directories, Dirs, !IO),
+ read_module_2(search_for_file(Dirs, FileName),
DefaultModuleName, no, no, Error, _, ModuleName, Messages,
Items, _, !IO),
check_module_has_expected_name(FileName, DefaultModuleName, ModuleName,
@@ -323,13 +323,10 @@
check_module_has_expected_name(FileName, ExpectedName, ActualName, !IO) :-
( ActualName \= ExpectedName ->
- mdbcomp__prim_data__sym_name_to_string(ActualName,
- ActualString),
- mdbcomp__prim_data__sym_name_to_string(ExpectedName,
- ExpectedString),
+ sym_name_to_string(ActualName, ActualString),
+ sym_name_to_string(ExpectedName, ExpectedString),
io__write_strings([
- "Error: file `", FileName,
- "' contains the wrong module.\n",
+ "Error: file `", FileName, "' contains the wrong module.\n",
"Expected module `", ExpectedString,
"', found module `", ActualString, "'.\n"
], !IO),
@@ -338,22 +335,20 @@
true
).
-% This implementation uses io__read_term to read in the program
-% term at a time, and then converts those terms into clauses and
-% declarations, checking for errors as it goes.
-% Note that rather than using difference lists, we just
-% build up the lists of items and messages in reverse order
-% and then reverse them afterwards. (Using difference lists would require
-% late-input modes.)
-
-:- pred prog_io__read_module_2(open_file(T)::in(open_file), module_name::in,
+ % This implementation uses io__read_term to read in the program one term
+ % at a time, and then converts those terms into clauses and declarations,
+ % checking for errors as it goes. Note that rather than using difference
+ % lists, we just build up the lists of items and messages in reverse order
+ % and then reverse them afterwards. (Using difference lists would require
+ % late-input modes.)
+ %
+:- pred read_module_2(open_file(T)::in(open_file), module_name::in,
maybe(timestamp)::in, bool::in, module_error::out, maybe(T)::out,
module_name::out, message_list::out, item_list::out,
maybe(io__res(timestamp))::out, io::di, io::uo) is det.
-prog_io__read_module_2(OpenFile, DefaultModuleName,
- MaybeOldTimestamp, ReturnTimestamp, Error,
- MaybeFileData, ModuleName, Messages, Items,
+read_module_2(OpenFile, DefaultModuleName, MaybeOldTimestamp, ReturnTimestamp,
+ Error, MaybeFileData, ModuleName, Messages, Items,
MaybeModuleTimestamp, !IO) :-
io__input_stream(OldInputStream, !IO),
OpenFile(OpenResult, !IO),
@@ -362,12 +357,10 @@
MaybeFileData = yes(FileData),
( ReturnTimestamp = yes ->
io__input_stream_name(InputStreamName, !IO),
- io__file_modification_time(InputStreamName,
- TimestampResult, !IO),
+ io__file_modification_time(InputStreamName, TimestampResult, !IO),
(
TimestampResult = ok(Timestamp),
- MaybeModuleTimestamp = yes(
- ok(time_t_to_timestamp(Timestamp)))
+ MaybeModuleTimestamp = yes(ok(time_t_to_timestamp(Timestamp)))
;
TimestampResult = error(IOError),
MaybeModuleTimestamp = yes(error(IOError))
@@ -379,20 +372,18 @@
MaybeOldTimestamp = yes(OldTimestamp),
MaybeModuleTimestamp = yes(ok(OldTimestamp))
->
- %
% XXX Currently smart recompilation won't work
% if ModuleName \= DefaultModuleName.
- % In that case, smart recompilation will
- % be disabled and prog_io__read_module should
- % never be passed an old timestamp.
- %
+ % In that case, smart recompilation will be disabled
+ % and read_module should never be passed an old timestamp.
+
ModuleName = DefaultModuleName,
Items = [],
Error = no_module_errors,
Messages = []
;
- read_all_items(DefaultModuleName, ModuleName,
- Messages, Items, Error, !IO)
+ read_all_items(DefaultModuleName, ModuleName, Messages, Items,
+ Error, !IO)
),
io__set_input_stream(OldInputStream, ModuleInputStream, !IO),
io__close_input(ModuleInputStream, !IO)
@@ -447,8 +438,7 @@
).
search_for_module_source(Dirs, ModuleName, MaybeFileName, !IO) :-
- search_for_module_source(Dirs, ModuleName, ModuleName, MaybeFileName,
- !IO).
+ search_for_module_source(Dirs, ModuleName, ModuleName, MaybeFileName, !IO).
:- pred search_for_module_source(list(dir_name)::in,
module_name::in, module_name::in, maybe_error(file_name)::out,
@@ -463,11 +453,10 @@
;
Result0 = error(_),
(
- PartialModuleName1 =
- drop_one_qualifier(PartialModuleName)
+ PartialModuleName1 = drop_one_qualifier(PartialModuleName)
->
- search_for_module_source(Dirs, ModuleName,
- PartialModuleName1, Result, !IO)
+ search_for_module_source(Dirs, ModuleName, PartialModuleName1,
+ Result, !IO)
;
sym_name_to_string(ModuleName, ModuleNameStr),
Result = error("can't find source for module `" ++
@@ -495,27 +484,26 @@
%-----------------------------------------------------------------------------%
- % extract the final `:- end_module' declaration if any
-
-:- type module_end ---> no ; yes(module_name, prog_context).
+:- type module_end
+ ---> no
+ ; yes(module_name, prog_context).
-:- pred get_end_module(item_list::in, module_name::in, item_list::out,
+ % Extract the final `:- end_module' declaration if any.
+ %
+:- pred get_end_module(module_name::in, item_list::in, item_list::out,
module_end::out) is det.
-get_end_module(RevItems0, ModuleName, RevItems, EndModule) :-
+get_end_module(ModuleName, RevItems0, RevItems, EndModule) :-
(
- %
- % Note: if the module name in the end_module declaration
- % does not match what we expect, given the source file name,
- % then we assume that it is for a nested module, and so
- % we leave it alone. If it is not for a nested module,
- % the error will be caught by make_hlds.m.
- %
- RevItems0 = [
- module_defn(_VarSet, end_module(ModuleName)) - Context
- | RevItems1]
+ % Note: if the module name in the end_module declaration does not match
+ % what we expect, given the source file name, then we assume that it is
+ % for a nested module, and so we leave it alone. If it is not for a
+ % nested module, the error will be caught by make_hlds.
+
+ RevItems0 = [module_defn(_VarSet, end_module(ModuleName)) - Context
+ | RevItemsPrime]
->
- RevItems = RevItems1,
+ RevItems = RevItemsPrime,
EndModule = yes(ModuleName, Context)
;
RevItems = RevItems0,
@@ -524,27 +512,23 @@
%-----------------------------------------------------------------------------%
- % check that the module starts with a :- module declaration,
+ % Check that the module starts with a :- module declaration,
% and that the end_module declaration (if any) is correct,
% and construct the final parsing result.
-
+ %
:- pred check_end_module(module_end::in, message_list::in, message_list::out,
item_list::in, item_list::out, module_error::in, module_error::out)
is det.
check_end_module(EndModule, !Messages, !Items, !Error) :-
- %
- % double-check that the first item is a `:- module ModuleName'
- % declaration, and remove it from the front of the item list
- %
+ % Double-check that the first item is a `:- module ModuleName' declaration,
+ % and remove it from the front of the item list.
(
!.Items = [Item | !:Items],
Item = module_defn(_VarSet, module(ModuleName1)) - _Context1
->
- %
- % check that the end module declaration (if any)
- % matches the begin module declaration
- %
+ % Check that the end module declaration (if any) matches
+ % the begin module declaration.
(
EndModule = yes(ModuleName2, Context2),
ModuleName1 \= ModuleName2
@@ -558,16 +542,16 @@
true
)
;
- % if there's no `:- module' declaration at this point, it is
- % an internal error -- read_first_item should have inserted one
+ % If there's no `:- module' declaration at this point, it is
+ % an internal error -- read_first_item should have inserted one.
error("check_end_module: no `:- module' declaration")
).
%-----------------------------------------------------------------------------%
- % Create a dummy term.
- % Used for error messages that are not associated with any
- % particular term or context.
+ % Create a dummy term. Used for error messages that are not associated
+ % with any particular term or context.
+ %
:- pred dummy_term(term::out) is det.
dummy_term(Term) :-
@@ -578,7 +562,7 @@
% Used for error messages that are associated with some specific
% context, but for which we don't want to print out the term
% (or for which the term isn't available to be printed out).
-
+ %
:- pred dummy_term_with_context(term__context::in, term::out) is det.
dummy_term_with_context(Context, Term) :-
@@ -628,27 +612,24 @@
% lexical analysis (chars -> tokens),
% parsing stage 1 (tokens -> terms),
% parsing stage 2 (terms -> items).
- % The final stage produces a list of program items, each of
- % which may be a declaration or a clause.
+ % The final stage produces a list of program items, each of which
+ % may be a declaration or a clause.
%
% We use a continuation-passing style here.
-
+ %
:- pred read_all_items(module_name::in, module_name::out,
message_list::out, item_list::out, module_error::out,
io__state::di, io__state::uo) is det.
read_all_items(DefaultModuleName, ModuleName, Messages, Items, Error, !IO) :-
- %
- % read all the items (the first one is handled specially)
- %
+ % Read all the items (the first one is handled specially).
io__input_stream(Stream, !IO),
io__input_stream_name(Stream, SourceFileName, !IO),
read_first_item(DefaultModuleName, SourceFileName, ModuleName,
RevMessages0, RevItems0, MaybeSecondTerm, Error0, !IO),
(
MaybeSecondTerm = yes(SecondTerm),
- process_read_term(ModuleName, SecondTerm,
- MaybeSecondItem),
+ process_read_term(ModuleName, SecondTerm, MaybeSecondItem),
read_items_loop_2(MaybeSecondItem, ModuleName, SourceFileName,
RevMessages0, RevMessages1, RevItems0, RevItems1,
@@ -660,97 +641,76 @@
Error0, Error1, !IO)
),
- %
- % get the end_module declaration (if any),
- % check that it matches the initial module declaration (if any),
- % and remove both of them from the final item list.
- %
- get_end_module(RevItems1, ModuleName, RevItems, EndModule),
+ % Get the end_module declaration (if any), check that it matches
+ % the initial module declaration (if any), and remove both of them
+ % from the final item list.
+ get_end_module(ModuleName, RevItems1, RevItems, EndModule),
check_end_module(EndModule, RevMessages1, RevMessages, Items0, Items,
Error1, Error),
list__reverse(RevMessages, Messages),
list__reverse(RevItems, Items0).
-%
-% We need to jump through a few hoops when reading the first item,
-% to allow the initial `:- module' declaration to be optional.
-% The reason is that in order to parse an item, we need to know
-% which module it is defined in (because we do some module
-% qualification and checking of module qualifiers at parse time),
-% but the initial `:- module' declaration and the declaration
-% that follows it occur in different scopes, so we need to know
-% what it is that we're parsing before we can parse it!
-% We solve this dilemma by first parsing it in the root scope,
-% and then if it turns out to not be a `:- module' declaration
-% we reparse it in the default module scope. Blecchh.
-%
+ % We need to jump through a few hoops when reading the first item,
+ % to allow the initial `:- module' declaration to be optional.
+ % The reason is that in order to parse an item, we need to know
+ % which module it is defined in (because we do some module
+ % qualification and checking of module qualifiers at parse time),
+ % but the initial `:- module' declaration and the declaration
+ % that follows it occur in different scopes, so we need to know
+ % what it is that we're parsing before we can parse it!
+ % We solve this dilemma by first parsing it in the root scope,
+ % and then if it turns out to not be a `:- module' declaration
+ % we reparse it in the default module scope. Blecchh.
+ %
:- pred read_first_item(module_name::in, file_name::in, module_name::out,
message_list::out, item_list::out, maybe(read_term)::out,
module_error::out, io__state::di, io__state::uo) is det.
read_first_item(DefaultModuleName, SourceFileName, ModuleName,
Messages, Items, MaybeSecondTerm, Error, !IO) :-
- globals__io_lookup_bool_option(warn_missing_module_name,
- WarnMissing, !IO),
- globals__io_lookup_bool_option(warn_wrong_module_name,
- WarnWrong, !IO),
+ globals__io_lookup_bool_option(warn_missing_module_name, WarnMissing, !IO),
+ globals__io_lookup_bool_option(warn_wrong_module_name, WarnWrong, !IO),
- %
- % parse the first term, treating it as occurring
- % within the scope of the special "root" module
- % (so that any `:- module' declaration is taken to
- % be a non-nested module unless explicitly qualified).
- %
+ % Parse the first term, treating it as occurring within the scope
+ % of the special "root" module (so that any `:- module' declaration
+ % is taken to be a non-nested module unless explicitly qualified).
parser__read_term(SourceFileName, MaybeFirstTerm, !IO),
root_module_name(RootModuleName),
process_read_term(RootModuleName, MaybeFirstTerm, MaybeFirstItem),
(
- %
- % apply and then skip `pragma source_file' decls,
- % by calling ourselves recursively with the new source
- % file name
- %
+ % Apply and then skip `pragma source_file' decls, by calling ourselves
+ % recursively with the new source file name.
MaybeFirstItem = ok(FirstItem, _),
FirstItem = pragma(_, source_file(NewSourceFileName))
->
read_first_item(DefaultModuleName, NewSourceFileName,
- ModuleName, Messages, Items, MaybeSecondTerm, Error,
- !IO)
+ ModuleName, Messages, Items, MaybeSecondTerm, Error, !IO)
;
- %
- % check if the first term was a `:- module' decl
- %
+ % Check if the first term was a `:- module' decl.
MaybeFirstItem = ok(FirstItem, FirstContext),
FirstItem = module_defn(_VarSet, ModuleDefn),
ModuleDefn = module(StartModuleName)
->
- %
- % if so, then check that it matches the expected
- % module name, and if not, report a warning
- %
+ % If so, then check that it matches the expected module name,
+ % and if not, report a warning.
( match_sym_name(StartModuleName, DefaultModuleName) ->
ModuleName = DefaultModuleName,
Messages = []
- ;
- match_sym_name(DefaultModuleName, StartModuleName)
- ->
+ ; match_sym_name(DefaultModuleName, StartModuleName) ->
ModuleName = StartModuleName,
Messages = []
;
- mdbcomp__prim_data__sym_name_to_string(StartModuleName,
- StartModuleNameString),
+ sym_name_to_string(StartModuleName, StartModuleNameString),
string__append_list(["source file `", SourceFileName,
"' contains module named `",
StartModuleNameString, "'"],
WrongModuleWarning),
- maybe_add_warning(WarnWrong, MaybeFirstTerm,
- FirstContext,
+ maybe_add_warning(WarnWrong, MaybeFirstTerm, FirstContext,
WrongModuleWarning, [], Messages),
- % Which one should we use here?
- % We used to use the default module name
- % (computed from the filename)
- % but now we use the declared one.
+ % Which one should we use here? We used to use the default module
+ % name (computed from the filename) but now we use the declared
+ % one.
ModuleName = StartModuleName
),
make_module_decl(ModuleName, FirstContext, FixedFirstItem),
@@ -758,32 +718,30 @@
Error = no_module_errors,
MaybeSecondTerm = no
;
- %
- % if the first term was not a `:- module' decl,
- % then issue a warning (if warning enabled), and
- % insert an implicit `:- module ModuleName' decl.
- %
+ % If the first term was not a `:- module' decl, then issue a warning
+ % (if warning enabled), and insert an implicit `:- module ModuleName'
+ % decl.
( MaybeFirstItem = ok(_FirstItem, FirstContext0) ->
FirstContext = FirstContext0
;
term__context_init(SourceFileName, 1, FirstContext)
),
- ( WarnMissing = yes ->
+ (
+ WarnMissing = yes,
dummy_term_with_context(FirstContext, FirstTerm),
add_warning("module should start with a " ++
"`:- module' declaration", FirstTerm, [],
Messages)
;
+ WarnMissing = no,
Messages = []
),
ModuleName = DefaultModuleName,
make_module_decl(ModuleName, FirstContext, FixedFirstItem),
- %
- % reparse the first term, this time treating it as
- % occuring within the scope of the implicit
- % `:- module' decl rather than in the root module.
- %
+ % Reparse the first term, this time treating it as occuring within
+ % the scope of the implicit `:- module' decl rather than in the
+ % root module.
MaybeSecondTerm = yes(MaybeFirstTerm),
Items = [FixedFirstItem],
Error = no_module_errors
@@ -815,21 +773,19 @@
%-----------------------------------------------------------------------------%
- % The code below was carefully optimized to run efficiently
- % in NU-Prolog. We used to call read_item(MaybeItem) -
- % which does all the work for a single item -
- % via io__gc_call/1, which called the goal with garbage collection.
- % But optimizing for NU-Prolog is no longer a big priority...
+ % The code below was carefully optimized to run efficiently in NU-Prolog.
+ % We used to call read_item(MaybeItem) - which does all the work for
+ % a single item - via io__gc_call/1, which called the goal with
+ % garbage collection. But optimizing for NU-Prolog is no longer a concern.
:- pred read_items_loop(module_name::in, file_name::in,
message_list::in, message_list::out, item_list::in, item_list::out,
- module_error::in,module_error::out, io__state::di, io__state::uo)
- is det.
+ module_error::in,module_error::out, io__state::di, io__state::uo) is det.
read_items_loop(ModuleName, SourceFileName, !Msgs, !Items, !Error, !IO) :-
read_item(ModuleName, SourceFileName, MaybeItem, !IO),
- read_items_loop_2(MaybeItem, ModuleName, SourceFileName,
- !Msgs, !Items, !Error, !IO).
+ read_items_loop_2(MaybeItem, ModuleName, SourceFileName, !Msgs,
+ !Items, !Error, !IO).
%-----------------------------------------------------------------------------%
@@ -838,15 +794,13 @@
item_list::in, item_list::out, module_error::in, module_error::out,
io__state::di, io__state::uo) is det.
-% do a switch on the type of the next item
-
read_items_loop_2(eof, _ModuleName, _SourceFile, !Msgs, !Items, !Error, !IO).
- % if the next item was end-of-file, then we're done.
+ % If the next item was end-of-file, then we're done.
read_items_loop_2(syntax_error(ErrorMsg, LineNumber), ModuleName,
SourceFileName, !Msgs, !Items, _Error0, Error, !IO) :-
- % if the next item was a syntax error, then insert it in
- % the list of messages and continue looping
+ % If the next item was a syntax error, then insert it in the list
+ % of messages and continue looping.
term__context_init(SourceFileName, LineNumber, Context),
dummy_term_with_context(Context, Term),
ThisError = ErrorMsg - Term,
@@ -857,8 +811,8 @@
read_items_loop_2(error(M, T), ModuleName, SourceFileName, !Msgs, !Items,
_Error0, Error, !IO) :-
- % if the next item was a semantic error, then insert it in
- % the list of messages and continue looping
+ % If the next item was a semantic error, then insert it in the list
+ % of messages and continue looping.
add_error(M, T, !Msgs),
Error1 = some_module_errors,
read_items_loop(ModuleName, SourceFileName, !Msgs, !Items,
@@ -868,30 +822,33 @@
!Msgs, !Items, !Error, !IO) :-
( Item0 = nothing(yes(Warning)) ->
Warning = item_warning(MaybeOption, Msg, Term),
- ( MaybeOption = yes(Option) ->
+ (
+ MaybeOption = yes(Option),
globals__io_lookup_bool_option(Option, Warn, !IO)
;
+ MaybeOption = no,
Warn = yes
),
- ( Warn = yes ->
+ (
+ Warn = yes,
add_warning(Msg, Term, !Msgs),
- globals__io_lookup_bool_option(halt_at_warn, Halt,
- !IO),
- ( Halt = yes ->
+ globals__io_lookup_bool_option(halt_at_warn, Halt, !IO),
+ (
+ Halt = yes,
!:Error = some_module_errors
;
- true
+ Halt = no
)
;
- true
+ Warn = no
),
Item = nothing(no)
;
Item = Item0
),
- % if the next item was a valid item, check whether it was
+ % If the next item was a valid item, check whether it was
% a declaration that affects the current parsing context --
% i.e. either a `module'/`end_module' declaration or a
% `pragma source_file' declaration. If so, set the new
@@ -913,15 +870,13 @@
SourceFileName = SourceFileName0,
!:Items = [Item - Context | !.Items]
; Item = module_defn(VarSet, import(module(Modules))) ->
- ImportItems = list.map(
- make_pseudo_import_module_decl(VarSet, Context),
+ ImportItems = list.map(make_pseudo_import_module_decl(VarSet, Context),
Modules),
SourceFileName = SourceFileName0,
ModuleName = ModuleName0,
list.append(ImportItems, !Items)
; Item = module_defn(VarSet, use(module(Modules))) ->
- UseItems = list.map(
- make_pseudo_use_module_decl(VarSet, Context),
+ UseItems = list.map(make_pseudo_use_module_decl(VarSet, Context),
Modules),
SourceFileName = SourceFileName0,
ModuleName = ModuleName0,
@@ -938,8 +893,7 @@
ModuleName = ModuleName0,
!:Items = [Item - Context | !.Items]
),
- read_items_loop(ModuleName, SourceFileName, !Msgs, !Items, !Error,
- !IO).
+ read_items_loop(ModuleName, SourceFileName, !Msgs, !Items, !Error, !IO).
:- func make_pseudo_import_module_decl(prog_varset, prog_context,
module_specifier) = item_and_context.
@@ -957,20 +911,18 @@
module_name) = item_and_context.
make_pseudo_include_module_decl(Varset, Context, ModuleSpecifier) =
- module_defn(Varset, include_module([ModuleSpecifier])) -
- Context.
+ module_defn(Varset, include_module([ModuleSpecifier])) - Context.
%-----------------------------------------------------------------------------%
- % read_item/1 reads a single item, and if it is a valid term
- % parses it.
-
:- type maybe_item_or_eof
---> eof
; syntax_error(file_name, int)
; error(string, term)
; ok(item, term__context).
+ % Read_item/1 reads a single item, and if it is a valid term parses it.
+ %
:- pred read_item(module_name::in, file_name::in, maybe_item_or_eof::out,
io::di, io::uo) is det.
@@ -995,39 +947,27 @@
convert_item(error(M, T), error(M, T)).
parse_item(ModuleName, VarSet, Term, Result) :-
- ( %%% some [Decl, DeclContext]
- Term = term__functor(term__atom(":-"), [Decl], _DeclContext)
- ->
- % It's a declaration
+ ( Term = term__functor(term__atom(":-"), [Decl], _DeclContext) ->
+ % It's a declaration.
parse_decl(ModuleName, VarSet, Decl, Result)
- ; %%% some [DCG_H, DCG_B, DCG_Context]
- % It's a DCG clause
- Term = term__functor(term__atom("-->"), [DCG_H, DCG_B],
- DCG_Context)
- ->
- parse_dcg_clause(ModuleName, VarSet, DCG_H, DCG_B,
- DCG_Context, Result)
+ ; Term = term__functor(term__atom("-->"), [DCG_H, DCG_B], DCG_Context) ->
+ % It's a DCG clause.
+ parse_dcg_clause(ModuleName, VarSet, DCG_H, DCG_B, DCG_Context, Result)
;
% It's either a fact or a rule
- ( %%% some [H, B, TermContext]
- Term = term__functor(term__atom(":-"), [H, B],
- TermContext)
- ->
- % it's a rule
+ ( Term = term__functor(term__atom(":-"), [H, B], TermContext) ->
+ % It's a rule.
Head = H,
Body = B,
TheContext = TermContext
;
- % it's a fact
+ % It's a fact.
Head = Term,
- (
- Head = term__functor(_Functor, _Args,
- HeadContext)
- ->
+ ( Head = term__functor(_Functor, _Args, HeadContext) ->
TheContext = HeadContext
;
- % term consists of just a single
- % variable - the context has been lost
+ % Term consists of just a single variable - the context
+ % has been lost.
term__context_init(TheContext)
),
Body = term__functor(term__atom("true"), [], TheContext)
@@ -1035,17 +975,15 @@
varset__coerce(VarSet, ProgVarSet),
parse_goal(Body, Body2, ProgVarSet, ProgVarSet2),
(
- Head = term__functor(term__atom("="),
- [FuncHead0, FuncResult], _),
+ Head = term__functor(term__atom("="), [FuncHead0, FuncResult], _),
FuncHead = desugar_field_access(FuncHead0)
->
- parse_implicitly_qualified_term(ModuleName,
- FuncHead, Head, "equation head", R2),
- process_func_clause(R2, FuncResult, ProgVarSet2, Body2,
- R3)
+ parse_implicitly_qualified_term(ModuleName, FuncHead, Head,
+ "equation head", R2),
+ process_func_clause(R2, FuncResult, ProgVarSet2, Body2, R3)
;
- parse_implicitly_qualified_term(ModuleName,
- Head, Term, "clause head", R2),
+ parse_implicitly_qualified_term(ModuleName, Head, Term,
+ "clause head", R2),
process_pred_clause(R2, ProgVarSet2, Body2, R3)
),
add_context(R3, TheContext, Result)
@@ -1084,39 +1022,30 @@
---> exist
; univ.
+ % The term associated with each decl_attribute is the term containing
+ % both the attribute and the declaration that that attribute modifies;
+ % this term is used when printing out error messages for cases when
+ % attributes are used on declarations where they are not allowed.
:- type decl_attrs == list(pair(decl_attribute, term)).
- % the term associated with each decl_attribute
- % is the term containing both the attribute and
- % the declaration that that attribute modifies;
- % this term is used when printing out error messages
- % for cases when attributes are used on declarations
- % where they are not allowed.
parse_decl(ModuleName, VarSet, F, Result) :-
parse_decl_2(ModuleName, VarSet, F, [], Result).
- % parse_decl_2(ModuleName, VarSet, Term, Attributes, Result)
- % succeeds if Term is a declaration and binds Result to a
- % representation of that declaration. Attributes is a list
- % of enclosing declaration attributes, in the order innermost to
- % outermost.
+ % parse_decl_2(ModuleName, VarSet, Term, Attributes, Result):
+ %
+ % Succeeds if Term is a declaration and binds Result to a representation
+ % of that declaration. Attributes is a list of enclosing declaration
+ % attributes, in the order innermost to outermost.
+ %
:- pred parse_decl_2(module_name::in, varset::in, term::in, decl_attrs::in,
maybe_item_and_context::out) is det.
parse_decl_2(ModuleName, VarSet, F, Attributes, Result) :-
- (
- F = term__functor(term__atom(Atom), Args, Context)
- ->
- (
- parse_decl_attribute(Atom, Args, Attribute, SubTerm)
- ->
+ ( F = term__functor(term__atom(Atom), Args, Context) ->
+ ( parse_decl_attribute(Atom, Args, Attribute, SubTerm) ->
NewAttributes = [Attribute - F | Attributes],
- parse_decl_2(ModuleName, VarSet, SubTerm,
- NewAttributes, Result)
- ;
- process_decl(ModuleName, VarSet, Atom, Args,
- Attributes, R)
- ->
+ parse_decl_2(ModuleName, VarSet, SubTerm, NewAttributes, Result)
+ ; process_decl(ModuleName, VarSet, Atom, Args, Attributes, R) ->
add_context(R, Context, Result)
;
Result = error("unrecognized declaration", F)
@@ -1125,11 +1054,12 @@
Result = error("atom expected after `:-'", F)
).
- % process_decl(ModuleName, VarSet, Attributes, Atom, Args, Result)
- % succeeds if Atom(Args) is a declaration and binds Result to a
- % representation of that declaration. Attributes is a list
- % of enclosing declaration attributes, in the order outermost to
- % innermost.
+ % process_decl(ModuleName, VarSet, Attributes, Atom, Args, Result):
+ %
+ % Succeeds if Atom(Args) is a declaration and binds Result to a
+ % representation of that declaration. Attributes is a list of
+ % enclosing declaration attributes, in the order outermost to innermost.
+ %
:- pred process_decl(module_name::in, varset::in, string::in, list(term)::in,
decl_attrs::in, maybe1(item)::out) is semidet.
@@ -1315,8 +1245,7 @@
(
Result0 = ok(ModuleNameSyms),
varset__coerce(VarSet0, VarSet),
- Result1 = ok(module_defn(VarSet,
- include_module(ModuleNameSyms)))
+ Result1 = ok(module_defn(VarSet, include_module(ModuleNameSyms)))
;
Result0 = error(A, B),
Result1 = error(A, B)
@@ -1325,11 +1254,10 @@
process_decl(DefaultModuleName, VarSet0, "end_module", [ModuleName],
Attributes, Result) :-
- %
- % The name in an `end_module' declaration not inside the
- % scope of the module being ended, so the default module name
- % here is the parent of the previous default module name.
- %
+ % The name in an `end_module' declaration not inside the scope of the
+ % module being ended, so the default module name here is the parent
+ % of the previous default module name.
+
root_module_name(RootModuleName),
sym_name_get_module_name(DefaultModuleName, RootModuleName,
ParentOfDefaultModuleName),
@@ -1380,34 +1308,29 @@
Attributes, Result) :-
parse_module_specifier(ModuleNameTerm, ModuleNameResult),
(
- VersionNumberTerm = term__functor(
- term__integer(VersionNumber), [], _),
+ VersionNumberTerm = term__functor(term__integer(VersionNumber), [], _),
VersionNumber = version_numbers_version_number
->
(
ModuleNameResult = ok(ModuleName)
->
- recompilation__version__parse_version_numbers(
- VersionNumbersTerm, Result0),
+ recompilation__version__parse_version_numbers(VersionNumbersTerm,
+ Result0),
(
Result0 = ok(VersionNumbers),
varset__coerce(VarSet0, VarSet),
- Result1 = module_defn(VarSet,
- version_numbers(ModuleName,
+ Result1 = module_defn(VarSet, version_numbers(ModuleName,
VersionNumbers)),
- check_no_attributes(ok(Result1),
- Attributes, Result)
+ check_no_attributes(ok(Result1), Attributes, Result)
;
Result0 = error(A, B),
Result = error(A, B)
)
;
- Result = error(
- "invalid module name in `:- version_numbers'",
+ Result = error("invalid module name in `:- version_numbers'",
ModuleNameTerm)
)
;
-
( VersionNumberTerm = term__functor(_, _, Context) ->
Msg = "interface file needs to be recreated, " ++
"the version numbers are out of date",
@@ -1416,8 +1339,7 @@
Msg, DummyTerm),
Result = ok(nothing(yes(Warning)))
;
- Result = error(
- "invalid version number in `:- version_numbers'",
+ Result = error("invalid version number in `:- version_numbers'",
VersionNumberTerm)
)
).
@@ -1487,7 +1409,7 @@
varset__coerce(VarSet, ProgVarSet0),
parse_goal(Term, Goal0, ProgVarSet0, ProgVarSet),
- % get universally quantified variables
+ % Get universally quantified variables.
( PromiseType = true ->
( Goal0 = all(UnivVars0, AllGoal) - _Context ->
UnivVars0 = UnivVars,
@@ -1501,7 +1423,6 @@
list__map(term__coerce_var, UnivVars0, UnivVars),
Goal0 = Goal
),
-
Result = ok(promise(PromiseType, Goal, ProgVarSet, UnivVars)).
%-----------------------------------------------------------------------------%
@@ -1512,8 +1433,7 @@
parse_type_decl(ModuleName, VarSet, TypeDecl, Attributes, Result) :-
(
TypeDecl = term__functor(term__atom(Name), Args, _),
- parse_type_decl_type(ModuleName, Name, Args, Attributes,
- Cond, R)
+ parse_type_decl_type(ModuleName, Name, Args, Attributes, Cond, R)
->
R1 = R,
Cond1 = Cond
@@ -1521,9 +1441,8 @@
process_abstract_type(ModuleName, TypeDecl, Attributes, R1),
Cond1 = true
),
- % We should check the condition for errors
- % (don't bother at the moment, since we ignore
- % conditions anyhow :-).
+ % We should check the condition for errors (don't bother at the moment,
+ % since we ignore conditions anyhow :-).
process_maybe1(make_type_defn(VarSet, Cond1), R1, Result).
:- pred make_type_defn(varset::in, condition::in, processed_type_body::in,
@@ -1552,16 +1471,16 @@
%-----------------------------------------------------------------------------%
- % add a warning message to the list of messages
-
+ % Add a warning message to the list of messages.
+ %
:- pred add_warning(string::in, term::in, message_list::in, message_list::out)
is det.
add_warning(Warning, Term, Msgs, [Msg - Term | Msgs]) :-
string__append("Warning: ", Warning, Msg).
- % add an error message to the list of messages
-
+ % Add an error message to the list of messages.
+ %
:- pred add_error(string::in, term::in, message_list::in, message_list::out)
is det.
@@ -1569,11 +1488,12 @@
string__append("Error: ", Error, Msg).
%-----------------------------------------------------------------------------%
- % parse_type_decl_type(Term, Condition, Result) succeeds
- % if Term is a "type" type declaration, and binds Condition
- % to the condition for that declaration (if any), and Result to
- % a representation of the declaration.
+ % parse_type_decl_type(Term, Condition, Result) succeeds if Term is
+ % a "type" type declaration, and binds Condition to the condition for
+ % that declaration (if any), and Result to a representation of the
+ % declaration.
+ %
:- pred parse_type_decl_type(module_name::in, string::in, list(term)::in,
decl_attrs::in, condition::out, maybe1(processed_type_body)::out)
is semidet.
@@ -1584,8 +1504,7 @@
get_is_solver_type(IsSolverType, Attributes0, Attributes),
(
IsSolverType = solver_type,
- Result = error("a solver type cannot have data constructors",
- H)
+ Result = error("a solver type cannot have data constructors", H)
;
IsSolverType = non_solver_type,
du_type_rhs_ctors_and_where_terms(Body, CtorsTerm,
@@ -1596,26 +1515,21 @@
Result = error(String, Term)
;
CtorsResult = ok(Ctors),
- WhereResult = parse_type_decl_where_term(
- non_solver_type, ModuleName, MaybeWhereTerm),
+ WhereResult = parse_type_decl_where_term(non_solver_type,
+ ModuleName, MaybeWhereTerm),
(
WhereResult = error(String, Term),
Result = error(String, Term)
;
- % The code to process `where'
- % attributes will return an error
- % result if solver attributes are
- % given for a non-solver type.
- % Because this is a du type, if the
- % unification with WhereResult
- % succeeds then _NoSolverTypeDetails
- % is guaranteed to be `no'.
- WhereResult = ok(_NoSolverTypeDetails,
- MaybeUserEqComp),
- process_du_type(ModuleName, H, Body, Ctors,
- MaybeUserEqComp, Result0),
- check_no_attributes(Result0, Attributes,
- Result)
+ % The code to process `where' attributes will return an error
+ % result if solver attributes are given for a non-solver type.
+ % Because this is a du type, if the unification with
+ % WhereResult succeeds then _NoSolverTypeDetails is
+ % guaranteed to be `no'.
+ WhereResult = ok(_NoSolverTypeDetails, MaybeUserEqComp),
+ process_du_type(ModuleName, H, Body, Ctors, MaybeUserEqComp,
+ Result0),
+ check_no_attributes(Result0, Attributes, Result)
)
)
).
@@ -1625,8 +1539,7 @@
process_eqv_type(ModuleName, H, Body, R0),
check_no_attributes(R0, Attributes, R).
-parse_type_decl_type(ModuleName, "where", [H, B], Attributes0, Condition,
- R) :-
+parse_type_decl_type(ModuleName, "where", [H, B], Attributes0, Condition, R) :-
get_condition(B, Body, Condition),
get_is_solver_type(IsSolverType, Attributes0, Attributes),
(
@@ -1635,8 +1548,7 @@
"by a `where' block alone", H)
;
IsSolverType = solver_type,
- R0 = parse_type_decl_where_term(solver_type, ModuleName,
- yes(Body)),
+ R0 = parse_type_decl_where_term(solver_type, ModuleName, yes(Body)),
(
R0 = error(String, Term),
R = error(String, Term)
@@ -1653,8 +1565,8 @@
du_type_rhs_ctors_and_where_terms(Term, CtorsTerm, MaybeWhereTerm) :-
(
- Term = term__functor(term__atom("where"),
- [CtorsTerm0, WhereTerm], _Context)
+ Term = term__functor(term__atom("where"), [CtorsTerm0, WhereTerm],
+ _Context)
->
CtorsTerm = CtorsTerm0,
MaybeWhereTerm = yes(WhereTerm)
@@ -1668,6 +1580,7 @@
% parse_type_decl_pred(ModuleName, VarSet, Pred, Attributes, Result)
% succeeds if Pred is a predicate type declaration, and binds Result
% to a representation of the declaration.
+ %
:- pred parse_type_decl_pred(module_name::in, varset::in, term::in,
decl_attrs::in, maybe1(item)::out) is det.
@@ -1678,9 +1591,9 @@
get_with_type(Body3, Body4, WithTypeResult),
(
WithTypeResult = ok(WithType),
- process_type_decl_pred_or_func(predicate, ModuleName,
- WithType, WithInst, MaybeDeterminism, VarSet, Body4,
- Condition, Attributes, R)
+ process_type_decl_pred_or_func(predicate, ModuleName, WithType,
+ WithInst, MaybeDeterminism, VarSet, Body4, Condition, Attributes,
+ R)
;
WithTypeResult = error(Msg, ErrorTerm),
R = error(Msg, ErrorTerm)
@@ -1705,21 +1618,17 @@
"`with_type`", Body)
;
(
- % Function declarations with
- % `with_type` annotations have the
- % same form as predicate declarations.
+ % Function declarations with `with_type` annotations
+ % have the same form as predicate declarations.
PredOrFunc = function,
WithType = no
->
- process_func(ModuleName, VarSet, Body,
- Condition, MaybeDeterminism,
- Attributes, R)
+ process_func(ModuleName, VarSet, Body, Condition,
+ MaybeDeterminism, Attributes, R)
;
- process_pred_or_func(PredOrFunc,
- ModuleName, VarSet, Body,
- Condition, WithType, WithInst,
- MaybeDeterminism, Attributes,
- R)
+ process_pred_or_func(PredOrFunc, ModuleName, VarSet, Body,
+ Condition, WithType, WithInst, MaybeDeterminism,
+ Attributes, R)
)
)
;
@@ -1736,6 +1645,7 @@
% parse_type_decl_func(ModuleName, Varset, Func, Attributes, Result)
% succeeds if Func is a function type declaration, and binds Result to
% a representation of the declaration.
+ %
:- pred parse_type_decl_func(module_name::in, varset::in, term::in,
decl_attrs::in, maybe1(item)::out) is det.
@@ -1779,9 +1689,8 @@
Result = error("`with_inst` and " ++
"determinism both specified", Body)
;
- process_mode(ModuleName, VarSet, Body3,
- Condition, Attributes, WithInst,
- MaybeDeterminism, Result)
+ process_mode(ModuleName, VarSet, Body3, Condition, Attributes,
+ WithInst, MaybeDeterminism, Result)
)
;
WithInst0 = error(E, T),
@@ -1806,8 +1715,7 @@
MaybeSymNameSpecifier = ok(SymNameSpecifier),
(
SymNameSpecifier = name(_),
- Result = error("`initialise' " ++
- "declaration requires arity", Term)
+ Result = error("`initialise' declaration requires arity", Term)
;
SymNameSpecifier = name_arity(SymName, Arity),
(
@@ -1836,8 +1744,7 @@
MaybeSymNameSpecifier = ok(SymNameSpecifier),
(
SymNameSpecifier = name(_),
- Result = error("`finalise' " ++
- "declaration requires arity", Term)
+ Result = error("`finalise' declaration requires arity", Term)
;
SymNameSpecifier = name_arity(SymName, Arity),
(
@@ -1937,47 +1844,35 @@
error("prog_io.parse_mutable_decl: shouldn't be here!")
).
-
:- pred parse_mutable_name(term::in, maybe1(string)::out) is det.
parse_mutable_name(NameTerm, NameResult) :-
- (
- NameTerm = term__functor(atom(Name), [], _)
- ->
+ ( NameTerm = term__functor(atom(Name), [], _) ->
NameResult = ok(Name)
;
NameResult = error("invalid mutable name", NameTerm)
).
-
:- pred parse_mutable_type(term::in, maybe1(type)::out) is det.
parse_mutable_type(TypeTerm, TypeResult) :-
- (
- term__contains_var(TypeTerm, _)
- ->
+ ( term__contains_var(TypeTerm, _) ->
TypeResult = error("the type in a mutable declaration " ++
"cannot contain variables", TypeTerm)
;
parse_type(TypeTerm, TypeResult)
).
-
:- pred parse_mutable_inst(term::in, maybe1(inst)::out) is det.
parse_mutable_inst(InstTerm, InstResult) :-
- (
- term__contains_var(InstTerm, _)
- ->
+ ( term__contains_var(InstTerm, _) ->
InstResult = error("the inst in a mutable declaration " ++
"cannot contain variables", InstTerm)
- ;
- convert_inst(no_allow_constrained_inst_var, InstTerm, Inst)
- ->
+ ; convert_inst(no_allow_constrained_inst_var, InstTerm, Inst) ->
InstResult = ok(Inst)
;
- InstResult = error("invalid inst in mutable declaration",
- InstTerm)
+ InstResult = error("invalid inst in mutable declaration", InstTerm)
).
:- type collected_mutable_attribute
@@ -2000,23 +1895,20 @@
map_parser(parse_mutable_attr, MutAttrTerms, MaybeAttrList),
MaybeAttrList = ok(CollectedMutAttrs)
->
- %
- % We check for trailed/untrailed and
- % thread_safe/not_thread_safe conflicts here and deal
- % with conflicting foreign_name attributes in
+ % We check for trailed/untrailed and thread_safe/not_thread_safe
+ % conflicts here and deal with conflicting foreign_name attributes in
% make_hlds_passes.m.
%
(
- list.member(Conflict1 - Conflict2,
- ConflictingAttributes),
+ list.member(Conflict1 - Conflict2, ConflictingAttributes),
list.member(Conflict1, CollectedMutAttrs),
list.member(Conflict2, CollectedMutAttrs)
->
MutAttrsResult = error("conflicting attributes " ++
"in attribute list", MutAttrsTerm)
;
- list.foldl(process_mutable_attribute,
- CollectedMutAttrs, Attributes0, Attributes),
+ list.foldl(process_mutable_attribute, CollectedMutAttrs,
+ Attributes0, Attributes),
MutAttrsResult = ok(Attributes)
)
;
@@ -2119,30 +2011,23 @@
MaybeWhereDetails :-
some [!MaybeTerm] (
!:MaybeTerm = MaybeTerm0,
- parse_where_attribute(
- parse_where_type_is_abstract_noncanonical,
+ parse_where_attribute(parse_where_type_is_abstract_noncanonical,
TypeIsAbstractNoncanonicalResult, !MaybeTerm),
- parse_where_attribute(
- parse_where_is("representation",
+ parse_where_attribute(parse_where_is("representation",
parse_where_type_is(ModuleName)),
RepresentationIsResult, !MaybeTerm),
- parse_where_attribute(
- parse_where_initialisation_is(ModuleName),
+ parse_where_attribute(parse_where_initialisation_is(ModuleName),
InitialisationIsResult, !MaybeTerm),
- parse_where_attribute(
- parse_where_is("ground",
+ parse_where_attribute(parse_where_is("ground",
parse_where_inst_is(ModuleName)),
GroundIsResult, !MaybeTerm),
- parse_where_attribute(
- parse_where_is("any",
+ parse_where_attribute(parse_where_is("any",
parse_where_inst_is(ModuleName)),
AnyIsResult, !MaybeTerm),
- parse_where_attribute(
- parse_where_is("equality",
+ parse_where_attribute(parse_where_is("equality",
parse_where_pred_is(ModuleName)),
EqualityIsResult, !MaybeTerm),
- parse_where_attribute(
- parse_where_is("comparison",
+ parse_where_attribute(parse_where_is("comparison",
parse_where_pred_is(ModuleName)),
ComparisonIsResult, !MaybeTerm),
parse_where_end(!.MaybeTerm, WhereEndResult)
@@ -2203,12 +2088,8 @@
maybe1(maybe(T)).
parse_where_is(Name, Parser, Term) = Result :-
- (
- Term = term__functor(term__atom("is"), [LHS, RHS], _Context1)
- ->
- (
- LHS = term__functor(term__atom(Name), [], _Context2)
- ->
+ ( Term = term__functor(term__atom("is"), [LHS, RHS], _Context1) ->
+ ( LHS = term__functor(term__atom(Name), [], _Context2) ->
RHSResult = Parser(RHS),
(
RHSResult = ok(ParsedRHS),
@@ -2228,8 +2109,8 @@
parse_where_type_is_abstract_noncanonical(Term) =
(
- Term = term__functor(term__atom(
- "type_is_abstract_noncanonical"), [], _Context)
+ Term = term__functor(term__atom("type_is_abstract_noncanonical"), [],
+ _Context)
->
ok(yes(unit))
;
@@ -2240,8 +2121,8 @@
maybe1(maybe(sym_name)).
parse_where_initialisation_is(ModuleName, Term) = Result :-
- Result0 = parse_where_is("initialisation",
- parse_where_pred_is(ModuleName), Term),
+ Result0 = parse_where_is("initialisation", parse_where_pred_is(ModuleName),
+ Term),
(
Result0 = ok(no)
->
@@ -2260,8 +2141,7 @@
parse_where_inst_is(_ModuleName, Term) =
(
- prog_io_util__convert_inst(no_allow_constrained_inst_var,
- Term, Inst),
+ prog_io_util__convert_inst(no_allow_constrained_inst_var, Term, Inst),
not prog_mode__inst_contains_unconstrained_var(Inst)
->
ok(Inst)
@@ -2339,9 +2219,8 @@
;
TypeIsAbstractNoncanonicalResult = ok(yes(_))
->
- % rafe: XXX I think this is wrong. There isn't
- % a problem with having the solver_type_details
- % and type_is_abstract_noncanonical.
+ % rafe: XXX I think this is wrong. There isn't a problem with having
+ % the solver_type_details and type_is_abstract_noncanonical.
(
RepresentationIsResult = ok(no),
InitialisationIsResult = ok(no),
@@ -2350,12 +2229,10 @@
EqualityIsResult = ok(no),
ComparisonIsResult = ok(no)
->
- Result = ok(no,
- yes(abstract_noncanonical_type(IsSolverType)))
+ Result = ok(no, yes(abstract_noncanonical_type(IsSolverType)))
;
Result = error("`where type_is_abstract_noncanonical' "
- ++ " excludes other `where ...' attributes",
- WhereTerm)
+ ++ " excludes other `where ...' attributes", WhereTerm)
)
;
IsSolverType = solver_type
@@ -2403,7 +2280,7 @@
Result = error("solver type definitions must have an" ++
"`initialisation' attribute", WhereTerm)
;
- error("prog_io__make_maybe_where_details: " ++
+ error("make_maybe_where_details: " ++
"shouldn't have reached this point! (1)")
)
;
@@ -2423,7 +2300,7 @@
->
Result = ok(no, yes(unify_compare(MaybeEqPred, MaybeCmpPred)))
;
- error("prog_io__make_maybe_where_details: " ++
+ error("make_maybe_where_details: " ++
"shouldn't have reached this point! (2)")
).
@@ -2431,7 +2308,7 @@
% to a representation of the determinism condition of Term0, if any,
% and binds Term to the other part of Term0. If Term0 does not
% contain a determinism, then Determinism is bound to `unspecified'.
-
+ %
:- pred get_determinism(term::in, term::out, maybe1(maybe(determinism))::out)
is det.
@@ -2442,8 +2319,8 @@
->
Body = Body1,
(
- Determinism1 = term__functor(term__atom(Determinism2),
- [], _Context2),
+ Determinism1 = term__functor(term__atom(Determinism2), [],
+ _Context2),
standard_det(Determinism2, Determinism3)
->
Determinism = ok(yes(Determinism3))
@@ -2457,18 +2334,17 @@
% Process the `with_inst` part of a declaration of the form:
% :- mode p(int) `with_inst` (pred(in, out) is det).
+ %
:- pred get_with_inst(term::in, term::out, maybe1(maybe(inst))::out) is det.
get_with_inst(Body0, Body, WithInst) :-
(
- Body0 = term__functor(term__atom("with_inst"),
- [Body1, Inst1], _)
+ Body0 = term__functor(term__atom("with_inst"), [Body1, Inst1], _)
->
( convert_inst(allow_constrained_inst_var, Inst1, Inst) ->
WithInst = ok(yes(Inst))
;
- WithInst = error("invalid inst in `with_inst`",
- Body0)
+ WithInst = error("invalid inst in `with_inst`", Body0)
),
Body = Body1
;
@@ -2507,34 +2383,32 @@
% to a representation of the 'where' condition of Term0, if any,
% and binds Term to the other part of Term0. If Term0 does not
% contain a condition, then Condition is bound to true.
-
+ %
:- pred get_condition(term::in, term::out, condition::out) is det.
get_condition(Body, Body, true).
-/********
-% NU-Prolog supported type declarations of the form
-% :- pred p(T) where p(X) : sorted(X).
-% or
-% :- type sorted_list(T) = list(T) where X : sorted(X).
-% :- pred p(sorted_list(T).
-% There is some code here to support that sort of thing, but
-% probably we would now need to use a different syntax, since
-% Mercury now uses `where' for different purposes (e.g. specifying
-% user-defined equality predicates, and also for type classes ...)
+% % NU-Prolog supported type declarations of the form
+% % :- pred p(T) where p(X) : sorted(X).
+% % or
+% % :- type sorted_list(T) = list(T) where X : sorted(X).
+% % :- pred p(sorted_list(T).
+% % There is some code here to support that sort of thing, but
+% % probably we would now need to use a different syntax, since
+% % Mercury now uses `where' for different purposes (e.g. specifying
+% % user-defined equality predicates, and also for type classes ...)
%
-get_condition(B, Body, Condition) :-
- (
- B = term__functor(term__atom("where"), [Body1, Condition1],
- _Context)
- ->
- Body = Body1,
- Condition = where(Condition1)
- ;
- Body = B,
- Condition = true
- ).
-********/
+% get_condition(B, Body, Condition) :-
+% (
+% B = term__functor(term__atom("where"), [Body1, Condition1],
+% _Context)
+% ->
+% Body = Body1,
+% Condition = where(Condition1)
+% ;
+% Body = B,
+% Condition = true
+% ).
%-----------------------------------------------------------------------------%
@@ -2563,8 +2437,7 @@
;
Result0 = ok(Name, Params),
(
- RepnType = SolverTypeDetails ^
- representation_type,
+ RepnType = SolverTypeDetails ^ representation_type,
type_contains_var(RepnType, Var),
not list__member(Var, Params)
->
@@ -2572,8 +2445,7 @@
"representation type", Head)
;
Result = ok(processed_type_body(Name, Params,
- solver_type(SolverTypeDetails,
- MaybeUserEqComp)))
+ solver_type(SolverTypeDetails, MaybeUserEqComp)))
)
)
;
@@ -2584,6 +2456,7 @@
%-----------------------------------------------------------------------------%
% This is for "Head == Body" (equivalence) definitions.
+ %
:- pred process_eqv_type(module_name::in, term::in, term::in,
maybe1(processed_type_body)::out) is det.
@@ -2598,20 +2471,16 @@
process_eqv_type_2(ok(Name, Params), Body0, Result) :-
% Check that all the variables in the body occur in the head.
(
- (
term__contains_var(Body0, Var),
term__coerce_var(Var, TVar),
\+ list__member(TVar, Params)
- )
->
- Result = error("free type parameter in RHS of " ++
- "type definition", Body0)
+ Result = error("free type parameter in RHS of type definition", Body0)
;
parse_type(Body0, BodyResult),
(
BodyResult = ok(Body),
- Result = ok(processed_type_body(Name, Params,
- eqv_type(Body)))
+ Result = ok(processed_type_body(Name, Params, eqv_type(Body)))
;
BodyResult = error(Msg, ErrorTerm),
Result = error(Msg, ErrorTerm)
@@ -2621,12 +2490,13 @@
%-----------------------------------------------------------------------------%
% process_du_type(ModuleName, TypeHead, TypeBody,
- % MaybeUserEqComp, Result)
- % checks that its arguments are well formed, and if they are,
+ % MaybeUserEqComp, Result):
+ %
+ % Checks that its arguments are well formed, and if they are,
% binds Result to a representation of the type information about the
% TypeHead.
% This is for "Head ---> Body [where ...]" (constructor) definitions.
-
+ %
:- pred process_du_type(module_name::in, term::in, term::in,
list(constructor)::in, maybe(unify_compare)::in,
maybe1(processed_type_body)::out) is det.
@@ -2638,8 +2508,8 @@
Result = error(String, Term)
;
Result0 = ok(Functor, Params),
- process_du_type_2(Functor, Params, Body, Ctors,
- MaybeUserEqComp, Result)
+ process_du_type_2(Functor, Params, Body, Ctors, MaybeUserEqComp,
+ Result)
).
:- pred process_du_type_2(sym_name::in, list(type_param)::in, term::in,
@@ -2647,10 +2517,10 @@
maybe1(processed_type_body)::out) is det.
process_du_type_2(Functor, Params, Body, Ctors, MaybeUserEqComp, Result) :-
-
+ (
% Check that all type variables in the body are either explicitly
% existentially quantified or occur in the head.
- (
+
list__member(Ctor, Ctors),
Ctor = ctor(ExistQVars, _Constraints, _CtorName, CtorArgs),
assoc_list__values(CtorArgs, CtorArgTypes),
@@ -2658,26 +2528,23 @@
\+ list__member(Var, ExistQVars),
\+ list__member(Var, Params)
->
- Result = error("free type parameter in RHS of " ++
- "type definition", Body)
-
- % Check that all type variables in existential quantifiers do not
- % occur in the head (maybe this should just be a warning, not an
- % error? If we were to allow it, we would need to rename them
- % apart.)
+ Result = error("free type parameter in RHS of type definition", Body)
;
+ % Check that all type variables in existential quantifiers do not
+ % occur in the head (maybe this should just be a warning, not an error?
+ % If we were to allow it, we would need to rename them apart.)
+
list__member(Ctor, Ctors),
Ctor = ctor(ExistQVars, _Constraints, _CtorName, _CtorArgs),
list__member(Var, ExistQVars),
list__member(Var, Params)
->
- Result = error("type variable has overlapping " ++
- "scopes (explicit type quantifier " ++
- "shadows argument type)", Body)
-
+ Result = error("type variable has overlapping scopes " ++
+ "(explicit type quantifier shadows argument type)", Body)
+ ;
% Check that all type variables in existential quantifiers occur
% somewhere in the constructor argument types or constraints.
- ;
+
list__member(Ctor, Ctors),
Ctor = ctor(ExistQVars, Constraints, _CtorName, CtorArgs),
list__member(Var, ExistQVars),
@@ -2686,13 +2553,12 @@
constraint_list_get_tvars(Constraints, ConstraintTVars),
\+ list__member(Var, ConstraintTVars)
->
- Result = error("type variable in existential " ++
- "quantifier does not occur in " ++
- "arguments or constraints of constructor", Body)
-
+ Result = error("type variable in existential quantifier " ++
+ "does not occur in arguments or constraints of constructor", Body)
+ ;
% Check that all type variables in existential constraints occur in
% the existential quantifiers.
- ;
+
list__member(Ctor, Ctors),
Ctor = ctor(ExistQVars, Constraints, _CtorName, _CtorArgs),
list__member(Constraint, Constraints),
@@ -2700,10 +2566,8 @@
type_list_contains_var(ConstraintArgs, Var),
\+ list__member(Var, ExistQVars)
->
- Result = error("type variables in class " ++
- "constraints introduced " ++
- "with `=>' must be explicitly " ++
- "existentially quantified " ++
+ Result = error("type variables in class constraints introduced " ++
+ "with `=>' must be explicitly existentially quantified " ++
"using `some'", Body)
;
Result = ok(processed_type_body(Functor, Params,
@@ -2712,11 +2576,11 @@
%-----------------------------------------------------------------------------%
- % process_abstract_type(ModuleName, TypeHead, Result)
- % checks that its argument is well formed, and if it is,
- % binds Result to a representation of the type information about the
- % TypeHead.
-
+ % process_abstract_type(ModuleName, TypeHead, Result):
+ %
+ % Checks that its argument is well formed, and if it is, binds Result
+ % to a representation of the type information about the TypeHead.
+ %
:- pred process_abstract_type(module_name::in, term::in, decl_attrs::in,
maybe1(processed_type_body)::out) is det.
@@ -2739,10 +2603,8 @@
parse_type_defn_head(ModuleName, Head, Body, Result) :-
( Head = term__variable(_) ->
- %
% `Head' has no term__context, so we need to get the
% context from `Body'
- %
( Body = term__functor(_, _, Context) ->
dummy_term_with_context(Context, ErrorTerm)
;
@@ -2750,8 +2612,8 @@
),
Result = error("variable on LHS of type definition", ErrorTerm)
;
- parse_implicitly_qualified_term(ModuleName,
- Head, Head, "type definition", R),
+ parse_implicitly_qualified_term(ModuleName, Head, Head,
+ "type definition", R),
parse_type_defn_head_2(R, Head, Result)
).
@@ -2767,16 +2629,11 @@
parse_type_defn_head_3(Name, Args, Head, Result) :-
% Check that all the head args are variables.
- (
- var_list_to_term_list(Params0, Args)
- ->
+ ( var_list_to_term_list(Params0, Args) ->
% Check that all the head arg variables are distinct.
- ( some [Param, OtherParams]
(
- list__member(_, Params0,
- [Param | OtherParams]),
+ list__member(_, Params0, [Param | OtherParams]),
list__member(Param, OtherParams)
- )
->
Result = error("repeated type parameters "
++ "in LHS of type defn", Head)
@@ -2790,10 +2647,10 @@
%-----------------------------------------------------------------------------%
- % Convert a list of terms separated by semi-colons
- % (known as a "disjunction", even thought the terms aren't goals
- % in this case) into a list of constructors.
-
+ % Convert a list of terms separated by semi-colons (known as a
+ % "disjunction", even thought the terms aren't goals in this case)
+ % into a list of constructors.
+ %
:- func convert_constructors(module_name, term) = maybe1(list(constructor)).
convert_constructors(ModuleName, Body) = Result :-
@@ -2807,8 +2664,8 @@
Result = error(String, Term)
).
- % true if input argument is a valid list of constructors
-
+ % True if input argument is a valid list of constructors.
+ %
:- func convert_constructors_2(module_name, list(term)) =
maybe1(list(constructor)).
@@ -2834,13 +2691,8 @@
:- func convert_constructor(module_name, term) = maybe1(constructor).
convert_constructor(ModuleName, Term0) = Result :-
- (
- Term0 = term__functor(term__atom("some"), [Vars, Term1],
- _Context)
- ->
- (
- parse_list_of_vars(Vars, ExistQVars0)
- ->
+ ( Term0 = term__functor(term__atom("some"), [Vars, Term1], _Context) ->
+ ( parse_list_of_vars(Vars, ExistQVars0) ->
list__map(term__coerce_var, ExistQVars0, ExistQVars),
Result = convert_constructor_2(ModuleName, ExistQVars,
Term0, Term1)
@@ -2849,44 +2701,40 @@
)
;
ExistQVars = [],
- Result = convert_constructor_2(ModuleName, ExistQVars,
- Term0, Term0)
+ Result = convert_constructor_2(ModuleName, ExistQVars, Term0, Term0)
).
:- func convert_constructor_2(module_name, list(tvar), term, term) =
maybe1(constructor).
convert_constructor_2(ModuleName, ExistQVars, Term0, Term1) = Result :-
- get_existential_constraints_from_term(ModuleName, Term1, Term2,
- Result0),
+ get_existential_constraints_from_term(ModuleName, Term1, Term2, Result0),
(
Result0 = error(String, Term),
Result = error(String, Term)
;
Result0 = ok(Constraints),
(
- % Note that as a special case, one level of
- % curly braces around the constructor are ignored.
- % This is to allow you to define ';'/2 and 'some'/2
- % constructors.
- Term2 = term__functor(term__atom("{}"), [Term3],
- _Context)
+ % Note that as a special case, one level of curly braces around
+ % the constructor are ignored. This is to allow you to define
+ % ';'/2 and 'some'/2 constructors.
+ Term2 = term__functor(term__atom("{}"), [Term3], _Context)
->
Term4 = Term3
;
Term4 = Term2
),
- Result = convert_constructor_3(ModuleName, ExistQVars,
- Constraints, Term0, Term4)
+ Result = convert_constructor_3(ModuleName, ExistQVars, Constraints,
+ Term0, Term4)
).
-:- func convert_constructor_3(module_name, list(tvar),
- list(prog_constraint), term, term) = maybe1(constructor).
+:- func convert_constructor_3(module_name, list(tvar), list(prog_constraint),
+ term, term) = maybe1(constructor).
convert_constructor_3(ModuleName, ExistQVars, Constraints, Term0, Term1) =
Result :-
- parse_implicitly_qualified_term(ModuleName,
- Term1, Term0, "constructor definition", Result0),
+ parse_implicitly_qualified_term(ModuleName, Term1, Term0,
+ "constructor definition", Result0),
(
Result0 = error(String, Term),
Result = error(String, Term)
@@ -2906,7 +2754,7 @@
% parse a `:- pred p(...)' declaration or a
% `:- func f(...) `with_type` t' declaration
-
+ %
:- pred process_pred_or_func(pred_or_func::in, module_name::in, varset::in,
term::in, condition::in, maybe(type)::in, maybe(inst)::in,
maybe(determinism)::in, decl_attrs::in, maybe1(item)::out) is det.
@@ -2917,8 +2765,7 @@
Attributes, MaybeContext),
(
MaybeContext = ok(ExistQVars, Constraints, InstConstraints),
- parse_implicitly_qualified_term(ModuleName,
- PredType, PredType,
+ parse_implicitly_qualified_term(ModuleName, PredType, PredType,
pred_or_func_decl_string(PredOrFunc), R),
process_pred_or_func_2(PredOrFunc, R, PredType, VarSet,
WithType, WithInst, MaybeDet, Cond, ExistQVars,
@@ -2956,18 +2803,15 @@
->
Result = error("inconsistent constraints " ++
"on inst variables in " ++
- pred_or_func_decl_string(PredOrFunc),
- PredType)
+ pred_or_func_decl_string(PredOrFunc), PredType)
;
get_purity(Purity, Attributes0, Attributes),
varset__coerce(VarSet0, TVarSet),
varset__coerce(VarSet0, IVarSet),
- Result0 = ok(pred_or_func(TVarSet, IVarSet,
- ExistQVars, PredOrFunc, F, As,
- WithType, WithInst, MaybeDet, Cond,
+ Result0 = ok(pred_or_func(TVarSet, IVarSet, ExistQVars,
+ PredOrFunc, F, As, WithType, WithInst, MaybeDet, Cond,
Purity, ClassContext)),
- check_no_attributes(Result0, Attributes,
- Result)
+ check_no_attributes(Result0, Attributes, Result)
)
;
Result = error("some but not all arguments " ++
@@ -2975,8 +2819,7 @@
)
;
Result = error("syntax error in " ++
- pred_or_func_decl_string(PredOrFunc),
- PredType)
+ pred_or_func_decl_string(PredOrFunc), PredType)
).
process_pred_or_func_2(_, error(M, T),
_, _, _, _, _, _, _, _, _, _, error(M, T)).
@@ -3002,6 +2845,7 @@
% get_class_context_and_inst_constraints(ModuleName, Attributes0,
% Attributes, MaybeContext, MaybeInstConstraints):
+ %
% Parse type quantifiers, type class constraints and inst constraints
% from the declaration attributes in Attributes0.
% MaybeContext is either bound to the correctly parsed context, or
@@ -3010,19 +2854,18 @@
% constraints or an appropriate error message (if there was a syntax
% error).
% Attributes is bound to the remaining attributes.
-
+ %
:- pred get_class_context_and_inst_constraints(module_name::in,
decl_attrs::in, decl_attrs::out,
maybe3(existq_tvars, prog_constraints, inst_var_sub)::out) is det.
get_class_context_and_inst_constraints(ModuleName, RevAttributes0,
RevAttributes, MaybeContext) :-
- %
- % constraints and quantifiers should occur in the following
- % order (outermost to innermost):
+ % Constraints and quantifiers should occur in the following order
+ % (outermost to innermost):
%
% operator precedence
- % ------- ----------
+ % -------- ----------
% 1. universal quantifiers all 950
% 2. existential quantifiers some 950
% 3. universal constraints <= 920
@@ -3033,10 +2876,9 @@
% in the opposite order -- innermost to outermost -- so we reverse
% them before we start.
%
- % [*] Note that the semantic meaning of `=>' is not quite
- % the same as implication; logically speaking it's more
- % like conjunction. Oh well, at least it has the right
- % precedence.
+ % [*] Note that the semantic meaning of `=>' is not quite the same
+ % as implication; logically speaking it's more like conjunction.
+ % Oh well, at least it has the right precedence.
%
% In theory it could make sense to allow the order of 2 & 3 to be
% swapped, or (in the case of multiple constraints & multiple
@@ -3082,8 +2924,7 @@
get_quant_vars(QuantType, ModuleName, !Attributes, !Vars) :-
(
- !.Attributes = [quantifier(QuantType, QuantVars) - _
- | !:Attributes]
+ !.Attributes = [quantifier(QuantType, QuantVars) - _ | !:Attributes]
->
list__append(!.Vars, QuantVars, !:Vars),
get_quant_vars(QuantType, ModuleName, !Attributes, !Vars)
@@ -3139,7 +2980,7 @@
% Verify that among the arguments of a :- pred declaration,
% either all arguments specify a mode or none of them do.
-
+ %
:- pred verify_type_and_mode_list(list(type_and_mode)::in) is semidet.
verify_type_and_mode_list([]).
@@ -3162,8 +3003,8 @@
%-----------------------------------------------------------------------------%
- % parse a `:- func p(...)' declaration
-
+ % Parse a `:- func p(...)' declaration.
+ %
:- pred process_func(module_name::in, varset::in, term::in, condition::in,
maybe(determinism)::in, decl_attrs::in, maybe1(item)::out) is det.
@@ -3172,9 +3013,8 @@
Attributes, MaybeContext),
(
MaybeContext = ok(ExistQVars, Constraints, InstConstraints),
- process_func_2(ModuleName, VarSet, Term,
- Cond, MaybeDet, ExistQVars, Constraints,
- InstConstraints, Attributes, Result)
+ process_func_2(ModuleName, VarSet, Term, Cond, MaybeDet, ExistQVars,
+ Constraints, InstConstraints, Attributes, Result)
;
MaybeContext = error(String, ErrorTerm),
Result = error(String, ErrorTerm)
@@ -3184,9 +3024,8 @@
maybe(determinism)::in, existq_tvars::in, prog_constraints::in,
inst_var_sub::in, decl_attrs::in, maybe1(item)::out) is det.
-process_func_2(ModuleName, VarSet, Term, Cond, MaybeDet,
- ExistQVars, Constraints, InstConstraints, Attributes,
- Result) :-
+process_func_2(ModuleName, VarSet, Term, Cond, MaybeDet, ExistQVars,
+ Constraints, InstConstraints, Attributes, Result) :-
(
Term = term__functor(term__atom("="),
[FuncTerm0, ReturnTypeTerm], _Context),
@@ -3194,9 +3033,8 @@
->
parse_implicitly_qualified_term(ModuleName, FuncTerm, Term,
"`:- func' declaration", R),
- process_func_3(R, FuncTerm, ReturnTypeTerm, Term, VarSet,
- MaybeDet, Cond, ExistQVars, Constraints,
- InstConstraints, Attributes, Result)
+ process_func_3(R, FuncTerm, ReturnTypeTerm, Term, VarSet, MaybeDet,
+ Cond, ExistQVars, Constraints, InstConstraints, Attributes, Result)
;
Result = error("`=' expected in `:- func' declaration", Term)
).
@@ -3213,19 +3051,16 @@
(
\+ verify_type_and_mode_list(As)
->
- Result = error("some but not all arguments have modes",
- FuncTerm)
+ Result = error("some but not all arguments have modes", FuncTerm)
;
- convert_type_and_mode(InstConstraints, ReturnTypeTerm,
- ReturnType)
+ convert_type_and_mode(InstConstraints, ReturnTypeTerm, ReturnType)
->
(
As = [type_and_mode(_, _) | _],
ReturnType = type_only(_)
->
- Result = error("function arguments have " ++
- "modes, but function result doesn't",
- FuncTerm)
+ Result = error("function arguments have modes, " ++
+ "but function result doesn't", FuncTerm)
;
As = [type_only(_) | _],
ReturnType = type_and_mode(_, _)
@@ -3241,18 +3076,13 @@
(
inst_var_constraints_are_consistent_in_type_and_modes(Args)
->
- Result0 = ok(pred_or_func(TVarSet,
- IVarSet, ExistQVars,
- function, F, Args, no, no,
- MaybeDet, Cond, Purity,
+ Result0 = ok(pred_or_func(TVarSet, IVarSet, ExistQVars,
+ function, F, Args, no, no, MaybeDet, Cond, Purity,
ClassContext)),
- check_no_attributes(Result0,
- Attributes, Result)
+ check_no_attributes(Result0, Attributes, Result)
;
- Result = error("inconsistent " ++
- "constraints on inst " ++
- "variables in function " ++
- "declaration", FullTerm)
+ Result = error("inconsistent constraints on inst " ++
+ "variables in function declaration", FullTerm)
)
)
;
@@ -3267,8 +3097,7 @@
%-----------------------------------------------------------------------------%
- % Perform one of the following field-access syntax rewrites if
- % possible:
+ % Perform one of the following field-access syntax rewrites if possible:
%
% A ^ f(B, ...) ---> f(B, ..., A)
% (A ^ f(B, ...) := X) ---> 'f :='(B, ..., A, X)
@@ -3293,7 +3122,7 @@
%-----------------------------------------------------------------------------%
- % parse a `:- mode p(...)' declaration
+ % Parse a `:- mode p(...)' declaration.
%
:- pred process_mode(module_name::in, varset::in, term::in, condition::in,
decl_attrs::in, maybe(inst)::in, maybe(determinism)::in,
@@ -3303,8 +3132,8 @@
Result) :-
(
WithInst = no,
- Term = term__functor(term__atom("="),
- [FuncTerm0, ReturnTypeTerm], _Context),
+ Term = term__functor(term__atom("="), [FuncTerm0, ReturnTypeTerm],
+ _Context),
FuncTerm = desugar_field_access(FuncTerm0)
->
parse_implicitly_qualified_term(ModuleName, FuncTerm, Term,
@@ -3340,14 +3169,12 @@
PredOrFunc = yes(predicate)
;
WithInst = yes(_),
- % We don't know whether it's a
- % predicate or a function until we
- % expand out the inst.
+ % We don't know whether it's a predicate or a function
+ % until we expand out the inst.
PredOrFunc = no
),
- Result0 = ok(pred_or_func_mode(VarSet,
- PredOrFunc, F, As, WithInst, MaybeDet,
- Cond))
+ Result0 = ok(pred_or_func_mode(VarSet, PredOrFunc, F, As,
+ WithInst, MaybeDet, Cond))
;
Result0 = error("inconsistent constraints " ++
"on inst variables in predicate " ++
@@ -3376,20 +3203,17 @@
Attributes, MaybeConstraints),
(
MaybeConstraints = ok(_, _, InstConstraints),
- list__map(constrain_inst_vars_in_mode(InstConstraints),
- As1, As),
+ list__map(constrain_inst_vars_in_mode(InstConstraints), As1, As),
(
- convert_mode(allow_constrained_inst_var,
- RetMode0, RetMode1)
+ convert_mode(allow_constrained_inst_var, RetMode0, RetMode1)
->
constrain_inst_vars_in_mode(InstConstraints,
RetMode1, RetMode),
varset__coerce(VarSet0, VarSet),
list__append(As, [RetMode], ArgModes),
( inst_var_constraints_are_consistent_in_modes(ArgModes) ->
- Result0 = ok(pred_or_func_mode(VarSet,
- yes(function), F, ArgModes,
- no, MaybeDet, Cond))
+ Result0 = ok(pred_or_func_mode(VarSet, yes(function), F,
+ ArgModes, no, MaybeDet, Cond))
;
Result0 = error("inconsistent " ++
"constraints on inst " ++
@@ -3397,9 +3221,8 @@
"mode declaration", FullTerm)
)
;
- Result0 = error("syntax error in return " ++
- "mode of function mode declaration",
- RetMode0)
+ Result0 = error("syntax error in return mode " ++
+ "of function mode declaration", RetMode0)
)
;
MaybeConstraints = error(String, Term),
@@ -3432,8 +3255,7 @@
constrain_inst_vars_in_inst(_, free(T), free(T)).
constrain_inst_vars_in_inst(InstConstraints, bound(U, BIs0), bound(U, BIs)) :-
list__map((pred(functor(C, Is0)::in, functor(C, Is)::out) is det :-
- list__map(constrain_inst_vars_in_inst(InstConstraints),
- Is0, Is)),
+ list__map(constrain_inst_vars_in_inst(InstConstraints), Is0, Is)),
BIs0, BIs).
constrain_inst_vars_in_inst(_, ground(U, none), ground(U, none)).
constrain_inst_vars_in_inst(InstConstraints,
@@ -3480,8 +3302,7 @@
constrain_inst_vars_in_inst_name(InstConstraints, Name0, Name) :-
( Name0 = user_inst(SymName, Args0) ->
- list__map(constrain_inst_vars_in_inst(InstConstraints),
- Args0, Args),
+ list__map(constrain_inst_vars_in_inst(InstConstraints), Args0, Args),
Name = user_inst(SymName, Args)
;
Name = Name0
@@ -3581,8 +3402,8 @@
convert_inst_defn(ModuleName, H, Body, R),
process_maybe1(make_inst_defn(VarSet, Condition), R, Result)
;
- % XXX this is for `abstract inst' declarations,
- % which are not really supported
+ % XXX This is for `abstract inst' declarations,
+ % which are not really supported.
InstDefn = term__functor(term__atom("is"),
[Head, term__functor(term__atom("private"), [], _)], _)
->
@@ -3595,14 +3416,12 @@
get_condition(B, Body, Condition),
Body1 = term__functor(term__atom("bound"), [Body], Context),
convert_inst_defn(ModuleName, H, Body1, R),
+ % We should check the condition for errs (don't bother at the moment,
+ % since we ignore conditions anyhow :-)
process_maybe1(make_inst_defn(VarSet, Condition), R, Result)
;
- Result = error("`==' expected in `:- inst' definition",
- InstDefn)
+ Result = error("`==' expected in `:- inst' definition", InstDefn)
).
- % we should check the condition for errs
- % (don't bother at the moment, since we ignore
- % conditions anyhow :-)
% Parse a `:- inst <Head> ---> <Body>.' definition.
%
@@ -3610,8 +3429,8 @@
maybe1(processed_inst_body)::out) is det.
convert_inst_defn(ModuleName, Head, Body, Result) :-
- parse_implicitly_qualified_term(ModuleName,
- Head, Body, "inst definition", R),
+ parse_implicitly_qualified_term(ModuleName, Head, Body,
+ "inst definition", R),
convert_inst_defn_2(R, Head, Body, Result).
:- pred convert_inst_defn_2(maybe_functor::in, term::in, term::in,
@@ -3620,50 +3439,43 @@
convert_inst_defn_2(error(M, T), _, _, error(M, T)).
convert_inst_defn_2(ok(Name, ArgTerms), Head, Body, Result) :-
(
- % check that all the head args are variables
+ % Check that all the head args are variables.
term__var_list_to_term_list(Args, ArgTerms)
->
(
- % check that all the head arg variables are distinct
+ % Check that all the head arg variables are distinct.
list__member(Arg2, Args, [Arg2|OtherArgs]),
list__member(Arg2, OtherArgs)
->
- Result = error(
- "repeated inst parameters in LHS of inst defn",
+ Result = error("repeated inst parameters in LHS of inst defn",
Head)
;
- % check that all the variables in the body occur
- % in the head
+ % Check that all the variables in the body occur in the head.
term__contains_var(Body, Var2),
\+ list__member(Var2, Args)
->
- Result = error(
- "free inst parameter in RHS of inst definition",
+ Result = error("free inst parameter in RHS of inst definition",
Body)
;
- % check that the inst is a valid user-defined
- % inst, i.e. that it does not have the form of
- % one of the builtin insts
+ % Check that the inst is a valid user-defined inst, i.e. that it
+ % does not have the form of one of the builtin insts.
\+ (
- convert_inst(no_allow_constrained_inst_var,
- Head, UserInst),
+ convert_inst(no_allow_constrained_inst_var, Head, UserInst),
UserInst = defined_inst(user_inst(_, _))
)
->
Result = error("attempt to redefine builtin inst", Head)
;
- % should improve the error message here
+ % Should improve the error message here.
(
- convert_inst(no_allow_constrained_inst_var,
- Body, ConvertedBody)
+ convert_inst(no_allow_constrained_inst_var, Body,
+ ConvertedBody)
->
list__map(term__coerce_var, Args, InstArgs),
- Result = ok(
- processed_inst_body(Name, InstArgs,
+ Result = ok(processed_inst_body(Name, InstArgs,
eqv_inst(ConvertedBody)))
;
- Result = error("syntax error in inst body",
- Body)
+ Result = error("syntax error in inst body", Body)
)
)
;
@@ -3691,21 +3503,19 @@
convert_abstract_inst_defn_2(error(M, T), _, error(M, T)).
convert_abstract_inst_defn_2(ok(Name, ArgTerms), Head, Result) :-
(
- % check that all the head args are variables
+ % Check that all the head args are variables.
term__var_list_to_term_list(Args, ArgTerms)
->
(
- % check that all the head arg variables are distinct
+ % Check that all the head arg variables are distinct.
list__member(Arg2, Args, [Arg2|OtherArgs]),
list__member(Arg2, OtherArgs)
->
- Result = error(
- "repeated inst parameters in abstract inst definition",
- Head)
+ Result = error("repeated inst parameters " ++
+ "in abstract inst definition", Head)
;
list__map(term__coerce_var, Args, InstArgs),
- Result = ok(processed_inst_body(Name, InstArgs,
- abstract_inst))
+ Result = ok(processed_inst_body(Name, InstArgs, abstract_inst))
)
;
Result = error("inst parameters must be variables", Head)
@@ -3726,15 +3536,12 @@
maybe1(item)::out) is det.
parse_mode_decl(ModuleName, VarSet, ModeDefn, Attributes, Result) :-
- ( %%% some [H, B]
- mode_op(ModeDefn, H, B)
- ->
+ ( mode_op(ModeDefn, H, B) ->
get_condition(B, Body, Condition),
convert_mode_defn(ModuleName, H, Body, R),
process_maybe1(make_mode_defn(VarSet, Condition), R, Result)
;
- parse_mode_decl_pred(ModuleName, VarSet, ModeDefn, Attributes,
- Result)
+ parse_mode_decl_pred(ModuleName, VarSet, ModeDefn, Attributes, Result)
).
:- pred mode_op(term::in, term::out, term::out) is semidet.
@@ -3763,40 +3570,35 @@
convert_mode_defn_2(error(M, T), _, _, error(M, T)).
convert_mode_defn_2(ok(Name, ArgTerms), Head, Body, Result) :-
(
- % check that all the head args are variables
+ % Check that all the head args are variables.
term__var_list_to_term_list(Args, ArgTerms)
->
(
- % check that all the head arg variables are distinct
+ % Check that all the head arg variables are distinct.
list__member(Arg2, Args, [Arg2|OtherArgs]),
list__member(Arg2, OtherArgs)
->
- Result = error(
- "repeated parameters in LHS of mode defn",
+ Result = error("repeated parameters in LHS of mode defn",
Head)
- % check that all the variables in the body occur
- % in the head
;
+ % Check that all the variables in the body occur in the head.
term__contains_var(Body, Var2),
\+ list__member(Var2, Args)
->
- Result = error(
- "free inst parameter in RHS of mode definition",
+ Result = error("free inst parameter in RHS of mode definition",
Body)
;
- % should improve the error message here
+ % Should improve the error message here.
(
- convert_mode(no_allow_constrained_inst_var,
- Body, ConvertedBody)
+ convert_mode(no_allow_constrained_inst_var, Body,
+ ConvertedBody)
->
list__map(term__coerce_var, Args, InstArgs),
- Result = ok(processed_mode_body(Name,
- InstArgs, eqv_mode(ConvertedBody)))
+ Result = ok(processed_mode_body(Name, InstArgs,
+ eqv_mode(ConvertedBody)))
;
- % catch-all error message - we should do
- % better than this
- Result = error(
- "syntax error in mode definition body",
+ % Catch-all error message - we should do better than this.
+ Result = error("syntax error in mode definition body",
Body)
)
)
@@ -3816,10 +3618,7 @@
is semidet.
convert_type_and_mode(InstConstraints, Term, Result) :-
- (
- Term = term__functor(term__atom("::"), [TypeTerm, ModeTerm],
- _Context)
- ->
+ ( Term = term__functor(term__atom("::"), [TypeTerm, ModeTerm], _Context) ->
parse_type(TypeTerm, ok(Type)),
convert_mode(allow_constrained_inst_var, ModeTerm, Mode0),
constrain_inst_vars_in_mode(InstConstraints, Mode0, Mode),
@@ -3864,13 +3663,15 @@
%-----------------------------------------------------------------------------%
-:- pred process_maybe1(maker(T1, T2), maybe1(T1), maybe1(T2)).
-:- mode process_maybe1(maker, in, out) is det.
+:- pred process_maybe1(maker(T1, T2)::maker, maybe1(T1)::in, maybe1(T2)::out)
+ is det.
+
process_maybe1(Maker, ok(X), ok(Y)) :- call(Maker, X, Y).
process_maybe1(_, error(M, T), error(M, T)).
-:- pred process_maybe1_to_t(maker(T1, maybe1(T2)), maybe1(T1), maybe1(T2)).
-:- mode process_maybe1_to_t(maker, in, out) is det.
+:- pred process_maybe1_to_t(maker(T1, maybe1(T2))::maker,
+ maybe1(T1)::in, maybe1(T2)::out) is det.
+
process_maybe1_to_t(Maker, ok(X), Y) :- call(Maker, X, Y).
process_maybe1_to_t(_, error(M, T), error(M, T)).
@@ -3912,14 +3713,12 @@
% cons(ConstructorSpecifier)
% Matches only constructors.
% pred(PredSpecifier)
-% Matches only predicates, ie. constructors of type
-% `pred'.
+% Matches only predicates, ie. constructors of type `pred'.
% adt(SymbolNameSpecifier)
% Matches only type names.
% type(SymbolNameSpecifier)
% Matches type names matched by the SymbolNameSpecifier,
-% and also matches any constructors for the matched type
-% names.
+% and also matches any constructors for the matched type names.
% op(SymbolNameSpecifier)
% Matches only operators.
% module(ModuleSpecifier)
@@ -3931,45 +3730,37 @@
( MainTerm = term__functor(term__atom(Functor), [Term], _Context) ->
( Functor = "cons" ->
parse_constructor_specifier(Term, Result0),
- process_maybe1(make_cons_symbol_specifier, Result0,
- Result)
+ process_maybe1(make_cons_symbol_specifier, Result0, Result)
; Functor = "pred" ->
parse_predicate_specifier(Term, Result0),
- process_maybe1(make_pred_symbol_specifier, Result0,
- Result)
+ process_maybe1(make_pred_symbol_specifier, Result0, Result)
; Functor = "func" ->
parse_function_specifier(Term, Result0),
- process_maybe1(make_func_symbol_specifier, Result0,
- Result)
+ process_maybe1(make_func_symbol_specifier, Result0, Result)
; Functor = "type" ->
parse_type_specifier(Term, Result0),
- process_maybe1(make_type_symbol_specifier, Result0,
- Result)
+ process_maybe1(make_type_symbol_specifier, Result0, Result)
; Functor = "adt" ->
parse_adt_specifier(Term, Result0),
- process_maybe1(make_adt_symbol_specifier, Result0,
- Result)
+ process_maybe1(make_adt_symbol_specifier, Result0, Result)
; Functor = "op" ->
parse_op_specifier(Term, Result0),
- process_maybe1(make_op_symbol_specifier, Result0,
- Result)
+ process_maybe1(make_op_symbol_specifier, Result0, Result)
; Functor = "module" ->
parse_module_specifier(Term, Result0),
- process_maybe1(make_module_symbol_specifier, Result0,
- Result)
+ process_maybe1(make_module_symbol_specifier, Result0, Result)
;
parse_constructor_specifier(MainTerm, Result0),
- process_maybe1(make_cons_symbol_specifier, Result0,
- Result)
+ process_maybe1(make_cons_symbol_specifier, Result0, Result)
)
;
parse_constructor_specifier(MainTerm, Result0),
process_maybe1(make_cons_symbol_specifier, Result0, Result)
).
-% Once we've parsed the appropriate type of symbol specifier, we
-% need to convert it to a sym_specifier.
-
+ % Once we've parsed the appropriate type of symbol specifier, we need to
+ % convert it to a sym_specifier.
+ %
:- pred make_pred_symbol_specifier(pred_specifier::in, sym_specifier::out)
is det.
@@ -4011,65 +3802,58 @@
%-----------------------------------------------------------------------------%
-% A ModuleSpecifier is just an sym_name.
-
+ % A ModuleSpecifier is just an sym_name.
+ %
:- pred parse_module_specifier(term::in, maybe1(module_specifier)::out) is det.
parse_module_specifier(Term, Result) :-
parse_symbol_name(Term, Result).
-% A ModuleName is an implicitly-quantified sym_name.
-%
-% We check for module names starting with capital letters
-% as a special case, so that we can report a better error
-% message for that case.
-
+ % A ModuleName is an implicitly-quantified sym_name.
+ %
+ % We check for module names starting with capital letters as a special
+ % case, so that we can report a better error message for that case.
+ %
:- pred parse_module_name(module_name::in, term::in,
maybe1(module_name)::out) is det.
parse_module_name(DefaultModuleName, Term, Result) :-
- (
- Term = term__variable(_)
- ->
+ ( Term = term__variable(_) ->
dummy_term(ErrorContext),
Result = error("module names starting with " ++
"capital letters must be quoted using " ++
"single quotes (e.g. "":- module 'Foo'."")",
ErrorContext)
;
- parse_implicitly_qualified_symbol_name(DefaultModuleName,
- Term, Result)
+ parse_implicitly_qualified_symbol_name(DefaultModuleName, Term, Result)
).
%-----------------------------------------------------------------------------%
-% A ConstructorSpecifier is one of
-% SymbolNameSpecifier
-% TypedConstructorSpecifier
-%
-% A TypedConstructorSpecifier is one of
-% SymbolNameSpecifier::Type
-% Matches only constructors with the specified result
-% type.
-% SymbolName(ArgType1, ..., ArgTypeN)
-% Matches only constructors with the specified argument
-% types.
-% SymbolName(ArgType1, ..., ArgTypeN)::Type
-% Matches only constructors with the specified argument
-% and result types.
-
+ % A ConstructorSpecifier is one of
+ % SymbolNameSpecifier
+ % TypedConstructorSpecifier
+ %
+ % A TypedConstructorSpecifier is one of
+ % SymbolNameSpecifier::Type
+ % Matches only constructors with the specified result type.
+ % SymbolName(ArgType1, ..., ArgTypeN)
+ % Matches only constructors with the specified argument types.
+ % SymbolName(ArgType1, ..., ArgTypeN)::Type
+ % Matches only constructors with the specified argument
+ % and result types.
+ %
:- pred parse_constructor_specifier(term::in, maybe1(cons_specifier)::out)
is det.
parse_constructor_specifier(Term, Result) :-
(
- Term = term__functor(term__atom("::"),
- [NameArgsTerm, TypeTerm], _Context)
+ Term = term__functor(term__atom("::"), [NameArgsTerm, TypeTerm],
+ _Context)
->
parse_arg_types_specifier(NameArgsTerm, NameArgsResult),
parse_type(TypeTerm, TypeResult),
- process_typed_constructor_specifier(NameArgsResult, TypeResult,
- Result)
+ process_typed_constructor_specifier(NameArgsResult, TypeResult, Result)
;
parse_arg_types_specifier(Term, TermResult),
process_maybe1(make_untyped_cons_spec, TermResult, Result)
@@ -4077,25 +3861,20 @@
%-----------------------------------------------------------------------------%
-% A PredicateSpecifier is one of
-% SymbolName(ArgType1, ..., ArgTypeN)
-% Matches only predicates with the specified argument
-% types.
-% SymbolNameSpecifier
-
+ % A PredicateSpecifier is one of
+ % SymbolName(ArgType1, ..., ArgTypeN)
+ % Matches only predicates with the specified argument types.
+ % SymbolNameSpecifier
+ %
:- pred parse_predicate_specifier(term::in, maybe1(pred_specifier)::out)
is det.
parse_predicate_specifier(Term, Result) :-
- (
- Term = term__functor(term__atom("/"), [_,_], _Context)
- ->
+ ( Term = term__functor(term__atom("/"), [_,_], _Context) ->
parse_symbol_name_specifier(Term, NameResult),
- process_maybe1(make_arity_predicate_specifier,
- NameResult, Result)
+ process_maybe1(make_arity_predicate_specifier, NameResult, Result)
;
- parse_qualified_term(Term, Term, "predicate specifier",
- TermResult),
+ parse_qualified_term(Term, Term, "predicate specifier", TermResult),
process_typed_predicate_specifier(TermResult, Result)
).
@@ -4103,9 +3882,11 @@
maybe1(pred_specifier)::out) is det.
process_typed_predicate_specifier(ok(Name, Args0), Result) :-
- ( Args0 = [] ->
+ (
+ Args0 = [],
Result = ok(sym(name(Name)))
;
+ Args0 = [_ | _],
parse_types(Args0, ArgsResult),
(
ArgsResult = ok(Args),
@@ -4124,28 +3905,23 @@
%-----------------------------------------------------------------------------%
-% Parsing the name & argument types of a constructor specifier is
-% exactly the same as parsing a predicate specifier...
-
+ % Parsing the name & argument types of a constructor specifier is exactly
+ % the same as parsing a predicate specifier...
+ %
:- pred parse_arg_types_specifier(term::in, maybe1(pred_specifier)::out)
is det.
parse_arg_types_specifier(Term, Result) :-
- (
- Term = term__functor(term__atom("/"), [_,_], _Context)
- ->
+ ( Term = term__functor(term__atom("/"), [_,_], _Context) ->
parse_symbol_name_specifier(Term, NameResult),
- process_maybe1(make_arity_predicate_specifier,
- NameResult, Result)
+ process_maybe1(make_arity_predicate_specifier, NameResult, Result)
;
- parse_qualified_term(Term, Term, "constructor specifier",
- TermResult),
+ parse_qualified_term(Term, Term, "constructor specifier", TermResult),
process_typed_predicate_specifier(TermResult, Result)
).
-% ... but we have to convert the result back into the appropriate
-% format.
-
+ % ... but we have to convert the result back into the appropriate format.
+ %
:- pred process_typed_constructor_specifier(maybe1(pred_specifier)::in,
maybe1(type)::in, maybe1(cons_specifier)::out) is det.
@@ -4168,12 +3944,11 @@
%-----------------------------------------------------------------------------%
-% A SymbolNameSpecifier is one of
-% SymbolName
-% SymbolName/Arity
-% Matches only symbols of the specified arity.
-%
-
+ % A SymbolNameSpecifier is one of
+ % SymbolName
+ % SymbolName/Arity
+ % Matches only symbols of the specified arity.
+ %
:- pred parse_symbol_name_specifier(term::in, maybe1(sym_name_specifier)::out)
is det.
@@ -4186,32 +3961,28 @@
term::in, maybe1(sym_name_specifier)::out) is det.
parse_implicitly_qualified_symbol_name_specifier(DefaultModule, Term, Result) :-
- ( %%% some [NameTerm, ArityTerm, Context]
- Term = term__functor(term__atom("/"), [NameTerm, ArityTerm],
- _Context)
+ (
+ Term = term__functor(term__atom("/"), [NameTerm, ArityTerm], _Context)
->
- ( %%% some [Arity, Context2]
- ArityTerm = term__functor(term__integer(Arity), [],
- _Context2)
+ (
+ ArityTerm = term__functor(term__integer(Arity), [], _Context2)
->
( Arity >= 0 ->
- parse_implicitly_qualified_symbol_name(
- DefaultModule, NameTerm, NameResult),
- process_maybe1(
- make_name_arity_specifier(Arity),
+ parse_implicitly_qualified_symbol_name(DefaultModule, NameTerm,
+ NameResult),
+ process_maybe1(make_name_arity_specifier(Arity),
NameResult, Result)
;
- Result = error("arity in symbol name " ++
- "specifier must be a non-negative " ++
- "integer", Term)
+ Result = error("arity in symbol name specifier " ++
+ "must be a non-negative integer", Term)
)
;
Result = error("arity in symbol name " ++
"specifier must be an integer", Term)
)
;
- parse_implicitly_qualified_symbol_name(DefaultModule,
- Term, SymbolNameResult),
+ parse_implicitly_qualified_symbol_name(DefaultModule, Term,
+ SymbolNameResult),
process_maybe1(make_name_specifier, SymbolNameResult, Result)
).
@@ -4226,31 +3997,29 @@
%-----------------------------------------------------------------------------%
-% A SymbolName is one of
-% Name
-% Matches symbols with the specified name in the
-% current namespace.
-% Module:Name
-% Matches symbols with the specified name exported
-% by the specified module (where Module is itself
-% a SymbolName).
-%
-% We also allow the syntax `Module__Name'
-% as an alternative for `Module:Name'.
-
+ % A SymbolName is one of
+ % Name
+ % Matches symbols with the specified name in the
+ % current namespace.
+ % Module.Name
+ % Matches symbols with the specified name exported
+ % by the specified module (where Module is itself a SymbolName).
+ %
+ % We also allow the syntax `Module__Name' as an alternative
+ % for `Module.Name'.
+ %
:- pred parse_symbol_name(term(T)::in, maybe1(sym_name)::out) is det.
parse_symbol_name(Term, Result) :-
(
- Term = term__functor(term__atom(FunctorName),
- [ModuleTerm, NameTerm], _Context),
+ Term = term__functor(term__atom(FunctorName), [ModuleTerm, NameTerm],
+ _Context),
( FunctorName = ":"
; FunctorName = "."
)
->
(
- NameTerm = term__functor(term__atom(Name), [],
- _Context1)
+ NameTerm = term__functor(term__atom(Name), [], _Context1)
->
parse_symbol_name(ModuleTerm, ModuleResult),
(
@@ -4269,9 +4038,7 @@
"in qualified symbol name", ErrorTerm)
)
;
- (
- Term = term__functor(term__atom(Name), [], _Context3)
- ->
+ ( Term = term__functor(term__atom(Name), [], _Context3) ->
string_to_sym_name(Name, "__", SymName),
Result = ok(SymName)
;
@@ -4294,7 +4061,8 @@
SymName = qualified(ModName, _),
\+ match_sym_name(ModName, DefaultModName)
->
- Result = error("module qualifier in definition does not match preceding `:- module' declaration", Term)
+ Result = error("module qualifier in definition " ++
+ "does not match preceding `:- module' declaration", Term)
;
unqualify_name(SymName, UnqualName),
Result = ok(qualified(DefaultModName, UnqualName))
@@ -4305,16 +4073,6 @@
%-----------------------------------------------------------------------------%
-% A QualifiedTerm is one of
-% Name(Args)
-% Module:Name(Args)
-% (or if Args is empty, one of
-% Name
-% Module:Name)
-% where Module is a SymName.
-% For backwards compatibility, we allow `__'
-% as an alternative to `:'.
-
sym_name_and_args(Term, SymName, Args) :-
parse_qualified_term(Term, Term, "", ok(SymName, Args)).
@@ -4348,9 +4106,7 @@
[ModuleTerm, NameArgsTerm], _),
FunctorName = "."
->
- (
- NameArgsTerm = term__functor(term__atom(Name), Args, _)
- ->
+ ( NameArgsTerm = term__functor(term__atom(Name), Args, _) ->
parse_symbol_name(ModuleTerm, ModuleResult),
(
ModuleResult = ok(Module),
@@ -4368,18 +4124,14 @@
"in qualified symbol name", ErrorTerm)
)
;
- (
- Term = term__functor(term__atom(Name), Args, _)
- ->
+ ( Term = term__functor(term__atom(Name), Args, _) ->
string_to_sym_name(Name, "__", SymName),
Result = ok(SymName, Args)
;
string__append("atom expected in ", Msg, ErrorMsg),
- %
- % since variables don't have any term__context,
- % if Term is a variable, we use ContainingTerm instead
- % (hopefully that _will_ have a term__context).
- %
+ % Since variables don't have any term__context, if Term is
+ % a variable, we use ContainingTerm instead (hopefully that
+ % _will_ have a term__context).
( Term = term__variable(_) ->
ErrorTerm0 = ContainingTerm
;
@@ -4391,8 +4143,8 @@
).
%-----------------------------------------------------------------------------%
-
-% predicates used to convert a sym_list to a program item
+%
+% Predicates used to convert a sym_list to a program item.
:- pred make_use(sym_list::in, module_defn::out) is det.
@@ -4408,22 +4160,22 @@
%-----------------------------------------------------------------------------%
-% A FuncSpecifier is just a constructur name specifier.
-
+ % A FuncSpecifier is just a constructur name specifier.
+ %
:- pred parse_function_specifier(term::in, maybe1(func_specifier)::out) is det.
parse_function_specifier(Term, Result) :-
parse_constructor_specifier(Term, Result).
-% A TypeSpecifier is just a symbol name specifier.
-
+ % A TypeSpecifier is just a symbol name specifier.
+ %
:- pred parse_type_specifier(term::in, maybe1(sym_name_specifier)::out) is det.
parse_type_specifier(Term, Result) :-
parse_symbol_name_specifier(Term, Result).
-% An ADT_Specifier is just a symbol name specifier.
-
+ % An ADT_Specifier is just a symbol name specifier.
+ %
:- pred parse_adt_specifier(term::in, maybe1(sym_name_specifier)::out) is det.
parse_adt_specifier(Term, Result) :-
@@ -4431,9 +4183,9 @@
%-----------------------------------------------------------------------------%
-% For the moment, an OpSpecifier is just a symbol name specifier.
-% XXX We should allow specifying the fixity of an operator
-
+ % For the moment, an OpSpecifier is just a symbol name specifier.
+ % XXX We should allow specifying the fixity of an operator
+ %
:- pred parse_op_specifier(term::in, maybe1(op_specifier)::out) is det.
parse_op_specifier(Term, Result) :-
@@ -4451,10 +4203,7 @@
convert_constructor_arg_list(_ModuleName, []) = ok([]).
convert_constructor_arg_list( ModuleName, [Term | Terms]) = Result :-
- (
- Term = term__functor(term__atom("::"), [NameTerm, TypeTerm],
- _)
- ->
+ ( Term = term__functor(term__atom("::"), [NameTerm, TypeTerm], _) ->
parse_implicitly_qualified_term(ModuleName, NameTerm, Term,
"field name", NameResult),
(
@@ -4462,19 +4211,18 @@
Result = error(String1, Term1)
;
NameResult = ok(_SymName, [_ | _]),
- Result = error("syntax error in constructor name",
- Term)
+ Result = error("syntax error in constructor name", Term)
;
NameResult = ok(SymName, []),
MaybeFieldName = yes(SymName),
- Result = convert_constructor_arg_list_2(ModuleName,
- MaybeFieldName, TypeTerm, Terms)
+ Result = convert_constructor_arg_list_2(ModuleName, MaybeFieldName,
+ TypeTerm, Terms)
)
;
MaybeFieldName = no,
TypeTerm = Term,
- Result = convert_constructor_arg_list_2(ModuleName,
- MaybeFieldName, TypeTerm, Terms)
+ Result = convert_constructor_arg_list_2(ModuleName, MaybeFieldName,
+ TypeTerm, Terms)
).
:- func convert_constructor_arg_list_2(module_name, maybe(sym_name), term,
@@ -4501,10 +4249,10 @@
%-----------------------------------------------------------------------------%
-% We use the empty module name ('') as the "root" module name; when adding
-% default module qualifiers in parse_implicitly_qualified_{term,symbol},
-% if the default module is the root module then we don't add any qualifier.
-
+ % We use the empty module name ('') as the "root" module name; when adding
+ % default module qualifiers in parse_implicitly_qualified_{term,symbol},
+ % if the default module is the root module then we don't add any qualifier.
+ %
:- pred root_module_name(module_name::out) is det.
root_module_name(unqualified("")).
Index: compiler/prog_io_dcg.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_dcg.m,v
retrieving revision 1.30
diff -u -b -r1.30 prog_io_dcg.m
--- compiler/prog_io_dcg.m 12 Sep 2005 03:05:46 -0000 1.30
+++ compiler/prog_io_dcg.m 17 Oct 2005 15:06:10 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1996-2001, 2003-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -29,12 +31,12 @@
:- pred parse_dcg_clause(module_name::in, varset::in, term::in, term::in,
prog_context::in, maybe_item_and_context::out) is det.
- % parse_dcg_pred_goal(GoalTerm, Goal,
- % DCGVarInitial, DCGVarFinal, VarSet0, Varset)
- % parses `GoalTerm' and expands it as a DCG goal,
- % `VarSet0' is the initial varset, and `VarSet' is
- % the final varset. `DCGVarInitial' is the first DCG variable,
+ % parse_dcg_pred_goal(GoalTerm, Goal, DCGVarInitial, DCGVarFinal, !Varset):
+ %
+ % Parses `GoalTerm' and expands it as a DCG goal.
+ % `DCGVarInitial' is the first DCG variable,
% and `DCGVarFinal' is the final DCG variable.
+ %
:- pred parse_dcg_pred_goal(term::in, goal::out, prog_var::out, prog_var::out,
prog_varset::in, prog_varset::out) is det.
@@ -59,12 +61,11 @@
varset__coerce(VarSet0, ProgVarSet0),
new_dcg_var(ProgVarSet0, ProgVarSet1, counter__init(0), Counter0,
DCG_0_Var),
- parse_dcg_goal(DCG_Body, Body, ProgVarSet1, ProgVarSet,
- Counter0, _Counter, DCG_0_Var, DCG_Var),
- parse_implicitly_qualified_term(ModuleName,
- DCG_Head, DCG_Body, "DCG clause head", HeadResult),
- process_dcg_clause(HeadResult, ProgVarSet, DCG_0_Var, DCG_Var,
- Body, R),
+ parse_dcg_goal(DCG_Body, Body, ProgVarSet1, ProgVarSet, Counter0, _Counter,
+ DCG_0_Var, DCG_Var),
+ parse_implicitly_qualified_term(ModuleName, DCG_Head, DCG_Body,
+ "DCG clause head", HeadResult),
+ process_dcg_clause(HeadResult, ProgVarSet, DCG_0_Var, DCG_Var, Body, R),
add_context(R, DCG_Context, Result).
%-----------------------------------------------------------------------------%
@@ -77,7 +78,7 @@
%-----------------------------------------------------------------------------%
% Used to allocate fresh variables needed for the DCG expansion.
-
+ %
:- pred new_dcg_var(prog_varset::in, prog_varset::out,
counter::in, counter::out, prog_var::out) is det.
@@ -91,19 +92,19 @@
%-----------------------------------------------------------------------------%
% Expand a DCG goal.
-
+ %
:- pred parse_dcg_goal(term::in, goal::out, prog_varset::in, prog_varset::out,
counter::in, counter::out, prog_var::in, prog_var::out) is det.
parse_dcg_goal(Term, Goal, !VarSet, !Counter, !Var) :-
- % first, figure out the context for the goal
+ % First, figure out the context for the goal.
(
Term = term__functor(_, _, Context)
;
Term = term__variable(_),
term__context_init(Context)
),
- % next, parse it
+ % Next, parse it.
(
term__coerce(Term, ProgTerm),
sym_name_and_args(ProgTerm, SymName, Args0)
@@ -112,19 +113,16 @@
(
SymName = unqualified(Functor),
list__map(term__coerce, Args0, Args1),
- parse_dcg_goal_2(Functor, Args1, Context,
- Goal1, !VarSet, !Counter, !Var)
+ parse_dcg_goal_2(Functor, Args1, Context, Goal1,
+ !VarSet, !Counter, !Var)
->
Goal = Goal1
;
- % It's the ordinary case of non-terminal.
- % Create a fresh var as the DCG output var from this
- % goal, and append the DCG argument pair to the
- % non-terminal's argument list.
+ % It's the ordinary case of non-terminal. Create a fresh var
+ % as the DCG output var from this goal, and append the DCG argument
+ % pair to the non-terminal's argument list.
new_dcg_var(!VarSet, !Counter, Var),
- list__append(Args0,
- [term__variable(!.Var),
- term__variable(Var)], Args),
+ Args = Args0 ++ [term__variable(!.Var), term__variable(Var)],
Goal = call(SymName, Args, pure) - Context,
!:Var = Var
)
@@ -134,32 +132,30 @@
% will catch calls to numbers and strings.
new_dcg_var(!VarSet, !Counter, Var),
term__coerce(Term, ProgTerm),
- Goal = call(unqualified("call"), [ProgTerm,
- term__variable(!.Var), term__variable(Var)],
- pure) - Context,
+ Goal = call(unqualified("call"),
+ [ProgTerm, term__variable(!.Var), term__variable(Var)], pure)
+ - Context,
!:Var = Var
).
- % parse_dcg_goal_2(Functor, Args, Context, VarSet0, Counter0, Var0,
- % Goal, VarSet, Counter, Var):
- % VarSet0/VarSet are an accumulator pair which we use to
- % allocate fresh DCG variables; Counter0 and Counter are a pair
- % we use to keep track of the number to give to the next DCG
- % variable (so that we can give it a semi-meaningful name "DCG_<N>"
- % for use in error messages, debugging, etc.).
- % Var0 and Var are an accumulator pair we use to keep track of
+ % parse_dcg_goal_2(Functor, Args, Context, Goal, !VarSet, !Counter, !Var):
+ %
+ % We use !VarSet to allocate fresh DCG variables; We use !Counter
+ % to keep track of the number to give to the next DCG variable
+ % (so that we can give it a semi-meaningful name "DCG_<N>" for use
+ % in error messages, debugging, etc.). We use !Var to keep track of
% the current DCG variable.
%
% Since (A -> B) has different semantics in standard Prolog
% (A -> B ; fail) than it does in NU-Prolog or Mercury (A -> B ; true),
% for the moment we'll just disallow it.
-
+ %
:- pred parse_dcg_goal_2(string::in, list(term)::in, prog_context::in,
goal::out, prog_varset::in, prog_varset::out,
counter::in, counter::out, prog_var::in, prog_var::out) is semidet.
- % Ordinary goal inside { curly braces }.
parse_dcg_goal_2("{}", [G0 | Gs], Context, Goal, !VarSet, !Counter, !Var) :-
+ % Ordinary goal inside { curly braces }.
% The parser treats '{}/N' terms as tuples, so we need
% to undo the parsing of the argument conjunction here.
list_to_conjunction(Context, G0, Gs, G),
@@ -167,79 +163,75 @@
parse_dcg_goal_2("impure", [G], _, Goal, !VarSet, !Counter, !Var) :-
parse_dcg_goal_with_purity(G, (impure), Goal, !VarSet, !Counter, !Var).
parse_dcg_goal_2("semipure", [G], _, Goal, !VarSet, !Counter, !Var) :-
- parse_dcg_goal_with_purity(G, (semipure), Goal, !VarSet, !Counter,
- !Var).
+ parse_dcg_goal_with_purity(G, (semipure), Goal, !VarSet, !Counter, !Var).
parse_dcg_goal_2("promise_pure", [G], Context, Goal,
!VarSet, !Counter, !Var) :-
parse_dcg_goal(G, Goal0, !VarSet, !Counter, !Var),
- Goal = promise_purity(dont_make_implicit_promises, (pure), Goal0) -
- Context.
+ Goal = promise_purity(dont_make_implicit_promises, (pure), Goal0)
+ - Context.
parse_dcg_goal_2("promise_semipure", [G], Context, Goal,
!VarSet, !Counter, !Var) :-
parse_dcg_goal(G, Goal0, !VarSet, !Counter, !Var),
- Goal = promise_purity(dont_make_implicit_promises, (semipure), Goal0) -
- Context.
+ Goal = promise_purity(dont_make_implicit_promises, (semipure), Goal0)
+ - Context.
parse_dcg_goal_2("promise_impure", [G], Context, Goal,
!VarSet, !Counter, !Var) :-
parse_dcg_goal(G, Goal0, !VarSet, !Counter, !Var),
- Goal = promise_purity(dont_make_implicit_promises, (impure), Goal0) -
- Context.
+ Goal = promise_purity(dont_make_implicit_promises, (impure), Goal0)
+ - Context.
parse_dcg_goal_2("promise_pure_implicit", [G], Context, Goal,
!VarSet, !Counter, !Var) :-
parse_dcg_goal(G, Goal0, !VarSet, !Counter, !Var),
- Goal = promise_purity(make_implicit_promises, (pure), Goal0) -
- Context.
+ Goal = promise_purity(make_implicit_promises, (pure), Goal0)
+ - Context.
parse_dcg_goal_2("promise_semipure_implicit", [G], Context, Goal,
!VarSet, !Counter, !Var) :-
parse_dcg_goal(G, Goal0, !VarSet, !Counter, !Var),
- Goal = promise_purity(make_implicit_promises, (semipure), Goal0) -
- Context.
+ Goal = promise_purity(make_implicit_promises, (semipure), Goal0)
+ - Context.
parse_dcg_goal_2("promise_impure_implicit", [G], Context, Goal,
!VarSet, !Counter, !Var) :-
parse_dcg_goal(G, Goal0, !VarSet, !Counter, !Var),
- Goal = promise_purity(make_implicit_promises, (impure), Goal0) -
- Context.
+ Goal = promise_purity(make_implicit_promises, (impure), Goal0)
+ - Context.
- % Empty list - just unify the input and output DCG args.
parse_dcg_goal_2("[]", [], Context, Goal, !VarSet, !Counter, Var0, Var) :-
+ % Empty list - just unify the input and output DCG args.
new_dcg_var(!VarSet, !Counter, Var),
Goal = unify(term__variable(Var0), term__variable(Var), pure)
- Context.
- % Non-empty list of terminals. Append the DCG output arg
- % as the new tail of the list, and unify the result with
- % the DCG input arg.
parse_dcg_goal_2("[|]", [X, Xs], Context, Goal, !VarSet, !Counter,
Var0, Var) :-
+ % Non-empty list of terminals. Append the DCG output arg as the new tail
+ % of the list, and unify the result with the DCG input arg.
new_dcg_var(!VarSet, !Counter, Var),
ConsTerm0 = term__functor(term__atom("[|]"), [X, Xs], Context),
term__coerce(ConsTerm0, ConsTerm),
term_list_append_term(ConsTerm, term__variable(Var), Term),
Goal = unify(term__variable(Var0), Term, pure) - Context.
- % Call to '='/1 - unify argument with DCG input arg.
parse_dcg_goal_2("=", [A0], Context, Goal, !VarSet, !Counter, Var, Var) :-
+ % Call to '='/1 - unify argument with DCG input arg.
term__coerce(A0, A),
Goal = unify(A, term__variable(Var), pure) - Context.
- % Call to ':='/1 - unify argument with DCG output arg.
parse_dcg_goal_2(":=", [A0], Context, Goal, !VarSet, !Counter, _Var0, Var) :-
+ % Call to ':='/1 - unify argument with DCG output arg.
new_dcg_var(!VarSet, !Counter, Var),
term__coerce(A0, A),
Goal = unify(A, term__variable(Var), pure) - Context.
- % If-then (Prolog syntax).
- % We need to add an else part to unify the DCG args.
-
-% /******
% parse_dcg_goal_2("->", [Cond0, Then0], Context, VarSet0, Counter0, Var0,
% Goal, VarSet, Counter, Var) :-
+% % If-then (Prolog syntax).
+% % We need to add an else part to unify the DCG args.
% parse_dcg_if_then(Cond0, Then0, Context, VarSet0, Counter0, Var0,
% SomeVars, StateVars, Cond, Then, VarSet, Counter, Var),
% ( Var = Var0 ->
@@ -249,24 +241,23 @@
% Goal = if_then_else(SomeVars, StateVars, Cond, Then,
% Unify - Context) - Context
% ).
-% ******/
- % If-then (NU-Prolog syntax).
parse_dcg_goal_2("if", [term__functor(term__atom("then"), [Cond0, Then0], _)],
Context, Goal, !VarSet, !Counter, Var0, Var) :-
+ % If-then (NU-Prolog syntax).
parse_dcg_if_then(Cond0, Then0, Context, SomeVars, StateVars,
Cond, Then, !VarSet, !Counter, Var0, Var),
( Var = Var0 ->
Goal = if_then(SomeVars, StateVars, Cond, Then) - Context
;
Unify = unify(term__variable(Var), term__variable(Var0), pure),
- Goal = if_then_else(SomeVars, StateVars, Cond, Then,
- Unify - Context) - Context
+ Goal = if_then_else(SomeVars, StateVars, Cond, Then, Unify - Context)
+ - Context
).
- % Conjunction.
parse_dcg_goal_2(",", [A0, B0], Context, (A, B) - Context, !VarSet, !Counter,
!Var) :-
+ % Conjunction.
parse_dcg_goal(A0, A, !VarSet, !Counter, !Var),
parse_dcg_goal(B0, B, !VarSet, !Counter, !Var).
@@ -275,8 +266,8 @@
parse_dcg_goal(A0, A, !VarSet, !Counter, !Var),
parse_dcg_goal(B0, B, !VarSet, !Counter, !Var).
- % Disjunction or if-then-else (Prolog syntax).
parse_dcg_goal_2(";", [A0, B0], Context, Goal, !VarSet, !Counter, Var0, Var) :-
+ % Disjunction or if-then-else (Prolog syntax).
(
A0 = term__functor(term__atom("->"), [Cond0, Then0], _Context)
->
@@ -290,14 +281,12 @@
Goal = (A1 ; B1) - Context
; VarA = Var0 ->
Var = VarB,
- Unify = unify(term__variable(Var),
- term__variable(VarA), pure),
+ Unify = unify(term__variable(Var), term__variable(VarA), pure),
append_to_disjunct(A1, Unify, Context, A2),
Goal = (A2 ; B1) - Context
; VarB = Var0 ->
Var = VarA,
- Unify = unify(term__variable(Var),
- term__variable(VarB), pure),
+ Unify = unify(term__variable(Var), term__variable(VarB), pure),
append_to_disjunct(B1, Unify, Context, B2),
Goal = (A1 ; B2) - Context
;
@@ -307,75 +296,74 @@
)
).
- % If-then-else (NU-Prolog syntax).
parse_dcg_goal_2("else", [IF, Else0], _, Goal, !VarSet, !Counter, !Var) :-
+ % If-then-else (NU-Prolog syntax).
IF = term__functor(term__atom("if"),
- [term__functor(term__atom("then"), [Cond0, Then0], _)],
- Context),
+ [term__functor(term__atom("then"), [Cond0, Then0], _)], Context),
parse_dcg_if_then_else(Cond0, Then0, Else0, Context, Goal,
!VarSet, !Counter, !Var).
- % Negation (NU-Prolog syntax).
parse_dcg_goal_2("not", [A0], Context, not(A) - Context,
!VarSet, !Counter, Var0, Var0) :-
+ % Negation (NU-Prolog syntax).
parse_dcg_goal(A0, A, !VarSet, !Counter, Var0, _).
- % Negation (Prolog syntax).
parse_dcg_goal_2("\\+", [A0], Context, not(A) - Context,
!VarSet, !Counter, Var0, Var0) :-
+ % Negation (Prolog syntax).
parse_dcg_goal(A0, A, !VarSet, !Counter, Var0, _).
- % Universal quantification.
parse_dcg_goal_2("all", [QVars, A0], Context, GoalExpr - Context,
!VarSet, !Counter, !Var) :-
-
+ % Universal quantification.
% Extract any state variables in the quantifier.
- %
parse_quantifier_vars(QVars, StateVars0, Vars0),
list__map(term__coerce_var, StateVars0, StateVars),
list__map(term__coerce_var, Vars0, Vars),
- parse_dcg_goal(A0, A @ (GoalExprA - ContextA), !VarSet, !Counter,
- !Var),
-
+ parse_dcg_goal(A0, A @ (GoalExprA - ContextA), !VarSet, !Counter, !Var),
(
- Vars = [], StateVars = [],
+ Vars = [],
+ StateVars = [],
GoalExpr = GoalExprA
;
- Vars = [], StateVars = [_|_],
+ Vars = [],
+ StateVars = [_ | _],
GoalExpr = all_state_vars(StateVars, A)
;
- Vars = [_|_], StateVars = [],
+ Vars = [_ | _],
+ StateVars = [],
GoalExpr = all(Vars, A)
;
- Vars = [_|_], StateVars = [_|_],
+ Vars = [_ | _],
+ StateVars = [_ | _],
GoalExpr = all(Vars, all_state_vars(StateVars, A) - ContextA)
).
- % Existential quantification.
parse_dcg_goal_2("some", [QVars, A0], Context, GoalExpr - Context,
!VarSet, !Counter, !Var) :-
-
+ % Existential quantification.
% Extract any state variables in the quantifier.
- %
parse_quantifier_vars(QVars, StateVars0, Vars0),
list__map(term__coerce_var, StateVars0, StateVars),
list__map(term__coerce_var, Vars0, Vars),
- parse_dcg_goal(A0, A @ (GoalExprA - ContextA), !VarSet, !Counter,
- !Var),
-
+ parse_dcg_goal(A0, A @ (GoalExprA - ContextA), !VarSet, !Counter, !Var),
(
- Vars = [], StateVars = [],
+ Vars = [],
+ StateVars = [],
GoalExpr = GoalExprA
;
- Vars = [], StateVars = [_|_],
+ Vars = [],
+ StateVars = [_ | _],
GoalExpr = some_state_vars(StateVars, A)
;
- Vars = [_|_], StateVars = [],
+ Vars = [_ | _],
+ StateVars = [],
GoalExpr = some(Vars, A)
;
- Vars = [_|_], StateVars = [_|_],
+ Vars = [_ | _],
+ StateVars = [_ | _],
GoalExpr = some(Vars, some_state_vars(StateVars, A) - ContextA)
).
@@ -423,8 +411,7 @@
SomeVars = SomeVars0,
StateVars = StateVars0
;
- % XXX a hack because we do not do
- % error checking in this module.
+ % XXX A hack because we do not do error checking in this module.
term__vars(QVars, SomeVars),
StateVars = []
),
@@ -436,10 +423,9 @@
),
parse_dcg_goal(A2, A, !VarSet, !Counter, !Var).
- % Parse the "if" and the "then" part of an if-then or an
- % if-then-else.
- % If the condition is a DCG goal, but then "then" part
- % is not, then we need to translate
+ % Parse the "if" and the "then" part of an if-then or an if-then-else.
+ % If the condition is a DCG goal, but then "then" part is not,
+ % then we need to translate
% ( a -> { b } ; c )
% as
% ( a(DCG_1, DCG_2) ->
@@ -455,7 +441,7 @@
% c(DCG_1, DCG_2)
% )
% so that the implicit quantification of DCG_2 is correct.
-
+ %
:- pred parse_dcg_if_then(term::in, term::in, prog_context::in,
list(prog_var)::out, list(prog_var)::out, goal::out, goal::out,
prog_varset::in, prog_varset::out, counter::in, counter::out,
@@ -466,7 +452,10 @@
parse_some_vars_dcg_goal(Cond0, SomeVars, StateVars, Cond,
!VarSet, !Counter, Var0, Var1),
parse_dcg_goal(Then0, Then1, !VarSet, !Counter, Var1, Var2),
- ( Var0 \= Var1, Var1 = Var2 ->
+ (
+ Var0 \= Var1,
+ Var1 = Var2
+ ->
new_dcg_var(!VarSet, !Counter, Var),
Unify = unify(term__variable(Var), term__variable(Var2), pure),
Then = (Then1, Unify - Context) - Context
@@ -490,25 +479,23 @@
Else = Else1
; VarThen = Var0 ->
Var = VarElse,
- Unify = unify(term__variable(Var), term__variable(VarThen),
- pure),
+ Unify = unify(term__variable(Var), term__variable(VarThen), pure),
Then = (Then1, Unify - Context) - Context,
Else = Else1
; VarElse = Var0 ->
Var = VarThen,
Then = Then1,
- Unify = unify(term__variable(Var), term__variable(VarElse),
- pure),
+ Unify = unify(term__variable(Var), term__variable(VarElse), pure),
Else = (Else1, Unify - Context) - Context
;
- % We prefer to substitute the then part since it is likely
- % to be smaller than the else part, since the else part may
- % have a deeply nested chain of if-then-elses.
-
- % parse_dcg_if_then guarantees that if VarThen \= Var0,
- % then the then part introduces a new DCG variable (i.e.
- % VarThen does not appear in the condition). We therefore
- % don't need to do the substitution in the condition.
+ % We prefer to substitute the then part since it is likely to be
+ % smaller than the else part, since the else part may have a deeply
+ % nested chain of if-then-elses.
+
+ % parse_dcg_if_then guarantees that if VarThen \= Var0, then the
+ % then part introduces a new DCG variable (i.e. VarThen does not appear
+ % in the condition). We therefore don't need to do the substitution
+ % in the condition.
Var = VarElse,
prog_util__rename_in_goal(VarThen, VarElse, Then1, Then),
@@ -517,10 +504,10 @@
Goal = if_then_else(SomeVars, StateVars, Cond, Then, Else) - Context.
% term_list_append_term(ListTerm, Term, Result):
- % if ListTerm is a term representing a proper list,
- % this predicate will append the term Term
- % onto the end of the list
-
+ %
+ % If ListTerm is a term representing a proper list, this predicate
+ % will append the term Term onto the end of the list.
+ %
:- pred term_list_append_term(term(T)::in, term(T)::in, term(T)::out)
is semidet.
@@ -528,10 +515,8 @@
( List0 = term__functor(term__atom("[]"), [], _Context) ->
List = Term
;
- List0 = term__functor(term__atom("[|]"),
- [Head, Tail0], Context2),
- List = term__functor(term__atom("[|]"),
- [Head, Tail], Context2),
+ List0 = term__functor(term__atom("[|]"), [Head, Tail0], Context2),
+ List = term__functor(term__atom("[|]"), [Head, Tail], Context2),
term_list_append_term(Tail0, Term, Tail)
).
Index: compiler/prog_io_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_goal.m,v
retrieving revision 1.35
diff -u -b -r1.35 prog_io_goal.m
--- compiler/prog_io_goal.m 13 Sep 2005 03:25:42 -0000 1.35
+++ compiler/prog_io_goal.m 17 Oct 2005 15:59:52 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1996-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -40,8 +42,8 @@
list(prog_term)::out, list(mode)::out, determinism::out) is semidet.
% parse_dcg_pred_expression/3 converts the first argument to a -->/2
- % higher-order dcg pred expression into a list of arguments, a list
- % of their corresponding modes and the two dcg argument modes, and a
+ % higher-order DCG pred expression into a list of arguments, a list
+ % of their corresponding modes and the two DCG argument modes, and a
% determinism.
% This is a variant of the higher-order pred syntax:
% `(pred(Var1::Mode1, ..., VarN::ModeN, DCG0Mode, DCGMode)
@@ -96,33 +98,31 @@
%-----------------------------------------------------------------------------%
- % Parse a goal.
- %
+parse_goal(Term, Goal, !VarSet) :-
% We could do some error-checking here, but all errors are picked up
% in either the type-checker or parser anyway.
-parse_goal(Term, Goal, !VarSet) :-
- % first, get the goal context
+ % First, get the goal context.
(
Term = term__functor(_, _, Context)
;
Term = term__variable(_),
term__context_init(Context)
),
- % We just check if it matches the appropriate pattern
- % for one of the builtins. If it doesn't match any of the
- % builtins, then it's just a predicate call.
+ % We just check if it matches the appropriate pattern for one of the
+ % builtins. If it doesn't match any of the builtins, then it's just
+ % a predicate call.
(
- % check for builtins...
+ % Check for builtins...
Term = term__functor(term__atom(Name), Args, Context),
parse_goal_2(Name, Args, GoalExpr, !VarSet)
->
Goal = GoalExpr - Context
;
- % it's not a builtin
+ % It's not a builtin.
term__coerce(Term, ArgsTerm),
(
- % check for predicate calls
+ % Check for predicate calls.
sym_name_and_args(ArgsTerm, SymName, Args)
->
Goal = call(SymName, Args, pure) - Context
@@ -130,8 +130,7 @@
% A call to a free variable, or to a number or string.
% Just translate it into a call to call/1 - the
% typechecker will catch calls to numbers and strings.
- Goal = call(unqualified("call"), [ArgsTerm], pure)
- - Context
+ Goal = call(unqualified("call"), [ArgsTerm], pure) - Context
)
).
@@ -157,9 +156,7 @@
parse_goal(A0, A, !V),
parse_goal(B0, B, !V).
parse_goal_2(";", [A0, B0], R, !V) :-
- (
- A0 = term__functor(term__atom("->"), [X0, Y0], _Context)
- ->
+ ( A0 = term__functor(term__atom("->"), [X0, Y0], _Context) ->
parse_some_vars_goal(X0, Vars, StateVars, X, !V),
parse_goal(Y0, Y, !V),
parse_goal(B0, B, !V),
@@ -183,9 +180,7 @@
parse_goal(A0, A, !V).
parse_goal_2("all", [QVars, A0], GoalExpr, !V):-
-
% Extract any state variables in the quantifier.
- %
parse_quantifier_vars(QVars, StateVars0, Vars0),
list__map(term__coerce_var, StateVars0, StateVars),
list__map(term__coerce_var, Vars0, Vars),
@@ -206,7 +201,7 @@
GoalExpr = all(Vars, all_state_vars(StateVars, A) - ContextA)
).
- % handle implication
+ % Handle implication.
parse_goal_2("<=", [A0, B0], implies(B, A), !V):-
parse_goal(A0, A, !V),
parse_goal(B0, B, !V).
@@ -221,9 +216,7 @@
parse_goal(B0, B, !V).
parse_goal_2("some", [QVars, A0], GoalExpr, !V):-
-
% Extract any state variables in the quantifier.
- %
parse_quantifier_vars(QVars, StateVars0, Vars0),
list__map(term__coerce_var, StateVars0, StateVars),
list__map(term__coerce_var, Vars0, Vars),
@@ -275,10 +268,9 @@
parse_goal(A0, A, !V),
GoalExpr = promise_purity(make_implicit_promises, impure, A).
- % The following is a temporary hack to handle `is' in
- % the parser - we ought to handle it in the code generation -
- % but then `is/2' itself is a bit of a hack
- %
+ % The following is a temporary hack to handle `is' in the parser -
+ % we ought to handle it in the code generation - but then `is/2' itself
+ % is a bit of a hack.
parse_goal_2("is", [A0, B0], unify(A, B, pure), !V) :-
term__coerce(A0, A),
term__coerce(B0, B).
@@ -337,8 +329,7 @@
%
parse_pred_expression(PredTerm, EvalMethod, Args, Modes, Det) :-
- PredTerm = term__functor(term__atom("is"),
- [PredEvalArgsTerm, DetTerm], _),
+ PredTerm = term__functor(term__atom("is"), [PredEvalArgsTerm, DetTerm], _),
DetTerm = term__functor(term__atom(DetString), [], _),
standard_det(DetString, Det),
parse_lambda_eval_method(PredEvalArgsTerm, EvalMethod, PredArgsTerm),
@@ -347,8 +338,7 @@
inst_var_constraints_are_consistent_in_modes(Modes).
parse_dcg_pred_expression(PredTerm, EvalMethod, Args, Modes, Det) :-
- PredTerm = term__functor(term__atom("is"),
- [PredEvalArgsTerm, DetTerm], _),
+ PredTerm = term__functor(term__atom("is"), [PredEvalArgsTerm, DetTerm], _),
DetTerm = term__functor(term__atom(DetString), [], _),
standard_det(DetString, Det),
parse_lambda_eval_method(PredEvalArgsTerm, EvalMethod, PredArgsTerm),
@@ -357,12 +347,9 @@
inst_var_constraints_are_consistent_in_modes(Modes).
parse_func_expression(FuncTerm, EvalMethod, Args, Modes, Det) :-
- %
% Parse a func expression with specified modes and determinism.
- %
FuncTerm = term__functor(term__atom("is"), [EqTerm, DetTerm], _),
- EqTerm = term__functor(term__atom("="),
- [FuncEvalArgsTerm, RetTerm], _),
+ EqTerm = term__functor(term__atom("="), [FuncEvalArgsTerm, RetTerm], _),
DetTerm = term__functor(term__atom(DetString), [], _),
standard_det(DetString, Det),
parse_lambda_eval_method(FuncEvalArgsTerm, EvalMethod, FuncArgsTerm),
@@ -374,10 +361,8 @@
list__append(Modes0, [RetMode], Modes),
inst_var_constraints_are_consistent_in_modes(Modes)
;
- %
% The argument modes default to `in',
% the return mode defaults to `out'.
- %
in_mode(InMode),
out_mode(OutMode),
list__length(FuncArgsList, NumArgs),
@@ -389,18 +374,14 @@
).
parse_func_expression(FuncTerm, EvalMethod, Args, Modes, Det) :-
- %
- % parse a func expression with unspecified modes and determinism
- %
- FuncTerm = term__functor(term__atom("="),
- [FuncEvalArgsTerm, RetTerm], _),
+ % Parse a func expression with unspecified modes and determinism.
+ FuncTerm = term__functor(term__atom("="), [FuncEvalArgsTerm, RetTerm], _),
parse_lambda_eval_method(FuncEvalArgsTerm, EvalMethod, FuncArgsTerm),
FuncArgsTerm = term__functor(term__atom("func"), Args0, _),
- %
- % the argument modes default to `in',
+
+ % The argument modes default to `in',
% the return mode defaults to `out',
% and the determinism defaults to `det'.
- %
in_mode(InMode),
out_mode(OutMode),
list__length(Args0, NumArgs),
@@ -436,7 +417,8 @@
% parse_dcg_pred_expr_args is like parse_pred_expr_args except
% that the last two elements of the list are the modes of the
- % two dcg arguments.
+ % two DCG arguments.
+ %
:- pred parse_dcg_pred_expr_args(list(term)::in, list(prog_term)::out,
list(mode)::out) is semidet.
@@ -447,7 +429,7 @@
constrain_inst_vars_in_mode(DCGModeA0, DCGModeA),
constrain_inst_vars_in_mode(DCGModeB0, DCGModeB).
parse_dcg_pred_expr_args([Term|Terms], [Arg|Args], [Mode|Modes]) :-
- Terms = [_, _|_],
+ Terms = [_, _ | _],
parse_lambda_arg(Term, Arg, Mode),
parse_dcg_pred_expr_args(Terms, Args, Modes).
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.89
diff -u -b -r1.89 prog_io_pragma.m
--- compiler/prog_io_pragma.m 28 Sep 2005 09:02:14 -0000 1.89
+++ compiler/prog_io_pragma.m 17 Oct 2005 16:00:22 -0000
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% vim:ts=4 sw=4 expandtab
+% vim: ts=4 sw=4 expandtab
%-----------------------------------------------------------------------------%
% Copyright (C) 1996-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
Index: compiler/prog_io_typeclass.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_typeclass.m,v
retrieving revision 1.42
diff -u -b -r1.42 prog_io_typeclass.m
--- compiler/prog_io_typeclass.m 12 Sep 2005 05:24:21 -0000 1.42
+++ compiler/prog_io_typeclass.m 17 Oct 2005 15:55:27 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1997-2005 University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -22,19 +24,23 @@
:- import_module term.
:- import_module varset.
- % parse a typeclass declaration.
+ % Parse a typeclass declaration.
+ %
:- pred parse_typeclass(module_name::in, varset::in, list(term)::in,
maybe1(item)::out) is semidet.
- % parse an instance declaration.
+ % Parse an instance declaration.
+ %
:- pred parse_instance(module_name::in, varset::in, list(term)::in,
maybe1(item)::out) is semidet.
- % parse a list of class constraints
+ % Parse a list of class constraints.
+ %
:- pred parse_class_constraints(module_name::in, term::in,
maybe1(list(prog_constraint))::out) is det.
- % parse a list of class and inst constraints
+ % Parse a list of class and inst constraints.
+ %
:- pred parse_class_and_inst_constraints(module_name::in, term::in,
maybe_class_and_inst_constraints::out) is det.
@@ -58,14 +64,11 @@
:- import_module varset.
parse_typeclass(ModuleName, VarSet, TypeClassTerm, Result) :-
- %XXX should return an error if we get more than one arg,
- %XXX rather than failing.
+ % XXX We should return an error if we get more than one arg, instead of
+ % failing.
TypeClassTerm = [Arg],
- (
- Arg = term__functor(term__atom("where"), [Name, Methods], _)
- ->
- parse_non_empty_class(ModuleName, Name, Methods, VarSet,
- Result)
+ ( Arg = term__functor(term__atom("where"), [Name, Methods], _) ->
+ parse_non_empty_class(ModuleName, Name, Methods, VarSet, Result)
;
parse_class_head(ModuleName, Arg, VarSet, Result)
).
@@ -91,7 +94,7 @@
^ tc_class_methods := concrete(MethodList))
^ tc_varset := TVarSet)
;
- % if the item we get back isn't a typeclass,
+ % If the item we get back isn't a typeclass,
% something has gone wrong...
error("prog_io_typeclass.m: item should be a typeclass")
)
@@ -107,8 +110,7 @@
(
Arg = term__functor(term__atom("<="), [Name, Constraints], _)
->
- parse_constrained_class(ModuleName, Name, Constraints, VarSet,
- Result)
+ parse_constrained_class(ModuleName, Name, Constraints, VarSet, Result)
;
varset__coerce(VarSet, TVarSet),
parse_unconstrained_class(ModuleName, Arg, TVarSet, Result)
@@ -133,26 +135,18 @@
Item = typeclass(_, _, _, _, _, _)
->
(
- %
- % Check for type variables in the constraints
- % which do not occur in the type class
- % parameters.
- %
- prog_type__constraint_list_get_tvars(
- ConstraintList, ConstrainedVars),
+ % Check for type variables in the constraints which do not
+ % occur in the type class parameters.
+ prog_type__constraint_list_get_tvars(ConstraintList,
+ ConstrainedVars),
list__member(Var, ConstrainedVars),
\+ list__member(Var, Item ^ tc_class_params)
->
- Result = error("type variable in " ++
- "superclass constraint is not " ++
- "a parameter of this type class",
- Constraints)
+ Result = error("type variable in superclass constraint " ++
+ "is not a parameter of this type class", Constraints)
;
- %
- % Check for type variables in the fundeps
- % which do not occur in the type class
- % parameters.
- %
+ % Check for type variables in the fundeps which do not occur
+ % in the type class parameters.
list__member(FunDep, FunDeps),
FunDep = fundep(Domain, Range),
(
@@ -162,17 +156,15 @@
),
\+ list__member(Var, Item ^ tc_class_params)
->
- Result = error("type variable in " ++
- "functional dependency is not " ++
- "a parameter of this type class",
- Constraints)
+ Result = error("type variable in functional dependency " ++
+ "is not a parameter of this type class", Constraints)
;
Result = ok((Item
^ tc_constraints := ConstraintList)
^ tc_fundeps := FunDeps)
)
;
- % if the item we get back isn't a typeclass,
+ % If the item we get back isn't a typeclass,
% something has gone wrong...
error("prog_io_typeclass.m: item should be a typeclass")
)
@@ -189,15 +181,13 @@
(
Result0 = ok(ArbitraryConstraints),
(
- collect_simple_and_fundep_constraints(
- ArbitraryConstraints,
+ collect_simple_and_fundep_constraints(ArbitraryConstraints,
Constraints, FunDeps)
->
Result = ok(Constraints, FunDeps)
;
ErrorMessage = "constraints on class declarations" ++
- " may only constrain type variables and" ++
- " ground types",
+ " may only constrain type variables and ground types",
Result = error(ErrorMessage, ConstraintsTerm)
)
;
@@ -235,11 +225,9 @@
(
term__var_list_to_term_list(Vars, TermVars),
list__sort_and_remove_dups(TermVars, SortedTermVars),
- list__length(SortedTermVars) =
- list__length(TermVars) `with_type` int
+ list__length(SortedTermVars) = list__length(TermVars) : int
->
- Result = ok(typeclass([], [], ClassName, Vars,
- abstract, TVarSet))
+ Result = ok(typeclass([], [], ClassName, Vars, abstract, TVarSet))
;
Result = error("expected distinct variables " ++
"as class parameters", Name)
@@ -254,15 +242,13 @@
parse_class_methods(ModuleName, Methods, VarSet, Result) :-
(
+ % Convert the list of terms into a list of maybe1(class_method)s.
list_term_to_term_list(Methods, MethodList)
- % Convert the list of terms into a list of
- % maybe1(class_method)s.
->
list__map((pred(MethodTerm::in, Method::out) is det :-
- % Turn the term into an item
- parse_decl(ModuleName, VarSet, MethodTerm,
- Item),
- % Turn the item into a class_method
+ % Turn the term into an item.
+ parse_decl(ModuleName, VarSet, MethodTerm, Item),
+ % Turn the item into a class_method.
item_to_class_method(Item, MethodTerm, Method)
), MethodList, Interface),
find_errors(Interface, Result)
@@ -279,8 +265,7 @@
(
Item = pred_or_func(A, B, C, D, E, F, G, H, I, J, K, L)
->
- Result = ok(pred_or_func(A, B, C, D, E, F, G, H, I, J, K, L,
- Context))
+ Result = ok(pred_or_func(A, B, C, D, E, F, G, H, I, J, K, L, Context))
;
Item = pred_or_func_mode(A, B, C, D, E, F, G)
->
@@ -290,9 +275,10 @@
"allowed in class interface", Term)
).
- % from a list of maybe1s, search through until you find an error.
+ % From a list of maybe1s, search through until you find an error.
% If an error is found, return it.
% If no error is found, return ok(the original elements).
+ %
:- pred find_errors(list(maybe1(T))::in, maybe1(list(T))::out) is det.
find_errors([], ok([])).
@@ -317,9 +303,9 @@
% Predicates for parsing various kinds of constraints.
%
- % Parse constraints on a pred or func declaration, or on an
- % existentially quantified type definition. Currently all such
- % constraints must be simple.
+ % Parse constraints on a pred or func declaration, or on an existentially
+ % quantified type definition. Currently all such constraints must be
+ % simple.
%
parse_class_constraints(ModuleName, ConstraintsTerm, Result) :-
ErrorMessage = "sorry, not implemented:" ++
@@ -338,8 +324,7 @@
Result0 = ok(ArbitraryConstraints),
(
% Fail if any of the constraints aren't simple.
- list.map(get_simple_constraint, ArbitraryConstraints,
- Constraints)
+ list.map(get_simple_constraint, ArbitraryConstraints, Constraints)
->
Result = ok(Constraints)
;
@@ -398,21 +383,20 @@
:- type arbitrary_constraint
---> simple(prog_constraint)
- % A class constraint whose arguments are either
- % variables or ground terms.
+ % A class constraint whose arguments are either variables
+ % or ground terms.
; non_simple(prog_constraint)
- % An arbitrary class constraint not matching the
- % description of "simple".
+ % An arbitrary class constraint not matching the description
+ % of "simple".
; inst_constraint(inst_var, inst)
- % A constraint on an inst variable (that is, one
- % whose head is '=<'/2).
+ % A constraint on an inst variable (that is, one whose head
+ % is '=<'/2).
; fundep(prog_fundep).
- % A functional dependency (that is, one whose head
- % is '->'/2 and whose arguments are comma-separated
- % variables.
+ % A functional dependency (that is, one whose head is '->'/2
+ % and whose arguments are comma-separated variables.
:- type arbitrary_constraints == list(arbitrary_constraint).
@@ -460,9 +444,7 @@
(
ArgsResult = ok(Args),
Constraint = constraint(ClassName, Args),
- (
- constraint_is_not_simple(Constraint)
- ->
+ ( constraint_is_not_simple(Constraint) ->
Result = ok(non_simple(Constraint))
;
Result = ok(simple(Constraint))
@@ -494,8 +476,8 @@
->
Result = ok(fundep(fundep(Domain, Range)))
;
- ErrorMessage = "domain and range of functional dependency" ++
- " must be comma-separated lists of variables",
+ ErrorMessage = "domain and range of functional dependency " ++
+ "must be comma-separated lists of variables",
Result = error(ErrorMessage, Term)
).
@@ -518,15 +500,13 @@
%-----------------------------------------------------------------------------%
parse_instance(ModuleName, VarSet, TypeClassTerm, Result) :-
- %XXX should return an error if we get more than one arg,
- %XXX rather than failing.
+ % XXX We should return an error if we get more than one arg,
+ % instead of failing.
TypeClassTerm = [Arg],
varset__coerce(VarSet, TVarSet),
- (
- Arg = term__functor(term__atom("where"), [Name, Methods], _)
- ->
- parse_non_empty_instance(ModuleName, Name, Methods, VarSet,
- TVarSet, Result)
+ ( Arg = term__functor(term__atom("where"), [Name, Methods], _) ->
+ parse_non_empty_instance(ModuleName, Name, Methods, VarSet, TVarSet,
+ Result)
;
parse_instance_name(ModuleName, Arg, TVarSet, Result)
).
@@ -535,11 +515,8 @@
maybe1(item)::out) is det.
parse_instance_name(ModuleName, Arg, TVarSet, Result) :-
- (
- Arg = term__functor(term__atom("<="), [Name, Constraints], _)
- ->
- parse_derived_instance(ModuleName, Name, Constraints,
- TVarSet, Result)
+ ( Arg = term__functor(term__atom("<="), [Name, Constraints], _) ->
+ parse_derived_instance(ModuleName, Name, Constraints, TVarSet, Result)
;
parse_underived_instance(ModuleName, Arg, TVarSet, Result)
).
@@ -547,28 +524,25 @@
:- pred parse_derived_instance(module_name::in, term::in, term::in,
tvarset::in, maybe1(item)::out) is det.
-parse_derived_instance(ModuleName, Decl, Constraints, TVarSet,
- Result) :-
+parse_derived_instance(ModuleName, Decl, Constraints, TVarSet, Result) :-
parse_instance_constraints(ModuleName, Constraints, ParsedConstraints),
(
ParsedConstraints = ok(ConstraintList),
- parse_underived_instance(ModuleName, Decl, TVarSet,
- Result0),
+ parse_underived_instance(ModuleName, Decl, TVarSet, Result0),
(
Result0 = error(_, _)
->
Result = Result0
;
- Result0 = ok(instance(_, Name, Types, Body, VarSet,
- ModName))
+ Result0 = ok(instance(_, Name, Types, Body, VarSet, ModName))
->
- Result = ok(instance(ConstraintList, Name, Types, Body,
- VarSet, ModName))
+ Result = ok(instance(ConstraintList, Name, Types, Body, VarSet,
+ ModName))
;
- % if the item we get back isn't an instance,
+ % If the item we get back isn't an instance,
% something has gone wrong...
- % maybe we should use cleverer inst decls to
- % avoid this call to error
+ % Maybe we should use cleverer inst decls to avoid
+ % this call to error.
error("prog_io_typeclass.m: item should be an instance")
)
;
@@ -581,24 +555,21 @@
parse_instance_constraints(ModuleName, Constraints, Result) :-
parse_simple_class_constraints(ModuleName, Constraints,
- "constraints on instance declarations may only constrain" ++
- " type variables and ground types",
- Result).
+ "constraints on instance declarations may only constrain " ++
+ "type variables and ground types", Result).
:- pred parse_underived_instance(module_name::in, term::in, tvarset::in,
maybe1(item)::out) is det.
parse_underived_instance(ModuleName, Name, TVarSet, Result) :-
- % We don't give a default module name here since the instance
- % declaration could well be for a typeclass defined in another
- % module.
- parse_qualified_term(Name, Name, "instance declaration",
- MaybeClassName),
+ % We don't give a default module name here since the instance declaration
+ % could well be for a typeclass defined in another module.
+ parse_qualified_term(Name, Name, "instance declaration", MaybeClassName),
(
MaybeClassName = ok(ClassName, TermTypes),
parse_types(TermTypes, TypesResult),
- parse_underived_instance_2(Name, ClassName, TypesResult,
- TVarSet, ModuleName, Result)
+ parse_underived_instance_2(Name, ClassName, TypesResult, TVarSet,
+ ModuleName, Result)
;
MaybeClassName = error(String, Term),
Result = error(String, Term)
@@ -614,15 +585,13 @@
(
% Check that each type in the arguments of the instance decl
% is a functor with vars as args.
- %
some [Type] (
list__member(Type, Types),
\+ type_is_functor_and_vars(Type)
)
->
- Result = error("types in instance declarations must be" ++
- " functors with distinct variables as arguments",
- ErrorTerm)
+ Result = error("types in instance declarations must be " ++
+ "functors with distinct variables as arguments", ErrorTerm)
;
Result = ok(instance([], ClassName, Types, abstract, TVarSet,
ModuleName))
@@ -664,22 +633,20 @@
parse_instance_methods(ModuleName, Methods, VarSet, ParsedMethods),
(
ParsedMethods = ok(MethodList),
- parse_instance_name(ModuleName, Name, TVarSet,
- ParsedNameAndTypes),
+ parse_instance_name(ModuleName, Name, TVarSet, ParsedNameAndTypes),
(
ParsedNameAndTypes = error(String, Term)
->
Result = error(String, Term)
;
- ParsedNameAndTypes = ok(instance(Constraints,
- NameString, Types, _, _, ModName))
+ ParsedNameAndTypes = ok(instance(Constraints, NameString, Types,
+ _, _, ModName))
->
Result0 = ok(instance(Constraints, NameString, Types,
concrete(MethodList), TVarSet, ModName)),
- check_tvars_in_instance_constraint(Result0, Name,
- Result)
+ check_tvars_in_instance_constraint(Result0, Name, Result)
;
- % if the item we get back isn't a typeclass,
+ % If the item we get back isn't a typeclass,
% something has gone wrong...
error("prog_io_typeclass.m: item should be an instance")
)
@@ -697,20 +664,16 @@
Item = instance(Constraints, _Name, Types, _Methods, _TVarSet,
_ModName)
->
- %
- % check that all of the type variables in the constraints
+ % Check that all of the type variables in the constraints
% on the instance declaration also occur in the type class
- % argument types in the instance declaration
- %
+ % argument types in the instance declaration.
(
- prog_type__constraint_list_get_tvars(Constraints,
- TVars),
+ prog_type__constraint_list_get_tvars(Constraints, TVars),
list__member(TVar, TVars),
\+ type_list_contains_var(Types, TVar)
->
Result = error("unbound type variable(s) " ++
- "in constraints on instance declaration",
- InstanceTerm)
+ "in constraints on instance declaration", InstanceTerm)
;
Result = ok(Item)
)
@@ -722,125 +685,91 @@
maybe1(list(instance_method))::out) is det.
parse_instance_methods(ModuleName, Methods, VarSet, Result) :-
- (
- list_term_to_term_list(Methods, MethodList)
- ->
- % Convert the list of terms into a list of
- % maybe1(class_method)s.
- list__map(term_to_instance_method(ModuleName, VarSet),
- MethodList, Interface),
+ ( list_term_to_term_list(Methods, MethodList) ->
+ % Convert the list of terms into a list of maybe1(class_method)s.
+ list__map(term_to_instance_method(ModuleName, VarSet), MethodList,
+ Interface),
find_errors(Interface, Result)
;
Result = error("expected list of instance methods", Methods)
).
- % Turn the term into a method instance
+ % Turn the term into a method instance.
+ %
:- pred term_to_instance_method(module_name::in, varset::in, term::in,
maybe1(instance_method)::out) is det.
term_to_instance_method(_ModuleName, VarSet, MethodTerm, Result) :-
(
- MethodTerm = term__functor(term__atom("is"), [ClassMethodTerm,
- InstanceMethod], TermContext)
+ MethodTerm = term__functor(term__atom("is"),
+ [ClassMethodTerm, InstanceMethod], TermContext)
->
(
ClassMethodTerm = term__functor(term__atom("pred"),
- [term__functor(
- term__atom("/"),
- [ClassMethod, Arity],
- _)],
- _)
- ->
- (
- parse_qualified_term(ClassMethod,
- ClassMethod, "instance method",
- ok(ClassMethodName, [])),
- Arity = term__functor(term__integer(ArityInt),
- [], _),
- parse_qualified_term(InstanceMethod,
- InstanceMethod, "instance method",
- ok(InstanceMethodName, []))
- ->
- Result = ok(instance_method(predicate,
- ClassMethodName,
- name(InstanceMethodName),
- ArityInt, TermContext))
- ;
- Result = error(
- "expected `pred(<Name> / <Arity>) " ++
- "is <InstanceMethod>'",
- MethodTerm)
+ [term__functor(term__atom("/"), [ClassMethod, Arity], _)], _)
+ ->
+ (
+ parse_qualified_term(ClassMethod, ClassMethod,
+ "instance method", ok(ClassMethodName, [])),
+ Arity = term__functor(term__integer(ArityInt), [], _),
+ parse_qualified_term(InstanceMethod, InstanceMethod,
+ "instance method", ok(InstanceMethodName, []))
+ ->
+ Result = ok(instance_method(predicate, ClassMethodName,
+ name(InstanceMethodName), ArityInt, TermContext))
+ ;
+ Result = error("expected `pred(<Name> / <Arity>) " ++
+ "is <InstanceMethod>'", MethodTerm)
)
;
ClassMethodTerm = term__functor(term__atom("func"),
- [term__functor(
- term__atom("/"),
- [ClassMethod, Arity],
- _)],
- _)
- ->
- (
- parse_qualified_term(ClassMethod,
- ClassMethod, "instance method",
- ok(ClassMethodName, [])),
- Arity = term__functor(term__integer(ArityInt),
- [], _),
- parse_qualified_term(InstanceMethod,
- InstanceMethod, "instance method",
- ok(InstanceMethodName, []))
- ->
- Result = ok(instance_method(function,
- ClassMethodName,
- name(InstanceMethodName),
- ArityInt, TermContext))
- ;
- Result = error(
- "expected `func(<Name> / <Arity>) " ++
- "is <InstanceMethod>'",
- MethodTerm)
- )
- ;
- Result = error(
- "expected `pred(<Name> / <Arity>) " ++
- "is <InstanceName>'",
- MethodTerm)
- )
- ;
- % For the clauses in an instance declaration,
- % the default module name for the clause heads
- % is the module name of the class that this is an
- % instance declaration for, but we don't necessarily
- % know what module that is at this point, since the
- % class name hasn't been fully qualified yet.
- % So here we give the special module name ""
- % as the default, which means that there is no default.
- % (If the module qualifiers in the clauses don't match
- % the module name of the class, we will pick that up later,
- % in check_typeclass.m.)
+ [term__functor(term__atom("/"), [ClassMethod, Arity], _)], _)
+ ->
+ (
+ parse_qualified_term(ClassMethod, ClassMethod,
+ "instance method", ok(ClassMethodName, [])),
+ Arity = term__functor(term__integer(ArityInt), [], _),
+ parse_qualified_term(InstanceMethod, InstanceMethod,
+ "instance method", ok(InstanceMethodName, []))
+ ->
+ Result = ok(instance_method(function, ClassMethodName,
+ name(InstanceMethodName), ArityInt, TermContext))
+ ;
+ Result = error("expected `func(<Name> / <Arity>) " ++
+ "is <InstanceMethod>'", MethodTerm)
+ )
+ ;
+ Result = error("expected `pred(<Name> / <Arity>) " ++
+ "is <InstanceName>'", MethodTerm)
+ )
+ ;
+ % For the clauses in an instance declaration, the default module name
+ % for the clause heads is the module name of the class that this is an
+ % instance declaration for, but we don't necessarily know what module
+ % that is at this point, since the class name hasn't been fully
+ % qualified yet. So here we give the special module name "" as the
+ % default, which means that there is no default. (If the module
+ % qualifiers in the clauses don't match the module name of the class,
+ % we will pick that up later, in check_typeclass.m.)
DefaultModuleName = unqualified(""),
parse_item(DefaultModuleName, VarSet, MethodTerm, Result0),
(
Result0 = ok(Item, Context),
- Item = clause(_Origin, _VarNames, PredOrFunc,
- ClassMethodName, HeadArgs,
- _ClauseBody)
- ->
- adjust_func_arity(PredOrFunc, ArityInt,
- list__length(HeadArgs)),
- Result = ok(instance_method(PredOrFunc,
- ClassMethodName, clauses([Item]), ArityInt,
- Context))
+ Item = clause(_Origin, _VarNames, PredOrFunc, ClassMethodName,
+ HeadArgs, _ClauseBody)
+ ->
+ adjust_func_arity(PredOrFunc, ArityInt, list__length(HeadArgs)),
+ Result = ok(instance_method(PredOrFunc, ClassMethodName,
+ clauses([Item]), ArityInt, Context))
;
Result0 = error(ErrorMsg, ErrorTerm)
->
Result = error(ErrorMsg, ErrorTerm)
;
- % catch-all error message for a syntactically valid item
- % which is not a clause
+ % Catch-all error message for a syntactically valid item
+ % which is not a clause.
Result = error("expected clause or " ++
- "`pred(<Name> / <Arity>) is " ++
- "<InstanceName>' or " ++
- "`func(<Name> / <Arity>) is <InstanceName>')",
- MethodTerm)
+ "`pred(<Name> / <Arity>) is <InstanceName>' or " ++
+ "`func(<Name> / <Arity>) is <InstanceName>')", MethodTerm)
)
).
Index: compiler/prog_io_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_util.m,v
retrieving revision 1.39
diff -u -b -r1.39 prog_io_util.m
--- compiler/prog_io_util.m 12 Sep 2005 08:20:27 -0000 1.39
+++ compiler/prog_io_util.m 17 Oct 2005 15:15:31 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1996-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -40,7 +42,8 @@
; ok(T1, T2, T3).
:- type maybe1(T) == maybe1(T, generic).
-:- type maybe1(T, U) ---> error(string, term(U))
+:- type maybe1(T, U)
+ ---> error(string, term(U))
; ok(T).
:- type maybe_functor == maybe_functor(generic).
@@ -49,8 +52,7 @@
% ok(SymName, Args - MaybeFuncRetArg) ; error(Msg, Term).
:- type maybe_pred_or_func(T) == maybe2(sym_name, pair(list(T), maybe(T))).
-:- type maybe_item_and_context
- == maybe2(item, prog_context).
+:- type maybe_item_and_context == maybe2(item, prog_context).
:- type var2tvar == map(var, tvar).
@@ -62,10 +64,8 @@
:- pred add_context(maybe1(item)::in, prog_context::in,
maybe_item_and_context::out) is det.
-%
% Various predicates to parse small bits of syntax.
% These predicates simply fail if they encounter a syntax error.
-%
:- pred parse_list_of_vars(term(T)::in, list(var(T))::out) is semidet.
@@ -80,11 +80,12 @@
:- pred parse_vars(term(T)::in, list(var(T))::out) is semidet.
% parse_vars_and_state_vars(Term, OrdinaryVars, DotStateVars,
- % ColonStateVars).
+ % ColonStateVars):
+ %
% Similar to parse_vars, but also allow state variables to appear
- % in the list. The outputs separate the parsed variables into
- % ordinary variables, state variables listed as !.X, and state
- % variables listed as !:X.
+ % in the list. The outputs separate the parsed variables into ordinary
+ % variables, state variables listed as !.X, and state variables
+ % listed as !:X.
%
:- pred parse_vars_and_state_vars(term(T)::in, list(var(T))::out,
list(var(T))::out, list(var(T))::out) is semidet.
@@ -133,27 +134,27 @@
:- pred standard_det(string::in, determinism::out) is semidet.
- % convert a "disjunction" (bunch of terms separated by ';'s) to a list
-
+ % Convert a "disjunction" (bunch of terms separated by ';'s) to a list.
+ %
:- pred disjunction_to_list(term(T)::in, list(term(T))::out) is det.
- % convert a "conjunction" (bunch of terms separated by ','s) to a list
-
+ % Convert a "conjunction" (bunch of terms separated by ','s) to a list.
+ %
:- pred conjunction_to_list(term(T)::in, list(term(T))::out) is det.
- % list_to_conjunction(Context, First, Rest, Term).
- % convert a list to a "conjunction" (bunch of terms separated by ','s)
-
+ % list_to_conjunction(Context, First, Rest, Term):
+ % Convert a list to a "conjunction" (bunch of terms separated by ','s).
+ %
:- pred list_to_conjunction(prog_context::in, term(T)::in, list(term(T))::in,
term(T)::out) is det.
- % convert a "sum" (bunch of terms separated by '+' operators) to a list
-
+ % Convert a "sum" (bunch of terms separated by '+' operators) to a list.
+ %
:- pred sum_to_list(term(T)::in, list(term(T))::out) is det.
- % Parse a comma-separated list (misleading described as
- % a "conjunction") of things.
-
+ % Parse a comma-separated list (misleading described as a "conjunction")
+ % of things.
+ %
:- pred parse_list(parser(T)::parser, term::in, maybe1(list(T))::out) is det.
:- pred map_parser(parser(T)::parser, list(term)::in, maybe1(list(T))::out)
@@ -195,8 +196,7 @@
parse_pred_or_func_name_and_arity(ModuleName, PorFPredAndArityTerm,
PredOrFunc, SymName, Arity) :-
- PorFPredAndArityTerm = term__functor(term__atom(PredOrFuncStr),
- Args, _),
+ PorFPredAndArityTerm = term__functor(term__atom(PredOrFuncStr), Args, _),
( PredOrFuncStr = "pred", PredOrFunc = predicate
; PredOrFuncStr = "func", PredOrFunc = function
),
@@ -250,14 +250,13 @@
).
parse_list_of_vars(term__functor(term__atom("[]"), [], _), []).
-parse_list_of_vars(term__functor(term__atom("[|]"),
- [Head, Tail], _), [V | Vs]) :-
+parse_list_of_vars(term__functor(term__atom("[|]"), [Head, Tail], _),
+ [V | Vs]) :-
Head = term__variable(V),
parse_list_of_vars(Tail, Vs).
- % XXX kind inference:
- % We currently give all types kind `star'. This will be different
- % when we have a kind system.
+ % XXX kind inference: We currently give all types kind `star'.
+ % This will be different when we have a kind system.
%
parse_type(Term, Result) :-
(
@@ -270,8 +269,7 @@
->
Result = ok(builtin(BuiltinType))
;
- parse_higher_order_type(Term, HOArgs, MaybeRet, Purity,
- EvalMethod)
+ parse_higher_order_type(Term, HOArgs, MaybeRet, Purity, EvalMethod)
->
Result = ok(higher_order(HOArgs, MaybeRet, Purity, EvalMethod))
;
@@ -286,19 +284,14 @@
Result = error(Msg, ErrorTerm)
)
;
- %
% We don't support apply/N types yet, so we just detect them
% and report an error message.
- %
Term = term__functor(term__atom(""), _, _)
->
Result = error("ill-formed type", Term)
;
- %
% We don't support kind annotations yet, and we don't report
% an error either. Perhaps we should?
- %
-
parse_qualified_term(Term, Term, "type", NameResult),
(
NameResult = ok(SymName, ArgTerms),
@@ -340,10 +333,9 @@
Term = term__functor(term__atom(Name), [], _),
builtin_type_to_string(BuiltinType, Name).
- % If there are any ill-formed types in the argument then we just
- % fail. The predicate parse_type will then try to parse the term
- % as an ordinary defined type and will produce the required error
- % message.
+ % If there are any ill-formed types in the argument then we just fail.
+ % The predicate parse_type will then try to parse the term as an ordinary
+ % defined type and will produce the required error message.
%
:- pred parse_higher_order_type(term::in, list(type)::out, maybe(type)::out,
purity::out, lambda_eval_method::out) is semidet.
@@ -351,8 +343,7 @@
parse_higher_order_type(Term0, ArgTypes, MaybeRet, Purity, EvalMethod) :-
parse_purity_annotation(Term0, Purity, Term1),
( Term1 = term__functor(term__atom("="), [FuncAndArgs0, Ret], _) ->
- parse_lambda_eval_method(FuncAndArgs0, EvalMethod,
- FuncAndArgs),
+ parse_lambda_eval_method(FuncAndArgs0, EvalMethod, FuncAndArgs),
FuncAndArgs = term__functor(term__atom("func"), Args, _),
parse_type(Ret, ok(RetType)),
MaybeRet = yes(RetType)
@@ -392,8 +383,7 @@
Term0 = term__functor(term__atom("func"), ArgTerms, Context),
maybe_add_lambda_eval_method(EvalMethod, Term0, Term1),
unparse_type(Ret, RetTerm),
- Term2 = term__functor(term__atom("="), [Term1, RetTerm],
- Context)
+ Term2 = term__functor(term__atom("="), [Term1, RetTerm], Context)
;
MaybeRet = no,
Term0 = term__functor(term__atom("pred"), ArgTerms, Context),
@@ -473,8 +463,7 @@
->
DetTerm = term__functor(term__atom(DetString), [], _),
standard_det(DetString, Detism),
- convert_mode_list(AllowConstrainedInstVar, ArgModesTerms,
- ArgModes),
+ convert_mode_list(AllowConstrainedInstVar, ArgModesTerms, ArgModes),
PredInstInfo = pred_inst_info(predicate, ArgModes, Detism),
Inst = ground(shared, higher_order(PredInstInfo)),
Mode = (Inst -> Inst)
@@ -488,14 +477,12 @@
% )
Term = term__functor(term__atom("is"), [EqTerm, DetTerm], _),
- EqTerm = term__functor(term__atom("="),
- [FuncTerm, RetModeTerm], _),
+ EqTerm = term__functor(term__atom("="), [FuncTerm, RetModeTerm], _),
FuncTerm = term__functor(term__atom("func"), ArgModesTerms, _)
->
DetTerm = term__functor(term__atom(DetString), [], _),
standard_det(DetString, Detism),
- convert_mode_list(AllowConstrainedInstVar, ArgModesTerms,
- ArgModes0),
+ convert_mode_list(AllowConstrainedInstVar, ArgModesTerms, ArgModes0),
convert_mode(AllowConstrainedInstVar, RetModeTerm, RetMode),
list__append(ArgModes0, [RetMode], ArgModes),
FuncInstInfo = pred_inst_info(function, ArgModes, Detism),
@@ -534,12 +521,10 @@
->
DetTerm = term__functor(term__atom(DetString), [], _),
standard_det(DetString, Detism),
- convert_mode_list(AllowConstrainedInstVar, ArgModesTerm,
- ArgModes),
+ convert_mode_list(AllowConstrainedInstVar, ArgModesTerm, ArgModes),
PredInst = pred_inst_info(predicate, ArgModes, Detism),
Result = ground(shared, higher_order(PredInst))
;
-
% The syntax for a higher-order func inst is
%
% func(<Mode1>, <Mode2>, ...) = <RetMode> is <Detism>
@@ -548,34 +533,28 @@
% <RetMode> is a mode, and <Detism> is a determinism.
Name = "is", Args0 = [EqTerm, DetTerm],
- EqTerm = term__functor(term__atom("="),
- [FuncTerm, RetModeTerm], _),
+ EqTerm = term__functor(term__atom("="), [FuncTerm, RetModeTerm], _),
FuncTerm = term__functor(term__atom("func"), ArgModesTerm, _)
->
DetTerm = term__functor(term__atom(DetString), [], _),
standard_det(DetString, Detism),
- convert_mode_list(AllowConstrainedInstVar, ArgModesTerm,
- ArgModes0),
+ convert_mode_list(AllowConstrainedInstVar, ArgModesTerm, ArgModes0),
convert_mode(AllowConstrainedInstVar, RetModeTerm, RetMode),
list__append(ArgModes0, [RetMode], ArgModes),
FuncInst = pred_inst_info(function, ArgModes, Detism),
Result = ground(shared, higher_order(FuncInst))
- % `bound' insts
; Name = "bound", Args0 = [Disj] ->
- parse_bound_inst_list(AllowConstrainedInstVar, Disj, shared,
- Result)
- % `bound_unique' is for backwards compatibility
- % - use `unique' instead
+ % `bound' insts
+ parse_bound_inst_list(AllowConstrainedInstVar, Disj, shared, Result)
; Name = "bound_unique", Args0 = [Disj] ->
- parse_bound_inst_list(AllowConstrainedInstVar, Disj, unique,
- Result)
+ % `bound_unique' is for backwards compatibility - use `unique' instead.
+ parse_bound_inst_list(AllowConstrainedInstVar, Disj, unique, Result)
; Name = "unique", Args0 = [Disj] ->
- parse_bound_inst_list(AllowConstrainedInstVar, Disj, unique,
- Result)
+ parse_bound_inst_list(AllowConstrainedInstVar, Disj, unique, Result)
; Name = "mostly_unique", Args0 = [Disj] ->
- parse_bound_inst_list(AllowConstrainedInstVar, Disj,
- mostly_unique, Result)
+ parse_bound_inst_list(AllowConstrainedInstVar, Disj, mostly_unique,
+ Result)
; Name = "=<", Args0 = [VarTerm, InstTerm] ->
AllowConstrainedInstVar = allow_constrained_inst_var,
VarTerm = term__variable(Var),
@@ -583,10 +562,9 @@
convert_inst(no_allow_constrained_inst_var, InstTerm, Inst),
Result = constrained_inst_vars(set__make_singleton_set(
term__coerce_var(Var)), Inst)
- % anything else must be a user-defined inst
;
- parse_qualified_term(Term, Term, "inst",
- ok(QualifiedName, Args1)),
+ % Anything else must be a user-defined inst.
+ parse_qualified_term(Term, Term, "inst", ok(QualifiedName, Args1)),
(
mercury_public_builtin_module(BuiltinModule),
sym_name_get_module_name(QualifiedName, unqualified(""),
@@ -595,8 +573,7 @@
% then it may be one of the simple builtin insts.
% We call convert_inst recursively to check for this.
unqualify_name(QualifiedName, UnqualifiedName),
- convert_simple_builtin_inst(UnqualifiedName, Args1,
- Result0),
+ convert_simple_builtin_inst(UnqualifiedName, Args1, Result0),
% However, if the inst is a user_inst defined inside
% the `builtin' module then we need to make sure it is
@@ -612,6 +589,7 @@
% A "simple" builtin inst is one that has no arguments and no special
% syntax.
+ %
:- pred convert_simple_builtin_inst(string::in, list(term)::in, (inst)::out)
is semidet.
@@ -659,7 +637,7 @@
disjunction_to_list(Disj, List),
convert_bound_inst_list(AllowConstrainedInstVar, List, Functors0),
list__sort(Functors0, Functors),
- % check that the list doesn't specify the same functor twice
+ % Check that the list doesn't specify the same functor twice.
\+ (
list__append(_, SubList, Functors),
SubList = [F1, F2 | _],
@@ -681,8 +659,7 @@
convert_bound_inst(AllowConstrainedInstVar, InstTerm, functor(ConsId, Args)) :-
InstTerm = term__functor(Functor, Args0, _),
( Functor = term__atom(_) ->
- parse_qualified_term(InstTerm, InstTerm, "inst",
- ok(SymName, Args1)),
+ parse_qualified_term(InstTerm, InstTerm, "inst", ok(SymName, Args1)),
list__length(Args1, Arity),
ConsId = cons(SymName, Arity)
;
@@ -718,9 +695,7 @@
list(term(T))::out) is det.
binop_term_to_list_2(Op, Term, !List) :-
- (
- Term = term__functor(term__atom(Op), [L, R], _Context)
- ->
+ ( Term = term__functor(term__atom(Op), [L, R], _Context) ->
binop_term_to_list_2(Op, R, !List),
binop_term_to_list_2(Op, L, !List)
;
@@ -739,6 +714,7 @@
% If a list of things contains multiple errors, then we only
% report the first one.
+ %
:- pred combine_list_results(maybe1(T)::in, maybe1(list(T))::in,
maybe1(list(T))::out) is det.
Index: compiler/prog_mode.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_mode.m,v
retrieving revision 1.7
diff -u -b -r1.7 prog_mode.m
--- compiler/prog_mode.m 29 Aug 2005 03:22:26 -0000 1.7
+++ compiler/prog_mode.m 17 Oct 2005 15:09:16 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 2004-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -17,8 +19,8 @@
:- import_module list.
- % Construct a mode corresponding to the standard
- % `in', `out', `uo' or `unused' mode.
+ % Construct a mode corresponding to the standard `in', `out', `uo'
+ % or `unused' mode.
%
:- pred in_mode((mode)::out) is det.
:- func in_mode = (mode).
@@ -53,10 +55,9 @@
%-----------------------------------------------------------------------------%
- % mode_substitute_arg_list(Mode0, Params, Args, Mode) is true
- % iff Mode is the mode that results from substituting all
- % occurrences of Params in Mode0 with the corresponding
- % value in Args.
+ % mode_substitute_arg_list(Mode0, Params, Args, Mode) is true iff Mode is
+ % the mode that results from substituting all occurrences of Params
+ % in Mode0 with the corresponding value in Args.
%
:- pred mode_substitute_arg_list((mode)::in, list(inst_var)::in,
list(inst)::in, (mode)::out) is det.
@@ -73,25 +74,24 @@
%-----------------------------------------------------------------------------%
- % inst_substitute_arg_list(Inst0, Params, Args, Inst) is true
- % iff Inst is the inst that results from substituting all
- % occurrences of Params in Inst0 with the corresponding
- % value in Args.
+ % inst_substitute_arg_list(Params, Args, Inst0, Inst) is true iff Inst
+ % is the inst that results from substituting all occurrences of Params
+ % in Inst0 with the corresponding value in Args.
%
-:- pred inst_substitute_arg_list((inst)::in, list(inst_var)::in,
- list(inst)::in, (inst)::out) is det.
+:- pred inst_substitute_arg_list(list(inst_var)::in, list(inst)::in,
+ (inst)::in, (inst)::out) is det.
- % inst_list_apply_substitution(Insts0, Subst, Insts) is true
+ % inst_list_apply_substitution(Subst, Insts0, Insts) is true
% iff Inst is the inst that results from applying Subst to Insts0.
%
-:- pred inst_list_apply_substitution(list(inst)::in, inst_var_sub::in,
- list(inst)::out) is det.
+:- pred inst_list_apply_substitution(inst_var_sub::in,
+ list(inst)::in, list(inst)::out) is det.
- % mode_list_apply_substitution(Modes0, Subst, Modes) is true
+ % mode_list_apply_substitution(Subst, Modes0, Modes) is true
% iff Mode is the mode that results from applying Subst to Modes0.
%
-:- pred mode_list_apply_substitution(list(mode)::in, inst_var_sub::in,
- list(mode)::out) is det.
+:- pred mode_list_apply_substitution(inst_var_sub::in,
+ list(mode)::in, list(mode)::out) is det.
:- pred rename_apart_inst_vars(inst_varset::in, inst_varset::in,
list(mode)::in, list(mode)::out) is det.
@@ -117,7 +117,7 @@
:- pred mode_id_to_int(mode_id::in, int::out) is det.
% Predicates to make error messages more readable by stripping
- % "builtin:" module qualifiers from modes.
+ % "builtin." module qualifiers from modes.
%
:- pred strip_builtin_qualifier_from_cons_id(cons_id::in, cons_id::out) is det.
@@ -177,21 +177,20 @@
%-----------------------------------------------------------------------------%
-inst_lists_to_mode_list([], [_|_], _) :-
+inst_lists_to_mode_list([], [_ | _], _) :-
error("inst_lists_to_mode_list: length mis-match").
-inst_lists_to_mode_list([_|_], [], _) :-
+inst_lists_to_mode_list([_ | _], [], _) :-
error("inst_lists_to_mode_list: length mis-match").
inst_lists_to_mode_list([], [], []).
-inst_lists_to_mode_list([Initial|Initials], [Final|Finals], [Mode|Modes]) :-
+inst_lists_to_mode_list([Initial | Initials], [Final | Finals],
+ [Mode | Modes]) :-
insts_to_mode(Initial, Final, Mode),
inst_lists_to_mode_list(Initials, Finals, Modes).
insts_to_mode(Initial, Final, Mode) :-
- %
% Use some abbreviations.
- % This is just to make error messages and inferred modes
- % more readable.
- %
+ % This is just to make error messages and inferred modes more readable.
+
( Initial = free, Final = ground(shared, none) ->
make_std_mode("out", [], Mode)
; Initial = free, Final = ground(unique, none) ->
@@ -223,147 +222,147 @@
%-----------------------------------------------------------------------------%
mode_substitute_arg_list(Mode0, Params, Args, Mode) :-
- ( Params = [] ->
+ (
+ Params = [],
Mode = Mode0 % optimize common case
;
+ Params = [_ | _],
map__from_corresponding_lists(Params, Args, Subst),
- mode_apply_substitution(Mode0, Subst, Mode)
+ mode_apply_substitution(Subst, Mode0, Mode)
).
-inst_substitute_arg_list(Inst0, Params, Args, Inst) :-
- ( Params = [] ->
+inst_substitute_arg_list(Params, Args, Inst0, Inst) :-
+ (
+ Params = [],
Inst = Inst0 % optimize common case
;
+ Params = [_ | _],
map__from_corresponding_lists(Params, Args, Subst),
- inst_apply_substitution(Inst0, Subst, Inst)
+ inst_apply_substitution(Subst, Inst0, Inst)
).
% mode_apply_substitution(Mode0, Subst, Mode) is true iff
% Mode is the mode that results from apply Subst to Mode0.
-
-:- pred mode_apply_substitution((mode)::in, inst_var_sub::in, (mode)::out)
+ %
+:- pred mode_apply_substitution(inst_var_sub::in, (mode)::in, (mode)::out)
is det.
-mode_apply_substitution((I0 -> F0), Subst, (I -> F)) :-
- inst_apply_substitution(I0, Subst, I),
- inst_apply_substitution(F0, Subst, F).
-mode_apply_substitution(user_defined_mode(Name, Args0), Subst,
+mode_apply_substitution(Subst, (I0 -> F0), (I -> F)) :-
+ inst_apply_substitution(Subst, I0, I),
+ inst_apply_substitution(Subst, F0, F).
+mode_apply_substitution(Subst, user_defined_mode(Name, Args0),
user_defined_mode(Name, Args)) :-
- inst_list_apply_substitution_2(Args0, Subst, Args).
+ inst_list_apply_substitution_2(Subst, Args0, Args).
-inst_list_apply_substitution(Insts0, Subst, Insts) :-
+inst_list_apply_substitution(Subst, Insts0, Insts) :-
( map__is_empty(Subst) ->
Insts = Insts0
;
- inst_list_apply_substitution_2(Insts0, Subst, Insts)
+ inst_list_apply_substitution_2(Subst, Insts0, Insts)
).
-:- pred inst_list_apply_substitution_2(list(inst)::in, inst_var_sub::in,
- list(inst)::out) is det.
+:- pred inst_list_apply_substitution_2(inst_var_sub::in,
+ list(inst)::in, list(inst)::out) is det.
-inst_list_apply_substitution_2([], _, []).
-inst_list_apply_substitution_2([A0 | As0], Subst, [A | As]) :-
- inst_apply_substitution(A0, Subst, A),
- inst_list_apply_substitution_2(As0, Subst, As).
-
- % inst_substitute_arg(Inst0, Subst, Inst) is true
- % iff Inst is the inst that results from substituting all
- % occurrences of Param in Inst0 with Arg.
+inst_list_apply_substitution_2(_, [], []).
+inst_list_apply_substitution_2(Subst, [A0 | As0], [A | As]) :-
+ inst_apply_substitution(Subst, A0, A),
+ inst_list_apply_substitution_2(Subst, As0, As).
-:- pred inst_apply_substitution((inst)::in, inst_var_sub::in, (inst)::out)
+ % inst_substitute_arg(Inst0, Subst, Inst) is true iff Inst is the inst that
+ % results from substituting all occurrences of Param in Inst0 with Arg.
+ %
+:- pred inst_apply_substitution(inst_var_sub::in, (inst)::in, (inst)::out)
is det.
-inst_apply_substitution(any(Uniq), _, any(Uniq)).
-inst_apply_substitution(free, _, free).
-inst_apply_substitution(free(T), _, free(T)).
-inst_apply_substitution(ground(Uniq, GroundInstInfo0), Subst, Inst) :-
- ground_inst_info_apply_substitution(GroundInstInfo0, Subst, Uniq, Inst).
-inst_apply_substitution(bound(Uniq, Alts0), Subst, bound(Uniq, Alts)) :-
- alt_list_apply_substitution(Alts0, Subst, Alts).
-inst_apply_substitution(not_reached, _, not_reached).
-inst_apply_substitution(inst_var(Var), Subst, Result) :-
- (
- map__search(Subst, Var, Replacement)
- ->
+inst_apply_substitution(_, any(Uniq), any(Uniq)).
+inst_apply_substitution(_, free, free).
+inst_apply_substitution(_, free(T), free(T)).
+inst_apply_substitution(Subst, ground(Uniq, GroundInstInfo0), Inst) :-
+ ground_inst_info_apply_substitution(Subst, Uniq, GroundInstInfo0, Inst).
+inst_apply_substitution(Subst, bound(Uniq, Alts0), bound(Uniq, Alts)) :-
+ alt_list_apply_substitution(Subst, Alts0, Alts).
+inst_apply_substitution(_, not_reached, not_reached).
+inst_apply_substitution(Subst, inst_var(Var), Result) :-
+ ( map__search(Subst, Var, Replacement) ->
Result = Replacement
;
Result = inst_var(Var)
).
-inst_apply_substitution(constrained_inst_vars(Vars, Inst0), Subst, Result) :-
+inst_apply_substitution(Subst, constrained_inst_vars(Vars, Inst0), Result) :-
( set__singleton_set(Vars, Var0) ->
Var = Var0
;
error("inst_apply_substitution: multiple inst_vars found")
),
- (
- map__search(Subst, Var, Replacement)
- ->
+ ( map__search(Subst, Var, Replacement) ->
Result = Replacement
% XXX Should probably have a sanity check here that
% Replacement =< Inst0
;
- inst_apply_substitution(Inst0, Subst, Result0),
+ inst_apply_substitution(Subst, Inst0, Result0),
Result = constrained_inst_vars(Vars, Result0)
).
-inst_apply_substitution(defined_inst(InstName0), Subst,
+inst_apply_substitution(Subst, defined_inst(InstName0),
defined_inst(InstName)) :-
- ( inst_name_apply_substitution(InstName0, Subst, InstName1) ->
+ ( inst_name_apply_substitution(Subst, InstName0, InstName1) ->
InstName = InstName1
;
InstName = InstName0
).
-inst_apply_substitution(abstract_inst(Name, Args0), Subst,
+inst_apply_substitution(Subst, abstract_inst(Name, Args0),
abstract_inst(Name, Args)) :-
- inst_list_apply_substitution_2(Args0, Subst, Args).
+ inst_list_apply_substitution_2(Subst, Args0, Args).
% This predicate fails if the inst_name is not one of user_inst,
- % typed_inst or typed_ground. The other types of inst_names are just
- % used as keys in the inst_table so it does not make sense to apply
+ % typed_inst or typed_ground. The other types of inst_names are just used
+ % as keys in the inst_table so it does not make sense to apply
% substitutions to them.
-:- pred inst_name_apply_substitution(inst_name::in, inst_var_sub::in,
- inst_name::out) is semidet.
+ %
+:- pred inst_name_apply_substitution(inst_var_sub::in,
+ inst_name::in, inst_name::out) is semidet.
-inst_name_apply_substitution(user_inst(Name, Args0), Subst,
+inst_name_apply_substitution(Subst, user_inst(Name, Args0),
user_inst(Name, Args)) :-
- inst_list_apply_substitution_2(Args0, Subst, Args).
-inst_name_apply_substitution(typed_inst(T, Inst0), Subst,
+ inst_list_apply_substitution_2(Subst, Args0, Args).
+inst_name_apply_substitution(Subst, typed_inst(T, Inst0),
typed_inst(T, Inst)) :-
- inst_name_apply_substitution(Inst0, Subst, Inst).
-inst_name_apply_substitution(typed_ground(Uniq, T), _, typed_ground(Uniq, T)).
+ inst_name_apply_substitution(Subst, Inst0, Inst).
+inst_name_apply_substitution(_, typed_ground(Uniq, T), typed_ground(Uniq, T)).
-:- pred alt_list_apply_substitution(list(bound_inst)::in, inst_var_sub::in,
- list(bound_inst)::out) is det.
+:- pred alt_list_apply_substitution(inst_var_sub::in,
+ list(bound_inst)::in, list(bound_inst)::out) is det.
-alt_list_apply_substitution([], _, []).
-alt_list_apply_substitution([Alt0|Alts0], Subst, [Alt|Alts]) :-
+alt_list_apply_substitution(_, [], []).
+alt_list_apply_substitution(Subst, [Alt0 | Alts0], [Alt | Alts]) :-
Alt0 = functor(Name, Args0),
- inst_list_apply_substitution_2(Args0, Subst, Args),
+ inst_list_apply_substitution_2(Subst, Args0, Args),
Alt = functor(Name, Args),
- alt_list_apply_substitution(Alts0, Subst, Alts).
+ alt_list_apply_substitution(Subst, Alts0, Alts).
-:- pred ground_inst_info_apply_substitution(ground_inst_info::in,
- inst_var_sub::in, uniqueness::in, (inst)::out) is det.
+:- pred ground_inst_info_apply_substitution(inst_var_sub::in, uniqueness::in,
+ ground_inst_info::in, (inst)::out) is det.
-ground_inst_info_apply_substitution(none, _, Uniq, ground(Uniq, none)).
-ground_inst_info_apply_substitution(GII0, Subst, Uniq, ground(Uniq, GII)) :-
+ground_inst_info_apply_substitution(_, Uniq, none, ground(Uniq, none)).
+ground_inst_info_apply_substitution(Subst, Uniq, GII0, ground(Uniq, GII)) :-
GII0 = higher_order(pred_inst_info(PredOrFunc, Modes0, Det)),
- mode_list_apply_substitution(Modes0, Subst, Modes),
+ mode_list_apply_substitution(Subst, Modes0, Modes),
GII = higher_order(pred_inst_info(PredOrFunc, Modes, Det)).
-mode_list_apply_substitution(Modes0, Subst, Modes) :-
+mode_list_apply_substitution(Subst, Modes0, Modes) :-
( map__is_empty(Subst) ->
Modes = Modes0
;
- mode_list_apply_substitution_2(Modes0, Subst, Modes)
+ mode_list_apply_substitution_2(Subst, Modes0, Modes)
).
-:- pred mode_list_apply_substitution_2(list(mode)::in, inst_var_sub::in,
- list(mode)::out) is det.
+:- pred mode_list_apply_substitution_2(inst_var_sub::in,
+ list(mode)::in, list(mode)::out) is det.
-mode_list_apply_substitution_2([], _, []).
-mode_list_apply_substitution_2([A0 | As0], Subst, [A | As]) :-
- mode_apply_substitution(A0, Subst, A),
- mode_list_apply_substitution_2(As0, Subst, As).
+mode_list_apply_substitution_2(_, [], []).
+mode_list_apply_substitution_2(Subst, [A0 | As0], [A | As]) :-
+ mode_apply_substitution(Subst, A0, A),
+ mode_list_apply_substitution_2(Subst, As0, As).
%-----------------------------------------------------------------------------%
@@ -512,7 +511,7 @@
( get_arg_insts_2(List, ConsId, ArgInsts0) ->
ArgInsts = ArgInsts0
;
- % the code is unreachable
+ % The code is unreachable.
list__duplicate(Arity, not_reached, ArgInsts)
).
get_arg_insts(free, _ConsId, Arity, ArgInsts) :-
@@ -532,20 +531,13 @@
get_arg_insts_2(BoundInsts, ConsId, ArgInsts)
).
- % In case we later decided to change the representation
- % of mode_ids.
-
+ % In case we later decided to change the representation of mode_ids.
mode_id_to_int(_ - X, X).
%-----------------------------------------------------------------------------%
- %
- % Predicates to make error messages more readable by stripping
- % "builtin:" module qualifiers from modes and insts.
% The interesting part is strip_builtin_qualifier_from_sym_name;
% the rest is basically just recursive traversals.
- %
-
strip_builtin_qualifiers_from_mode_list(Modes0, Modes) :-
list__map(strip_builtin_qualifiers_from_mode, Modes0, Modes).
@@ -612,6 +604,7 @@
:- pred strip_builtin_qualifiers_from_bound_inst(bound_inst::in,
bound_inst::out) is det.
+
strip_builtin_qualifiers_from_bound_inst(BoundInst0, BoundInst) :-
BoundInst0 = functor(ConsId0, Insts0),
strip_builtin_qualifier_from_cons_id(ConsId0, ConsId),
Index: compiler/prog_mutable.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_mutable.m,v
retrieving revision 1.3
diff -u -b -r1.3 prog_mutable.m
--- compiler/prog_mutable.m 6 Oct 2005 08:26:10 -0000 1.3
+++ compiler/prog_mutable.m 17 Oct 2005 15:57:06 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -53,7 +55,6 @@
%
:- func get_global_foreign_defn(string) = item.
-
:- func mutable_get_pred_sym_name(sym_name, string) = sym_name.
:- func mutable_set_pred_sym_name(sym_name, string) = sym_name.
@@ -105,11 +106,9 @@
Constraints = constraints([], []),
GetPredDecl = pred_or_func(VarSet, InstVarSet, ExistQVars, predicate,
mutable_get_pred_sym_name(ModuleName, Name),
- [
- type_and_mode(Type, out_mode(Inst)),
+ [type_and_mode(Type, out_mode(Inst)),
type_and_mode(io_state_type, di_mode),
- type_and_mode(io_state_type, uo_mode)
- ],
+ type_and_mode(io_state_type, uo_mode)],
no /* with_type */, no /* with_inst */, yes(det),
true /* condition */, pure, Constraints).
@@ -120,11 +119,9 @@
Constraints = constraints([], []),
SetPredDecl = pred_or_func(VarSet, InstVarSet, ExistQVars, predicate,
mutable_set_pred_sym_name(ModuleName, Name),
- [
- type_and_mode(Type, in_mode(Inst)),
+ [type_and_mode(Type, in_mode(Inst)),
type_and_mode(io_state_type, di_mode),
- type_and_mode(io_state_type, uo_mode)
- ],
+ type_and_mode(io_state_type, uo_mode)],
no /* with_type */, no /* with_inst */, yes(det),
true /* condition */, pure, Constraints).
Index: compiler/prog_rep.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_rep.m,v
retrieving revision 1.37
diff -u -b -r1.37 prog_rep.m
--- compiler/prog_rep.m 13 Sep 2005 04:04:06 -0000 1.37
+++ compiler/prog_rep.m 17 Oct 2005 14:44:58 -0000
@@ -1,4 +1,6 @@
%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
% Copyright (C) 2000-2005 University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -29,19 +31,18 @@
:- import_module map.
:- import_module std_util.
-% A var_num_map maps each variable that occurs in any of a procedure's layout
-% structures to a number that uniquely identifies that variable, and to its
-% name.
-%
-% The integer returned by term__var_to_int are a dense set when we consider
-% all the original variables of a procedure. However, it can become less dense
-% when an optimization removes all references to a variable, and becomes less
-% dense still when we consider only variables that occur in a layout structure.
-% This is why we allocate our own id numbers.
-
+ % A var_num_map maps each variable that occurs in any of a procedure's
+ % layout structures to a number that uniquely identifies that variable,
+ % and to its name.
+ %
+ % The integer returned by term__var_to_int are a dense set when we consider
+ % all the original variables of a procedure. However, it can become less
+ % dense when an optimization removes all references to a variable, and
+ % becomes less dense still when we consider only variables that occur
+ % in a layout structure. This is why we allocate our own id numbers.
:- type var_num_map == map(prog_var, pair(int, string)).
-:- pred prog_rep__represent_proc(list(prog_var)::in, hlds_goal::in,
+:- pred represent_proc(list(prog_var)::in, hlds_goal::in,
instmap::in, vartypes::in, var_num_map::in, module_info::in,
stack_layout_info::in, stack_layout_info::out, list(int)::out) is det.
@@ -67,7 +68,7 @@
:- import_module string.
:- import_module term.
-:- type prog_rep__info
+:- type prog_rep_info
---> info(
filename :: string,
vartypes :: vartypes,
@@ -76,15 +77,13 @@
module_info :: module_info
).
-prog_rep__represent_proc(HeadVars, Goal, InstMap0, VarTypes, VarNumMap,
+represent_proc(HeadVars, Goal, InstMap0, VarTypes, VarNumMap,
ModuleInfo, !StackInfo, ProcRepBytes) :-
Goal = _ - GoalInfo,
goal_info_get_context(GoalInfo, Context),
term__context_file(Context, FileName),
MaxVarNum = map.foldl(max_var_num, VarNumMap, 0),
- (
- MaxVarNum =< 255
- ->
+ ( MaxVarNum =< 255 ->
VarNumRep = byte
;
VarNumRep = short
@@ -95,8 +94,7 @@
string_to_byte_list(FileName, !StackInfo, FileNameBytes),
goal_to_byte_list(Goal, InstMap0, Info, !StackInfo, GoalBytes),
ProcRepBytes0 = [VarNumRepByte] ++ FileNameBytes ++
- vars_to_byte_list(Info, HeadVars) ++
- GoalBytes,
+ vars_to_byte_list(Info, HeadVars) ++ GoalBytes,
int32_to_byte_list(list__length(ProcRepBytes0) + 4, LimitBytes),
ProcRepBytes = LimitBytes ++ ProcRepBytes0.
@@ -105,9 +103,7 @@
:- func max_var_num(prog_var, pair(int, string), int) = int.
max_var_num(_, VarNum1 - _, VarNum2) = Max :-
- (
- VarNum1 > VarNum2
- ->
+ ( VarNum1 > VarNum2 ->
Max = VarNum1
;
Max = VarNum2
@@ -115,7 +111,7 @@
%---------------------------------------------------------------------------%
-:- pred goal_to_byte_list(hlds_goal::in, instmap::in, prog_rep__info::in,
+:- pred goal_to_byte_list(hlds_goal::in, instmap::in, prog_rep_info::in,
stack_layout_info::in, stack_layout_info::out, list(int)::out) is det.
goal_to_byte_list(GoalExpr - GoalInfo, InstMap0, Info, !StackInfo, Bytes) :-
@@ -123,7 +119,7 @@
Bytes).
:- pred goal_expr_to_byte_list(hlds_goal_expr::in, hlds_goal_info::in,
- instmap::in, prog_rep__info::in,
+ instmap::in, prog_rep_info::in,
stack_layout_info::in, stack_layout_info::out, list(int)::out) is det.
goal_expr_to_byte_list(conj(Goals), _, InstMap0, Info, !StackInfo, Bytes) :-
@@ -288,22 +284,22 @@
% these should have been expanded out by now
error("goal_expr_to_byte_list: unexpected shorthand").
-:- pred lhs_final_is_ground(prog_rep__info::in, uni_mode::in) is semidet.
+:- pred lhs_final_is_ground(prog_rep_info::in, uni_mode::in) is semidet.
lhs_final_is_ground(Info, (_ - _) -> (LHSFinalInst - _)) :-
inst_is_ground(Info ^ module_info, LHSFinalInst).
-:- pred rhs_is_input(prog_rep__info::in, uni_mode::in) is semidet.
+:- pred rhs_is_input(prog_rep_info::in, uni_mode::in) is semidet.
rhs_is_input(Info, (_ - RHSInitialInst) -> (_ - RHSFinalInst)) :-
mode_is_input(Info ^ module_info, RHSInitialInst -> RHSFinalInst).
-:- pred filter_input_args(prog_rep__info::in, list(uni_mode)::in,
+:- pred filter_input_args(prog_rep_info::in, list(uni_mode)::in,
list(prog_var)::in, list(maybe(prog_var))::out) is det.
filter_input_args(_, [], [], []).
-filter_input_args(Info, [Mode | Modes], [Var | Vars], [MaybeVar | MaybeVars])
- :-
+filter_input_args(Info, [Mode | Modes], [Var | Vars],
+ [MaybeVar | MaybeVars]) :-
( rhs_is_input(Info, Mode) ->
MaybeVar = yes(Var)
;
@@ -317,7 +313,7 @@
%---------------------------------------------------------------------------%
:- pred atomic_goal_info_to_byte_list(hlds_goal_info::in, instmap::in,
- prog_rep__info::in, stack_layout_info::in, stack_layout_info::out,
+ prog_rep_info::in, stack_layout_info::in, stack_layout_info::out,
list(int)::out, list(prog_var)::out) is det.
atomic_goal_info_to_byte_list(GoalInfo, InstMap0, Info, !StackInfo, Bytes,
@@ -381,7 +377,7 @@
%---------------------------------------------------------------------------%
-:- pred conj_to_byte_list(hlds_goals::in, instmap::in, prog_rep__info::in,
+:- pred conj_to_byte_list(hlds_goals::in, instmap::in, prog_rep_info::in,
stack_layout_info::in, stack_layout_info::out, list(int)::out) is det.
conj_to_byte_list([], _, _, !StackInfo, []).
@@ -395,7 +391,7 @@
%---------------------------------------------------------------------------%
-:- pred disj_to_byte_list(hlds_goals::in, instmap::in, prog_rep__info::in,
+:- pred disj_to_byte_list(hlds_goals::in, instmap::in, prog_rep_info::in,
stack_layout_info::in, stack_layout_info::out, list(int)::out) is det.
disj_to_byte_list([], _, _, !StackInfo, []).
@@ -406,7 +402,7 @@
%---------------------------------------------------------------------------%
-:- pred cases_to_byte_list(list(case)::in, instmap::in, prog_rep__info::in,
+:- pred cases_to_byte_list(list(case)::in, instmap::in, prog_rep_info::in,
stack_layout_info::in, stack_layout_info::out, list(int)::out) is det.
cases_to_byte_list([], _, _, !StackInfo, []).
@@ -439,20 +435,20 @@
stack_layout__lookup_string_in_table(String, Index, !StackInfo),
int32_to_byte_list(Index, Bytes).
-:- func vars_to_byte_list(prog_rep__info, list(prog_var)) = list(int).
+:- func vars_to_byte_list(prog_rep_info, list(prog_var)) = list(int).
vars_to_byte_list(Info, Vars) =
length_to_byte_list(Vars) ++
list__condense(list__map(var_to_byte_list(Info), Vars)).
-:- func maybe_vars_to_byte_list(prog_rep__info, list(maybe(prog_var))) =
+:- func maybe_vars_to_byte_list(prog_rep_info, list(maybe(prog_var))) =
list(int).
maybe_vars_to_byte_list(Info, Vars) =
length_to_byte_list(Vars) ++
list__condense(list__map(maybe_var_to_byte_list(Info), Vars)).
-:- func var_to_byte_list(prog_rep__info, prog_var) = list(int).
+:- func var_to_byte_list(prog_rep_info, prog_var) = list(int).
var_to_byte_list(Info, Var) = Bytes :-
map__lookup(Info ^ var_num_map, Var, VarNum - _),
@@ -464,14 +460,11 @@
short_to_byte_list(VarNum, Bytes)
).
-:- func maybe_var_to_byte_list(prog_rep__info, maybe(prog_var)) = list(int).
+:- func maybe_var_to_byte_list(prog_rep_info, maybe(prog_var)) = list(int).
maybe_var_to_byte_list(Info, MaybeVar) = Bytes :-
- %
- % This is not the most efficient representation, however
- % maybe(prog_var)'s are only used for partial unifications
- % which are rare.
- %
+ % This is not the most efficient representation, however maybe(prog_var)s
+ % are only used for partial unifications which are rare.
(
MaybeVar = yes(Var),
Bytes = [1 | var_to_byte_list(Info, Var)]
Index: compiler/prog_type.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_type.m,v
retrieving revision 1.8
diff -u -b -r1.8 prog_type.m
--- compiler/prog_type.m 12 Sep 2005 05:24:22 -0000 1.8
+++ compiler/prog_type.m 17 Oct 2005 13:53:03 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -494,34 +496,29 @@
->
Type = builtin(BuiltinType)
;
- type_ctor_is_higher_order(TypeCtor, Purity, PredOrFunc,
- EvalMethod)
+ type_ctor_is_higher_order(TypeCtor, Purity, PredOrFunc, EvalMethod)
->
- construct_higher_order_type(Purity, PredOrFunc, EvalMethod,
- Args, Type)
+ construct_higher_order_type(Purity, PredOrFunc, EvalMethod, Args, Type)
;
type_ctor_is_tuple(TypeCtor)
->
- % XXX kind inference:
- % we assume the kind is star.
+ % XXX kind inference: we assume the kind is star.
Type = tuple(Args, star)
;
TypeCtor = SymName - _,
- % XXX kind inference:
- % we assume the kind is star.
+ % XXX kind inference: we assume the kind is star.
Type = defined(SymName, Args, star)
).
construct_higher_order_type(Purity, PredOrFunc, EvalMethod, ArgTypes, Type) :-
(
PredOrFunc = predicate,
- construct_higher_order_pred_type(Purity, EvalMethod, ArgTypes,
- Type)
+ construct_higher_order_pred_type(Purity, EvalMethod, ArgTypes, Type)
;
PredOrFunc = function,
pred_args_to_func_args(ArgTypes, FuncArgTypes, FuncRetType),
- construct_higher_order_func_type(Purity, EvalMethod,
- FuncArgTypes, FuncRetType, Type)
+ construct_higher_order_func_type(Purity, EvalMethod, FuncArgTypes,
+ FuncRetType, Type)
).
construct_higher_order_pred_type(Purity, EvalMethod, ArgTypes, Type) :-
@@ -813,8 +810,8 @@
apply_variable_renaming_to_prog_constraint(Renaming, !Constraint) :-
!.Constraint = constraint(ClassName, ClassArgTypes0),
- apply_variable_renaming_to_type_list(Renaming, ClassArgTypes0,
- ClassArgTypes),
+ apply_variable_renaming_to_type_list(Renaming,
+ ClassArgTypes0, ClassArgTypes),
!:Constraint = constraint(ClassName, ClassArgTypes).
constraint_list_get_tvars(Constraints, TVars) :-
Index: compiler/rat.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rat.m,v
retrieving revision 1.2
diff -u -b -r1.2 rat.m
--- compiler/rat.m 7 Apr 2005 06:32:14 -0000 1.2
+++ compiler/rat.m 17 Oct 2005 14:47:11 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1997-1998, 2003, 2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
@@ -12,9 +14,9 @@
% lp_rational module.
%
% NOTE: if you actually want a general purpose rational number type then use
-% the rational module in the standard library. The stuff in this
-% module is pretty heavily geared towards a few specific tasks that
-% are part of the termination analysis.
+% the rational module in the standard library. The stuff in this module
+% is pretty heavily geared towards a few specific tasks that are part of
+% the termination analysis.
%
% TODO:
% - overflow checking would be nice
@@ -98,7 +100,8 @@
% The rat_norm/2 function generates rationals in this
% normal form.
%
-:- type rat ---> r(int, int).
+:- type rat
+ ---> r(int, int).
'<'(X, Y) :- cmp(X, Y) = (<).
@@ -140,9 +143,10 @@
:- func rat.reciprocal(rat) = rat.
reciprocal(r(Num, Den)) =
- ( if Num = 0
- then throw("rat.reciprocal/1: division by zero")
- else r(signum(Num) * Den, int.abs(Num))
+ ( Num = 0 ->
+ throw("rat.reciprocal/1: division by zero")
+ ;
+ r(signum(Num) * Den, int.abs(Num))
).
rat.numer(r(Num, _)) = Num.
@@ -154,8 +158,10 @@
:- func rat_norm(int, int) = rat.
rat_norm(Num, Den) = Rat :-
- ( Den = 0 -> throw("rat.rat_norm: division by zero")
- ; Num = 0 -> Rat = r(0, 1)
+ ( Den = 0 ->
+ throw("rat.rat_norm: division by zero")
+ ; Num = 0 ->
+ Rat = r(0, 1)
;
G = gcd(Num, Den),
Num2 = Num * signum(Den),
@@ -174,24 +180,30 @@
:- func lcm(int, int) = int.
lcm(A, B) =
- ( A = 0 -> 0
- ; B = 0 -> 0
- ; int.abs((A // gcd(A, B)) * B)
+ ( A = 0 ->
+ 0
+ ; B = 0 ->
+ 0
+ ;
+ int.abs((A // gcd(A, B)) * B)
).
:- func signum(int) = int.
signum(N) = ( N = 0 -> 0 ; N < 0 -> -1 ; 1 ).
- % Builtin comparison does not give a natural ordering
- % on rats.
+ % Builtin comparison does not give a natural ordering on rats.
+ %
:- func cmp(rat, rat) = comparison_result.
cmp(X, Y) = Cmp :-
Diff = X - Y,
- ( is_zero(Diff) -> Cmp = (=)
- ; is_negative(Diff) -> Cmp = (<)
- ; Cmp = (>)
+ ( is_zero(Diff) ->
+ Cmp = (=)
+ ; is_negative(Diff) ->
+ Cmp = (<)
+ ;
+ Cmp = (>)
).
:- pred is_zero(rat::in) is semidet.
Index: compiler/source_file_map.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/source_file_map.m,v
retrieving revision 1.13
diff -u -b -r1.13 source_file_map.m
--- compiler/source_file_map.m 22 Mar 2005 06:40:25 -0000 1.13
+++ compiler/source_file_map.m 18 Oct 2005 02:03:33 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 2002-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -20,20 +22,21 @@
:- import_module io.
:- import_module list.
- % lookup_module_source_file(ModuleName, FileName, FileNameIsMapped).
+ % lookup_module_source_file(ModuleName, FileName, !IO)
%
- % FileNameIsMapped is `yes' if ModuleName is in
- % the Mercury.modules file.
:- pred lookup_module_source_file(module_name::in, file_name::out,
io::di, io::uo) is det.
% Return `yes' if there is a valid Mercury.modules file.
+ %
:- pred have_source_file_map(bool::out, io::di, io::uo) is det.
% Return the default fully-qualified source file name.
+ %
:- func default_source_file(module_name) = file_name.
% Given a list of file names, produce the Mercury.modules file.
+ %
:- pred write_source_file_map(list(string)::in, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
@@ -73,16 +76,19 @@
HaveMap = no
).
- % Read the Mercury.modules file (if it exists) to find
- % the mapping from module name to file name.
+ % Read the Mercury.modules file (if it exists) to find the mapping
+ % from module name to file name.
+ %
:- pred get_source_file_map(source_file_map::out, io::di, io::uo) is det.
get_source_file_map(SourceFileMap, !IO) :-
globals__io_get_globals(Globals0, !IO),
globals__get_source_file_map(Globals0, MaybeSourceFileMap0),
- ( MaybeSourceFileMap0 = yes(SourceFileMap0) ->
+ (
+ MaybeSourceFileMap0 = yes(SourceFileMap0),
SourceFileMap = SourceFileMap0
;
+ MaybeSourceFileMap0 = no,
io__open_input(modules_file_name, OpenRes, !IO),
(
OpenRes = ok(Stream),
@@ -96,8 +102,7 @@
SourceFileMap = map__init
),
globals__io_get_globals(Globals1, !IO),
- globals__set_source_file_map(yes(SourceFileMap),
- Globals1, Globals2),
+ globals__set_source_file_map(yes(SourceFileMap), Globals1, Globals2),
unsafe_promise_unique(Globals2, Globals),
globals__io_set_globals(Globals, !IO)
).
@@ -114,8 +119,7 @@
read_until_char('\n', [], FileNameCharsResult, !IO),
(
FileNameCharsResult = ok(FileNameChars),
- string__from_rev_char_list(FileNameChars,
- FileName),
+ string__from_rev_char_list(FileNameChars, FileName),
map__set(!.Map, ModuleName, FileName, !:Map),
read_source_file_map(ModuleChars, !Map, !IO)
;
@@ -193,10 +197,9 @@
file_name_to_module_name(dir__basename_det(PartialFileName),
DefaultModuleName),
(
- % Only include a module in the mapping if the
- % name doesn't match the default.
- dir__dirname(PartialFileName) =
- dir__this_directory `with_type` string,
+ % Only include a module in the mapping if the name doesn't match
+ % the default.
+ dir__dirname(PartialFileName) = dir__this_directory : string,
ModuleName = DefaultModuleName
->
true
Index: compiler/stack_layout.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/stack_layout.m,v
retrieving revision 1.106
diff -u -b -r1.106 stack_layout.m
--- compiler/stack_layout.m 5 Oct 2005 06:33:53 -0000 1.106
+++ compiler/stack_layout.m 17 Oct 2005 17:23:52 -0000
@@ -1,4 +1,6 @@
%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
% Copyright (C) 1997-2005 University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -39,11 +41,13 @@
:- import_module list.
:- import_module map.
-:- pred stack_layout__generate_llds(module_info::in,
- global_data::in, global_data::out,
+ % Process all the continuation information stored in the HLDS,
+ % converting it into LLDS data structures.
+ %
+:- pred generate_llds(module_info::in, global_data::in, global_data::out,
list(comp_gen_c_data)::out, map(label, data_addr)::out) is det.
-:- pred stack_layout__construct_closure_layout(proc_label::in, int::in,
+:- pred construct_closure_layout(proc_label::in, int::in,
closure_layout_info::in, proc_label::in, module_name::in,
string::in, int::in, pred_origin::in, string::in, static_cell_info::in,
static_cell_info::out, assoc_list(rval, llds_type)::out,
@@ -51,16 +55,16 @@
% Construct a representation of a variable location as a 32-bit
% integer.
-:- pred stack_layout__represent_locn_as_int(layout_locn::in, int::out) is det.
+ %
+:- pred represent_locn_as_int(layout_locn::in, int::out) is det.
- % Construct a representation of the interface determinism of a
- % procedure.
-:- pred stack_layout__represent_determinism_rval(determinism::in,
- rval::out) is det.
+ % Construct a representation of the interface determinism of a procedure.
+ %
+:- pred represent_determinism_rval(determinism::in, rval::out) is det.
:- type stack_layout_info.
-:- pred stack_layout__lookup_string_in_table(string::in, int::out,
+:- pred lookup_string_in_table(string::in, int::out,
stack_layout_info::in, stack_layout_info::out) is det.
:- implementation.
@@ -95,15 +99,13 @@
:- import_module set.
:- import_module std_util.
:- import_module string.
+:- import_module svmap.
:- import_module term.
:- import_module varset.
%---------------------------------------------------------------------------%
- % Process all the continuation information stored in the HLDS,
- % converting it into LLDS data structures.
-
-stack_layout__generate_llds(ModuleInfo0, !GlobalData, Layouts, LayoutLabels) :-
+generate_llds(ModuleInfo0, !GlobalData, Layouts, LayoutLabels) :-
global_data_get_all_proc_layouts(!.GlobalData, ProcLayoutList),
module_info_get_globals(ModuleInfo0, Globals),
globals__lookup_bool_option(Globals, agc_stack_layout, AgcLayout),
@@ -124,11 +126,10 @@
AgcLayout, TraceLayout, ProcIdLayout, StaticCodeAddr,
LabelCounter0, [], [], [], LayoutLabels0, [],
StringTable0, LabelTables0, StaticCellInfo0),
- stack_layout__lookup_string_in_table("", _, LayoutInfo0, LayoutInfo1),
- stack_layout__lookup_string_in_table("<too many variables>", _,
+ lookup_string_in_table("", _, LayoutInfo0, LayoutInfo1),
+ lookup_string_in_table("<too many variables>", _,
LayoutInfo1, LayoutInfo2),
- list__foldl(stack_layout__construct_layouts, ProcLayoutList,
- LayoutInfo2, LayoutInfo),
+ list__foldl(construct_layouts, ProcLayoutList, LayoutInfo2, LayoutInfo),
LabelsCounter = LayoutInfo ^ label_counter,
counter__allocate(NumLabels, LabelsCounter, _),
TableIoDecls = LayoutInfo ^ table_infos,
@@ -142,16 +143,13 @@
!GlobalData),
StringTable = string_table(_, RevStringList, StringOffset),
list__reverse(RevStringList, StringList),
- stack_layout__concat_string_list(StringList, StringOffset,
- ConcatStrings),
+ concat_string_list(StringList, StringOffset, ConcatStrings),
- list__condense([TableIoDecls, ProcLayouts, InternalLayouts],
- Layouts0),
+ list__condense([TableIoDecls, ProcLayouts, InternalLayouts], Layouts0),
(
TraceLayout = yes,
module_info_get_name(ModuleInfo0, ModuleName),
- globals__lookup_bool_option(Globals, rtti_line_numbers,
- LineNumbers),
+ globals__lookup_bool_option(Globals, rtti_line_numbers, LineNumbers),
(
LineNumbers = yes,
EffLabelTables = LabelTables
@@ -159,22 +157,20 @@
LineNumbers = no,
map__init(EffLabelTables)
),
- stack_layout__format_label_tables(EffLabelTables,
- SourceFileLayouts),
+ format_label_tables(EffLabelTables, SourceFileLayouts),
SuppressedEvents = encode_suppressed_events(TraceSuppress),
ModuleLayout = layout_data(module_layout_data(ModuleName,
StringOffset, ConcatStrings, ProcLayoutNames,
- SourceFileLayouts, TraceLevel, SuppressedEvents,
- NumLabels)),
+ SourceFileLayouts, TraceLevel, SuppressedEvents, NumLabels)),
Layouts = [ModuleLayout | Layouts0]
;
TraceLayout = no,
Layouts = Layouts0
).
-:- pred stack_layout__valid_proc_layout(proc_layout_info::in) is semidet.
+:- pred valid_proc_layout(proc_layout_info::in) is semidet.
-stack_layout__valid_proc_layout(ProcLayoutInfo) :-
+valid_proc_layout(ProcLayoutInfo) :-
EntryLabel = ProcLayoutInfo ^ entry_label,
ProcLabel = get_proc_label(EntryLabel),
(
@@ -189,14 +185,13 @@
% concat_string_list appends a list of strings together,
% appending a null character after each string.
% The resulting string will contain embedded null characters,
-:- pred stack_layout__concat_string_list(list(string)::in, int::in,
+:- pred concat_string_list(list(string)::in, int::in,
string_with_0s::out) is det.
concat_string_list(Strings, Len, string_with_0s(Result)) :-
concat_string_list_2(Strings, Len, Result).
-:- pred stack_layout__concat_string_list_2(list(string)::in, int::in,
- string::out) is det.
+:- pred concat_string_list_2(list(string)::in, int::in, string::out) is det.
:- pragma foreign_decl("C", "
#include ""mercury_tags.h"" /* for MR_list_*() */
@@ -205,8 +200,7 @@
").
:- pragma foreign_proc("C",
- stack_layout__concat_string_list_2(StringList::in, ArenaSize::in,
- Arena::out),
+ concat_string_list_2(StringList::in, ArenaSize::in, Arena::out),
[will_not_call_mercury, promise_pure, thread_safe],
"{
MR_Word cur_node;
@@ -221,8 +215,7 @@
cur_node = StringList;
while (! MR_list_is_empty(cur_node)) {
- (void) strcpy(&Arena[cur_offset],
- (char *) MR_list_head(cur_node));
+ (void) strcpy(&Arena[cur_offset], (char *) MR_list_head(cur_node));
cur_offset += strlen((char *) MR_list_head(cur_node)) + 1;
cur_node = MR_list_tail(cur_node);
}
@@ -239,8 +232,8 @@
% This version is only used if there is no matching foreign_proc version.
% Note that this version only works if the Mercury implementation's
-% string representation allows strings to contain embedded null
-% characters. So we check that.
+% string representation allows strings to contain embedded null characters.
+% So we check that.
concat_string_list_2(StringsList, _Len, StringWithNulls) :-
(
char__to_int(NullChar, 0),
@@ -258,47 +251,43 @@
%---------------------------------------------------------------------------%
-:- pred stack_layout__format_label_tables(map(string, label_table)::in,
+:- pred format_label_tables(map(string, label_table)::in,
list(file_layout_data)::out) is det.
-stack_layout__format_label_tables(LabelTableMap, SourceFileLayouts) :-
+format_label_tables(LabelTableMap, SourceFileLayouts) :-
map__to_assoc_list(LabelTableMap, LabelTableList),
- list__map(stack_layout__format_label_table, LabelTableList,
- SourceFileLayouts).
+ list__map(format_label_table, LabelTableList, SourceFileLayouts).
-:- pred stack_layout__format_label_table(pair(string, label_table)::in,
+:- pred format_label_table(pair(string, label_table)::in,
file_layout_data::out) is det.
-stack_layout__format_label_table(FileName - LineNoMap,
+format_label_table(FileName - LineNoMap,
file_layout_data(FileName, FilteredList)) :-
% This step should produce a list ordered on line numbers.
map__to_assoc_list(LineNoMap, LineNoList),
% And this step should preserve that order.
- stack_layout__flatten_label_table(LineNoList, [], FlatLineNoList),
+ flatten_label_table(LineNoList, [], FlatLineNoList),
Filter = (pred(LineNoInfo::in, FilteredLineNoInfo::out) is det :-
LineNoInfo = LineNo - (Label - _IsReturn),
FilteredLineNoInfo = LineNo - Label
),
list__map(Filter, FlatLineNoList, FilteredList).
-:- pred stack_layout__flatten_label_table(
- assoc_list(int, list(line_no_info))::in,
+:- pred flatten_label_table(assoc_list(int, list(line_no_info))::in,
assoc_list(int, line_no_info)::in,
assoc_list(int, line_no_info)::out) is det.
-stack_layout__flatten_label_table([], RevList, List) :-
+flatten_label_table([], RevList, List) :-
list__reverse(RevList, List).
-stack_layout__flatten_label_table([LineNo - LinesInfos | Lines],
- RevList0, List) :-
- list__foldl(stack_layout__add_line_no(LineNo), LinesInfos,
- RevList0, RevList1),
- stack_layout__flatten_label_table(Lines, RevList1, List).
+flatten_label_table([LineNo - LinesInfos | Lines], RevList0, List) :-
+ list__foldl(add_line_no(LineNo), LinesInfos, RevList0, RevList1),
+ flatten_label_table(Lines, RevList1, List).
-:- pred stack_layout__add_line_no(int::in, line_no_info::in,
+:- pred add_line_no(int::in, line_no_info::in,
assoc_list(int, line_no_info)::in,
assoc_list(int, line_no_info)::out) is det.
-stack_layout__add_line_no(LineNo, LineInfo, RevList0, RevList) :-
+add_line_no(LineNo, LineInfo, RevList0, RevList) :-
RevList = [LineNo - LineInfo | RevList0].
%---------------------------------------------------------------------------%
@@ -307,22 +296,38 @@
% the procedure-specific layout and the layouts of the labels
% inside that procedure. Also update the module-wide label table
% with the labels defined in this procedure.
-
-:- pred stack_layout__construct_layouts(proc_layout_info::in,
+ %
+:- pred construct_layouts(proc_layout_info::in,
stack_layout_info::in, stack_layout_info::out) is det.
-stack_layout__construct_layouts(ProcLayoutInfo, !Info) :-
- ProcLayoutInfo = proc_layout_info(RttiProcLabel, EntryLabel, _Detism,
- _StackSlots, _SuccipLoc, _EvalMethod, _EffTraceLevel,
- _MaybeCallLabel, _MaxTraceReg, HeadVars, _ArgModes,
- Goal, _NeedGoalRep, _InstMap, _TraceSlotInfo,
- ForceProcIdLayout, VarSet, _VarTypes, InternalMap,
- MaybeTableIoDecl, _NeedsAllNames, _MaybeDeepProfInfo),
+construct_layouts(ProcLayoutInfo, !Info) :-
+ ProcLayoutInfo = proc_layout_info(RttiProcLabel,
+ EntryLabel,
+ _Detism,
+ _StackSlots,
+ _SuccipLoc,
+ _EvalMethod,
+ _EffTraceLevel,
+ _MaybeCallLabel,
+ _MaxTraceReg,
+ HeadVars,
+ _ArgModes,
+ Goal,
+ _NeedGoalRep,
+ _InstMap,
+ _TraceSlotInfo,
+ ForceProcIdLayout,
+ VarSet,
+ _VarTypes,
+ InternalMap,
+ MaybeTableIoDecl,
+ _NeedsAllNames,
+ _MaybeDeepProfInfo),
map__to_assoc_list(InternalMap, Internals),
compute_var_number_map(HeadVars, VarSet, Internals, Goal, VarNumMap),
ProcLabel = get_proc_label(EntryLabel),
- stack_layout__get_procid_stack_layout(!.Info, ProcIdLayout0),
+ get_procid_stack_layout(!.Info, ProcIdLayout0),
bool__or(ProcIdLayout0, ForceProcIdLayout, ProcIdLayout),
(
( ProcIdLayout = yes
@@ -340,58 +345,55 @@
),
valid_proc_layout(ProcLayoutInfo)
->
- list__map_foldl(stack_layout__construct_internal_layout(
- ProcLabel, ProcLayoutName, VarNumMap),
+ list__map_foldl(
+ construct_internal_layout(ProcLabel, ProcLayoutName, VarNumMap),
Internals, InternalLayouts, !Info)
;
InternalLayouts = []
),
- stack_layout__get_label_tables(!.Info, LabelTables0),
- list__foldl(stack_layout__update_label_table, InternalLayouts,
+ get_label_tables(!.Info, LabelTables0),
+ list__foldl(update_label_table, InternalLayouts,
LabelTables0, LabelTables),
- stack_layout__set_label_tables(LabelTables, !Info),
- stack_layout__construct_proc_layout(ProcLayoutInfo, Kind, VarNumMap,
- !Info).
+ set_label_tables(LabelTables, !Info),
+ construct_proc_layout(ProcLayoutInfo, Kind, VarNumMap, !Info).
%---------------------------------------------------------------------------%
% Add the given label layout to the module-wide label tables.
-:- pred stack_layout__update_label_table(
+:- pred update_label_table(
{proc_label, int, label_vars, internal_layout_info}::in,
map(string, label_table)::in, map(string, label_table)::out) is det.
-stack_layout__update_label_table(
- {ProcLabel, LabelNum, LabelVars, InternalInfo},
+update_label_table({ProcLabel, LabelNum, LabelVars, InternalInfo},
!LabelTables) :-
InternalInfo = internal_layout_info(Port, _, Return),
(
Return = yes(return_layout_info(TargetsContexts, _)),
- stack_layout__find_valid_return_context(TargetsContexts,
- Target, Context, _GoalPath)
+ find_valid_return_context(TargetsContexts, Target, Context, _GoalPath)
->
( Target = label(TargetLabel) ->
IsReturn = known_callee(TargetLabel)
;
IsReturn = unknown_callee
),
- stack_layout__update_label_table_2(ProcLabel, LabelNum,
+ update_label_table_2(ProcLabel, LabelNum,
LabelVars, Context, IsReturn, !LabelTables)
;
Port = yes(trace_port_layout_info(Context, _, _, _, _)),
- stack_layout__context_is_valid(Context)
+ context_is_valid(Context)
->
- stack_layout__update_label_table_2(ProcLabel, LabelNum,
- LabelVars, Context, not_a_return, !LabelTables)
+ update_label_table_2(ProcLabel, LabelNum, LabelVars, Context,
+ not_a_return, !LabelTables)
;
true
).
-:- pred stack_layout__update_label_table_2(proc_label::in, int::in,
+:- pred update_label_table_2(proc_label::in, int::in,
label_vars::in, context::in, is_label_return::in,
map(string, label_table)::in, map(string, label_table)::out) is det.
-stack_layout__update_label_table_2(ProcLabel, LabelNum, LabelVars, Context,
+update_label_table_2(ProcLabel, LabelNum, LabelVars, Context,
IsReturn, !LabelTables) :-
term__context_file(Context, File),
term__context_line(Context, Line),
@@ -399,48 +401,44 @@
LabelLayout = label_layout(ProcLabel, LabelNum, LabelVars),
( map__search(LabelTable0, Line, LineInfo0) ->
LineInfo = [LabelLayout - IsReturn | LineInfo0],
- map__det_update(LabelTable0, Line, LineInfo,
- LabelTable),
- map__det_update(!.LabelTables, File, LabelTable,
- !:LabelTables)
+ map__det_update(LabelTable0, Line, LineInfo, LabelTable),
+ svmap__det_update(File, LabelTable, !LabelTables)
;
LineInfo = [LabelLayout - IsReturn],
- map__det_insert(LabelTable0, Line, LineInfo,
- LabelTable),
- map__det_update(!.LabelTables, File, LabelTable,
- !:LabelTables)
+ map__det_insert(LabelTable0, Line, LineInfo, LabelTable),
+ svmap__det_update(File, LabelTable, !LabelTables)
)
- ; stack_layout__context_is_valid(Context) ->
+ ; context_is_valid(Context) ->
map__init(LabelTable0),
LabelLayout = label_layout(ProcLabel, LabelNum, LabelVars),
LineInfo = [LabelLayout - IsReturn],
map__det_insert(LabelTable0, Line, LineInfo, LabelTable),
- map__det_insert(!.LabelTables, File, LabelTable, !:LabelTables)
+ svmap__det_insert(File, LabelTable, !LabelTables)
;
% We don't have a valid context for this label,
% so we don't enter it into any tables.
true
).
-:- pred stack_layout__find_valid_return_context(
+:- pred find_valid_return_context(
assoc_list(code_addr, pair(prog_context, goal_path))::in,
code_addr::out, prog_context::out, goal_path::out) is semidet.
-stack_layout__find_valid_return_context([TargetContext | TargetContexts],
+find_valid_return_context([TargetContext | TargetContexts],
ValidTarget, ValidContext, ValidGoalPath) :-
TargetContext = Target - (Context - GoalPath),
- ( stack_layout__context_is_valid(Context) ->
+ ( context_is_valid(Context) ->
ValidTarget = Target,
ValidContext = Context,
ValidGoalPath = GoalPath
;
- stack_layout__find_valid_return_context(TargetContexts,
- ValidTarget, ValidContext, ValidGoalPath)
+ find_valid_return_context(TargetContexts, ValidTarget, ValidContext,
+ ValidGoalPath)
).
-:- pred stack_layout__context_is_valid(prog_context::in) is semidet.
+:- pred context_is_valid(prog_context::in) is semidet.
-stack_layout__context_is_valid(Context) :-
+context_is_valid(Context) :-
term__context_file(Context, File),
term__context_line(Context, Line),
File \= "",
@@ -448,11 +446,11 @@
%---------------------------------------------------------------------------%
-:- pred stack_layout__construct_proc_traversal(label::in, determinism::in,
+:- pred construct_proc_traversal(label::in, determinism::in,
int::in, maybe(int)::in, proc_layout_stack_traversal::out,
stack_layout_info::in, stack_layout_info::out) is det.
-stack_layout__construct_proc_traversal(EntryLabel, Detism, NumStackSlots,
+construct_proc_traversal(EntryLabel, Detism, NumStackSlots,
MaybeSuccipLoc, Traversal, !Info) :-
(
MaybeSuccipLoc = yes(Location),
@@ -461,40 +459,32 @@
;
SuccipLval = stackvar(Location)
),
- stack_layout__represent_locn_as_int(direct(SuccipLval),
- SuccipInt),
+ represent_locn_as_int(direct(SuccipLval), SuccipInt),
MaybeSuccipInt = yes(SuccipInt)
;
MaybeSuccipLoc = no,
- % Use a dummy location if there is no succip slot
- % on the stack.
+ % Use a dummy location if there is no succip slot on the stack.
%
- % This case can arise in two circumstances.
- % First, procedures that use the nondet stack
- % have a special slot for the succip, so the
- % succip is not stored in a general purpose
- % slot. Second, procedures that use the det stack
- % but which do not call other procedures
+ % This case can arise in two circumstances. First, procedures that
+ % use the nondet stack have a special slot for the succip, so the
+ % succip is not stored in a general purpose slot. Second, procedures
+ % that use the det stack but which do not call other procedures
% do not save the succip on the stack.
%
- % The tracing system does not care about the
- % location of the saved succip. The accurate
- % garbage collector does. It should know from
- % the determinism that the procedure uses the
- % nondet stack, which takes care of the first
- % possibility above. Procedures that do not call
- % other procedures do not establish resumption
- % points and thus agc is not interested in them.
- % As far as stack dumps go, calling error counts
- % as a call, so any procedure that may call error
- % (directly or indirectly) will have its saved succip
- % location recorded, so the stack dump will work.
+ % The tracing system does not care about the location of the saved
+ % succip. The accurate garbage collector does. It should know from
+ % the determinism that the procedure uses the nondet stack, which
+ % takes care of the first possibility above. Procedures that do not
+ % call other procedures do not establish resumption points and thus
+ % agc is not interested in them. As far as stack dumps go, calling
+ % error counts as a call, so any procedure that may call error
+ % (directly or indirectly) will have its saved succip location
+ % recorded, so the stack dump will work.
%
- % Future uses of stack layouts will have to have
- % similar constraints.
+ % Future uses of stack layouts will have to have similar constraints.
MaybeSuccipInt = no
),
- stack_layout__get_static_code_addresses(!.Info, StaticCodeAddr),
+ get_static_code_addresses(!.Info, StaticCodeAddr),
(
StaticCodeAddr = yes,
MaybeEntryLabel = yes(EntryLabel)
@@ -506,34 +496,49 @@
MaybeSuccipInt, NumStackSlots, Detism).
% Construct a procedure-specific layout.
-
-:- pred stack_layout__construct_proc_layout(proc_layout_info::in,
+ %
+:- pred construct_proc_layout(proc_layout_info::in,
proc_layout_kind::in, var_num_map::in,
stack_layout_info::in, stack_layout_info::out) is det.
-stack_layout__construct_proc_layout(ProcLayoutInfo, Kind, VarNumMap, !Info) :-
- ProcLayoutInfo = proc_layout_info(RttiProcLabel, EntryLabel, Detism,
- StackSlots, SuccipLoc, EvalMethod, EffTraceLevel,
- MaybeCallLabel, MaxTraceReg, HeadVars, ArgModes,
- Goal, NeedGoalRep, InstMap, TraceSlotInfo, _ForceProcIdLayout,
- VarSet, VarTypes, _InternalMap, MaybeTableInfo, NeedsAllNames,
+construct_proc_layout(ProcLayoutInfo, Kind, VarNumMap, !Info) :-
+ ProcLayoutInfo = proc_layout_info(RttiProcLabel,
+ EntryLabel,
+ Detism,
+ StackSlots,
+ SuccipLoc,
+ EvalMethod,
+ EffTraceLevel,
+ MaybeCallLabel,
+ MaxTraceReg,
+ HeadVars,
+ ArgModes,
+ Goal,
+ NeedGoalRep,
+ InstMap,
+ TraceSlotInfo,
+ _ForceProcIdLayout,
+ VarSet,
+ VarTypes,
+ _InternalMap,
+ MaybeTableInfo,
+ NeedsAllNames,
MaybeProcStatic),
- stack_layout__construct_proc_traversal(EntryLabel, Detism, StackSlots,
+ construct_proc_traversal(EntryLabel, Detism, StackSlots,
SuccipLoc, Traversal, !Info),
(
Kind = proc_layout_traversal,
More = no_proc_id
;
Kind = proc_layout_proc_id(_),
- stack_layout__get_trace_stack_layout(!.Info, TraceStackLayout),
+ get_trace_stack_layout(!.Info, TraceStackLayout),
(
TraceStackLayout = yes,
given_trace_level_is_none(EffTraceLevel) = no,
valid_proc_layout(ProcLayoutInfo)
->
- stack_layout__construct_trace_layout(RttiProcLabel,
- EvalMethod, EffTraceLevel, MaybeCallLabel,
- MaxTraceReg, HeadVars, ArgModes, Goal,
+ construct_trace_layout(RttiProcLabel, EvalMethod, EffTraceLevel,
+ MaybeCallLabel, MaxTraceReg, HeadVars, ArgModes, Goal,
NeedGoalRep, InstMap, TraceSlotInfo,
VarSet, VarTypes, MaybeTableInfo,
NeedsAllNames, VarNumMap, ExecTrace, !Info),
@@ -546,21 +551,20 @@
ProcLayout = proc_layout_data(RttiProcLabel, Traversal, More),
Data = layout_data(ProcLayout),
LayoutName = proc_layout(RttiProcLabel, Kind),
- stack_layout__add_proc_layout_data(Data, LayoutName, EntryLabel,
+ add_proc_layout_data(Data, LayoutName, EntryLabel,
!Info),
(
MaybeTableInfo = no
;
MaybeTableInfo = yes(TableInfo),
- stack_layout__get_static_cell_info(!.Info, StaticCellInfo0),
- stack_layout__make_table_data(RttiProcLabel, Kind,
- TableInfo, TableData,
+ get_static_cell_info(!.Info, StaticCellInfo0),
+ make_table_data(RttiProcLabel, Kind, TableInfo, TableData,
StaticCellInfo0, StaticCellInfo),
- stack_layout__set_static_cell_info(StaticCellInfo, !Info),
- stack_layout__add_table_data(TableData, !Info)
+ set_static_cell_info(StaticCellInfo, !Info),
+ add_table_data(TableData, !Info)
).
-:- pred stack_layout__construct_trace_layout(rtti_proc_label::in,
+:- pred construct_trace_layout(rtti_proc_label::in,
eval_method::in, trace_level::in, maybe(label)::in, int::in,
list(prog_var)::in, list(mode)::in, hlds_goal::in, bool::in,
instmap::in, trace_slot_info::in, prog_varset::in, vartypes::in,
@@ -568,11 +572,11 @@
proc_layout_exec_trace::out,
stack_layout_info::in, stack_layout_info::out) is det.
-stack_layout__construct_trace_layout(RttiProcLabel, EvalMethod, EffTraceLevel,
+construct_trace_layout(RttiProcLabel, EvalMethod, EffTraceLevel,
MaybeCallLabel, MaxTraceReg, HeadVars, ArgModes,
Goal, NeedGoalRep, InstMap, TraceSlotInfo, _VarSet, VarTypes,
MaybeTableInfo, NeedsAllNames, VarNumMap, ExecTrace, !Info) :-
- stack_layout__construct_var_name_vector(VarNumMap,
+ construct_var_name_vector(VarNumMap,
NeedsAllNames, MaxVarNum, VarNameVector, !Info),
list__map(convert_var_to_int(VarNumMap), HeadVars, HeadVarNumVector),
ModuleInfo = !.Info ^ module_info,
@@ -581,17 +585,15 @@
ProcBytes = []
;
NeedGoalRep = yes,
- prog_rep__represent_proc(HeadVars,
- Goal, InstMap, VarTypes, VarNumMap, ModuleInfo,
- !Info, ProcBytes)
+ prog_rep__represent_proc(HeadVars, Goal, InstMap, VarTypes, VarNumMap,
+ ModuleInfo, !Info, ProcBytes)
),
(
MaybeCallLabel = yes(CallLabelPrime),
CallLabel = CallLabelPrime
;
MaybeCallLabel = no,
- error("stack_layout__construct_trace_layout: " ++
- "call label not present")
+ error("construct_trace_layout: call label not present")
),
TraceSlotInfo = trace_slot_info(MaybeFromFullSlot, MaybeIoSeqSlot,
MaybeTrailSlots, MaybeMaxfrSlot, MaybeCallTableSlot),
@@ -600,7 +602,7 @@
CallLabel = internal(CallLabelNum, CallProcLabel)
;
CallLabel = entry(_, _),
- error("stack_layout__construct_trace_layout: entry call label")
+ error("construct_trace_layout: entry call label")
),
CallLabelLayout = label_layout(CallProcLabel, CallLabelNum,
label_has_var_info),
@@ -638,12 +640,12 @@
true
).
-:- pred stack_layout__construct_var_name_vector(var_num_map::in,
+:- pred construct_var_name_vector(var_num_map::in,
bool::in, int::out, list(int)::out,
stack_layout_info::in, stack_layout_info::out) is det.
-stack_layout__construct_var_name_vector(VarNumMap, NeedsAllNames, MaxVarNum,
- Offsets, !Info) :-
+construct_var_name_vector(VarNumMap, NeedsAllNames, MaxVarNum, Offsets,
+ !Info) :-
map__values(VarNumMap, VarNames0),
(
NeedsAllNames = yes,
@@ -655,11 +657,11 @@
list__sort(VarNames, SortedVarNames),
( SortedVarNames = [FirstVarNum - _ | _] ->
MaxVarNum0 = FirstVarNum,
- stack_layout__construct_var_name_rvals(SortedVarNames, 1,
- MaxVarNum0, MaxVarNum, Offsets, !Info)
+ construct_var_name_rvals(SortedVarNames, 1, MaxVarNum0, MaxVarNum,
+ Offsets, !Info)
;
- % Since variable numbers start at 1, MaxVarNum = 0
- % implies an empty array.
+ % Since variable numbers start at 1, MaxVarNum = 0 implies
+ % an empty array.
MaxVarNum = 0,
Offsets = []
).
@@ -669,22 +671,22 @@
var_has_name(_VarNum - VarName) :-
VarName \= "".
-:- pred stack_layout__construct_var_name_rvals(assoc_list(int, string)::in,
+:- pred construct_var_name_rvals(assoc_list(int, string)::in,
int::in, int::in, int::out, list(int)::out,
stack_layout_info::in, stack_layout_info::out) is det.
-stack_layout__construct_var_name_rvals([], _CurNum, MaxNum, MaxNum, [], !Info).
-stack_layout__construct_var_name_rvals([Var - Name | VarNamesTail], CurNum,
+construct_var_name_rvals([], _CurNum, MaxNum, MaxNum, [], !Info).
+construct_var_name_rvals([Var - Name | VarNamesTail], CurNum,
!MaxNum, [Offset | OffsetsTail], !Info) :-
( Var = CurNum ->
- stack_layout__lookup_string_in_table(Name, Offset, !Info),
+ lookup_string_in_table(Name, Offset, !Info),
!:MaxNum = Var,
VarNames = VarNamesTail
;
Offset = 0,
VarNames = [Var - Name | VarNamesTail]
),
- stack_layout__construct_var_name_rvals(VarNames, CurNum + 1,
+ construct_var_name_rvals(VarNames, CurNum + 1,
!MaxNum, OffsetsTail, !Info).
%---------------------------------------------------------------------------%
@@ -775,13 +777,13 @@
% Construct the layout describing a single internal label
% for accurate GC and/or execution tracing.
-
-:- pred stack_layout__construct_internal_layout(proc_label::in,
+ %
+:- pred construct_internal_layout(proc_label::in,
layout_name::in, var_num_map::in, pair(int, internal_layout_info)::in,
{proc_label, int, label_vars, internal_layout_info}::out,
stack_layout_info::in, stack_layout_info::out) is det.
-stack_layout__construct_internal_layout(ProcLabel, ProcLayoutName, VarNumMap,
+construct_internal_layout(ProcLabel, ProcLayoutName, VarNumMap,
LabelNum - Internal, LabelLayout, !Info) :-
Internal = internal_layout_info(Trace, Resume, Return),
(
@@ -790,8 +792,7 @@
map__init(TraceTypeVarMap)
;
Trace = yes(trace_port_layout_info(_,_,_,_, TraceLayout)),
- TraceLayout = layout_label_info(TraceLiveVarSet,
- TraceTypeVarMap)
+ TraceLayout = layout_label_info(TraceLiveVarSet, TraceTypeVarMap)
),
(
Resume = no,
@@ -799,47 +800,38 @@
map__init(ResumeTypeVarMap)
;
Resume = yes(ResumeLayout),
- ResumeLayout = layout_label_info(ResumeLiveVarSet,
- ResumeTypeVarMap)
+ ResumeLayout = layout_label_info(ResumeLiveVarSet, ResumeTypeVarMap)
),
(
- Trace = yes(trace_port_layout_info(_, Port, IsHidden,
- GoalPath, _)),
+ Trace = yes(trace_port_layout_info(_, Port, IsHidden, GoalPath, _)),
Return = no,
MaybePort = yes(Port),
MaybeIsHidden = yes(IsHidden),
goal_path_to_string(GoalPath, GoalPathStr),
- stack_layout__lookup_string_in_table(GoalPathStr, GoalPathNum,
- !Info),
+ lookup_string_in_table(GoalPathStr, GoalPathNum, !Info),
MaybeGoalPath = yes(GoalPathNum)
;
Trace = no,
Return = yes(ReturnInfo),
- % We only ever use the port fields of these layout
- % structures when we process exception events.
- % (Since exception events are interface events,
- % the goal path field is not meaningful then.)
+ % We only ever use the port fields of these layout structures
+ % when we process exception events. (Since exception events are
+ % interface events, the goal path field is not meaningful then.)
MaybePort = yes(exception),
MaybeIsHidden = yes(no),
- % We only ever use the goal path fields of these
- % layout structures when we process "fail" commands
- % in the debugger.
+ % We only ever use the goal path fields of these layout structures
+ % when we process "fail" commands in the debugger.
ReturnInfo = return_layout_info(TargetsContexts, _),
(
- stack_layout__find_valid_return_context(
- TargetsContexts, _, _, GoalPath)
+ find_valid_return_context(TargetsContexts, _, _, GoalPath)
->
goal_path_to_string(GoalPath, GoalPathStr),
- stack_layout__lookup_string_in_table(GoalPathStr,
- GoalPathNum, !Info),
+ lookup_string_in_table(GoalPathStr, GoalPathNum, !Info),
MaybeGoalPath = yes(GoalPathNum)
;
- % If tracing is enabled, then exactly one of
- % the calls for which this label is a return
- % site would have had a valid context. If none
- % do, then tracing is not enabled, and
- % therefore the goal path of this label will
- % not be accessed.
+ % If tracing is enabled, then exactly one of the calls for which
+ % this label is a return site would have had a valid context.
+ % If none do, then tracing is not enabled, and therefore the goal
+ % path of this label will not be accessed.
MaybeGoalPath = no
)
;
@@ -853,29 +845,26 @@
Return = yes(_),
error("label has both trace and return layout info")
),
- stack_layout__get_agc_stack_layout(!.Info, AgcStackLayout),
+ get_agc_stack_layout(!.Info, AgcStackLayout),
(
Return = no,
set__init(ReturnLiveVarSet),
map__init(ReturnTypeVarMap)
;
Return = yes(return_layout_info(_, ReturnLayout)),
- ReturnLayout = layout_label_info(ReturnLiveVarSet0,
- ReturnTypeVarMap0),
+ ReturnLayout = layout_label_info(ReturnLiveVarSet0, ReturnTypeVarMap0),
(
AgcStackLayout = yes,
ReturnLiveVarSet = ReturnLiveVarSet0,
ReturnTypeVarMap = ReturnTypeVarMap0
;
AgcStackLayout = no,
- % This set of variables must be for uplevel printing
- % in execution tracing, so we are interested only
- % in (a) variables, not temporaries, (b) only named
- % variables, and (c) only those on the stack, not
- % the return values.
- set__to_sorted_list(ReturnLiveVarSet0,
- ReturnLiveVarList0),
- stack_layout__select_trace_return(
+ % This set of variables must be for uplevel printing in execution
+ % tracing, so we are interested only in (a) variables, not
+ % temporaries, (b) only named variables, and (c) only those
+ % on the stack, not the return values.
+ set__to_sorted_list(ReturnLiveVarSet0, ReturnLiveVarList0),
+ select_trace_return(
ReturnLiveVarList0, ReturnTypeVarMap0,
ReturnLiveVarList, ReturnTypeVarMap),
set__list_to_set(ReturnLiveVarList, ReturnLiveVarSet)
@@ -889,17 +878,14 @@
MaybeVarInfo = no,
LabelVars = label_has_no_var_info
;
- % XXX ignore differences in insts inside
- % layout_var_infos
+ % XXX Ignore differences in insts inside layout_var_infos.
set__union(TraceLiveVarSet, ResumeLiveVarSet, LiveVarSet0),
set__union(LiveVarSet0, ReturnLiveVarSet, LiveVarSet),
map__union(set__intersect, TraceTypeVarMap, ResumeTypeVarMap,
TypeVarMap0),
- map__union(set__intersect, TypeVarMap0, ReturnTypeVarMap,
- TypeVarMap),
- stack_layout__construct_livelval_rvals(LiveVarSet, VarNumMap,
- TypeVarMap, EncodedLength, LiveValRval, NamesRval,
- TypeParamRval, !Info),
+ map__union(set__intersect, TypeVarMap0, ReturnTypeVarMap, TypeVarMap),
+ construct_livelval_rvals(LiveVarSet, VarNumMap, TypeVarMap,
+ EncodedLength, LiveValRval, NamesRval, TypeParamRval, !Info),
VarInfo = label_var_info(EncodedLength, LiveValRval, NamesRval,
TypeParamRval),
MaybeVarInfo = yes(VarInfo),
@@ -908,7 +894,7 @@
(
Trace = yes(_),
- stack_layout__allocate_label_number(LabelNumber0, !Info),
+ allocate_label_number(LabelNumber0, !Info),
% MR_ml_label_exec_count[0] is never written out;
% it is reserved for cases like this, for labels without
% events, and for handwritten labels.
@@ -922,53 +908,49 @@
LabelNumber = 0
),
LayoutData = label_layout_data(ProcLabel, LabelNum, ProcLayoutName,
- MaybePort, MaybeIsHidden, LabelNumber, MaybeGoalPath,
- MaybeVarInfo),
+ MaybePort, MaybeIsHidden, LabelNumber, MaybeGoalPath, MaybeVarInfo),
CData = layout_data(LayoutData),
LayoutName = label_layout(ProcLabel, LabelNum, LabelVars),
Label = internal(LabelNum, ProcLabel),
- stack_layout__add_internal_layout_data(CData, Label, LayoutName,
- !Info),
+ add_internal_layout_data(CData, Label, LayoutName, !Info),
LabelLayout = {ProcLabel, LabelNum, LabelVars, Internal}.
%---------------------------------------------------------------------------%
-:- pred stack_layout__construct_livelval_rvals(set(layout_var_info)::in,
+:- pred construct_livelval_rvals(set(layout_var_info)::in,
var_num_map::in, map(tvar, set(layout_locn))::in, int::out,
rval::out, rval::out, rval::out,
stack_layout_info::in, stack_layout_info::out) is det.
-stack_layout__construct_livelval_rvals(LiveLvalSet, VarNumMap, TVarLocnMap,
+construct_livelval_rvals(LiveLvalSet, VarNumMap, TVarLocnMap,
EncodedLength, LiveValRval, NamesRval, TypeParamRval, !Info) :-
set__to_sorted_list(LiveLvalSet, LiveLvals),
- stack_layout__sort_livevals(LiveLvals, SortedLiveLvals),
- stack_layout__construct_liveval_arrays(SortedLiveLvals, VarNumMap,
+ sort_livevals(LiveLvals, SortedLiveLvals),
+ construct_liveval_arrays(SortedLiveLvals, VarNumMap,
EncodedLength, LiveValRval, NamesRval, !Info),
StaticCellInfo0 = !.Info ^ static_cell_info,
- stack_layout__construct_tvar_vector(TVarLocnMap,
- TypeParamRval, StaticCellInfo0, StaticCellInfo),
+ construct_tvar_vector(TVarLocnMap, TypeParamRval,
+ StaticCellInfo0, StaticCellInfo),
!:Info = !.Info ^ static_cell_info := StaticCellInfo.
-:- pred stack_layout__construct_tvar_vector(map(tvar, set(layout_locn))::in,
+:- pred construct_tvar_vector(map(tvar, set(layout_locn))::in,
rval::out, static_cell_info::in, static_cell_info::out) is det.
-stack_layout__construct_tvar_vector(TVarLocnMap, TypeParamRval,
- !StaticCellInfo) :-
+construct_tvar_vector(TVarLocnMap, TypeParamRval, !StaticCellInfo) :-
( map__is_empty(TVarLocnMap) ->
TypeParamRval = const(int_const(0))
;
- stack_layout__construct_tvar_rvals(TVarLocnMap, Vector),
+ construct_tvar_rvals(TVarLocnMap, Vector),
add_static_cell(Vector, DataAddr, !StaticCellInfo),
TypeParamRval = const(data_addr_const(DataAddr, no))
).
-:- pred stack_layout__construct_tvar_rvals(map(tvar, set(layout_locn))::in,
+:- pred construct_tvar_rvals(map(tvar, set(layout_locn))::in,
assoc_list(rval, llds_type)::out) is det.
-stack_layout__construct_tvar_rvals(TVarLocnMap, Vector) :-
+construct_tvar_rvals(TVarLocnMap, Vector) :-
map__to_assoc_list(TVarLocnMap, TVarLocns),
- stack_layout__construct_type_param_locn_vector(TVarLocns, 1,
- TypeParamLocs),
+ construct_type_param_locn_vector(TVarLocns, 1, TypeParamLocs),
list__length(TypeParamLocs, TypeParamsLength),
LengthRval = const(int_const(TypeParamsLength)),
Vector = [LengthRval - uint_least32 | TypeParamLocs].
@@ -981,12 +963,12 @@
% the typeinfo list we return may be bigger than necessary, but this
% does not compromise correctness; we do this to avoid having to
% scan the types of all the selected layout_var_infos.
-
-:- pred stack_layout__select_trace_return(
+ %
+:- pred select_trace_return(
list(layout_var_info)::in, map(tvar, set(layout_locn))::in,
list(layout_var_info)::out, map(tvar, set(layout_locn))::out) is det.
-stack_layout__select_trace_return(Infos, TVars, TraceReturnInfos, TVars) :-
+select_trace_return(Infos, TVars, TraceReturnInfos, TVars) :-
IsNamedReturnVar = (pred(LocnInfo::in) is semidet :-
LocnInfo = layout_var_info(Locn, LvalType, _),
LvalType = var(_, Name, _, _),
@@ -1004,11 +986,11 @@
% the output of the debugger look nicer, and the sorting of the both
% blocks makes it more likely that different labels' layout structures
% will have common parts (e.g. name vectors).
+ %
+:- pred sort_livevals(list(layout_var_info)::in, list(layout_var_info)::out)
+ is det.
-:- pred stack_layout__sort_livevals(list(layout_var_info)::in,
- list(layout_var_info)::out) is det.
-
-stack_layout__sort_livevals(OrigInfos, FinalInfos) :-
+sort_livevals(OrigInfos, FinalInfos) :-
IsNamedVar = (pred(LvalInfo::in) is semidet :-
LvalInfo = layout_var_info(_Lval, LvalType, _),
LvalType = var(_, Name, _, _),
@@ -1018,8 +1000,8 @@
CompareVarInfos = (pred(Var1::in, Var2::in, Result::out) is det :-
Var1 = layout_var_info(Lval1, LiveType1, _),
Var2 = layout_var_info(Lval2, LiveType2, _),
- stack_layout__get_name_from_live_value_type(LiveType1, Name1),
- stack_layout__get_name_from_live_value_type(LiveType2, Name2),
+ get_name_from_live_value_type(LiveType1, Name1),
+ get_name_from_live_value_type(LiveType2, Name2),
compare(NameResult, Name1, Name2),
( NameResult = (=) ->
compare(Result, Lval1, Lval2)
@@ -1031,10 +1013,10 @@
list__sort(CompareVarInfos, OtherInfos0, OtherInfos),
list__append(NamedVarInfos, OtherInfos, FinalInfos).
-:- pred stack_layout__get_name_from_live_value_type(live_value_type::in,
+:- pred get_name_from_live_value_type(live_value_type::in,
string::out) is det.
-stack_layout__get_name_from_live_value_type(LiveType, Name) :-
+get_name_from_live_value_type(LiveType, Name) :-
( LiveType = var(_, NamePrime, _, _) ->
Name = NamePrime
;
@@ -1047,14 +1029,14 @@
% sorted on the type variables, represent them in an array of
% location descriptions indexed by the type variable. The next
% slot to fill is given by the second argument.
-
-:- pred stack_layout__construct_type_param_locn_vector(
+ %
+:- pred construct_type_param_locn_vector(
assoc_list(tvar, set(layout_locn))::in,
int::in, assoc_list(rval, llds_type)::out) is det.
-stack_layout__construct_type_param_locn_vector([], _, []).
-stack_layout__construct_type_param_locn_vector([TVar - Locns | TVarLocns],
- CurSlot, Vector) :-
+construct_type_param_locn_vector([], _, []).
+construct_type_param_locn_vector([TVar - Locns | TVarLocns], CurSlot,
+ Vector) :-
term__var_to_int(TVar, TVarNum),
NextSlot = CurSlot + 1,
( TVarNum = CurSlot ->
@@ -1063,13 +1045,12 @@
;
error("tvar has empty set of locations")
),
- stack_layout__represent_locn_as_int_rval(Locn, Rval),
- stack_layout__construct_type_param_locn_vector(TVarLocns,
- NextSlot, VectorTail),
+ represent_locn_as_int_rval(Locn, Rval),
+ construct_type_param_locn_vector(TVarLocns, NextSlot, VectorTail),
Vector = [Rval - uint_least32 | VectorTail]
; TVarNum > CurSlot ->
- stack_layout__construct_type_param_locn_vector(
- [TVar - Locns | TVarLocns], NextSlot, VectorTail),
+ construct_type_param_locn_vector([TVar - Locns | TVarLocns], NextSlot,
+ VectorTail),
% This slot will never be referred to.
Vector = [const(int_const(0)) - uint_least32 | VectorTail]
;
@@ -1085,8 +1066,7 @@
% is in the byte array, and uint_least32 if it
% is in the int array.
rval, % Rval describing the type of a live value.
- llds_type, % The llds type of the rval describing the
- % type.
+ llds_type, % The llds type of the rval describing the type.
rval % Rval describing the variable number of a
% live value. Always of llds type uint_least16.
% Contains zero if the live value is not
@@ -1097,23 +1077,22 @@
% Construct a vector of (locn, live_value_type) pairs,
% and a corresponding vector of variable names.
-
-:- pred stack_layout__construct_liveval_arrays(list(layout_var_info)::in,
+ %
+:- pred construct_liveval_arrays(list(layout_var_info)::in,
var_num_map::in, int::out, rval::out, rval::out,
stack_layout_info::in, stack_layout_info::out) is det.
-stack_layout__construct_liveval_arrays(VarInfos, VarNumMap, EncodedLength,
+construct_liveval_arrays(VarInfos, VarNumMap, EncodedLength,
TypeLocnVector, NumVector, !Info) :-
- int__pow(2, stack_layout__short_count_bits, BytesLimit),
- stack_layout__construct_liveval_array_infos(VarInfos, VarNumMap,
+ int__pow(2, short_count_bits, BytesLimit),
+ construct_liveval_array_infos(VarInfos, VarNumMap,
0, BytesLimit, IntArrayInfo, ByteArrayInfo, !Info),
list__length(IntArrayInfo, IntArrayLength),
list__length(ByteArrayInfo, ByteArrayLength),
list__append(IntArrayInfo, ByteArrayInfo, AllArrayInfo),
- EncodedLength = IntArrayLength << stack_layout__short_count_bits
- + ByteArrayLength,
+ EncodedLength = IntArrayLength << short_count_bits + ByteArrayLength,
SelectLocns = (pred(ArrayInfo::in, LocnRval::out) is det :-
ArrayInfo = live_array_info(LocnRval, _, _, _)
@@ -1121,8 +1100,7 @@
SelectTypes = (pred(ArrayInfo::in, TypeRval - TypeType::out) is det :-
ArrayInfo = live_array_info(_, TypeRval, TypeType, _)
),
- AddRevNums = (pred(ArrayInfo::in, NumRvals0::in, NumRvals::out)
- is det :-
+ AddRevNums = (pred(ArrayInfo::in, NumRvals0::in, NumRvals::out) is det :-
ArrayInfo = live_array_info(_, _, _, NumRval),
NumRvals = [NumRval | NumRvals0]
),
@@ -1133,26 +1111,23 @@
list__map(SelectLocns, ByteArrayInfo, ByteLocns),
list__map(associate_type(uint_least8), ByteLocns, ByteLocnsTypes),
list__append(IntLocnsTypes, ByteLocnsTypes, AllLocnsTypes),
- list__append(AllTypeRvalsTypes, AllLocnsTypes,
- TypeLocnVectorRvalsTypes),
- stack_layout__get_static_cell_info(!.Info, StaticCellInfo0),
+ list__append(AllTypeRvalsTypes, AllLocnsTypes, TypeLocnVectorRvalsTypes),
+ get_static_cell_info(!.Info, StaticCellInfo0),
add_static_cell(TypeLocnVectorRvalsTypes, TypeLocnVectorAddr,
StaticCellInfo0, StaticCellInfo1),
TypeLocnVector = const(data_addr_const(TypeLocnVectorAddr, no)),
- stack_layout__set_static_cell_info(StaticCellInfo1, !Info),
+ set_static_cell_info(StaticCellInfo1, !Info),
- stack_layout__get_trace_stack_layout(!.Info, TraceStackLayout),
+ get_trace_stack_layout(!.Info, TraceStackLayout),
(
TraceStackLayout = yes,
- list__foldl(AddRevNums, AllArrayInfo,
- [], RevVarNumRvals),
+ list__foldl(AddRevNums, AllArrayInfo, [], RevVarNumRvals),
list__reverse(RevVarNumRvals, VarNumRvals),
- list__map(associate_type(uint_least16), VarNumRvals,
- VarNumRvalsTypes),
- stack_layout__get_static_cell_info(!.Info, StaticCellInfo2),
+ list__map(associate_type(uint_least16), VarNumRvals, VarNumRvalsTypes),
+ get_static_cell_info(!.Info, StaticCellInfo2),
add_static_cell(VarNumRvalsTypes, NumVectorAddr,
StaticCellInfo2, StaticCellInfo),
- stack_layout__set_static_cell_info(StaticCellInfo, !Info),
+ set_static_cell_info(StaticCellInfo, !Info),
NumVector = const(data_addr_const(NumVectorAddr, no))
;
TraceStackLayout = no,
@@ -1164,22 +1139,20 @@
associate_type(LldsType, Rval, Rval - LldsType).
-:- pred stack_layout__construct_liveval_array_infos(list(layout_var_info)::in,
+:- pred construct_liveval_array_infos(list(layout_var_info)::in,
var_num_map::in, int::in, int::in,
list(liveval_array_info)::out, list(liveval_array_info)::out,
stack_layout_info::in, stack_layout_info::out) is det.
-stack_layout__construct_liveval_array_infos([], _, _, _, [], [], !Info).
-stack_layout__construct_liveval_array_infos([VarInfo | VarInfos], VarNumMap,
+construct_liveval_array_infos([], _, _, _, [], [], !Info).
+construct_liveval_array_infos([VarInfo | VarInfos], VarNumMap,
BytesSoFar, BytesLimit, IntVars, ByteVars, !Info) :-
VarInfo = layout_var_info(Locn, LiveValueType, _),
- stack_layout__represent_live_value_type(LiveValueType, TypeRval,
- TypeRvalType, !Info),
- stack_layout__construct_liveval_num_rval(VarNumMap, VarInfo,
- VarNumRval, !Info),
+ represent_live_value_type(LiveValueType, TypeRval, TypeRvalType, !Info),
+ construct_liveval_num_rval(VarNumMap, VarInfo, VarNumRval, !Info),
(
LiveValueType = var(_, _, Type, _),
- stack_layout__get_module_info(!.Info, ModuleInfo),
+ get_module_info(!.Info, ModuleInfo),
is_dummy_argument_type(ModuleInfo, Type),
% We want to preserve I/O states in registers
\+ (
@@ -1190,49 +1163,44 @@
"unexpected reference to dummy value")
;
BytesSoFar < BytesLimit,
- stack_layout__represent_locn_as_byte(Locn, LocnByteRval)
+ represent_locn_as_byte(Locn, LocnByteRval)
->
Var = live_array_info(LocnByteRval, TypeRval, TypeRvalType,
VarNumRval),
- stack_layout__construct_liveval_array_infos(VarInfos,
- VarNumMap, BytesSoFar + 1, BytesLimit,
- IntVars, ByteVars0, !Info),
+ construct_liveval_array_infos(VarInfos, VarNumMap,
+ BytesSoFar + 1, BytesLimit, IntVars, ByteVars0, !Info),
ByteVars = [Var | ByteVars0]
;
- stack_layout__represent_locn_as_int_rval(Locn, LocnRval),
- Var = live_array_info(LocnRval, TypeRval, TypeRvalType,
- VarNumRval),
- stack_layout__construct_liveval_array_infos(VarInfos,
- VarNumMap, BytesSoFar, BytesLimit,
- IntVars0, ByteVars, !Info),
+ represent_locn_as_int_rval(Locn, LocnRval),
+ Var = live_array_info(LocnRval, TypeRval, TypeRvalType, VarNumRval),
+ construct_liveval_array_infos(VarInfos, VarNumMap,
+ BytesSoFar, BytesLimit, IntVars0, ByteVars, !Info),
IntVars = [Var | IntVars0]
).
-:- pred stack_layout__construct_liveval_num_rval(var_num_map::in,
+:- pred construct_liveval_num_rval(var_num_map::in,
layout_var_info::in, rval::out,
stack_layout_info::in, stack_layout_info::out) is det.
-stack_layout__construct_liveval_num_rval(VarNumMap,
+construct_liveval_num_rval(VarNumMap,
layout_var_info(_, LiveValueType, _), VarNumRval, !Info) :-
( LiveValueType = var(Var, _, _, _) ->
- stack_layout__convert_var_to_int(VarNumMap, Var, VarNum),
+ convert_var_to_int(VarNumMap, Var, VarNum),
VarNumRval = const(int_const(VarNum))
;
VarNumRval = const(int_const(0))
).
-:- pred stack_layout__convert_var_to_int(var_num_map::in, prog_var::in,
+:- pred convert_var_to_int(var_num_map::in, prog_var::in,
int::out) is det.
-stack_layout__convert_var_to_int(VarNumMap, Var, VarNum) :-
+convert_var_to_int(VarNumMap, Var, VarNum) :-
map__lookup(VarNumMap, Var, VarNum0 - _),
- % The variable number has to fit into two bytes.
- % We reserve the largest such number (Limit)
- % to mean that the variable number is too large
- % to be represented. This ought not to happen,
- % since compilation would be glacial at best
- % for procedures with that many variables.
- Limit = (1 << (2 * stack_layout__byte_bits)) - 1,
+ % The variable number has to fit into two bytes. We reserve the largest
+ % such number (Limit) to mean that the variable number is too large
+ % to be represented. This ought not to happen, since compilation
+ % would be glacial at best for procedures with that many variables.
+ Limit = (1 << (2 * byte_bits)) - 1,
int__min(VarNum0, Limit, VarNum).
%---------------------------------------------------------------------------%
@@ -1240,8 +1208,8 @@
% The representation we build here should be kept in sync
% with runtime/mercury_ho_call.h, which contains macros to access
% the data structures we build here.
-
-stack_layout__construct_closure_layout(CallerProcLabel, SeqNo,
+ %
+construct_closure_layout(CallerProcLabel, SeqNo,
ClosureLayoutInfo, ClosureProcLabel, ModuleName,
FileName, LineNumber, Origin, GoalPath, !StaticCellInfo,
RvalsTypes, Data) :-
@@ -1252,93 +1220,84 @@
GoalPath)),
ProcIdRvalType = const(data_addr_const(DataAddr, no)) - data_ptr,
ClosureLayoutInfo = closure_layout_info(ClosureArgs, TVarLocnMap),
- stack_layout__construct_closure_arg_rvals(ClosureArgs,
+ construct_closure_arg_rvals(ClosureArgs,
ClosureArgRvalsTypes, !StaticCellInfo),
- stack_layout__construct_tvar_vector(TVarLocnMap, TVarVectorRval,
- !StaticCellInfo),
+ construct_tvar_vector(TVarLocnMap, TVarVectorRval, !StaticCellInfo),
RvalsTypes = [ProcIdRvalType, TVarVectorRval - data_ptr |
ClosureArgRvalsTypes].
-:- pred stack_layout__construct_closure_arg_rvals(list(closure_arg_info)::in,
+:- pred construct_closure_arg_rvals(list(closure_arg_info)::in,
assoc_list(rval, llds_type)::out,
static_cell_info::in, static_cell_info::out) is det.
-stack_layout__construct_closure_arg_rvals(ClosureArgs, ClosureArgRvalsTypes,
+construct_closure_arg_rvals(ClosureArgs, ClosureArgRvalsTypes,
!StaticCellInfo) :-
- list__map_foldl(stack_layout__construct_closure_arg_rval,
- ClosureArgs, ArgRvalsTypes, !StaticCellInfo),
+ list__map_foldl(construct_closure_arg_rval, ClosureArgs, ArgRvalsTypes,
+ !StaticCellInfo),
list__length(ArgRvalsTypes, Length),
ClosureArgRvalsTypes =
[const(int_const(Length)) - integer | ArgRvalsTypes].
-:- pred stack_layout__construct_closure_arg_rval(closure_arg_info::in,
+:- pred construct_closure_arg_rval(closure_arg_info::in,
pair(rval, llds_type)::out,
static_cell_info::in, static_cell_info::out) is det.
-stack_layout__construct_closure_arg_rval(ClosureArg, ArgRval - ArgRvalType,
+construct_closure_arg_rval(ClosureArg, ArgRval - ArgRvalType,
!StaticCellInfo) :-
ClosureArg = closure_arg_info(Type, _Inst),
- % For a stack layout, we can treat all type variables as
- % universally quantified. This is not the argument of a
- % constructor, so we do not need to distinguish between type
- % variables that are and aren't in scope; we can take the
- % variable number directly from the procedure's tvar set.
+ % For a stack layout, we can treat all type variables as universally
+ % quantified. This is not the argument of a constructor, so we do not need
+ % to distinguish between type variables that are and aren't in scope;
+ % we can take the variable number directly from the procedure's tvar set.
ExistQTvars = [],
NumUnivQTvars = -1,
ll_pseudo_type_info__construct_typed_llds_pseudo_type_info(Type,
- NumUnivQTvars, ExistQTvars, !StaticCellInfo,
- ArgRval, ArgRvalType).
+ NumUnivQTvars, ExistQTvars, !StaticCellInfo, ArgRval, ArgRvalType).
%---------------------------------------------------------------------------%
-:- pred stack_layout__make_table_data(rtti_proc_label::in,
+:- pred make_table_data(rtti_proc_label::in,
proc_layout_kind::in, proc_table_info::in, layout_data::out,
static_cell_info::in, static_cell_info::out) is det.
-stack_layout__make_table_data(RttiProcLabel, Kind, TableInfo, TableData,
+make_table_data(RttiProcLabel, Kind, TableInfo, TableData,
!StaticCellInfo) :-
(
TableInfo = table_io_decl_info(TableArgInfo),
- stack_layout__convert_table_arg_info(TableArgInfo,
- NumPTIs, PTIVectorRval, TVarVectorRval,
- !StaticCellInfo),
+ convert_table_arg_info(TableArgInfo, NumPTIs, PTIVectorRval,
+ TVarVectorRval, !StaticCellInfo),
TableData = table_io_decl_data(RttiProcLabel, Kind,
NumPTIs, PTIVectorRval, TVarVectorRval)
;
TableInfo = table_gen_info(NumInputs, NumOutputs, Steps,
TableArgInfo),
- stack_layout__convert_table_arg_info(TableArgInfo,
- NumPTIs, PTIVectorRval, TVarVectorRval,
- !StaticCellInfo),
+ convert_table_arg_info(TableArgInfo, NumPTIs, PTIVectorRval,
+ TVarVectorRval, !StaticCellInfo),
NumArgs = NumInputs + NumOutputs,
- require(unify(NumArgs, NumPTIs),
- "stack_layout__make_table_data: args mismatch"),
- TableData = table_gen_data(RttiProcLabel,
- NumInputs, NumOutputs, Steps,
+ require(unify(NumArgs, NumPTIs), "make_table_data: args mismatch"),
+ TableData = table_gen_data(RttiProcLabel, NumInputs, NumOutputs, Steps,
PTIVectorRval, TVarVectorRval)
).
-:- pred stack_layout__convert_table_arg_info(table_arg_infos::in,
+:- pred convert_table_arg_info(table_arg_infos::in,
int::out, rval::out, rval::out,
static_cell_info::in, static_cell_info::out) is det.
-stack_layout__convert_table_arg_info(TableArgInfos, NumPTIs,
+convert_table_arg_info(TableArgInfos, NumPTIs,
PTIVectorRval, TVarVectorRval, !StaticCellInfo) :-
TableArgInfos = table_arg_infos(Args, TVarSlotMap),
list__length(Args, NumPTIs),
- list__map_foldl(stack_layout__construct_table_arg_pti_rval,
- Args, PTIRvalsTypes, !StaticCellInfo),
+ list__map_foldl(construct_table_arg_pti_rval, Args, PTIRvalsTypes,
+ !StaticCellInfo),
add_static_cell(PTIRvalsTypes, PTIVectorAddr, !StaticCellInfo),
PTIVectorRval = const(data_addr_const(PTIVectorAddr, no)),
- map__map_values(stack_layout__convert_slot_to_locn_map,
- TVarSlotMap, TVarLocnMap),
- stack_layout__construct_tvar_vector(TVarLocnMap, TVarVectorRval,
- !StaticCellInfo).
+ map__map_values(convert_slot_to_locn_map, TVarSlotMap, TVarLocnMap),
+ construct_tvar_vector(TVarLocnMap, TVarVectorRval, !StaticCellInfo).
-:- pred stack_layout__convert_slot_to_locn_map(tvar::in, table_locn::in,
+:- pred convert_slot_to_locn_map(tvar::in, table_locn::in,
set(layout_locn)::out) is det.
-stack_layout__convert_slot_to_locn_map(_TVar, SlotLocn, LvalLocns) :-
+convert_slot_to_locn_map(_TVar, SlotLocn, LvalLocns) :-
(
SlotLocn = direct(SlotNum),
LvalLocn = direct(reg(r, SlotNum))
@@ -1348,18 +1307,17 @@
),
LvalLocns = set__make_singleton_set(LvalLocn).
-:- pred stack_layout__construct_table_arg_pti_rval(
+:- pred construct_table_arg_pti_rval(
table_arg_info::in, pair(rval, llds_type)::out,
static_cell_info::in, static_cell_info::out) is det.
-stack_layout__construct_table_arg_pti_rval(ClosureArg,
- ArgRval - ArgRvalType, !StaticCellInfo) :-
+construct_table_arg_pti_rval(ClosureArg, ArgRval - ArgRvalType,
+ !StaticCellInfo) :-
ClosureArg = table_arg_info(_, _, Type),
ExistQTvars = [],
NumUnivQTvars = -1,
ll_pseudo_type_info__construct_typed_llds_pseudo_type_info(Type,
- NumUnivQTvars, ExistQTvars, !StaticCellInfo,
- ArgRval, ArgRvalType).
+ NumUnivQTvars, ExistQTvars, !StaticCellInfo, ArgRval, ArgRvalType).
%---------------------------------------------------------------------------%
@@ -1372,47 +1330,45 @@
% this will be a pointer to a specific type_ctor_info (acting as a
% type_info) defined by hand in builtin.m to stand for values of
% each such kind; one for succips, one for hps, etc.
-
-:- pred stack_layout__represent_live_value_type(live_value_type::in, rval::out,
+ %
+:- pred represent_live_value_type(live_value_type::in, rval::out,
llds_type::out, stack_layout_info::in, stack_layout_info::out) is det.
-stack_layout__represent_live_value_type(succip, Rval, data_ptr, !Info) :-
- stack_layout__represent_special_live_value_type("succip", Rval).
-stack_layout__represent_live_value_type(hp, Rval, data_ptr, !Info) :-
- stack_layout__represent_special_live_value_type("hp", Rval).
-stack_layout__represent_live_value_type(curfr, Rval, data_ptr, !Info) :-
- stack_layout__represent_special_live_value_type("curfr", Rval).
-stack_layout__represent_live_value_type(maxfr, Rval, data_ptr, !Info) :-
- stack_layout__represent_special_live_value_type("maxfr", Rval).
-stack_layout__represent_live_value_type(redofr, Rval, data_ptr, !Info) :-
- stack_layout__represent_special_live_value_type("redofr", Rval).
-stack_layout__represent_live_value_type(redoip, Rval, data_ptr, !Info) :-
- stack_layout__represent_special_live_value_type("redoip", Rval).
-stack_layout__represent_live_value_type(trail_ptr, Rval, data_ptr, !Info) :-
- stack_layout__represent_special_live_value_type("trail_ptr", Rval).
-stack_layout__represent_live_value_type(ticket, Rval, data_ptr, !Info) :-
- stack_layout__represent_special_live_value_type("ticket", Rval).
-stack_layout__represent_live_value_type(unwanted, Rval, data_ptr, !Info) :-
- stack_layout__represent_special_live_value_type("unwanted", Rval).
-stack_layout__represent_live_value_type(var(_, _, Type, _), Rval, LldsType,
- !Info) :-
- % For a stack layout, we can treat all type variables as
- % universally quantified. This is not the argument of a
- % constructor, so we do not need to distinguish between type
- % variables that are and aren't in scope; we can take the
- % variable number directly from the procedure's tvar set.
+represent_live_value_type(succip, Rval, data_ptr, !Info) :-
+ represent_special_live_value_type("succip", Rval).
+represent_live_value_type(hp, Rval, data_ptr, !Info) :-
+ represent_special_live_value_type("hp", Rval).
+represent_live_value_type(curfr, Rval, data_ptr, !Info) :-
+ represent_special_live_value_type("curfr", Rval).
+represent_live_value_type(maxfr, Rval, data_ptr, !Info) :-
+ represent_special_live_value_type("maxfr", Rval).
+represent_live_value_type(redofr, Rval, data_ptr, !Info) :-
+ represent_special_live_value_type("redofr", Rval).
+represent_live_value_type(redoip, Rval, data_ptr, !Info) :-
+ represent_special_live_value_type("redoip", Rval).
+represent_live_value_type(trail_ptr, Rval, data_ptr, !Info) :-
+ represent_special_live_value_type("trail_ptr", Rval).
+represent_live_value_type(ticket, Rval, data_ptr, !Info) :-
+ represent_special_live_value_type("ticket", Rval).
+represent_live_value_type(unwanted, Rval, data_ptr, !Info) :-
+ represent_special_live_value_type("unwanted", Rval).
+represent_live_value_type(var(_, _, Type, _), Rval, LldsType, !Info) :-
+ % For a stack layout, we can treat all type variables as universally
+ % quantified. This is not the argument of a constructor, so we do not
+ % need to distinguish between type variables that are and aren't in scope;
+ % we can take the variable number directly from the procedure's tvar set.
ExistQTvars = [],
NumUnivQTvars = -1,
- stack_layout__get_static_cell_info(!.Info, StaticCellInfo0),
+ get_static_cell_info(!.Info, StaticCellInfo0),
ll_pseudo_type_info__construct_typed_llds_pseudo_type_info(Type,
NumUnivQTvars, ExistQTvars, StaticCellInfo0, StaticCellInfo,
Rval, LldsType),
- stack_layout__set_static_cell_info(StaticCellInfo, !Info).
+ set_static_cell_info(StaticCellInfo, !Info).
-:- pred stack_layout__represent_special_live_value_type(string::in, rval::out)
+:- pred represent_special_live_value_type(string::in, rval::out)
is det.
-stack_layout__represent_special_live_value_type(SpecialTypeName, Rval) :-
+represent_special_live_value_type(SpecialTypeName, Rval) :-
RttiTypeCtor = rtti_type_ctor(unqualified(""), SpecialTypeName, 0),
DataAddr = rtti_addr(ctor_rtti_id(RttiTypeCtor, type_ctor_info)),
Rval = const(data_addr_const(DataAddr, no)).
@@ -1433,68 +1389,66 @@
% cannot be nested inside typeclass_infos any deeper than this.
% A more general representation that would allow more indirection
% would be much harder to fit into one machine word.
+ %
+:- pred represent_locn_as_int_rval(layout_locn::in, rval::out) is det.
-:- pred stack_layout__represent_locn_as_int_rval(layout_locn::in, rval::out)
- is det.
-
-stack_layout__represent_locn_as_int_rval(Locn, Rval) :-
- stack_layout__represent_locn_as_int(Locn, Word),
+represent_locn_as_int_rval(Locn, Rval) :-
+ represent_locn_as_int(Locn, Word),
Rval = const(int_const(Word)).
-stack_layout__represent_locn_as_int(direct(Lval), Word) :-
- stack_layout__represent_lval(Lval, Word).
-stack_layout__represent_locn_as_int(indirect(Lval, Offset), Word) :-
- stack_layout__represent_lval(Lval, BaseWord),
- require((1 << stack_layout__long_lval_offset_bits) > Offset,
- "stack_layout__represent_locn: offset too large to be represented"),
- BaseAndOffset is (BaseWord << stack_layout__long_lval_offset_bits)
- + Offset,
- stack_layout__make_tagged_word(lval_indirect, BaseAndOffset, Word).
+represent_locn_as_int(direct(Lval), Word) :-
+ represent_lval(Lval, Word).
+represent_locn_as_int(indirect(Lval, Offset), Word) :-
+ represent_lval(Lval, BaseWord),
+ require((1 << long_lval_offset_bits) > Offset,
+ "represent_locn: offset too large to be represented"),
+ BaseAndOffset is (BaseWord << long_lval_offset_bits) + Offset,
+ make_tagged_word(lval_indirect, BaseAndOffset, Word).
% Construct a four byte representation of an lval.
+ %
+:- pred represent_lval(lval::in, int::out) is det.
-:- pred stack_layout__represent_lval(lval::in, int::out) is det.
-
-stack_layout__represent_lval(reg(r, Num), Word) :-
- stack_layout__make_tagged_word(lval_r_reg, Num, Word).
-stack_layout__represent_lval(reg(f, Num), Word) :-
- stack_layout__make_tagged_word(lval_f_reg, Num, Word).
-stack_layout__represent_lval(stackvar(Num), Word) :-
- require(Num > 0, "stack_layout__represent_lval: bad stackvar"),
- stack_layout__make_tagged_word(lval_stackvar, Num, Word).
-stack_layout__represent_lval(framevar(Num), Word) :-
- require(Num > 0, "stack_layout__represent_lval: bad framevar"),
- stack_layout__make_tagged_word(lval_framevar, Num, Word).
-stack_layout__represent_lval(succip, Word) :-
- stack_layout__make_tagged_word(lval_succip, 0, Word).
-stack_layout__represent_lval(maxfr, Word) :-
- stack_layout__make_tagged_word(lval_maxfr, 0, Word).
-stack_layout__represent_lval(curfr, Word) :-
- stack_layout__make_tagged_word(lval_curfr, 0, Word).
-stack_layout__represent_lval(hp, Word) :-
- stack_layout__make_tagged_word(lval_hp, 0, Word).
-stack_layout__represent_lval(sp, Word) :-
- stack_layout__make_tagged_word(lval_sp, 0, Word).
+represent_lval(reg(r, Num), Word) :-
+ make_tagged_word(lval_r_reg, Num, Word).
+represent_lval(reg(f, Num), Word) :-
+ make_tagged_word(lval_f_reg, Num, Word).
+represent_lval(stackvar(Num), Word) :-
+ require(Num > 0, "represent_lval: bad stackvar"),
+ make_tagged_word(lval_stackvar, Num, Word).
+represent_lval(framevar(Num), Word) :-
+ require(Num > 0, "represent_lval: bad framevar"),
+ make_tagged_word(lval_framevar, Num, Word).
+represent_lval(succip, Word) :-
+ make_tagged_word(lval_succip, 0, Word).
+represent_lval(maxfr, Word) :-
+ make_tagged_word(lval_maxfr, 0, Word).
+represent_lval(curfr, Word) :-
+ make_tagged_word(lval_curfr, 0, Word).
+represent_lval(hp, Word) :-
+ make_tagged_word(lval_hp, 0, Word).
+represent_lval(sp, Word) :-
+ make_tagged_word(lval_sp, 0, Word).
-stack_layout__represent_lval(temp(_, _), _) :-
+represent_lval(temp(_, _), _) :-
error("stack_layout: continuation live value stored in temp register").
-stack_layout__represent_lval(succip(_), _) :-
+represent_lval(succip(_), _) :-
error("stack_layout: continuation live value stored in fixed slot").
-stack_layout__represent_lval(redoip(_), _) :-
+represent_lval(redoip(_), _) :-
error("stack_layout: continuation live value stored in fixed slot").
-stack_layout__represent_lval(redofr(_), _) :-
+represent_lval(redofr(_), _) :-
error("stack_layout: continuation live value stored in fixed slot").
-stack_layout__represent_lval(succfr(_), _) :-
+represent_lval(succfr(_), _) :-
error("stack_layout: continuation live value stored in fixed slot").
-stack_layout__represent_lval(prevfr(_), _) :-
+represent_lval(prevfr(_), _) :-
error("stack_layout: continuation live value stored in fixed slot").
-stack_layout__represent_lval(field(_, _, _), _) :-
+represent_lval(field(_, _, _), _) :-
error("stack_layout: continuation live value stored in field").
-stack_layout__represent_lval(mem_ref(_), _) :-
+represent_lval(mem_ref(_), _) :-
error("stack_layout: continuation live value stored in mem_ref").
-stack_layout__represent_lval(lvar(_), _) :-
+represent_lval(lvar(_), _) :-
error("stack_layout: continuation live value stored in lvar").
% Some things in this module are encoded using a low tag.
@@ -1503,12 +1457,12 @@
%
% This allows us to use more than the usual 2 or 3 bits, but
% we have to use low tags and cannot tag pointers this way.
+ %
+:- pred make_tagged_word(locn_type::in, int::in, int::out) is det.
-:- pred stack_layout__make_tagged_word(locn_type::in, int::in, int::out) is det.
-
-stack_layout__make_tagged_word(Locn, Value, TaggedValue) :-
- stack_layout__locn_type_code(Locn, Tag),
- TaggedValue is (Value << stack_layout__long_lval_tag_bits) + Tag.
+make_tagged_word(Locn, Value, TaggedValue) :-
+ locn_type_code(Locn, Tag),
+ TaggedValue is (Value << long_lval_tag_bits) + Tag.
:- type locn_type
---> lval_r_reg
@@ -1522,98 +1476,94 @@
; lval_sp
; lval_indirect.
-:- pred stack_layout__locn_type_code(locn_type::in, int::out) is det.
-
-stack_layout__locn_type_code(lval_r_reg, 0).
-stack_layout__locn_type_code(lval_f_reg, 1).
-stack_layout__locn_type_code(lval_stackvar, 2).
-stack_layout__locn_type_code(lval_framevar, 3).
-stack_layout__locn_type_code(lval_succip, 4).
-stack_layout__locn_type_code(lval_maxfr, 5).
-stack_layout__locn_type_code(lval_curfr, 6).
-stack_layout__locn_type_code(lval_hp, 7).
-stack_layout__locn_type_code(lval_sp, 8).
-stack_layout__locn_type_code(lval_indirect, 9).
-
-:- func stack_layout__long_lval_tag_bits = int.
-
-% This number of tag bits must be able to encode all values of
-% stack_layout__locn_type_code.
+:- pred locn_type_code(locn_type::in, int::out) is det.
-stack_layout__long_lval_tag_bits = 4.
+locn_type_code(lval_r_reg, 0).
+locn_type_code(lval_f_reg, 1).
+locn_type_code(lval_stackvar, 2).
+locn_type_code(lval_framevar, 3).
+locn_type_code(lval_succip, 4).
+locn_type_code(lval_maxfr, 5).
+locn_type_code(lval_curfr, 6).
+locn_type_code(lval_hp, 7).
+locn_type_code(lval_sp, 8).
+locn_type_code(lval_indirect, 9).
+
+ % This number of tag bits must be able to encode all values of
+ % locn_type_code.
+:- func long_lval_tag_bits = int.
+
+long_lval_tag_bits = 4.
+
+ % This number of tag bits must be able to encode the largest offset
+ % of a type_info within a typeclass_info.
+:- func long_lval_offset_bits = int.
-% This number of tag bits must be able to encode the largest offset
-% of a type_info within a typeclass_info.
-
-:- func stack_layout__long_lval_offset_bits = int.
-
-stack_layout__long_lval_offset_bits = 6.
+long_lval_offset_bits = 6.
%---------------------------------------------------------------------------%
% Construct a representation of a variable location as a byte,
% if this is possible.
+ %
+:- pred represent_locn_as_byte(layout_locn::in, rval::out) is semidet.
-:- pred stack_layout__represent_locn_as_byte(layout_locn::in, rval::out)
- is semidet.
-
-stack_layout__represent_locn_as_byte(LayoutLocn, Rval) :-
+represent_locn_as_byte(LayoutLocn, Rval) :-
LayoutLocn = direct(Lval),
- stack_layout__represent_lval_as_byte(Lval, Byte),
+ represent_lval_as_byte(Lval, Byte),
0 =< Byte,
Byte < 256,
Rval = const(int_const(Byte)).
% Construct a representation of an lval in a byte, if possible.
+ %
+:- pred represent_lval_as_byte(lval::in, int::out) is semidet.
+
+represent_lval_as_byte(reg(r, Num), Byte) :-
+ require(Num > 0, "represent_lval_as_byte: bad reg"),
+ make_tagged_byte(0, Num, Byte).
+represent_lval_as_byte(stackvar(Num), Byte) :-
+ require(Num > 0, "represent_lval_as_byte: bad stackvar"),
+ make_tagged_byte(1, Num, Byte).
+represent_lval_as_byte(framevar(Num), Byte) :-
+ require(Num > 0, "represent_lval_as_byte: bad framevar"),
+ make_tagged_byte(2, Num, Byte).
+represent_lval_as_byte(succip, Byte) :-
+ locn_type_code(lval_succip, Val),
+ make_tagged_byte(3, Val, Byte).
+represent_lval_as_byte(maxfr, Byte) :-
+ locn_type_code(lval_maxfr, Val),
+ make_tagged_byte(3, Val, Byte).
+represent_lval_as_byte(curfr, Byte) :-
+ locn_type_code(lval_curfr, Val),
+ make_tagged_byte(3, Val, Byte).
+represent_lval_as_byte(hp, Byte) :-
+ locn_type_code(lval_hp, Val),
+ make_tagged_byte(3, Val, Byte).
+represent_lval_as_byte(sp, Byte) :-
+ locn_type_code(lval_sp, Val),
+ make_tagged_byte(3, Val, Byte).
+
+:- pred make_tagged_byte(int::in, int::in, int::out) is det.
+
+make_tagged_byte(Tag, Value, TaggedValue) :-
+ TaggedValue is unchecked_left_shift(Value, short_lval_tag_bits) + Tag.
-:- pred stack_layout__represent_lval_as_byte(lval::in, int::out) is semidet.
+:- func short_lval_tag_bits = int.
-stack_layout__represent_lval_as_byte(reg(r, Num), Byte) :-
- require(Num > 0, "stack_layout__represent_lval_as_byte: bad reg"),
- stack_layout__make_tagged_byte(0, Num, Byte).
-stack_layout__represent_lval_as_byte(stackvar(Num), Byte) :-
- require(Num > 0, "stack_layout__represent_lval_as_byte: bad stackvar"),
- stack_layout__make_tagged_byte(1, Num, Byte).
-stack_layout__represent_lval_as_byte(framevar(Num), Byte) :-
- require(Num > 0, "stack_layout__represent_lval_as_byte: bad framevar"),
- stack_layout__make_tagged_byte(2, Num, Byte).
-stack_layout__represent_lval_as_byte(succip, Byte) :-
- stack_layout__locn_type_code(lval_succip, Val),
- stack_layout__make_tagged_byte(3, Val, Byte).
-stack_layout__represent_lval_as_byte(maxfr, Byte) :-
- stack_layout__locn_type_code(lval_maxfr, Val),
- stack_layout__make_tagged_byte(3, Val, Byte).
-stack_layout__represent_lval_as_byte(curfr, Byte) :-
- stack_layout__locn_type_code(lval_curfr, Val),
- stack_layout__make_tagged_byte(3, Val, Byte).
-stack_layout__represent_lval_as_byte(hp, Byte) :-
- stack_layout__locn_type_code(lval_hp, Val),
- stack_layout__make_tagged_byte(3, Val, Byte).
-stack_layout__represent_lval_as_byte(sp, Byte) :-
- stack_layout__locn_type_code(lval_sp, Val),
- stack_layout__make_tagged_byte(3, Val, Byte).
-
-:- pred stack_layout__make_tagged_byte(int::in, int::in, int::out) is det.
-
-stack_layout__make_tagged_byte(Tag, Value, TaggedValue) :-
- TaggedValue is unchecked_left_shift(Value,
- stack_layout__short_lval_tag_bits) + Tag.
-
-:- func stack_layout__short_lval_tag_bits = int.
-
-stack_layout__short_lval_tag_bits = 2.
-
-:- func stack_layout__short_count_bits = int.
-
-stack_layout__short_count_bits = 10.
+short_lval_tag_bits = 2.
-:- func stack_layout__byte_bits = int.
+:- func short_count_bits = int.
-stack_layout__byte_bits = 8.
+short_count_bits = 10.
+
+:- func byte_bits = int.
+
+byte_bits = 8.
%---------------------------------------------------------------------------%
-stack_layout__represent_determinism_rval(Detism,
+represent_determinism_rval(Detism,
const(int_const(code_model__represent_determinism(Detism)))).
%---------------------------------------------------------------------------%
@@ -1634,8 +1584,8 @@
:- type label_table == map(int, list(line_no_info)).
-:- type stack_layout_info --->
- stack_layout_info(
+:- type stack_layout_info
+ ---> stack_layout_info(
module_info :: module_info,
agc_stack_layout :: bool, % generate agc info?
trace_stack_layout :: bool, % generate tracing info?
@@ -1660,115 +1610,114 @@
static_cell_info :: static_cell_info
).
-:- pred stack_layout__get_module_info(stack_layout_info::in,
+:- pred get_module_info(stack_layout_info::in,
module_info::out) is det.
-:- pred stack_layout__get_agc_stack_layout(stack_layout_info::in,
+:- pred get_agc_stack_layout(stack_layout_info::in,
bool::out) is det.
-:- pred stack_layout__get_trace_stack_layout(stack_layout_info::in,
+:- pred get_trace_stack_layout(stack_layout_info::in,
bool::out) is det.
-:- pred stack_layout__get_procid_stack_layout(stack_layout_info::in,
+:- pred get_procid_stack_layout(stack_layout_info::in,
bool::out) is det.
-:- pred stack_layout__get_static_code_addresses(stack_layout_info::in,
+:- pred get_static_code_addresses(stack_layout_info::in,
bool::out) is det.
-:- pred stack_layout__get_table_infos(stack_layout_info::in,
+:- pred get_table_infos(stack_layout_info::in,
list(comp_gen_c_data)::out) is det.
-:- pred stack_layout__get_proc_layout_data(stack_layout_info::in,
+:- pred get_proc_layout_data(stack_layout_info::in,
list(comp_gen_c_data)::out) is det.
-:- pred stack_layout__get_internal_layout_data(stack_layout_info::in,
+:- pred get_internal_layout_data(stack_layout_info::in,
list(comp_gen_c_data)::out) is det.
-:- pred stack_layout__get_label_set(stack_layout_info::in,
+:- pred get_label_set(stack_layout_info::in,
map(label, data_addr)::out) is det.
-:- pred stack_layout__get_string_table(stack_layout_info::in,
+:- pred get_string_table(stack_layout_info::in,
string_table::out) is det.
-:- pred stack_layout__get_label_tables(stack_layout_info::in,
+:- pred get_label_tables(stack_layout_info::in,
map(string, label_table)::out) is det.
-:- pred stack_layout__get_static_cell_info(stack_layout_info::in,
+:- pred get_static_cell_info(stack_layout_info::in,
static_cell_info::out) is det.
-stack_layout__get_module_info(LI, LI ^ module_info).
-stack_layout__get_agc_stack_layout(LI, LI ^ agc_stack_layout).
-stack_layout__get_trace_stack_layout(LI, LI ^ trace_stack_layout).
-stack_layout__get_procid_stack_layout(LI, LI ^ procid_stack_layout).
-stack_layout__get_static_code_addresses(LI, LI ^ static_code_addresses).
-stack_layout__get_table_infos(LI, LI ^ table_infos).
-stack_layout__get_proc_layout_data(LI, LI ^ proc_layouts).
-stack_layout__get_internal_layout_data(LI, LI ^ internal_layouts).
-stack_layout__get_label_set(LI, LI ^ label_set).
-stack_layout__get_string_table(LI, LI ^ string_table).
-stack_layout__get_label_tables(LI, LI ^ label_tables).
-stack_layout__get_static_cell_info(LI, LI ^ static_cell_info).
+get_module_info(LI, LI ^ module_info).
+get_agc_stack_layout(LI, LI ^ agc_stack_layout).
+get_trace_stack_layout(LI, LI ^ trace_stack_layout).
+get_procid_stack_layout(LI, LI ^ procid_stack_layout).
+get_static_code_addresses(LI, LI ^ static_code_addresses).
+get_table_infos(LI, LI ^ table_infos).
+get_proc_layout_data(LI, LI ^ proc_layouts).
+get_internal_layout_data(LI, LI ^ internal_layouts).
+get_label_set(LI, LI ^ label_set).
+get_string_table(LI, LI ^ string_table).
+get_label_tables(LI, LI ^ label_tables).
+get_static_cell_info(LI, LI ^ static_cell_info).
-:- pred stack_layout__allocate_label_number(int::out,
+:- pred allocate_label_number(int::out,
stack_layout_info::in, stack_layout_info::out) is det.
-stack_layout__allocate_label_number(LabelNum, !LI) :-
+allocate_label_number(LabelNum, !LI) :-
Counter0 = !.LI ^ label_counter,
counter__allocate(LabelNum, Counter0, Counter),
!:LI = !.LI ^ label_counter := Counter.
-:- pred stack_layout__add_table_data(layout_data::in,
+:- pred add_table_data(layout_data::in,
stack_layout_info::in, stack_layout_info::out) is det.
-stack_layout__add_table_data(TableIoDeclData, !LI) :-
+add_table_data(TableIoDeclData, !LI) :-
TableIoDecls0 = !.LI ^ table_infos,
TableIoDecls = [layout_data(TableIoDeclData) | TableIoDecls0],
!:LI = !.LI ^ table_infos := TableIoDecls.
-:- pred stack_layout__add_proc_layout_data(comp_gen_c_data::in,
+:- pred add_proc_layout_data(comp_gen_c_data::in,
layout_name::in, label::in,
stack_layout_info::in, stack_layout_info::out) is det.
-stack_layout__add_proc_layout_data(ProcLayout, ProcLayoutName, Label, !LI) :-
+add_proc_layout_data(ProcLayout, ProcLayoutName, Label, !LI) :-
ProcLayouts0 = !.LI ^ proc_layouts,
ProcLayouts = [ProcLayout | ProcLayouts0],
LabelSet0 = !.LI ^ label_set,
- map__det_insert(LabelSet0, Label, layout_addr(ProcLayoutName),
- LabelSet),
+ map__det_insert(LabelSet0, Label, layout_addr(ProcLayoutName), LabelSet),
ProcLayoutNames0 = !.LI ^ proc_layout_name_list,
ProcLayoutNames = [ProcLayoutName | ProcLayoutNames0],
- !:LI = (((!.LI ^ proc_layouts := ProcLayouts)
- ^ label_set := LabelSet)
- ^ proc_layout_name_list := ProcLayoutNames).
+ !:LI = !.LI ^ proc_layouts := ProcLayouts,
+ !:LI = !.LI ^ label_set := LabelSet,
+ !:LI = !.LI ^ proc_layout_name_list := ProcLayoutNames.
-:- pred stack_layout__add_internal_layout_data(comp_gen_c_data::in,
+:- pred add_internal_layout_data(comp_gen_c_data::in,
label::in, layout_name::in, stack_layout_info::in,
stack_layout_info::out) is det.
-stack_layout__add_internal_layout_data(InternalLayout, Label, LayoutName,
+add_internal_layout_data(InternalLayout, Label, LayoutName,
!LI) :-
InternalLayouts0 = !.LI ^ internal_layouts,
InternalLayouts = [InternalLayout | InternalLayouts0],
LabelSet0 = !.LI ^ label_set,
map__det_insert(LabelSet0, Label, layout_addr(LayoutName), LabelSet),
- !:LI = ((!.LI ^ internal_layouts := InternalLayouts)
- ^ label_set := LabelSet).
+ !:LI = !.LI ^ internal_layouts := InternalLayouts,
+ !:LI = !.LI ^ label_set := LabelSet.
-:- pred stack_layout__set_string_table(string_table::in,
+:- pred set_string_table(string_table::in,
stack_layout_info::in, stack_layout_info::out) is det.
-:- pred stack_layout__set_label_tables(map(string, label_table)::in,
+:- pred set_label_tables(map(string, label_table)::in,
stack_layout_info::in, stack_layout_info::out) is det.
-:- pred stack_layout__set_static_cell_info(static_cell_info::in,
+:- pred set_static_cell_info(static_cell_info::in,
stack_layout_info::in, stack_layout_info::out) is det.
-stack_layout__set_string_table(ST, LI, LI ^ string_table := ST).
-stack_layout__set_label_tables(LT, LI, LI ^ label_tables := LT).
-stack_layout__set_static_cell_info(SCI, LI, LI ^ static_cell_info := SCI).
+set_string_table(ST, LI, LI ^ string_table := ST).
+set_label_tables(LT, LI, LI ^ label_tables := LT).
+set_static_cell_info(SCI, LI, LI ^ static_cell_info := SCI).
%---------------------------------------------------------------------------%
+%
+% Access to the string_table data structure.
- % Access to the string_table data structure.
-
-:- type string_table --->
- string_table(
+:- type string_table
+ ---> string_table(
map(string, int), % Maps strings to their offsets.
list(string), % List of strings so far,
% in reverse order.
int % Next available offset
).
-stack_layout__lookup_string_in_table(String, Offset, !Info) :-
+lookup_string_in_table(String, Offset, !Info) :-
StringTable0 = !.Info ^ string_table,
StringTable0 = string_table(TableMap0, TableList0, TableOffset0),
( map__search(TableMap0, String, OldOffset) ->
@@ -1786,14 +1735,13 @@
% next several years anyway. (Compiling a module that has
% a 1 Gb string table will require several tens of Gb
% of other compiler structures.)
- TableOffset < (1 << ((4 * stack_layout__byte_bits) - 2))
+ TableOffset < (1 << ((4 * byte_bits) - 2))
->
Offset = TableOffset0,
- map__det_insert(TableMap0, String, TableOffset0,
- TableMap),
+ map__det_insert(TableMap0, String, TableOffset0, TableMap),
TableList = [String | TableList0],
StringTable = string_table(TableMap, TableList, TableOffset),
- stack_layout__set_string_table(StringTable, !Info)
+ set_string_table(StringTable, !Info)
;
% Says that the name of the variable is "TOO_MANY_VARIABLES".
Offset = 1
Index: compiler/stack_opt.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/stack_opt.m,v
retrieving revision 1.20
diff -u -b -r1.20 stack_opt.m
--- compiler/stack_opt.m 11 Oct 2005 03:17:23 -0000 1.20
+++ compiler/stack_opt.m 17 Oct 2005 17:25:18 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 2002-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -130,13 +132,13 @@
% moment, the only variables we treat this way are those that are required to
% be on the stack by a parallel conjunction.
-:- type opt_stack_alloc --->
- opt_stack_alloc(
+:- type opt_stack_alloc
+ ---> opt_stack_alloc(
par_conj_own_slots :: set(prog_var)
).
-:- type stack_opt_params --->
- stack_opt_params(
+:- type stack_opt_params
+ ---> stack_opt_params(
matching_params :: matching_params,
all_path_node_ratio :: int,
fixpoint_loop :: bool,
@@ -145,8 +147,8 @@
non_candidate_vars :: set(prog_var)
).
-:- type matching_result --->
- matching_result(
+:- type matching_result
+ ---> matching_result(
prog_var,
cons_id,
list(prog_var),
@@ -158,8 +160,8 @@
set(anchor)
).
-:- type stack_opt_info --->
- stack_opt_info(
+:- type stack_opt_info
+ ---> stack_opt_info(
stack_opt_params :: stack_opt_params,
left_anchor_inserts :: insert_map,
matching_results :: list(matching_result)
@@ -197,20 +199,14 @@
Changed, DebugStackOpt, PredIdInt, !IO),
(
Changed = yes,
- maybe_write_progress_message(
- "\nafter stack opt transformation",
- DebugStackOpt, PredIdInt, !.ProcInfo, !.ModuleInfo,
- !IO),
+ maybe_write_progress_message("\nafter stack opt transformation",
+ DebugStackOpt, PredIdInt, !.ProcInfo, !.ModuleInfo, !IO),
requantify_proc(!ProcInfo),
- maybe_write_progress_message(
- "\nafter stack opt requantify",
- DebugStackOpt, PredIdInt, !.ProcInfo, !.ModuleInfo,
- !IO),
+ maybe_write_progress_message("\nafter stack opt requantify",
+ DebugStackOpt, PredIdInt, !.ProcInfo, !.ModuleInfo, !IO),
recompute_instmap_delta_proc(yes, !ProcInfo, !ModuleInfo),
- maybe_write_progress_message(
- "\nafter stack opt recompute instmaps",
- DebugStackOpt, PredIdInt, !.ProcInfo, !.ModuleInfo,
- !IO)
+ maybe_write_progress_message("\nafter stack opt recompute instmaps",
+ DebugStackOpt, PredIdInt, !.ProcInfo, !.ModuleInfo, !IO)
;
Changed = no
).
@@ -420,19 +416,17 @@
AfterModelNon, InsertAnchors, InsertIntervals),
(
FreeOfCost = yes,
- set__difference(CandidateArgVars0, RelevantAfterVars,
- ViaCellVars),
- record_matching_result(CellVar, ConsId,
- FieldVarList, ViaCellVars, Goal,
- InsertAnchors, InsertIntervals, !IntervalInfo,
+ set__difference(CandidateArgVars0, RelevantAfterVars, ViaCellVars),
+ record_matching_result(CellVar, ConsId, FieldVarList, ViaCellVars,
+ Goal, InsertAnchors, InsertIntervals, !IntervalInfo,
!StackOptInfo)
;
FreeOfCost = no,
(
AfterModelNon = no,
OnStack = StackOptParams ^ on_stack,
- set__difference(CandidateArgVars0,
- RelevantAfterVars, CandidateArgVars),
+ set__difference(CandidateArgVars0, RelevantAfterVars,
+ CandidateArgVars),
(
OnStack = yes,
( set__member(CellVar, FlushedLater) ->
@@ -443,12 +437,9 @@
;
OnStack = no,
(
- list__member(PathInfo,
- PathsInfo),
- PathInfo = match_path_info(_,
- Segments),
- list__member(Segment,
- Segments),
+ list__member(PathInfo, PathsInfo),
+ PathInfo = match_path_info(_, Segments),
+ list__member(Segment, Segments),
set__member(CellVar, Segment)
->
CellVarFlushedLater = yes
@@ -456,12 +447,10 @@
CellVarFlushedLater = no
)
),
- apply_matching(CellVar, CellVarFlushedLater,
- IntParams, StackOptParams, PathsInfo,
- CandidateArgVars, ViaCellVars),
- record_matching_result(CellVar, ConsId,
- FieldVarList, ViaCellVars, Goal,
- InsertAnchors, InsertIntervals,
+ apply_matching(CellVar, CellVarFlushedLater, IntParams,
+ StackOptParams, PathsInfo, CandidateArgVars, ViaCellVars),
+ record_matching_result(CellVar, ConsId, FieldVarList,
+ ViaCellVars, Goal, InsertAnchors, InsertIntervals,
!IntervalInfo, !StackOptInfo)
;
AfterModelNon = yes
@@ -478,9 +467,8 @@
apply_matching(CellVar, CellVarFlushedLater, IntParams, StackOptParams,
PathInfos, CandidateArgVars0, ViaCellVars) :-
apply_matching_loop(CellVar, CellVarFlushedLater, IntParams,
- StackOptParams, PathInfos,
- CandidateArgVars0, BenefitNodeSets, CostNodeSets,
- ViaCellVars0),
+ StackOptParams, PathInfos, CandidateArgVars0,
+ BenefitNodeSets, CostNodeSets, ViaCellVars0),
BenefitNodes = set__union_list(BenefitNodeSets),
CostNodes = set__union_list(CostNodeSets),
set__count(BenefitNodes, NumBenefitNodes),
@@ -522,20 +510,17 @@
;
FixpointLoop = yes,
apply_matching_loop(CellVar, CellVarFlushedLater,
- IntParams, StackOptParams, PathInfos,
- CandidateArgVars1,
+ IntParams, StackOptParams, PathInfos, CandidateArgVars1,
BenefitNodeSets, CostNodeSets, ViaCellVars)
)
).
:- pred apply_matching_for_path(prog_var::in, bool::in, stack_opt_params::in,
set(prog_var)::in, match_path_info::in,
- set(benefit_node)::out, set(cost_node)::out, set(prog_var)::out)
- is det.
+ set(benefit_node)::out, set(cost_node)::out, set(prog_var)::out) is det.
apply_matching_for_path(CellVar, CellVarFlushedLater, StackOptParams,
- CandidateArgVars, PathInfo, BenefitNodes, CostNodes,
- ViaCellVars) :-
+ CandidateArgVars, PathInfo, BenefitNodes, CostNodes, ViaCellVars) :-
( set__empty(CandidateArgVars) ->
BenefitNodes = set__init,
CostNodes = set__init,
@@ -543,9 +528,9 @@
;
PathInfo = match_path_info(FirstSegment, LaterSegments),
MatchingParams = StackOptParams ^ matching_params,
- find_via_cell_vars(CellVar, CandidateArgVars,
- CellVarFlushedLater, FirstSegment, LaterSegments,
- MatchingParams, BenefitNodes, CostNodes, ViaCellVars)
+ find_via_cell_vars(CellVar, CandidateArgVars, CellVarFlushedLater,
+ FirstSegment, LaterSegments, MatchingParams,
+ BenefitNodes, CostNodes, ViaCellVars)
).
:- pred record_matching_result(prog_var::in, cons_id::in, list(prog_var)::in,
@@ -554,23 +539,17 @@
stack_opt_info::in, stack_opt_info::out) is det.
record_matching_result(CellVar, ConsId, ArgVars, ViaCellVars, Goal,
- PotentialAnchors, PotentialIntervals,
- IntervalInfo0, IntervalInfo, StackOptInfo0, StackOptInfo) :-
+ PotentialAnchors, PotentialIntervals, !IntervalInfo, !StackOptInfo) :-
( set__empty(ViaCellVars) ->
- IntervalInfo = IntervalInfo0,
- StackOptInfo = StackOptInfo0
+ true
;
set__to_sorted_list(PotentialIntervals, PotentialIntervalList),
set__to_sorted_list(PotentialAnchors, PotentialAnchorList),
- list__foldl3(
- record_cell_var_for_interval(CellVar, ViaCellVars),
- PotentialIntervalList, IntervalInfo0, IntervalInfo1,
- StackOptInfo0, StackOptInfo1,
+ list__foldl3(record_cell_var_for_interval(CellVar, ViaCellVars),
+ PotentialIntervalList, !IntervalInfo, !StackOptInfo,
set__init, InsertIntervals),
- list__foldl3(
- add_anchor_inserts(Goal, ViaCellVars, InsertIntervals),
- PotentialAnchorList, IntervalInfo1, IntervalInfo2,
- StackOptInfo1, StackOptInfo2,
+ list__foldl3(add_anchor_inserts(Goal, ViaCellVars, InsertIntervals),
+ PotentialAnchorList, !IntervalInfo, !StackOptInfo,
set__init, InsertAnchors),
Goal = _ - GoalInfo,
goal_info_get_goal_path(GoalInfo, GoalPath),
@@ -578,11 +557,9 @@
ArgVars, ViaCellVars, GoalPath,
PotentialIntervals, InsertIntervals,
PotentialAnchors, InsertAnchors),
- MatchingResults0 = StackOptInfo2 ^ matching_results,
+ MatchingResults0 = !.StackOptInfo ^ matching_results,
MatchingResults = [MatchingResult | MatchingResults0],
- IntervalInfo = IntervalInfo2,
- StackOptInfo = StackOptInfo2
- ^ matching_results := MatchingResults
+ !:StackOptInfo = !.StackOptInfo ^ matching_results := MatchingResults
).
:- pred record_cell_var_for_interval(prog_var::in, set(prog_var)::in,
@@ -591,15 +568,13 @@
set(interval_id)::in, set(interval_id)::out) is det.
record_cell_var_for_interval(CellVar, ViaCellVars, IntervalId,
- !IntervalInfo, !StackOptInfo,
- InsertIntervals0, InsertIntervals) :-
+ !IntervalInfo, !StackOptInfo, !InsertIntervals) :-
record_interval_vars(IntervalId, [CellVar], !IntervalInfo),
- delete_interval_vars(IntervalId, ViaCellVars, DeletedVars,
- !IntervalInfo),
+ delete_interval_vars(IntervalId, ViaCellVars, DeletedVars, !IntervalInfo),
( set__non_empty(DeletedVars) ->
- svset__insert(IntervalId, InsertIntervals0, InsertIntervals)
+ svset__insert(IntervalId, !InsertIntervals)
;
- InsertIntervals = InsertIntervals0
+ true
).
:- pred add_anchor_inserts(hlds_goal::in, set(prog_var)::in,
@@ -618,15 +593,12 @@
InsertMap0 = !.StackOptInfo ^ left_anchor_inserts,
( map__search(InsertMap0, Anchor, Inserts0) ->
Inserts = [Insert | Inserts0],
- svmap__det_update(Anchor, Inserts,
- InsertMap0, InsertMap)
+ svmap__det_update(Anchor, Inserts, InsertMap0, InsertMap)
;
Inserts = [Insert],
- svmap__det_insert(Anchor, Inserts,
- InsertMap0, InsertMap)
+ svmap__det_insert(Anchor, Inserts, InsertMap0, InsertMap)
),
- !:StackOptInfo = !.StackOptInfo
- ^ left_anchor_inserts := InsertMap,
+ !:StackOptInfo = !.StackOptInfo ^ left_anchor_inserts := InsertMap,
svset__insert(Anchor, !InsertAnchors)
;
true
@@ -657,9 +629,8 @@
% Have we stepped over
% model_non goals?
used_after_scope :: set(prog_var)
- % The vars which are known
- % to be used after the
- % deconstruction goes out of
+ % The vars which are known to be used
+ % after the deconstruction goes out of
% scope.
).
@@ -703,8 +674,7 @@
CurSegment0 = !.Path ^ current_segment,
CurSegment = set__union(Vars, CurSegment0),
OccurringIntervals0 = !.Path ^ occurring_intervals,
- svset__insert(IntervalId,
- OccurringIntervals0, OccurringIntervals),
+ svset__insert(IntervalId, OccurringIntervals0, OccurringIntervals),
!:Path = !.Path ^ current_segment := CurSegment,
!:Path = !.Path ^ occurring_intervals := OccurringIntervals
).
@@ -722,8 +692,7 @@
anchor_requires_close(_, proc_end) = yes.
anchor_requires_close(IntervalInfo, branch_start(_, GoalPath)) =
resume_save_status_requires_close(ResumeSaveStatus) :-
- map__lookup(IntervalInfo ^ branch_resume_map, GoalPath,
- ResumeSaveStatus).
+ map__lookup(IntervalInfo ^ branch_resume_map, GoalPath, ResumeSaveStatus).
anchor_requires_close(_, cond_then(_)) = no.
anchor_requires_close(_, branch_end(BranchConstruct, _)) =
( BranchConstruct = neg ->
@@ -814,17 +783,16 @@
all_paths::in, all_paths::out) is det.
find_all_branches(RelevantVars, IntervalId, MaybeSearchAnchor0,
- IntervalInfo, StackOptInfo, AllPaths0, AllPaths) :-
+ IntervalInfo, StackOptInfo, !AllPaths) :-
map__lookup(IntervalInfo ^ interval_end, IntervalId, End),
map__lookup(IntervalInfo ^ interval_succ, IntervalId, SuccessorIds),
(
SuccessorIds = [],
require(may_have_no_successor(End),
- "find_all_branches: unexpected no successor"),
+ "find_all_branches: unexpected no successor")
% require(unify(MaybeSearchAnchor0, no),
% "find_all_branches: no successor while in search"),
% that test may fail if we come to a call that cannot succeed
- AllPaths = AllPaths0
;
SuccessorIds = [SuccessorId | MoreSuccessorIds],
(
@@ -840,30 +808,23 @@
MaybeSearchAnchor0 = yes(SearchAnchor0),
End = SearchAnchor0
->
- AllPaths0 = all_paths(Paths0, AfterModelNon, _),
- AllPaths = all_paths(Paths0, AfterModelNon, set__init)
+ !:AllPaths = !.AllPaths ^ used_after_scope := set__init
;
End = branch_end(_, EndGoalPath),
map__lookup(IntervalInfo ^ branch_end_map, EndGoalPath,
BranchEndInfo),
- OnStackAfterBranch =
- BranchEndInfo ^ flushed_after_branch,
- AccessedAfterBranch =
- BranchEndInfo ^ accessed_after_branch,
+ OnStackAfterBranch = BranchEndInfo ^ flushed_after_branch,
+ AccessedAfterBranch = BranchEndInfo ^ accessed_after_branch,
NeededAfterBranch = set__union(OnStackAfterBranch,
AccessedAfterBranch),
- RelevantAfter = set__intersect(RelevantVars,
- NeededAfterBranch),
+ RelevantAfter = set__intersect(RelevantVars, NeededAfterBranch),
set__non_empty(RelevantAfter)
->
- AllPaths0 = all_paths(Paths0, AfterModelNon, _),
- AllPaths = all_paths(Paths0, AfterModelNon,
- RelevantAfter)
+ !:AllPaths = !.AllPaths ^ used_after_scope := RelevantAfter
;
find_all_branches_from(End, RelevantVars,
MaybeSearchAnchor0, IntervalInfo, StackOptInfo,
- [SuccessorId | MoreSuccessorIds],
- AllPaths0, AllPaths)
+ [SuccessorId | MoreSuccessorIds], !AllPaths)
)
).
@@ -926,12 +887,10 @@
->
MaybeSearchAnchor1 = yes(branch_end(BranchType, EndGoalPath)),
list__map(apply_interval_find_all_branches_map(RelevantVars,
- MaybeSearchAnchor1, IntervalInfo, StackOptInfo,
- !.AllPaths),
+ MaybeSearchAnchor1, IntervalInfo, StackOptInfo, !.AllPaths),
SuccessorIds, AllPathsList),
consolidate_after_join(AllPathsList, !:AllPaths),
- map__lookup(IntervalInfo ^ branch_end_map, EndGoalPath,
- BranchEndInfo),
+ map__lookup(IntervalInfo ^ branch_end_map, EndGoalPath, BranchEndInfo),
ContinueId = BranchEndInfo ^ interval_after_branch,
apply_interval_find_all_branches(RelevantVars,
MaybeSearchAnchor0, IntervalInfo, StackOptInfo,
@@ -960,7 +919,7 @@
% We need a version of apply_interval_find_all_branches with this
% argument order for use in higher order caode.
-
+ %
:- pred apply_interval_find_all_branches_map(set(prog_var)::in,
maybe(anchor)::in, interval_info::in, stack_opt_info::in,
all_paths::in, interval_id::in, all_paths::out) is det.
@@ -980,8 +939,7 @@
map__lookup(IntervalInfo ^ interval_vars, IntervalId, IntervalVars),
RelevantIntervalVars = set__intersect(RelevantVars, IntervalVars),
!.AllPaths = all_paths(Paths0, AfterModelNon0, RelevantAfter),
- Paths1 = set__map(
- add_interval_to_path(IntervalId, RelevantIntervalVars),
+ Paths1 = set__map(add_interval_to_path(IntervalId, RelevantIntervalVars),
Paths0),
map__lookup(IntervalInfo ^ interval_start, IntervalId, Start),
(
@@ -990,8 +948,7 @@
; Start = branch_end(_, _)
; Start = branch_start(_, _)
),
- map__search(IntervalInfo ^ anchor_follow_map, Start,
- StartInfo),
+ map__search(IntervalInfo ^ anchor_follow_map, Start, StartInfo),
StartInfo = AnchorFollowVars - _,
set__intersect(RelevantVars, AnchorFollowVars, NeededVars),
set__non_empty(NeededVars)
@@ -1051,8 +1008,7 @@
io__write_string(":\n", !IO),
proc_info_goal(ProcInfo, Goal),
proc_info_varset(ProcInfo, VarSet),
- hlds_out__write_goal(Goal, ModuleInfo, VarSet, yes, 0, "\n",
- !IO),
+ hlds_out__write_goal(Goal, ModuleInfo, VarSet, yes, 0, "\n", !IO),
io__write_string("\n", !IO)
;
true
@@ -1060,11 +1016,10 @@
%-----------------------------------------------------------------------------%
-% This predicate (along with dump_interval_info) can help debug the
-% performance of the transformation.
-
-:- pred dump_stack_opt_info(stack_opt_info::in, io::di, io::uo)
- is det.
+ % This predicate (along with dump_interval_info) can help debug the
+ % performance of the transformation.
+ %
+:- pred dump_stack_opt_info(stack_opt_info::in, io::di, io::uo) is det.
dump_stack_opt_info(StackOptInfo, !IO) :-
map__to_assoc_list(StackOptInfo ^ left_anchor_inserts, Inserts),
@@ -1072,8 +1027,7 @@
list__foldl(dump_anchor_inserts, Inserts, !IO),
io__write_string("\nMATCHING RESULTS:\n", !IO),
- list__foldl(dump_matching_result,
- StackOptInfo ^ matching_results, !IO),
+ list__foldl(dump_matching_result, StackOptInfo ^ matching_results, !IO),
io__write_string("\n", !IO).
:- pred dump_anchor_inserts(pair(anchor, list(insert_spec))::in,
@@ -1112,9 +1066,8 @@
io::di, io::uo) is det.
dump_matching_result(MatchingResult, !IO) :-
- MatchingResult = matching_result(CellVar, ConsId,
- ArgVars, ViaCellVars, GoalPath,
- PotentialIntervals, InsertIntervals,
+ MatchingResult = matching_result(CellVar, ConsId, ArgVars, ViaCellVars,
+ GoalPath, PotentialIntervals, InsertIntervals,
PotentialAnchors, InsertAnchors),
io__write_string("\nmatching result at ", !IO),
io__write(GoalPath, !IO),
@@ -1144,12 +1097,10 @@
io__write_string("\n", !IO),
io__write_string("potential anchors: ", !IO),
- io__write_list(set__to_sorted_list(PotentialAnchors), " ", io__write,
- !IO),
+ io__write_list(set__to_sorted_list(PotentialAnchors), " ", io__write, !IO),
io__write_string("\n", !IO),
io__write_string("insert anchors: ", !IO),
- io__write_list(set__to_sorted_list(InsertAnchors), " ", io__write,
- !IO),
+ io__write_list(set__to_sorted_list(InsertAnchors), " ", io__write, !IO),
io__write_string("\n", !IO).
%-----------------------------------------------------------------------------%
Index: compiler/timestamp.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/timestamp.m,v
retrieving revision 1.10
diff -u -b -r1.10 timestamp.m
--- compiler/timestamp.m 22 Mar 2005 06:40:28 -0000 1.10
+++ compiler/timestamp.m 17 Oct 2005 13:49:39 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 2001-2002, 2004-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -15,36 +17,34 @@
:- import_module time.
- % A `timestamp' is similar to a `time_t' except that
- % timestamps are system independent. A timestamp string
- % (obtained using time__timestamp_to_string) written on
- % one system can be read on any other system.
- % Comparison of values of type `timestamp' (via compare/3)
- % is equivalent to comparison of the times represented.
+ % A `timestamp' is similar to a `time_t' except that timestamps are system
+ % independent. A timestamp string (obtained using timestamp_to_string)
+ % written on one system can be read on any other system. Comparison of
+ % values of type `timestamp' (via compare/3) is equivalent to comparison
+ % of the times represented.
:- type timestamp.
- % time_t_to_timestamp(Time) = Timestamp:
% Converts the calendar time value `Time' into a timestamp.
% Equivalent to `gm_time_to_timestamp(gmtime(Time))'.
+ %
:-func time_t_to_timestamp(time_t) = timestamp.
- % timestamp_to_string(Timestamp) = String:
- % Converts `Timestamp' into a string with format
- % "yyyy-mm-dd hh:mm:ss", expressed as UTC.
+ % Converts a timestamp into a string with format "yyyy-mm-dd hh:mm:ss",
+ % expressed as UTC.
+ %
:- func timestamp_to_string(timestamp) = string.
- % string_to_timestamp(String) = Timestamp:
- % Converts a string formatted as "yyyy-mm-dd hh:mm:ss",
- % into a timestamp. Fails if the string does not have the
- % correct format.
+ % Converts a string formatted as "yyyy-mm-dd hh:mm:ss", into a timestamp.
+ % Fails if the string does not have the correct format.
+ %
:- func string_to_timestamp(string) = timestamp is semidet.
- % oldest_timestamp = Timestamp:
% Return a timestamp which is older than any other timestamp.
+ %
:- func oldest_timestamp = timestamp.
- % newest_timestamp = Timestamp:
% Return a timestamp which is newer than any other timestamp.
+ %
:- func newest_timestamp = timestamp.
%-----------------------------------------------------------------------------%
@@ -61,7 +61,8 @@
% We use a no-tag type rather than an abstract equivalence type
% to avoid type errors with abstract equivalence types in the hlc
% back-end.
-:- type timestamp ---> timestamp(string).
+:- type timestamp
+ ---> timestamp(string).
oldest_timestamp = timestamp("0000-00-00 00:00:00").
newest_timestamp = timestamp("9999-99-99 99:99:99").
@@ -74,8 +75,8 @@
timestamp(gmtime_to_timestamp_2(Year, Month, MD, Hrs, Min, Sec,
YD, WD, maybe_dst_to_int(DST))).
-:- func gmtime_to_timestamp_2(int, int, int, int,
- int, int, int, int, int) = string.
+:- func gmtime_to_timestamp_2(int, int, int, int, int, int, int, int, int)
+ = string.
:- pragma foreign_decl("C", "
#include ""mercury_string.h""
@@ -135,15 +136,13 @@
% we need to ensure that the length check occurs before the
% calls to unsafe_undex to avoid dereferencing invalid pointers.
(
- string__length(Timestamp) `with_type` int =
- string__length("yyyy-mm-dd hh:mm:ss")
+ string__length(Timestamp) : int = string__length("yyyy-mm-dd hh:mm:ss")
->
string__to_int(string__unsafe_substring(Timestamp, 0, 4), _),
string__unsafe_index(Timestamp, 4, '-'),
- string__to_int(string__unsafe_substring(Timestamp, 5, 2),
- Month),
+ string__to_int(string__unsafe_substring(Timestamp, 5, 2), Month),
Month >= 1,
Month =< 12,
@@ -155,22 +154,19 @@
string__unsafe_index(Timestamp, 10, ' '),
- string__to_int(string__unsafe_substring(Timestamp, 11, 2),
- Hour),
+ string__to_int(string__unsafe_substring(Timestamp, 11, 2), Hour),
Hour >= 0,
Hour =< 23,
string__unsafe_index(Timestamp, 13, ':'),
- string__to_int(string__unsafe_substring(Timestamp, 14, 2),
- Minute),
+ string__to_int(string__unsafe_substring(Timestamp, 14, 2), Minute),
Minute >= 0,
Minute =< 59,
string__unsafe_index(Timestamp, 16, ':'),
- string__to_int(string__unsafe_substring(Timestamp, 17, 2),
- Second),
+ string__to_int(string__unsafe_substring(Timestamp, 17, 2), Second),
Second >= 0,
Second =< 61 % Seconds 60 and 61 are for leap seconds.
;
Index: compiler/top_level.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/top_level.m,v
retrieving revision 1.5
diff -u -b -r1.5 top_level.m
--- compiler/top_level.m 20 Dec 2004 01:15:42 -0000 1.5
+++ compiler/top_level.m 18 Oct 2005 02:05:17 -0000
@@ -1,43 +1,44 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 2002-2004 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
-% This package contains the top-level stuff that uses all the
-% other packages. In particular it contains the module mercury_compile.m,
-% which defines main/2, and which invokes all the other parts of the
-% Mercury compiler.
-%
+% This package contains the top-level stuff that uses all the other packages.
+% In particular it contains the module mercury_compile.m, which defines main/2,
+% and which invokes all the other parts of the Mercury compiler.
:- module top_level.
:- interface.
-% the front-end phases
+% The front-end phases.
:- import_module check_hlds.
:- import_module hlds.
:- import_module mode_robdd.
:- import_module parse_tree.
:- import_module transform_hlds.
-% back-ends that we currently use or plan to use
+% Back-ends that we currently use or plan to use.
:- import_module aditi_backend.
:- import_module ll_backend.
:- import_module ml_backend.
-% incomplete back-ends
+% Incomplete back-ends.
:- import_module bytecode_backend.
-% misc utilities
+% Misc utilities.
:- import_module backend_libs.
:- import_module libs.
:- include_module mercury_compile.
% XXX It would be nicer to define `main' in top_level.mercury_compile,
-% rather than defining it here. But that doesn't work with the
-% Mercury compiler's .NET back-end, which assumes that main is defined
-% in the program's top-level module.
+% rather than defining it here. But that doesn't work with the Mercury
+% compiler's .NET back-end, which assumes that main is defined in the program's
+% top-level module.
+
:- use_module io.
:- pred main(io.state::di, io.state::uo) is det.
@@ -45,7 +46,8 @@
:- use_module top_level.mercury_compile.
-main --> top_level.mercury_compile.real_main.
+main(!IO) :-
+ top_level.mercury_compile.real_main(!IO).
:- end_module top_level.
Index: compiler/trans_opt.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/trans_opt.m,v
retrieving revision 1.30
diff -u -b -r1.30 trans_opt.m
--- compiler/trans_opt.m 30 Sep 2005 08:08:35 -0000 1.30
+++ compiler/trans_opt.m 18 Oct 2005 01:59:53 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1997-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -7,26 +9,26 @@
% file: trans_opt.m
% main author: crs
%
-% Transitive intermodule optimization allows the compiler to do
-% intermodule optimization that depends on other .trans_opt files. In
-% comparison to .opt files, .trans_opt files allow much more accurate
-% optimization to occur, but at the cost of an increased number of
-% compilations required. The fact that a .trans_opt file may depend on
-% other .trans_opt files introduces the possibility of circular
-% dependencies occuring. These circular dependencies would occur if the
-% data in A.trans_opt depended on the data in B.trans_opt being correct,
-% and vice-versa.
+% Transitive intermodule optimization allows the compiler to do intermodule
+% optimization that depends on other .trans_opt files. In comparison to .opt
+% files, .trans_opt files allow much more accurate optimization to occur,
+% but at the cost of an increased number of compilations required. The fact
+% that a .trans_opt file may depend on other .trans_opt files introduces
+% the possibility of circular dependencies occuring. These circular
+% dependencies would occur if the data in A.trans_opt depended on the data
+% in B.trans_opt being correct, and vice versa.
%
% The following system is used to ensure that circular dependencies cannot
% occur:
-% When mmake <module>.depend is run, mmc calculates a suitable
-% ordering. This ordering is then used to create each of the .d
-% files. This allows make to ensure that all necessary trans_opt
-% files are up to date before creating any other trans_opt files.
-% This same information is used by mmc to decide which trans_opt
-% files may be imported when creating another .trans_opt file. By
-% observing the ordering decided upon when mmake module.depend was
-% run, any circularities which may have been created are avoided.
+%
+% When mmake <module>.depend is run, mmc calculates a suitable ordering.
+% This ordering is then used to create each of the .d files. This allows
+% make to ensure that all necessary trans_opt files are up to date before
+% creating any other trans_opt files. This same information is used by mmc
+% to decide which trans_opt files may be imported when creating another
+% .trans_opt file. By observing the ordering decided upon when mmake
+% module.depend was run, any circularities which may have been created
+% are avoided.
%
% This module writes out the interface for transitive intermodule optimization.
% The .trans_opt file includes:
@@ -35,11 +37,10 @@
% All these items should be module qualified.
% Constructors should be explicitly type qualified.
%
-% Note that the .trans_opt file does not (yet) include clauses,
-% `pragma c_code' declarations, or any of the other information
-% that would be needed for inlining or other optimizations;
-% currently it is only used for termination analysis and
-% exception analysis.
+% Note that the .trans_opt file does not (yet) include clauses, `pragma
+% foreign_proc' declarations, or any of the other information that would be
+% needed for inlining or other optimizations; currently it is only used
+% for termination analysis and exception analysis.
%
% This module also contains predicates to read in the .trans_opt files.
%
@@ -59,14 +60,18 @@
:- import_module io.
:- import_module list.
+ % Open the file "<module-name>.trans_opt.tmp", and write out the
+ % declarations.
+ %
:- pred trans_opt__write_optfile(module_info::in, io::di, io::uo) is det.
% trans_opt__grab_optfiles(ModuleList, !ModuleImports, Error, !IO):
+ %
% Add the items from each of the modules in ModuleList.trans_opt to
% the items in ModuleImports.
+ %
:- pred trans_opt__grab_optfiles(list(module_name)::in,
- module_imports::in, module_imports::out, bool::out, io::di, io::uo)
- is det.
+ module_imports::in, module_imports::out, bool::out, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -97,9 +102,6 @@
%-----------------------------------------------------------------------------%
-% Open the file "<module-name>.trans_opt.tmp", and write out the
-% declarations.
-
trans_opt__write_optfile(Module, !IO) :-
module_info_get_name(Module, ModuleName),
module_name_to_file_name(ModuleName, ".trans_opt.tmp", yes, TmpOptName,
@@ -138,15 +140,13 @@
module_info_get_exception_info(Module, ExceptionInfo),
list__foldl(
- exception_analysis__write_pragma_exceptions(Module,
- ExceptionInfo),
+ exception_analysis__write_pragma_exceptions(Module, ExceptionInfo),
PredIds, !IO),
io__set_output_stream(OldStream, _, !IO),
io__close_output(Stream, !IO),
- module_name_to_file_name(ModuleName, ".trans_opt", no,
- OptName, !IO),
+ module_name_to_file_name(ModuleName, ".trans_opt", no, OptName, !IO),
update_interface(OptName, !IO),
touch_interface_datestamp(ModuleName, ".trans_opt_date", !IO)
).
Index: compiler/transform.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/transform.m,v
retrieving revision 1.21
diff -u -b -r1.21 transform.m
--- compiler/transform.m 22 Mar 2005 06:40:29 -0000 1.21
+++ compiler/transform.m 18 Oct 2005 02:01:23 -0000
@@ -1,8 +1,11 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1995-1998, 2003-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
+%
% File: transform.m
% Main author: bromage.
%
@@ -19,13 +22,13 @@
% Define a new predicate with a given goal.
%
% - identity (NYI)
-% Apply an identity (such as the associative law for
-% addition) to a goal.
+% Apply an identity (such as the associative law for addition) to a goal.
%
% These operations form the basis of most high-level transformations.
%
% Also included is a conjunction rescheduler. Useful just in case
% your transformer upset the ordering in a conjunction.
+%
%-----------------------------------------------------------------------------%
:- module transform_hlds__transform.
@@ -36,7 +39,7 @@
:- import_module list.
-:- pred transform__reschedule_conj(list(hlds_goal)::in, list(hlds_goal)::out,
+:- pred reschedule_conj(list(hlds_goal)::in, list(hlds_goal)::out,
mode_info::in, mode_info::out) is det.
%-----------------------------------------------------------------------------%
@@ -58,22 +61,24 @@
%-----------------------------------------------------------------------------%
-transform__reschedule_conj([], [], !ModeInfo).
-transform__reschedule_conj([Goal0 | Goals0], Goals, !ModeInfo) :-
+reschedule_conj([], [], !ModeInfo).
+reschedule_conj([Goal0 | Goals0], Goals, !ModeInfo) :-
mode_info_get_instmap(!.ModeInfo, InstMap0),
mode_info_get_delay_info(!.ModeInfo, DelayInfo0),
delay_info__wakeup_goals(WokenGoals, DelayInfo0, DelayInfo1),
mode_info_set_delay_info(DelayInfo1, !ModeInfo),
- ( WokenGoals \= [] ->
+ (
+ WokenGoals = [_ | _],
list__append(WokenGoals, [Goal0 | Goals0], Goals1),
- transform__reschedule_conj(Goals1, Goals, !ModeInfo)
+ reschedule_conj(Goals1, Goals, !ModeInfo)
;
+ WokenGoals = [],
Goal0 = _Goal0Goal - Goal0Info,
goal_info_get_instmap_delta(Goal0Info, InstMapDelta),
instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMap1),
mode_info_set_instmap(InstMap1, !ModeInfo),
- transform__reschedule_conj(Goals0, Goals1, !ModeInfo),
+ reschedule_conj(Goals0, Goals1, !ModeInfo),
Goals = [Goal0 | Goals1]
).
Index: compiler/tree.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/tree.m,v
retrieving revision 1.18
diff -u -b -r1.18 tree.m
--- compiler/tree.m 24 Mar 2005 02:00:31 -0000 1.18
+++ compiler/tree.m 17 Oct 2005 13:46:13 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 1993-2001, 2003-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -63,6 +65,7 @@
% flatten_2(T, !Flat) is true iff !:Flat is the list that results from
% traversing T left-to-right depth-first, and then appending !.Flat.
+ %
:- pred tree.flatten_2(tree(T)::in, list(T)::in, list(T)::out) is det.
tree.flatten_2(empty, !Flat).
@@ -77,8 +80,8 @@
% flatten_list(List, !Flat) is true iff !:Flat is the list that results
% from traversing List left-to-right depth-first, and then appending
% !.Flat.
-:- pred tree.flatten_list(list(tree(T))::in, list(T)::in, list(T)::out)
- is det.
+ %
+:- pred tree.flatten_list(list(tree(T))::in, list(T)::in, list(T)::out) is det.
tree.flatten_list([], !Flat).
tree.flatten_list([Head | Tail], !Flat) :-
Index: compiler/tupling.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/tupling.m,v
retrieving revision 1.12
diff -u -b -r1.12 tupling.m
--- compiler/tupling.m 30 Sep 2005 08:08:35 -0000 1.12
+++ compiler/tupling.m 18 Oct 2005 02:06:07 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -228,9 +230,9 @@
%-----------------------------------------------------------------------------%
% This predicate can be used in place of maybe_tuple_scc to evaluate
- % and transform each procedure of an SCC individually. This is to
- % mimic the behaviour from an earlier version of this file.
- % It's currently unused but might be useful for debugging.
+ % and transform each procedure of an SCC individually. This is to mimic
+ % the behaviour from an earlier version of this file. It's currently
+ % unused but might be useful for debugging.
%
:- pred maybe_tuple_scc_individual_procs(trace_counts::in, tuning_params::in,
dependency_graph::in, list(pred_proc_id)::in,
@@ -279,8 +281,7 @@
( list__length(CandidateHeadVars) < MinArgsToTuple ->
(
VeryVerbose = yes,
- io__write_string(
- "% Too few candidate headvars\n", !IO)
+ io__write_string("% Too few candidate headvars\n", !IO)
;
VeryVerbose = no
)
@@ -293,7 +294,7 @@
% No need to work on this SCC if there are no callers to it
% within this module.
%
- % XXX: if part of the SCC is exported then we might want
+ % XXX: If part of the SCC is exported then we might want
% to look at it, for intermodule tupling.
(
VeryVerbose = yes,
@@ -325,8 +326,7 @@
:- pred maybe_tuple_scc_2(trace_counts::in, tuning_params::in,
list(pred_proc_id)::in, candidate_headvars::in,
module_info::in, module_info::out, counter::in, counter::out,
- transform_map::in, transform_map::out, io::di, io::uo, bool::in)
- is det.
+ transform_map::in, transform_map::out, io::di, io::uo, bool::in) is det.
maybe_tuple_scc_2(TraceCounts, TuningParams, PredProcIds, CandidateHeadVars,
!ModuleInfo, !Counter, !TransformMap, !IO, VeryVerbose) :-
@@ -348,15 +348,13 @@
;
maybe_tuple_scc_3(TraceCounts, TuningParams, PredProcIds,
CandidateHeadVars, CostsWithoutTupling,
- !ModuleInfo, !Counter, !TransformMap, !IO,
- VeryVerbose)
+ !ModuleInfo, !Counter, !TransformMap, !IO, VeryVerbose)
).
:- pred maybe_tuple_scc_3(trace_counts::in, tuning_params::in,
list(pred_proc_id)::in, candidate_headvars::in, costs::in,
module_info::in, module_info::out, counter::in, counter::out,
- transform_map::in, transform_map::out, io::di, io::uo, bool::in)
- is det.
+ transform_map::in, transform_map::out, io::di, io::uo, bool::in) is det.
maybe_tuple_scc_3(TraceCounts, TuningParams, PredProcIds, CandidateHeadVars,
CostsWithoutTupling,
@@ -371,8 +369,7 @@
(
VeryVerbose = yes,
io.format("%% SCC costs with tupling = {%g, %g}\n",
- [f(LoadsWithTupling), f(StoresWithTupling)],
- !IO)
+ [f(LoadsWithTupling), f(StoresWithTupling)], !IO)
;
VeryVerbose = no
),
@@ -410,6 +407,10 @@
%-----------------------------------------------------------------------------%
+:- type candidate_headvars == assoc_list(string, candidate_headvar_origins).
+
+:- type candidate_headvar_origins == map(pred_proc_id, prog_var).
+
% The "candidate headvars" of a procedure are the input arguments of
% a procedure that we are considering to pass to the procedure as a
% tuple.
@@ -424,14 +425,8 @@
% with a mappping to the actual variable within each procedure (if
% that procedure has an input variable of the given name). The order
% of the elements in the association list is important later on,
- % since we only try tupling contiguous runs of the candidate
- % variables.
+ % since we only try tupling contiguous runs of the candidate variables.
%
-
-:- type candidate_headvars == assoc_list(string, candidate_headvar_origins).
-
-:- type candidate_headvar_origins == map(pred_proc_id, prog_var).
-
:- pred candidate_headvars_of_proc(module_info::in, pred_proc_id::in,
candidate_headvars::out) is det.
@@ -443,8 +438,7 @@
proc_info_headvars(ProcInfo, HeadVars),
proc_info_argmodes(ProcInfo, ArgModes),
CandidateHeadVars = list__filter_map_corresponding(
- candidate_headvars_of_proc_2(PredProcId, VarSet, VarTypes,
- ModuleInfo),
+ candidate_headvars_of_proc_2(PredProcId, VarSet, VarTypes, ModuleInfo),
HeadVars, ArgModes).
:- func candidate_headvars_of_proc_2(pred_proc_id, prog_varset, vartypes,
@@ -469,10 +463,8 @@
list__map(candidate_headvars_of_proc(ModuleInfo),
PredProcIds, ListsOfCandidates),
list__condense(ListsOfCandidates, FlatListOfCandidates),
- multi_map__from_flat_assoc_list(FlatListOfCandidates,
- CandidatesMultiMap),
- map__foldl(common_candidate_headvars_of_procs_2,
- CandidatesMultiMap,
+ multi_map__from_flat_assoc_list(FlatListOfCandidates, CandidatesMultiMap),
+ map__foldl(common_candidate_headvars_of_procs_2, CandidatesMultiMap,
[], CandidateHeadVars).
:- pred common_candidate_headvars_of_procs_2(
@@ -481,13 +473,11 @@
common_candidate_headvars_of_procs_2(HeadVarName, ListOfOrigins,
CandidateHeadVars0, CandidateHeadVars) :-
- % Only include this variable in the list of candidates if
- % there are two or more procedures in the SCC with head
- % variables having the same name.
+ % Only include this variable in the list of candidates if there are two
+ % or more procedures in the SCC with head variables having the same name.
( ListOfOrigins = [_, _ | _] ->
list__foldl(map__merge, ListOfOrigins, map__init, Origins),
- CandidateHeadVars = CandidateHeadVars0 ++
- [HeadVarName - Origins]
+ CandidateHeadVars = CandidateHeadVars0 ++ [HeadVarName - Origins]
;
CandidateHeadVars = CandidateHeadVars0
).
@@ -514,8 +504,9 @@
find_best_tupling_scheme(TraceCounts, TuningParams, ModuleInfo,
PredProcIds, CandidateHeadVars, MaybeBestScheme) :-
MinArgsToTuple = TuningParams ^ min_args_to_tuple,
- fold_over_list_runs(find_best_tupling_scheme_2(TraceCounts,
- TuningParams, ModuleInfo, PredProcIds),
+ fold_over_list_runs(
+ find_best_tupling_scheme_2(TraceCounts, TuningParams,
+ ModuleInfo, PredProcIds),
CandidateHeadVars, MinArgsToTuple,
no, MaybeBestScheme).
@@ -528,13 +519,13 @@
PredProcIds, CandidateHeadVars,
MaybeBestScheme0, MaybeBestScheme) :-
MinArgsToTuple = TuningParams ^ min_args_to_tuple,
- list__map(make_tupling_proposal(ModuleInfo, CandidateHeadVars,
- MinArgsToTuple),
+ list__map(
+ make_tupling_proposal(ModuleInfo, CandidateHeadVars, MinArgsToTuple),
PredProcIds, TuplingProposals),
map__from_corresponding_lists(PredProcIds, TuplingProposals,
TuplingScheme),
- count_load_stores_for_scc(TraceCounts, TuningParams,
- ModuleInfo, TuplingScheme, PredProcIds, Costs),
+ count_load_stores_for_scc(TraceCounts, TuningParams, ModuleInfo,
+ TuplingScheme, PredProcIds, Costs),
(
(
MaybeBestScheme0 = no
@@ -569,8 +560,7 @@
% add that variable to the varset permanently.
varset__new_named_var(VarSet, "DummyCellVar", DummyCellVar, _),
FieldVars = assoc_list__keys(FieldVarArgPos),
- TuplingProposal = tupling(DummyCellVar, FieldVars,
- FieldVarArgPos)
+ TuplingProposal = tupling(DummyCellVar, FieldVars, FieldVarArgPos)
).
:- pred less_total_cost(costs::in, costs::in) is semidet.
@@ -582,10 +572,10 @@
%-----------------------------------------------------------------------------%
- % fold_over_list_runs(Pred, List, MinRunLength, !Acc)
+ % fold_over_list_runs(Pred, List, MinRunLength, !Acc):
+ %
% Call Pred for each consecutive run of elements in List of a length
- % greater or equal to MinRunLength, threading an accumulator through
- % it.
+ % greater or equal to MinRunLength, threading an accumulator through it.
%
:- pred fold_over_list_runs(pred(list(L), A, A)::in(pred(in, in, out) is det),
list(L)::in, int::in, A::in, A::out) is det.
@@ -628,11 +618,11 @@
!ModuleInfo, !Counter, !TransformMap) :-
PredProcId = proc(PredId, ProcId),
some [!ProcInfo] (
- module_info_pred_proc_info(!.ModuleInfo,
- PredId, ProcId, PredInfo, !:ProcInfo),
+ module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
+ PredInfo, !:ProcInfo),
- % Build up information about intervals and which
- % variables are needed in each interval.
+ % Build up information about intervals and which variables
+ % are needed in each interval.
build_interval_info(!.ModuleInfo, !.ProcInfo, IntervalInfo),
% Create the cell variable.
@@ -654,16 +644,15 @@
% Make a transformed version of the procedure and add it to
% the module.
- make_transformed_proc(CellVar, FieldVars, InsertMap,
- !ProcInfo),
+ make_transformed_proc(CellVar, FieldVars, InsertMap, !ProcInfo),
recompute_instmap_delta_proc(yes, !ProcInfo, !ModuleInfo),
counter__allocate(Num, !Counter),
create_aux_pred(PredId, ProcId, PredInfo, !.ProcInfo, Num,
AuxPredProcId, CallAux, !ModuleInfo),
% Add an entry to the transform map for the new procedure.
- TransformedProc = transformed_proc(AuxPredProcId,
- TupleConsType, ArgsToTuple, CallAux),
+ TransformedProc = transformed_proc(AuxPredProcId, TupleConsType,
+ ArgsToTuple, CallAux),
svmap__det_insert(PredProcId, TransformedProc, !TransformMap)
).
@@ -700,12 +689,11 @@
% the very beginning of the procedure. The required deconstructions
% for those variables won't show up in the insert map. To handle this
% we just to insert a deconstruction unification at the start of the
- % procedure and let a simplification pass remove it later if not
- % required.
+ % procedure and let a simplification pass remove it later if not required.
%
- % We could make build_insert_map add such required unifications
- % to the insert map, but record_decisions_in_goal would need to be
- % modified as well.
+ % We could make build_insert_map add such required unifications to the
+ % insert map, but record_decisions_in_goal would need to be modified
+ % as well.
%
deconstruct_tuple(CellVar, FieldVarsList, ProcStartDeconstruct),
ProcStartInsert = insert_spec(ProcStartDeconstruct,
@@ -716,8 +704,7 @@
rename_vars_in_goal(RenameMapB, Goal2, Goal3),
map__merge(RenameMapA, RenameMapB, RenameMap),
- apply_headvar_correction(set__from_list(HeadVars), RenameMap,
- Goal3, Goal),
+ apply_headvar_correction(set__from_list(HeadVars), RenameMap, Goal3, Goal),
proc_info_set_goal(Goal, !ProcInfo),
proc_info_set_varset(VarSet, !ProcInfo),
proc_info_set_vartypes(VarTypes, !ProcInfo),
@@ -727,10 +714,10 @@
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
rename_map::out, insert_spec::in) is det.
-insert_proc_start_deconstruction(Goal0, Goal,
- !VarSet, !VarTypes, VarRename, Insert) :-
- % The tuple_opt feature is not used for this goal as we do
- % want other transformations to remove it if possible.
+insert_proc_start_deconstruction(Goal0, Goal, !VarSet, !VarTypes,
+ VarRename, Insert) :-
+ % The tuple_opt feature is not used for this goal as we do want
+ % other transformations to remove it if possible.
make_inserted_goal(!VarSet, !VarTypes, map__init, VarRename,
Insert, no, InsertGoal),
Goal0 = _ - GoalInfo,
@@ -738,9 +725,9 @@
%-----------------------------------------------------------------------------%
- % This predicate makes a new version of the given procedure in a
- % module. Amongst other things the new procedure is given a new
- % pred_id and proc_id, a new name and a new goal.
+ % This predicate makes a new version of the given procedure in a module.
+ % Amongst other things the new procedure is given a new pred_id and
+ % proc_id, a new name and a new goal.
%
% CallAux is an output variable, which is unified with a goal that
% can be used as a template for constructing calls to the newly
@@ -880,8 +867,7 @@
pred_info_arg_types(PredInfo, ArgTypes),
generate_proc_arg_info(ArgTypes, !.ModuleInfo, !ProcInfo),
- detect_liveness_proc(PredId, ProcId, !.ModuleInfo, !ProcInfo,
- !IO),
+ detect_liveness_proc(PredId, ProcId, !.ModuleInfo, !ProcInfo, !IO),
initial_liveness(!.ProcInfo, PredId, !.ModuleInfo, Liveness0),
module_info_get_globals(!.ModuleInfo, Globals),
body_should_use_typeinfo_liveness(PredInfo, Globals,
@@ -895,9 +881,8 @@
OptTupleAlloc0 = opt_tuple_alloc,
set__init(FailVars),
set__init(NondetLiveness0),
- build_live_sets_in_goal(Goal0, Goal, FailVars,
- AllocData, OptTupleAlloc0, _OptTupleAlloc,
- Liveness0, _Liveness,
+ build_live_sets_in_goal(Goal0, Goal, FailVars, AllocData,
+ OptTupleAlloc0, _OptTupleAlloc, Liveness0, _Liveness,
NondetLiveness0, _NondetLiveness),
proc_info_set_goal(Goal, !ProcInfo),
@@ -910,7 +895,8 @@
% The opt_tuple_alloc structure is constructed by live_vars.m. As far as I can
% tell we don't need such a thing for this module so we just define some stubs.
-:- type opt_tuple_alloc ---> opt_tuple_alloc.
+:- type opt_tuple_alloc
+ ---> opt_tuple_alloc.
:- instance stack_alloc_info(opt_tuple_alloc) where [
pred(at_call_site/4) is opt_at_call_site,
@@ -936,15 +922,14 @@
%-----------------------------------------------------------------------------%
:- pred count_load_stores_for_scc(trace_counts::in, tuning_params::in,
- module_info::in, tupling_scheme::in, list(pred_proc_id)::in,
- costs::out) is det.
+ module_info::in, tupling_scheme::in, list(pred_proc_id)::in, costs::out)
+ is det.
count_load_stores_for_scc(TraceCounts, TuningParams, ModuleInfo,
TuplingScheme, PredProcIds, costs(Loads, Stores)) :-
list__foldl2(count_load_stores_for_scc_2(TraceCounts,
TuningParams, ModuleInfo, TuplingScheme),
- PredProcIds,
- 0.0, Loads, 0.0, Stores).
+ PredProcIds, 0.0, Loads, 0.0, Stores).
:- pred count_load_stores_for_scc_2(trace_counts::in, tuning_params::in,
module_info::in, tupling_scheme::in, pred_proc_id::in,
@@ -970,12 +955,12 @@
ModuleInfo, ProcCounts, TuningParams, TuplingScheme),
ProcLoads, ProcStores),
% XXX: There is a problem somewhere causing CALL and EXIT
- % events not to show up for some procedures in trace count
- % files. The weighting of the procedure's costs is disabled.
+ % events not to show up for some procedures in trace count files.
+ % The weighting of the procedure's costs is disabled.
% However, if working, it still wouldn't be ideal as we don't
% know how many of the calls to the procedure came from within
% or without the SCC.
- /*get_proc_calls(ProcCounts, Weight),*/
+ % get_proc_calls(ProcCounts, Weight),
Weight = 1,
!:Loads = !.Loads + float(Weight) * ProcLoads,
!:Stores = !.Stores + float(Weight) * ProcStores
@@ -1027,9 +1012,8 @@
MaybeNeedAcrossCall),
MaybeNeedAcrossCall = yes(_)
->
- count_load_stores_for_call(CountInfo, InputVars,
- OutputArgVarSet, MaybeNeedAcrossCall, GoalInfo,
- !CountState)
+ count_load_stores_for_call(CountInfo, InputVars, OutputArgVarSet,
+ MaybeNeedAcrossCall, GoalInfo, !CountState)
;
cls_require_in_regs(CountInfo, InputVars, !CountState),
cls_clobber_regs(OutputArgVarSet, !CountState)
@@ -1083,8 +1067,7 @@
cls_require_in_regs(CountInfo, ArgVars, !CountState),
cls_put_in_regs([CellVar], !CountState)
;
- Unification = deconstruct(CellVar, _ConsId, ArgVars,
- _ArgModes, _, _),
+ Unification = deconstruct(CellVar, _ConsId, ArgVars, _ArgModes, _, _),
cls_put_in_regs_via_deconstruct(CountInfo, CellVar, ArgVars,
!CountState)
;
@@ -1096,8 +1079,7 @@
cls_require_in_regs(CountInfo, [Var1, Var2], !CountState)
;
Unification = complicated_unify(_, _, _),
- unexpected(this_file,
- "count_load_stores_in_goal: complicated_unify")
+ unexpected(this_file, "count_load_stores_in_goal: complicated_unify")
).
count_load_stores_in_goal(scope(_Reason, Goal) - _GoalInfo, CountInfo,
@@ -1155,8 +1137,7 @@
;
ResumePoint = no_resume_point,
unexpected(this_file,
- "count_load_stores_in_goal: " ++
- "no_resume_point for if_then_else")
+ "count_load_stores_in_goal: no_resume_point for if_then_else")
).
count_load_stores_in_goal(shorthand(_) - _, _, !_) :-
@@ -1187,12 +1168,11 @@
arg_info__partition_proc_call_args(CalleeProcInfo, VarTypes,
ModuleInfo, ArgVars, InputArgs0, Outputs, _),
(
- % If the caller is a tupled procedure, and every field
- % variable of the tuple appears as an input argument to the
- % callee AND every such argument is in a position matching
- % the field variable's position in the tupling proposal, then
- % the cell var of the caller can be reused as the call var
- % for the callee.
+ % If the caller is a tupled procedure, and every field variable
+ % of the tuple appears as an input argument to the callee AND
+ % every such argument is in a position matching the field variable's
+ % position in the tupling proposal, then the cell var of the caller
+ % can be reused as the call var for the callee.
%
% TODO: If we kept track of the aliases of field variables,
% then they could be checked also.
@@ -1203,15 +1183,13 @@
list__nth_member_search(ArgVars, Var, Pos)
)
->
- % In this case, the cell var is not being used to
- % access field variables, so it should not incur
- % the cell var cost.
- cls_require_normal_var_in_reg(CountInfo, CellVar,
- !CountState),
+ % In this case, the cell var is not being used to access field
+ % variables, so it should not incur the cell var cost.
+ cls_require_normal_var_in_reg(CountInfo, CellVar, !CountState),
set__delete_list(InputArgs0, FieldVars, InputArgs)
;
- % The cell var cannot be used for the callee, so we
- % must add the cost of constructing a new tuple.
+ % The cell var cannot be used for the callee, so we must add
+ % the cost of constructing a new tuple.
TuplingParams = CountInfo ^ count_info_params,
CellVarStoreCost = float(TuplingParams ^ cell_var_store_cost),
!:CountState = (!.CountState ^ store_costs :=
@@ -1258,8 +1236,7 @@
MaybeNeedAcrossCall = yes(NeedAcrossCall),
NeedAcrossCall = need_across_call(ForwardVars,
ResumeVars, NondetLiveVars),
- AllVars = set__union_list([ForwardVars, ResumeVars,
- NondetLiveVars]),
+ AllVars = set__union_list([ForwardVars, ResumeVars, NondetLiveVars]),
cls_require_flushed(CountInfo, AllVars, !CountState),
cls_clobber_regs(Outputs, !CountState)
;
@@ -1423,16 +1400,15 @@
set__from_list(DeconstructFieldVars),
set__from_list(TupleFieldVars)),
( set__non_empty(VarsToLoad) ->
- cls_require_var_in_reg_with_cost(CvLoadCost,
- DeconstructCellVar, !State),
- set__fold(cls_require_var_in_reg_with_cost(FvLoadCost),
- VarsToLoad, !State)
- ;
- % All the variables generated by this deconstruction
- % can be obtained from the proposed tupling, so the
- % deconstruction can be ignored. The costs of loading
- % those variables from the tuple will be counted as
- % they come.
+ cls_require_var_in_reg_with_cost(CvLoadCost, DeconstructCellVar,
+ !State),
+ set__fold(cls_require_var_in_reg_with_cost(FvLoadCost), VarsToLoad,
+ !State)
+ ;
+ % All the variables generated by this deconstruction can be
+ % obtained from the proposed tupling, so the deconstruction
+ % can be ignored. The costs of loading those variables from
+ % the tuple will be counted as they come.
true
)
).
@@ -1460,10 +1436,9 @@
cls_require_flushed_2(tupling(CellVar, FieldVars, _), TuningParams, Var,
!CountState) :-
- ( Var `list.member` FieldVars ->
+ ( list.member(Var, FieldVars) ->
FvStoreCost = TuningParams ^ field_var_store_cost,
- cls_require_flushed_with_cost(FvStoreCost, CellVar,
- !CountState)
+ cls_require_flushed_with_cost(FvStoreCost, CellVar, !CountState)
;
StoreCost = TuningParams ^ normal_var_store_cost,
cls_require_flushed_with_cost(StoreCost, Var, !CountState)
@@ -1475,7 +1450,7 @@
cls_require_flushed_with_cost(StoreCost, Var,
count_state(RegVars, StackVars0, Loads, Stores0),
count_state(RegVars, StackVars, Loads, Stores)) :-
- ( Var `set.member` StackVars0 ->
+ ( set.member(Var, StackVars0) ->
StackVars = StackVars0,
Stores = Stores0
;
@@ -1497,20 +1472,20 @@
:- pred reset_count_state_counts(count_state::in, count_state::out) is det.
-reset_count_state_counts(CountState0, CountState) :-
- CountState = ((CountState0
- ^ load_costs := 0.0)
- ^ store_costs := 0.0).
+reset_count_state_counts(!CountState) :-
+ !:CountState = !.CountState ^ load_costs := 0.0,
+ !:CountState = !.CountState ^ store_costs := 0.0.
:- pred add_branch_costs(count_state::in, float::in,
count_state::in, count_state::out) is det.
-add_branch_costs(BranchState, Weight, CountState0, CountState) :-
+add_branch_costs(BranchState, Weight, !CountState) :-
BranchState = count_state(_, _, BranchLoads, BranchStores),
- CountState0 = count_state(_, _, Loads0, Stores0),
- CountState = ((CountState0
- ^ load_costs := Loads0 + Weight * BranchLoads)
- ^ store_costs := Stores0 + Weight * BranchStores).
+ !.CountState = count_state(_, _, Loads0, Stores0),
+ !:CountState = !.CountState ^ load_costs
+ := Loads0 + Weight * BranchLoads,
+ !:CountState = !.CountState ^ store_costs
+ := Stores0 + Weight * BranchStores.
%-----------------------------------------------------------------------------%
%
@@ -1539,8 +1514,7 @@
set__make_singleton_set(CurIntervalId),
map__init, set__init, StartMap, EndMap,
SuccMap, VarsMap, map__init),
- build_interval_info_in_goal(Goal, IntervalInfo0, IntervalInfo,
- unit, _).
+ build_interval_info_in_goal(Goal, IntervalInfo0, IntervalInfo, unit, _).
% This is needed only to satisfy the interface of interval.m
%
@@ -1566,15 +1540,14 @@
build_insert_map(CellVar, FieldVars, IntervalInfo, InsertMap) :-
FieldVarsSet = set__from_list(FieldVars),
map__foldl(build_insert_map_2(CellVar, FieldVars, FieldVarsSet),
- IntervalInfo ^ anchor_follow_map,
- map__init, InsertMap).
+ IntervalInfo ^ anchor_follow_map, map__init, InsertMap).
:- pred build_insert_map_2(prog_var::in, list(prog_var)::in, set(prog_var)::in,
anchor::in, anchor_follow_info::in, insert_map::in, insert_map::out)
is det.
-build_insert_map_2(CellVar, FieldVars, FieldVarsSet,
- Anchor, FollowVars - _, !InsertMap) :-
+build_insert_map_2(CellVar, FieldVars, FieldVarsSet, Anchor, FollowVars - _,
+ !InsertMap) :-
NeededFieldVars = FieldVarsSet `set__intersect` FollowVars,
( set__empty(NeededFieldVars) ->
true
@@ -1621,37 +1594,38 @@
%
:- type transform_map == map(pred_proc_id, transformed_proc).
-:- type transformed_proc --->
- transformed_proc(
+:- type transformed_proc
+ ---> transformed_proc(
+ % The pred_proc_id of the transformed version of the procedure.
transformed_pred_proc_id :: pred_proc_id,
- % The pred_proc_id of the transformed version of
- % the procedure.
+
+ % The type of the cell variable created by the transformation.
+ % This will be a tuple type.
tuple_cons_type :: (type),
- % The type of the cell variable created by the
- % transformation. This will be a tuple type.
- args_to_tuple :: list(int),
+
% The argument positions of the original procedure
% which were tupled.
+ args_to_tuple :: list(int),
+
+ % A template for a call goal that is used to update calls
+ % of the original procedure to the transformed procedure
+ % instead. The arguments of the template need to be replaced
+ % by the actual arguments.
call_template :: hlds_goal
- % A template for a call goal that is used to update
- % calls of the original procedure to the transformed
- % procedure instead. The arguments of the template
- % need to be replaced by the actual arguments.
).
:- pred fix_calls_in_procs(transform_map::in, list(pred_proc_id)::in,
module_info::in, module_info::out) is det.
fix_calls_in_procs(TransformMap, PredProcIds, !ModuleInfo) :-
- list__foldl(fix_calls_in_proc(TransformMap),
- PredProcIds, !ModuleInfo).
+ list__foldl(fix_calls_in_proc(TransformMap), PredProcIds, !ModuleInfo).
:- pred fix_calls_in_transformed_procs(transform_map::in,
module_info::in, module_info::out) is det.
fix_calls_in_transformed_procs(TransformMap, !ModuleInfo) :-
- map__foldl(fix_calls_in_transformed_procs_2(TransformMap),
- TransformMap, !ModuleInfo).
+ map__foldl(fix_calls_in_transformed_procs_2(TransformMap), TransformMap,
+ !ModuleInfo).
:- pred fix_calls_in_transformed_procs_2(transform_map::in, pred_proc_id::in,
transformed_proc::in, module_info::in, module_info::out) is det.
@@ -1684,8 +1658,7 @@
proc_info_set_varset(VarSet, !ProcInfo),
proc_info_set_vartypes(VarTypes, !ProcInfo),
requantify_proc(!ProcInfo),
- recompute_instmap_delta_proc(yes, !ProcInfo,
- !ModuleInfo),
+ recompute_instmap_delta_proc(yes, !ProcInfo, !ModuleInfo),
module_info_set_pred_proc_info(PredId, ProcId,
PredInfo, !.ProcInfo, !ModuleInfo)
)
@@ -1709,13 +1682,11 @@
(
Builtin = not_builtin,
map__search(TransformMap, proc(CalledPredId0, CalledProcId0),
- transformed_proc(_,
- TupleConsType,
- ArgsToTuple,
- CallAux0 - CallAuxInfo))
+ TransformedProc),
+ TransformedProc = transformed_proc(_, TupleConsType, ArgsToTuple,
+ CallAux0 - CallAuxInfo)
->
- svvarset__new_named_var("TuplingCellVarForCall", CellVar,
- !VarSet),
+ svvarset__new_named_var("TuplingCellVarForCall", CellVar, !VarSet),
svmap__det_insert(CellVar, TupleConsType, !VarTypes),
extract_tupled_args_from_list(Args0, ArgsToTuple,
TupledArgs, UntupledArgs),
@@ -1726,8 +1697,7 @@
->
CallGoal = CallAux - CallAuxInfo
;
- unexpected(this_file,
- "fix_calls_in_goal: not a call template")
+ unexpected(this_file, "fix_calls_in_goal: not a call template")
),
conj_list_to_goal([ConstructGoal, CallGoal], GoalInfo0, Goal1),
RequantifyVars = set__from_list([CellVar | Args0]),
@@ -1758,13 +1728,11 @@
% XXX: I am not sure whether parallel conjunctions should be treated
% with fix_calls_in_goal or fix_calls_in_goal_list. At any rate,
% this is untested.
- fix_calls_in_goal_list(Goals0, Goals, !VarSet, !VarTypes,
- TransformMap).
+ fix_calls_in_goal_list(Goals0, Goals, !VarSet, !VarTypes, TransformMap).
fix_calls_in_goal(disj(Goals0) - GoalInfo, disj(Goals) - GoalInfo,
!VarSet, !VarTypes, TransformMap) :-
- fix_calls_in_goal_list(Goals0, Goals, !VarSet, !VarTypes,
- TransformMap).
+ fix_calls_in_goal_list(Goals0, Goals, !VarSet, !VarTypes, TransformMap).
fix_calls_in_goal(switch(Var, CanFail, Cases0) - GoalInfo,
switch(Var, CanFail, Cases) - GoalInfo,
@@ -1791,9 +1759,9 @@
fix_calls_in_conj([Goal0 | Goals0], Goals, !VarSet, !VarTypes, TransformMap) :-
fix_calls_in_goal(Goal0, Goal1, !VarSet, !VarTypes, TransformMap),
fix_calls_in_conj(Goals0, Goals1, !VarSet, !VarTypes, TransformMap),
- (if Goal1 = conj(ConjGoals) - _ then
+ ( Goal1 = conj(ConjGoals) - _ ->
Goals = ConjGoals ++ Goals1
- else
+ ;
Goals = [Goal1 | Goals1]
).
@@ -1805,8 +1773,7 @@
fix_calls_in_goal_list([Goal0 | Goals0], [Goal | Goals], !VarSet, !VarTypes,
TransformMap) :-
fix_calls_in_goal(Goal0, Goal, !VarSet, !VarTypes, TransformMap),
- fix_calls_in_goal_list(Goals0, Goals, !VarSet, !VarTypes,
- TransformMap).
+ fix_calls_in_goal_list(Goals0, Goals, !VarSet, !VarTypes, TransformMap).
:- pred fix_calls_in_cases(list(case)::in, list(case)::out,
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
@@ -1846,13 +1813,11 @@
extract_tupled_args_from_list_2([], _Num, _Indices, []).
extract_tupled_args_from_list_2([H | T], Num, Indices, NotSelected) :-
- ( Num `list.member` Indices ->
- extract_tupled_args_from_list_2(T, Num+1, Indices,
- NotSelected)
- ;
- NotSelected = [H | NotSelected1],
- extract_tupled_args_from_list_2(T, Num+1, Indices,
- NotSelected1)
+ ( list.member(Num, Indices) ->
+ extract_tupled_args_from_list_2(T, Num+1, Indices, NotSelected)
+ ;
+ extract_tupled_args_from_list_2(T, Num+1, Indices, NotSelectedTail),
+ NotSelected = [H | NotSelectedTail]
).
%-----------------------------------------------------------------------------%
Index: compiler/type_class_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_class_info.m,v
retrieving revision 1.10
diff -u -b -r1.10 type_class_info.m
--- compiler/type_class_info.m 30 Sep 2005 08:08:35 -0000 1.10
+++ compiler/type_class_info.m 17 Oct 2005 16:56:07 -0000
@@ -1,4 +1,6 @@
%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
% Copyright (C) 2003-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -64,20 +66,17 @@
% typed arguments. We generate descriptors for type class instances only if
% requested to generate all the descriptors we can.
-generate_rtti(ModuleInfo, GenerateAll, RttiDatas) :-
+generate_rtti(ModuleInfo, GenerateAll, !:RttiDatas) :-
module_info_get_class_table(ModuleInfo, ClassTable),
map__to_assoc_list(ClassTable, Classes),
- list__foldl(generate_class_decl(ModuleInfo), Classes,
- [], RttiDatas0),
+ list__foldl(generate_class_decl(ModuleInfo), Classes, [], !:RttiDatas),
(
GenerateAll = yes,
module_info_get_instance_table(ModuleInfo, InstanceTable),
map__to_assoc_list(InstanceTable, Instances),
- list__foldl(generate_instance_decls(ModuleInfo), Instances,
- RttiDatas0, RttiDatas)
+ list__foldl(generate_instance_decls(ModuleInfo), Instances, !RttiDatas)
;
- GenerateAll = no,
- RttiDatas = RttiDatas0
+ GenerateAll = no
).
%---------------------------------------------------------------------------%
@@ -139,9 +138,8 @@
Body = InstanceDefn ^ instance_body,
(
Body = concrete(_),
- % Only make the RTTI structure for the type class
- % instance if the instance declaration originally
- % came from _this_ module.
+ % Only make the RTTI structure for the type class instance if the
+ % instance declaration originally came from _this_ module.
status_defined_in_this_module(ImportStatus, yes)
->
RttiData = generate_instance_decl(ModuleInfo, ClassId,
@@ -174,8 +172,8 @@
MaybeInterface = Instance ^ instance_hlds_interface,
(
MaybeInterface = yes(Interface),
- MethodProcLabels = list__map(
- generate_method_proc_label(ModuleInfo), Interface)
+ MethodProcLabels = list__map(generate_method_proc_label(ModuleInfo),
+ Interface)
;
MaybeInterface = no,
error("generate_instance_decl: no interface")
@@ -211,18 +209,17 @@
:- func generate_tc_type(type) = tc_type.
generate_tc_type(Type) = TCType :-
- pseudo_type_info__construct_maybe_pseudo_type_info(Type, -1, [],
- TCType).
+ pseudo_type_info__construct_maybe_pseudo_type_info(Type, -1, [], TCType).
%---------------------------------------------------------------------------%
-% The version number of the runtime data structures describing type class
-% information, most of which (currently, all of which) is generated in this
-% module.
-%
-% The value returned by this function should be kept in sync with
-% MR_TYPECLASS_VERSION in runtime/mercury_typeclass_info.h.
-
+ % The version number of the runtime data structures describing type class
+ % information, most of which (currently, all of which) is generated in this
+ % module.
+ %
+ % The value returned by this function should be kept in sync with
+ % MR_TYPECLASS_VERSION in runtime/mercury_typeclass_info.h.
+ %
:- func type_class_info_rtti_version = int.
type_class_info_rtti_version = 0.
Index: compiler/typeclasses.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typeclasses.m,v
retrieving revision 1.4
diff -u -b -r1.4 typeclasses.m
--- compiler/typeclasses.m 30 Sep 2005 08:08:38 -0000 1.4
+++ compiler/typeclasses.m 18 Oct 2005 01:01:28 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -24,11 +26,11 @@
:- import_module io.
- % perform_context_reduction(OrigTypeAssignSet, Info0, Info) is true
+ % perform_context_reduction(OrigTypeAssignSet, !Info) is true
% iff either
- % (a) Info is the typecheck_info that results from performing
- % context reduction on the type_assigns in Info0, or
- % (b) if there is no valid context reduction, then Info is Info0
+ % (a) !:Info is the typecheck_info that results from performing
+ % context reduction on the type_assigns in !.Info, or
+ % (b) if there is no valid context reduction, then !:Info is !.Info
% with the type assign set replaced by OrigTypeAssignSet (see below).
%
% Context reduction is the process of eliminating redundant constraints
@@ -76,7 +78,7 @@
% the instance rules or superclass rules, building up proofs for
% redundant constraints.
%
-:- pred typeclasses__reduce_context_by_rule_application(class_table::in,
+:- pred reduce_context_by_rule_application(class_table::in,
instance_table::in, superclass_table::in, head_type_params::in,
tsubst::in, tsubst::out, tvarset::in, tvarset::out,
constraint_proof_map::in, constraint_proof_map::out,
@@ -112,27 +114,23 @@
module_info_get_instance_table(ModuleInfo, InstanceTable),
typecheck_info_get_type_assign_set(!.Info, TypeAssignSet0),
list__filter_map(
- reduce_type_assign_context(ClassTable, SuperClassTable,
- InstanceTable),
+ reduce_type_assign_context(ClassTable, SuperClassTable, InstanceTable),
TypeAssignSet0, TypeAssignSet),
(
% Check that this context reduction hasn't eliminated
% all the type assignments.
- TypeAssignSet = [],
- TypeAssignSet0 \= []
+ TypeAssignSet0 = [_ | _],
+ TypeAssignSet = []
->
report_unsatisfiable_constraints(TypeAssignSet0, !Info, !IO),
DeleteConstraints = (pred(TA0::in, TA::out) is det :-
- type_assign_get_typeclass_constraints(TA0,
- Constraints0),
+ type_assign_get_typeclass_constraints(TA0, Constraints0),
Constraints = (Constraints0
^ unproven := [])
^ redundant := multi_map.init,
- type_assign_set_typeclass_constraints(Constraints,
- TA0, TA)
+ type_assign_set_typeclass_constraints(Constraints, TA0, TA)
),
- list__map(DeleteConstraints, OrigTypeAssignSet,
- NewTypeAssignSet),
+ list__map(DeleteConstraints, OrigTypeAssignSet, NewTypeAssignSet),
typecheck_info_set_type_assign_set(NewTypeAssignSet, !Info)
;
typecheck_info_set_type_assign_set(TypeAssignSet, !Info)
@@ -185,12 +183,11 @@
apply_improvement_rules(ClassTable, InstanceTable, HeadTypeParams,
!.Constraints, !TVarSet, !Bindings, AppliedImprovementRule),
- % We want to make sure that any changes to the bindings are
- % reflected in the constraints, so that the full effect of the
- % improvement rules applies as soon as possible. We therefore
- % apply the bindings to the constraints (but only if the
- % bindings have actually changed since they were last applied).
- %
+ % We want to make sure that any changes to the bindings are reflected
+ % in the constraints, so that the full effect of the improvement rules
+ % applies as soon as possible. We therefore apply the bindings to the
+ % constraints (but only if the bindings have actually changed since
+ % they were last applied).
(
AppliedImprovementRule = yes,
apply_rec_subst_to_constraints(!.Bindings, !Constraints)
@@ -202,8 +199,7 @@
EliminatedAssumed),
apply_instance_rules(ClassTable, InstanceTable, !TVarSet, !Proofs,
!ConstraintMap, !Seen, !Constraints, AppliedInstanceRule),
- % XXX kind inference:
- % We assume that all tvars have kind `star'.
+ % XXX Kind inference: we assume that all tvars have kind `star'.
map__init(KindMap),
apply_class_rules(SuperClassTable, !.TVarSet, KindMap, !Proofs,
!ConstraintMap, !Constraints, AppliedClassRule),
@@ -214,13 +210,11 @@
AppliedClassRule = no
->
% We have reached fixpoint.
- %
sort_and_merge_dups(!Constraints)
;
typeclasses__reduce_context_by_rule_application_2(ClassTable,
- InstanceTable, SuperClassTable, HeadTypeParams,
- !Bindings, !TVarSet, !Proofs, !ConstraintMap,
- !Constraints, !Seen)
+ InstanceTable, SuperClassTable, HeadTypeParams, !Bindings,
+ !TVarSet, !Proofs, !ConstraintMap, !Constraints, !Seen)
).
:- pred sort_and_merge_dups(hlds_constraints::in, hlds_constraints::out)
@@ -245,9 +239,7 @@
merge_adjacent_constraints_2(C0, [], [C0]).
merge_adjacent_constraints_2(C0, [C1 | Cs], Constraints) :-
- (
- merge_constraints(C0, C1, C)
- ->
+ ( merge_constraints(C0, C1, C) ->
merge_adjacent_constraints_2(C, Cs, Constraints)
;
merge_adjacent_constraints_2(C1, Cs, Constraints0),
@@ -272,10 +264,10 @@
apply_improvement_rules(ClassTable, InstanceTable, HeadTypeParams, Constraints,
!TVarSet, !Bindings, Changed) :-
- % XXX should we sort and merge the constraints here?
- do_class_improvement(ClassTable, HeadTypeParams, Constraints,
- !Bindings, Changed1),
- % XXX do we really need to modify the varset? See the comment above
+ % XXX Should we sort and merge the constraints here?
+ do_class_improvement(ClassTable, HeadTypeParams, Constraints, !Bindings,
+ Changed1),
+ % XXX Do we really need to modify the varset? See the comment above
% find_matching_instance_rule.
do_instance_improvement(ClassTable, InstanceTable, HeadTypeParams,
Constraints, !TVarSet, !Bindings, Changed2),
@@ -290,8 +282,7 @@
Assumed = Constraints ^ assumed,
multi_map__keys(Redundant, ClassIds),
list__foldl2(
- do_class_improvement_2(ClassTable, HeadTypeParams, Redundant,
- Assumed),
+ do_class_improvement_2(ClassTable, HeadTypeParams, Redundant, Assumed),
ClassIds, !Bindings, no, Changed).
:- pred do_class_improvement_2(class_table::in, head_type_params::in,
@@ -330,9 +321,8 @@
!Bindings, !Changed).
:- pred do_class_improvement_by_pairs_2(hlds_constraint::in,
- list(hlds_constraint)::in, hlds_class_fundeps::in,
- head_type_params::in, tsubst::in, tsubst::out, bool::in, bool::out)
- is det.
+ list(hlds_constraint)::in, hlds_class_fundeps::in, head_type_params::in,
+ tsubst::in, tsubst::out, bool::in, bool::out) is det.
do_class_improvement_by_pairs_2(_, [], _, _, !Bindings, !Changed).
do_class_improvement_by_pairs_2(Constraint, [HeadConstraint | TailConstraints],
@@ -347,9 +337,8 @@
% other comes from the redundant constraints.
%
:- pred do_class_improvement_by_assumed(list(hlds_constraint)::in,
- list(hlds_constraint)::in, hlds_class_fundeps::in,
- head_type_params::in, tsubst::in, tsubst::out, bool::in, bool::out)
- is det.
+ list(hlds_constraint)::in, hlds_class_fundeps::in, head_type_params::in,
+ tsubst::in, tsubst::out, bool::in, bool::out) is det.
do_class_improvement_by_assumed(Assumed, Constraints, FunDeps, HeadTypeParams,
!Bindings, !Changed) :-
@@ -395,22 +384,16 @@
ConstraintB = constraint(_, _, TypesB),
FunDep = fundep(Domain, Range),
(
- %
- % We already know that the name/arity of the
- % constraints match, since we have partitioned them
- % already.
- %
+ % We already know that the name/arity of the constraints match,
+ % since we have partitioned them already.
lists_match_on_elements(Domain, TypesA, TypesB),
\+ lists_match_on_elements(Range, TypesA, TypesB),
- %
- % The unification can fail if type parameters in the
- % declaration would be bound by the improvement rule.
- % This means that the declaration is not as specific
- % as it could be, but that is not a problem for us.
- %
- unify_on_elements(Range, TypesA, TypesB, HeadTypeParams,
- !Bindings)
+ % The unification can fail if type parameters in the declaration
+ % would be bound by the improvement rule. This means that the
+ % declaration is not as specific as it could be, but that is not
+ % a problem for us.
+ unify_on_elements(Range, TypesA, TypesB, HeadTypeParams, !Bindings)
->
!:Changed = yes
;
@@ -436,15 +419,13 @@
bool::in, bool::out) is det.
do_instance_improvement_2(ClassTable, InstanceTable, HeadTypeParams,
- RedundantConstraints, ClassId, !TVarSet, !Bindings,
- !Changed) :-
+ RedundantConstraints, ClassId, !TVarSet, !Bindings, !Changed) :-
map__lookup(ClassTable, ClassId, ClassDefn),
FunDeps = ClassDefn ^ class_fundeps,
map__lookup(InstanceTable, ClassId, InstanceDefns),
map__lookup(RedundantConstraints, ClassId, Constraints),
list__foldl3(
- do_instance_improvement_3(Constraints, FunDeps,
- HeadTypeParams),
+ do_instance_improvement_3(Constraints, FunDeps, HeadTypeParams),
InstanceDefns, !TVarSet, !Bindings, !Changed).
:- pred do_instance_improvement_3(list(hlds_constraint)::in,
@@ -456,13 +437,11 @@
!TVarSet, !Bindings, !Changed) :-
InstanceTVarSet = InstanceDefn ^ instance_tvarset,
InstanceTypes0 = InstanceDefn ^ instance_types,
- tvarset_merge_renaming(!.TVarSet, InstanceTVarSet, NewTVarSet,
- Renaming),
+ tvarset_merge_renaming(!.TVarSet, InstanceTVarSet, NewTVarSet, Renaming),
apply_variable_renaming_to_type_list(Renaming, InstanceTypes0,
InstanceTypes),
list__foldl2(
- do_instance_improvement_4(FunDeps, InstanceTypes,
- HeadTypeParams),
+ do_instance_improvement_4(FunDeps, InstanceTypes, HeadTypeParams),
Constraints, !Bindings, no, Changed0),
(
Changed0 = yes,
@@ -492,24 +471,16 @@
Constraint = constraint(_, _, ConstraintTypes),
FunDep = fundep(Domain, Range),
(
- %
- % We already know that the name/arity of the
- % constraints match, since we have partitioned them
- % already.
- %
- subsumes_on_elements(Domain, InstanceTypes0, ConstraintTypes,
- Subst),
- apply_rec_subst_to_type_list(Subst, InstanceTypes0,
- InstanceTypes),
- \+ lists_match_on_elements(Range, InstanceTypes,
- ConstraintTypes),
-
- %
- % The unification can fail if type parameters in the
- % declaration would be bound by the improvement rule.
- % This means that the declaration is not as specific
- % as it could be, but that is not a problem for us.
- %
+ % We already know that the name/arity of the constraints match,
+ % since we have partitioned them already.
+ subsumes_on_elements(Domain, InstanceTypes0, ConstraintTypes, Subst),
+ apply_rec_subst_to_type_list(Subst, InstanceTypes0, InstanceTypes),
+ \+ lists_match_on_elements(Range, InstanceTypes, ConstraintTypes),
+
+ % The unification can fail if type parameters in the declaration
+ % would be bound by the improvement rule. This means that the
+ % declaration is not as specific as it could be, but that is not
+ % a problem for us.
unify_on_elements(Range, InstanceTypes, ConstraintTypes,
HeadTypeParams, !Bindings)
->
@@ -608,14 +579,12 @@
constraint_map::in, constraint_map::out,
redundant_constraints::in, redundant_constraints::out,
list(hlds_constraint)::in, list(hlds_constraint)::out,
- list(hlds_constraint)::in, list(hlds_constraint)::out, bool::out)
- is det.
+ list(hlds_constraint)::in, list(hlds_constraint)::out, bool::out) is det.
apply_instance_rules_2(_, _, !TVarSet, !Proofs, !ConstraintMap, !Redundant,
!Seen, [], [], no).
apply_instance_rules_2(ClassTable, InstanceTable, !TVarSet, !Proofs,
- !ConstraintMap, !Redundant, !Seen, [C | Cs], Constraints,
- Changed) :-
+ !ConstraintMap, !Redundant, !Seen, [C | Cs], Constraints, Changed) :-
C = constraint(_, ClassName, Types),
list__length(Types, Arity),
map__lookup(InstanceTable, class_id(ClassName, Arity), Instances),
@@ -631,18 +600,17 @@
NewConstraints),
update_redundant_constraints(ClassTable, !.TVarSet,
NewConstraints, !Redundant),
- % Put the new constraints at the front of the list
+ % Put the new constraints at the front of the list.
!:Seen = NewConstraints ++ !.Seen,
Changed1 = yes
;
- % Put the old constraint at the front of the list
+ % Put the old constraint at the front of the list.
NewConstraints = [C],
!:TVarSet = InitialTVarSet,
Changed1 = no
),
apply_instance_rules_2(ClassTable, InstanceTable, !TVarSet, !Proofs,
- !ConstraintMap, !Redundant, !Seen, Cs, TailConstraints,
- Changed2),
+ !ConstraintMap, !Redundant, !Seen, Cs, TailConstraints, Changed2),
bool__or(Changed1, Changed2, Changed),
list__append(NewConstraints, TailConstraints, Constraints).
@@ -650,7 +618,7 @@
is semidet.
matches_no_constraint(Seen, Constraint) :-
- \+ (some [S] (
+ \+ ( some [S] (
list__member(S, Seen),
matching_constraints(S, Constraint)
)).
@@ -687,8 +655,7 @@
ProgConstraints0 = Instance ^ instance_constraints,
InstanceTypes0 = Instance ^ instance_types,
InstanceTVarSet = Instance ^ instance_tvarset,
- tvarset_merge_renaming(!.TVarSet, InstanceTVarSet, NewTVarSet,
- Renaming),
+ tvarset_merge_renaming(!.TVarSet, InstanceTVarSet, NewTVarSet, Renaming),
apply_variable_renaming_to_type_list(Renaming, InstanceTypes0,
InstanceTypes),
(
@@ -739,11 +706,10 @@
Parents = [],
retrieve_prog_constraint(Constraint0, ProgConstraint0),
- % The head_type_params argument contains all the variables from
- % the original constraint that we are trying to prove. (These
- % are the type variables that must not be bound as we search
- % through the superclass relation).
- %
+ % The head_type_params argument contains all the variables from the
+ % original constraint that we are trying to prove. (These are the type
+ % variables that must not be bound as we search through the superclass
+ % relation).
constraint_get_tvars(ProgConstraint0, HeadTypeParams),
(
eliminate_constraint_by_class_rules(ProgConstraint0, _, _,
@@ -778,8 +744,7 @@
AssumedConstraints, SuperClassTable, HeadTypeParams, TVarSet,
KindMap, ParentConstraints, Proofs0, Proofs) :-
- % Make sure we aren't in a cycle in the
- % superclass relation
+ % Make sure we aren't in a cycle in the superclass relation.
\+ list__member(C, ParentConstraints),
C = constraint(SuperClassName, SuperClassTypes),
@@ -787,25 +752,20 @@
SuperClassId = class_id(SuperClassName, SuperClassArity),
multi_map__search(SuperClassTable, SuperClassId, SubClasses),
- % Convert all the subclass_details into prog_constraints by
- % doing the appropriate variable renaming and applying the
- % type variable bindings.
- % If the unification of the type variables for a particular
- % constraint fails then that constraint is eliminated because it
- % cannot contribute to proving the constraint we are trying to
- % prove.
+ % Convert all the subclass_details into prog_constraints by doing the
+ % appropriate variable renaming and applying the type variable bindings.
+ % If the unification of the type variables for a particular constraint
+ % fails then that constraint is eliminated because it cannot contribute
+ % to proving the constraint we are trying to prove.
list__filter_map(
- subclass_details_to_constraint(TVarSet, KindMap,
- SuperClassTypes),
+ subclass_details_to_constraint(TVarSet, KindMap, SuperClassTypes),
SubClasses, SubClassConstraints),
(
- % Do the first level of search. We search for
- % an assumed constraint which unifies with any
- % of the subclass constraints.
+ % Do the first level of search. We search for an assumed constraint
+ % which unifies with any of the subclass constraints.
varset__vars(TVarSet, XXXHeadTypeParams),
list.find_first_map(
- match_assumed_constraint(XXXHeadTypeParams,
- SubClassConstraints),
+ match_assumed_constraint(XXXHeadTypeParams, SubClassConstraints),
AssumedConstraints, SubClass - SubClassSubst0)
->
SubClassSubst = SubClassSubst0,
@@ -814,8 +774,7 @@
;
NewParentConstraints = [C | ParentConstraints],
- % Recursively search the rest of the superclass
- % relation.
+ % Recursively search the rest of the superclass relation.
SubClassSearch = (pred(Constraint::in, CnstrtAndProof::out)
is semidet :-
eliminate_constraint_by_class_rules(Constraint,
@@ -823,8 +782,7 @@
AssumedConstraints, SuperClassTable,
HeadTypeParams, TVarSet, KindMap,
NewParentConstraints, Proofs0, SubProofs),
- CnstrtAndProof = {SubstConstraint, SubClassSubst0,
- SubProofs}
+ CnstrtAndProof = {SubstConstraint, SubClassSubst0, SubProofs}
),
% XXX this could (and should) be more efficient.
% (i.e. by manually doing a "cut").
@@ -870,15 +828,15 @@
SubClassDetails = subclass_details(SuperVars0, SubID, SubVars0,
SuperVarSet),
- % Rename the variables from the typeclass
- % declaration into those of the current pred.
+ % Rename the variables from the typeclass declaration into those
+ % of the current pred.
tvarset_merge_renaming(TVarSet, SuperVarSet, _NewTVarSet, Renaming),
apply_variable_renaming_to_tvar_kind_map(Renaming, KindMap0, KindMap),
apply_variable_renaming_to_tvar_list(Renaming, SubVars0, SubVars),
apply_variable_renaming_to_type_list(Renaming, SuperVars0, SuperVars),
- % Work out what the (renamed) vars from the
- % typeclass declaration are bound to here.
+ % Work out what the (renamed) vars from the typeclass declaration
+ % are bound to here.
type_unify_list(SuperVars, SuperClassTypes, [], map__init, Bindings),
SubID = class_id(SubName, _SubArity),
apply_rec_subst_to_tvar_list(KindMap, Bindings, SubVars,
@@ -886,37 +844,32 @@
SubC = constraint(SubName, SubClassTypes).
% check_satisfiability(Constraints, HeadTypeParams):
- % Check that all of the constraints are satisfiable.
- % Fail if any are definitely not satisfiable.
%
- % We disallow ground constraints
- % for which there are no matching instance rules,
- % even though the module system means that it would
- % make sense to allow them: even if there
- % is no instance declaration visible in the current
- % module, there may be one visible in the caller.
- % The reason we disallow them is that in practice
- % allowing this causes type inference to let too
- % many errors slip through, with the error diagnosis
- % being too far removed from the real cause of the
- % error. Note that ground constraints *are* allowed
- % if you declare them, since we removed declared
+ % Check that all of the constraints are satisfiable. Fail if any are
+ % definitely not satisfiable.
+ %
+ % We disallow ground constraints for which there are no matching instance
+ % rules, even though the module system means that it would make sense
+ % to allow them: even if there is no instance declaration visible
+ % in the current module, there may be one visible in the caller. The reason
+ % we disallow them is that in practice allowing this causes type inference
+ % to let too many errors slip through, with the error diagnosis being
+ % too far removed from the real cause of the error. Note that ground
+ % constraints *are* allowed if you declare them, since we removed declared
% constraints before checking satisfiability.
%
- % Similarly, for constraints on head type params
- % (universally quantified type vars in this pred's type decl,
- % or existentially quantified type vars in type decls for
- % callees), we know that the head type params can never get bound.
- % This means that if the constraint wasn't an assumed constraint
- % and can't be eliminated by instance rule or class rule
- % application, then we can report an error now, rather than
- % later. (For non-head-type-param type variables,
- % we need to wait, in case the type variable gets bound
- % to a type for which there is a valid instance declaration.)
- %
- % So a constraint is considered satisfiable iff it
- % contains at least one type variable that is not in the
- % head type params.
+ % Similarly, for constraints on head type params (universally quantified
+ % type vars in this pred's type decl, or existentially quantified type vars
+ % in type decls for callees), we know that the head type params can
+ % never get bound. This means that if the constraint wasn't an assumed
+ % constraint and can't be eliminated by instance rule or class rule
+ % application, then we can report an error now, rather than later.
+ % (For non-head-type-param type variables, we need to wait, in case
+ % the type variable gets bound to a type for which there is a valid
+ % instance declaration.)
+ %
+ % So a constraint is considered satisfiable iff it contains at least one
+ % type variable that is not in the head type params.
%
:- pred check_satisfiability(list(hlds_constraint)::in, head_type_params::in)
is semidet.
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unique_modes.m,v
retrieving revision 1.95
diff -u -b -r1.95 unique_modes.m
--- compiler/unique_modes.m 7 Oct 2005 04:28:58 -0000 1.95
+++ compiler/unique_modes.m 17 Oct 2005 14:56:18 -0000
@@ -593,7 +593,7 @@
modecheck_var_has_inst_list(ArgVars, InitialInsts,
NeedExactMatch, ArgOffset, InstVarSub, !ModeInfo),
mode_list_get_final_insts(ModuleInfo, ProcArgModes, FinalInsts0),
- inst_list_apply_substitution(FinalInsts0, InstVarSub, FinalInsts),
+ inst_list_apply_substitution(InstVarSub, FinalInsts0, FinalInsts),
modecheck_set_var_inst_list(ArgVars, InitialInsts, FinalInsts,
ArgOffset, NewArgVars, ExtraGoals, !ModeInfo),
(
Index: compiler/wrap_blocks.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/wrap_blocks.m,v
retrieving revision 1.6
diff -u -b -r1.6 wrap_blocks.m
--- compiler/wrap_blocks.m 22 Mar 2005 06:40:32 -0000 1.6
+++ compiler/wrap_blocks.m 17 Oct 2005 13:45:26 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 2001, 2003, 2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -25,8 +27,7 @@
:- import_module list.
-:- pred wrap_blocks(list(instruction)::in, list(instruction)::out)
- is det.
+:- pred wrap_blocks(list(instruction)::in, list(instruction)::out) is det.
:- implementation.
@@ -51,7 +52,7 @@
list(instruction)::in, list(instruction)::out) is det.
wrap_instrs([], R, F, RevSofar, []) :-
- ( RevSofar = [_|_] ->
+ ( RevSofar = [_ | _] ->
error("procedure ends with fallthrough")
; ( R > 0 ; F > 0 ) ->
error("procedure ends without closing block")
@@ -75,15 +76,13 @@
( ( Uinstr0 = label(_) ; Uinstr0 = call(_, _, _, _, _, _) ) ->
list__reverse(RevSofar, BlockInstrs),
wrap_instrs(Instrs0, 0, 0, [], Instrs1),
- Instrs = [block(R1, F1, BlockInstrs) - "", Instr0
- | Instrs1]
+ Instrs = [block(R1, F1, BlockInstrs) - "", Instr0 | Instrs1]
; opt_util__can_instr_fall_through(Uinstr0, no) ->
list__reverse([Instr0 | RevSofar], BlockInstrs),
wrap_instrs(Instrs0, 0, 0, [], Instrs1),
Instrs = [block(R1, F1, BlockInstrs) - "" | Instrs1]
;
- wrap_instrs(Instrs0, R1, F1,
- [Instr0 | RevSofar], Instrs)
+ wrap_instrs(Instrs0, R1, F1, [Instr0 | RevSofar], Instrs)
)
;
wrap_instrs(Instrs0, 0, 0, [], Instrs1),
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing mdbcomp
Index: mdbcomp/mdbcomp.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/mdbcomp/mdbcomp.m,v
retrieving revision 1.3
diff -u -b -r1.3 mdbcomp.m
--- mdbcomp/mdbcomp.m 24 Aug 2005 09:07:10 -0000 1.3
+++ mdbcomp/mdbcomp.m 18 Oct 2005 04:37:14 -0000
@@ -1,4 +1,6 @@
%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%---------------------------------------------------------------------------%
% Copyright (C) 2003, 2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
Index: mdbcomp/program_representation.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/mdbcomp/program_representation.m,v
retrieving revision 1.8
diff -u -b -r1.8 program_representation.m
--- mdbcomp/program_representation.m 13 Sep 2005 04:04:06 -0000 1.8
+++ mdbcomp/program_representation.m 18 Oct 2005 01:26:38 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 2001-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
@@ -35,8 +37,8 @@
:- import_module char, list, std_util, bool.
- % A representation of the goal we execute. These need to be
- % generated statically and stored inside the executable.
+ % A representation of the goal we execute. These need to be generated
+ % statically and stored inside the executable.
%
% Each element of this structure will correspond one-to-one
% to the original stage 90 HLDS.
@@ -51,16 +53,13 @@
:- type goal_rep
---> conj_rep(
- list(goal_rep) % The conjuncts in the original
- % order.
+ list(goal_rep) % The conjuncts in the original order.
)
; disj_rep(
- list(goal_rep) % The disjuncts in the original
- % order.
+ list(goal_rep) % The disjuncts in the original order.
)
; switch_rep(
- list(goal_rep) % The switch arms in the
- % original order.
+ list(goal_rep) % The switch arms in the original order.
)
; ite_rep(
goal_rep, % Condition.
@@ -78,9 +77,8 @@
detism_rep,
string, % Filename of context.
int, % Line number of context.
- list(var_rep), % The sorted list of the
- % variables bound by the
- % atomic goal.
+ list(var_rep), % The sorted list of the variables
+ % bound by the atomic goal.
atomic_goal_rep
).
@@ -95,33 +93,29 @@
cons_id_rep,
list(var_rep)
)
- %
+ ; partial_deconstruct_rep(
% A partial deconstruction of the form
% X = f(Y_1, Y_2, ..., Y_n)
% where X is more instanciated after the unification
% than before.
- %
- ; partial_deconstruct_rep(
var_rep, % X
cons_id_rep, % f
- % The list of Y_i's. Y_i's which are
- % input are wrapped in `yes', while the other
- % Y_i positions are `no'.
list(maybe(var_rep))
+ % The list of Y_i's. Y_i's which are input
+ % are wrapped in `yes', while the other
+ % Y_i positions are `no'.
)
- %
+ ; partial_construct_rep(
% A partial construction of the form
% X = f(Y_1, Y_2, ..., Y_n)
% where X is free before the unification and bound,
% but not ground, after the unification.
- %
- ; partial_construct_rep(
var_rep, % X
cons_id_rep, % f
- % The list of Y_i's. Y_i's which are
- % input are wrapped in `yes', while the other
- % Y_i positions are `no'.
list(maybe(var_rep))
+ % The list of Y_i's. Y_i's which are input
+ % are wrapped in `yes', while the other
+ % Y_i positions are `no'.
)
; unify_assign_rep(
var_rep, % target
@@ -186,14 +180,16 @@
% call_is_primitive(ModuleName, PredName): succeeds iff a call to the
% named predicate behaves like a primitive operation, in the sense that
% it does not generate events.
+ %
:- pred call_is_primitive(string::in, string::in) is semidet.
- % The atomic goals module, name and arity
+ % The atomic goal's module, name and arity.
:- type atomic_goal_id
---> atomic_goal_id(string, string, int).
% Can we find out the atomic goals name, module and arity from
% its atomic_goal_rep? If so return them, otherwise return no.
+ %
:- func atomic_goal_identifiable(atomic_goal_rep) =
maybe(atomic_goal_id).
@@ -208,7 +204,8 @@
:- type goal_path_string == string.
-:- type goal_path_step ---> conj(int)
+:- type goal_path_step
+ ---> conj(int)
; disj(int)
; switch(int)
; ite_cond
@@ -220,21 +217,19 @@
; later.
% Does the scope goal have a different determinism inside than outside?
-:- type maybe_cut ---> cut ; no_cut.
+:- type maybe_cut
+ ---> cut
+ ; no_cut.
-:- pred path_from_string_det(string, goal_path).
-:- mode path_from_string_det(in, out) is det.
+:- pred path_from_string_det(string::in, goal_path::out) is det.
:- pred string_from_path(goal_path::in, string::out) is det.
-:- pred path_from_string(string, goal_path).
-:- mode path_from_string(in, out) is semidet.
+:- pred path_from_string(string::in, goal_path::out) is semidet.
-:- pred path_step_from_string(string, goal_path_step).
-:- mode path_step_from_string(in, out) is semidet.
+:- pred path_step_from_string(string::in, goal_path_step::out) is semidet.
-:- pred is_path_separator(char).
-:- mode is_path_separator(in) is semidet.
+:- pred is_path_separator(char::in) is semidet.
% User-visible head variables are represented by a number from 1..N,
% where N is the user-visible arity.
@@ -248,22 +243,24 @@
% filtering out non-user-visible vars.
; any_head_var(int) % Nth in the list of all arguments.
- % (M-N+1)th argument in the list of all arguments,
- % where N is the value of the int in the constructor
- % and M is the total number of arguments.
; any_head_var_from_back(int).
+ % (M-N+1)th argument in the list of all
+ % arguments, where N is the value of the int
+ % in the constructor and M is the total number
+ % of arguments.
% A particular subterm within a term is represented by a term_path.
% This is the list of argument positions that need to be followed
% in order to travel from the root to the subterm. In contrast to
% goal_paths, this list is in top-down order.
-
:- type term_path == list(int).
% Returns type_of(_ `with_type` proc_rep), for use in C code.
+ %
:- func proc_rep_type = type_desc.
% Returns type_of(_ `with_type` goal_rep), for use in C code.
+ %
:- func goal_rep_type = type_desc.
% Construct a representation of the interface determinism of a
@@ -276,6 +273,7 @@
% The 4 bit is set iff the min number of solutions is more than zero.
% The 2 bit is set iff the max number of solutions is more than zero.
% The 1 bit is set iff the max number of solutions is more than one.
+ %
:- func detism_rep(detism_rep) = int.
:- pred determinism_representation(detism_rep, int).
@@ -351,16 +349,16 @@
string_to_sym_name(ModuleName, ".", SymModuleName),
any_mercury_builtin_module(SymModuleName)
;
- %
- % The following are also treated as primitive since
- % compiler generated predicate events are not
- % included in the annotated trace at the moment.
- %
+ % The following are also treated as primitive since events from
+ % compiler generated predicates are not included in the annotated trace
+ % at the moment.
+ (
PredName = "__Unify__"
;
PredName = "__Index__"
;
PredName = "__Compare__"
+ )
).
goal_generates_internal_event(conj_rep(_)) = no.
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
Index: tools/makebatch
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/tools/makebatch,v
retrieving revision 1.34
diff -u -b -r1.34 makebatch
--- tools/makebatch 17 Oct 2005 02:18:09 -0000 1.34
+++ tools/makebatch 17 Oct 2005 07:44:12 -0000
@@ -5,15 +5,18 @@
#
# The control and output files are all in the subdirectory batch.
# The control files are $batch.MCFLAGS and possibly $batch.CFLAGS,
-# $batch.MGNUCFLAGS, $batch.MLFLAGS, $batch.GRADE, and/or $batch.MMAKE,
-# where $batch is the last argument of makebatch. $batch.CFLAGS,
-# $batch.MGNUCFLAGS, $batch.MLFLAGS, $batch.GRADE and $batch.MMAKE
-# are consulted if they exist.
+# $batch.MGNUCFLAGS, $batch.MLFLAGS, $batch.GRADE, $batch.MMAKE,
+# $batch.MMAKE.$n where $batch is the last argument of makebatch.
+# They are all consulted if they exist.
#
-# All the control files except $batch.MMAKE must have the same number
-# of lines. Each line corresponds to a version of the compiler that is
-# built with the MCFLAGS, EXTRA_MGNUCFLAGS, EXTRA_CFLAGS and GRADE make
-# variables being set from that line.
+# All the control files except $batch.MMAKE and $batch.MMAKE.$n
+# must have the same number of lines. Each line corresponds to a version
+# of the compiler that is built with the MCFLAGS, EXTRA_CFLAGS,
+# EXTRA_MGNUCFLAGS, EXTRA_MLFLAGS and GRADE make variables being set
+# from that line.
+#
+# The control file $batch.MMAKE.$n contains an Mmakefile fragment that is
+# included in the parameters of the version numbered $n.
#
# The control file $batch.MMAKE contains an Mmakefile fragment that is
# included in the parameters of all the versions being built.
@@ -189,6 +192,11 @@
then
mlflags=`awk "NR == $n" batch/$batch.MLFLAGS`
echo "EXTRA_MLFLAGS = $mlflags" >> Mmake.stage.params
+ fi
+
+ if test -f batch/$batch.MMAKE.$n
+ then
+ cat batch/$batch.MMAKE.$n >> Mmake.stage.params
fi
if $needgrade
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
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