[m-rev.] diff: misc compiler cleanups (part 1)
Zoltan Somogyi
zs at cs.mu.OZ.AU
Fri Mar 19 21:14:08 AEDT 2004
compiler/modules.m:
compiler/compile_target_code.m:
compiler/handle_options.m:
compiler/bytecode_data.m:
compiler/prog_io_util.m:
Bring these modules up to date with our current coding style. Use
predmode declarations and state variable syntax where appropriate.
Fix inconsistent indentation. Print more error messages using
error_util.m for printing error messages.
compiler/trace_param.m:
Add a new predicate for use by the updated code in handle_options.m.
compiler/error_util.m:
compiler/hlds_error_util.m:
Make error_util.m to be a submodule of parse_tree.m, not hlds.m.
Most of its predicates are not dependent on HLDS data structures.
Move the ones that are into a new module, hlds_error_util, that
is a submodule of hlds.m. Overall, this reduces the dependence
of submodules of parse_tree.m, including modules.m, on submodules
of hlds.m.
compiler/notes/compiler_design.html:
Update the documentation of compiler modes to account for
hlds_error_util.m.
compiler/hlds.m:
compiler/parse_tree.m:
Update the list of included submodules.
compiler/*.m:
Update module imports and module qualifications as needed for the
change above.
tests/invalid/*.{exp,exp2}:
Update the expected outputs of a bunch of test cases to reflect the new
format of some warning messages due to the user error_util; they now
observe line length limits, and print contexts in some cases where they
were previously missing.
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
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/accumulator.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/accumulator.m,v
retrieving revision 1.26
diff -u -b -r1.26 accumulator.m
--- compiler/accumulator.m 21 Dec 2003 05:04:32 -0000 1.26
+++ compiler/accumulator.m 16 Mar 2004 05:54:27 -0000
@@ -160,15 +160,16 @@
:- import_module check_hlds__inst_match.
:- import_module check_hlds__mode_util.
:- import_module hlds__assertion.
-:- import_module hlds__error_util.
:- import_module hlds__goal_util.
:- import_module hlds__hlds_data.
+:- import_module hlds__hlds_error_util.
:- import_module hlds__hlds_goal.
:- import_module hlds__hlds_out.
:- import_module hlds__instmap.
:- import_module hlds__quantification.
:- import_module libs__globals.
:- import_module libs__options.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__inst.
:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_util.
@@ -244,8 +245,8 @@
->
{ ModuleInfo = ModuleInfo1 }
;
- { error_util__describe_one_pred_name(ModuleInfo1,
- PredId, PredName) },
+ { describe_one_pred_name(ModuleInfo1, PredId,
+ PredName) },
{ pred_info_context(PredInfo, Context) },
error_util__write_error_pieces(Context, 0,
@@ -335,7 +336,7 @@
output_warning(warn(Context, PredId, VarA, VarB), VarSet, ModuleInfo,
Context, Formats) :-
- error_util__describe_one_pred_name(ModuleInfo, PredId, PredStr),
+ describe_one_pred_name(ModuleInfo, PredId, PredStr),
varset__lookup_name(VarSet, VarA, VarAStr0),
varset__lookup_name(VarSet, VarB, VarBStr0),
Index: compiler/bytecode_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/bytecode_data.m,v
retrieving revision 1.11
diff -u -b -r1.11 bytecode_data.m
--- compiler/bytecode_data.m 26 May 2003 08:59:49 -0000 1.11
+++ compiler/bytecode_data.m 15 Mar 2004 11:40:47 -0000
@@ -21,15 +21,10 @@
:- import_module io, int, list, string.
% XXX this assumes strings contain 8-bit characters
-:- pred output_string(string, io__state, io__state).
-:- mode output_string(in, di, uo) is det.
+:- pred output_string(string::in, io::di, io::uo) is det.
+:- pred string_to_byte_list(string::in, list(int)::out) is det.
- % XXX this assumes strings contain 8-bit characters
-:- pred string_to_byte_list(string, list(int)).
-:- mode string_to_byte_list(in, out) is det.
-
-:- pred output_byte(int, io__state, io__state).
-:- mode output_byte(in, di, uo) is det.
+:- pred output_byte(int::in, io::di, io::uo) is det.
/*
** Spit out an `int' in a portable `highest common denominator' format.
@@ -37,20 +32,16 @@
**
** NOTE: We -assume- the machine architecture uses 2's-complement.
*/
-:- pred output_int(int, io__state, io__state).
-:- mode output_int(in, di, uo) is det.
-:- pred int_to_byte_list(int, list(int)).
-:- mode int_to_byte_list(in, out) is det.
+:- pred output_int(int::in, io::di, io::uo) is det.
+:- pred int_to_byte_list(int::in, list(int)::out) is det.
/*
** Same as output_int and int_to_byte_list, except only use 32 bits.
*/
-:- pred output_int32(int, io__state, io__state).
-:- mode output_int32(in, di, uo) is det.
-:- pred int32_to_byte_list(int, list(int)).
-:- mode int32_to_byte_list(in, out) is det.
+:- pred output_int32(int::in, io::di, io::uo) is det.
+:- pred int32_to_byte_list(int::in, list(int)::out) is det.
/*
** Spit out a `short' in a portable format.
@@ -58,11 +49,9 @@
**
** NOTE: We -assume- the machine architecture uses 2's-complement.
*/
-:- pred output_short(int, io__state, io__state).
-:- mode output_short(in, di, uo) is det.
-:- pred short_to_byte_list(int, list(int)).
-:- mode short_to_byte_list(in, out) is det.
+:- pred output_short(int::in, io::di, io::uo) is det.
+:- pred short_to_byte_list(int::in, list(int)::out) is det.
/*
** Spit out a `float' in a portable `highest common denominator format.
@@ -70,28 +59,27 @@
**
** NOTE: We -assume- the machine architecture uses IEEE-754.
*/
-:- pred output_float(float, io__state, io__state).
-:- mode output_float(in, di, uo) is det.
-:- pred float_to_byte_list(float, list(int)).
-:- mode float_to_byte_list(in, out) is det.
+:- pred output_float(float::in, io::di, io::uo) is det.
+:- pred float_to_byte_list(float::in, list(int)::out) is det.
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module hlds.error_util.
+:- import_module parse_tree__error_util.
+
:- import_module char, require.
-output_string(Val) -->
+output_string(Val, !IO) :-
% XXX this assumes strings contain 8-bit characters
% Using write_bytes here is wrong; the output will depend
% on the Mercury implementation's representation of chars,
% so it may be different for different Mercury implementations.
% In particular, it will do the wrong thing for Mercury
% implementations which represent characters in Unicode.
- io__write_bytes(Val),
- io__write_byte(0).
+ io__write_bytes(Val, !IO),
+ io__write_byte(0, !IO).
string_to_byte_list(Val, List) :-
% XXX this assumes strings contain 8-bit characters
@@ -105,31 +93,31 @@
list__map(ToInt, Chars, List0),
list__append(List0, [0], List).
-output_byte(Val) -->
- ( { Val < 256 } ->
- io__write_byte(Val)
+output_byte(Val, !IO) :-
+ ( Val < 256 ->
+ io__write_byte(Val, !IO)
;
- { error("byte does not fit in eight bits") }
+ error("byte does not fit in eight bits")
).
-output_short(Val) -->
- output_int(16, Val).
+output_short(Val, !IO) :-
+ output_int(16, Val, !IO).
short_to_byte_list(Val, Bytes) :-
int_to_byte_list(16, Val, Bytes).
-output_int32(IntVal) -->
- output_int(32, IntVal).
+output_int32(IntVal, !IO) :-
+ output_int(32, IntVal, !IO).
int32_to_byte_list(IntVal, List) :-
int_to_byte_list(32, IntVal, List).
-output_int(IntVal) -->
- { int__bits_per_int(IntBits) },
- ( { IntBits > bytecode_int_bits } ->
- { error("size of int is larger than size of bytecode integer.")}
+output_int(IntVal, !IO) :-
+ int__bits_per_int(IntBits),
+ ( IntBits > bytecode_int_bits ->
+ error("size of int is larger than size of bytecode integer.")
;
- output_int(bytecode_int_bits, IntVal)
+ output_int(bytecode_int_bits, IntVal, !IO)
).
int_to_byte_list(IntVal, Bytes) :-
@@ -140,21 +128,18 @@
int_to_byte_list(bytecode_int_bits, IntVal, Bytes)
).
-:- pred output_int(int, int, io__state, io__state).
-:- mode output_int(in, in, di, uo) is det.
+:- pred output_int(int::in, int::in, io::di, io::uo) is det.
-output_int(Bits, IntVal) -->
- output_int(io__write_byte, Bits, IntVal).
+output_int(Bits, IntVal, !IO) :-
+ output_int(io__write_byte, Bits, IntVal, !IO).
-:- pred int_to_byte_list(int, int, list(int)).
-:- mode int_to_byte_list(in, in, out) is det.
+:- pred int_to_byte_list(int::in, int::in, list(int)::out) is det.
int_to_byte_list(Bits, IntVal, Bytes) :-
output_int(cons, Bits, IntVal, [], RevBytes),
list__reverse(RevBytes, Bytes).
-:- pred cons(T, list(T), list(T)).
-:- mode cons(in, in, out) is det.
+:- pred cons(T::in, list(T)::in, list(T)::out) is det.
cons(T, List, [T | List]).
@@ -162,9 +147,9 @@
:- mode output_int(pred(in, in, out) is det, in, in, in, out) is det.
:- mode output_int(pred(in, di, uo) is det, in, in, di, uo) is det.
-output_int(Writer, Bits, IntVal) -->
- { int__bits_per_int(IntBits) },
- {
+output_int(Writer, Bits, IntVal, !IO) :-
+ int__bits_per_int(IntBits),
+ (
Bits < IntBits,
int__pow(2, Bits - 1, MaxVal),
( IntVal >= MaxVal
@@ -172,34 +157,32 @@
)
->
string__format(
- "error: bytecode_data__output_int: %d does not fit in %d bits",
+ "error: bytecode_data__output_int: " ++
+ "%d does not fit in %d bits",
[i(IntVal), i(Bits)], Msg),
error(Msg)
;
true
- },
- { Bits > IntBits ->
+ ),
+ ( Bits > IntBits ->
ZeroPadBytes = (Bits - IntBits) // bits_per_byte
;
ZeroPadBytes = 0
- },
- output_padding_zeros(Writer, ZeroPadBytes),
- { BytesToDump = Bits // bits_per_byte },
- { FirstByteToDump = BytesToDump - ZeroPadBytes - 1 },
- output_int_bytes(Writer, FirstByteToDump, IntVal).
+ ),
+ output_padding_zeros(Writer, ZeroPadBytes, !IO),
+ BytesToDump = Bits // bits_per_byte,
+ FirstByteToDump = BytesToDump - ZeroPadBytes - 1,
+ output_int_bytes(Writer, FirstByteToDump, IntVal, !IO).
:- func bytecode_int_bits = int.
-:- mode bytecode_int_bits = out is det.
bytecode_int_bits = bits_per_byte * bytecode_int_bytes.
:- func bytecode_int_bytes = int.
-:- mode bytecode_int_bytes = out is det.
bytecode_int_bytes = 8.
:- func bits_per_byte = int.
-:- mode bits_per_byte = out is det.
bits_per_byte = 8.
@@ -207,40 +190,40 @@
:- mode output_padding_zeros(pred(in, in, out) is det, in, in, out) is det.
:- mode output_padding_zeros(pred(in, di, uo) is det, in, di, uo) is det.
-output_padding_zeros(Writer, NumBytes) -->
- ( { NumBytes > 0 } ->
- call(Writer, 0),
- { NumBytes1 = NumBytes - 1 },
- output_padding_zeros(Writer, NumBytes1)
+output_padding_zeros(Writer, NumBytes, !IO) :-
+ ( NumBytes > 0 ->
+ call(Writer, 0, !IO),
+ NumBytes1 = NumBytes - 1,
+ output_padding_zeros(Writer, NumBytes1, !IO)
;
- []
+ true
).
:- pred output_int_bytes(pred(int, T, T), int, int, T, T).
:- mode output_int_bytes(pred(in, in, out) is det, in, in, in, out) is det.
:- mode output_int_bytes(pred(in, di, uo) is det, in, in, di, uo) is det.
-output_int_bytes(Writer, ByteNum, IntVal) -->
- ( { ByteNum >= 0 } ->
- { BitShifts = ByteNum * bits_per_byte },
- { Byte = (IntVal >> BitShifts) mod (1 << bits_per_byte) },
- { ByteNum1 = ByteNum - 1 },
- call(Writer, Byte),
- output_int_bytes(Writer, ByteNum1, IntVal)
+output_int_bytes(Writer, ByteNum, IntVal, !IO) :-
+ ( ByteNum >= 0 ->
+ BitShifts = ByteNum * bits_per_byte,
+ Byte = (IntVal >> BitShifts) mod (1 << bits_per_byte),
+ ByteNum1 = ByteNum - 1,
+ call(Writer, Byte, !IO),
+ output_int_bytes(Writer, ByteNum1, IntVal, !IO)
;
- []
+ true
).
-output_float(Val) -->
- { float_to_float64_bytes(Val, B0, B1, B2, B3, B4, B5, B6, B7) },
- output_byte(B0),
- output_byte(B1),
- output_byte(B2),
- output_byte(B3),
- output_byte(B4),
- output_byte(B5),
- output_byte(B6),
- output_byte(B7).
+output_float(Val, !IO) :-
+ float_to_float64_bytes(Val, B0, B1, B2, B3, B4, B5, B6, B7),
+ output_byte(B0, !IO),
+ output_byte(B1, !IO),
+ output_byte(B2, !IO),
+ output_byte(B3, !IO),
+ output_byte(B4, !IO),
+ output_byte(B5, !IO),
+ output_byte(B6, !IO),
+ output_byte(B7, !IO).
float_to_byte_list(Val, [B0, B1, B2, B3, B4, B5, B6, B7]) :-
float_to_float64_bytes(Val, B0, B1, B2, B3, B4, B5, B6, B7).
@@ -249,15 +232,16 @@
** Convert a `float' to the representation used in the bytecode.
** That is, a sequence of eight bytes.
*/
+
:- pred float_to_float64_bytes(float::in,
int::out, int::out, int::out, int::out,
int::out, int::out, int::out, int::out) is det.
-:- pragma c_code(
- float_to_float64_bytes(FloatVal::in, B0::out, B1::out, B2::out, B3::out,
- B4::out, B5::out, B6::out, B7::out),
- will_not_call_mercury,
- "
+:- pragma c_code(
+ float_to_float64_bytes(FloatVal::in, B0::out, B1::out, B2::out,
+ B3::out, B4::out, B5::out, B6::out, B7::out),
+ [will_not_call_mercury],
+"
{
MR_Float64 float64;
unsigned char *raw_mem_p;
@@ -287,13 +271,13 @@
#error ""Weird-endian architecture""
#endif
}
+").
- "
-).
float_to_float64_bytes(_FloatVal, _B0, _B1, _B2, _B3, _B4, _B5, _B6, _B7) :-
sorry(this_file, "float_to_float64_bytes for non-C target").
:- func this_file = string.
+
this_file = "bytecode_data.m".
:- end_module bytecode_data.
Index: compiler/bytecode_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/bytecode_gen.m,v
retrieving revision 1.78
diff -u -b -r1.78 bytecode_gen.m
--- compiler/bytecode_gen.m 1 Dec 2003 15:55:29 -0000 1.78
+++ compiler/bytecode_gen.m 16 Mar 2004 05:37:27 -0000
@@ -42,7 +42,6 @@
:- import_module backend_libs__code_model.
:- import_module check_hlds__mode_util.
:- import_module check_hlds__type_util.
-:- import_module hlds__error_util.
:- import_module hlds__goal_util.
:- import_module hlds__hlds_code_util.
:- import_module hlds__hlds_data.
@@ -53,6 +52,7 @@
:- import_module libs__tree.
:- import_module ll_backend__arg_info.
:- import_module ll_backend__call_gen. % XXX for arg passing convention
+:- import_module parse_tree__error_util.
:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_out.
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.54
diff -u -b -r1.54 check_typeclass.m
--- compiler/check_typeclass.m 6 Feb 2004 05:08:30 -0000 1.54
+++ compiler/check_typeclass.m 16 Mar 2004 05:37:43 -0000
@@ -61,15 +61,15 @@
:- import_module backend_libs__base_typeclass_info.
:- import_module check_hlds__inst_match.
:- import_module check_hlds__mode_util.
-:- import_module check_hlds__type_util.
:- import_module check_hlds__typecheck.
-:- import_module hlds__error_util.
+:- import_module check_hlds__type_util.
:- import_module hlds__hlds_data.
:- import_module hlds__hlds_goal.
:- import_module hlds__hlds_out.
:- import_module hlds__hlds_pred.
:- import_module libs__globals.
:- import_module libs__options.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__mercury_to_mercury.
:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_out.
Index: compiler/compile_target_code.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/compile_target_code.m,v
retrieving revision 1.54
diff -u -b -r1.54 compile_target_code.m
--- compiler/compile_target_code.m 20 Feb 2004 01:49:50 -0000 1.54
+++ compiler/compile_target_code.m 16 Mar 2004 05:38:26 -0000
@@ -9,6 +9,7 @@
% Code to compile the generated `.c', `.s', `.o', etc, files.
%
%-----------------------------------------------------------------------------%
+
:- module backend_libs__compile_target_code.
:- interface.
@@ -20,7 +21,6 @@
:- import_module bool, list, io, std_util.
-
% Are we generating position independent code (for use in a
% shared library)? On some architectures, pic and non-pic
% code is incompatible, so we need to generate `.o' and `.pic_o'
@@ -28,116 +28,100 @@
:- type pic
---> pic
; link_with_pic
- ; non_pic
- .
+ ; non_pic.
% compile_c_file(ErrorStream, PIC, CFile, ObjFile, Succeeded).
-:- pred compile_c_file(io__output_stream, pic, string, string, bool,
- io__state, io__state).
-:- mode compile_c_file(in, in, in, in, out, di, uo) is det.
+:- pred compile_c_file(io__output_stream::in, pic::in, string::in, string::in,
+ bool::out, io::di, io::uo) is det.
% compile_c_file(ErrorStream, PIC, ModuleName, Succeeded).
-:- pred compile_c_file(io__output_stream, pic, module_name, bool,
- io__state, io__state).
-:- mode compile_c_file(in, in, in, out, di, uo) is det.
+:- pred compile_c_file(io__output_stream::in, pic::in, module_name::in,
+ bool::out, io::di, io::uo) is det.
% assemble(ErrorStream, PIC, ModuleName, Succeeded).
-:- pred assemble(io__output_stream, pic, module_name,
- bool, io__state, io__state).
-:- mode assemble(in, in, in, out, di, uo) is det.
+:- pred assemble(io__output_stream::in, pic::in, module_name::in,
+ bool::out, io::di, io::uo) is det.
% compile_java_file(ErrorStream, JavaFile, Succeeded).
-:- pred compile_java_file(io__output_stream, string, bool,
- io__state, io__state).
-:- mode compile_java_file(in, in, out, di, uo) is det.
+:- pred compile_java_file(io__output_stream::in, string::in, bool::out,
+ io::di, io::uo) is det.
% il_assemble(ErrorStream, ModuleName, HasMain, Succeeded).
-:- pred il_assemble(io__output_stream, module_name,
- has_main, bool, io__state, io__state).
-:- mode il_assemble(in, in, in, out, di, uo) is det.
+:- pred il_assemble(io__output_stream::in, module_name::in, has_main::in,
+ bool::out, io::di, io::uo) is det.
% il_assemble(ErrorStream, ILFile, DLLFile, HasMain, Succeeded).
-:- pred il_assemble(io__output_stream, file_name, file_name,
- has_main, bool, io__state, io__state).
-:- mode il_assemble(in, in, in, in, out, di, uo) is det.
+:- pred il_assemble(io__output_stream::in, file_name::in, file_name::in,
+ has_main::in, bool::out, io::di, io::uo) is det.
% compile_managed_cplusplus_file(ErrorStream,
% MCPPFile, DLLFile, Succeeded).
-:- pred compile_managed_cplusplus_file(io__output_stream,
- file_name, file_name, bool, io__state, io__state).
-:- mode compile_managed_cplusplus_file(in, in, in, out, di, uo) is det.
+:- pred compile_managed_cplusplus_file(io__output_stream::in,
+ file_name::in, file_name::in, bool::out, io::di, io::uo) is det.
% compile_csharp_file(ErrorStream, C#File, DLLFile, Succeeded).
-:- pred compile_csharp_file(io__output_stream, module_imports,
- file_name, file_name, bool, io__state, io__state).
-:- mode compile_csharp_file(in, in, in, in, out, di, uo) is det.
+:- pred compile_csharp_file(io__output_stream::in, module_imports::in,
+ file_name::in, file_name::in, bool::out, io::di, io::uo) is det.
% make_init_file(ErrorStream, MainModuleName, ModuleNames, Succeeded).
%
% Make the `.init' file for a library containing the given modules.
-:- pred make_init_file(io__output_stream, module_name,
- list(module_name), bool, io__state, io__state).
-:- mode make_init_file(in, in, in, out, di, uo) is det.
+:- pred make_init_file(io__output_stream::in, module_name::in,
+ list(module_name)::in, bool::out, io::di, io::uo) is det.
% make_init_obj_file(ErrorStream, MainModuleName,
% AllModuleNames, MaybeInitObjFileName).
-:- pred make_init_obj_file(io__output_stream, module_name, list(module_name),
- maybe(file_name), io__state, io__state).
-:- mode make_init_obj_file(in, in, in, out, di, uo) is det.
+:- pred make_init_obj_file(io__output_stream::in, module_name::in,
+ list(module_name)::in, maybe(file_name)::out, io::di, io::uo) is det.
:- type linked_target_type
---> executable
; static_library
; shared_library
- ; java_archive
- .
+ ; java_archive.
% link(TargetType, MainModuleName, ObjectFileNames, Succeeded).
-:- pred link(io__output_stream, linked_target_type, module_name,
- list(string), bool, io__state, io__state).
-:- mode link(in, in, in, in, out, di, uo) is det.
+:- pred link(io__output_stream::in, linked_target_type::in, module_name::in,
+ list(string)::in, bool::out, io::di, io::uo) is det.
% link_module_list(ModulesToLink, Succeeded).
%
% The elements of ModulesToLink are the output of
% `module_name_to_filename(ModuleName, "", no, ModuleToLink)'
% for each module in the program.
-:- pred link_module_list(list(string), bool, io__state, io__state).
-:- mode link_module_list(in, out, di, uo) is det.
+:- pred link_module_list(list(string)::in, bool::out, io::di, io::uo) is det.
% get_object_code_type(TargetType, PIC)
%
% Work out whether we should be generating position-independent
% object code.
-:- pred get_object_code_type(linked_target_type, pic, io__state, io__state).
-:- mode get_object_code_type(in, out, di, uo) is det.
+:- pred get_object_code_type(linked_target_type::in, pic::out, io::di, io::uo)
+ is det.
%-----------------------------------------------------------------------------%
% Code to deal with `--split-c-files'.
% split_c_to_obj(ErrorStream, ModuleName, NumChunks, Succeeded).
% Compile the `.c' files produced for a module with `--split-c-files'.
-:- pred split_c_to_obj(io__output_stream, module_name,
- int, bool, io__state, io__state).
-:- mode split_c_to_obj(in, in, in, out, di, uo) is det.
+:- pred split_c_to_obj(io__output_stream::in, module_name::in,
+ int::in, bool::out, io::di, io::uo) is det.
% Write the number of `.c' files written by this
% compilation with `--split-c-files'.
-:- pred write_num_split_c_files(module_name, int, bool, io__state, io__state).
-:- mode write_num_split_c_files(in, in, out, di, uo) is det.
+:- pred write_num_split_c_files(module_name::in, int::in, bool::out,
+ io::di, io::uo) is det.
% Find the number of `.c' files written by a previous
% compilation with `--split-c-files'.
-:- pred read_num_split_c_files(module_name, maybe_error(int),
- io__state, io__state).
-:- mode read_num_split_c_files(in, out, di, uo) is det.
+:- pred read_num_split_c_files(module_name::in, maybe_error(int)::out,
+ io::di, io::uo) is det.
% remove_split_c_output_files(ModuleName, NumChunks).
%
% Remove the `.c' and `.o' files written by a previous
% compilation with `--split-c-files'.
-:- pred remove_split_c_output_files(module_name, int, io__state, io__state).
-:- mode remove_split_c_output_files(in, in, di, uo) is det.
+:- pred remove_split_c_output_files(module_name::in, int::in,
+ io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
@@ -146,9 +130,8 @@
%
% Create a command string which passes the source file names
% for AllModuleNames to CommandName, with MainModule given first.
-:- pred make_all_module_command(string, module_name,
- list(module_name), string, io__state, io__state).
-:- mode make_all_module_command(in, in, in, out, di, uo) is det.
+:- pred make_all_module_command(string::in, module_name::in,
+ list(module_name)::in, string::out, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
@@ -165,8 +148,8 @@
:- mode maybe_pic_object_file_extension(in, out, in) is semidet.
% Same as above except the globals are obtained from the io__state.
-:- pred maybe_pic_object_file_extension(pic::in, string::out,
- io__state::di, io__state::uo) is det.
+:- pred maybe_pic_object_file_extension(pic::in, string::out, io::di, io::uo)
+ is det.
%-----------------------------------------------------------------------------%
@@ -174,124 +157,124 @@
:- import_module backend_libs__foreign.
:- import_module backend_libs__name_mangle.
-:- import_module hlds__error_util.
:- import_module hlds__passes_aux.
:- import_module libs__globals.
:- import_module libs__handle_options.
:- import_module libs__options.
:- import_module libs__trace_params.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__prog_out.
:- import_module char, dir, getopt, int, require, string.
-il_assemble(ErrorStream, ModuleName, HasMain, Succeeded) -->
- module_name_to_file_name(ModuleName, ".il", no, IL_File),
- module_name_to_file_name(ModuleName, ".dll", yes, DllFile),
+il_assemble(ErrorStream, ModuleName, HasMain, Succeeded, !IO) :-
+ module_name_to_file_name(ModuleName, ".il", no, IL_File, !IO),
+ module_name_to_file_name(ModuleName, ".dll", yes, DllFile, !IO),
%
% If the module contains main/2 then we it should be built as an
% executable. Unfortunately MC++ or C# code may refer to the dll
% so we always need to build the dll.
%
- il_assemble(ErrorStream, IL_File, DllFile, no_main, DllSucceeded),
- ( { HasMain = has_main } ->
- module_name_to_file_name(ModuleName, ".exe", yes, ExeFile),
- il_assemble(ErrorStream, IL_File, ExeFile,
- HasMain, ExeSucceeded),
- { Succeeded = DllSucceeded `and` ExeSucceeded }
+ il_assemble(ErrorStream, IL_File, DllFile, no_main, DllSucceeded, !IO),
+ ( HasMain = has_main ->
+ module_name_to_file_name(ModuleName, ".exe", yes, ExeFile, !IO),
+ il_assemble(ErrorStream, IL_File, ExeFile, HasMain,
+ ExeSucceeded, !IO),
+ Succeeded = DllSucceeded `and` ExeSucceeded
;
- { Succeeded = DllSucceeded }
+ Succeeded = DllSucceeded
).
-il_assemble(ErrorStream, IL_File, TargetFile,
- HasMain, Succeeded) -->
- globals__io_lookup_bool_option(verbose, Verbose),
- globals__io_lookup_bool_option(sign_assembly, SignAssembly),
- maybe_write_string(Verbose, "% Assembling `"),
- maybe_write_string(Verbose, IL_File),
- maybe_write_string(Verbose, "':\n"),
- globals__io_lookup_string_option(il_assembler, ILASM),
- globals__io_lookup_accumulating_option(ilasm_flags, ILASMFlagsList),
- { join_string_list(ILASMFlagsList, "", "", " ", ILASMFlags) },
- { SignAssembly = yes ->
+il_assemble(ErrorStream, IL_File, TargetFile, HasMain, Succeeded, !IO) :-
+ globals__io_lookup_bool_option(verbose, Verbose, !IO),
+ globals__io_lookup_bool_option(sign_assembly, SignAssembly, !IO),
+ maybe_write_string(Verbose, "% Assembling `", !IO),
+ maybe_write_string(Verbose, IL_File, !IO),
+ maybe_write_string(Verbose, "':\n", !IO),
+ globals__io_lookup_string_option(il_assembler, ILASM, !IO),
+ globals__io_lookup_accumulating_option(ilasm_flags, ILASMFlagsList, !IO),
+ join_string_list(ILASMFlagsList, "", "", " ", ILASMFlags),
+ ( SignAssembly = yes ->
SignOpt = "/keyf=mercury.sn "
;
SignOpt = ""
- },
- { Verbose = yes ->
+ ),
+ ( Verbose = yes ->
VerboseOpt = ""
;
VerboseOpt = "/quiet "
- },
- globals__io_lookup_bool_option(target_debug, Debug),
- { Debug = yes ->
+ ),
+ globals__io_lookup_bool_option(target_debug, Debug, !IO),
+ ( Debug = yes ->
DebugOpt = "/debug "
;
DebugOpt = ""
- },
- { HasMain = has_main ->
+ ),
+ ( HasMain = has_main ->
TargetOpt = ""
;
TargetOpt = "/dll "
- },
- { string__append_list([ILASM, " ", SignOpt, VerboseOpt, DebugOpt,
+ ),
+ string__append_list([ILASM, " ", SignOpt, VerboseOpt, DebugOpt,
TargetOpt, ILASMFlags, " /out=", TargetFile,
- " ", IL_File], Command) },
- invoke_system_command(ErrorStream, verbose_commands,
- Command, Succeeded).
-
-compile_managed_cplusplus_file(ErrorStream,
- MCPPFileName, DLLFileName, Succeeded) -->
- globals__io_lookup_bool_option(verbose, Verbose),
- maybe_write_string(Verbose, "% Compiling `"),
- maybe_write_string(Verbose, MCPPFileName),
- maybe_write_string(Verbose, "':\n"),
- globals__io_lookup_string_option(mcpp_compiler, MCPP),
- globals__io_lookup_accumulating_option(mcpp_flags, MCPPFlagsList),
- { join_string_list(MCPPFlagsList, "", "", " ", MCPPFlags) },
- globals__io_lookup_bool_option(target_debug, Debug),
- { Debug = yes ->
+ " ", IL_File], Command),
+ invoke_system_command(ErrorStream, verbose_commands, Command,
+ Succeeded, !IO).
+
+compile_managed_cplusplus_file(ErrorStream, MCPPFileName, DLLFileName,
+ Succeeded, !IO) :-
+ globals__io_lookup_bool_option(verbose, Verbose, !IO),
+ maybe_write_string(Verbose, "% Compiling `", !IO),
+ maybe_write_string(Verbose, MCPPFileName, !IO),
+ maybe_write_string(Verbose, "':\n", !IO),
+ globals__io_lookup_string_option(mcpp_compiler, MCPP, !IO),
+ globals__io_lookup_accumulating_option(mcpp_flags, MCPPFlagsList, !IO),
+ join_string_list(MCPPFlagsList, "", "", " ", MCPPFlags),
+ globals__io_lookup_bool_option(target_debug, Debug, !IO),
+ ( Debug = yes ->
DebugOpt = "/Zi "
;
DebugOpt = ""
- },
+ ),
% XXX Should we introduce a `--mcpp-include-directory' option?
globals__io_lookup_accumulating_option(c_include_directory,
- C_Incl_Dirs),
- { InclOpts = string__append_list(list__condense(list__map(
- (func(C_INCL) = ["-I", C_INCL, " "]), C_Incl_Dirs))) },
+ C_Incl_Dirs, !IO),
+ InclOpts = string__append_list(list__condense(list__map(
+ (func(C_INCL) = ["-I", C_INCL, " "]), C_Incl_Dirs))),
% XXX Should we use a separate dll_directories options?
globals__io_lookup_accumulating_option(link_library_directories,
- DLLDirs),
- { DLLDirOpts = "-AIMercury/dlls " ++
+ DLLDirs, !IO),
+ DLLDirOpts = "-AIMercury/dlls " ++
string__append_list(list__condense(list__map(
- (func(DLLDir) = ["-AI", DLLDir, " "]), DLLDirs))) },
+ (func(DLLDir) = ["-AI", DLLDir, " "]), DLLDirs))),
- { string__append_list([MCPP, " -CLR ", DebugOpt, InclOpts,
+ string__append_list([MCPP, " -CLR ", DebugOpt, InclOpts,
DLLDirOpts, MCPPFlags, " ", MCPPFileName,
" -LD -o ", DLLFileName],
- Command) },
- invoke_system_command(ErrorStream, verbose_commands,
- Command, Succeeded).
-
-compile_csharp_file(ErrorStream, Imports,
- CSharpFileName0, DLLFileName, Succeeded) -->
- globals__io_lookup_bool_option(verbose, Verbose),
- maybe_write_string(Verbose, "% Compiling `"),
- maybe_write_string(Verbose, CSharpFileName),
- maybe_write_string(Verbose, "':\n"),
- globals__io_lookup_string_option(csharp_compiler, CSC),
- globals__io_lookup_accumulating_option(csharp_flags, CSCFlagsList),
- { join_string_list(CSCFlagsList, "", "", " ", CSCFlags) },
+ Command),
+ invoke_system_command(ErrorStream, verbose_commands, Command,
+ Succeeded, !IO).
+
+compile_csharp_file(ErrorStream, Imports, CSharpFileName0, DLLFileName,
+ Succeeded, !IO) :-
+ globals__io_lookup_bool_option(verbose, Verbose, !IO),
+ maybe_write_string(Verbose, "% Compiling `", !IO),
+ maybe_write_string(Verbose, CSharpFileName, !IO),
+ maybe_write_string(Verbose, "':\n", !IO),
+ globals__io_lookup_string_option(csharp_compiler, CSC, !IO),
+ globals__io_lookup_accumulating_option(csharp_flags, CSCFlagsList,
+ !IO),
+ join_string_list(CSCFlagsList, "", "", " ", CSCFlags),
% XXX This is because the MS C# compiler doesn't understand
% / as a directory seperator.
- { CSharpFileName = string__replace_all(CSharpFileName0, "/", "\\\\") },
+ CSharpFileName = string__replace_all(CSharpFileName0, "/", "\\\\"),
- globals__io_lookup_bool_option(target_debug, Debug),
- { Debug = yes ->
+ globals__io_lookup_bool_option(target_debug, Debug, !IO),
+ ( Debug = yes ->
% XXX This needs testing before it can be enabled
% (see the comments for install_debug_library in
% library/Mmakefile).
@@ -299,69 +282,69 @@
DebugOpt = ""
;
DebugOpt = ""
- },
+ ),
% XXX Should we use a separate dll_directories options?
globals__io_lookup_accumulating_option(link_library_directories,
- DLLDirs),
- { DLLDirOpts = "/lib:Mercury/dlls " ++
+ DLLDirs, !IO),
+ DLLDirOpts = "/lib:Mercury/dlls " ++
string__append_list(list__condense(list__map(
- (func(DLLDir) = ["/lib:", DLLDir, " "]), DLLDirs))) },
+ (func(DLLDir) = ["/lib:", DLLDir, " "]), DLLDirs))),
- { mercury_std_library_module_name(Imports ^ module_name) ->
+ ( mercury_std_library_module_name(Imports ^ module_name) ->
Prefix = "/addmodule:"
;
Prefix = "/r:"
- },
- { ForeignDeps = list__map(
+ ),
+ ForeignDeps = list__map(
(func(M) =
foreign_import_module_name(M, Imports ^ module_name)
- ), Imports ^ foreign_import_module_info ) },
- { ReferencedDlls = referenced_dlls(Imports ^ module_name,
- Imports ^ int_deps ++ Imports ^ impl_deps ++
- ForeignDeps) },
- list__map_foldl((pred(Mod::in, Result::out, di, uo) is det -->
- module_name_to_file_name(Mod, ".dll", no, FileName),
- { Result = [Prefix, FileName, " "] }
- ), ReferencedDlls, ReferencedDllsList),
- { ReferencedDllsStr = string__append_list(
- list__condense(ReferencedDllsList)) },
+ ), Imports ^ foreign_import_module_info ),
+ ReferencedDlls = referenced_dlls(Imports ^ module_name,
+ Imports ^ int_deps ++ Imports ^ impl_deps ++ ForeignDeps),
+ list__map_foldl(
+ (pred(Mod::in, Result::out, IO0::di, IO::uo) is det :-
+ module_name_to_file_name(Mod, ".dll", no, FileName,
+ IO0, IO),
+ Result = [Prefix, FileName, " "]
+ ), ReferencedDlls, ReferencedDllsList, !IO),
+ ReferencedDllsStr = string__append_list(
+ list__condense(ReferencedDllsList)),
- { string__append_list([CSC, DebugOpt,
+ string__append_list([CSC, DebugOpt,
" /t:library ", DLLDirOpts, CSCFlags, ReferencedDllsStr,
- " /out:", DLLFileName, " ", CSharpFileName], Command) },
- invoke_system_command(ErrorStream, verbose_commands,
- Command, Succeeded).
+ " /out:", DLLFileName, " ", CSharpFileName], Command),
+ invoke_system_command(ErrorStream, verbose_commands, Command,
+ Succeeded, !IO).
%-----------------------------------------------------------------------------%
-split_c_to_obj(ErrorStream, ModuleName, NumChunks, Succeeded) -->
- split_c_to_obj(ErrorStream, ModuleName, 0, NumChunks, Succeeded).
+split_c_to_obj(ErrorStream, ModuleName, NumChunks, Succeeded, !IO) :-
+ split_c_to_obj(ErrorStream, ModuleName, 0, NumChunks, Succeeded, !IO).
% compile each of the C files in `<module>.dir'
-:- pred split_c_to_obj(io__output_stream, module_name,
- int, int, bool, io__state, io__state).
-:- mode split_c_to_obj(in, in, in, in, out, di, uo) is det.
-
-split_c_to_obj(ErrorStream, ModuleName,
- Chunk, NumChunks, Succeeded) -->
- ( { Chunk > NumChunks } ->
- { Succeeded = yes }
+:- pred split_c_to_obj(io__output_stream::in, module_name::in,
+ int::in, int::in, bool::out, io::di, io::uo) is det.
+
+split_c_to_obj(ErrorStream, ModuleName, Chunk, NumChunks, Succeeded, !IO) :-
+ ( Chunk > NumChunks ->
+ Succeeded = yes
;
% XXX should this use maybe_pic_object_file_extension?
- globals__io_lookup_string_option(object_file_extension, Obj),
+ globals__io_lookup_string_option(object_file_extension, Obj,
+ !IO),
module_name_to_split_c_file_name(ModuleName, Chunk,
- ".c", C_File),
+ ".c", C_File, !IO),
module_name_to_split_c_file_name(ModuleName, Chunk,
- Obj, O_File),
+ Obj, O_File, !IO),
compile_c_file(ErrorStream, non_pic,
- C_File, O_File, Succeeded0),
- ( { Succeeded0 = no } ->
- { Succeeded = no }
- ;
- { Chunk1 = Chunk + 1 },
- split_c_to_obj(ErrorStream,
- ModuleName, Chunk1, NumChunks, Succeeded)
+ C_File, O_File, Succeeded0, !IO),
+ ( Succeeded0 = no ->
+ Succeeded = no
+ ;
+ Chunk1 = Chunk + 1,
+ split_c_to_obj(ErrorStream, ModuleName,
+ Chunk1, NumChunks, Succeeded, !IO)
)
).
@@ -370,26 +353,26 @@
:- type compiler_type ---> gcc ; lcc ; cl ; unknown.
-compile_c_file(ErrorStream, PIC, ModuleName, Succeeded) -->
- module_name_to_file_name(ModuleName, ".c", yes, C_File),
- maybe_pic_object_file_extension(PIC, ObjExt),
- module_name_to_file_name(ModuleName, ObjExt, yes, O_File),
- compile_c_file(ErrorStream, PIC, C_File, O_File, Succeeded).
+compile_c_file(ErrorStream, PIC, ModuleName, Succeeded, !IO) :-
+ module_name_to_file_name(ModuleName, ".c", yes, C_File, !IO),
+ maybe_pic_object_file_extension(PIC, ObjExt, !IO),
+ module_name_to_file_name(ModuleName, ObjExt, yes, O_File, !IO),
+ compile_c_file(ErrorStream, PIC, C_File, O_File, Succeeded, !IO).
-compile_c_file(ErrorStream, PIC, C_File, O_File, Succeeded) -->
- globals__io_lookup_bool_option(verbose, Verbose),
+compile_c_file(ErrorStream, PIC, C_File, O_File, Succeeded, !IO) :-
+ globals__io_lookup_bool_option(verbose, Verbose, !IO),
globals__io_lookup_string_option(c_flag_to_name_object_file,
- NameObjectFile),
- maybe_write_string(Verbose, "% Compiling `"),
- maybe_write_string(Verbose, C_File),
- maybe_write_string(Verbose, "':\n"),
- globals__io_lookup_string_option(cc, CC),
- globals__io_lookup_accumulating_option(cflags, C_Flags_List),
- { join_string_list(C_Flags_List, "", "", " ", CFLAGS) },
-
- globals__io_lookup_bool_option(use_subdirs, UseSubdirs),
- globals__io_lookup_bool_option(split_c_files, SplitCFiles),
- { (UseSubdirs = yes ; SplitCFiles = yes) ->
+ NameObjectFile, !IO),
+ maybe_write_string(Verbose, "% Compiling `", !IO),
+ maybe_write_string(Verbose, C_File, !IO),
+ maybe_write_string(Verbose, "':\n", !IO),
+ globals__io_lookup_string_option(cc, CC, !IO),
+ globals__io_lookup_accumulating_option(cflags, C_Flags_List, !IO),
+ join_string_list(C_Flags_List, "", "", " ", CFLAGS),
+
+ globals__io_lookup_bool_option(use_subdirs, UseSubdirs, !IO),
+ globals__io_lookup_bool_option(split_c_files, SplitCFiles, !IO),
+ ( (UseSubdirs = yes ; SplitCFiles = yes) ->
% the source file (foo.c) will be compiled in a subdirectory
% (either Mercury/cs, foo.dir, or Mercury/dirs/foo.dir,
% depending on which of these two options is set)
@@ -398,69 +381,69 @@
SubDirInclOpt = "-I. "
;
SubDirInclOpt = ""
- },
+ ),
globals__io_lookup_accumulating_option(c_include_directory,
- C_Incl_Dirs),
- { InclOpt = string__append_list(list__condense(list__map(
- (func(C_INCL) = ["-I", C_INCL, " "]), C_Incl_Dirs))) },
- globals__io_lookup_bool_option(split_c_files, Split_C_Files),
- { Split_C_Files = yes ->
+ C_Incl_Dirs, !IO),
+ InclOpt = string__append_list(list__condense(list__map(
+ (func(C_INCL) = ["-I", C_INCL, " "]), C_Incl_Dirs))),
+ globals__io_lookup_bool_option(split_c_files, Split_C_Files, !IO),
+ ( Split_C_Files = yes ->
SplitOpt = "-DMR_SPLIT_C_FILES "
;
SplitOpt = ""
- },
- globals__io_lookup_bool_option(highlevel_code, HighLevelCode),
- ( { HighLevelCode = yes } ->
- { HighLevelCodeOpt = "-DMR_HIGHLEVEL_CODE " }
+ ),
+ globals__io_lookup_bool_option(highlevel_code, HighLevelCode, !IO),
+ ( HighLevelCode = yes ->
+ HighLevelCodeOpt = "-DMR_HIGHLEVEL_CODE "
;
- { HighLevelCodeOpt = "" }
+ HighLevelCodeOpt = ""
),
globals__io_lookup_bool_option(gcc_nested_functions,
- GCC_NestedFunctions),
- ( { GCC_NestedFunctions = yes } ->
- { NestedFunctionsOpt = "-DMR_USE_GCC_NESTED_FUNCTIONS " }
+ GCC_NestedFunctions, !IO),
+ ( GCC_NestedFunctions = yes ->
+ NestedFunctionsOpt = "-DMR_USE_GCC_NESTED_FUNCTIONS "
;
- { NestedFunctionsOpt = "" }
+ NestedFunctionsOpt = ""
),
- globals__io_lookup_bool_option(highlevel_data, HighLevelData),
- ( { HighLevelData = yes } ->
- { HighLevelDataOpt = "-DMR_HIGHLEVEL_DATA " }
+ globals__io_lookup_bool_option(highlevel_data, HighLevelData, !IO),
+ ( HighLevelData = yes ->
+ HighLevelDataOpt = "-DMR_HIGHLEVEL_DATA "
;
- { HighLevelDataOpt = "" }
+ HighLevelDataOpt = ""
),
- globals__io_lookup_bool_option(gcc_global_registers, GCC_Regs),
- ( { GCC_Regs = yes } ->
+ globals__io_lookup_bool_option(gcc_global_registers, GCC_Regs, !IO),
+ ( GCC_Regs = yes ->
globals__io_lookup_string_option(cflags_for_regs,
- CFLAGS_FOR_REGS),
- { RegOpt = "-DMR_USE_GCC_GLOBAL_REGISTERS " }
+ CFLAGS_FOR_REGS, !IO),
+ RegOpt = "-DMR_USE_GCC_GLOBAL_REGISTERS "
;
- { CFLAGS_FOR_REGS = "" },
- { RegOpt = "" }
+ CFLAGS_FOR_REGS = "",
+ RegOpt = ""
),
- globals__io_lookup_bool_option(gcc_non_local_gotos, GCC_Gotos),
- ( { GCC_Gotos = yes } ->
- { GotoOpt = "-DMR_USE_GCC_NONLOCAL_GOTOS " },
+ globals__io_lookup_bool_option(gcc_non_local_gotos, GCC_Gotos, !IO),
+ ( GCC_Gotos = yes ->
+ GotoOpt = "-DMR_USE_GCC_NONLOCAL_GOTOS ",
globals__io_lookup_string_option(cflags_for_gotos,
- CFLAGS_FOR_GOTOS)
+ CFLAGS_FOR_GOTOS, !IO)
;
- { GotoOpt = "" },
- { CFLAGS_FOR_GOTOS = "" }
+ GotoOpt = "",
+ CFLAGS_FOR_GOTOS = ""
),
- globals__io_lookup_bool_option(asm_labels, ASM_Labels),
- { ASM_Labels = yes ->
+ globals__io_lookup_bool_option(asm_labels, ASM_Labels, !IO),
+ ( ASM_Labels = yes ->
AsmOpt = "-DMR_USE_ASM_LABELS "
;
AsmOpt = ""
- },
- globals__io_lookup_bool_option(parallel, Parallel),
- ( { Parallel = yes } ->
+ ),
+ globals__io_lookup_bool_option(parallel, Parallel, !IO),
+ ( Parallel = yes ->
globals__io_lookup_string_option(cflags_for_threads,
- CFLAGS_FOR_THREADS)
+ CFLAGS_FOR_THREADS, !IO)
;
- { CFLAGS_FOR_THREADS = "" }
+ CFLAGS_FOR_THREADS = ""
),
- globals__io_get_gc_method(GC_Method),
- {
+ globals__io_get_gc_method(GC_Method, !IO),
+ (
GC_Method = automatic,
GC_Opt = ""
;
@@ -475,36 +458,36 @@
;
GC_Method = accurate,
GC_Opt = "-DMR_NATIVE_GC "
- },
- globals__io_lookup_bool_option(profile_calls, ProfileCalls),
- { ProfileCalls = yes ->
+ ),
+ globals__io_lookup_bool_option(profile_calls, ProfileCalls, !IO),
+ ( ProfileCalls = yes ->
ProfileCallsOpt = "-DMR_MPROF_PROFILE_CALLS "
;
ProfileCallsOpt = ""
- },
- globals__io_lookup_bool_option(profile_time, ProfileTime),
- { ProfileTime = yes ->
+ ),
+ globals__io_lookup_bool_option(profile_time, ProfileTime, !IO),
+ ( ProfileTime = yes ->
ProfileTimeOpt = "-DMR_MPROF_PROFILE_TIME "
;
ProfileTimeOpt = ""
- },
- globals__io_lookup_bool_option(profile_memory, ProfileMemory),
- { ProfileMemory = yes ->
+ ),
+ globals__io_lookup_bool_option(profile_memory, ProfileMemory, !IO),
+ ( ProfileMemory = yes ->
ProfileMemoryOpt = "-DMR_MPROF_PROFILE_MEMORY "
;
ProfileMemoryOpt = ""
- },
- globals__io_lookup_bool_option(profile_deep, ProfileDeep),
- { ProfileDeep = yes ->
+ ),
+ globals__io_lookup_bool_option(profile_deep, ProfileDeep, !IO),
+ ( ProfileDeep = yes ->
ProfileDeepOpt = "-DMR_DEEP_PROFILING "
;
ProfileDeepOpt = ""
- },
+ ),
globals__io_lookup_bool_option(record_term_sizes_as_words,
- RecordTermSizesAsWords),
+ RecordTermSizesAsWords, !IO),
globals__io_lookup_bool_option(record_term_sizes_as_cells,
- RecordTermSizesAsCells),
- {
+ RecordTermSizesAsCells, !IO),
+ (
RecordTermSizesAsWords = yes,
RecordTermSizesAsCells = yes,
% this should have been caught in handle_options
@@ -516,133 +499,134 @@
;
RecordTermSizesAsWords = no,
RecordTermSizesAsCells = yes,
- RecordTermSizesOpt = "-DMR_RECORD_TERM_SIZES -DMR_RECORD_TERM_SIZES_AS_CELLS "
+ RecordTermSizesOpt = "-DMR_RECORD_TERM_SIZES " ++
+ "-DMR_RECORD_TERM_SIZES_AS_CELLS "
;
RecordTermSizesAsWords = no,
RecordTermSizesAsCells = no,
RecordTermSizesOpt = ""
- },
+ ),
(
- { PIC = pic },
+ PIC = pic,
globals__io_lookup_string_option(cflags_for_pic,
- CFLAGS_FOR_PIC),
- { PIC_Reg = yes }
+ CFLAGS_FOR_PIC, !IO),
+ PIC_Reg = yes
+ ;
+ PIC = link_with_pic,
+ CFLAGS_FOR_PIC = "",
+ PIC_Reg = yes
;
- { PIC = link_with_pic },
- { CFLAGS_FOR_PIC = "" },
- { PIC_Reg = yes }
- ;
- { PIC = non_pic },
- { CFLAGS_FOR_PIC = "" },
- globals__io_lookup_bool_option(pic_reg, PIC_Reg)
+ PIC = non_pic,
+ CFLAGS_FOR_PIC = "",
+ globals__io_lookup_bool_option(pic_reg, PIC_Reg, !IO)
),
- { PIC_Reg = yes ->
+ ( PIC_Reg = yes ->
% This will be ignored for architectures/grades
% where use of position independent code does not
% reserve a register.
PIC_Reg_Opt = "-DMR_PIC_REG "
;
PIC_Reg_Opt = ""
- },
+ ),
- globals__io_get_tags_method(Tags_Method),
- { Tags_Method = high ->
+ globals__io_get_tags_method(Tags_Method, !IO),
+ ( Tags_Method = high ->
TagsOpt = "-DMR_HIGHTAGS "
;
TagsOpt = ""
- },
- globals__io_lookup_int_option(num_tag_bits, NumTagBits),
- { string__int_to_string(NumTagBits, NumTagBitsString) },
- { string__append_list(
- ["-DMR_TAGBITS=", NumTagBitsString, " "], NumTagBitsOpt) },
- globals__io_lookup_bool_option(decl_debug, DeclDebug),
- { DeclDebug = yes ->
+ ),
+ globals__io_lookup_int_option(num_tag_bits, NumTagBits, !IO),
+ string__int_to_string(NumTagBits, NumTagBitsString),
+ string__append_list(
+ ["-DMR_TAGBITS=", NumTagBitsString, " "], NumTagBitsOpt),
+ globals__io_lookup_bool_option(decl_debug, DeclDebug, !IO),
+ ( DeclDebug = yes ->
DeclDebugOpt = "-DMR_DECL_DEBUG "
;
DeclDebugOpt = ""
- },
- globals__io_lookup_bool_option(require_tracing, RequireTracing),
- { RequireTracing = yes ->
+ ),
+ globals__io_lookup_bool_option(require_tracing, RequireTracing, !IO),
+ ( RequireTracing = yes ->
RequireTracingOpt = "-DMR_REQUIRE_TRACING "
;
RequireTracingOpt = ""
- },
- globals__io_lookup_bool_option(stack_trace, StackTrace),
- { StackTrace = yes ->
+ ),
+ globals__io_lookup_bool_option(stack_trace, StackTrace, !IO),
+ ( StackTrace = yes ->
StackTraceOpt = "-DMR_STACK_TRACE "
;
StackTraceOpt = ""
- },
- globals__io_lookup_bool_option(target_debug, Target_Debug),
- ( { Target_Debug = yes } ->
+ ),
+ globals__io_lookup_bool_option(target_debug, Target_Debug, !IO),
+ ( Target_Debug = yes ->
globals__io_lookup_string_option(cflags_for_debug,
- Target_DebugOpt0),
- { string__append(Target_DebugOpt0, " ", Target_DebugOpt) }
+ Target_DebugOpt0, !IO),
+ string__append(Target_DebugOpt0, " ", Target_DebugOpt)
;
- { Target_DebugOpt = "" }
+ Target_DebugOpt = ""
),
- globals__io_lookup_bool_option(low_level_debug, LL_Debug),
- { LL_Debug = yes ->
+ globals__io_lookup_bool_option(low_level_debug, LL_Debug, !IO),
+ ( LL_Debug = yes ->
LL_DebugOpt = "-DMR_LOW_LEVEL_DEBUG "
;
LL_DebugOpt = ""
- },
- globals__io_lookup_bool_option(use_trail, UseTrail),
- { UseTrail = yes ->
+ ),
+ globals__io_lookup_bool_option(use_trail, UseTrail, !IO),
+ ( UseTrail = yes ->
UseTrailOpt = "-DMR_USE_TRAIL "
;
UseTrailOpt = ""
- },
- globals__io_lookup_bool_option(reserve_tag, ReserveTag),
- { ReserveTag = yes ->
+ ),
+ globals__io_lookup_bool_option(reserve_tag, ReserveTag, !IO),
+ ( ReserveTag = yes ->
ReserveTagOpt = "-DMR_RESERVE_TAG "
;
ReserveTagOpt = ""
- },
- globals__io_lookup_bool_option(use_minimal_model, MinimalModel),
- { MinimalModel = yes ->
+ ),
+ globals__io_lookup_bool_option(use_minimal_model, MinimalModel, !IO),
+ ( MinimalModel = yes ->
MinimalModelOpt = "-DMR_USE_MINIMAL_MODEL "
;
MinimalModelOpt = ""
- },
- globals__io_lookup_bool_option(type_layout, TypeLayoutOption),
- { TypeLayoutOption = no ->
+ ),
+ globals__io_lookup_bool_option(type_layout, TypeLayoutOption, !IO),
+ ( TypeLayoutOption = no ->
TypeLayoutOpt = "-DMR_NO_TYPE_LAYOUT "
;
TypeLayoutOpt = ""
- },
- globals__io_lookup_bool_option(c_optimize, C_optimize),
- ( { C_optimize = yes } ->
+ ),
+ globals__io_lookup_bool_option(c_optimize, C_optimize, !IO),
+ ( C_optimize = yes ->
globals__io_lookup_string_option(cflags_for_optimization,
- OptimizeOpt)
+ OptimizeOpt, !IO)
;
- { OptimizeOpt = "" }
+ OptimizeOpt = ""
),
- globals__io_lookup_bool_option(ansi_c, Ansi),
- ( { Ansi = yes } ->
- globals__io_lookup_string_option(cflags_for_ansi, AnsiOpt)
+ globals__io_lookup_bool_option(ansi_c, Ansi, !IO),
+ ( Ansi = yes ->
+ globals__io_lookup_string_option(cflags_for_ansi, AnsiOpt, !IO)
;
- { AnsiOpt = "" }
+ AnsiOpt = ""
),
- globals__io_lookup_bool_option(inline_alloc, InlineAlloc),
- { InlineAlloc = yes ->
+ globals__io_lookup_bool_option(inline_alloc, InlineAlloc, !IO),
+ ( InlineAlloc = yes ->
InlineAllocOpt = "-DMR_INLINE_ALLOC -DSILENT "
;
InlineAllocOpt = ""
- },
- globals__io_lookup_bool_option(warn_target_code, Warn),
- ( { Warn = yes } ->
+ ),
+ globals__io_lookup_bool_option(warn_target_code, Warn, !IO),
+ ( Warn = yes ->
globals__io_lookup_string_option(cflags_for_warnings,
- WarningOpt)
+ WarningOpt, !IO)
;
- { WarningOpt = "" }
+ WarningOpt = ""
),
% Be careful with the order here! Some options override others,
% e.g. CFLAGS_FOR_REGS must come after OptimizeOpt so that
% it can override -fomit-frame-pointer with -fno-omit-frame-pointer.
% Also be careful that each option is separated by spaces.
- { string__append_list([CC, " ", SubDirInclOpt, InclOpt,
+ string__append_list([CC, " ", SubDirInclOpt, InclOpt,
SplitOpt, " ", OptimizeOpt, " ",
HighLevelCodeOpt, NestedFunctionsOpt, HighLevelDataOpt,
RegOpt, GotoOpt, AsmOpt,
@@ -654,75 +638,75 @@
DeclDebugOpt, RequireTracingOpt, StackTraceOpt,
UseTrailOpt, ReserveTagOpt, MinimalModelOpt, TypeLayoutOpt,
InlineAllocOpt, " ", AnsiOpt, " ", WarningOpt, " ", CFLAGS,
- " -c ", C_File, " ", NameObjectFile, O_File], Command) },
+ " -c ", C_File, " ", NameObjectFile, O_File], Command),
invoke_system_command(ErrorStream, verbose_commands,
- Command, Succeeded).
+ Command, Succeeded, !IO).
%-----------------------------------------------------------------------------%
-compile_java_file(ErrorStream, JavaFile, Succeeded) -->
- globals__io_lookup_bool_option(verbose, Verbose),
- maybe_write_string(Verbose, "% Compiling `"),
- maybe_write_string(Verbose, JavaFile),
- maybe_write_string(Verbose, "':\n"),
- globals__io_lookup_string_option(java_compiler, JavaCompiler),
- globals__io_lookup_accumulating_option(java_flags, JavaFlagsList),
- { join_string_list(JavaFlagsList, "", "", " ", JAVAFLAGS) },
+compile_java_file(ErrorStream, JavaFile, Succeeded, !IO) :-
+ globals__io_lookup_bool_option(verbose, Verbose, !IO),
+ maybe_write_string(Verbose, "% Compiling `", !IO),
+ maybe_write_string(Verbose, JavaFile, !IO),
+ maybe_write_string(Verbose, "':\n", !IO),
+ globals__io_lookup_string_option(java_compiler, JavaCompiler, !IO),
+ globals__io_lookup_accumulating_option(java_flags, JavaFlagsList, !IO),
+ join_string_list(JavaFlagsList, "", "", " ", JAVAFLAGS),
globals__io_lookup_accumulating_option(java_classpath,
- Java_Incl_Dirs),
+ Java_Incl_Dirs, !IO),
% XXX PathSeparator should be ";" on Windows
- { PathSeparator = ":" },
+ PathSeparator = ":",
% We prepend the current CLASSPATH to preserve the accumulating
% nature of this variable.
- get_env_classpath(EnvClasspath),
- { join_string_list([EnvClasspath|Java_Incl_Dirs], "", "",
- PathSeparator, ClassPath) },
- { ClassPath = "" ->
+ get_env_classpath(EnvClasspath, !IO),
+ join_string_list([EnvClasspath|Java_Incl_Dirs], "", "",
+ PathSeparator, ClassPath),
+ ( ClassPath = "" ->
InclOpt = ""
;
InclOpt = string__append_list([
"-classpath ", quote_arg(ClassPath), " "])
- },
+ ),
- globals__io_lookup_bool_option(target_debug, Target_Debug),
- { Target_Debug = yes ->
+ globals__io_lookup_bool_option(target_debug, Target_Debug, !IO),
+ ( Target_Debug = yes ->
Target_DebugOpt = "-g "
;
Target_DebugOpt = ""
- },
+ ),
- globals__io_lookup_bool_option(use_subdirs, UseSubdirs),
- globals__io_lookup_bool_option(use_grade_subdirs, UseGradeSubdirs),
- globals__io_lookup_string_option(fullarch, FullArch),
- globals__io_get_globals(Globals),
- ( { UseSubdirs = yes } ->
- { UseGradeSubdirs = yes ->
+ globals__io_lookup_bool_option(use_subdirs, UseSubdirs, !IO),
+ globals__io_lookup_bool_option(use_grade_subdirs, UseGradeSubdirs, !IO),
+ globals__io_lookup_string_option(fullarch, FullArch, !IO),
+ globals__io_get_globals(Globals, !IO),
+ ( UseSubdirs = yes ->
+ ( UseGradeSubdirs = yes ->
grade_directory_component(Globals, Grade),
DirName = "Mercury"/Grade/FullArch/"Mercury"/"classs"
;
DirName = "Mercury"/"classs"
- },
+ ),
% javac won't create the destination directory for
% class files, so we need to do it.
- dir__make_directory(DirName, _),
+ dir__make_directory(DirName, _, !IO),
% Set destination directory for class files.
- { DestDir = "-d " ++ DirName ++ " " }
+ DestDir = "-d " ++ DirName ++ " "
;
- { DestDir = "" }
+ DestDir = ""
),
% Be careful with the order here! Some options may override others.
% Also be careful that each option is separated by spaces.
- { string__append_list([JavaCompiler, " ", InclOpt, DestDir,
- Target_DebugOpt, JAVAFLAGS, " ", JavaFile], Command) },
- invoke_system_command(ErrorStream, verbose_commands,
- Command, Succeeded).
+ string__append_list([JavaCompiler, " ", InclOpt, DestDir,
+ Target_DebugOpt, JAVAFLAGS, " ", JavaFile], Command),
+ invoke_system_command(ErrorStream, verbose_commands, Command,
+ Succeeded, !IO).
%-----------------------------------------------------------------------------%
-assemble(ErrorStream, PIC, ModuleName, Succeeded) -->
- {
+assemble(ErrorStream, PIC, ModuleName, Succeeded, !IO) :-
+ (
PIC = pic,
AsmExt = ".pic_s",
GCCFLAGS_FOR_ASM = "-x assembler ",
@@ -737,287 +721,296 @@
AsmExt = ".s",
GCCFLAGS_FOR_ASM = "",
GCCFLAGS_FOR_PIC = ""
- },
- module_name_to_file_name(ModuleName, AsmExt, no, AsmFile),
- maybe_pic_object_file_extension(PIC, ObjExt),
- module_name_to_file_name(ModuleName, ObjExt, yes, ObjFile),
-
- globals__io_lookup_bool_option(verbose, Verbose),
- maybe_write_string(Verbose, "% Assembling `"),
- maybe_write_string(Verbose, AsmFile),
- maybe_write_string(Verbose, "':\n"),
+ ),
+ module_name_to_file_name(ModuleName, AsmExt, no, AsmFile, !IO),
+ maybe_pic_object_file_extension(PIC, ObjExt, !IO),
+ module_name_to_file_name(ModuleName, ObjExt, yes, ObjFile, !IO),
+
+ globals__io_lookup_bool_option(verbose, Verbose, !IO),
+ maybe_write_string(Verbose, "% Assembling `", !IO),
+ maybe_write_string(Verbose, AsmFile, !IO),
+ maybe_write_string(Verbose, "':\n", !IO),
% XXX should we use new asm_* options rather than
% reusing cc, cflags, c_flag_to_name_object_file?
- globals__io_lookup_string_option(cc, CC),
+ globals__io_lookup_string_option(cc, CC, !IO),
globals__io_lookup_string_option(c_flag_to_name_object_file,
- NameObjectFile),
- globals__io_lookup_accumulating_option(cflags, C_Flags_List),
- { join_string_list(C_Flags_List, "", "", " ", CFLAGS) },
+ NameObjectFile, !IO),
+ globals__io_lookup_accumulating_option(cflags, C_Flags_List, !IO),
+ join_string_list(C_Flags_List, "", "", " ", CFLAGS),
% Be careful with the order here.
% Also be careful that each option is separated by spaces.
- { string__append_list([CC, " ", CFLAGS, " ", GCCFLAGS_FOR_PIC,
+ string__append_list([CC, " ", CFLAGS, " ", GCCFLAGS_FOR_PIC,
GCCFLAGS_FOR_ASM, "-c ", AsmFile, " ",
- NameObjectFile, ObjFile], Command) },
- invoke_system_command(ErrorStream, verbose_commands,
- Command, Succeeded).
+ NameObjectFile, ObjFile], Command),
+ invoke_system_command(ErrorStream, verbose_commands, Command,
+ Succeeded, !IO).
%-----------------------------------------------------------------------------%
-make_init_file(ErrorStream, MainModuleName, AllModules, Succeeded) -->
+make_init_file(ErrorStream, MainModuleName, AllModules, Succeeded, !IO) :-
module_name_to_file_name(MainModuleName, ".init.tmp",
- yes, TmpInitFileName),
- io__open_output(TmpInitFileName, InitFileRes),
+ yes, TmpInitFileName, !IO),
+ io__open_output(TmpInitFileName, InitFileRes, !IO),
(
- { InitFileRes = ok(InitFileStream) },
- globals__io_lookup_bool_option(aditi, Aditi),
- list__foldl(
- (pred(ModuleName::in, di, uo) is det -->
- { InitFuncName0 = make_init_name(ModuleName) },
- { InitFuncName = InitFuncName0 ++ "init" },
- io__write_string(InitFileStream, "INIT "),
- io__write_string(InitFileStream, InitFuncName),
- io__nl(InitFileStream),
- ( { Aditi = yes } ->
- { RLName = make_rl_data_name(ModuleName) },
- io__write_string(InitFileStream,
- "ADITI_DATA "),
- io__write_string(InitFileStream, RLName),
- io__nl(InitFileStream)
- ;
- []
- )
- ), AllModules),
+ InitFileRes = ok(InitFileStream),
+ globals__io_lookup_bool_option(aditi, Aditi, !IO),
+ list__foldl(make_init_file_aditi(InitFileStream, Aditi),
+ AllModules, !IO),
globals__io_lookup_maybe_string_option(extra_init_command,
- MaybeInitFileCommand),
+ MaybeInitFileCommand, !IO),
(
- { MaybeInitFileCommand = yes(InitFileCommand) },
+ MaybeInitFileCommand = yes(InitFileCommand),
make_all_module_command(InitFileCommand,
- MainModuleName, AllModules, CommandString),
+ MainModuleName, AllModules, CommandString,
+ !IO),
invoke_system_command(InitFileStream, verbose_commands,
- CommandString, Succeeded0)
+ CommandString, Succeeded0, !IO)
;
- { MaybeInitFileCommand = no },
- { Succeeded0 = yes }
+ MaybeInitFileCommand = no,
+ Succeeded0 = yes
),
- io__close_output(InitFileStream),
+ io__close_output(InitFileStream, !IO),
module_name_to_file_name(MainModuleName, ".init",
- yes, InitFileName),
- update_interface(InitFileName, Succeeded1),
- { Succeeded = Succeeded0 `and` Succeeded1 }
- ;
- { InitFileRes = error(Error) },
- io__progname_base("mercury_compile", ProgName),
- io__write_string(ErrorStream, ProgName),
- io__write_string(ErrorStream, ": can't open `"),
- io__write_string(ErrorStream, TmpInitFileName),
- io__write_string(ErrorStream, "' for output:\n"),
- io__nl(ErrorStream),
- io__write_string(ErrorStream, io__error_message(Error)),
- io__nl(ErrorStream),
- { Succeeded = no }
+ yes, InitFileName, !IO),
+ update_interface(InitFileName, Succeeded1, !IO),
+ Succeeded = Succeeded0 `and` Succeeded1
+ ;
+ InitFileRes = error(Error),
+ io__progname_base("mercury_compile", ProgName, !IO),
+ io__write_string(ErrorStream, ProgName, !IO),
+ io__write_string(ErrorStream, ": can't open `", !IO),
+ io__write_string(ErrorStream, TmpInitFileName, !IO),
+ io__write_string(ErrorStream, "' for output:\n", !IO),
+ io__nl(ErrorStream, !IO),
+ io__write_string(ErrorStream, io__error_message(Error), !IO),
+ io__nl(ErrorStream, !IO),
+ Succeeded = no
+ ).
+
+:- pred make_init_file_aditi(io__output_stream::in, bool::in, module_name::in,
+ io::di, io::uo) is det.
+
+make_init_file_aditi(InitFileStream, Aditi, ModuleName, !IO) :-
+ InitFuncName0 = make_init_name(ModuleName),
+ InitFuncName = InitFuncName0 ++ "init",
+ io__write_string(InitFileStream, "INIT ", !IO),
+ io__write_string(InitFileStream, InitFuncName, !IO),
+ io__nl(InitFileStream, !IO),
+ ( Aditi = yes ->
+ RLName = make_rl_data_name(ModuleName),
+ io__write_string(InitFileStream, "ADITI_DATA ", !IO),
+ io__write_string(InitFileStream, RLName, !IO),
+ io__nl(InitFileStream, !IO)
+ ;
+ true
).
%-----------------------------------------------------------------------------%
-link_module_list(Modules, Succeeded) -->
- globals__io_lookup_string_option(output_file_name, OutputFileName0),
- ( { OutputFileName0 = "" } ->
- ( { Modules = [Module | _] } ->
- { OutputFileName = Module }
+link_module_list(Modules, Succeeded, !IO) :-
+ globals__io_lookup_string_option(output_file_name, OutputFileName0,
+ !IO),
+ ( OutputFileName0 = "" ->
+ ( Modules = [Module | _] ->
+ OutputFileName = Module
;
- { error("link_module_list: no modules") }
+ error("link_module_list: no modules")
)
;
- { OutputFileName = OutputFileName0 }
+ OutputFileName = OutputFileName0
),
- { file_name_to_module_name(OutputFileName, MainModuleName) },
+ file_name_to_module_name(OutputFileName, MainModuleName),
globals__io_lookup_bool_option(compile_to_shared_lib,
- CompileToSharedLib),
- { TargetType =
- (CompileToSharedLib = yes -> shared_library ; executable) },
- get_object_code_type(TargetType, PIC),
- maybe_pic_object_file_extension(PIC, Obj),
-
- globals__io_get_target(Target),
- globals__io_lookup_bool_option(split_c_files, SplitFiles),
- io__output_stream(OutputStream),
- ( { Target = asm } ->
- % for --target asm, we generate everything into a single object file
- ( { Modules = [FirstModule | _] } ->
- join_module_list([FirstModule], Obj, ObjectsList)
- ;
- { error("link_module_list: no modules") }
- ),
- { MakeLibCmdOK = yes }
- ; { SplitFiles = yes } ->
- globals__io_lookup_string_option(library_extension, LibExt),
- module_name_to_file_name(MainModuleName, LibExt,
- yes, SplitLibFileName),
- { string__append(".dir/*", Obj, DirObj) },
- join_module_list(Modules, DirObj, ObjectList),
+ CompileToSharedLib, !IO),
+ TargetType =
+ (CompileToSharedLib = yes -> shared_library ; executable),
+ get_object_code_type(TargetType, PIC, !IO),
+ maybe_pic_object_file_extension(PIC, Obj, !IO),
+
+ globals__io_get_target(Target, !IO),
+ globals__io_lookup_bool_option(split_c_files, SplitFiles, !IO),
+ io__output_stream(OutputStream, !IO),
+ ( Target = asm ->
+ % for --target asm, we generate everything into
+ % a single object file
+ ( Modules = [FirstModule | _] ->
+ join_module_list([FirstModule], Obj, ObjectsList, !IO)
+ ;
+ error("link_module_list: no modules")
+ ),
+ MakeLibCmdOK = yes
+ ; SplitFiles = yes ->
+ globals__io_lookup_string_option(library_extension, LibExt,
+ !IO),
+ module_name_to_file_name(MainModuleName, LibExt, yes,
+ SplitLibFileName, !IO),
+ string__append(".dir/*", Obj, DirObj),
+ join_module_list(Modules, DirObj, ObjectList, !IO),
create_archive(OutputStream, SplitLibFileName,
- ObjectList, MakeLibCmdOK),
- { ObjectsList = [SplitLibFileName] }
+ ObjectList, MakeLibCmdOK, !IO),
+ ObjectsList = [SplitLibFileName]
;
- { MakeLibCmdOK = yes },
- join_module_list(Modules, Obj, ObjectsList)
+ MakeLibCmdOK = yes,
+ join_module_list(Modules, Obj, ObjectsList, !IO)
),
- ( { MakeLibCmdOK = no } ->
- { Succeeded = no }
+ ( MakeLibCmdOK = no ->
+ Succeeded = no
;
- ( { TargetType = executable } ->
- { list__map(
+ ( TargetType = executable ->
+
+ list__map(
(pred(ModuleStr::in, ModuleName::out) is det :-
- file_name_to_module_name(dir__basename_det(ModuleStr),
+ file_name_to_module_name(
+ dir__basename_det(ModuleStr),
ModuleName)
- ),
- Modules, ModuleNames) },
- { MustCompile = yes },
- make_init_obj_file(OutputStream, MustCompile, MainModuleName,
- ModuleNames, InitObjResult)
+ ), Modules, ModuleNames),
+ MustCompile = yes,
+ make_init_obj_file(OutputStream, MustCompile,
+ MainModuleName, ModuleNames, InitObjResult,
+ !IO)
;
- { InitObjResult = yes("") }
+ InitObjResult = yes("")
),
(
- { InitObjResult = yes(InitObjFileName) },
+ InitObjResult = yes(InitObjFileName),
globals__io_lookup_accumulating_option(link_objects,
- ExtraLinkObjectsList),
- { AllObjects0 = ObjectsList ++ ExtraLinkObjectsList },
- { AllObjects =
+ ExtraLinkObjectsList, !IO),
+ AllObjects0 = ObjectsList ++ ExtraLinkObjectsList,
+ AllObjects =
( InitObjFileName = "" ->
AllObjects0
;
[InitObjFileName | AllObjects0]
- ) },
+ ),
link(OutputStream, TargetType, MainModuleName,
- AllObjects, Succeeded)
+ AllObjects, Succeeded, !IO)
;
- { InitObjResult = no },
- { Succeeded = no }
+ InitObjResult = no,
+ Succeeded = no
)
).
-make_init_obj_file(ErrorStream,
- ModuleName, ModuleNames, Result) -->
- globals__io_lookup_bool_option(rebuild, MustCompile),
+make_init_obj_file(ErrorStream, ModuleName, ModuleNames, Result, !IO) :-
+ globals__io_lookup_bool_option(rebuild, MustCompile, !IO),
make_init_obj_file(ErrorStream,
- MustCompile, ModuleName, ModuleNames, Result).
+ MustCompile, ModuleName, ModuleNames, Result, !IO).
% WARNING: The code here duplicates the functionality of scripts/c2init.in.
% Any changes there may also require changes here, and vice versa.
-:- pred make_init_obj_file(io__output_stream, bool,
- module_name, list(module_name), maybe(file_name),
- io__state, io__state).
-:- mode make_init_obj_file(in,
- in, in, in, out, di, uo) is det.
-
-make_init_obj_file(ErrorStream, MustCompile, ModuleName,
- ModuleNames, Result) -->
- globals__io_lookup_bool_option(verbose, Verbose),
- globals__io_lookup_bool_option(statistics, Stats),
- maybe_write_string(Verbose, "% Creating initialization file...\n"),
-
- globals__io_get_globals(Globals),
- { compute_grade(Globals, Grade) },
-
- get_object_code_type(executable, PIC),
- maybe_pic_object_file_extension(PIC, ObjExt),
- { InitObj = "_init" ++ ObjExt },
-
- module_name_to_file_name(ModuleName, "_init.c", yes, InitCFileName),
- module_name_to_file_name(ModuleName, InitObj, yes, InitObjFileName),
+:- pred make_init_obj_file(io__output_stream::in, bool::in,
+ module_name::in, list(module_name)::in, maybe(file_name)::out,
+ io::di, io::uo) is det.
+
+make_init_obj_file(ErrorStream, MustCompile, ModuleName, ModuleNames, Result,
+ !IO) :-
+ globals__io_lookup_bool_option(verbose, Verbose, !IO),
+ globals__io_lookup_bool_option(statistics, Stats, !IO),
+ maybe_write_string(Verbose, "% Creating initialization file...\n",
+ !IO),
+
+ globals__io_get_globals(Globals, !IO),
+ compute_grade(Globals, Grade),
+
+ get_object_code_type(executable, PIC, !IO),
+ maybe_pic_object_file_extension(PIC, ObjExt, !IO),
+ InitObj = "_init" ++ ObjExt,
+
+ module_name_to_file_name(ModuleName, "_init.c", yes, InitCFileName,
+ !IO),
+ module_name_to_file_name(ModuleName, InitObj, yes, InitObjFileName,
+ !IO),
list__map_foldl(
- (pred(ThisModuleName::in, CFileName::out, di, uo) is det -->
- module_name_to_file_name(ThisModuleName, ".c", no,
- CFileName)
- ), ModuleNames, CFileNameList),
- { join_quoted_string_list(CFileNameList, "", "", " ", CFileNames) },
+ (pred(ThisModule::in, CFileName::out, IO0::di, IO::uo) is det :-
+ module_name_to_file_name(ThisModule, ".c", no, CFileName,
+ IO0, IO)
+ ), ModuleNames, CFileNameList, !IO),
+ join_quoted_string_list(CFileNameList, "", "", " ", CFileNames),
globals__io_lookup_accumulating_option(init_file_directories,
- InitFileDirsList),
- { join_quoted_string_list(InitFileDirsList,
- "-I ", "", " ", InitFileDirs) },
+ InitFileDirsList, !IO),
+ join_quoted_string_list(InitFileDirsList,
+ "-I ", "", " ", InitFileDirs),
-
- globals__io_lookup_accumulating_option(init_files, InitFileNamesList0),
+ globals__io_lookup_accumulating_option(init_files, InitFileNamesList0,
+ !IO),
globals__io_lookup_accumulating_option(trace_init_files,
- TraceInitFileNamesList0),
+ TraceInitFileNamesList0, !IO),
globals__io_lookup_maybe_string_option(
- mercury_standard_library_directory, MaybeStdLibDir),
+ mercury_standard_library_directory, MaybeStdLibDir, !IO),
(
- { MaybeStdLibDir = yes(StdLibDir) },
- { InitFileNamesList1 = [StdLibDir/"modules"/"mer_rt.init",
+ MaybeStdLibDir = yes(StdLibDir),
+ InitFileNamesList1 = [StdLibDir/"modules"/"mer_rt.init",
StdLibDir/"modules"/"mer_std.init" |
- InitFileNamesList0] },
- { TraceInitFileNamesList =
+ InitFileNamesList0],
+ TraceInitFileNamesList =
[StdLibDir/"modules"/"mer_browser.init",
StdLibDir/"modules"/"mer_mdbcomp.init" |
- TraceInitFileNamesList0] }
+ TraceInitFileNamesList0]
;
- { MaybeStdLibDir = no },
- { InitFileNamesList1 = InitFileNamesList0 },
- { TraceInitFileNamesList = TraceInitFileNamesList0 }
+ MaybeStdLibDir = no,
+ InitFileNamesList1 = InitFileNamesList0,
+ TraceInitFileNamesList = TraceInitFileNamesList0
),
- globals__io_get_trace_level(TraceLevel),
- ( { given_trace_level_is_none(TraceLevel) = no } ->
- { TraceOpt = "-t" },
- { InitFileNamesList =
- InitFileNamesList1 ++ TraceInitFileNamesList }
+ globals__io_get_trace_level(TraceLevel, !IO),
+ ( given_trace_level_is_none(TraceLevel) = no ->
+ TraceOpt = "-t",
+ InitFileNamesList =
+ InitFileNamesList1 ++ TraceInitFileNamesList
;
- { TraceOpt = "" },
- { InitFileNamesList = InitFileNamesList1 }
+ TraceOpt = "",
+ InitFileNamesList = InitFileNamesList1
),
- { join_quoted_string_list(InitFileNamesList,
- "", "", " ", InitFileNames) },
+ join_quoted_string_list(InitFileNamesList, "", "", " ", InitFileNames),
- globals__io_lookup_accumulating_option(runtime_flags,
- RuntimeFlagsList),
- { join_quoted_string_list(RuntimeFlagsList, "-r ",
- "", " ", RuntimeFlags) },
+ globals__io_lookup_accumulating_option(runtime_flags, RuntimeFlagsList,
+ !IO),
+ join_quoted_string_list(RuntimeFlagsList, "-r ", "", " ",
+ RuntimeFlags),
globals__io_lookup_bool_option(extra_initialization_functions,
- ExtraInits),
- { ExtraInitsOpt = ( ExtraInits = yes -> "-x" ; "" ) },
+ ExtraInits, !IO),
+ ExtraInitsOpt = ( ExtraInits = yes -> "-x" ; "" ),
- globals__io_lookup_bool_option(main, Main),
- { NoMainOpt = ( Main = no -> "-l" ; "" ) },
+ globals__io_lookup_bool_option(main, Main, !IO),
+ NoMainOpt = ( Main = no -> "-l" ; "" ),
- globals__io_lookup_bool_option(aditi, Aditi),
- { AditiOpt = ( Aditi = yes -> "-a" ; "" ) },
+ globals__io_lookup_bool_option(aditi, Aditi, !IO),
+ AditiOpt = ( Aditi = yes -> "-a" ; "" ),
- globals__io_lookup_string_option(mkinit_command, Mkinit),
- { TmpInitCFileName = InitCFileName ++ ".tmp" },
- { MkInitCmd = string__append_list(
+ globals__io_lookup_string_option(mkinit_command, Mkinit, !IO),
+ TmpInitCFileName = InitCFileName ++ ".tmp",
+ MkInitCmd = string__append_list(
[Mkinit, " -g ", Grade, " ", TraceOpt, " ", ExtraInitsOpt,
" ", NoMainOpt, " ", AditiOpt, " ", RuntimeFlags,
" -o ", quote_arg(TmpInitCFileName), " ", InitFileDirs,
- " ", InitFileNames, " ", CFileNames]) },
- invoke_system_command(ErrorStream, verbose, MkInitCmd, MkInitOK0),
- maybe_report_stats(Stats),
- ( { MkInitOK0 = yes } ->
- update_interface(InitCFileName, MkInitOK1),
+ " ", InitFileNames, " ", CFileNames]),
+ invoke_system_command(ErrorStream, verbose, MkInitCmd, MkInitOK0, !IO),
+ maybe_report_stats(Stats, !IO),
+ ( MkInitOK0 = yes ->
+ update_interface(InitCFileName, MkInitOK1, !IO),
(
- { MkInitOK1 = yes },
-
+ MkInitOK1 = yes,
(
- { MustCompile = yes },
- { Compile = yes }
+ MustCompile = yes,
+ Compile = yes
;
- { MustCompile = no },
+ MustCompile = no,
io__file_modification_time(InitCFileName,
- InitCModTimeResult),
+ InitCModTimeResult, !IO),
io__file_modification_time(InitObjFileName,
- InitObjModTimeResult),
- {
- InitObjModTimeResult = ok(InitObjModTime),
+ InitObjModTimeResult, !IO),
+ (
+ InitObjModTimeResult =
+ ok(InitObjModTime),
InitCModTimeResult = ok(InitCModTime),
- compare(TimeCompare, InitObjModTime, InitCModTime),
+ compare(TimeCompare, InitObjModTime,
+ InitCModTime),
( TimeCompare = (=)
; TimeCompare = (>)
)
@@ -1025,204 +1018,209 @@
Compile = no
;
Compile = yes
- }
+ )
),
-
(
- { Compile = yes },
+ Compile = yes,
maybe_write_string(Verbose,
- "% Compiling initialization file...\n"),
+ "% Compiling initialization file...\n", !IO),
compile_c_file(ErrorStream, PIC, InitCFileName,
- InitObjFileName, CompileOK),
- maybe_report_stats(Stats),
- ( { CompileOK = no } ->
- { Result = no }
+ InitObjFileName, CompileOK, !IO),
+ maybe_report_stats(Stats, !IO),
+ ( CompileOK = no ->
+ Result = no
;
- { Result = yes(InitObjFileName) }
+ Result = yes(InitObjFileName)
)
;
- { Compile = no },
- { Result = yes(InitObjFileName) }
+ Compile = no,
+ Result = yes(InitObjFileName)
)
;
- { MkInitOK1 = no },
- { Result = no }
+ MkInitOK1 = no,
+ Result = no
)
;
- { Result = no }
+ Result = no
).
% WARNING: The code here duplicates the functionality of scripts/ml.in.
% Any changes there may also require changes here, and vice versa.
-link(ErrorStream, LinkTargetType, ModuleName, ObjectsList, Succeeded) -->
- globals__io_lookup_bool_option(verbose, Verbose),
- globals__io_lookup_bool_option(statistics, Stats),
- maybe_write_string(Verbose, "% Linking...\n"),
- globals__io_lookup_string_option(library_extension, LibExt),
+link(ErrorStream, LinkTargetType, ModuleName, ObjectsList, Succeeded, !IO) :-
+ globals__io_lookup_bool_option(verbose, Verbose, !IO),
+ globals__io_lookup_bool_option(statistics, Stats, !IO),
+
+ maybe_write_string(Verbose, "% Linking...\n", !IO),
+ globals__io_lookup_string_option(library_extension, LibExt, !IO),
globals__io_lookup_string_option(shared_library_extension,
- SharedLibExt),
- globals__io_lookup_string_option(executable_file_extension, ExeExt),
- ( { LinkTargetType = static_library } ->
- { Ext = LibExt },
- module_name_to_lib_file_name("lib", ModuleName, LibExt,
- yes, OutputFileName),
+ SharedLibExt, !IO),
+ globals__io_lookup_string_option(executable_file_extension, ExeExt,
+ !IO),
+ ( LinkTargetType = static_library ->
+ Ext = LibExt,
+ module_name_to_lib_file_name("lib", ModuleName, LibExt, yes,
+ OutputFileName, !IO),
create_archive(ErrorStream, OutputFileName, ObjectsList,
- LinkSucceeded)
- ; { LinkTargetType = java_archive } ->
- { Ext = ".jar" },
- module_name_to_file_name(ModuleName, Ext, yes, OutputFileName),
+ LinkSucceeded, !IO)
+ ; LinkTargetType = java_archive ->
+ Ext = ".jar",
+ module_name_to_file_name(ModuleName, Ext, yes, OutputFileName,
+ !IO),
create_java_archive(ErrorStream, ModuleName, OutputFileName,
- ObjectsList, LinkSucceeded)
+ ObjectsList, LinkSucceeded, !IO)
;
(
- { LinkTargetType = shared_library },
- { CommandOpt = link_shared_lib_command },
- { RpathFlagOpt = shlib_linker_rpath_flag },
- { RpathSepOpt = shlib_linker_rpath_separator },
- { LDFlagsOpt = ld_libflags },
- { ThreadFlagsOpt = shlib_linker_thread_flags },
- { DebugFlagsOpt = shlib_linker_debug_flags },
- { TraceFlagsOpt = shlib_linker_trace_flags },
+ LinkTargetType = shared_library,
+ CommandOpt = link_shared_lib_command,
+ RpathFlagOpt = shlib_linker_rpath_flag,
+ RpathSepOpt = shlib_linker_rpath_separator,
+ LDFlagsOpt = ld_libflags,
+ ThreadFlagsOpt = shlib_linker_thread_flags,
+ DebugFlagsOpt = shlib_linker_debug_flags,
+ TraceFlagsOpt = shlib_linker_trace_flags,
globals__io_lookup_bool_option(allow_undefined,
- AllowUndef),
- ( { AllowUndef = yes } ->
+ AllowUndef, !IO),
+ ( AllowUndef = yes ->
globals__io_lookup_string_option(
- linker_allow_undefined_flag, UndefOpt)
+ linker_allow_undefined_flag, UndefOpt,
+ !IO)
;
globals__io_lookup_string_option(
- linker_error_undefined_flag, UndefOpt)
+ linker_error_undefined_flag, UndefOpt,
+ !IO)
),
- { Ext = SharedLibExt },
+ Ext = SharedLibExt,
module_name_to_lib_file_name("lib", ModuleName,
- Ext, yes, OutputFileName)
+ Ext, yes, OutputFileName, !IO)
;
- { LinkTargetType = static_library },
- { error("compile_target_code__link") }
+ LinkTargetType = static_library,
+ error("compile_target_code__link")
;
- { LinkTargetType = java_archive },
- { error("compile_target_code__link") }
+ LinkTargetType = java_archive,
+ error("compile_target_code__link")
;
- { LinkTargetType = executable },
- { CommandOpt = link_executable_command },
- { RpathFlagOpt = linker_rpath_flag },
- { RpathSepOpt = linker_rpath_separator },
- { LDFlagsOpt = ld_flags },
- { ThreadFlagsOpt = linker_thread_flags },
- { DebugFlagsOpt = linker_debug_flags },
- { TraceFlagsOpt = linker_trace_flags },
- { UndefOpt = "" },
- { Ext = ExeExt },
+ LinkTargetType = executable,
+ CommandOpt = link_executable_command,
+ RpathFlagOpt = linker_rpath_flag,
+ RpathSepOpt = linker_rpath_separator,
+ LDFlagsOpt = ld_flags,
+ ThreadFlagsOpt = linker_thread_flags,
+ DebugFlagsOpt = linker_debug_flags,
+ TraceFlagsOpt = linker_trace_flags,
+ UndefOpt = "",
+ Ext = ExeExt,
module_name_to_file_name(ModuleName, Ext,
- yes, OutputFileName)
+ yes, OutputFileName, !IO)
),
%
% Should the executable be stripped?
%
- globals__io_lookup_bool_option(strip, Strip),
- ( { LinkTargetType = executable, Strip = yes } ->
+ globals__io_lookup_bool_option(strip, Strip, !IO),
+ ( LinkTargetType = executable, Strip = yes ->
globals__io_lookup_string_option(linker_strip_flag,
- StripOpt)
+ StripOpt, !IO)
;
- { StripOpt = "" }
+ StripOpt = ""
),
- globals__io_lookup_bool_option(target_debug, TargetDebug),
- ( { TargetDebug = yes } ->
+ globals__io_lookup_bool_option(target_debug, TargetDebug, !IO),
+ ( TargetDebug = yes ->
globals__io_lookup_string_option(DebugFlagsOpt,
- DebugOpts)
+ DebugOpts, !IO)
;
- { DebugOpts = "" }
+ DebugOpts = ""
),
%
% Should the executable be statically linked?
%
- globals__io_lookup_string_option(linkage, Linkage),
- ( { LinkTargetType = executable, Linkage = "static" } ->
+ globals__io_lookup_string_option(linkage, Linkage, !IO),
+ ( LinkTargetType = executable, Linkage = "static" ->
globals__io_lookup_string_option(linker_static_flags,
- StaticOpts)
+ StaticOpts, !IO)
;
- { StaticOpts = "" }
+ StaticOpts = ""
),
%
% Are the thread libraries needed?
%
- use_thread_libs(UseThreadLibs),
- ( { UseThreadLibs = yes } ->
+ use_thread_libs(UseThreadLibs, !IO),
+ ( UseThreadLibs = yes ->
globals__io_lookup_string_option(ThreadFlagsOpt,
- ThreadOpts)
+ ThreadOpts, !IO)
;
- { ThreadOpts = "" }
+ ThreadOpts = ""
),
%
% Find the Mercury standard libraries.
%
globals__io_lookup_maybe_string_option(
- mercury_standard_library_directory, MaybeStdLibDir),
+ mercury_standard_library_directory, MaybeStdLibDir,
+ !IO),
(
- { MaybeStdLibDir = yes(StdLibDir) },
+ MaybeStdLibDir = yes(StdLibDir),
get_mercury_std_libs(LinkTargetType,
- StdLibDir, MercuryStdLibs)
+ StdLibDir, MercuryStdLibs, !IO)
;
- { MaybeStdLibDir = no },
- { MercuryStdLibs = "" }
+ MaybeStdLibDir = no,
+ MercuryStdLibs = ""
),
%
% Find which system libraries are needed.
%
- get_system_libs(LinkTargetType, SystemLibs),
+ get_system_libs(LinkTargetType, SystemLibs, !IO),
- { join_quoted_string_list(ObjectsList,
- "", "", " ", Objects) },
+ join_quoted_string_list(ObjectsList, "", "", " ", Objects),
globals__io_lookup_accumulating_option(LDFlagsOpt,
- LDFlagsList),
- { join_string_list(LDFlagsList, "", "", " ", LDFlags) },
+ LDFlagsList, !IO),
+ join_string_list(LDFlagsList, "", "", " ", LDFlags),
globals__io_lookup_accumulating_option(
link_library_directories,
- LinkLibraryDirectoriesList),
+ LinkLibraryDirectoriesList, !IO),
globals__io_lookup_string_option(linker_path_flag,
- LinkerPathFlag),
- { join_quoted_string_list(LinkLibraryDirectoriesList,
- LinkerPathFlag, "", " ",
- LinkLibraryDirectories) },
+ LinkerPathFlag, !IO),
+ join_quoted_string_list(LinkLibraryDirectoriesList,
+ LinkerPathFlag, "", " ", LinkLibraryDirectories),
%
% Set up the runtime library path.
%
(
- { SharedLibExt \= LibExt },
- { Linkage = "shared" ; LinkTargetType = shared_library }
+ SharedLibExt \= LibExt,
+ ( Linkage = "shared"
+ ; LinkTargetType = shared_library
+ )
->
globals__io_lookup_accumulating_option(
runtime_link_library_directories,
- RpathDirs),
- ( { RpathDirs = [] } ->
- { RpathOpts = "" }
+ RpathDirs, !IO),
+ ( RpathDirs = [] ->
+ RpathOpts = ""
;
globals__io_lookup_string_option(RpathSepOpt,
- RpathSep),
+ RpathSep, !IO),
globals__io_lookup_string_option(RpathFlagOpt,
- RpathFlag),
- { RpathOpts0 = string__join_list(RpathSep,
- RpathDirs) },
- { RpathOpts = RpathFlag ++ RpathOpts0 }
+ RpathFlag, !IO),
+ RpathOpts0 = string__join_list(RpathSep,
+ RpathDirs),
+ RpathOpts = RpathFlag ++ RpathOpts0
)
;
- { RpathOpts = "" }
+ RpathOpts = ""
),
- globals__io_get_trace_level(TraceLevel),
- ( { given_trace_level_is_none(TraceLevel) = yes } ->
- { TraceOpts = "" }
+ globals__io_get_trace_level(TraceLevel, !IO),
+ ( given_trace_level_is_none(TraceLevel) = yes ->
+ TraceOpts = ""
;
globals__io_lookup_string_option(TraceFlagsOpt,
- TraceOpts )
+ TraceOpts, !IO)
),
%
@@ -1231,31 +1229,31 @@
% Mercury libraries.
%
globals__io_lookup_accumulating_option(
- mercury_library_directories,
- MercuryLibDirs0),
- globals__io_lookup_string_option(fullarch, FullArch),
- globals__io_get_globals(Globals),
- { grade_directory_component(Globals, GradeDir) },
- { MercuryLibDirs = list__map(
+ mercury_library_directories, MercuryLibDirs0, !IO),
+ globals__io_lookup_string_option(fullarch, FullArch, !IO),
+ globals__io_get_globals(Globals, !IO),
+ grade_directory_component(Globals, GradeDir),
+ MercuryLibDirs = list__map(
(func(LibDir) = LibDir/"lib"/GradeDir/FullArch),
- MercuryLibDirs0) },
+ MercuryLibDirs0),
globals__io_lookup_accumulating_option(link_libraries,
- LinkLibrariesList0),
+ LinkLibrariesList0, !IO),
list__map_foldl2(process_link_library(MercuryLibDirs),
- LinkLibrariesList0, LinkLibrariesList,
- yes, LibrariesSucceeded),
+ LinkLibrariesList0, LinkLibrariesList, yes,
+ LibrariesSucceeded, !IO),
globals__io_lookup_string_option(linker_opt_separator,
- LinkOptSep),
+ LinkOptSep, !IO),
(
- { LibrariesSucceeded = yes },
- { join_quoted_string_list(LinkLibrariesList,
- "", "", " ", LinkLibraries) },
+ LibrariesSucceeded = yes,
+ join_quoted_string_list(LinkLibrariesList,
+ "", "", " ", LinkLibraries),
% Note that LDFlags may contain `-l' options
% so it should come after Objects.
- globals__io_lookup_string_option(CommandOpt, Command),
- { string__append_list(
+ globals__io_lookup_string_option(CommandOpt, Command,
+ !IO),
+ string__append_list(
[Command, " ",
StaticOpts, " ", StripOpt, " ", UndefOpt, " ",
ThreadOpts, " ", TraceOpts, " ",
@@ -1264,113 +1262,114 @@
RpathOpts, " ", DebugOpts, " ", LDFlags, " ",
LinkLibraries, " ", MercuryStdLibs, " ",
SystemLibs],
- LinkCmd) },
+ LinkCmd),
- globals__io_lookup_bool_option(demangle, Demangle),
- ( { Demangle = yes } ->
+ globals__io_lookup_bool_option(demangle, Demangle,
+ !IO),
+ ( Demangle = yes ->
globals__io_lookup_string_option(
- demangle_command, DemamngleCmd),
- { MaybeDemangleCmd = yes(DemamngleCmd) }
+ demangle_command, DemamngleCmd, !IO),
+ MaybeDemangleCmd = yes(DemamngleCmd)
;
- { MaybeDemangleCmd = no }
+ MaybeDemangleCmd = no
),
invoke_system_command(ErrorStream, verbose_commands,
- LinkCmd, MaybeDemangleCmd, LinkSucceeded)
+ LinkCmd, MaybeDemangleCmd, LinkSucceeded, !IO)
;
- { LibrariesSucceeded = no },
- { LinkSucceeded = no }
+ LibrariesSucceeded = no,
+ LinkSucceeded = no
)
),
- maybe_report_stats(Stats),
- globals__io_lookup_bool_option(use_grade_subdirs,
- UseGradeSubdirs),
+ maybe_report_stats(Stats, !IO),
+ globals__io_lookup_bool_option(use_grade_subdirs, UseGradeSubdirs,
+ !IO),
(
- { LinkSucceeded = yes },
- { UseGradeSubdirs = yes }
+ LinkSucceeded = yes,
+ UseGradeSubdirs = yes
->
% Link/copy the executable into the user's directory.
- globals__io_set_option(use_subdirs, bool(no)),
- globals__io_set_option(use_grade_subdirs, bool(no)),
- ( { LinkTargetType = executable } ->
+ globals__io_set_option(use_subdirs, bool(no), !IO),
+ globals__io_set_option(use_grade_subdirs, bool(no), !IO),
+ ( LinkTargetType = executable ->
module_name_to_file_name(ModuleName, Ext,
- no, UserDirFileName)
+ no, UserDirFileName, !IO)
;
module_name_to_lib_file_name("lib", ModuleName, Ext,
- no, UserDirFileName)
+ no, UserDirFileName, !IO)
),
- globals__io_set_option(use_subdirs, bool(yes)),
- globals__io_set_option(use_grade_subdirs, bool(yes)),
+ globals__io_set_option(use_subdirs, bool(yes), !IO),
+ globals__io_set_option(use_grade_subdirs, bool(yes), !IO),
- io__set_output_stream(ErrorStream, OutputStream),
- make_symlink_or_copy_file(OutputFileName,
- UserDirFileName, Succeeded),
- io__set_output_stream(OutputStream, _)
+ io__set_output_stream(ErrorStream, OutputStream, !IO),
+ make_symlink_or_copy_file(OutputFileName, UserDirFileName,
+ Succeeded, !IO),
+ io__set_output_stream(OutputStream, _, !IO)
;
- { Succeeded = LinkSucceeded }
+ Succeeded = LinkSucceeded
).
% Find the standard Mercury libraries, and the system
% libraries needed by them.
-:- pred get_mercury_std_libs(linked_target_type::in, dir_name::in,
- string::out, io__state::di, io__state::uo) is det.
+:- pred get_mercury_std_libs(linked_target_type::in, dir_name::in, string::out,
+ io::di, io::uo) is det.
-get_mercury_std_libs(TargetType, StdLibDir, StdLibs) -->
- globals__io_lookup_string_option(fullarch, FullArch),
- globals__io_get_gc_method(GCMethod),
- globals__io_lookup_string_option(library_extension, LibExt),
- globals__io_get_globals(Globals),
- { grade_directory_component(Globals, GradeDir) },
+get_mercury_std_libs(TargetType, StdLibDir, StdLibs, !IO) :-
+ globals__io_lookup_string_option(fullarch, FullArch, !IO),
+ globals__io_get_gc_method(GCMethod, !IO),
+ globals__io_lookup_string_option(library_extension, LibExt, !IO),
+ globals__io_get_globals(Globals, !IO),
+ grade_directory_component(Globals, GradeDir),
%
% GC libraries.
%
(
- { GCMethod = automatic },
- { StaticGCLibs = "" },
- { SharedGCLibs = "" }
- ;
- { GCMethod = none },
- { StaticGCLibs = "" },
- { SharedGCLibs = "" }
- ;
- { GCMethod = boehm },
- globals__io_lookup_bool_option(profile_time, ProfTime),
- globals__io_lookup_bool_option(profile_deep, ProfDeep),
- { ( ProfTime = yes ; ProfDeep = yes ) ->
+ GCMethod = automatic,
+ StaticGCLibs = "",
+ SharedGCLibs = ""
+ ;
+ GCMethod = none,
+ StaticGCLibs = "",
+ SharedGCLibs = ""
+ ;
+ GCMethod = boehm,
+ globals__io_lookup_bool_option(profile_time, ProfTime, !IO),
+ globals__io_lookup_bool_option(profile_deep, ProfDeep, !IO),
+ ( ( ProfTime = yes ; ProfDeep = yes ) ->
GCGrade0 = "gc_prof"
;
GCGrade0 = "gc"
- },
- globals__io_lookup_bool_option(parallel, Parallel),
- { Parallel = yes ->
+ ),
+ globals__io_lookup_bool_option(parallel, Parallel, !IO),
+ ( Parallel = yes ->
GCGrade = "par_" ++ GCGrade0
;
GCGrade = GCGrade0
- },
- make_link_lib(TargetType, GCGrade, SharedGCLibs),
- { StaticGCLibs = quote_arg(StdLibDir/"lib"/FullArch/
- ("lib" ++ GCGrade ++ LibExt)) }
- ;
- { GCMethod = mps },
- make_link_lib(TargetType, "mps", SharedGCLibs),
- { StaticGCLibs = quote_arg(StdLibDir/"lib"/FullArch/
- ("libmps" ++ LibExt) ) }
- ;
- { GCMethod = accurate },
- { StaticGCLibs = "" },
- { SharedGCLibs = "" }
+ ),
+ make_link_lib(TargetType, GCGrade, SharedGCLibs, !IO),
+ StaticGCLibs = quote_arg(StdLibDir/"lib"/FullArch/
+ ("lib" ++ GCGrade ++ LibExt))
+ ;
+ GCMethod = mps,
+ make_link_lib(TargetType, "mps", SharedGCLibs, !IO),
+ StaticGCLibs = quote_arg(StdLibDir/"lib"/FullArch/
+ ("libmps" ++ LibExt) )
+ ;
+ GCMethod = accurate,
+ StaticGCLibs = "",
+ SharedGCLibs = ""
),
%
% Trace libraries.
%
- globals__io_get_trace_level(TraceLevel),
- ( { given_trace_level_is_none(TraceLevel) = yes } ->
- { StaticTraceLibs = "" },
- { SharedTraceLibs = "" }
+ globals__io_get_trace_level(TraceLevel, !IO),
+ ( given_trace_level_is_none(TraceLevel) = yes ->
+ StaticTraceLibs = "",
+ SharedTraceLibs = ""
;
- { StaticTraceLibs =
+ StaticTraceLibs =
quote_arg(StdLibDir/"lib"/GradeDir/FullArch/
("libmer_trace" ++ LibExt)) ++
" " ++
@@ -1378,37 +1377,37 @@
("libmer_browser" ++ LibExt)) ++
" " ++
quote_arg(StdLibDir/"lib"/GradeDir/FullArch/
- ("libmer_mdbcomp" ++ LibExt)) },
- make_link_lib(TargetType, "mer_trace", TraceLib),
- make_link_lib(TargetType, "mer_browser", BrowserLib),
- make_link_lib(TargetType, "mer_mdbcomp", MdbCompLib),
- { SharedTraceLibs = string__join_list(" ",
- [TraceLib, BrowserLib, MdbCompLib]) }
+ ("libmer_mdbcomp" ++ LibExt)),
+ make_link_lib(TargetType, "mer_trace", TraceLib, !IO),
+ make_link_lib(TargetType, "mer_browser", BrowserLib, !IO),
+ make_link_lib(TargetType, "mer_mdbcomp", MdbCompLib, !IO),
+ SharedTraceLibs = string__join_list(" ",
+ [TraceLib, BrowserLib, MdbCompLib])
),
- globals__io_lookup_string_option(mercury_linkage, MercuryLinkage),
- ( { MercuryLinkage = "static" } ->
- { StdLibs = string__join_list(" ",
+ globals__io_lookup_string_option(mercury_linkage, MercuryLinkage, !IO),
+ ( MercuryLinkage = "static" ->
+ StdLibs = string__join_list(" ",
[StaticTraceLibs,
quote_arg(StdLibDir/"lib"/GradeDir/FullArch/
("libmer_std" ++ LibExt)),
quote_arg(StdLibDir/"lib"/GradeDir/FullArch/
("libmer_rt" ++ LibExt)),
- StaticGCLibs]) }
- ; { MercuryLinkage = "shared" } ->
- make_link_lib(TargetType, "mer_std", StdLib),
- make_link_lib(TargetType, "mer_rt", RuntimeLib),
- { StdLibs = string__join_list(" ",
- [SharedTraceLibs, StdLib, RuntimeLib, SharedGCLibs]) }
+ StaticGCLibs])
+ ; MercuryLinkage = "shared" ->
+ make_link_lib(TargetType, "mer_std", StdLib, !IO),
+ make_link_lib(TargetType, "mer_rt", RuntimeLib, !IO),
+ StdLibs = string__join_list(" ",
+ [SharedTraceLibs, StdLib, RuntimeLib, SharedGCLibs])
;
- { error("unknown linkage " ++ MercuryLinkage) }
+ error("unknown linkage " ++ MercuryLinkage)
).
:- pred make_link_lib(linked_target_type::in, string::in, string::out,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
-make_link_lib(TargetType, LibName, LinkOpt) -->
- {
+make_link_lib(TargetType, LibName, LinkOpt, !IO) :-
+ (
TargetType = executable,
LinkLibFlag = linker_link_lib_flag,
LinkLibSuffix = linker_link_lib_suffix
@@ -1422,172 +1421,181 @@
;
TargetType = static_library,
error("make_link_lib: static_library")
- },
- globals__io_lookup_string_option(LinkLibFlag, LinkLibOpt),
- globals__io_lookup_string_option(LinkLibSuffix, Suffix),
- { LinkOpt = quote_arg(LinkLibOpt ++ LibName ++ Suffix) }.
+ ),
+ globals__io_lookup_string_option(LinkLibFlag, LinkLibOpt, !IO),
+ globals__io_lookup_string_option(LinkLibSuffix, Suffix, !IO),
+ LinkOpt = quote_arg(LinkLibOpt ++ LibName ++ Suffix).
-:- pred get_system_libs(linked_target_type::in, string::out,
- io__state::di, io__state::uo) is det.
+:- pred get_system_libs(linked_target_type::in, string::out, io::di, io::uo)
+ is det.
-get_system_libs(TargetType, SystemLibs) -->
+get_system_libs(TargetType, SystemLibs, !IO) :-
%
% System libraries used when tracing.
%
- globals__io_get_trace_level(TraceLevel),
- ( { given_trace_level_is_none(TraceLevel) = yes } ->
- { SystemTraceLibs = "" }
- ;
- globals__io_lookup_string_option(trace_libs, SystemTraceLibs0),
- globals__io_lookup_bool_option(use_readline, UseReadline),
- ( { UseReadline = yes } ->
+ globals__io_get_trace_level(TraceLevel, !IO),
+ ( given_trace_level_is_none(TraceLevel) = yes ->
+ SystemTraceLibs = ""
+ ;
+ globals__io_lookup_string_option(trace_libs, SystemTraceLibs0,
+ !IO),
+ globals__io_lookup_bool_option(use_readline, UseReadline, !IO),
+ ( UseReadline = yes ->
globals__io_lookup_string_option(readline_libs,
- ReadlineLibs),
- { SystemTraceLibs =
- SystemTraceLibs0 ++ " " ++ ReadlineLibs }
+ ReadlineLibs, !IO),
+ SystemTraceLibs =
+ SystemTraceLibs0 ++ " " ++ ReadlineLibs
;
- { SystemTraceLibs = SystemTraceLibs0 }
+ SystemTraceLibs = SystemTraceLibs0
)
),
%
% Thread libraries
%
- use_thread_libs(UseThreadLibs),
- ( { UseThreadLibs = yes } ->
- globals__io_lookup_string_option(thread_libs, ThreadLibs)
+ use_thread_libs(UseThreadLibs, !IO),
+ ( UseThreadLibs = yes ->
+ globals__io_lookup_string_option(thread_libs, ThreadLibs, !IO)
;
- { ThreadLibs = "" }
+ ThreadLibs = ""
),
%
% Other system libraries.
%
(
- { TargetType = shared_library },
- globals__io_lookup_string_option(shared_libs, OtherSystemLibs)
+ TargetType = shared_library,
+ globals__io_lookup_string_option(shared_libs, OtherSystemLibs,
+ !IO)
;
- { TargetType = static_library },
- { error("compile_target_code__get_std_libs: static library") }
+ TargetType = static_library,
+ error("compile_target_code__get_std_libs: static library")
;
- { TargetType = java_archive },
- { error("compile_target_code__get_std_libs: java archive") }
+ TargetType = java_archive,
+ error("compile_target_code__get_std_libs: java archive")
;
- { TargetType = executable },
- globals__io_lookup_string_option(math_lib, OtherSystemLibs)
+ TargetType = executable,
+ globals__io_lookup_string_option(math_lib, OtherSystemLibs,
+ !IO)
),
- { SystemLibs = string__join_list(" ",
- [SystemTraceLibs, OtherSystemLibs, ThreadLibs]) }.
+ SystemLibs = string__join_list(" ",
+ [SystemTraceLibs, OtherSystemLibs, ThreadLibs]).
-:- pred use_thread_libs(bool::out, io__state::di, io__state::uo) is det.
+:- pred use_thread_libs(bool::out, io::di, io::uo) is det.
-use_thread_libs(UseThreadLibs) -->
- globals__io_lookup_bool_option(parallel, Parallel),
- globals__io_get_gc_method(GCMethod),
- { UseThreadLibs =
- ( ( Parallel = yes ; GCMethod = mps ) -> yes ; no ) }.
+use_thread_libs(UseThreadLibs, !IO) :-
+ globals__io_lookup_bool_option(parallel, Parallel, !IO),
+ globals__io_get_gc_method(GCMethod, !IO),
+ UseThreadLibs = ( ( Parallel = yes ; GCMethod = mps ) -> yes ; no ).
%-----------------------------------------------------------------------------%
-:- pred process_link_library(list(dir_name), string, string, bool, bool,
- io__state, io__state).
-:- mode process_link_library(in, in, out, in, out, di, uo) is det.
-
-process_link_library(MercuryLibDirs, LibName, LinkerOpt, !Succeeded) -->
- globals__io_lookup_string_option(mercury_linkage, MercuryLinkage),
- globals__io_lookup_accumulating_option(mercury_libraries, MercuryLibs),
- ( { MercuryLinkage = "static", list__member(LibName, MercuryLibs) } ->
+:- pred process_link_library(list(dir_name)::in, string::in, string::out,
+ bool::in, bool::out, io::di, io::uo) is det.
+
+process_link_library(MercuryLibDirs, LibName, LinkerOpt, !Succeeded, !IO) :-
+ globals__io_lookup_string_option(mercury_linkage, MercuryLinkage, !IO),
+ globals__io_lookup_accumulating_option(mercury_libraries, MercuryLibs,
+ !IO),
+ (
+ MercuryLinkage = "static",
+ list__member(LibName, MercuryLibs)
+ ->
% If we are linking statically with Mercury libraries,
% pass the absolute pathname of the `.a' file for
% the library.
globals__io_lookup_bool_option(use_grade_subdirs,
- UseGradeSubdirs),
+ UseGradeSubdirs, !IO),
- { file_name_to_module_name(LibName, LibModuleName) },
- globals__io_lookup_string_option(library_extension, LibExt),
+ file_name_to_module_name(LibName, LibModuleName),
+ globals__io_lookup_string_option(library_extension, LibExt,
+ !IO),
- globals__io_set_option(use_grade_subdirs, bool(no)),
+ globals__io_set_option(use_grade_subdirs, bool(no), !IO),
module_name_to_lib_file_name("lib", LibModuleName, LibExt,
- no, LibFileName),
+ no, LibFileName, !IO),
globals__io_set_option(use_grade_subdirs,
- bool(UseGradeSubdirs)),
+ bool(UseGradeSubdirs), !IO),
- io__input_stream(InputStream),
+ io__input_stream(InputStream, !IO),
search_for_file_returning_dir(MercuryLibDirs, LibFileName,
- SearchResult),
+ SearchResult, !IO),
(
- { SearchResult = ok(DirName) },
- { LinkerOpt = DirName/LibFileName },
- io__set_input_stream(InputStream, LibInputStream),
- io__close_input(LibInputStream)
+ SearchResult = ok(DirName),
+ LinkerOpt = DirName/LibFileName,
+ io__set_input_stream(InputStream, LibInputStream, !IO),
+ io__close_input(LibInputStream, !IO)
;
- { SearchResult = error(Error) },
- { LinkerOpt = "" },
+ SearchResult = error(Error),
+ LinkerOpt = "",
write_error_pieces_maybe_with_context(no,
- 0, [words(Error)]),
- { !:Succeeded = no }
+ 0, [words(Error)], !IO),
+ !:Succeeded = no
)
;
- { LinkerOpt = "-l" ++ LibName }
+ LinkerOpt = "-l" ++ LibName
).
-:- pred create_archive(io__output_stream, file_name, list(file_name),
- bool, io__state, io__state).
-:- mode create_archive(in, in, in, out, di, uo) is det.
+:- pred create_archive(io__output_stream::in, file_name::in,
+ list(file_name)::in, bool::out, io::di, io::uo) is det.
-create_archive(ErrorStream, LibFileName, ObjectList, Succeeded) -->
- globals__io_lookup_string_option(create_archive_command, ArCmd),
+create_archive(ErrorStream, LibFileName, ObjectList, Succeeded, !IO) :-
+ globals__io_lookup_string_option(create_archive_command, ArCmd, !IO),
globals__io_lookup_accumulating_option(
- create_archive_command_flags, ArFlagsList),
- { join_string_list(ArFlagsList, "", "", " ", ArFlags) },
+ create_archive_command_flags, ArFlagsList, !IO),
+ join_string_list(ArFlagsList, "", "", " ", ArFlags),
globals__io_lookup_string_option(
- create_archive_command_output_flag, ArOutputFlag),
- globals__io_lookup_string_option(ranlib_command, RanLib),
- { join_quoted_string_list(ObjectList, "", "", " ", Objects) },
- { MakeLibCmd = string__append_list([
+ create_archive_command_output_flag, ArOutputFlag, !IO),
+ globals__io_lookup_string_option(ranlib_command, RanLib, !IO),
+ join_quoted_string_list(ObjectList, "", "", " ", Objects),
+ MakeLibCmd = string__append_list([
ArCmd, " ", ArFlags, " ", ArOutputFlag, " ",
- LibFileName, " ", Objects]) },
+ LibFileName, " ", Objects]),
invoke_system_command(ErrorStream, verbose_commands,
- MakeLibCmd, MakeLibCmdSucceeded),
- ( { RanLib = "" ; MakeLibCmdSucceeded = no } ->
- { Succeeded = MakeLibCmdSucceeded }
+ MakeLibCmd, MakeLibCmdSucceeded, !IO),
+ (
+ ( RanLib = ""
+ ; MakeLibCmdSucceeded = no
+ )
+ ->
+ Succeeded = MakeLibCmdSucceeded
;
- { RanLibCmd =
- string__append_list([RanLib, " ", LibFileName]) },
+ RanLibCmd = string__append_list([RanLib, " ", LibFileName]),
invoke_system_command(ErrorStream, verbose_commands,
- RanLibCmd, Succeeded)
+ RanLibCmd, Succeeded, !IO)
).
-:- pred create_java_archive(io__output_stream, module_name, file_name,
- list(file_name), bool, io__state, io__state).
-:- mode create_java_archive(in, in, in, in, out, di, uo) is det.
+:- pred create_java_archive(io__output_stream::in, module_name::in,
+ file_name::in, list(file_name)::in, bool::out, io::di, io::uo) is det.
create_java_archive(ErrorStream, ModuleName, JarFileName, ObjectList,
- Succeeded) -->
+ Succeeded, !IO) :-
% XXX Maybe these should be set up as options:
- { Jar = "jar" },
- { JarCreateFlags = "cf" },
+ Jar = "jar",
+ JarCreateFlags = "cf",
- { join_quoted_string_list(ObjectList, "", "", " ", Objects) },
- list_class_files_for_jar(ModuleName, Objects, ListClassFiles),
- { Cmd = string__append_list([
+ join_quoted_string_list(ObjectList, "", "", " ", Objects),
+ list_class_files_for_jar(ModuleName, Objects, ListClassFiles, !IO),
+ Cmd = string__append_list([
Jar, " ", JarCreateFlags, " ", JarFileName, " ", ListClassFiles
- ]) },
+ ]),
- invoke_system_command(ErrorStream, verbose_commands, Cmd, Succeeded).
+ invoke_system_command(ErrorStream, verbose_commands, Cmd, Succeeded,
+ !IO).
-get_object_code_type(FileType, ObjectCodeType) -->
- globals__io_lookup_string_option(pic_object_file_extension, PicObjExt),
+get_object_code_type(FileType, ObjectCodeType, !IO) :-
+ globals__io_lookup_string_option(pic_object_file_extension, PicObjExt,
+ !IO),
globals__io_lookup_string_option(link_with_pic_object_file_extension,
- LinkWithPicObjExt),
- globals__io_lookup_string_option(object_file_extension, ObjExt),
- globals__io_lookup_string_option(mercury_linkage, MercuryLinkage),
- globals__io_lookup_bool_option(gcc_global_registers, GCCGlobals),
- globals__io_lookup_bool_option(highlevel_code, HighLevelCode),
- globals__io_lookup_bool_option(pic, PIC),
- globals__io_get_target(Target),
- {
+ LinkWithPicObjExt, !IO),
+ globals__io_lookup_string_option(object_file_extension, ObjExt, !IO),
+ globals__io_lookup_string_option(mercury_linkage, MercuryLinkage, !IO),
+ globals__io_lookup_bool_option(gcc_global_registers, GCCGlobals, !IO),
+ globals__io_lookup_bool_option(highlevel_code, HighLevelCode, !IO),
+ globals__io_lookup_bool_option(pic, PIC, !IO),
+ globals__io_get_target(Target, !IO),
+ (
PIC = yes,
% We've been explicitly told to use position independent code.
ObjectCodeType = ( if PicObjExt = ObjExt then non_pic else pic )
@@ -1633,19 +1641,18 @@
error("unknown linkage " ++ MercuryLinkage)
)
)
- }.
+ ).
%-----------------------------------------------------------------------------%
-:- pred standard_library_directory_option(string, io__state, io__state).
-:- mode standard_library_directory_option(out, di, uo) is det.
+:- pred standard_library_directory_option(string::out, io::di, io::uo) is det.
-standard_library_directory_option(Opt) -->
+standard_library_directory_option(Opt, !IO) :-
globals__io_lookup_maybe_string_option(
- mercury_standard_library_directory, MaybeStdLibDir),
+ mercury_standard_library_directory, MaybeStdLibDir, !IO),
globals__io_lookup_maybe_string_option(
- mercury_configuration_directory, MaybeConfDir),
- {
+ mercury_configuration_directory, MaybeConfDir, !IO),
+ (
MaybeStdLibDir = yes(StdLibDir),
Opt0 = "--mercury-standard-library-directory "
++ StdLibDir ++ " ",
@@ -1658,7 +1665,7 @@
;
MaybeStdLibDir = no,
Opt = "--no-mercury-standard-library-directory "
- }.
+ ).
%-----------------------------------------------------------------------------%
@@ -1668,8 +1675,8 @@
% string Result. Each string is prefixed by Prefix, suffixed by
% Suffix and separated by Separator.
-:- pred join_string_list(list(string), string, string, string, string).
-:- mode join_string_list(in, in, in, in, out) is det.
+:- pred join_string_list(list(string)::in, string::in, string::in, string::in,
+ string::out) is det.
join_string_list([], _Prefix, _Suffix, _Separator, "").
join_string_list([String | Strings], Prefix, Suffix, Separator, Result) :-
@@ -1684,8 +1691,8 @@
% As above, but quote the strings first.
% Note that the strings in values of the *flags options are
% already quoted.
-:- pred join_quoted_string_list(list(string), string, string, string, string).
-:- mode join_quoted_string_list(in, in, in, in, out) is det.
+:- pred join_quoted_string_list(list(string)::in, string::in, string::in,
+ string::in, string::out) is det.
join_quoted_string_list(Strings, Prefix, Suffix, Separator, Result) :-
join_string_list(map(quote_arg, Strings),
@@ -1699,121 +1706,126 @@
% adding the specified Extension. (This conversion ensures
% that we follow the usual file naming conventions.)
-:- pred join_module_list(list(string), string, list(string),
- io__state, io__state).
-:- mode join_module_list(in, in, out, di, uo) is det.
-
-join_module_list([], _Extension, []) --> [].
-join_module_list([Module | Modules], Extension, [FileName | Rest]) -->
- { file_name_to_module_name(dir__basename_det(Module), ModuleName) },
- module_name_to_file_name(ModuleName, Extension, no, FileName),
- join_module_list(Modules, Extension, Rest).
+:- pred join_module_list(list(string)::in, string::in, list(string)::out,
+ io::di, io::uo) is det.
+
+join_module_list([], _Extension, [], !IO).
+join_module_list([Module | Modules], Extension, [FileName | Rest], !IO) :-
+ file_name_to_module_name(dir__basename_det(Module), ModuleName),
+ module_name_to_file_name(ModuleName, Extension, no, FileName, !IO),
+ join_module_list(Modules, Extension, Rest, !IO).
%-----------------------------------------------------------------------------%
-write_num_split_c_files(ModuleName, NumChunks, Succeeded) -->
+write_num_split_c_files(ModuleName, NumChunks, Succeeded, !IO) :-
module_name_to_file_name(ModuleName, ".num_split", yes,
- NumChunksFileName),
- io__open_output(NumChunksFileName, Res),
- ( { Res = ok(OutputStream) } ->
- io__write_int(OutputStream, NumChunks),
- io__nl(OutputStream),
- io__close_output(OutputStream),
- { Succeeded = yes }
- ;
- { Succeeded = no },
- io__progname_base("mercury_compile", ProgName),
- io__write_string(ProgName),
- io__write_string(": can't open `"),
- io__write_string(NumChunksFileName),
- io__write_string("' for output\n")
+ NumChunksFileName, !IO),
+ io__open_output(NumChunksFileName, Res, !IO),
+ ( Res = ok(OutputStream) ->
+ io__write_int(OutputStream, NumChunks, !IO),
+ io__nl(OutputStream, !IO),
+ io__close_output(OutputStream, !IO),
+ Succeeded = yes
+ ;
+ Succeeded = no,
+ io__progname_base("mercury_compile", ProgName, !IO),
+ io__write_string(ProgName, !IO),
+ io__write_string(": can't open `", !IO),
+ io__write_string(NumChunksFileName, !IO),
+ io__write_string("' for output\n", !IO)
).
-read_num_split_c_files(ModuleName, MaybeNumChunks) -->
+read_num_split_c_files(ModuleName, MaybeNumChunks, !IO) :-
module_name_to_file_name(ModuleName, ".num_split", no,
- NumChunksFileName),
- io__open_input(NumChunksFileName, Res),
+ NumChunksFileName, !IO),
+ io__open_input(NumChunksFileName, Res, !IO),
(
- { Res = ok(FileStream) },
- io__read_word(FileStream, MaybeNumChunksString),
- io__close_input(FileStream),
+ Res = ok(FileStream),
+ io__read_word(FileStream, MaybeNumChunksString, !IO),
+ io__close_input(FileStream, !IO),
(
- { MaybeNumChunksString = ok(NumChunksString) },
+ MaybeNumChunksString = ok(NumChunksString),
(
- { string__to_int(
+ string__to_int(
string__from_char_list(NumChunksString),
- NumChunks) }
+ NumChunks)
->
- { MaybeNumChunks = ok(NumChunks) }
+ MaybeNumChunks = ok(NumChunks)
;
- { MaybeNumChunks = error(
+ MaybeNumChunks = error(
"Software error: error in `"
++ NumChunksFileName
- ++ "': expected single int.\n") }
+ ++ "': expected single int.\n")
)
;
- { MaybeNumChunksString = eof },
- { MaybeNumChunks = error(
+ MaybeNumChunksString = eof,
+ MaybeNumChunks = error(
"Software error: error in `"
++ NumChunksFileName
- ++ "': expected single int.\n") }
+ ++ "': expected single int.\n")
;
- { MaybeNumChunksString = error(_) },
- { MaybeNumChunks = error(
+ MaybeNumChunksString = error(_),
+ MaybeNumChunks = error(
"Software error: error in `"
++ NumChunksFileName
- ++ "': expected single int.\n") }
+ ++ "': expected single int.\n")
)
;
- { Res = error(Error) },
- { MaybeNumChunks = error(io__error_message(Error)) }
+ Res = error(Error),
+ MaybeNumChunks = error(io__error_message(Error))
).
-remove_split_c_output_files(ModuleName, NumChunks) -->
- remove_split_c_output_files(ModuleName, 0, NumChunks).
+remove_split_c_output_files(ModuleName, NumChunks, !IO) :-
+ remove_split_c_output_files(ModuleName, 0, NumChunks, !IO).
+
+:- pred remove_split_c_output_files(module_name::in, int::in, int::in,
+ io::di, io::uo) is det.
-:- pred remove_split_c_output_files(module_name, int, int,
- io__state, io__state).
-:- mode remove_split_c_output_files(in,in, in, di, uo) is det.
-
-remove_split_c_output_files(ModuleName, ThisChunk, NumChunks) -->
- ( { ThisChunk =< NumChunks } ->
- globals__io_lookup_string_option(object_file_extension, Obj),
+remove_split_c_output_files(ModuleName, ThisChunk, NumChunks, !IO) :-
+ ( ThisChunk =< NumChunks ->
+ globals__io_lookup_string_option(object_file_extension, Obj,
+ !IO),
module_name_to_split_c_file_name(ModuleName, ThisChunk,
- ".c", CFileName),
+ ".c", CFileName, !IO),
module_name_to_split_c_file_name(ModuleName, ThisChunk,
- Obj, ObjFileName),
- io__remove_file(CFileName, _),
- io__remove_file(ObjFileName, _),
- remove_split_c_output_files(ModuleName, ThisChunk, NumChunks)
+ Obj, ObjFileName, !IO),
+ io__remove_file(CFileName, _, !IO),
+ io__remove_file(ObjFileName, _, !IO),
+ remove_split_c_output_files(ModuleName, ThisChunk, NumChunks,
+ !IO)
;
- []
+ true
).
%-----------------------------------------------------------------------------%
-make_all_module_command(Command0, MainModule, AllModules, Command) -->
+make_all_module_command(Command0, MainModule, AllModules, Command, !IO) :-
% Pass the main module first.
list__map_foldl(
- (pred(Module::in, FileName::out, di, uo) is det -->
- module_name_to_file_name(Module, ".m", no, FileName)
+ (pred(Module::in, FileName::out, IO0::di, IO::uo) is det :-
+ module_name_to_file_name(Module, ".m", no, FileName,
+ IO0, IO)
),
[MainModule | list__delete_all(AllModules, MainModule)],
- ModuleNameStrings),
- { Command = string__join_list(" ",
- list__map(quote_arg, [Command0 | ModuleNameStrings])) }.
+ ModuleNameStrings, !IO),
+ Command = string__join_list(" ",
+ list__map(quote_arg, [Command0 | ModuleNameStrings])).
%-----------------------------------------------------------------------------%
:- pragma promise_pure(maybe_pic_object_file_extension/3).
+
maybe_pic_object_file_extension(Globals::in, PIC::in, Ext::out) :-
- ( PIC = non_pic,
+ (
+ PIC = non_pic,
globals__lookup_string_option(Globals,
object_file_extension, Ext)
- ; PIC = pic,
+ ;
+ PIC = pic,
globals__lookup_string_option(Globals,
pic_object_file_extension, Ext)
- ; PIC = link_with_pic,
+ ;
+ PIC = link_with_pic,
globals__lookup_string_option(Globals,
link_with_pic_object_file_extension, Ext)
).
@@ -1840,9 +1852,9 @@
fail
).
-maybe_pic_object_file_extension(PIC, ObjExt) -->
- globals__io_get_globals(Globals),
- { maybe_pic_object_file_extension(Globals, PIC, ObjExt) }.
+maybe_pic_object_file_extension(PIC, ObjExt, !IO) :-
+ globals__io_get_globals(Globals, !IO),
+ maybe_pic_object_file_extension(Globals, PIC, ObjExt).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.86
diff -u -b -r1.86 dead_proc_elim.m
--- compiler/dead_proc_elim.m 21 Dec 2003 05:04:32 -0000 1.86
+++ compiler/dead_proc_elim.m 16 Mar 2004 05:54:56 -0000
@@ -67,12 +67,13 @@
:- implementation.
:- import_module hlds__hlds_data.
+:- import_module hlds__hlds_error_util.
:- import_module hlds__hlds_goal.
:- import_module hlds__passes_aux.
-:- import_module hlds__error_util.
:- import_module libs__globals.
:- import_module libs__options.
:- import_module ll_backend__llds.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__prog_util.
:- import_module int, string, list, set, queue, bool, require.
@@ -717,7 +718,7 @@
:- mode warn_dead_proc(in, in, in, in, di, uo) is det.
warn_dead_proc(PredId, ProcId, Context, ModuleInfo, !IO) :-
- error_util__describe_one_proc_name(ModuleInfo, proc(PredId, ProcId),
+ describe_one_proc_name(ModuleInfo, proc(PredId, ProcId),
ProcName),
Components = [words("Warning:"), fixed(ProcName),
words("is never called.")],
Index: compiler/equiv_type.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/equiv_type.m,v
retrieving revision 1.35
diff -u -b -r1.35 equiv_type.m
--- compiler/equiv_type.m 18 Dec 2003 01:54:47 -0000 1.35
+++ compiler/equiv_type.m 16 Mar 2004 05:39:13 -0000
@@ -98,8 +98,8 @@
% XXX we shouldn't import the HLDS here.
:- import_module check_hlds__mode_util.
:- import_module check_hlds__type_util.
-:- import_module hlds__error_util.
:- import_module hlds__hlds_data.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__inst.
:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_out.
Index: compiler/error_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/error_util.m,v
retrieving revision 1.25
diff -u -b -r1.25 error_util.m
--- compiler/error_util.m 30 Jan 2004 06:00:45 -0000 1.25
+++ compiler/error_util.m 18 Mar 2004 16:28:59 -0000
@@ -10,36 +10,34 @@
% This module contains code that can be helpful in the formatting of
% error messages.
%
+% Given a context, a starting indentation level and a list of words,
+% print an error message that looks like this:
+%
+% module.m:10: first line of error message blah blah blah
+% module.m:10: second line of error message blah blah blah
+% module.m:10: third line of error message blah blah blah
+%
+% The words will be packed into lines as tightly as possible,
+% with spaces between each pair of words, subject to the constraints
+% that every line starts with a context, followed by Indent+1 spaces
+% on the first line and Indent+3 spaces on later lines, and that every
+% line contains at most 79 characters (unless a long single word
+% forces the line over this limit).
+%
+% The caller supplies the list of words to be printed in the form
+% of a list of error message components. Each component may specify
+% a string to printed exactly as it is, or it may specify a string
+% containing a list of words, which may be broken at white space.
+%
%-----------------------------------------------------------------------------%
-:- module hlds__error_util.
+:- module parse_tree__error_util.
:- interface.
-:- import_module hlds__hlds_module.
-:- import_module hlds__hlds_pred.
:- import_module parse_tree__prog_data.
-:- import_module assoc_list, char, io, list, std_util.
-
- % Given a context, a starting indentation level and a list of words,
- % print an error message that looks like this:
- %
- % module.m:10: first line of error message blah blah blah
- % module.m:10: second line of error message blah blah blah
- % module.m:10: third line of error message blah blah blah
- %
- % The words will be packed into lines as tightly as possible,
- % with spaces between each pair of words, subject to the constraints
- % that every line starts with a context, followed by Indent+1 spaces
- % on the first line and Indent+3 spaces on later lines, and that every
- % line contains at most 79 characters (unless a long single word
- % forces the line over this limit).
- %
- % The caller supplies the list of words to be printed in the form
- % of a list of error message components. Each component may specify
- % a string to printed exactly as it is, or it may specify a string
- % containing a list of words, which may be broken at white space.
+:- import_module char, io, list, std_util.
:- type format_component
---> fixed(string) % This string should appear in the output
@@ -51,18 +49,22 @@
% white space may be rearranged and line
% breaks may be inserted.
+ ; sym_name(sym_name)
+ % The output should contain the string form of
+ % the sym_name, surrounded by `' quotes.
+
; nl. % Insert a line break if there has been text
% output since the last line break.
% Convert a list of strings into a list of format_components,
% suitable for displaying as an error message.
-:- pred error_util__list_to_pieces(list(string)::in,
+:- pred list_to_pieces(list(string)::in,
list(format_component)::out) is det.
% Convert a list of lists of format_components into a list of
% format_components separated by commas, with the last two
% elements separated by `and'.
-:- func error_util__component_lists_to_pieces(list(list(format_component))) =
+:- func component_lists_to_pieces(list(list(format_component))) =
list(format_component).
% Display the given error message, without a context and with standard
@@ -83,43 +85,15 @@
:- pred write_error_pieces_maybe_with_context(maybe(prog_context)::in, int::in,
list(format_component)::in, io::di, io::uo) is det.
- % Report a warning, and set the exit status to error if the
- % --halt-at-warn option is set. This predicate does the same thing as
- % prog_io_util__report_warning, except that it does a nicer job of
- % displaying the warning message.
-:- pred report_warning(prog_context::in, int::in, list(format_component)::in,
- io::di, io::uo) is det.
-
- % Predicates to convert a predicate names to strings.
-
-:- pred error_util__describe_one_pred_name(module_info::in, pred_id::in,
- string::out) is det.
-
-:- pred error_util__describe_several_pred_names(module_info::in,
- list(pred_id)::in, list(format_component)::out) is det.
-
-:- pred error_util__describe_one_proc_name(module_info::in, pred_proc_id::in,
- string::out) is det.
-
-:- pred error_util__describe_several_proc_names(module_info::in,
- list(pred_proc_id)::in, list(format_component)::out) is det.
-
-:- pred error_util__describe_one_call_site(module_info::in,
- pair(pred_proc_id, prog_context)::in, string::out) is det.
-
-:- pred error_util__describe_several_call_sites(module_info::in,
- assoc_list(pred_proc_id, prog_context)::in,
- list(format_component)::out) is det.
-
-:- func error_util__describe_sym_name(sym_name) = string.
+:- func describe_sym_name(sym_name) = string.
-:- func error_util__describe_sym_name_and_arity(sym_name_and_arity) = string.
+:- func describe_sym_name_and_arity(sym_name_and_arity) = string.
-:- func error_util__pred_or_func_to_string(pred_or_func) = string.
+:- func pred_or_func_to_string(pred_or_func) = string.
% Append a punctuation character to a message, avoiding unwanted
% line splitting between the message and the punctuation.
-:- func error_util__append_punctuation(list(format_component), char) =
+:- func append_punctuation(list(format_component), char) =
list(format_component).
% report_error_num_args(MaybePredOrFunc, Arity, CorrectArities).
@@ -147,6 +121,24 @@
%
:- pred unexpected(string::in, string::in) is erroneous.
+ % Record the fact that a warning has been issued; set the exit status
+ % to error if the --halt-at-warn option is set.
+:- pred record_warning(io::di, io::uo) is det.
+
+ % Report a warning, and set the exit status to error if the
+ % --halt-at-warn option is set.
+:- pred report_warning(string::in, io::di, io::uo) is det.
+
+ % Report a warning to the specified stream, and set the exit status
+ % to error if the --halt-at-warn option is set.
+:- pred report_warning(io__output_stream::in, string::in, io::di, io::uo)
+ is det.
+
+ % Report a warning, and set the exit status to error if the
+ % --halt-at-warn option is set.
+:- pred report_warning(prog_context::in, int::in, list(format_component)::in,
+ io::di, io::uo) is det.
+
:- implementation.
:- import_module parse_tree__prog_out.
@@ -156,34 +148,25 @@
:- import_module bool, io, list, term, char, string, int, require.
-error_util__list_to_pieces([], []).
-error_util__list_to_pieces([Elem], [words(Elem)]).
-error_util__list_to_pieces([Elem1, Elem2],
+list_to_pieces([], []).
+list_to_pieces([Elem], [words(Elem)]).
+list_to_pieces([Elem1, Elem2],
[fixed(Elem1), words("and"), fixed(Elem2)]).
-error_util__list_to_pieces([Elem1, Elem2, Elem3 | Elems], Pieces) :-
+list_to_pieces([Elem1, Elem2, Elem3 | Elems], Pieces) :-
string__append(Elem1, ",", Piece1),
- error_util__list_to_pieces([Elem2, Elem3 | Elems], Pieces1),
+ list_to_pieces([Elem2, Elem3 | Elems], Pieces1),
Pieces = [fixed(Piece1) | Pieces1].
-error_util__component_lists_to_pieces([]) = [].
-error_util__component_lists_to_pieces([Components]) = Components.
-error_util__component_lists_to_pieces([Components1, Components2]) =
+component_lists_to_pieces([]) = [].
+component_lists_to_pieces([Components]) = Components.
+component_lists_to_pieces([Components1, Components2]) =
list__condense([Components1, [words("and")], Components2]).
-error_util__component_lists_to_pieces(
+component_lists_to_pieces(
[Components1, Components2, Components3 | Components]) =
list__append(append_punctuation(Components1, ','),
- error_util__component_lists_to_pieces(
+ component_lists_to_pieces(
[Components2, Components3 | Components])).
-report_warning(Context, Indent, Components, !IO) :-
- globals__io_lookup_bool_option(halt_at_warn, HaltAtWarn, !IO),
- ( HaltAtWarn = yes ->
- io__set_exit_status(1, !IO)
- ;
- true
- ),
- write_error_pieces(Context, Indent, Components, !IO).
-
write_error_pieces_plain(Components, !IO) :-
write_error_pieces_maybe_with_context(yes, no, 0, Components, !IO).
@@ -311,6 +294,10 @@
break_into_words(WordsStr, Words0, Words1),
Paras1 = Paras0
;
+ Component = sym_name(SymName),
+ Words1 = [sym_name_to_word(SymName) | Words0],
+ Paras1 = Paras0
+ ;
Component = nl,
list__reverse(Words0, Words),
Paras1 = [Words | Paras0],
@@ -318,6 +305,11 @@
),
convert_components_to_word_list(Components, Words1, Paras1, Paras).
+:- func sym_name_to_word(sym_name) = string.
+
+sym_name_to_word(SymName) = "`" ++ SymStr ++ "'" :-
+ sym_name_to_string(SymName, SymStr).
+
:- pred break_into_words(string::in, list(string)::in, list(string)::out)
is det.
@@ -438,86 +430,22 @@
%-----------------------------------------------------------------------------%
- % The code of this predicate duplicates the functionality of
- % hlds_out__write_pred_id. Changes here should be made there as well.
-
-error_util__describe_one_pred_name(Module, PredId, Piece) :-
- module_info_pred_info(Module, PredId, PredInfo),
- ModuleName = pred_info_module(PredInfo),
- prog_out__sym_name_to_string(ModuleName, ModuleNameString),
- PredName = pred_info_name(PredInfo),
- Arity = pred_info_arity(PredInfo),
- PredOrFunc = pred_info_is_pred_or_func(PredInfo),
- PredOrFuncPart = pred_or_func_to_string(PredOrFunc),
- adjust_func_arity(PredOrFunc, OrigArity, Arity),
- (
- pred_info_get_goal_type(PredInfo, promise(PromiseType))
- ->
- Piece = "`" ++ promise_to_string(PromiseType) ++ "' declaration"
- ;
- string__int_to_string(OrigArity, ArityPart),
- string__append_list([
- PredOrFuncPart,
- " `",
- ModuleNameString,
- ".",
- PredName,
- "/",
- ArityPart,
- "'"], Piece)
- ).
-
-error_util__describe_several_pred_names(Module, PredId, Pieces) :-
- list__map(error_util__describe_one_pred_name(Module), PredId, Pieces0),
- error_util__list_to_pieces(Pieces0, Pieces).
-
-error_util__describe_one_proc_name(Module, proc(PredId, ProcId), Piece) :-
- error_util__describe_one_pred_name(Module, PredId, PredPiece),
- proc_id_to_int(ProcId, ProcIdInt),
- string__int_to_string(ProcIdInt, ProcIdPart),
- string__append_list([
- PredPiece,
- " mode ",
- ProcIdPart
- ], Piece).
-
-error_util__describe_several_proc_names(Module, PPIds, Pieces) :-
- list__map(error_util__describe_one_proc_name(Module), PPIds, Pieces0),
- error_util__list_to_pieces(Pieces0, Pieces).
-
-error_util__describe_one_call_site(Module, PPId - Context, Piece) :-
- error_util__describe_one_proc_name(Module, PPId, ProcName),
- term__context_file(Context, FileName),
- term__context_line(Context, LineNumber),
- string__int_to_string(LineNumber, LineNumberPart),
- string__append_list([
- ProcName,
- " at ",
- FileName,
- ":",
- LineNumberPart
- ], Piece).
-
-error_util__describe_several_call_sites(Module, Sites, Pieces) :-
- list__map(error_util__describe_one_call_site(Module), Sites, Pieces0),
- error_util__list_to_pieces(Pieces0, Pieces).
-
-error_util__describe_sym_name_and_arity(SymName / Arity) =
+describe_sym_name_and_arity(SymName / Arity) =
string__append_list(["`", SymNameString,
"/", string__int_to_string(Arity), "'"]) :-
sym_name_to_string(SymName, SymNameString).
-error_util__describe_sym_name(SymName) =
+describe_sym_name(SymName) =
string__append_list(["`", SymNameString, "'"]) :-
sym_name_to_string(SymName, SymNameString).
-error_util__pred_or_func_to_string(predicate) = "predicate".
-error_util__pred_or_func_to_string(function) = "function".
+pred_or_func_to_string(predicate) = "predicate".
+pred_or_func_to_string(function) = "function".
-error_util__append_punctuation([], _) = _ :-
- error("error_util__append_punctuation: " ++
+append_punctuation([], _) = _ :-
+ error("append_punctuation: " ++
"appending punctuation after nothing").
-error_util__append_punctuation([Piece0], Punc) = [Piece] :-
+append_punctuation([Piece0], Punc) = [Piece] :-
% Avoid unwanted line splitting between the message
% and the punctuation.
(
@@ -527,12 +455,16 @@
Piece0 = fixed(String),
Piece = fixed(string__append(String, char_to_string(Punc)))
;
+ Piece0 = sym_name(SymName),
+ String = sym_name_to_word(SymName),
+ Piece = fixed(string__append(String, char_to_string(Punc)))
+ ;
Piece0 = nl,
- error("error_util__append_punctutation: " ++
+ error("append_punctutation: " ++
"appending punctuation after newline")
).
-error_util__append_punctuation([Piece1, Piece2 | Pieces], Punc) =
- [Piece1 | error_util__append_punctuation([Piece2 | Pieces], Punc)].
+append_punctuation([Piece1, Piece2 | Pieces], Punc) =
+ [Piece1 | append_punctuation([Piece2 | Pieces], Punc)].
%-----------------------------------------------------------------------------%
@@ -581,3 +513,23 @@
string__format("%s: Unexpected: %s",
[s(Module), s(What)], ErrorMessage),
error(ErrorMessage).
+
+record_warning(!IO) :-
+ globals__io_lookup_bool_option(halt_at_warn, HaltAtWarn, !IO),
+ ( HaltAtWarn = yes ->
+ io__set_exit_status(1, !IO)
+ ;
+ true
+ ).
+
+report_warning(Message, !IO) :-
+ record_warning(!IO),
+ io__write_string(Message, !IO).
+
+report_warning(Stream, Message, !IO) :-
+ record_warning(!IO),
+ io__write_string(Stream, Message, !IO).
+
+report_warning(Context, Indent, Components, !IO) :-
+ record_warning(!IO),
+ write_error_pieces(Context, Indent, Components, !IO).
Index: compiler/export.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/export.m,v
retrieving revision 1.73
diff -u -b -r1.73 export.m
--- compiler/export.m 7 Feb 2004 12:44:18 -0000 1.73
+++ compiler/export.m 16 Mar 2004 05:42:22 -0000
@@ -72,16 +72,16 @@
:- implementation.
:- import_module backend_libs__code_model.
+:- import_module backend_libs__c_util.
:- import_module backend_libs__foreign.
:- import_module backend_libs__name_mangle.
:- import_module backend_libs__proc_label.
-:- import_module backend_libs__c_util.
:- import_module check_hlds__type_util.
-:- import_module hlds__error_util.
:- import_module hlds__hlds_pred.
:- import_module libs__globals.
:- import_module libs__options.
:- import_module ll_backend__arg_info.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__modules.
:- import_module term, varset.
Index: compiler/foreign.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/foreign.m,v
retrieving revision 1.34
diff -u -b -r1.34 foreign.m
--- compiler/foreign.m 13 Jan 2004 05:28:00 -0000 1.34
+++ compiler/foreign.m 16 Mar 2004 05:43:22 -0000
@@ -232,11 +232,11 @@
:- import_module backend_libs__name_mangle.
:- import_module check_hlds__mode_util.
:- import_module check_hlds__type_util.
-:- import_module hlds__error_util.
:- import_module hlds__hlds_data.
:- import_module hlds__hlds_module.
:- import_module hlds__hlds_pred.
:- import_module libs__globals.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__modules.
:- import_module parse_tree__prog_out.
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.201
diff -u -b -r1.201 handle_options.m
--- compiler/handle_options.m 10 Mar 2004 04:30:31 -0000 1.201
+++ compiler/handle_options.m 16 Mar 2004 05:36:32 -0000
@@ -24,36 +24,33 @@
:- import_module list, bool, getopt, std_util, io.
% handle_options(Args, MaybeError, OptionArgs, NonOptionArgs, Link).
-:- pred handle_options(list(string), maybe(string), list(string),
- list(string), bool, io__state, io__state).
-:- mode handle_options(in, out, out, out, out, di, uo) is det.
+:- pred handle_options(list(string)::in, maybe(string)::out, list(string)::out,
+ list(string)::out, bool::out, io::di, io::uo) is det.
% process_options(Args, OptionArgs, NonOptionArgs, MaybeOptionTable).
%
% Process the options, but don't do any post-processing or
% modify the globals. This is mainly useful for separating
% the list of arguments into option and non-option arguments.
-:- pred process_options(list(string), list(string), list(string),
- maybe_option_table(option)).
-:- mode process_options(in, out, out, out) is det.
+:- pred process_options(list(string)::in, list(string)::out, list(string)::out,
+ maybe_option_table(option)::out) is det.
% usage_error(Descr, Message)
%
% Display the description of the error location, the error message
% and then a usage message.
-:- pred usage_error(string::in, string::in,
- io__state::di, io__state::uo) is det.
+:- pred usage_error(string::in, string::in, io::di, io::uo) is det.
% usage_error(Message)
%
% Display error message and then usage message
-:- pred usage_error(string::in, io__state::di, io__state::uo) is det.
+:- pred usage_error(string::in, io::di, io::uo) is det.
% Display usage message.
-:- pred usage(io__state::di, io__state::uo) is det.
+:- pred usage(io::di, io::uo) is det.
% Display long usage message for help
-:- pred long_usage(io__state::di, io__state::uo) is det.
+:- pred long_usage(io::di, io::uo) is det.
% Given the current set of options, figure out
% which grade to use.
@@ -74,6 +71,7 @@
:- import_module libs__trace_params.
:- import_module parse_tree.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__prog_io_util.
:- import_module char, dir, int, string, map, set, library.
@@ -131,18 +129,16 @@
process_options(Args0, OptionArgs, Args, Result) :-
OptionOps = option_ops(short_option, long_option,
option_defaults, special_handler),
- getopt__process_options(OptionOps, Args0,
- OptionArgs, Args, Result).
+ getopt__process_options(OptionOps, Args0, OptionArgs, Args, Result).
-:- pred dump_arguments(list(string), io__state, io__state).
-:- mode dump_arguments(in, di, uo) is det.
+:- pred dump_arguments(list(string)::in, io::di, io::uo) is det.
-dump_arguments([]) --> [].
-dump_arguments([Arg | Args]) -->
- io__write_string("<"),
- io__write_string(Arg),
- io__write_string(">\n"),
- dump_arguments(Args).
+dump_arguments([], !IO).
+dump_arguments([Arg | Args], !IO) :-
+ io__write_string("<", !IO),
+ io__write_string(Arg, !IO),
+ io__write_string(">\n", !IO),
+ dump_arguments(Args, !IO).
%-----------------------------------------------------------------------------%
@@ -150,117 +146,151 @@
% and process implications among the options (i.e. situations where setting
% one option implies setting/unsetting another one).
-:- pred postprocess_options(maybe_option_table(option), maybe(string),
- io__state, io__state).
-:- mode postprocess_options(in, out, di, uo) is det.
+:- pred postprocess_options(maybe_option_table(option)::in, maybe(string)::out,
+ io::di, io::uo) is det.
-postprocess_options(error(ErrorMessage), yes(ErrorMessage)) --> [].
-postprocess_options(ok(OptionTable), Error) -->
- { map__lookup(OptionTable, target, Target0) },
+postprocess_options(error(ErrorMessage), yes(ErrorMessage), !IO).
+postprocess_options(ok(OptionTable0), MaybeError, !IO) :-
+ check_option_values(OptionTable0, OptionTable, Target, GC_Method,
+ TagsMethod, TermNorm, TraceLevel, TraceSuppress, [], Errors),
+ ( Errors = [] ->
+ postprocess_options_2(OptionTable, Target, GC_Method,
+ TagsMethod, TermNorm, TraceLevel, TraceSuppress,
+ MaybeError, !IO)
+ ;
+ Error = string__join_list("\n", Errors),
+ MaybeError = yes(Error)
+ ).
+
+:- pred check_option_values(option_table::in, option_table::out,
+ compilation_target::out, gc_method::out, tags_method::out,
+ termination_norm::out, trace_level::out, trace_suppress_items::out,
+ list(string)::in, list(string)::out) is det.
+
+check_option_values(OptionTable0, OptionTable, Target, GC_Method, TagsMethod,
+ TermNorm, TraceLevel, TraceSuppress, !Errors) :-
+ map__lookup(OptionTable0, target, Target0),
(
- { Target0 = string(TargetStr) },
- { convert_target(TargetStr, Target) }
+ Target0 = string(TargetStr),
+ convert_target(TargetStr, TargetPrime)
->
- { map__lookup(OptionTable, gc, GC_Method0) },
+ Target = TargetPrime
+ ;
+ Target = c, % dummy
+ add_error("Invalid target option " ++
+ "(must be `c', `asm', `il', or `java')", !Errors)
+ ),
+ map__lookup(OptionTable0, gc, GC_Method0),
(
- { GC_Method0 = string(GC_MethodStr) },
- { convert_gc_method(GC_MethodStr, GC_Method) }
+ GC_Method0 = string(GC_MethodStr),
+ convert_gc_method(GC_MethodStr, GC_MethodPrime)
->
- { map__lookup(OptionTable, tags, TagsMethod0) },
+ GC_Method = GC_MethodPrime
+ ;
+ GC_Method = none, % dummy
+ add_error("Invalid GC option (must be `none', " ++
+ "`conservative', `boehm', `mps', `accurate', " ++
+ "or `automatic')", !Errors)
+ ),
+ map__lookup(OptionTable0, tags, TagsMethod0),
(
- { TagsMethod0 = string(TagsMethodStr) },
- { convert_tags_method(TagsMethodStr, TagsMethod) }
+ TagsMethod0 = string(TagsMethodStr),
+ convert_tags_method(TagsMethodStr, TagsMethodPrime)
->
- { map__lookup(OptionTable, fact_table_hash_percent_full,
- PercentFull) },
+ TagsMethod = TagsMethodPrime
+ ;
+ TagsMethod = none, % dummy
+ add_error("Invalid tags option " ++
+ "(must be `none', `low' or `high')", !Errors)
+ ),
+ map__lookup(OptionTable0, fact_table_hash_percent_full, PercentFull),
(
- { PercentFull = int(Percent) },
- { Percent >= 1 },
- { Percent =< 100 }
+ PercentFull = int(Percent),
+ Percent >= 1,
+ Percent =< 100
->
- { map__lookup(OptionTable, termination_norm,
- TermNorm0) },
+ true
+ ;
+ add_error("Invalid argument to option " ++
+ "`--fact-table-hash-percent-full'\n\t" ++
+ "(must be an integer between 1 and 100)", !Errors)
+ ),
+ map__lookup(OptionTable0, termination_norm, TermNorm0),
(
- { TermNorm0 = string(TermNormStr) },
- { convert_termination_norm(TermNormStr, TermNorm) }
+ TermNorm0 = string(TermNormStr),
+ convert_termination_norm(TermNormStr, TermNormPrime)
->
- { map__lookup(OptionTable, trace, Trace) },
- { map__lookup(OptionTable, require_tracing,
- RequireTracingOpt) },
- { map__lookup(OptionTable, decl_debug,
- DeclDebugOpt) },
+ TermNorm = TermNormPrime
+ ;
+ TermNorm = simple, % dummy
+ add_error("Invalid argument to option " ++
+ "`--termination-norm'\n\t(must be " ++
+ "`simple', `total' or `num-data-elems').", !Errors)
+ ),
+ map__lookup(OptionTable0, trace, Trace),
+ map__lookup(OptionTable0, require_tracing, RequireTracingOpt),
+ map__lookup(OptionTable0, decl_debug, DeclDebugOpt),
(
- { Trace = string(TraceStr) },
- { RequireTracingOpt = bool(RequireTracing) },
- { DeclDebugOpt = bool(DeclDebug) },
- { convert_trace_level(TraceStr, RequireTracing,
- DeclDebug, MaybeTraceLevel) }
+ Trace = string(TraceStr),
+ RequireTracingOpt = bool(RequireTracing),
+ DeclDebugOpt = bool(DeclDebug),
+ convert_trace_level(TraceStr, RequireTracing, DeclDebug,
+ MaybeTraceLevel)
->
(
- { MaybeTraceLevel = yes(TraceLevel) },
- { map__lookup(OptionTable, suppress_trace,
- Suppress) },
+ MaybeTraceLevel = yes(TraceLevel)
+ ;
+ MaybeTraceLevel = no,
+ TraceLevel = trace_level_none, % dummy
+ add_error("Specified trace level is not " ++
+ "compatible with grade", !Errors)
+ )
+ ;
+ TraceLevel = trace_level_none, % dummy
+ add_error("Invalid argument to option `--trace'\n\t" ++
+ "(must be `minimum', `shallow', `deep', `decl', " ++
+ "`rep' or `default').", !Errors)
+ ),
+ map__lookup(OptionTable0, suppress_trace, Suppress),
(
- { Suppress = string(SuppressStr) },
- { convert_trace_suppress(SuppressStr,
- TraceSuppress) }
+ Suppress = string(SuppressStr),
+ convert_trace_suppress(SuppressStr, TraceSuppressPrime)
->
- { map__lookup(OptionTable, dump_hlds_alias,
- DumpAliasOption) },
+ TraceSuppress = TraceSuppressPrime
+ ;
+ TraceSuppress = default_trace_suppress, % dummy
+ add_error("Invalid argument to option `--suppress-trace'.",
+ !Errors)
+ ),
+ map__lookup(OptionTable0, dump_hlds_alias, DumpAliasOption),
(
- { DumpAliasOption = string(DumpAlias) },
- { DumpAlias = "" }
+ DumpAliasOption = string(DumpAlias),
+ DumpAlias = ""
->
- postprocess_options_2(OptionTable,
- Target, GC_Method, TagsMethod,
- TermNorm, TraceLevel,
- TraceSuppress, Error)
+ OptionTable = OptionTable0
;
- { DumpAliasOption = string(DumpAlias) },
- { convert_dump_alias(DumpAlias,
- DumpOptions) }
+ DumpAliasOption = string(DumpAlias),
+ convert_dump_alias(DumpAlias, DumpOptions)
->
- { map__set(OptionTable,
- dump_hlds_options,
- string(DumpOptions),
- NewOptionTable) },
- postprocess_options_2(NewOptionTable,
- Target, GC_Method, TagsMethod,
- TermNorm, TraceLevel,
- TraceSuppress, Error)
- ;
- { Error = yes("Invalid argument to option `--hlds-dump-alias'.") }
- )
- ;
- { Error = yes("Invalid argument to option `--suppress-trace'.") }
- )
- ;
- { MaybeTraceLevel = no },
- { Error = yes("Specified trace level is not compatible with grade") }
- )
- ;
- { Error = yes("Invalid argument to option `--trace'\n\t(must be `minimum', `shallow', `deep', `decl', `rep' or `default').") }
- )
- ;
- { Error = yes("Invalid argument to option `--termination-norm'\n\t(must be `simple', `total' or `num-data-elems').") }
- )
- ;
- { Error = yes("Invalid argument to option `--fact-table-hash-percent-full'\n\t(must be an integer between 1 and 100)") }
- )
+ map__set(OptionTable0, dump_hlds_options, string(DumpOptions),
+ OptionTable)
;
- { Error = yes("Invalid tags option (must be `none', `low' or `high')") }
- )
- ;
- { Error = yes("Invalid GC option (must be `none', `conservative', `boehm', `mps', `accurate', or `automatic')") }
- )
- ;
- { Error = yes("Invalid target option (must be `c', `asm', `il', or `java')") }
+ OptionTable = OptionTable0, % dummy
+ add_error("Invalid argument to option `--hlds-dump-alias'.",
+ !Errors)
).
+:- pred add_error(string::in, list(string)::in, list(string)::out) is det.
+
+add_error(Error, Errors0, Errors) :-
+ % We won't be appending enough errors for the quadratic complexity
+ % of repeated appends to be a problem.
+ list__append(Errors0, [Error], Errors).
+
:- pred postprocess_options_2(option_table::in, compilation_target::in,
gc_method::in, tags_method::in, termination_norm::in,
trace_level::in, trace_suppress_items::in, maybe(string)::out,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
postprocess_options_2(OptionTable0, Target, GC_Method, TagsMethod0,
TermNorm, TraceLevel, TraceSuppress, Error) -->
@@ -1356,7 +1386,7 @@
% code generator, because sometimes the same option has different
% meanings and implications in the two backends.
%
-:- pred postprocess_options_lowlevel(io__state::di, io__state::uo) is det.
+:- pred postprocess_options_lowlevel(io::di, io::uo) is det.
postprocess_options_lowlevel -->
% The low level code generator assumes that const(_) rvals are
@@ -1380,7 +1410,7 @@
% If the SourceBoolOption is set to yes, then the ImpliedOption is set
% to ImpliedOptionValue.
:- pred option_implies(option::in, option::in, option_data::in,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
option_implies(SourceOption, ImpliedOption, ImpliedOptionValue) -->
globals__io_lookup_bool_option(SourceOption, SourceOptionValue),
@@ -1395,7 +1425,7 @@
% If the SourceBoolOption is set to no, then the ImpliedOption is set
% to ImpliedOptionValue.
:- pred option_neg_implies(option::in, option::in, option_data::in,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
option_neg_implies(SourceOption, ImpliedOption, ImpliedOptionValue) -->
globals__io_lookup_bool_option(SourceOption, SourceOptionValue),
@@ -1410,7 +1440,7 @@
% If the SourceBoolOption is set to yes, and RequiredOption is not set
% to RequiredOptionValue, then report a usage error.
:- pred option_requires(option::in, option::in, option_data::in,
- string::in, io__state::di, io__state::uo) is det.
+ string::in, io::di, io::uo) is det.
option_requires(SourceOption, RequiredOption, RequiredOptionValue,
ErrorMessage) -->
@@ -1430,19 +1460,18 @@
string::in, io__state::di, io__state::uo) is det.
maybe_disable_smart_recompilation(Smart, ConflictingOption,
- ValueToDisableSmart, OptionDescr) -->
- globals__io_lookup_bool_option(ConflictingOption, Value),
+ ValueToDisableSmart, OptionDescr, !IO) :-
+ globals__io_lookup_bool_option(ConflictingOption, Value, !IO),
(
- { Smart = yes },
- { Value = ValueToDisableSmart }
+ Smart = yes,
+ Value = ValueToDisableSmart
->
- disable_smart_recompilation(OptionDescr)
+ disable_smart_recompilation(OptionDescr, !IO)
;
- []
+ true
).
-:- pred disable_smart_recompilation(string::in,
- io__state::di, io__state::uo) is det.
+:- pred disable_smart_recompilation(string::in, io::di, io::uo) is det.
disable_smart_recompilation(OptionDescr) -->
globals__io_set_option(smart_recompilation, bool(no)),
@@ -1463,45 +1492,48 @@
[]
).
-usage_error(ErrorDescr, ErrorMessage) -->
- write_program_name,
- io__write_string(ErrorDescr),
- io__nl,
- usage_error(ErrorMessage).
-
-usage_error(ErrorMessage) -->
- write_program_name,
- io__write_string(ErrorMessage),
- io__write_string("\n"),
- io__set_exit_status(1),
- usage.
+usage_error(ErrorDescr, ErrorMessage, !IO) :-
+ write_program_name(!IO),
+ io__write_string(ErrorDescr, !IO),
+ io__nl(!IO),
+ usage_error(ErrorMessage, !IO).
+
+usage_error(ErrorMessage, !IO) :-
+ write_program_name(!IO),
+ io__write_string(ErrorMessage, !IO),
+ io__write_string("\n", !IO),
+ io__set_exit_status(1, !IO),
+ usage(!IO).
:- pred write_program_name(io__state::di, io__state::uo) is det.
-write_program_name -->
- io__progname_base("mercury_compile", ProgName),
- io__write_string(ProgName),
- io__write_string(": ").
+write_program_name(!IO) :-
+ io__progname_base("mercury_compile", ProgName, !IO),
+ io__write_string(ProgName, !IO),
+ io__write_string(": ", !IO).
-usage -->
- { library__version(Version) },
+usage(!IO) :-
+ library__version(Version),
io__write_strings([
"Mercury Compiler, version ", Version, "\n",
"Copyright (C) 1993-2004 The University of Melbourne\n",
"Usage: mmc [<options>] <arguments>\n",
"Use `mmc --help' for more information.\n"
- ]).
+ ], !IO).
-long_usage -->
- { library__version(Version) },
- io__write_strings(["Mercury Compiler, version ", Version, "\n"]),
- io__write_string("Copyright (C) 1993-2004 The University of Melbourne\n"),
- io__write_string("Usage: mmc [<options>] <arguments>\n"),
- io__write_string("Arguments:\n"),
- io__write_string("\tArguments ending in `.m' are assumed to be source file names.\n"),
- io__write_string("\tArguments that do not end in `.m' are assumed to be module names.\n"),
- io__write_string("Options:\n"),
- options_help.
+long_usage(!IO) :-
+ library__version(Version),
+ io__write_strings(["Mercury Compiler, version ", Version, "\n"], !IO),
+ io__write_string("Copyright (C) 1993-2004 " ++
+ "The University of Melbourne\n", !IO),
+ io__write_string("Usage: mmc [<options>] <arguments>\n", !IO),
+ io__write_string("Arguments:\n", !IO),
+ io__write_string("\tArguments ending in `.m' " ++
+ "are assumed to be source file names.\n", !IO),
+ io__write_string("\tArguments that do not end in `.m' " ++
+ "are assumed to be module names.\n", !IO),
+ io__write_string("Options:\n", !IO),
+ options_help(!IO).
%-----------------------------------------------------------------------------%
@@ -1565,9 +1597,8 @@
)
), Components, Options1, Options, NoComps, _FinalComps).
-:- pred add_option_list(list(pair(option, option_data)), option_table,
- option_table).
-:- mode add_option_list(in, in, out) is det.
+:- pred add_option_list(list(pair(option, option_data))::in, option_table::in,
+ option_table::out) is det.
add_option_list(CompOpts, Opts0, Opts) :-
list__foldl((pred(Opt::in, Opts1::in, Opts2::out) is det :-
@@ -1583,10 +1614,8 @@
% implied by the file names (.pic_o vs .o, `.a' vs `.so').
%
(
- string__sub_string_search(Grade0,
- ".picreg", PicRegIndex),
- string__split(Grade0, PicRegIndex,
- LeftPart, RightPart0),
+ string__sub_string_search(Grade0, ".picreg", PicRegIndex),
+ string__split(Grade0, PicRegIndex, LeftPart, RightPart0),
string__append(".picreg", RightPart, RightPart0)
->
Grade = LeftPart ++ RightPart
@@ -1605,8 +1634,8 @@
construct_string(Components, Grade)
).
-:- pred construct_string(list(pair(grade_component, string)), string).
-:- mode construct_string(in, out) is det.
+:- pred construct_string(list(pair(grade_component, string))::in, string::out)
+ is det.
construct_string([], "").
construct_string([_ - Bit|Bits], Grade) :-
@@ -1619,9 +1648,8 @@
Grade = Bit
).
-:- pred compute_grade_components(option_table,
- list(pair(grade_component, string))).
-:- mode compute_grade_components(in, out) is det.
+:- pred compute_grade_components(option_table::in,
+ list(pair(grade_component, string))::out) is det.
compute_grade_components(Options, GradeComponents) :-
solutions((pred(CompData::out) is nondet :-
@@ -1828,8 +1856,7 @@
[stack_trace - bool(yes), require_tracing - bool(no),
decl_debug - bool(no)], no).
-:- pred reset_grade_options(option_table, option_table).
-:- mode reset_grade_options(in, out) is det.
+:- pred reset_grade_options(option_table::in, option_table::out) is det.
reset_grade_options(Options0, Options) :-
aggregate(grade_start_values,
@@ -1868,8 +1895,7 @@
string__to_char_list(GradeStr, Chars),
split_grade_string_2(Chars, Components).
-:- pred split_grade_string_2(list(char), list(string)).
-:- mode split_grade_string_2(in, out) is semidet.
+:- pred split_grade_string_2(list(char)::in, list(string)::out) is semidet.
split_grade_string_2([], []).
split_grade_string_2(Chars, Components) :-
@@ -1885,8 +1911,7 @@
RestComponents = []
).
-:- pred char_is_not(char, char).
-:- mode char_is_not(in, in) is semidet.
+:- pred char_is_not(char::in, char::in) is semidet.
char_is_not(A, B) :-
A \= B.
@@ -1901,8 +1926,7 @@
%
% You are welcome to add more aliases.
-:- pred convert_dump_alias(string, string).
-:- mode convert_dump_alias(in, out) is semidet.
+:- pred convert_dump_alias(string::in, string::out) is semidet.
convert_dump_alias("ALL", "abcdfgilmnprstuvCDIMPTU").
convert_dump_alias("all", "abcdfgilmnprstuvCMPT").
Index: compiler/hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds.m,v
retrieving revision 1.211
diff -u -b -r1.211 hlds.m
--- compiler/hlds.m 5 Jun 2003 04:16:20 -0000 1.211
+++ compiler/hlds.m 15 Mar 2004 11:02:36 -0000
@@ -41,10 +41,10 @@
:- include_module hlds_out.
% Miscellaneous utilities.
-:- include_module error_util.
:- include_module goal_form.
:- include_module goal_util.
:- include_module hlds_code_util.
+:- include_module hlds_error_util.
:- include_module passes_aux.
%-----------------------------------------------------------------------------%
Index: compiler/hlds_error_util.m
===================================================================
RCS file: compiler/hlds_error_util.m
diff -N compiler/hlds_error_util.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/hlds_error_util.m 15 Mar 2004 12:14:13 -0000
@@ -0,0 +1,119 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 1997-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.
+%-----------------------------------------------------------------------------%
+%
+% error_util.m
+% Main author: zs.
+%
+% This module contains code that can be helpful in the formatting of
+% error messages. It builds upon parse_tree__error_util, and extends it
+% with predicates that access HLDS data structures.
+%
+%-----------------------------------------------------------------------------%
+
+:- module hlds__hlds_error_util.
+
+:- interface.
+
+:- import_module hlds__hlds_module.
+:- import_module hlds__hlds_pred.
+:- import_module parse_tree__prog_data.
+:- import_module parse_tree__error_util.
+
+:- import_module assoc_list, list, std_util.
+
+ % Predicates to convert a predicate names to strings.
+
+:- pred describe_one_pred_name(module_info::in, pred_id::in,
+ string::out) is det.
+
+:- pred describe_several_pred_names(module_info::in,
+ list(pred_id)::in, list(format_component)::out) is det.
+
+:- pred describe_one_proc_name(module_info::in, pred_proc_id::in,
+ string::out) is det.
+
+:- pred describe_several_proc_names(module_info::in,
+ list(pred_proc_id)::in, list(format_component)::out) is det.
+
+:- pred describe_one_call_site(module_info::in,
+ pair(pred_proc_id, prog_context)::in, string::out) is det.
+
+:- pred describe_several_call_sites(module_info::in,
+ assoc_list(pred_proc_id, prog_context)::in,
+ list(format_component)::out) is det.
+
+:- implementation.
+
+:- import_module parse_tree__prog_out.
+:- import_module parse_tree__prog_util.
+
+:- import_module string, list, term.
+
+%-----------------------------------------------------------------------------%
+
+ % The code of this predicate duplicates the functionality of
+ % hlds_out__write_pred_id. Changes here should be made there as well.
+
+describe_one_pred_name(Module, PredId, Piece) :-
+ module_info_pred_info(Module, PredId, PredInfo),
+ ModuleName = pred_info_module(PredInfo),
+ prog_out__sym_name_to_string(ModuleName, ModuleNameString),
+ PredName = pred_info_name(PredInfo),
+ Arity = pred_info_arity(PredInfo),
+ PredOrFunc = pred_info_is_pred_or_func(PredInfo),
+ PredOrFuncPart = pred_or_func_to_string(PredOrFunc),
+ adjust_func_arity(PredOrFunc, OrigArity, Arity),
+ (
+ pred_info_get_goal_type(PredInfo, promise(PromiseType))
+ ->
+ Piece = "`" ++ promise_to_string(PromiseType) ++ "' declaration"
+ ;
+ string__int_to_string(OrigArity, ArityPart),
+ string__append_list([
+ PredOrFuncPart,
+ " `",
+ ModuleNameString,
+ ".",
+ PredName,
+ "/",
+ ArityPart,
+ "'"], Piece)
+ ).
+
+describe_several_pred_names(Module, PredId, Pieces) :-
+ list__map(describe_one_pred_name(Module), PredId, Pieces0),
+ list_to_pieces(Pieces0, Pieces).
+
+describe_one_proc_name(Module, proc(PredId, ProcId), Piece) :-
+ describe_one_pred_name(Module, PredId, PredPiece),
+ proc_id_to_int(ProcId, ProcIdInt),
+ string__int_to_string(ProcIdInt, ProcIdPart),
+ string__append_list([
+ PredPiece,
+ " mode ",
+ ProcIdPart
+ ], Piece).
+
+describe_several_proc_names(Module, PPIds, Pieces) :-
+ list__map(describe_one_proc_name(Module), PPIds, Pieces0),
+ list_to_pieces(Pieces0, Pieces).
+
+describe_one_call_site(Module, PPId - Context, Piece) :-
+ describe_one_proc_name(Module, PPId, ProcName),
+ term__context_file(Context, FileName),
+ term__context_line(Context, LineNumber),
+ string__int_to_string(LineNumber, LineNumberPart),
+ string__append_list([
+ ProcName,
+ " at ",
+ FileName,
+ ":",
+ LineNumberPart
+ ], Piece).
+
+describe_several_call_sites(Module, Sites, Pieces) :-
+ list__map(describe_one_call_site(Module), Sites, Pieces0),
+ list_to_pieces(Pieces0, Pieces).
Index: compiler/ilasm.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ilasm.m,v
retrieving revision 1.36
diff -u -b -r1.36 ilasm.m
--- compiler/ilasm.m 15 Mar 2003 03:08:52 -0000 1.36
+++ compiler/ilasm.m 16 Mar 2004 05:43:35 -0000
@@ -273,9 +273,9 @@
:- implementation.
:- import_module backend_libs__c_util. % for output_float_literal
-:- import_module hlds__error_util.
:- import_module libs__globals.
:- import_module libs__options.
+:- import_module parse_tree__error_util.
:- import_module char, string, pprint, getopt.
:- import_module require, int, term_io, varset, bool.
Index: compiler/ilds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ilds.m,v
retrieving revision 1.16
diff -u -b -r1.16 ilds.m
--- compiler/ilds.m 15 Mar 2003 03:08:52 -0000 1.16
+++ compiler/ilds.m 15 Mar 2004 11:16:26 -0000
@@ -386,7 +386,7 @@
:- implementation.
-:- import_module hlds__error_util.
+:- import_module parse_tree__error_util.
:- import_module int, require.
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.156
diff -u -b -r1.156 intermod.m
--- compiler/intermod.m 1 Jan 2004 05:57:09 -0000 1.156
+++ compiler/intermod.m 18 Mar 2004 09:28:41 -0000
@@ -2303,7 +2303,7 @@
make_pseudo_decl(opt_imported),
[], NewIndirectDeps, [], NewImplIndirectDeps,
Module3, Module4),
- process_module_short_interfaces_and_implementations_transitively(
+ process_module_short_interfaces_and_impls_transitively(
ReadModules, NewIndirectDeps ++ NewImplIndirectDeps,
".int2",
make_pseudo_decl(opt_imported),
Index: compiler/java_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/java_util.m,v
retrieving revision 1.9
diff -u -b -r1.9 java_util.m
--- compiler/java_util.m 28 Mar 2003 06:04:09 -0000 1.9
+++ compiler/java_util.m 15 Mar 2004 11:16:26 -0000
@@ -74,7 +74,7 @@
:- implementation.
-:- import_module hlds__error_util.
+:- import_module parse_tree__error_util.
:- import_module list.
Index: compiler/loop_inv.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/loop_inv.m,v
retrieving revision 1.7
diff -u -b -r1.7 loop_inv.m
--- compiler/loop_inv.m 10 Feb 2004 09:33:00 -0000 1.7
+++ compiler/loop_inv.m 16 Mar 2004 05:44:14 -0000
@@ -124,11 +124,11 @@
:- import_module check_hlds__inst_match.
:- import_module check_hlds__mode_util.
:- import_module check_hlds__purity.
-:- import_module hlds__error_util.
-:- import_module hlds__hlds_goal.
:- import_module hlds__hlds_data.
+:- import_module hlds__hlds_goal.
:- import_module hlds__instmap.
:- import_module hlds__quantification.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__inst.
:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_util.
Index: compiler/magic_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/magic_util.m,v
retrieving revision 1.36
diff -u -b -r1.36 magic_util.m
--- compiler/magic_util.m 1 Dec 2003 15:55:39 -0000 1.36
+++ compiler/magic_util.m 15 Mar 2004 23:32:50 -0000
@@ -125,12 +125,13 @@
:- import_module check_hlds__mode_util.
:- import_module check_hlds__polymorphism.
:- import_module check_hlds__type_util.
-:- import_module hlds__error_util.
:- import_module hlds__goal_util.
:- import_module hlds__hlds_data.
+:- import_module hlds__hlds_error_util.
:- import_module hlds__hlds_out.
:- import_module hlds__instmap.
:- import_module parse_tree__inst.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__prog_out.
:- import_module parse_tree__prog_util.
@@ -1757,7 +1758,7 @@
magic_util__report_error(ModuleInfo, Verbose,
argument_error(Error, Arg, proc(PredId, _)) - Context) -->
- { error_util__describe_one_pred_name(ModuleInfo, PredId, PredName) },
+ { describe_one_pred_name(ModuleInfo, PredId, PredName) },
{ string__append_list(["In Aditi ", PredName, ":"], PredNamePiece) },
{ magic_util__error_arg_id_piece(Arg, ArgPiece) },
{ magic_util__report_argument_error(Context, Error, ArgPiece,
@@ -1766,7 +1767,7 @@
magic_util__report_error(ModuleInfo, _Verbose,
nonspecific_polymorphism(proc(PredId, _), _) - Context) -->
- { error_util__describe_one_pred_name(ModuleInfo, PredId, PredName) },
+ { describe_one_pred_name(ModuleInfo, PredId, PredName) },
{ string__append_list(["In ", PredName, ":"], PredNamePiece) },
{ SecondPart = [words("the code uses polymorphism or type-classes"),
words("which are not supported by Aditi.")] },
@@ -1774,7 +1775,7 @@
magic_util__report_error(ModuleInfo, _Verbose,
curried_argument(proc(PredId, _)) - Context) -->
- { error_util__describe_one_pred_name(ModuleInfo, PredId, PredName) },
+ { describe_one_pred_name(ModuleInfo, PredId, PredName) },
{ string__append_list(["In ", PredName, ":"], PredNamePiece) },
{ SecondPart = [words("sorry, curried closure arguments are not"),
words("implemented for Aditi procedures."),
@@ -1784,7 +1785,7 @@
magic_util__report_error(ModuleInfo, _Verbose,
non_removeable_aditi_state(proc(PredId, _), VarSet, Vars)
- Context) -->
- { error_util__describe_one_pred_name(ModuleInfo, PredId, PredName) },
+ { describe_one_pred_name(ModuleInfo, PredId, PredName) },
{ string__append_list(["In ", PredName, ":"], PredNamePiece) },
{ Vars = [_] ->
VarPiece = words("variable"),
@@ -1801,7 +1802,7 @@
magic_util__report_error(ModuleInfo, Verbose,
context_error(Error, proc(PredId, _ProcId)) - Context) -->
- { error_util__describe_one_pred_name(ModuleInfo, PredId, PredName) },
+ { describe_one_pred_name(ModuleInfo, PredId, PredName) },
{ string__append_list(["In ", PredName, ":"], PredNamePiece) },
{ SecondPart = [words("with `:- pragma context(...)' declaration:"),
nl, words("error: recursive rule is not linear.\n")] },
@@ -1814,9 +1815,9 @@
magic_util__report_error(ModuleInfo, _Verbose,
mutually_recursive_context(PredProcId,
OtherPredProcIds) - Context) -->
- { error_util__describe_one_proc_name(ModuleInfo,
+ { describe_one_proc_name(ModuleInfo,
PredProcId, ProcPiece) },
- { error_util__describe_several_proc_names(ModuleInfo,
+ { describe_several_proc_names(ModuleInfo,
OtherPredProcIds, OtherProcPieces) },
{ list__condense(
[[words("Error: procedure"), words(ProcPiece), words("with a"),
@@ -1827,7 +1828,7 @@
magic_util__report_error(ModuleInfo, _Verbose,
mixed_scc(PredProcIds) - Context) -->
- { error_util__describe_several_proc_names(ModuleInfo,
+ { describe_several_proc_names(ModuleInfo,
PredProcIds, SCCPieces) },
{ list__condense([
[words("In the strongly connected component consisting of")],
Index: compiler/make.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make.m,v
retrieving revision 1.19
diff -u -b -r1.19 make.m
--- compiler/make.m 24 Sep 2003 06:35:26 -0000 1.19
+++ compiler/make.m 16 Mar 2004 05:44:21 -0000
@@ -61,12 +61,12 @@
:- import_module backend_libs__compile_target_code.
:- import_module backend_libs__foreign.
-:- import_module hlds__error_util.
:- import_module libs__globals.
:- import_module libs__handle_options.
:- import_module libs__options.
:- import_module libs__process_util.
:- import_module libs__timestamp.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__mercury_to_mercury.
:- import_module parse_tree__modules.
:- import_module parse_tree__prog_data.
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.460
diff -u -b -r1.460 make_hlds.m
--- compiler/make_hlds.m 8 Mar 2004 02:26:32 -0000 1.460
+++ compiler/make_hlds.m 16 Mar 2004 05:44:29 -0000
@@ -104,10 +104,9 @@
:- import_module check_hlds__mode_errors.
:- import_module check_hlds__mode_util.
:- import_module check_hlds__purity.
-:- import_module check_hlds__type_util.
:- import_module check_hlds__typecheck.
+:- import_module check_hlds__type_util.
:- import_module check_hlds__unify_proc.
-:- import_module hlds__error_util.
:- import_module hlds__goal_util.
:- import_module hlds__hlds_code_util.
:- import_module hlds__hlds_goal.
@@ -120,6 +119,7 @@
:- import_module ll_backend.
:- import_module ll_backend__fact_table.
:- import_module ll_backend__llds.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__inst.
:- import_module parse_tree__mercury_to_mercury.
:- import_module parse_tree__module_qual.
Index: compiler/make_tags.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_tags.m,v
retrieving revision 1.42
diff -u -b -r1.42 make_tags.m
--- compiler/make_tags.m 21 Dec 2003 05:04:35 -0000 1.42
+++ compiler/make_tags.m 16 Mar 2004 05:45:04 -0000
@@ -81,9 +81,9 @@
:- implementation.
:- import_module check_hlds__type_util.
-:- import_module hlds__error_util.
:- import_module libs__globals.
:- import_module libs__options.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__prog_util.
:- import_module int, map, std_util, require.
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.302
diff -u -b -r1.302 mercury_compile.m
--- compiler/mercury_compile.m 10 Feb 2004 10:10:02 -0000 1.302
+++ compiler/mercury_compile.m 16 Mar 2004 05:45:14 -0000
@@ -134,7 +134,6 @@
:- import_module backend_libs__compile_target_code.
:- import_module backend_libs__name_mangle.
:- import_module check_hlds__goal_path.
-:- import_module hlds__error_util.
:- import_module hlds__hlds_data.
:- import_module hlds__hlds_module.
:- import_module hlds__hlds_out.
@@ -149,6 +148,7 @@
:- import_module make.
:- import_module make__options_file.
:- import_module make__util.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__mercury_to_mercury.
:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_util.
Index: compiler/ml_call_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_call_gen.m,v
retrieving revision 1.44
diff -u -b -r1.44 ml_call_gen.m
--- compiler/ml_call_gen.m 20 Feb 2004 02:39:56 -0000 1.44
+++ compiler/ml_call_gen.m 16 Mar 2004 05:45:22 -0000
@@ -125,12 +125,12 @@
:- import_module backend_libs__builtin_ops.
:- import_module check_hlds__mode_util.
:- import_module check_hlds__type_util.
-:- import_module hlds__error_util.
:- import_module hlds__hlds_data.
:- import_module hlds__hlds_module.
:- import_module libs__globals.
:- import_module libs__options.
:- import_module ml_backend__ml_closure_gen.
+:- import_module parse_tree__error_util.
:- import_module bool, int, string, std_util, term, varset, require, map.
Index: compiler/ml_closure_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_closure_gen.m,v
retrieving revision 1.25
diff -u -b -r1.25 ml_closure_gen.m
--- compiler/ml_closure_gen.m 20 Feb 2004 02:39:56 -0000 1.25
+++ compiler/ml_closure_gen.m 16 Mar 2004 05:45:18 -0000
@@ -83,10 +83,10 @@
:- import_module backend_libs__rtti.
:- import_module check_hlds__mode_util.
:- import_module check_hlds__type_util.
-:- import_module hlds__error_util.
:- import_module hlds__hlds_module.
:- import_module libs__globals.
:- import_module libs__options.
+:- import_module parse_tree__error_util.
% XXX The following modules depend on the LLDS,
% so ideally they should not be used here.
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.135
diff -u -b -r1.135 ml_code_gen.m
--- compiler/ml_code_gen.m 20 Feb 2004 02:39:56 -0000 1.135
+++ compiler/ml_code_gen.m 16 Mar 2004 05:45:42 -0000
@@ -784,7 +784,6 @@
:- import_module backend_libs__foreign. % XXX needed for pragma foreign code
:- import_module check_hlds__mode_util.
:- import_module check_hlds__type_util.
-:- import_module hlds__error_util.
:- import_module hlds__goal_util.
:- import_module hlds__hlds_data.
:- import_module hlds__hlds_pred.
@@ -796,6 +795,7 @@
:- import_module ml_backend__ml_switch_gen.
:- import_module ml_backend__ml_type_gen.
:- import_module ml_backend__ml_unify_gen.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__modules.
:- import_module parse_tree__prog_util.
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.77
diff -u -b -r1.77 ml_code_util.m
--- compiler/ml_code_util.m 20 Feb 2004 02:39:56 -0000 1.77
+++ compiler/ml_code_util.m 16 Mar 2004 05:45:45 -0000
@@ -745,7 +745,6 @@
:- import_module check_hlds__mode_util.
:- import_module check_hlds__polymorphism.
:- import_module check_hlds__type_util.
-:- import_module hlds__error_util.
:- import_module hlds__hlds_goal.
:- import_module hlds__instmap.
:- import_module hlds__special_pred.
@@ -753,6 +752,7 @@
:- import_module libs__options.
:- import_module ml_backend__ml_call_gen.
:- import_module ml_backend__ml_code_gen.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__inst.
:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_io.
Index: compiler/ml_optimize.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_optimize.m,v
retrieving revision 1.25
diff -u -b -r1.25 ml_optimize.m
--- compiler/ml_optimize.m 1 Mar 2004 12:34:30 -0000 1.25
+++ compiler/ml_optimize.m 16 Mar 2004 05:46:07 -0000
@@ -43,11 +43,11 @@
:- implementation.
:- import_module backend_libs__builtin_ops.
-:- import_module hlds__error_util.
:- import_module libs__globals.
:- import_module libs__options.
:- import_module ml_backend__ml_code_util.
:- import_module ml_backend__ml_util.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_util.
Index: compiler/ml_tailcall.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_tailcall.m,v
retrieving revision 1.20
diff -u -b -r1.20 ml_tailcall.m
--- compiler/ml_tailcall.m 20 Feb 2004 02:39:57 -0000 1.20
+++ compiler/ml_tailcall.m 16 Mar 2004 05:46:14 -0000
@@ -76,10 +76,10 @@
:- implementation.
-:- import_module hlds__error_util.
:- import_module hlds__hlds_out.
:- import_module hlds__hlds_pred.
:- import_module ml_backend__ml_util.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__prog_data.
:- import_module string, int, list, std_util.
Index: compiler/ml_type_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_type_gen.m,v
retrieving revision 1.35
diff -u -b -r1.35 ml_type_gen.m
--- compiler/ml_type_gen.m 20 Feb 2004 02:39:58 -0000 1.35
+++ compiler/ml_type_gen.m 16 Mar 2004 05:46:17 -0000
@@ -79,12 +79,12 @@
:- import_module check_hlds__polymorphism.
:- import_module check_hlds__type_util.
-:- import_module hlds__error_util.
:- import_module hlds__hlds_pred.
:- import_module libs__globals.
:- import_module libs__options.
:- import_module ml_backend__ml_code_util.
:- import_module ml_backend__ml_util.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_util.
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.70
diff -u -b -r1.70 ml_unify_gen.m
--- compiler/ml_unify_gen.m 20 Feb 2004 02:39:58 -0000 1.70
+++ compiler/ml_unify_gen.m 16 Mar 2004 05:46:57 -0000
@@ -87,7 +87,6 @@
:- import_module backend_libs__rtti.
:- import_module check_hlds__mode_util.
:- import_module check_hlds__type_util.
-:- import_module hlds__error_util.
:- import_module hlds__hlds_code_util.
:- import_module hlds__hlds_out.
:- import_module hlds__hlds_pred.
@@ -98,6 +97,7 @@
:- import_module ml_backend__ml_code_gen.
:- import_module ml_backend__ml_type_gen.
:- import_module ml_backend__ml_util.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__prog_util.
:- import_module int, string, map, require, term, varset.
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.109
diff -u -b -r1.109 mlds.m
--- compiler/mlds.m 26 Feb 2004 06:36:21 -0000 1.109
+++ compiler/mlds.m 16 Mar 2004 05:47:04 -0000
@@ -1712,9 +1712,9 @@
:- implementation.
:- import_module backend_libs__foreign.
-:- import_module hlds__error_util.
:- import_module hlds__hlds_data.
:- import_module libs__globals.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__modules.
:- import_module int, term, string, require.
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.160
diff -u -b -r1.160 mlds_to_c.m
--- compiler/mlds_to_c.m 20 Feb 2004 02:20:04 -0000 1.160
+++ compiler/mlds_to_c.m 16 Mar 2004 05:47:15 -0000
@@ -70,7 +70,6 @@
:- import_module backend_libs__name_mangle.
:- import_module backend_libs__rtti. % for rtti__addr_to_string.
:- import_module check_hlds__type_util.
-:- import_module hlds__error_util.
:- import_module hlds__hlds_pred. % for pred_proc_id.
:- import_module hlds__passes_aux.
:- import_module libs__globals.
@@ -81,6 +80,7 @@
:- import_module ml_backend__ml_type_gen. % for ml_gen_type_name
:- import_module ml_backend__ml_util.
:- import_module ml_backend__rtti_to_mlds. % for mlds_rtti_type_name.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__modules.
:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_out.
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.93
diff -u -b -r1.93 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 20 Feb 2004 02:20:05 -0000 1.93
+++ compiler/mlds_to_gcc.m 16 Mar 2004 05:47:21 -0000
@@ -164,7 +164,6 @@
:- import_module backend_libs__pseudo_type_info.
:- import_module backend_libs__rtti. % for rtti__addr_to_string.
:- import_module check_hlds__type_util.
-:- import_module hlds__error_util.
:- import_module hlds__hlds_pred. % for proc_id_to_int and invalid_pred_id
:- import_module hlds__passes_aux.
:- import_module libs__globals.
@@ -174,6 +173,7 @@
% derived classes
:- import_module ml_backend__ml_util.
:- import_module ml_backend__mlds_to_c. % to handle C foreign_code
+:- import_module parse_tree__error_util.
:- import_module parse_tree__modules.
:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_out.
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.138
diff -u -b -r1.138 mlds_to_il.m
--- compiler/mlds_to_il.m 3 Dec 2003 08:22:24 -0000 1.138
+++ compiler/mlds_to_il.m 16 Mar 2004 05:47:27 -0000
@@ -142,7 +142,6 @@
:- import_module backend_libs__pseudo_type_info.
:- import_module backend_libs__rtti.
:- import_module check_hlds__type_util.
-:- import_module hlds__error_util.
:- import_module hlds__passes_aux.
:- import_module libs__globals.
:- import_module libs__options.
@@ -151,6 +150,7 @@
:- import_module ml_backend__ml_code_util.
:- import_module ml_backend__ml_type_gen.
:- import_module ml_backend__ml_util.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__modules.
:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_out.
Index: compiler/mlds_to_ilasm.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_ilasm.m,v
retrieving revision 1.22
diff -u -b -r1.22 mlds_to_ilasm.m
--- compiler/mlds_to_ilasm.m 12 Nov 2003 16:15:53 -0000 1.22
+++ compiler/mlds_to_ilasm.m 16 Mar 2004 05:47:35 -0000
@@ -34,7 +34,6 @@
:- import_module backend_libs__foreign.
:- import_module backend_libs__rtti.
:- import_module check_hlds__type_util.
-:- import_module hlds__error_util.
:- import_module hlds__hlds_pred. % for `pred_proc_id'.
:- import_module hlds__passes_aux.
:- import_module libs__globals.
@@ -46,6 +45,7 @@
:- import_module ml_backend__ml_code_util.
:- import_module ml_backend__ml_util.
:- import_module ml_backend__mlds_to_managed.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__modules.
:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_out.
Index: compiler/mlds_to_java.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_java.m,v
retrieving revision 1.56
diff -u -b -r1.56 mlds_to_java.m
--- compiler/mlds_to_java.m 18 Mar 2004 04:13:17 -0000 1.56
+++ compiler/mlds_to_java.m 19 Mar 2004 09:44:15 -0000
@@ -97,7 +97,6 @@
:- import_module backend_libs__name_mangle.
:- import_module backend_libs__rtti.
:- import_module check_hlds__type_util.
-:- import_module hlds__error_util.
:- import_module hlds__hlds_pred. % for pred_proc_id.
:- import_module hlds__passes_aux.
:- import_module libs__globals.
@@ -107,6 +106,7 @@
:- import_module ml_backend__ml_type_gen. % for ml_gen_type_name
:- import_module ml_backend__ml_util.
:- import_module ml_backend__rtti_to_mlds. % for mlds_rtti_type_name.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__modules. % for mercury_std_library_name.
:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_out.
Index: compiler/mlds_to_managed.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_managed.m,v
retrieving revision 1.10
diff -u -b -r1.10 mlds_to_managed.m
--- compiler/mlds_to_managed.m 13 Nov 2003 15:08:03 -0000 1.10
+++ compiler/mlds_to_managed.m 16 Mar 2004 05:47:51 -0000
@@ -44,18 +44,18 @@
:- import_module backend_libs__foreign.
:- import_module backend_libs__rtti.
:- import_module check_hlds__type_util.
-:- import_module hlds__error_util.
:- import_module hlds__hlds_pred. % for `pred_proc_id'.
:- import_module hlds__passes_aux.
:- import_module libs__globals.
:- import_module libs__options.
:- import_module libs__tree.
-:- import_module ml_backend__il_peephole.
:- import_module ml_backend__ilasm.
:- import_module ml_backend__ilds.
+:- import_module ml_backend__il_peephole.
:- import_module ml_backend__ml_code_util.
-:- import_module ml_backend__ml_util.
:- import_module ml_backend__mlds_to_il.
+:- import_module ml_backend__ml_util.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__modules.
:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_out.
--------------------------------------------------------------------------
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