[m-rev.] diff: cleanups of purity.m, hlds_out.m and llds_out.m
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Jan 17 15:40:20 AEDT 2005
compiler/hlds_out.m:
compiler/llds_out.m:
Bring these modules up to date with our current style guidelines.
Use state variables in the few places where we weren't doing so
already.
compiler/purity.m:
Bring this module up to date with our current style guidelines.
Use the predicates of error_util and hlds_error_util to print error
messages. Be more consistent in using quotations. Fix indentation.
compiler/error_util.m:
Add a long needed facility: the ability to glue some punctuation
at the end of a previous word.
Add a mechanism for turning a list of components into a string,
instead of printing them out.
Make the interface of this module more consistent by making
list_to_pieces a function just like component_lists_to_pieces.
compiler/hlds_error_util.m:
Change the way we describe predicates and procedures. Instead of
returning their descriptions as single fixed strings that error_util
can't break up across lines, return them as separate components that
can be split across lines. This makes error output look nicer.
Fix a mismatch between what were supposed to be corresponding pieces
of code in hlds_error_util and hlds_out.
Turn the appropriate predicates into functions.
compiler/*.m:
Conform to the changed interfaces of some of the above modules.
tests/invalid/*.err_exp:
tests/invalid/purity/*.err_exp:
tests/recompilation/*.err_exp:
tests/warnings/*.exp:
Update the expected outputs for the better looking error messages we
now generate.
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.33
diff -u -b -r1.33 accumulator.m
--- compiler/accumulator.m 20 Jul 2004 16:06:36 -0000 1.33
+++ compiler/accumulator.m 15 Jan 2005 11:55:59 -0000
@@ -245,12 +245,12 @@
->
true
;
- describe_one_pred_name(!.ModuleInfo,
- should_module_qualify, PredId, PredName),
+ PredPieces = describe_one_pred_name(!.ModuleInfo,
+ should_module_qualify, PredId),
pred_info_context(PredInfo, Context),
error_util__write_error_pieces(Context, 0,
- [words("In"), words(PredName)], !IO),
+ [words("In") | PredPieces], !IO),
proc_info_varset(!.ProcInfo, VarSet),
output_warnings(Warnings, VarSet, !.ModuleInfo, !IO),
@@ -332,16 +332,16 @@
output_warning(warn(Context, PredId, VarA, VarB), VarSet, ModuleInfo,
Context, Formats) :-
- describe_one_pred_name(ModuleInfo, should_module_qualify, PredId,
- PredStr),
+ PredPieces = describe_one_pred_name(ModuleInfo, should_module_qualify,
+ PredId),
varset__lookup_name(VarSet, VarA, VarAStr0),
varset__lookup_name(VarSet, VarB, VarBStr0),
VarAStr = string__append_list(["`", VarAStr0, "'"]),
VarBStr = string__append_list(["`", VarBStr0, "'"]),
- Formats = [words("warning: the call to"), words(PredStr),
- words("has had the location of the variables"),
+ Formats = [words("warning: the call to")] ++ PredPieces ++
+ [words("has had the location of the variables"),
words(VarAStr), words("and"), words(VarBStr),
words("swapped to allow accumulator introduction.")
].
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.58
diff -u -b -r1.58 check_typeclass.m
--- compiler/check_typeclass.m 20 May 2004 22:18:30 -0000 1.58
+++ compiler/check_typeclass.m 16 Jan 2005 03:43:23 -0000
@@ -317,8 +317,7 @@
ErrorMsgStart),
BogusInstanceMethodNames = list__map(format_method_name,
BogusInstanceMethods),
- error_util__list_to_pieces(BogusInstanceMethodNames,
- ErrorMsgBody0),
+ ErrorMsgBody0 = list_to_pieces(BogusInstanceMethodNames),
ErrorMsgBody = list__append(ErrorMsgBody0, [words(".")]),
NewError = Context - [words(ErrorMsgStart) | ErrorMsgBody],
!:Errors = [NewError | !.Errors]
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.92
diff -u -b -r1.92 dead_proc_elim.m
--- compiler/dead_proc_elim.m 14 Jun 2004 04:16:00 -0000 1.92
+++ compiler/dead_proc_elim.m 15 Jan 2005 11:56:28 -0000
@@ -676,10 +676,10 @@
module_info::in, io::di, io::uo) is det.
warn_dead_proc(PredId, ProcId, Context, ModuleInfo, !IO) :-
- describe_one_proc_name(ModuleInfo, should_not_module_qualify,
- proc(PredId, ProcId), ProcName),
- Components = [words("Warning:"), fixed(ProcName),
- words("is never called.")],
+ ProcPieces = describe_one_proc_name(ModuleInfo,
+ should_not_module_qualify, proc(PredId, ProcId)),
+ Components = [words("Warning:")] ++ ProcPieces ++
+ [words("is never called.")],
error_util__report_warning(Context, 0, Components, !IO).
:- pred dead_proc_elim__eliminate_base_gen_infos(list(type_ctor_gen_info)::in,
Index: compiler/det_report.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_report.m,v
retrieving revision 1.93
diff -u -b -r1.93 det_report.m
--- compiler/det_report.m 6 Jan 2005 04:30:54 -0000 1.93
+++ compiler/det_report.m 16 Jan 2005 03:43:41 -0000
@@ -280,7 +280,7 @@
VerboseErrors = yes,
solutions(get_valid_dets(EvalMethod), Detisms),
DetismStrs = list__map(determinism_to_string, Detisms),
- list_to_pieces(DetismStrs, DetismPieces),
+ DetismPieces = list_to_pieces(DetismStrs),
write_error_pieces_not_first_line(Context, 0,
[words("The pragma requested is only valid"),
words("for the following determinism(s):") |
@@ -370,23 +370,24 @@
% ... then it is an error.
proc_info_context(ProcInfo, FuncContext),
proc_info_inst_varset(ProcInfo, InstVarSet),
- describe_one_pred_name_mode(!.ModuleInfo,
+ PredModePieces = describe_one_pred_name_mode(!.ModuleInfo,
should_not_module_qualify, PredId, InstVarSet,
- PredArgModes, PredModeDesc),
- Pieces = [words("Error: invalid determinism for"),
- fixed(PredModeDesc ++ ":"), nl,
- words("the primary mode of a function cannot be `" ++
- mercury_det_to_string(InferredDetism) ++
+ PredArgModes),
+ Pieces = [words("Error: invalid determinism for")]
+ ++ PredModePieces ++ [suffix(":"), nl,
+ words("the primary mode of a function cannot be"),
+ words("`" ++ mercury_det_to_string(InferredDetism) ++
"'.")],
write_error_pieces(FuncContext, 0, Pieces, !IO),
globals__io_lookup_bool_option(verbose_errors, VerboseErrors,
!IO),
- ( VerboseErrors = yes ->
+ (
+ VerboseErrors = yes,
ExtMsg = func_primary_mode_det_msg,
write_error_pieces_not_first_line(FuncContext, 0,
[words(ExtMsg)], !IO)
;
- true
+ VerboseErrors = no
),
module_info_incr_errors(!ModuleInfo)
;
@@ -426,9 +427,9 @@
record_warning(!IO),
module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
proc_info_context(ProcInfo, Context),
- describe_one_proc_name_mode(ModuleInfo, should_not_module_qualify,
- proc(PredId, ProcId), Desc),
- Pieces = [words("In " ++ Desc ++ ":"), nl,
+ ProcPieces = describe_one_proc_name_mode(ModuleInfo,
+ should_not_module_qualify, proc(PredId, ProcId)),
+ Pieces = [words("In")] ++ ProcPieces ++ [suffix(":"), nl,
words(Message), nl,
words("Declared `"
++ determinism_to_string(DeclaredDetism)
@@ -1160,10 +1161,10 @@
),
write_error_pieces(Context, 0, Pieces, !IO).
det_report_msg(warn_obsolete(PredId, Context), ModuleInfo, !IO) :-
- describe_one_pred_name(ModuleInfo, should_module_qualify, PredId,
- PredDesc),
- Pieces = [words("Warning: call to obsolete "),
- fixed(PredDesc ++ ".")],
+ PredPieces = describe_one_pred_name(ModuleInfo, should_module_qualify,
+ PredId),
+ Pieces = [words("Warning: call to obsolete")] ++ PredPieces
+ ++ [suffix(".")],
write_error_pieces(Context, 0, Pieces, !IO).
det_report_msg(warn_infinite_recursion(Context), _ModuleInfo, !IO) :-
% it would be better if we supplied more information than just
@@ -1296,12 +1297,11 @@
det_report_msg(cc_pred_in_wrong_context(GoalInfo, Detism, PredId, _ModeId),
ModuleInfo, !IO) :-
goal_info_get_context(GoalInfo, Context),
- describe_one_pred_name(ModuleInfo, should_not_module_qualify, PredId,
- PredDesc),
+ PredPieces = describe_one_pred_name(ModuleInfo,
+ should_not_module_qualify, PredId),
DetStr = mercury_det_to_string(Detism),
- Pieces = [words("Error: call to"),
- fixed(PredDesc),
- words("with determinism `" ++ DetStr ++ "'"),
+ Pieces = [words("Error: call to")] ++ PredPieces ++
+ [words("with determinism `" ++ DetStr ++ "'"),
words("occurs in a context which requires all solutions.")],
write_error_pieces(Context, 0, Pieces, !IO).
det_report_msg(higher_order_cc_pred_in_wrong_context(GoalInfo, Detism),
@@ -1314,11 +1314,11 @@
write_error_pieces(Context, 0, Pieces, !IO).
det_report_msg(error_in_lambda(DeclaredDetism, InferredDetism, Goal, GoalInfo,
PredId, ProcId), ModuleInfo, !IO) :-
- describe_one_proc_name_mode(ModuleInfo, should_not_module_qualify,
- proc(PredId, ProcId), Desc),
+ PredPieces = describe_one_proc_name_mode(ModuleInfo,
+ should_not_module_qualify, proc(PredId, ProcId)),
goal_info_get_context(GoalInfo, Context),
write_error_pieces(Context, 0,
- [words("In " ++ Desc ++ ":"), nl,
+ [words("In")] ++ PredPieces ++ [suffix(":"), nl,
words("Determinism error in lambda expression."), nl,
words("Declared `"
++ determinism_to_string(DeclaredDetism)
@@ -1359,18 +1359,18 @@
ModuleInfo, !IO) :-
module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
proc_info_context(ProcInfo, Context),
- describe_one_proc_name_mode(ModuleInfo, should_not_module_qualify,
- proc(PredId, ProcId), Desc),
- Pieces = [words("In " ++ Desc ++ ":"), nl,
+ ProcPieces = describe_one_proc_name_mode(ModuleInfo,
+ should_not_module_qualify, proc(PredId, ProcId)),
+ Pieces = [words("In")] ++ ProcPieces ++ [suffix(":"), nl,
words("error: `:- pragma c_code(...)' for a procedure"),
words("without a determinism declaration.")],
write_error_pieces(Context, 0, Pieces, !IO).
det_report_msg(has_io_state_but_not_det(PredId, ProcId), ModuleInfo, !IO) :-
module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
proc_info_context(ProcInfo, Context),
- describe_one_proc_name_mode(ModuleInfo, should_not_module_qualify,
- proc(PredId, ProcId), Desc),
- Pieces = [words("In " ++ Desc ++ ":"), nl,
+ ProcPieces = describe_one_proc_name_mode(ModuleInfo,
+ should_not_module_qualify, proc(PredId, ProcId)),
+ Pieces = [words("In")] ++ ProcPieces ++ [suffix(":"), nl,
words("error: invalid determinism for a predicate"),
words("with I/O state arguments.")],
write_error_pieces(Context, 0, Pieces, !IO),
@@ -1388,14 +1388,14 @@
!IO) :-
module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
proc_info_context(ProcInfo, Context),
- describe_one_proc_name_mode(ModuleInfo, should_not_module_qualify,
- proc(PredId, ProcId), Desc),
- Pieces = [words(Desc ++ "has determinism erroneous but also has"),
+ ProcPieces = describe_one_proc_name_mode(ModuleInfo,
+ should_not_module_qualify, proc(PredId, ProcId)),
+ Pieces = ProcPieces ++
+ [words("has determinism erroneous but also has"),
words("foreign clauses that have a"),
- fixed("`will_not_throw_exception'"),
- words("attribute. This attribute cannot be applied"),
- words("to erroneous procedures.")
- ],
+ fixed("`will_not_throw_exception' attribute."),
+ words("This attribute cannot be applied"),
+ words("to erroneous procedures.")],
write_error_pieces(Context, 0, Pieces, !IO).
det_report_msg(export_model_non_proc(PredId, ProcId, Detism), ModuleInfo,
!IO) :-
@@ -1435,9 +1435,9 @@
det_report_seen_call_id(ModuleInfo, SeenCall) = Pieces :-
(
SeenCall = seen_call(PredId, _),
- describe_one_pred_name(ModuleInfo, should_module_qualify,
- PredId, PredDesc),
- Pieces = [words("call to"), fixed(PredDesc)]
+ PredPieces = describe_one_pred_name(ModuleInfo,
+ should_module_qualify, PredId),
+ Pieces = [words("call to") | PredPieces]
;
SeenCall = higher_order_call,
Pieces = [words("higher-order call")]
Index: compiler/error_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/error_util.m,v
retrieving revision 1.29
diff -u -b -r1.29 error_util.m
--- compiler/error_util.m 8 Dec 2004 05:39:13 -0000 1.29
+++ compiler/error_util.m 16 Jan 2005 03:46:13 -0000
@@ -43,6 +43,11 @@
---> fixed(string) % This string should appear in the output
% in one piece, as it is.
+ ; suffix(string) % This string should appear in the output
+ % in one pieces, as it is, appended directly
+ % after the previous format_component, without
+ % any intervening space.
+
; words(string) % This string contains words separated by
% white space. The words should appear in
% the output in the given order, but the
@@ -56,10 +61,9 @@
; 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 list_to_pieces(list(string)::in,
- list(format_component)::out) is det.
+ % Convert a list of strings into a list of format_components
+ % separated by commas, with the last two elements separated by `and'.
+:- func list_to_pieces(list(string)) = list(format_component).
% Convert a list of lists of format_components into a list of
% format_components separated by commas, with the last two
@@ -99,6 +103,8 @@
:- pred write_error_pieces_maybe_with_context(maybe(prog_context)::in, int::in,
list(format_component)::in, io::di, io::uo) is det.
+:- func error_pieces_to_string(list(format_component)) = string.
+
:- func describe_sym_name(sym_name) = string.
:- func describe_sym_name_and_arity(sym_name_and_arity) = string.
@@ -162,14 +168,11 @@
:- import_module io, list, term, char, string, int, require.
-list_to_pieces([], []).
-list_to_pieces([Elem], [words(Elem)]).
-list_to_pieces([Elem1, Elem2],
- [fixed(Elem1), words("and"), fixed(Elem2)]).
-list_to_pieces([Elem1, Elem2, Elem3 | Elems], Pieces) :-
- string__append(Elem1, ",", Piece1),
- list_to_pieces([Elem2, Elem3 | Elems], Pieces1),
- Pieces = [fixed(Piece1) | Pieces1].
+list_to_pieces([]) = [].
+list_to_pieces([Elem]) = [words(Elem)].
+list_to_pieces([Elem1, Elem2]) = [fixed(Elem1), words("and"), fixed(Elem2)].
+list_to_pieces([Elem1, Elem2, Elem3 | Elems]) =
+ [fixed(Elem1 ++ ",") | list_to_pieces([Elem2, Elem3 | Elems])].
component_lists_to_pieces([]) = [].
component_lists_to_pieces([Components]) = Components.
@@ -302,58 +305,127 @@
io__write_string(Word, !IO),
write_line_rest(Words, !IO).
+error_pieces_to_string([]) = "".
+error_pieces_to_string([Component | Components]) = Str :-
+ TailStr = error_pieces_to_string(Components),
+ (
+ Component = fixed(Word),
+ ( TailStr = "" ->
+ Str = Word
+ ;
+ Str = Word ++ " " ++ TailStr
+ )
+ ;
+ Component = suffix(Word),
+ Str = Word ++ TailStr
+ ;
+ Component = words(Words),
+ ( TailStr = "" ->
+ Str = Words
+ ;
+ Str = Words ++ " " ++ TailStr
+ )
+ ;
+ Component = sym_name(SymName),
+ Word = sym_name_to_word(SymName),
+ ( TailStr = "" ->
+ Str = Word
+ ;
+ Str = Word ++ " " ++ TailStr
+ )
+ ;
+ Component = nl,
+ Str = "\n" ++ TailStr
+ ).
+
%----------------------------------------------------------------------------%
+:- type word
+ ---> word(string)
+ ; suffix_word(string).
+
:- pred convert_components_to_word_list(list(format_component)::in,
- list(string)::in, list(list(string))::in, list(list(string))::out)
+ list(word)::in, list(list(string))::in, list(list(string))::out)
is det.
-convert_components_to_word_list([], Words0, Paras0, Paras) :-
- list__reverse(Words0, Words),
- list__reverse([Words | Paras0], Paras).
-convert_components_to_word_list([Component | Components], Words0,
+convert_components_to_word_list([], RevWords0, Paras0, Paras) :-
+ Strings = rev_words_to_strings(RevWords0),
+ list__reverse([Strings | Paras0], Paras).
+convert_components_to_word_list([Component | Components], RevWords0,
Paras0, Paras) :-
(
Component = fixed(Word),
- Words1 = [Word | Words0],
+ RevWords1 = [word(Word) | RevWords0],
+ Paras1 = Paras0
+ ;
+ Component = suffix(Word),
+ RevWords1 = [suffix_word(Word) | RevWords0],
Paras1 = Paras0
;
Component = words(WordsStr),
- break_into_words(WordsStr, Words0, Words1),
+ break_into_words(WordsStr, RevWords0, RevWords1),
Paras1 = Paras0
;
Component = sym_name(SymName),
- Words1 = [sym_name_to_word(SymName) | Words0],
+ RevWords1 = [word(sym_name_to_word(SymName)) | RevWords0],
Paras1 = Paras0
;
Component = nl,
- list__reverse(Words0, Words),
- Paras1 = [Words | Paras0],
- Words1 = []
+ Strings = rev_words_to_strings(RevWords0),
+ Paras1 = [Strings | Paras0],
+ RevWords1 = []
),
- convert_components_to_word_list(Components, Words1, Paras1, Paras).
+ convert_components_to_word_list(Components, RevWords1, Paras1, Paras).
+
+:- func rev_words_to_strings(list(word)) = list(string).
+
+rev_words_to_strings(RevWords) =
+ list__reverse(rev_words_to_rev_strings(RevWords)).
+
+:- func rev_words_to_rev_strings(list(word)) = list(string).
+
+rev_words_to_rev_strings([]) = [].
+rev_words_to_rev_strings([Word | Words]) = Strings :-
+ (
+ Word = word(String),
+ Strings = [String | rev_words_to_rev_strings(Words)]
+ ;
+ Word = suffix_word(Suffix),
+ (
+ Words = [],
+ Strings = [Suffix]
+ ;
+ Words = [word(String) | Tail],
+ Strings = [String ++ Suffix |
+ rev_words_to_rev_strings(Tail)]
+ ;
+ Words = [suffix_word(MoreSuffix) | Tail],
+ Strings = rev_words_to_rev_strings(
+ [suffix_word(MoreSuffix ++ Suffix) | Tail])
+ )
+ ).
:- 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.
+:- pred break_into_words(string::in, list(word)::in, list(word)::out) is det.
break_into_words(String, Words0, Words) :-
break_into_words_from(String, 0, Words0, Words).
-:- pred break_into_words_from(string::in, int::in, list(string)::in,
- list(string)::out) is det.
+:- pred break_into_words_from(string::in, int::in, list(word)::in,
+ list(word)::out) is det.
break_into_words_from(String, Cur, Words0, Words) :-
( find_word_start(String, Cur, Start) ->
find_word_end(String, Start, End),
Length = End - Start + 1,
- string__substring(String, Start, Length, Word),
+ string__substring(String, Start, Length, WordStr),
Next = End + 1,
- break_into_words_from(String, Next, [Word | Words0], Words)
+ break_into_words_from(String, Next,
+ [word(WordStr) | Words0], Words)
;
Words = Words0
).
@@ -482,6 +554,9 @@
;
Piece0 = fixed(String),
Piece = fixed(string__append(String, char_to_string(Punc)))
+ ;
+ Piece0 = suffix(Suffix),
+ Piece = suffix(string__append(Suffix, char_to_string(Punc)))
;
Piece0 = sym_name(SymName),
String = sym_name_to_word(SymName),
Index: compiler/hlds_error_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_error_util.m,v
retrieving revision 1.4
diff -u -b -r1.4 hlds_error_util.m
--- compiler/hlds_error_util.m 14 Jun 2004 04:16:06 -0000 1.4
+++ compiler/hlds_error_util.m 16 Jan 2005 03:42:07 -0000
@@ -30,34 +30,34 @@
---> should_module_qualify
; should_not_module_qualify.
-:- pred describe_one_pred_name(module_info::in, should_module_qualify::in,
- pred_id::in, string::out) is det.
+:- func describe_one_pred_name(module_info, should_module_qualify, pred_id)
+ = list(format_component).
-:- pred describe_one_pred_name_mode(module_info::in, should_module_qualify::in,
- pred_id::in, inst_varset::in, list(mode)::in, string::out) is det.
+:- func describe_one_pred_name_mode(module_info, should_module_qualify,
+ pred_id, inst_varset, list(mode)) = list(format_component).
-:- pred describe_several_pred_names(module_info::in, should_module_qualify::in,
- list(pred_id)::in, list(format_component)::out) is det.
+:- func describe_several_pred_names(module_info, should_module_qualify,
+ list(pred_id)) = list(format_component).
-:- pred describe_one_proc_name(module_info::in, should_module_qualify::in,
- pred_proc_id::in, string::out) is det.
+:- func describe_one_proc_name(module_info, should_module_qualify,
+ pred_proc_id) = list(format_component).
-:- pred describe_one_proc_name_mode(module_info::in, should_module_qualify::in,
- pred_proc_id::in, string::out) is det.
+:- func describe_one_proc_name_mode(module_info, should_module_qualify,
+ pred_proc_id) = list(format_component).
-:- pred describe_several_proc_names(module_info::in, should_module_qualify::in,
- list(pred_proc_id)::in, list(format_component)::out) is det.
+:- func describe_several_proc_names(module_info, should_module_qualify,
+ list(pred_proc_id)) = list(format_component).
-:- pred describe_one_call_site(module_info::in, should_module_qualify::in,
- pair(pred_proc_id, prog_context)::in, string::out) is det.
+:- func describe_one_call_site(module_info, should_module_qualify,
+ pair(pred_proc_id, prog_context)) = list(format_component).
-:- pred describe_several_call_sites(module_info::in, should_module_qualify::in,
- assoc_list(pred_proc_id, prog_context)::in,
- list(format_component)::out) is det.
+:- func describe_several_call_sites(module_info, should_module_qualify,
+ assoc_list(pred_proc_id, prog_context)) = list(format_component).
:- implementation.
:- import_module check_hlds__mode_util.
+:- import_module hlds__special_pred.
:- import_module parse_tree__mercury_to_mercury.
:- import_module parse_tree__prog_mode.
:- import_module parse_tree__prog_out.
@@ -70,33 +70,45 @@
% 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, ShouldModuleQualify, PredId, Piece) :-
+describe_one_pred_name(Module, ShouldModuleQualify, PredId) = Pieces :-
module_info_pred_info(Module, PredId, PredInfo),
ModuleName = pred_info_module(PredInfo),
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),
+ PredOrFuncStr = 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"
+ pred_info_get_markers(PredInfo, Markers),
+ pred_info_get_maybe_special_pred(PredInfo, MaybeSpecial),
+ ( MaybeSpecial = yes(SpecialId - TypeCtor) ->
+ special_pred_description(SpecialId, Descr),
+ TypeCtor = TypeSymName - TypeArity,
+ ( TypeArity = 0 ->
+ Pieces = [words(Descr), words("for type"),
+ sym_name(TypeSymName)]
+ ;
+ Pieces = [words(Descr), words("for type constructor"),
+ sym_name(TypeSymName)]
+ )
+ ; check_marker(Markers, class_instance_method) ->
+ Pieces = [words("type class method implementation")]
+ ; pred_info_get_goal_type(PredInfo, promise(PromiseType)) ->
+ Pieces = [words("`" ++ promise_to_string(PromiseType) ++ "'"),
+ words("declaration")]
;
string__int_to_string(OrigArity, ArityPart),
string__append_list([
- PredOrFuncPart,
- " `",
+ "`",
module_qualification(ModuleName, ShouldModuleQualify),
PredName,
"/",
ArityPart,
- "'"], Piece)
+ "'"], SpecStr),
+ Pieces = [words(PredOrFuncStr), fixed(SpecStr)]
).
describe_one_pred_name_mode(Module, ShouldModuleQualify, PredId, InstVarSet,
- ArgModes0, Piece) :-
+ ArgModes0) = Pieces :-
module_info_pred_info(Module, PredId, PredInfo),
ModuleName = pred_info_module(PredInfo),
PredName = pred_info_name(PredInfo),
@@ -129,54 +141,48 @@
module_qualification(ModuleName, ShouldModuleQualify),
PredName,
ArgModesPart,
- "'"], Piece).
+ "'"], Descr),
+ Pieces = [words(Descr)].
-describe_several_pred_names(Module, ShouldModuleQualify, PredId, Pieces) :-
- list__map(describe_one_pred_name(Module, ShouldModuleQualify),
- PredId, Pieces0),
- list_to_pieces(Pieces0, Pieces).
-
-describe_one_proc_name(Module, ShouldModuleQualify, proc(PredId, ProcId),
- Piece) :-
- describe_one_pred_name(Module, ShouldModuleQualify, PredId, PredPiece),
+describe_several_pred_names(Module, ShouldModuleQualify, PredIds) = Pieces :-
+ PiecesList = list__map(
+ describe_one_pred_name(Module, ShouldModuleQualify), PredIds),
+ Pieces = component_lists_to_pieces(PiecesList).
+
+describe_one_proc_name(Module, ShouldModuleQualify, proc(PredId, ProcId))
+ = Pieces :-
+ PredPieces = describe_one_pred_name(Module, ShouldModuleQualify,
+ PredId),
proc_id_to_int(ProcId, ProcIdInt),
- string__int_to_string(ProcIdInt, ProcIdPart),
- string__append_list([
- PredPiece,
- " mode ",
- ProcIdPart
- ], Piece).
+ string__int_to_string(ProcIdInt, ProcIdStr),
+ Pieces = PredPieces ++ [words("mode"), words(ProcIdStr)].
-describe_one_proc_name_mode(Module, ShouldModuleQualify, proc(PredId, ProcId),
- Piece) :-
+describe_one_proc_name_mode(Module, ShouldModuleQualify, proc(PredId, ProcId))
+ = Pieces :-
module_info_pred_proc_info(Module, PredId, ProcId, _, ProcInfo),
proc_info_argmodes(ProcInfo, ArgModes),
proc_info_inst_varset(ProcInfo, InstVarSet),
- describe_one_pred_name_mode(Module, ShouldModuleQualify, PredId,
- InstVarSet, ArgModes, Piece).
-
-describe_several_proc_names(Module, ShouldModuleQualify, PPIds, Pieces) :-
- list__map(describe_one_proc_name(Module, ShouldModuleQualify),
- PPIds, Pieces0),
- list_to_pieces(Pieces0, Pieces).
+ Pieces = describe_one_pred_name_mode(Module, ShouldModuleQualify,
+ PredId, InstVarSet, ArgModes).
-describe_one_call_site(Module, ShouldModuleQualify, PPId - Context, Piece) :-
- describe_one_proc_name(Module, ShouldModuleQualify, PPId, ProcName),
+describe_several_proc_names(Module, ShouldModuleQualify, PPIds) = Pieces :-
+ PiecesList = list__map(
+ describe_one_proc_name(Module, ShouldModuleQualify), PPIds),
+ Pieces = component_lists_to_pieces(PiecesList).
+
+describe_one_call_site(Module, ShouldModuleQualify, PPId - Context) = Pieces :-
+ ProcNamePieces = describe_one_proc_name(Module, ShouldModuleQualify,
+ PPId),
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, ShouldModuleQualify, Sites, Pieces) :-
- list__map(describe_one_call_site(Module, ShouldModuleQualify),
- Sites, Pieces0),
- list_to_pieces(Pieces0, Pieces).
+ string__int_to_string(LineNumber, LineNumberStr),
+ Pieces = ProcNamePieces ++
+ [words("at"), fixed(FileName ++ ":" ++ LineNumberStr)].
+
+describe_several_call_sites(Module, ShouldModuleQualify, Sites) = Pieces :-
+ PiecesList = list__map(
+ describe_one_call_site(Module, ShouldModuleQualify), Sites),
+ Pieces = component_lists_to_pieces(PiecesList).
:- func module_qualification(module_name, should_module_qualify) = string.
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.341
diff -u -b -r1.341 hlds_out.m
--- compiler/hlds_out.m 14 Jan 2005 05:58:06 -0000 1.341
+++ compiler/hlds_out.m 17 Jan 2005 04:29:40 -0000
@@ -60,11 +60,9 @@
% hlds_out__write_pred_id/4 writes out a message such as
% predicate `foo:bar/3'
% or function `foo:myfoo/5'
- % unless the predicate is a special (unify, compare or index)
- % predicate, in which case mercury_output_term is used to print out
- % the predicate's name and argument types (since for such predicates,
- % the module, name and arity are not sufficient to identify the
- % predicate).
+ % except in some special cases where the predicate name is mangled
+ % and we can print a more meaningful identification of the predicate
+ % in question.
:- pred hlds_out__write_pred_id(module_info::in, pred_id::in, io::di, io::uo)
is det.
@@ -1168,9 +1166,7 @@
hlds_out__write_indent(Indent, !IO),
io__write_string("% Modes for which this clause applies: ",
!IO),
- list__map((pred(Mode :: in, ModeInt :: out) is det :-
- proc_id_to_int(Mode, ModeInt)
- ), Modes, ModeInts),
+ ModeInts = list__map(proc_id_to_int, Modes),
hlds_out__write_intlist(ModeInts, !IO),
io__write_string("\n", !IO)
;
@@ -2938,11 +2934,16 @@
:- pred hlds_out__write_type_list(list(type)::in, tvarset::in, bool::in,
io::di, io::uo) is det.
-hlds_out__write_type_list(Types, TypeVarSet, AppendVarNums) -->
- list__foldl((pred(Type::in, di, uo) is det -->
- mercury_output_term(Type, TypeVarSet, AppendVarNums),
- io__write_string(", ")),
- Types).
+hlds_out__write_type_list(Types, TypeVarSet, AppendVarNums, !IO) :-
+ list__foldl(output_term_and_comma(TypeVarSet, AppendVarNums),
+ Types, !IO).
+
+:- pred output_term_and_comma(tvarset::in, bool::in, (type)::in,
+ io::di, io::uo) is det.
+
+output_term_and_comma(TypeVarSet, AppendVarNums, Type, !IO) :-
+ mercury_output_term(Type, TypeVarSet, AppendVarNums, !IO),
+ io__write_string(", ", !IO).
:- pred hlds_out__write_var_types(int::in, prog_varset::in, bool::in,
vartypes::in, tvarset::in, io::di, io::uo) is det.
@@ -3170,8 +3171,7 @@
io::di, io::uo) is det.
hlds_out__write_type_body(Indent, TVarSet, du_type(Ctors, Tags, Enum,
- MaybeUserEqComp, ReservedTag, Foreign),
- !IO) :-
+ MaybeUserEqComp, ReservedTag, Foreign), !IO) :-
io__write_string(" --->\n", !IO),
(
Enum = yes,
@@ -3217,7 +3217,6 @@
MaybeUserEqComp, !IO),
io__write_string(".\n", !IO).
-
:- pred hlds_out__write_constructors(int::in, tvarset::in,
list(constructor)::in, cons_tag_values::in, io::di, io::uo) is det.
@@ -3738,49 +3737,6 @@
Indent1, ".\n", !IO)
).
-% :- pred hlds_out__write_varnames(int::in, map(var, string)::in,
-% io::di, io::uo) is det.
-%
-% hlds_out__write_varnames(Indent, VarNames) -->
-% { map__to_assoc_list(VarNames, VarNameList) },
-% (
-% { VarNameList = [] }
-% ->
-% hlds_out__write_indent(Indent),
-% io__write_string("[]\n")
-% ;
-% hlds_out__write_indent(Indent),
-% io__write_string("[\n"),
-% {Indent1 = Indent + 1},
-% hlds_out__write_varnames_2(Indent1, VarNameList),
-% hlds_out__write_indent(Indent),
-% io__write_string("]\n")
-% ).
-%
-% :- pred hlds_out__write_varnames_2(int::in, list(pair(var, string))::in,
-% io::di, io::uo) is det.
-%
-% hlds_out__write_varnames_2(Indent, VarNameList0) -->
-% (
-% { VarNameList0 = [VarId - Name|VarNameList] }
-% ->
-% { Indent1 = Indent + 1 },
-% hlds_out__write_indent(Indent1),
-% { term__var_to_int(VarId, VarNum) },
-% io__write_int(VarNum),
-% io__write_string(" - "),
-% io__write_string(Name),
-% io__write_string("\n"),
-% ( { VarNameList = [] } ->
-% []
-% ;
-% io__write_string(",\n"),
-% hlds_out__write_varnames_2(Indent, VarNameList)
-% )
-% ;
-% { error("This cannot happen") }
-% ).
-
hlds_out__write_determinism(Detism, !IO) :-
io__write_string(hlds_out__determinism_to_string(Detism), !IO).
@@ -4041,12 +3997,15 @@
bound_insts_to_term([], _) = _ :-
error("bound_insts_to_term([])").
bound_insts_to_term([functor(ConsId, Args) | BoundInsts], Context) = Term :-
- ( cons_id_and_args_to_term(ConsId,
+ (
+ cons_id_and_args_to_term(ConsId,
list__map(map_inst_to_term(Context), Args), FirstTerm)
->
- ( BoundInsts = [] ->
+ (
+ BoundInsts = [],
Term = FirstTerm
;
+ BoundInsts = [_ | _],
construct_qualified_term(unqualified(";"),
[FirstTerm,
bound_insts_to_term(BoundInsts, Context)],
@@ -4073,8 +4032,8 @@
%-----------------------------------------------------------------------------%
-mercury_output_uni_mode_list(UniModes, VarSet) -->
- mercury_format_uni_mode_list(UniModes, VarSet).
+mercury_output_uni_mode_list(UniModes, VarSet, !IO) :-
+ mercury_format_uni_mode_list(UniModes, VarSet, !IO).
mercury_uni_mode_list_to_string(UniModes, VarSet) = String :-
mercury_format_uni_mode_list(UniModes, VarSet, "", String).
@@ -4082,18 +4041,20 @@
:- pred mercury_format_uni_mode_list(list(uni_mode)::in, inst_varset::in,
U::di, U::uo) is det <= output(U).
-mercury_format_uni_mode_list([], _VarSet) --> [].
-mercury_format_uni_mode_list([Mode | Modes], VarSet) -->
- mercury_format_uni_mode(Mode, VarSet),
- ( { Modes = [] } ->
- []
+mercury_format_uni_mode_list([], _VarSet, !IO).
+mercury_format_uni_mode_list([Mode | Modes], VarSet, !IO) :-
+ mercury_format_uni_mode(Mode, VarSet, !IO),
+ (
+ Modes = [],
+ true
;
- add_string(", "),
- mercury_format_uni_mode_list(Modes, VarSet)
+ Modes = [_ | _],
+ add_string(", ", !IO),
+ mercury_format_uni_mode_list(Modes, VarSet, !IO)
).
-mercury_output_uni_mode(UniMode, VarSet) -->
- mercury_format_uni_mode(UniMode, VarSet).
+mercury_output_uni_mode(UniMode, VarSet, !IO) :-
+ mercury_format_uni_mode(UniMode, VarSet, !IO).
mercury_uni_mode_to_string(UniMode, VarSet) = String :-
mercury_format_uni_mode(UniMode, VarSet, "", String).
@@ -4101,10 +4062,10 @@
:- pred mercury_format_uni_mode(uni_mode::in, inst_varset::in,
U::di, U::uo) is det <= output(U).
-mercury_format_uni_mode((InstA1 - InstB1 -> InstA2 - InstB2), VarSet) -->
- mercury_format_mode((InstA1 -> InstA2), simple_inst_info(VarSet)),
- add_string(" = "),
- mercury_format_mode((InstB1 -> InstB2), simple_inst_info(VarSet)).
+mercury_format_uni_mode((InstA1 - InstB1 -> InstA2 - InstB2), VarSet, !IO) :-
+ mercury_format_mode((InstA1 -> InstA2), simple_inst_info(VarSet), !IO),
+ add_string(" = ", !IO),
+ mercury_format_mode((InstB1 -> InstB2), simple_inst_info(VarSet), !IO).
:- instance inst_info(expanded_inst_info) where [
func(instvarset/1) is eii_varset,
@@ -4124,23 +4085,22 @@
:- pred mercury_format_expanded_defined_inst(inst_name::in,
expanded_inst_info::in, U::di, U::uo) is det <= output(U).
-mercury_format_expanded_defined_inst(InstName, ExpandedInstInfo) -->
- ( { set__member(InstName, ExpandedInstInfo ^ eii_expansions) } ->
- add_string("...")
- ; { InstName = user_inst(_, _) } ->
+mercury_format_expanded_defined_inst(InstName, ExpandedInstInfo, !S) :-
+ ( set__member(InstName, ExpandedInstInfo ^ eii_expansions) ->
+ add_string("...", !S)
+ ; InstName = user_inst(_, _) ->
% don't expand user-defined insts, just output them as is
% (we do expand any compiler-defined insts that occur
% in the arguments of the user-defined inst, however)
- mercury_format_inst_name(InstName, ExpandedInstInfo)
+ mercury_format_inst_name(InstName, ExpandedInstInfo, !S)
;
- { inst_lookup(ExpandedInstInfo ^ eii_module_info, InstName,
- Inst) },
- { set__insert(ExpandedInstInfo ^ eii_expansions, InstName,
- Expansions) },
+ inst_lookup(ExpandedInstInfo ^ eii_module_info, InstName,
+ Inst),
+ set__insert(ExpandedInstInfo ^ eii_expansions, InstName,
+ Expansions),
mercury_format_inst(Inst,
- ExpandedInstInfo ^ eii_expansions := Expansions)
+ ExpandedInstInfo ^ eii_expansions := Expansions, !S)
).
-
mercury_output_expanded_inst(Inst, VarSet, ModuleInfo, !IO) :-
set__init(Expansions),
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.241
diff -u -b -r1.241 llds_out.m
--- compiler/llds_out.m 9 Dec 2004 02:02:22 -0000 1.241
+++ compiler/llds_out.m 15 Jan 2005 07:00:46 -0000
@@ -2361,18 +2361,18 @@
:- pred output_reset_trail_reason(reset_trail_reason::in, io::di, io::uo)
is det.
-output_reset_trail_reason(undo) -->
- io__write_string("MR_undo").
-output_reset_trail_reason(commit) -->
- io__write_string("MR_commit").
-output_reset_trail_reason(solve) -->
- io__write_string("MR_solve").
-output_reset_trail_reason(exception) -->
- io__write_string("MR_exception").
-output_reset_trail_reason(retry) -->
- io__write_string("MR_retry").
-output_reset_trail_reason(gc) -->
- io__write_string("MR_gc").
+output_reset_trail_reason(undo, !IO) :-
+ io__write_string("MR_undo", !IO).
+output_reset_trail_reason(commit, !IO) :-
+ io__write_string("MR_commit", !IO).
+output_reset_trail_reason(solve, !IO) :-
+ io__write_string("MR_solve", !IO).
+output_reset_trail_reason(exception, !IO) :-
+ io__write_string("MR_exception", !IO).
+output_reset_trail_reason(retry, !IO) :-
+ io__write_string("MR_retry", !IO).
+output_reset_trail_reason(gc, !IO) :-
+ io__write_string("MR_gc", !IO).
:- pred output_livevals(list(lval)::in, io::di, io::uo) is det.
@@ -2452,36 +2452,45 @@
:- pred output_live_value_type(live_value_type::in, io::di, io::uo) is det.
-output_live_value_type(succip) --> io__write_string("type succip").
-output_live_value_type(curfr) --> io__write_string("type curfr").
-output_live_value_type(maxfr) --> io__write_string("type maxfr").
-output_live_value_type(redofr) --> io__write_string("type redofr").
-output_live_value_type(redoip) --> io__write_string("type redoip").
-output_live_value_type(hp) --> io__write_string("type hp").
-output_live_value_type(trail_ptr) --> io__write_string("type trail_ptr").
-output_live_value_type(ticket) --> io__write_string("type ticket").
-output_live_value_type(unwanted) --> io__write_string("unwanted").
-output_live_value_type(var(Var, Name, Type, LldsInst)) -->
- io__write_string("var("),
- { term__var_to_int(Var, VarInt) },
- io__write_int(VarInt),
- io__write_string(", "),
- io__write_string(Name),
- io__write_string(", "),
+output_live_value_type(succip, !IO) :-
+ io__write_string("type succip", !IO).
+output_live_value_type(curfr, !IO) :-
+ io__write_string("type curfr", !IO).
+output_live_value_type(maxfr, !IO) :-
+ io__write_string("type maxfr", !IO).
+output_live_value_type(redofr, !IO) :-
+ io__write_string("type redofr", !IO).
+output_live_value_type(redoip, !IO) :-
+ io__write_string("type redoip", !IO).
+output_live_value_type(hp, !IO) :-
+ io__write_string("type hp", !IO).
+output_live_value_type(trail_ptr, !IO) :-
+ io__write_string("type trail_ptr", !IO).
+output_live_value_type(ticket, !IO) :-
+ io__write_string("type ticket", !IO).
+output_live_value_type(unwanted, !IO) :-
+ io__write_string("unwanted", !IO).
+output_live_value_type(var(Var, Name, Type, LldsInst), !IO) :-
+ io__write_string("var(", !IO),
+ term__var_to_int(Var, VarInt),
+ io__write_int(VarInt, !IO),
+ io__write_string(", ", !IO),
+ io__write_string(Name, !IO),
+ io__write_string(", ", !IO),
% XXX Fake type varset
- { varset__init(NewTVarset) },
- mercury_output_term(Type, NewTVarset, no),
- io__write_string(", "),
+ varset__init(NewTVarset),
+ mercury_output_term(Type, NewTVarset, no, !IO),
+ io__write_string(", ", !IO),
(
- { LldsInst = ground },
- io__write_string("ground")
+ LldsInst = ground,
+ io__write_string("ground", !IO)
;
- { LldsInst = partial(Inst) },
+ LldsInst = partial(Inst),
% XXX Fake inst varset
- { varset__init(NewIVarset) },
- mercury_output_inst(Inst, NewIVarset)
+ varset__init(NewIVarset),
+ mercury_output_inst(Inst, NewIVarset, !IO)
),
- io__write_string(")").
+ io__write_string(")", !IO).
:- pred output_temp_decls(int::in, string::in, io::di, io::uo) is det.
@@ -2861,20 +2870,20 @@
:- pred output_decl_id(decl_id::in, io::di, io::uo) is det.
-output_decl_id(common_type(ModuleName, TypeNum)) -->
- output_common_cell_type_name(ModuleName, TypeNum).
-output_decl_id(data_addr(DataAddr)) -->
- output_data_addr(DataAddr).
-output_decl_id(code_addr(_CodeAddress)) -->
- { error("output_decl_id: code_addr unexpected") }.
-output_decl_id(float_label(_Label)) -->
- { error("output_decl_id: float_label unexpected") }.
-output_decl_id(pragma_c_struct(_Name)) -->
- { error("output_decl_id: pragma_c_struct unexpected") }.
-output_decl_id(type_info_like_struct(_Name)) -->
- { error("output_decl_id: type_info_like_struct unexpected") }.
-output_decl_id(typeclass_constraint_struct(_Name)) -->
- { error("output_decl_id: class_constraint_struct unexpected") }.
+output_decl_id(common_type(ModuleName, TypeNum), !IO) :-
+ output_common_cell_type_name(ModuleName, TypeNum, !IO).
+output_decl_id(data_addr(DataAddr), !IO) :-
+ output_data_addr(DataAddr, !IO).
+output_decl_id(code_addr(_CodeAddress), !IO) :-
+ error("output_decl_id: code_addr unexpected").
+output_decl_id(float_label(_Label), !IO) :-
+ error("output_decl_id: float_label unexpected").
+output_decl_id(pragma_c_struct(_Name), !IO) :-
+ error("output_decl_id: pragma_c_struct unexpected").
+output_decl_id(type_info_like_struct(_Name), !IO) :-
+ error("output_decl_id: type_info_like_struct unexpected").
+output_decl_id(typeclass_constraint_struct(_Name), !IO) :-
+ error("output_decl_id: class_constraint_struct unexpected").
:- pred output_cons_arg_types(list(llds_type)::in, string::in, int::in,
io::di, io::uo) is det.
@@ -2943,20 +2952,34 @@
:- pred output_llds_type(llds_type::in, io::di, io::uo) is det.
-output_llds_type(int_least8) --> io__write_string("MR_int_least8_t").
-output_llds_type(uint_least8) --> io__write_string("MR_uint_least8_t").
-output_llds_type(int_least16) --> io__write_string("MR_int_least16_t").
-output_llds_type(uint_least16) --> io__write_string("MR_uint_least16_t").
-output_llds_type(int_least32) --> io__write_string("MR_int_least32_t").
-output_llds_type(uint_least32) --> io__write_string("MR_uint_least32_t").
-output_llds_type(bool) --> io__write_string("MR_Integer").
-output_llds_type(integer) --> io__write_string("MR_Integer").
-output_llds_type(unsigned) --> io__write_string("MR_Unsigned").
-output_llds_type(float) --> io__write_string("MR_Float").
-output_llds_type(word) --> io__write_string("MR_Word").
-output_llds_type(string) --> io__write_string("MR_String").
-output_llds_type(data_ptr) --> io__write_string("MR_Word *").
-output_llds_type(code_ptr) --> io__write_string("MR_Code *").
+output_llds_type(int_least8, !IO) :-
+ io__write_string("MR_int_least8_t", !IO).
+output_llds_type(uint_least8, !IO) :-
+ io__write_string("MR_uint_least8_t", !IO).
+output_llds_type(int_least16, !IO) :-
+ io__write_string("MR_int_least16_t", !IO).
+output_llds_type(uint_least16, !IO) :-
+ io__write_string("MR_uint_least16_t", !IO).
+output_llds_type(int_least32, !IO) :-
+ io__write_string("MR_int_least32_t", !IO).
+output_llds_type(uint_least32, !IO) :-
+ io__write_string("MR_uint_least32_t", !IO).
+output_llds_type(bool, !IO) :-
+ io__write_string("MR_Integer", !IO).
+output_llds_type(integer, !IO) :-
+ io__write_string("MR_Integer", !IO).
+output_llds_type(unsigned, !IO) :-
+ io__write_string("MR_Unsigned", !IO).
+output_llds_type(float, !IO) :-
+ io__write_string("MR_Float", !IO).
+output_llds_type(word, !IO) :-
+ io__write_string("MR_Word", !IO).
+output_llds_type(string, !IO) :-
+ io__write_string("MR_String", !IO).
+output_llds_type(data_ptr, !IO) :-
+ io__write_string("MR_Word *", !IO).
+output_llds_type(code_ptr, !IO) :-
+ io__write_string("MR_Code *", !IO).
% Output the arguments, each on its own line prefixing with Indent,
% and with a cast appropriate to its type if necessary.
@@ -4524,9 +4547,9 @@
:- pred output_unary_op(unary_op::in, io::di, io::uo) is det.
-output_unary_op(Op) -->
- { c_util__unary_prefix_op(Op, OpString) },
- io__write_string(OpString).
+output_unary_op(Op, !IO) :-
+ c_util__unary_prefix_op(Op, OpString),
+ io__write_string(OpString, !IO).
:- pred output_rval_const(rval_const::in, io::di, io::uo) is det.
@@ -4673,104 +4696,106 @@
:- pred output_lval_as_word(lval::in, io::di, io::uo) is det.
-output_lval_as_word(Lval) -->
- { llds__lval_type(Lval, ActualType) },
- ( { types_match(word, ActualType) } ->
- output_lval(Lval)
- ; { ActualType = float } ->
+output_lval_as_word(Lval, !IO) :-
+ llds__lval_type(Lval, ActualType),
+ ( types_match(word, ActualType) ->
+ output_lval(Lval, !IO)
+ ; ActualType = float ->
% sanity check -- if this happens, the llds is ill-typed
- { error("output_lval_as_word: got float") }
+ error("output_lval_as_word: got float")
;
- io__write_string("MR_LVALUE_CAST(MR_Word,"),
- output_lval(Lval),
- io__write_string(")")
+ io__write_string("MR_LVALUE_CAST(MR_Word,", !IO),
+ output_lval(Lval, !IO),
+ io__write_string(")", !IO)
).
:- pred output_lval(lval::in, io::di, io::uo) is det.
-output_lval(reg(Type, Num)) -->
- output_reg(Type, Num).
-output_lval(stackvar(N)) -->
- { N =< 0 ->
+output_lval(reg(Type, Num), !IO) :-
+ output_reg(Type, Num, !IO).
+output_lval(stackvar(N), !IO) :-
+ ( N =< 0 ->
error("stack var out of range")
;
true
- },
- io__write_string("MR_sv("),
- io__write_int(N),
- io__write_string(")").
-output_lval(framevar(N)) -->
- { N =< 0 ->
+ ),
+ io__write_string("MR_sv(", !IO),
+ io__write_int(N, !IO),
+ io__write_string(")", !IO).
+output_lval(framevar(N), !IO) :-
+ ( N =< 0 ->
error("frame var out of range")
;
true
- },
- io__write_string("MR_fv("),
- io__write_int(N),
- io__write_string(")").
-output_lval(succip) -->
- io__write_string("MR_succip").
-output_lval(sp) -->
- io__write_string("MR_sp").
-output_lval(hp) -->
- io__write_string("MR_hp").
-output_lval(maxfr) -->
- io__write_string("MR_maxfr").
-output_lval(curfr) -->
- io__write_string("MR_curfr").
-output_lval(succfr(Rval)) -->
- io__write_string("MR_succfr_slot("),
- output_rval(Rval),
- io__write_string(")").
-output_lval(prevfr(Rval)) -->
- io__write_string("MR_prevfr_slot("),
- output_rval(Rval),
- io__write_string(")").
-output_lval(redofr(Rval)) -->
- io__write_string("MR_redofr_slot("),
- output_rval(Rval),
- io__write_string(")").
-output_lval(redoip(Rval)) -->
- io__write_string("MR_redoip_slot("),
- output_rval(Rval),
- io__write_string(")").
-output_lval(succip(Rval)) -->
- io__write_string("MR_succip_slot("),
- output_rval(Rval),
- io__write_string(")").
-output_lval(field(MaybeTag, Rval, FieldNumRval)) -->
- ( { MaybeTag = yes(Tag) } ->
- io__write_string("MR_tfield("),
- io__write_int(Tag),
- io__write_string(", ")
- ;
- io__write_string("MR_mask_field(")
- ),
- output_rval(Rval),
- io__write_string(", "),
- ( { FieldNumRval = const(int_const(FieldNum)) } ->
+ ),
+ io__write_string("MR_fv(", !IO),
+ io__write_int(N, !IO),
+ io__write_string(")", !IO).
+output_lval(succip, !IO) :-
+ io__write_string("MR_succip", !IO).
+output_lval(sp, !IO) :-
+ io__write_string("MR_sp", !IO).
+output_lval(hp, !IO) :-
+ io__write_string("MR_hp", !IO).
+output_lval(maxfr, !IO) :-
+ io__write_string("MR_maxfr", !IO).
+output_lval(curfr, !IO) :-
+ io__write_string("MR_curfr", !IO).
+output_lval(succfr(Rval), !IO) :-
+ io__write_string("MR_succfr_slot(", !IO),
+ output_rval(Rval, !IO),
+ io__write_string(")", !IO).
+output_lval(prevfr(Rval), !IO) :-
+ io__write_string("MR_prevfr_slot(", !IO),
+ output_rval(Rval, !IO),
+ io__write_string(")", !IO).
+output_lval(redofr(Rval), !IO) :-
+ io__write_string("MR_redofr_slot(", !IO),
+ output_rval(Rval, !IO),
+ io__write_string(")", !IO).
+output_lval(redoip(Rval), !IO) :-
+ io__write_string("MR_redoip_slot(", !IO),
+ output_rval(Rval, !IO),
+ io__write_string(")", !IO).
+output_lval(succip(Rval), !IO) :-
+ io__write_string("MR_succip_slot(", !IO),
+ output_rval(Rval, !IO),
+ io__write_string(")", !IO).
+output_lval(field(MaybeTag, Rval, FieldNumRval), !IO) :-
+ (
+ MaybeTag = yes(Tag),
+ io__write_string("MR_tfield(", !IO),
+ io__write_int(Tag, !IO),
+ io__write_string(", ", !IO)
+ ;
+ MaybeTag = no,
+ io__write_string("MR_mask_field(", !IO)
+ ),
+ output_rval(Rval, !IO),
+ io__write_string(", ", !IO),
+ ( FieldNumRval = const(int_const(FieldNum)) ->
% Avoid emitting the (MR_Integer) cast.
- io__write_int(FieldNum)
+ io__write_int(FieldNum, !IO)
;
- output_rval(FieldNumRval)
+ output_rval(FieldNumRval, !IO)
),
- io__write_string(")").
-output_lval(lvar(_)) -->
- { error("Illegal to output an lvar") }.
-output_lval(temp(Type, Num)) -->
- (
- { Type = r },
- io__write_string("MR_tempr"),
- io__write_int(Num)
- ;
- { Type = f },
- io__write_string("MR_tempf"),
- io__write_int(Num)
- ).
-output_lval(mem_ref(Rval)) -->
- io__write_string("XXX("),
- output_rval(Rval),
- io__write_string(")").
+ io__write_string(")", !IO).
+output_lval(lvar(_), !IO) :-
+ error("Illegal to output an lvar").
+output_lval(temp(Type, Num), !IO) :-
+ (
+ Type = r,
+ io__write_string("MR_tempr", !IO),
+ io__write_int(Num, !IO)
+ ;
+ Type = f,
+ io__write_string("MR_tempf", !IO),
+ io__write_int(Num, !IO)
+ ).
+output_lval(mem_ref(Rval), !IO) :-
+ io__write_string("XXX(", !IO),
+ output_rval(Rval, !IO),
+ io__write_string(")", !IO).
:- pred output_lval_for_assign(lval::in, llds_type::out, io::di, io::uo) is det.
Index: compiler/magic_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/magic_util.m,v
retrieving revision 1.41
diff -u -b -r1.41 magic_util.m
--- compiler/magic_util.m 5 Sep 2004 23:52:15 -0000 1.41
+++ compiler/magic_util.m 16 Jan 2005 03:51:34 -0000
@@ -1752,100 +1752,95 @@
.
%-----------------------------------------------------------------------------%
+
:- implementation.
-magic_util__report_errors(Errors, ModuleInfo, Verbose) -->
- list__foldl(magic_util__report_error(ModuleInfo, Verbose), Errors).
+magic_util__report_errors(Errors, ModuleInfo, Verbose, !IO) :-
+ list__foldl(magic_util__report_error(ModuleInfo, Verbose),
+ Errors, !IO).
:- pred magic_util__report_error(module_info::in, bool::in, magic_error::in,
io::di, io::uo) is det.
-magic_util__report_error(ModuleInfo, Verbose,
- argument_error(Error, Arg, proc(PredId, _)) - Context) -->
-
- { describe_one_pred_name(ModuleInfo, should_module_qualify,
- 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,
- Verbose, SecondPart) },
- write_error_pieces(Context, 0, [fixed(PredNamePiece), nl | SecondPart]).
-
-magic_util__report_error(ModuleInfo, _Verbose,
- nonspecific_polymorphism(proc(PredId, _), _) - Context) -->
- { describe_one_pred_name(ModuleInfo, should_module_qualify,
- PredId, PredName) },
- { string__append_list(["In ", PredName, ":"], PredNamePiece) },
- { SecondPart = [words("the code uses polymorphism or type-classes"),
- words("which are not supported by Aditi.")] },
- write_error_pieces(Context, 0, [fixed(PredNamePiece), nl | SecondPart]).
-
-magic_util__report_error(ModuleInfo, _Verbose,
- curried_argument(proc(PredId, _)) - Context) -->
- { describe_one_pred_name(ModuleInfo, should_module_qualify,
- PredId, PredName) },
- { string__append_list(["In ", PredName, ":"], PredNamePiece) },
- { SecondPart = [words("sorry, curried closure arguments are not"),
+magic_util__report_error(ModuleInfo, Verbose, MagicError - Context, !IO) :-
+ MagicError = argument_error(Error, Arg, proc(PredId, _)),
+ PredNamePieces = describe_one_pred_name(ModuleInfo,
+ should_module_qualify, PredId),
+ InPieces = [words("In Aditi") | PredNamePieces] ++ [suffix(":"), nl],
+ magic_util__error_arg_id_piece(Arg, ArgPiece),
+ magic_util__report_argument_error(Context, Error, ArgPiece, Verbose,
+ ReportPieces),
+ write_error_pieces(Context, 0, InPieces ++ ReportPieces, !IO).
+
+magic_util__report_error(ModuleInfo, _Verbose, MagicError - Context, !IO) :-
+ MagicError = nonspecific_polymorphism(proc(PredId, _), _),
+ PredNamePieces = describe_one_pred_name(ModuleInfo,
+ should_module_qualify, PredId),
+ Pieces = [words("In") | PredNamePieces] ++ [suffix(":"), nl,
+ words("the code uses polymorphism or type-classes"),
+ words("which are not supported by Aditi.")],
+ write_error_pieces(Context, 0, Pieces, !IO).
+
+magic_util__report_error(ModuleInfo, _Verbose, MagicError - Context, !IO) :-
+ MagicError = curried_argument(proc(PredId, _)),
+ PredNamePieces = describe_one_pred_name(ModuleInfo,
+ should_module_qualify, PredId),
+ Pieces = [words("In") | PredNamePieces] ++ [suffix(":"), nl,
+ words("sorry, curried closure arguments are not"),
words("implemented for Aditi procedures."),
- words("Construct them within the closure instead.")] },
- write_error_pieces(Context, 0, [fixed(PredNamePiece), nl | SecondPart]).
+ words("Construct them within the closure instead.")],
+ write_error_pieces(Context, 0, Pieces, !IO).
-magic_util__report_error(ModuleInfo, _Verbose,
- non_removeable_aditi_state(proc(PredId, _), VarSet, Vars)
- - Context) -->
- { describe_one_pred_name(ModuleInfo, should_module_qualify,
- PredId, PredName) },
- { string__append_list(["In ", PredName, ":"], PredNamePiece) },
- { Vars = [_] ->
+magic_util__report_error(ModuleInfo, _Verbose, MagicError - Context, !IO) :-
+ MagicError = non_removeable_aditi_state(proc(PredId, _), VarSet, Vars),
+ PredNamePieces = describe_one_pred_name(ModuleInfo,
+ should_module_qualify, PredId),
+ InPieces = [words("In") | PredNamePieces] ++ [suffix(":"), nl],
+ ( Vars = [_] ->
VarPiece = words("variable"),
- StatePiece = words("is a non-removable `aditi:state'.")
+ StatePiece = words("is a non-removable `aditi.state'.")
;
VarPiece = words("variables"),
- StatePiece = words("are non-removable `aditi:state's.")
- },
- { list__map(varset__lookup_name(VarSet), Vars, VarNames) },
- { error_util__list_to_pieces(VarNames, VarNamePieces) },
- { list__condense([[fixed(PredNamePiece), nl, VarPiece],
- VarNamePieces, [StatePiece]], Pieces) },
- write_error_pieces(Context, 0, Pieces).
-
-magic_util__report_error(ModuleInfo, Verbose,
- context_error(Error, proc(PredId, _ProcId)) - Context) -->
- { describe_one_pred_name(ModuleInfo, should_module_qualify,
- PredId, PredName) },
- { string__append_list(["In ", PredName, ":"], PredNamePiece) },
- { SecondPart = [words("with `:- pragma context(...)' declaration:"),
- nl, words("error: recursive rule is not linear.\n")] },
- { magic_util__report_linearity_error(ModuleInfo,
- Context, Verbose, Error, LinearityPieces) },
- { list__append([fixed(PredNamePiece), nl | SecondPart],
- LinearityPieces, Pieces) },
- write_error_pieces(Context, 0, Pieces).
-
-magic_util__report_error(ModuleInfo, _Verbose,
- mutually_recursive_context(PredProcId,
- OtherPredProcIds) - Context) -->
- { describe_one_proc_name(ModuleInfo, should_module_qualify,
- PredProcId, ProcPiece) },
- { describe_several_proc_names(ModuleInfo, should_module_qualify,
- OtherPredProcIds, OtherProcPieces) },
- { list__condense(
- [[words("Error: procedure"), words(ProcPiece), words("with a"),
- fixed("`:- pragma context(...)"),
- words("declaration is mutually recursive with")],
- OtherProcPieces, [words(".")]], Pieces) },
- write_error_pieces(Context, 0, Pieces).
-
-magic_util__report_error(ModuleInfo, _Verbose,
- mixed_scc(PredProcIds) - Context) -->
- { describe_several_proc_names(ModuleInfo, should_module_qualify,
- PredProcIds, SCCPieces) },
- { list__condense([
- [words("In the strongly connected component consisting of")],
- SCCPieces,
+ StatePiece = words("are non-removable `aditi.state's.")
+ ),
+ list__map(varset__lookup_name(VarSet), Vars, VarNames),
+ VarNamePieces = error_util__list_to_pieces(VarNames),
+ Pieces = InPieces ++ [VarPiece] ++ VarNamePieces ++ [StatePiece],
+ write_error_pieces(Context, 0, Pieces, !IO).
+
+magic_util__report_error(ModuleInfo, Verbose, MagicError - Context, !IO) :-
+ MagicError = context_error(Error, proc(PredId, _ProcId)),
+ PredNamePieces = describe_one_pred_name(ModuleInfo,
+ should_module_qualify, PredId),
+ magic_util__report_linearity_error(ModuleInfo,
+ Context, Verbose, Error, LinearityPieces),
+ Pieces = [words("In") | PredNamePieces] ++ [suffix(":"), nl,
+ words("with `:- pragma context(...)' declaration:"), nl,
+ words("error: recursive rule is not linear.")]
+ ++ LinearityPieces,
+ write_error_pieces(Context, 0, Pieces, !IO).
+
+magic_util__report_error(ModuleInfo, _Verbose, MagicError - Context, !IO) :-
+ MagicError = mutually_recursive_context(PredProcId, OtherPredProcIds),
+ ProcPieces = describe_one_proc_name(ModuleInfo,
+ should_module_qualify, PredProcId),
+ OtherProcPieces = describe_several_proc_names(ModuleInfo,
+ should_module_qualify, OtherPredProcIds),
+ Pieces = [words("Error: procedure")] ++ ProcPieces ++
+ [words("with a"), fixed("`:- pragma context(...)'"),
+ words("declaration is mutually recursive with")]
+ ++ OtherProcPieces ++ [suffix(".")],
+ write_error_pieces(Context, 0, Pieces, !IO).
+
+magic_util__report_error(ModuleInfo, _Verbose, MagicError - Context, !IO) :-
+ MagicError = mixed_scc(PredProcIds),
+ SCCPieces = describe_several_proc_names(ModuleInfo,
+ should_module_qualify, PredProcIds),
+ Pieces = [words("In the strongly connected component consisting of")]
+ ++ SCCPieces ++
[words("some, but not all procedures are marked"),
- words("for Aditi compilation.")]], Pieces) },
- write_error_pieces(Context, 0, Pieces).
+ words("for Aditi compilation.")],
+ write_error_pieces(Context, 0, Pieces, !IO).
:- pred magic_util__error_arg_id_piece(magic_arg_id::in,
format_component::out) is det.
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.490
diff -u -b -r1.490 make_hlds.m
--- compiler/make_hlds.m 6 Jan 2005 04:30:53 -0000 1.490
+++ compiler/make_hlds.m 16 Jan 2005 03:43:51 -0000
@@ -2523,7 +2523,7 @@
error_util__describe_sym_name_and_arity(
SymName / Arity)),
Expansions),
- error_util__list_to_pieces(Pieces0, Pieces1),
+ Pieces1 = error_util__list_to_pieces(Pieces0),
Pieces = append_punctuation(
[words("Error: circular equivalence"),
fixed(Kinds) | Pieces1], '.'),
Index: compiler/options_file.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options_file.m,v
retrieving revision 1.23
diff -u -b -r1.23 options_file.m
--- compiler/options_file.m 30 Jun 2004 02:48:08 -0000 1.23
+++ compiler/options_file.m 16 Jan 2005 03:44:18 -0000
@@ -532,10 +532,9 @@
io__get_line_number(LineNumber, !IO),
Context = term__context_init(FileName, LineNumber),
- error_util__list_to_pieces(
+ VarList = error_util__list_to_pieces(
list__map((func(Var) = "`" ++ Var ++ "'"),
- list__sort_and_remove_dups(UndefVars)),
- VarList),
+ list__sort_and_remove_dups(UndefVars))),
( Rest = [], Word = "variable", IsOrAre = "is"
; Rest = [_ | _], Word = "variables", IsOrAre = "are"
),
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.67
diff -u -b -r1.67 purity.m
--- compiler/purity.m 5 Sep 2004 23:52:43 -0000 1.67
+++ compiler/purity.m 16 Jan 2005 05:34:53 -0000
@@ -126,39 +126,42 @@
% ; (semipure)
% ; (impure).
-% Purity check a whole module. Also do the post-typecheck stuff
-% described above, and eliminate double negations and calls
-% to `private_builtin.unsafe_type_cast/2'.
-% The first argument specifies whether there were any type
-% errors (if so, we suppress some diagnostics in post_typecheck.m
-% because they are usually spurious).
-% The third argument specifies whether post_typecheck.m detected
-% any errors that would cause problems for later passes
-% (if so, we stop compilation after this pass).
-
+ % Purity check a whole module. Also do the post-typecheck stuff
+ % described above, and eliminate double negations and calls
+ % to `private_builtin.unsafe_type_cast/2'.
+ % The first argument specifies whether there were any type
+ % errors (if so, we suppress some diagnostics in post_typecheck.m
+ % because they are usually spurious).
+ % The third argument specifies whether post_typecheck.m detected
+ % any errors that would cause problems for later passes
+ % (if so, we stop compilation after this pass).
+ %
:- pred puritycheck(bool::in, bool::out, module_info::in, module_info::out,
- io__state::di, io__state::uo) is det.
-
-% Rerun purity checking on a procedure after an optimization pass has
-% performed transformations which might affect the procedure's purity.
-% repuritycheck_proc makes sure that the goal_infos contain the correct
-% purity, and that the pred_info contains the promised_pure or
-% promised_semipure markers which might be needed if a promised pure
-% procedure was inlined into the procedure being checked.
+ io::di, io::uo) is det.
+ % Rerun purity checking on a procedure after an optimization pass has
+ % performed transformations which might affect the procedure's purity.
+ % repuritycheck_proc makes sure that the goal_infos contain the correct
+ % purity, and that the pred_info contains the promised_pure or
+ % promised_semipure markers which might be needed if a promised pure
+ % procedure was inlined into the procedure being checked.
+ %
:- pred repuritycheck_proc(module_info::in, pred_proc_id::in, pred_info::in,
pred_info::out) is det.
-% Sort of a "maximum" for impurity.
+ % Sort of a "maximum" for impurity.
+ %
:- func worst_purity(purity, purity) = purity.
-% Compare two purities.
+ % Compare two purities.
+ %
:- pred less_pure(purity::in, purity::in) is semidet.
-% Give an error message for unifications marked impure/semipure that are
-% not function calls (e.g. impure X = 4)
+ % Give an error message for unifications marked impure/semipure
+ % that are not function calls (e.g. impure X = 4)
+ %
:- pred impure_unification_expr_error(prog_context::in, purity::in,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
:- implementation.
@@ -169,6 +172,7 @@
:- import_module check_hlds__type_util.
:- import_module check_hlds__typecheck.
:- import_module check_hlds__unify_proc.
+:- import_module hlds__hlds_error_util.
:- import_module hlds__hlds_data.
:- import_module hlds__hlds_goal.
:- import_module hlds__hlds_out.
@@ -188,6 +192,7 @@
:- import_module assoc_list, bool, int, list, set.
%-----------------------------------------------------------------------------%
+%
% Public Predicates
puritycheck(FoundTypeError, PostTypecheckError, !HLDS, !IO) :-
@@ -218,11 +223,10 @@
%-----------------------------------------------------------------------------%
-% Purity-check the code for all the predicates in a module
+ % Purity-check the code for all the predicates in a module.
:- pred check_preds_purity(bool::in, bool::out,
- module_info::in, module_info::out, io__state::di, io__state::uo)
- is det.
+ module_info::in, module_info::out, io::di, io::uo) is det.
check_preds_purity(FoundTypeError, PostTypecheckError, !ModuleInfo, !IO) :-
module_info_predids(!.ModuleInfo, PredIds),
@@ -241,7 +245,7 @@
:- pred check_preds_purity_2(list(pred_id)::in,
module_info::in, module_info::out, int::in, int::out,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
check_preds_purity_2([], !ModuleInfo, !NumErrors, !IO).
check_preds_purity_2([PredId | PredIds], !ModuleInfo, !NumErrors, !IO) :-
@@ -274,6 +278,7 @@
% Purity-check the code for single predicate, reporting any errors.
%-----------------------------------------------------------------------------%
+%
% Check purity of a single predicate
%
% Purity checking is quite simple. Since impurity /must/ be declared, we can
@@ -292,7 +297,7 @@
% turned into the appropriate feature in the hlds_goal_info.)
:- pred puritycheck_pred(pred_id::in, pred_info::in, pred_info::out,
- module_info::in, int::out, io__state::di, io__state::uo) is det.
+ module_info::in, int::out, io::di, io::uo) is det.
puritycheck_pred(PredId, !PredInfo, ModuleInfo, NumErrors, !IO) :-
pred_info_get_purity(!.PredInfo, DeclPurity) ,
@@ -571,8 +576,8 @@
FixModes = modes_need_fixing,
(
EvalMethod = normal,
- error(
- "compute_expr_purity: modes need fixing for normal lambda_goal")
+ error("compute_expr_purity: modes need " ++
+ "fixing for normal lambda_goal")
;
EvalMethod = (aditi_bottom_up),
% Make sure `aditi_bottom_up' expressions have
@@ -609,9 +614,7 @@
RunPostTypecheck = no,
Goal1 = Unif0 - GoalInfo
),
- (
- Goal1 = unify(_, _, _, _, _) - _
- ->
+ ( Goal1 = unify(_, _, _, _, _) - _ ->
check_higher_order_purity(GoalInfo, ConsId,
Var, Args, ActualPurity, !Info),
Goal = Goal1
@@ -655,6 +658,7 @@
( legacy_purity_behaviour(Attributes) = yes ->
% get the purity from the declaration, and set it
% here so that it is correct for later use
+
module_info_pred_info(ModuleInfo, PredId, PredInfo),
pred_info_get_purity(PredInfo, Purity),
set_purity(Purity, Attributes, NewAttributes),
@@ -746,6 +750,7 @@
% DeclaredPurity: The declared purity of the pred
% InPragmaCCode: Is this a pragma c code?
% Promised: Did we promise this pred as pure?
+ %
:- pred perform_pred_purity_checks(pred_info::in, purity::in, purity::in,
purity::in, purity_check_result::out) is det.
@@ -772,9 +777,7 @@
;
less_pure(ActualPurity, DeclaredPurity)
->
- (
- PromisedPurity = (impure)
- ->
+ ( PromisedPurity = (impure) ->
PurityCheckResult = insufficient_decl
;
PurityCheckResult = no_worries
@@ -793,7 +796,7 @@
% We don't warn about exaggerated impurity declarations
% for "stub" procedures, i.e. procedures which
% originally had no clauses.
- %
+
pred_info_get_markers(PredInfo, Markers),
pred_info_get_goal_type(PredInfo, GoalType),
(
@@ -850,6 +853,7 @@
% class methods or instance methods --- it just
% means that the predicate provided as an
% implementation was more pure than necessary.
+
pred_info_get_markers(PredInfo, Markers),
(
check_marker(Markers, class_method)
@@ -872,9 +876,9 @@
compute_expr_purity(Goal0, Goal, GoalInfo0, Purity, !Info),
add_goal_info_purity_feature(GoalInfo0, Purity, GoalInfo).
-% Compute the purity of a list of hlds_goals. Since the purity of a
-% disjunction is computed the same way as the purity of a conjunction, we use
-% the same code for both
+ % Compute the purity of a list of hlds_goals. Since the purity of a
+ % disjunction is computed the same way as the purity of a conjunction,
+ % we use the same code for both
:- pred compute_goals_purity(list(hlds_goal)::in, list(hlds_goal)::out,
purity::in, purity::out, purity_info::in, purity_info::out) is det.
@@ -929,54 +933,64 @@
%-----------------------------------------------------------------------------%
+:- func pred_context(module_info, pred_info, pred_id) = list(format_component).
+
+pred_context(ModuleInfo, _PredInfo, PredId) = Pieces :-
+ PredPieces = describe_one_pred_name(ModuleInfo, should_module_qualify,
+ PredId),
+ Pieces = [words("In")] ++ PredPieces ++ [suffix(":"), nl].
+
:- pred error_inconsistent_promise(module_info::in, pred_info::in,
- pred_id::in, purity::in, io__state::di, io__state::uo) is det.
+ pred_id::in, purity::in, io::di, io::uo) is det.
-error_inconsistent_promise(ModuleInfo, PredInfo, PredId, Purity) -->
- { pred_info_context(PredInfo, Context) },
- write_context_and_pred_id(ModuleInfo, PredInfo, PredId),
- prog_out__write_context(Context),
- report_warning(" warning: declared `"),
- prog_out__write_purity(Purity),
- io__write_string("' but promised pure.\n"),
- globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
- ( { VerboseErrors = yes } ->
- { PredOrFunc = pred_info_is_pred_or_func(PredInfo) },
- prog_out__write_context(Context),
- io__write_string(" A pure "),
- prog_out__write_pred_or_func(PredOrFunc),
- io__write_string(" that invokes impure or semipure code should\n"),
- prog_out__write_context(Context),
- io__write_string(
- " be promised pure and should have no impurity declaration.\n"
- )
+error_inconsistent_promise(ModuleInfo, PredInfo, PredId, Purity, !IO) :-
+ pred_info_context(PredInfo, Context),
+ PredOrFunc = pred_info_is_pred_or_func(PredInfo),
+ PredOrFuncStr = pred_or_func_to_full_str(PredOrFunc),
+ purity_name(Purity, PurityName),
+ PredContextPieces = pred_context(ModuleInfo, PredInfo, PredId),
+ Pieces1 = PredContextPieces ++
+ [words("warning: declared"), fixed(PurityName),
+ words("but promised pure.")],
+ globals__io_lookup_bool_option(verbose_errors, VerboseErrors, !IO),
+ (
+ VerboseErrors = yes,
+ Pieces = Pieces1 ++
+ [words("A pure"), fixed(PredOrFuncStr),
+ words("that invokes impure or semipure code"),
+ words("should be promised pure and should have"),
+ words("no impurity declaration.")]
;
- []
- ).
+ VerboseErrors = no,
+ Pieces = Pieces1
+ ),
+ write_error_pieces(Context, 0, Pieces, !IO),
+ record_warning(!IO).
:- pred warn_exaggerated_impurity_decl(module_info::in, pred_info::in,
pred_id::in, purity::in, purity::in,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
warn_exaggerated_impurity_decl(ModuleInfo, PredInfo, PredId,
- DeclPurity, ActualPurity) -->
- { pred_info_context(PredInfo, Context) },
- write_context_and_pred_id(ModuleInfo, PredInfo, PredId),
- prog_out__write_context(Context),
- report_warning(" warning: declared `"),
- write_purity(DeclPurity),
- io__write_string("' but actually "),
- write_purity(ActualPurity),
- io__write_string(".\n").
+ DeclPurity, ActualPurity, !IO) :-
+ pred_info_context(PredInfo, Context),
+ PredContextPieces = pred_context(ModuleInfo, PredInfo, PredId),
+ purity_name(DeclPurity, DeclPurityName),
+ purity_name(ActualPurity, ActualPurityName),
+ Pieces = PredContextPieces ++
+ [words("warning: declared"), fixed(DeclPurityName),
+ words("but actually"), fixed(ActualPurityName ++ ".")],
+ write_error_pieces(Context, 0, Pieces, !IO),
+ record_warning(!IO).
:- pred warn_unnecessary_promise_pure(module_info::in, pred_info::in,
- pred_id::in, purity::in, io__state::di, io__state::uo) is det.
+ pred_id::in, purity::in, io::di, io::uo) is det.
-warn_unnecessary_promise_pure(ModuleInfo, PredInfo, PredId, PromisedPurity) -->
- { pred_info_context(PredInfo, Context) },
- write_context_and_pred_id(ModuleInfo, PredInfo, PredId),
- prog_out__write_context(Context),
- {
+warn_unnecessary_promise_pure(ModuleInfo, PredInfo, PredId, PromisedPurity,
+ !IO) :-
+ pred_info_context(PredInfo, Context),
+ PredContextPieces = pred_context(ModuleInfo, PredInfo, PredId),
+ (
PromisedPurity = pure,
Pragma = "promise_pure",
CodeStr = "impure or semipure"
@@ -987,59 +1001,56 @@
;
PromisedPurity = (impure),
error("purity__warn_unnecessary_promise_pure: promise_impure?")
- },
-
- report_warning(" warning: unnecessary `"),
- io__write_string(Pragma),
- io__write_string("' pragma.\n"),
- globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
- ( { VerboseErrors = yes } ->
- prog_out__write_context(Context),
- { PredOrFunc = pred_info_is_pred_or_func(PredInfo) },
- io__write_string(" This "),
- prog_out__write_pred_or_func(PredOrFunc),
- io__write_string(" does not invoke any "),
- io__write_string(CodeStr),
- io__write_string(" code,\n"),
- prog_out__write_context(Context),
- io__write_string(" so there is no need for a `"),
- io__write_string(Pragma),
- io__write_string("' pragma.\n")
+ ),
+ Pieces1 = [words("warning: unnecessary `" ++ Pragma ++ "' pragma."),
+ nl],
+ globals__io_lookup_bool_option(verbose_errors, VerboseErrors, !IO),
+ (
+ VerboseErrors = yes,
+ PredOrFunc = pred_info_is_pred_or_func(PredInfo),
+ PredOrFuncStr = pred_or_func_to_full_str(PredOrFunc),
+ Pieces2 = [words("This"), fixed(PredOrFuncStr),
+ words("does not invoke any"), fixed(CodeStr),
+ words("code, so there is no need for a"),
+ words("`" ++ Pragma ++ "' pragma.")],
+ Pieces = PredContextPieces ++ Pieces1 ++ Pieces2
;
- []
- ).
+ VerboseErrors = no,
+ Pieces = PredContextPieces ++ Pieces1
+ ),
+ write_error_pieces(Context, 0, Pieces, !IO),
+ record_warning(!IO).
:- pred error_inferred_impure(module_info::in, pred_info::in, pred_id::in,
- purity::in, io__state::di, io__state::uo) is det.
+ purity::in, io::di, io::uo) is det.
-error_inferred_impure(ModuleInfo, PredInfo, PredId, Purity) -->
- { pred_info_context(PredInfo, Context) },
- { PredOrFunc = pred_info_is_pred_or_func(PredInfo) },
- write_context_and_pred_id(ModuleInfo, PredInfo, PredId),
- prog_out__write_context(Context),
- io__write_string(" purity error: "),
- prog_out__write_pred_or_func(PredOrFunc),
- io__write_string(" is "),
- prog_out__write_purity(Purity),
- io__write_string(".\n"),
- prog_out__write_context(Context),
- { pred_info_get_purity(PredInfo, DeclaredPurity) },
- ( { is_unify_or_compare_pred(PredInfo) } ->
- io__write_string(" It must be pure.\n")
- ;
- io__write_string(" It must be declared `"),
- prog_out__write_purity(Purity),
- io__write_string("' or promised "),
- prog_out__write_purity(DeclaredPurity),
- io__write_string(".\n")
- ).
+error_inferred_impure(ModuleInfo, PredInfo, PredId, Purity, !IO) :-
+ pred_info_context(PredInfo, Context),
+ PredOrFunc = pred_info_is_pred_or_func(PredInfo),
+ PredOrFuncStr = pred_or_func_to_full_str(PredOrFunc),
+ PredContextPieces = pred_context(ModuleInfo, PredInfo, PredId),
+ pred_info_get_purity(PredInfo, DeclaredPurity),
+ purity_name(Purity, PurityName),
+ purity_name(DeclaredPurity, DeclaredPurityName),
+
+ Pieces1 = [words("purity error:"), fixed(PredOrFuncStr),
+ words("is"), fixed(PurityName ++ "."), nl],
+ ( is_unify_or_compare_pred(PredInfo) ->
+ Pieces2 = [words("It must be pure.")]
+ ;
+ Pieces2 = [words("It must be declared"),
+ fixed("`" ++ PurityName ++ "'"),
+ words("or promised"),
+ fixed(DeclaredPurityName ++ ".")]
+ ),
+ write_error_pieces(Context, 0, PredContextPieces ++ Pieces1 ++ Pieces2,
+ !IO).
% Errors and warnings reported by purity.m and post_typecheck.m
% for problems within a goal.
:- type post_typecheck_message
---> error(post_typecheck_error)
- ; warning(post_typecheck_warning)
- .
+ ; warning(post_typecheck_warning).
:- type post_typecheck_messages == list(post_typecheck_message).
@@ -1048,143 +1059,129 @@
; closure_purity_error(prog_context, purity, purity)
% closure_purity_error(Context, DeclaredPurity, ActualPurity)
; impure_unification_expr_error(prog_context, purity)
- ; aditi_builtin_error(aditi_builtin_error)
- .
+ ; aditi_builtin_error(aditi_builtin_error).
:- type post_typecheck_warning
---> unnecessary_body_impurity_decl(prog_context, pred_id, purity).
:- pred report_post_typecheck_message(module_info::in,
- post_typecheck_message::in, io__state::di, io__state::uo) is det.
+ post_typecheck_message::in, io::di, io::uo) is det.
-report_post_typecheck_message(ModuleInfo, error(Message)) -->
- io__set_exit_status(1),
+report_post_typecheck_message(ModuleInfo, error(Message), !IO) :-
+ io__set_exit_status(1, !IO),
(
- { Message = missing_body_impurity_error(Context, PredId) },
- error_missing_body_impurity_decl(ModuleInfo, PredId, Context)
+ Message = missing_body_impurity_error(Context, PredId),
+ error_missing_body_impurity_decl(ModuleInfo, PredId, Context,
+ !IO)
;
- { Message = closure_purity_error(Context, DeclaredPurity,
- ActualPurity) },
+ Message = closure_purity_error(Context, DeclaredPurity,
+ ActualPurity),
report_error_closure_purity(Context, DeclaredPurity,
- ActualPurity)
+ ActualPurity, !IO)
;
- { Message = impure_unification_expr_error(Context, Purity) },
- impure_unification_expr_error(Context, Purity)
+ Message = impure_unification_expr_error(Context, Purity),
+ impure_unification_expr_error(Context, Purity, !IO)
;
- { Message = aditi_builtin_error(AditiError) },
- report_aditi_builtin_error(AditiError)
+ Message = aditi_builtin_error(AditiError),
+ report_aditi_builtin_error(AditiError, !IO)
).
-report_post_typecheck_message(ModuleInfo,
- warning(unnecessary_body_impurity_decl(Context,
- PredId, DeclaredPurity))) -->
- globals__io_lookup_bool_option(halt_at_warn, HaltAtWarn),
+report_post_typecheck_message(ModuleInfo, Warning, !IO) :-
+ Warning = warning(unnecessary_body_impurity_decl(Context,
+ PredId, DeclaredPurity)),
+ globals__io_lookup_bool_option(halt_at_warn, HaltAtWarn, !IO),
(
- { HaltAtWarn = yes },
- io__set_exit_status(1)
+ HaltAtWarn = yes,
+ io__set_exit_status(1, !IO)
;
- { HaltAtWarn = no }
+ HaltAtWarn = no
),
warn_unnecessary_body_impurity_decl(ModuleInfo, PredId, Context,
- DeclaredPurity).
+ DeclaredPurity, !IO).
:- pred error_missing_body_impurity_decl(module_info::in, pred_id::in,
- prog_context::in, io__state::di, io__state::uo) is det.
+ prog_context::in, io::di, io::uo) is det.
-error_missing_body_impurity_decl(ModuleInfo, PredId, Context) -->
- prog_out__write_context(Context),
- io__write_string("In call to "),
- write_purity(Purity),
- io__write_string(" "),
- hlds_out__write_pred_id(ModuleInfo, PredId),
- io__write_string(":\n"),
- prog_out__write_context(Context),
- { module_info_pred_info(ModuleInfo, PredId, PredInfo) },
- { PredOrFunc = pred_info_is_pred_or_func(PredInfo) },
- { pred_info_get_purity(PredInfo, Purity) },
- ( { PredOrFunc = predicate } ->
- io__write_string(" purity error: call must be preceded by `"),
- write_purity(Purity),
- io__write_string("' indicator.\n")
- ;
- io__write_string(" purity error: call must be " ++
- "in an explicit unification\n"),
- prog_out__write_context(Context),
- io__write_string(" which is preceded by `"),
- write_purity(Purity),
- io__write_string("' indicator.\n")
- ).
+error_missing_body_impurity_decl(ModuleInfo, PredId, Context, !IO) :-
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ PredOrFunc = pred_info_is_pred_or_func(PredInfo),
+ pred_info_get_purity(PredInfo, Purity),
+ purity_name(Purity, PurityName),
+ PredPieces = describe_one_pred_name(ModuleInfo, should_module_qualify,
+ PredId),
+ Pieces1 = [words("In call to "), fixed(PurityName)] ++
+ PredPieces ++ [suffix(":"), nl],
+ (
+ PredOrFunc = predicate,
+ Pieces2 = [words("purity error: call must be preceded by"),
+ fixed("`" ++ PurityName ++ "'"),
+ words("indicator.")]
+ ;
+ PredOrFunc = function,
+ Pieces2 = [words("purity error: call must be in an " ++
+ "explicit unification which is preceded by"),
+ fixed("`" ++ PurityName ++ "'"),
+ words("indicator.")]
+ ),
+ write_error_pieces(Context, 0, Pieces1 ++ Pieces2, !IO).
:- pred warn_unnecessary_body_impurity_decl(module_info::in, pred_id::in,
- prog_context::in, purity::in, io__state::di, io__state::uo) is det.
+ prog_context::in, purity::in, io::di, io::uo) is det.
warn_unnecessary_body_impurity_decl(ModuleInfo, PredId, Context,
- DeclaredPurity) -->
- prog_out__write_context(Context),
- io__write_string("In call to "),
- hlds_out__write_pred_id(ModuleInfo, PredId),
- io__write_string(":\n"),
- prog_out__write_context(Context),
- io__write_string(" warning: unnecessary `"),
- write_purity(DeclaredPurity),
- io__write_string("' indicator.\n"),
- prog_out__write_context(Context),
- { module_info_pred_info(ModuleInfo, PredId, PredInfo) },
- { pred_info_get_purity(PredInfo, ActualPurity) },
- ( { ActualPurity = pure } ->
- io__write_string(" No purity indicator is necessary.\n")
- ;
- io__write_string(" A purity indicator of `"),
- write_purity(ActualPurity),
- io__write_string("' is sufficient.\n")
- ).
+ DeclaredPurity, !IO) :-
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_get_purity(PredInfo, ActualPurity),
+ purity_name(DeclaredPurity, DeclaredPurityName),
+ purity_name(ActualPurity, ActualPurityName),
+ PredPieces = describe_one_pred_name(ModuleInfo, should_module_qualify,
+ PredId),
+
+ Pieces1 = [words("In call to")] ++ PredPieces ++ [suffix(":"), nl,
+ words("warning: unnecessary"),
+ fixed("`" ++ DeclaredPurityName ++ "'"),
+ words("indicator."), nl],
+ ( ActualPurity = pure ->
+ Pieces2 = [words("No purity indicator is necessary.")]
+ ;
+ Pieces2 = [words("A purity indicator of"),
+ fixed("`" ++ ActualPurityName ++ "'"),
+ words("is sufficient.")]
+ ),
+ write_error_pieces(Context, 0, Pieces1 ++ Pieces2, !IO).
:- pred check_closure_purity(hlds_goal_info::in, purity::in, purity::in,
purity_info::in, purity_info::out) is det.
-check_closure_purity(GoalInfo, DeclaredPurity, ActualPurity) -->
- ( { ActualPurity `less_pure` DeclaredPurity } ->
- { goal_info_get_context(GoalInfo, Context) },
+check_closure_purity(GoalInfo, DeclaredPurity, ActualPurity, !IO) :-
+ ( ActualPurity `less_pure` DeclaredPurity ->
+ goal_info_get_context(GoalInfo, Context),
purity_info_add_message(error(closure_purity_error(Context,
- DeclaredPurity, ActualPurity)))
+ DeclaredPurity, ActualPurity)), !IO)
;
% we don't bother to warn if the DeclaredPurity is less
% pure than the ActualPurity; that would lead to too many
% spurious warnings.
- []
+ true
).
:- pred report_error_closure_purity(prog_context::in, purity::in, purity::in,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
-report_error_closure_purity(Context, _DeclaredPurity, ActualPurity) -->
- prog_out__write_context(Context),
- io__write_string("Purity error in closure: closure body is "),
- write_purity(ActualPurity),
- io__write_string(",\n"),
- prog_out__write_context(Context),
- io__write_string(" but closure was not declared `"),
- write_purity(ActualPurity),
- io__write_string(".'\n").
-
-:- pred write_context_and_pred_id(module_info::in, pred_info::in, pred_id::in,
- io__state::di, io__state::uo) is det.
-
-write_context_and_pred_id(ModuleInfo, PredInfo, PredId) -->
- { pred_info_context(PredInfo, Context) },
- prog_out__write_context(Context),
- io__write_string("In "),
- hlds_out__write_pred_id(ModuleInfo, PredId),
- io__write_string(":\n").
-
-impure_unification_expr_error(Context, Purity) -->
- prog_out__write_context(Context),
- io__write_string(
- "Purity error: unification with expression was declared\n"),
- prog_out__write_context(Context),
- io__write_string(" "),
- write_purity(Purity),
- io__write_string(", but expression was not a function call.\n").
+report_error_closure_purity(Context, _DeclaredPurity, ActualPurity, !IO) :-
+ purity_name(ActualPurity, ActualPurityName),
+ Pieces = [words("Purity error in closure: closure body is"),
+ fixed(ActualPurityName ++ ","),
+ words("but closure was not declared"),
+ fixed(ActualPurityName ++ ".")],
+ write_error_pieces(Context, 0, Pieces, !IO).
+
+impure_unification_expr_error(Context, Purity, !IO) :-
+ purity_name(Purity, PurityName),
+ Pieces = [words("Purity error: unification with expression"),
+ words("was declared"), fixed(PurityName ++ ","),
+ words("but expression was not a function call.")],
+ write_error_pieces(Context, 0, Pieces, !IO).
%-----------------------------------------------------------------------------%
Index: compiler/rl_exprn.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rl_exprn.m,v
retrieving revision 1.43
diff -u -b -r1.43 rl_exprn.m
--- compiler/rl_exprn.m 20 Oct 2004 09:44:59 -0000 1.43
+++ compiler/rl_exprn.m 15 Jan 2005 11:38:34 -0000
@@ -47,6 +47,7 @@
% to specify which constructor to use.
%
%-----------------------------------------------------------------------------%
+
:- module aditi_backend__rl_exprn.
:- interface.
@@ -1575,8 +1576,9 @@
rl_exprn__call_not_implemented_error(Context,
ModuleInfo, PredId, ProcId, ErrorDescr) :-
- describe_one_proc_name(ModuleInfo, should_module_qualify,
- proc(PredId, ProcId), ProcName),
+ ProcNamePieces = describe_one_proc_name(ModuleInfo,
+ should_module_qualify, proc(PredId, ProcId)),
+ ProcName = error_pieces_to_string(ProcNamePieces),
prog_out__context_to_string(Context, ContextStr),
string__append_list(
[
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.72
diff -u -b -r1.72 table_gen.m
--- compiler/table_gen.m 10 Jan 2005 05:30:24 -0000 1.72
+++ compiler/table_gen.m 15 Jan 2005 11:57:56 -0000
@@ -301,9 +301,9 @@
report_missing_tabled_for_io(ModuleInfo, PredInfo, PredId, ProcId, !IO) :-
pred_info_context(PredInfo, Context),
- describe_one_proc_name(ModuleInfo, should_module_qualify,
- proc(PredId, ProcId), Name),
- Msg = [fixed(Name), words("contains untabled I/O primitive.")],
+ ProcPieces = describe_one_proc_name(ModuleInfo, should_module_qualify,
+ proc(PredId, ProcId)),
+ Msg = ProcPieces ++ [words("contains untabled I/O primitive.")],
error_util__write_error_pieces(Context, 0, Msg, !IO).
:- pred report_bad_mode_for_tabling(module_info::in, pred_info::in,
@@ -313,10 +313,10 @@
report_bad_mode_for_tabling(ModuleInfo, PredInfo, PredId, ProcId, VarSet, Vars,
!IO) :-
pred_info_context(PredInfo, Context),
- describe_one_proc_name(ModuleInfo, should_module_qualify,
- proc(PredId, ProcId), Name),
+ ProcPieces = describe_one_proc_name(ModuleInfo, should_module_qualify,
+ proc(PredId, ProcId)),
lookup_var_names(VarSet, Vars, VarNames),
- Msg = [fixed(Name), words("contains arguments"),
+ Msg = ProcPieces ++ [words("contains arguments"),
words("whose mode is incompatible with tabling;"), nl,
words("these arguments are"), words(VarNames)],
error_util__write_error_pieces(Context, 0, Msg, !IO).
@@ -356,12 +356,13 @@
% compilation of the library.
pred_info_context(!.PredInfo, Context),
- describe_one_proc_name(!.ModuleInfo, should_module_qualify,
- proc(PredId, ProcId), Name),
+ ProcPieces = describe_one_proc_name(!.ModuleInfo,
+ should_module_qualify, proc(PredId, ProcId)),
EvalMethodStr = eval_method_to_string(EvalMethod),
Msg = [words("Ignoring the pragma"), fixed(EvalMethodStr),
- words("for"), fixed(Name), words("due to lack of"),
- words("support on this back end."), nl],
+ words("for")] ++ ProcPieces ++
+ [words("due to lack of support"),
+ words("on this back end."), nl],
error_util__write_error_pieces(Context, 0, Msg, !IO),
%
% XXX We set the evaluation method to eval_normal here
Index: compiler/term_errors.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_errors.m,v
retrieving revision 1.26
diff -u -b -r1.26 term_errors.m
--- compiler/term_errors.m 30 Jun 2004 02:48:17 -0000 1.26
+++ compiler/term_errors.m 15 Jan 2005 12:09:09 -0000
@@ -161,17 +161,15 @@
term_errors__report_term_errors(SCC, Errors, Module, !IO) :-
get_context_from_scc(SCC, Module, Context),
( SCC = [PPId] ->
- Pieces0 = [words("Termination of")],
- describe_one_proc_name(Module, should_module_qualify, PPId,
- PredName),
- list__append(Pieces0, [fixed(PredName)], Pieces1),
+ Pieces1 = [words("Termination of")] ++
+ describe_one_proc_name(Module, should_module_qualify,
+ PPId),
Single = yes(PPId)
;
- Pieces0 = [words("Termination of the "),
- words("mutually recursive procedures")],
- describe_several_proc_names(Module, should_module_qualify, SCC,
- ProcNamePieces),
- list__append(Pieces0, ProcNamePieces, Pieces1),
+ Pieces1 = [words("Termination of the "),
+ words("mutually recursive procedures")] ++
+ describe_several_proc_names(Module,
+ should_module_qualify, SCC),
Single = no
),
(
@@ -203,17 +201,15 @@
term_errors__report_arg_size_errors(SCC, Errors, Module, !IO) :-
get_context_from_scc(SCC, Module, Context),
( SCC = [PPId] ->
- Pieces0 = [words("Termination constant of")],
- describe_one_proc_name(Module, should_module_qualify, PPId,
- ProcName),
- list__append(Pieces0, [fixed(ProcName)], Pieces1),
+ Pieces1 = [words("Termination constant of")] ++
+ describe_one_proc_name(Module, should_module_qualify,
+ PPId),
Single = yes(PPId)
;
- Pieces0 = [words("Termination constants"),
- words("of the mutually recursive procedures")],
- describe_several_proc_names(Module, should_module_qualify, SCC,
- ProcNamePieces),
- list__append(Pieces0, ProcNamePieces, Pieces1),
+ Pieces1 = [words("Termination constants"),
+ words("of the mutually recursive procedures")] ++
+ describe_several_proc_names(Module,
+ should_module_qualify, SCC),
Single = no
),
Piece2 = words("set to infinity for the following"),
@@ -296,37 +292,35 @@
(
Single = yes(PPId),
require(unify(PPId, CallerPPId), "caller outside this SCC"),
- Piece1 = words("It")
+ Pieces1 = [words("It")]
;
Single = no,
- describe_one_proc_name(Module, should_module_qualify,
- CallerPPId, ProcName),
- Piece1 = fixed(ProcName)
+ Pieces1 = describe_one_proc_name(Module, should_module_qualify,
+ CallerPPId)
),
Piece2 = words("calls"),
- describe_one_proc_name(Module, should_module_qualify, CalleePPId,
- CalleePiece),
+ CalleePieces = describe_one_proc_name(Module, should_module_qualify,
+ CalleePPId),
Pieces3 = [words("with an unbounded increase"),
words("in the size of the input arguments.")],
- Pieces = [Piece1, Piece2, fixed(CalleePiece) | Pieces3].
+ Pieces = Pieces1 ++ [Piece2] ++ CalleePieces ++ Pieces3.
term_errors__description(can_loop_proc_called(CallerPPId, CalleePPId),
Single, Module, Pieces, no) :-
(
Single = yes(PPId),
require(unify(PPId, CallerPPId), "caller outside this SCC"),
- Piece1 = words("It")
+ Pieces1 = [words("It")]
;
Single = no,
- describe_one_proc_name(Module, should_module_qualify,
- CallerPPId, ProcName),
- Piece1 = fixed(ProcName)
+ Pieces1 = describe_one_proc_name(Module, should_module_qualify,
+ CallerPPId)
),
Piece2 = words("calls"),
- describe_one_proc_name(Module, should_module_qualify,
- CalleePPId, CalleePiece),
- Pieces3 = [words("which could not be proven to terminate.")],
- Pieces = [Piece1, Piece2, fixed(CalleePiece) | Pieces3].
+ CalleePieces = describe_one_proc_name(Module, should_module_qualify,
+ CalleePPId),
+ Piece3 = words("which could not be proven to terminate."),
+ Pieces = Pieces1 ++ [Piece2] ++ CalleePieces ++ [Piece3].
term_errors__description(imported_pred, _, _, Pieces, no) :-
Pieces = [words("It contains one or more"),
@@ -338,36 +332,34 @@
(
Single = yes(PPId),
require(unify(PPId, CallerPPId), "caller outside this SCC"),
- Piece1 = words("It")
+ Pieces1 = [words("It")]
;
Single = no,
- describe_one_proc_name(Module, should_module_qualify,
- CallerPPId, ProcName),
- Piece1 = fixed(ProcName)
+ Pieces1 = describe_one_proc_name(Module, should_module_qualify,
+ CallerPPId)
),
Piece2 = words("calls"),
- describe_one_proc_name(Module, should_module_qualify,
- CalleePPId, CalleePiece),
- Pieces3 = [words("with one or more higher order arguments.")],
- Pieces = [Piece1, Piece2, fixed(CalleePiece) | Pieces3].
+ CalleePieces = describe_one_proc_name(Module, should_module_qualify,
+ CalleePPId),
+ Piece3 = words("with one or more higher order arguments."),
+ Pieces = Pieces1 ++ [Piece2] ++ CalleePieces ++ [Piece3].
term_errors__description(inf_termination_const(CallerPPId, CalleePPId),
Single, Module, Pieces, yes(CalleePPId)) :-
(
Single = yes(PPId),
require(unify(PPId, CallerPPId), "caller outside this SCC"),
- Piece1 = words("It")
+ Pieces1 = [words("It")]
;
Single = no,
- describe_one_proc_name(Module, should_module_qualify,
- CallerPPId, ProcName),
- Piece1 = fixed(ProcName)
+ Pieces1 = describe_one_proc_name(Module, should_module_qualify,
+ CallerPPId)
),
Piece2 = words("calls"),
- describe_one_proc_name(Module, should_module_qualify,
- CalleePPId, CalleePiece),
- Pieces3 = [words("which has a termination constant of infinity.")],
- Pieces = [Piece1, Piece2, fixed(CalleePiece) | Pieces3].
+ CalleePieces = describe_one_proc_name(Module, should_module_qualify,
+ CalleePPId),
+ Piece3 = words("which has a termination constant of infinity."),
+ Pieces = Pieces1 ++ [Piece2] ++ CalleePieces ++ [Piece3].
term_errors__description(not_subset(ProcPPId, OutputSuppliers, HeadVars),
Single, Module, Pieces, no) :-
@@ -379,18 +371,18 @@
;
% XXX this should never happen (but it does)
% error("not_subset outside this SCC"),
- describe_one_proc_name(Module, should_module_qualify,
- ProcPPId, PPIdPiece),
+ PPIdPieces = describe_one_proc_name(Module,
+ should_module_qualify, ProcPPId),
Pieces1 = [words("The set of"),
- words("output supplier variables of"),
- fixed(PPIdPiece)]
+ words("output supplier variables of") |
+ PPIdPieces]
)
;
Single = no,
- describe_one_proc_name(Module, should_module_qualify,
- ProcPPId, PPIdPiece),
- Pieces1 = [words("The set of output supplier variables of"),
- fixed(PPIdPiece)]
+ PPIdPieces = describe_one_proc_name(Module,
+ should_module_qualify, ProcPPId),
+ Pieces1 = [words("The set of output supplier variables of") |
+ PPIdPieces]
),
ProcPPId = proc(PredId, ProcId),
module_info_pred_proc_info(Module, PredId, ProcId, _, ProcInfo),
@@ -408,17 +400,16 @@
term_errors__description(cycle(_StartPPId, CallSites), _, Module, Pieces, no) :-
( CallSites = [DirectCall] ->
- describe_one_call_site(Module, should_module_qualify,
- DirectCall, Site),
- Pieces = [words("At the recursive call to"),
- fixed(Site),
- words("the arguments are"),
+ SitePieces = describe_one_call_site(Module,
+ should_module_qualify, DirectCall),
+ Pieces = [words("At the recursive call to") | SitePieces] ++
+ [words("the arguments are"),
words("not guaranteed to decrease in size.")]
;
Pieces1 = [words("In the recursive cycle"),
words("through the calls to")],
- describe_several_call_sites(Module, should_module_qualify,
- CallSites, SitePieces),
+ SitePieces = describe_several_call_sites(Module,
+ should_module_qualify, CallSites),
Pieces2 = [words("the arguments are"),
words("not guaranteed to decrease in size.")],
list__condense([Pieces1, SitePieces, Pieces2], Pieces)
@@ -449,15 +440,13 @@
PPId = proc(SCCPredId, _),
require(unify(PredId, SCCPredId),
"does not terminate pragma outside this SCC"),
- Piece2 = words("it.")
+ Pieces2 = [words("it.")]
;
Single = no,
- describe_one_pred_name(Module, should_module_qualify,
- PredId, Piece2Nodot),
- string__append(Piece2Nodot, ".", Piece2Str),
- Piece2 = fixed(Piece2Str)
+ Pieces2 = describe_one_pred_name(Module, should_module_qualify,
+ PredId) ++ [suffix(".")]
),
- list__append(Pieces1, [Piece2], Pieces).
+ list__append(Pieces1, Pieces2, Pieces).
term_errors__description(inconsistent_annotations, _, _, Pieces, no) :-
Pieces = [words("The termination pragmas are inconsistent.")].
Index: compiler/termination.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/termination.m,v
retrieving revision 1.44
diff -u -b -r1.44 termination.m
--- compiler/termination.m 5 Sep 2004 23:52:46 -0000 1.44
+++ compiler/termination.m 15 Jan 2005 12:18:55 -0000
@@ -190,15 +190,16 @@
proc_info_set_maybe_termination_info(
yes(can_loop([TermErr])), ProcInfo0,
ProcInfo),
+ ProcNamePieces =
describe_one_proc_name(!.Module,
- should_module_qualify, PPId, ProcName),
+ should_module_qualify, PPId),
Piece1 = words("has a `pragma terminates'"),
Piece2 = words("declaration but also has the"),
Piece3 = words("`does_not_terminate' foreign"),
Piece4 = words("code attribute set."),
- Components = [words("Warning:"),
- fixed(ProcName), Piece1, Piece2,
- Piece3, Piece4],
+ Components = [words("Warning:")] ++
+ ProcNamePieces ++
+ [Piece1, Piece2, Piece3, Piece4],
error_util__report_warning(Context, 0,
Components, !IO)
;
@@ -215,14 +216,15 @@
proc_info_set_maybe_termination_info(
yes(can_loop(TermErrs)),
ProcInfo0, ProcInfo),
- describe_one_proc_name(!.Module,
- should_module_qualify, PPId, ProcName),
+ ProcNamePieces = describe_one_proc_name(!.Module,
+ should_module_qualify, PPId),
Piece1 = words("has a `pragma does_not_terminate'"),
Piece2 = words("declaration but also has the"),
Piece3 = words("`terminates' foreign code"),
Piece4 = words("attribute set."),
- Components = [words("Warning:"), fixed(ProcName),
- Piece1, Piece2, Piece3, Piece4],
+ Components = [words("Warning:")] ++
+ ProcNamePieces ++
+ [Piece1, Piece2, Piece3, Piece4],
error_util__report_warning(Context, 0, Components,
!IO)
;
@@ -301,13 +303,13 @@
PredIds = list__map((func(proc(PredId, _)) = PredId),
SCCTerminationKnown),
- describe_several_pred_names(!.Module,
- should_module_qualify, PredIds, PredNames),
+ PredNamesPieces = describe_several_pred_names(!.Module,
+ should_module_qualify, PredIds),
Piece1 = words(
"are mutually recursive but some of their"),
Piece2 = words(
"termination pragmas are inconsistent."),
- Components = [words("Warning:")] ++ PredNames ++
+ Components = [words("Warning:")] ++ PredNamesPieces ++
[Piece1, Piece2],
error_util__report_warning(Context, 0, Components, !IO)
)
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.358
diff -u -b -r1.358 typecheck.m
--- compiler/typecheck.m 5 Sep 2004 23:52:48 -0000 1.358
+++ compiler/typecheck.m 16 Jan 2005 03:44:31 -0000
@@ -362,8 +362,9 @@
;
true
),
- describe_one_pred_name(!.ModuleInfo, should_module_qualify,
- PredId, PredName),
+ PredPieces = describe_one_pred_name(!.ModuleInfo,
+ should_module_qualify, PredId),
+ PredName = error_pieces_to_string(PredPieces),
generate_stub_clause(PredName, !PredInfo, !.ModuleInfo,
StubClause, VarSet0, VarSet),
Clauses1 = [StubClause],
@@ -4601,7 +4602,8 @@
prog_out__write_context(Context, !IO),
io__write_string("Inferred ", !IO),
AppendVarNums = no,
- ( PredOrFunc = predicate,
+ (
+ PredOrFunc = predicate,
mercury_output_pred_type(VarSet, ExistQVars, Name, Types,
MaybeDet, Purity, ClassContext, Context, AppendVarNums,
!IO)
@@ -4619,11 +4621,10 @@
report_no_clauses(MessageKind, PredId, PredInfo, ModuleInfo, !IO) :-
pred_info_context(PredInfo, Context),
- describe_one_pred_name(ModuleInfo, should_not_module_qualify, PredId,
- PredName0),
- string__append(PredName0, ".", PredName),
- ErrorMsg = [ words(MessageKind ++ ": no clauses for "),
- fixed(PredName) ],
+ PredPieces = describe_one_pred_name(ModuleInfo,
+ should_not_module_qualify, PredId),
+ ErrorMsg = [words(MessageKind ++ ": no clauses for ") | PredPieces] ++
+ [suffix(".")],
error_util__write_error_pieces(Context, 0, ErrorMsg, !IO).
%-----------------------------------------------------------------------------%
@@ -4637,13 +4638,15 @@
SmallWarning = [fixed(Preamble),
words("warning: highly ambiguous overloading.") ],
globals__io_lookup_bool_option(verbose_errors, VerboseErrors, !IO),
- ( VerboseErrors = yes ->
+ (
+ VerboseErrors = yes,
VerboseWarning = [
words("This may cause type-checking to be very"),
words("slow. It may also make your code"),
words("difficult to understand.") ],
list__append(SmallWarning, VerboseWarning, Warning)
;
+ VerboseErrors = no,
Warning = SmallWarning
),
error_util__report_warning(Context, 0, Warning, !IO).
@@ -5668,8 +5671,7 @@
report_unimported_parents(Context, UnimportedParents, !IO) :-
UnimportedParentDescs = list__map(error_util__describe_sym_name,
UnimportedParents),
- error_util__list_to_pieces(UnimportedParentDescs,
- AllUnimportedParents),
+ AllUnimportedParents = list_to_pieces(UnimportedParentDescs),
error_util__write_error_pieces(Context, 2,
( AllUnimportedParents = [_] ->
[words("(the possible parent module ")]
@@ -6086,9 +6088,10 @@
make_pred_id_preamble(Info, Preamble) :-
typecheck_info_get_module_info(Info, Module),
- typecheck_info_get_predid(Info, PredID),
- describe_one_pred_name(Module, should_not_module_qualify, PredID,
- PredName),
+ typecheck_info_get_predid(Info, PredId),
+ PredPieces = describe_one_pred_name(Module, should_not_module_qualify,
+ PredId),
+ PredName = error_pieces_to_string(PredPieces),
Preamble = "In clause for " ++ PredName ++ ":".
%-----------------------------------------------------------------------------%
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
Index: tests/invalid/aditi_update_errors.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/aditi_update_errors.err_exp,v
retrieving revision 1.8
diff -u -b -r1.8 aditi_update_errors.err_exp
--- tests/invalid/aditi_update_errors.err_exp 14 May 2004 08:40:30 -0000 1.8
+++ tests/invalid/aditi_update_errors.err_exp 15 Jan 2005 17:09:45 -0000
@@ -60,8 +60,8 @@
aditi_update_errors.m:103: warning: variable `_Y' occurs more than once in this scope.
aditi_update_errors.m:166: In clause for predicate `aditi_update_errors.aditi_update_types/2':
aditi_update_errors.m:166: warning: variable `DB' occurs only once in this scope.
-aditi_update_errors.m:007: Error: no clauses for
-aditi_update_errors.m:007: predicate `aditi_update_syntax/2'.
+aditi_update_errors.m:007: Error: no clauses for predicate
+aditi_update_errors.m:007: `aditi_update_syntax/2'.
aditi_update_errors.m:096: In clause for predicate `aditi_update_errors.aditi_update_types/2':
aditi_update_errors.m:096: error: wrong number of arguments (2; should be 3)
aditi_update_errors.m:096: in call to predicate `p'.
Index: tests/invalid/erroneous_throw_promise.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/erroneous_throw_promise.err_exp,v
retrieving revision 1.1
diff -u -b -r1.1 erroneous_throw_promise.err_exp
--- tests/invalid/erroneous_throw_promise.err_exp 10 Dec 2004 07:03:45 -0000 1.1
+++ tests/invalid/erroneous_throw_promise.err_exp 15 Jan 2005 17:10:14 -0000
@@ -1,9 +1,9 @@
-erroneous_throw_promise.m:007: `bar(in)'has determinism erroneous but also has
+erroneous_throw_promise.m:007: `bar(in)' has determinism erroneous but also has
erroneous_throw_promise.m:007: foreign clauses that have a
erroneous_throw_promise.m:007: `will_not_throw_exception' attribute. This
erroneous_throw_promise.m:007: attribute cannot be applied to erroneous
erroneous_throw_promise.m:007: procedures.
-erroneous_throw_promise.m:005: `foo(in)'has determinism erroneous but also has
+erroneous_throw_promise.m:005: `foo(in)' has determinism erroneous but also has
erroneous_throw_promise.m:005: foreign clauses that have a
erroneous_throw_promise.m:005: `will_not_throw_exception' attribute. This
erroneous_throw_promise.m:005: attribute cannot be applied to erroneous
Index: tests/invalid/impure_method_impl.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/impure_method_impl.err_exp,v
retrieving revision 1.4
diff -u -b -r1.4 impure_method_impl.err_exp
--- tests/invalid/impure_method_impl.err_exp 17 Jan 2003 05:57:08 -0000 1.4
+++ tests/invalid/impure_method_impl.err_exp 16 Jan 2005 05:17:24 -0000
@@ -1,10 +1,14 @@
-impure_method_impl.m:017: In call to impure predicate `impure_method_impl.foo_m2/2':
-impure_method_impl.m:017: purity error: call must be preceded by `impure' indicator.
+impure_method_impl.m:017: In call to impure predicate
+impure_method_impl.m:017: `impure_method_impl.foo_m2/2':
+impure_method_impl.m:017: purity error: call must be preceded by `impure'
+impure_method_impl.m:017: indicator.
impure_method_impl.m:017: In type class method implementation:
impure_method_impl.m:017: purity error: predicate is impure.
impure_method_impl.m:017: It must be declared `impure' or promised semipure.
-impure_method_impl.m:016: In call to semipure predicate `impure_method_impl.foo_m1/2':
-impure_method_impl.m:016: purity error: call must be preceded by `semipure' indicator.
+impure_method_impl.m:016: In call to semipure predicate
+impure_method_impl.m:016: `impure_method_impl.foo_m1/2':
+impure_method_impl.m:016: purity error: call must be preceded by `semipure'
+impure_method_impl.m:016: indicator.
impure_method_impl.m:016: In type class method implementation:
impure_method_impl.m:016: purity error: predicate is semipure.
impure_method_impl.m:016: It must be declared `semipure' or promised pure.
Index: tests/invalid/multimode_missing_impure.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/multimode_missing_impure.err_exp,v
retrieving revision 1.2
diff -u -b -r1.2 multimode_missing_impure.err_exp
--- tests/invalid/multimode_missing_impure.err_exp 17 Jan 2003 05:57:09 -0000 1.2
+++ tests/invalid/multimode_missing_impure.err_exp 16 Jan 2005 05:17:30 -0000
@@ -1,7 +1,11 @@
-multimode_missing_impure.m:025: In predicate `multimode_missing_impure.test1/1':
+multimode_missing_impure.m:025: In predicate
+multimode_missing_impure.m:025: `multimode_missing_impure.test1/1':
multimode_missing_impure.m:025: purity error: predicate is impure.
-multimode_missing_impure.m:025: It must be declared `impure' or promised pure.
-multimode_missing_impure.m:034: In predicate `multimode_missing_impure.test2/2':
+multimode_missing_impure.m:025: It must be declared `impure' or promised
+multimode_missing_impure.m:025: pure.
+multimode_missing_impure.m:034: In predicate
+multimode_missing_impure.m:034: `multimode_missing_impure.test2/2':
multimode_missing_impure.m:034: purity error: predicate is impure.
-multimode_missing_impure.m:034: It must be declared `impure' or promised pure.
+multimode_missing_impure.m:034: It must be declared `impure' or promised
+multimode_missing_impure.m:034: pure.
For more information, try recompiling with `-E'.
cvs diff: Diffing tests/invalid/purity
Index: tests/invalid/purity/impure_func_t2.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/purity/impure_func_t2.err_exp,v
retrieving revision 1.2
diff -u -b -r1.2 impure_func_t2.err_exp
--- tests/invalid/purity/impure_func_t2.err_exp 17 Jan 2003 05:57:14 -0000 1.2
+++ tests/invalid/purity/impure_func_t2.err_exp 16 Jan 2005 05:31:17 -0000
@@ -1,4 +1,5 @@
-impure_func_t2.m:016: In call to impure function `impure_func_t2.get_counter/0':
+impure_func_t2.m:016: In call to impure function
+impure_func_t2.m:016: `impure_func_t2.get_counter/0':
impure_func_t2.m:016: purity error: call must be in an explicit unification
impure_func_t2.m:016: which is preceded by `impure' indicator.
For more information, try recompiling with `-E'.
Index: tests/invalid/purity/impure_func_t3.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/purity/impure_func_t3.err_exp,v
retrieving revision 1.2
diff -u -b -r1.2 impure_func_t3.err_exp
--- tests/invalid/purity/impure_func_t3.err_exp 17 Jan 2003 05:57:14 -0000 1.2
+++ tests/invalid/purity/impure_func_t3.err_exp 16 Jan 2005 05:31:55 -0000
@@ -1,4 +1,5 @@
-impure_func_t3.m:017: In call to impure function `impure_func_t3.get_counter/0':
+impure_func_t3.m:017: In call to impure function
+impure_func_t3.m:017: `impure_func_t3.get_counter/0':
impure_func_t3.m:017: purity error: call must be in an explicit unification
impure_func_t3.m:017: which is preceded by `impure' indicator.
impure_func_t3.m:017: In call to predicate `io.print/3':
Index: tests/invalid/purity/impure_func_t4.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/purity/impure_func_t4.err_exp,v
retrieving revision 1.2
diff -u -b -r1.2 impure_func_t4.err_exp
--- tests/invalid/purity/impure_func_t4.err_exp 17 Jan 2003 05:57:14 -0000 1.2
+++ tests/invalid/purity/impure_func_t4.err_exp 16 Jan 2005 05:33:33 -0000
@@ -1,4 +1,5 @@
-impure_func_t4.m:017: In call to semipure function `impure_func_t4.get_counter/0':
+impure_func_t4.m:017: In call to semipure function
+impure_func_t4.m:017: `impure_func_t4.get_counter/0':
impure_func_t4.m:017: purity error: call must be in an explicit unification
impure_func_t4.m:017: which is preceded by `semipure' indicator.
For more information, try recompiling with `-E'.
Index: tests/invalid/purity/purity.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/purity/purity.err_exp,v
retrieving revision 1.7
diff -u -b -r1.7 purity.err_exp
--- tests/invalid/purity/purity.err_exp 14 Jul 2004 05:39:13 -0000 1.7
+++ tests/invalid/purity/purity.err_exp 16 Jan 2005 07:01:05 -0000
@@ -1,15 +1,15 @@
purity.m:035: In predicate `purity.w1/0':
-purity.m:035: warning: declared `impure' but actually pure.
+purity.m:035: warning: declared impure but actually pure.
purity.m:039: In predicate `purity.w2/0':
-purity.m:039: warning: declared `semipure' but actually pure.
+purity.m:039: warning: declared semipure but actually pure.
purity.m:043: In predicate `purity.w3/0':
-purity.m:043: warning: declared `impure' but actually semipure.
+purity.m:043: warning: declared impure but actually semipure.
purity.m:047: In predicate `purity.w4/0':
purity.m:047: warning: unnecessary `promise_pure' pragma.
purity.m:052: In predicate `purity.w5/0':
-purity.m:052: warning: declared `impure' but promised pure.
+purity.m:052: warning: declared impure but promised pure.
purity.m:057: In predicate `purity.w6/0':
-purity.m:057: warning: declared `semipure' but promised pure.
+purity.m:057: warning: declared semipure but promised pure.
purity.m:066: In predicate `purity.e1/0':
purity.m:066: purity error: predicate is impure.
purity.m:066: It must be declared `impure' or promised pure.
@@ -25,16 +25,16 @@
purity.m:085: purity error: call must be preceded by `semipure' indicator.
purity.m:119: In call to impure predicate `purity.imp1/1':
purity.m:119: purity error: call must be preceded by `impure' indicator.
-purity.m:119: Purity error in closure: closure body is impure,
-purity.m:119: but closure was not declared `impure.'
+purity.m:119: Purity error in closure: closure body is impure, but closure was
+purity.m:119: not declared impure.
purity.m:125: In call to semipure predicate `purity.semi/1':
purity.m:125: purity error: call must be preceded by `semipure' indicator.
-purity.m:125: Purity error in closure: closure body is semipure,
-purity.m:125: but closure was not declared `semipure.'
-purity.m:100: In unification predicate for type purity.e8:
+purity.m:125: Purity error in closure: closure body is semipure, but closure
+purity.m:125: was not declared semipure.
+purity.m:100: In unification predicate for type `purity.e8':
purity.m:100: purity error: predicate is impure.
purity.m:100: It must be pure.
-purity.m:108: In unification predicate for type purity.e9:
+purity.m:108: In unification predicate for type `purity.e9':
purity.m:108: purity error: predicate is semipure.
purity.m:108: It must be pure.
purity.m:090: In clause for `e6':
Index: tests/invalid/purity/purity_type_error.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/purity/purity_type_error.err_exp,v
retrieving revision 1.3
diff -u -b -r1.3 purity_type_error.err_exp
--- tests/invalid/purity/purity_type_error.err_exp 1 Dec 2003 15:56:12 -0000 1.3
+++ tests/invalid/purity/purity_type_error.err_exp 16 Jan 2005 05:18:09 -0000
@@ -5,5 +5,5 @@
purity_type_error.m:020: variable `HeadVar__1' has type `int',
purity_type_error.m:020: constant `1.00000000000000' has type `float'.
purity_type_error.m:009: In predicate `purity_type_error.warn/1':
-purity_type_error.m:009: warning: declared `impure' but actually pure.
+purity_type_error.m:009: warning: declared impure but actually pure.
For more information, try recompiling with `-E'.
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
Index: tests/recompilation/typeclass_method_pragma_r.err_exp.2
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/recompilation/typeclass_method_pragma_r.err_exp.2,v
retrieving revision 1.3
diff -u -b -r1.3 typeclass_method_pragma_r.err_exp.2
--- tests/recompilation/typeclass_method_pragma_r.err_exp.2 14 May 2004 08:40:33 -0000 1.3
+++ tests/recompilation/typeclass_method_pragma_r.err_exp.2 16 Jan 2005 05:20:42 -0000
@@ -1,4 +1,4 @@
Recompiling module `typeclass_method_pragma_r':
typeclass `typeclass_method_pragma_r_2.io/1' was modified.
-typeclass_method_pragma_r.m:015: Warning: call to obsolete
-typeclass_method_pragma_r.m:015: predicate `typeclass_method_pragma_r_2.output/3'.
+typeclass_method_pragma_r.m:015: Warning: call to obsolete predicate
+typeclass_method_pragma_r.m:015: `typeclass_method_pragma_r_2.output/3'.
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
Index: tests/warnings/duplicate_call.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/warnings/duplicate_call.exp,v
retrieving revision 1.3
diff -u -b -r1.3 duplicate_call.exp
--- tests/warnings/duplicate_call.exp 14 May 2004 08:40:33 -0000 1.3
+++ tests/warnings/duplicate_call.exp 15 Jan 2005 20:26:20 -0000
@@ -1,4 +1,4 @@
-duplicate_call.m:015: Warning: redundant call to
-duplicate_call.m:015: predicate `duplicate_call.called/3'.
-duplicate_call.m:014: Here is the previous call to
-duplicate_call.m:014: predicate `duplicate_call.called/3'.
+duplicate_call.m:015: Warning: redundant call to predicate
+duplicate_call.m:015: `duplicate_call.called/3'.
+duplicate_call.m:014: Here is the previous call to predicate
+duplicate_call.m:014: `duplicate_call.called/3'.
Index: tests/warnings/duplicate_const.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/warnings/duplicate_const.exp,v
retrieving revision 1.2
diff -u -b -r1.2 duplicate_const.exp
--- tests/warnings/duplicate_const.exp 14 May 2004 08:40:33 -0000 1.2
+++ tests/warnings/duplicate_const.exp 15 Jan 2005 20:26:20 -0000
@@ -1,4 +1,4 @@
-duplicate_const.m:016: Warning: redundant call to
-duplicate_const.m:016: predicate `duplicate_const.called/4'.
-duplicate_const.m:015: Here is the previous call to
-duplicate_const.m:015: predicate `duplicate_const.called/4'.
+duplicate_const.m:016: Warning: redundant call to predicate
+duplicate_const.m:016: `duplicate_const.called/4'.
+duplicate_const.m:015: Here is the previous call to predicate
+duplicate_const.m:015: `duplicate_const.called/4'.
Index: tests/warnings/foreign_term_invalid.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/warnings/foreign_term_invalid.exp,v
retrieving revision 1.1
diff -u -b -r1.1 foreign_term_invalid.exp
--- tests/warnings/foreign_term_invalid.exp 12 Feb 2004 03:36:18 -0000 1.1
+++ tests/warnings/foreign_term_invalid.exp 15 Jan 2005 20:26:13 -0000
@@ -1,10 +1,8 @@
-foreign_term_invalid.m:009: Warning:
-foreign_term_invalid.m:009: predicate `foreign_term_invalid.test1/1' mode 0
-foreign_term_invalid.m:009: has a `pragma does_not_terminate' declaration but
-foreign_term_invalid.m:009: also has the `terminates' foreign code attribute
-foreign_term_invalid.m:009: set.
-foreign_term_invalid.m:010: Warning:
-foreign_term_invalid.m:010: predicate `foreign_term_invalid.test2/1' mode 0
-foreign_term_invalid.m:010: has a `pragma terminates' declaration but also
-foreign_term_invalid.m:010: has the `does_not_terminate' foreign code
+foreign_term_invalid.m:009: Warning: predicate `foreign_term_invalid.test1/1'
+foreign_term_invalid.m:009: mode 0 has a `pragma does_not_terminate'
+foreign_term_invalid.m:009: declaration but also has the `terminates' foreign
+foreign_term_invalid.m:009: code attribute set.
+foreign_term_invalid.m:010: Warning: predicate `foreign_term_invalid.test2/1'
+foreign_term_invalid.m:010: mode 0 has a `pragma terminates' declaration but
+foreign_term_invalid.m:010: also has the `does_not_terminate' foreign code
foreign_term_invalid.m:010: attribute set.
Index: tests/warnings/purity_warnings.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/warnings/purity_warnings.exp,v
retrieving revision 1.1
diff -u -b -r1.1 purity_warnings.exp
--- tests/warnings/purity_warnings.exp 22 Jan 2003 13:44:47 -0000 1.1
+++ tests/warnings/purity_warnings.exp 15 Jan 2005 20:26:29 -0000
@@ -5,14 +5,14 @@
purity_warnings.m:022: warning: unnecessary `impure' indicator.
purity_warnings.m:022: No purity indicator is necessary.
purity_warnings.m:024: In predicate `purity_warnings.impure_pred1/2':
-purity_warnings.m:024: warning: declared `impure' but actually pure.
+purity_warnings.m:024: warning: declared impure but actually pure.
purity_warnings.m:028: In predicate `purity_warnings.impure_pred2/2':
-purity_warnings.m:028: warning: declared `impure' but actually semipure.
+purity_warnings.m:028: warning: declared impure but actually semipure.
purity_warnings.m:036: In call to predicate `io.write_string/3':
purity_warnings.m:036: warning: unnecessary `semipure' indicator.
purity_warnings.m:036: No purity indicator is necessary.
purity_warnings.m:034: In predicate `purity_warnings.semipure_pred/2':
-purity_warnings.m:034: warning: declared `semipure' but actually pure.
+purity_warnings.m:034: warning: declared semipure but actually pure.
purity_warnings.m:065: In call to predicate `io.print/3':
purity_warnings.m:065: warning: unnecessary `impure' indicator.
purity_warnings.m:065: No purity indicator is necessary.
Index: tests/warnings/simple_code.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/warnings/simple_code.exp,v
retrieving revision 1.11
diff -u -b -r1.11 simple_code.exp
--- tests/warnings/simple_code.exp 14 May 2004 08:40:33 -0000 1.11
+++ tests/warnings/simple_code.exp 15 Jan 2005 20:26:30 -0000
@@ -8,6 +8,6 @@
simple_code.m:028: Warning: the negated goal cannot fail.
simple_code.m:028: Warning: the negated goal cannot succeed.
simple_code.m:033: Warning: the negated goal cannot succeed.
-simple_code.m:039: Warning: call to obsolete
-simple_code.m:039: predicate `simple_code.obsolete/0'.
+simple_code.m:039: Warning: call to obsolete predicate
+simple_code.m:039: `simple_code.obsolete/0'.
simple_code.m:099: Warning: recursive call will lead to infinite recursion.
Index: tests/warnings/term_indirect_warning.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/warnings/term_indirect_warning.exp,v
retrieving revision 1.1
diff -u -b -r1.1 term_indirect_warning.exp
--- tests/warnings/term_indirect_warning.exp 12 Jan 2004 05:24:32 -0000 1.1
+++ tests/warnings/term_indirect_warning.exp 16 Jan 2005 05:29:42 -0000
@@ -1,4 +1,4 @@
-term_indirect_warning.m:011: Termination of
-term_indirect_warning.m:011: predicate `term_indirect_warning.foo/3' mode 0
-term_indirect_warning.m:011: not proven for the following reason:
+term_indirect_warning.m:011: Termination of predicate
+term_indirect_warning.m:011: `term_indirect_warning.foo/3' mode 0 not proven
+term_indirect_warning.m:011: for the following reason:
term_indirect_warning.m:016: It contains a higher order call.
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list