[m-rev.] for post-commit review: make type and purity check group error msgs
Zoltan Somogyi
zs at csse.unimelb.edu.au
Tue Sep 12 14:40:44 AEST 2006
Modify the type and purity check passes to gather up all error messages,
and print them all at once after sorting.
compiler/typecheck.m:
compiler/typeclasses.m:
compiler/post_typecheck.m:
compiler/purity.m:
Gather up all error messages instead of printing them when generated.
In some places the gathered list of error specifications allows us
to eliminate error counts and error flags.
Eliminate the last occurrences of io.write_* in these modules,
replacing them with error_specs.
Change the error messages generated by purity.m to eliminate the
unnecessary module qualification of the name of the predicate or
function in which the error occurs.
compiler/typecheck_errors.m:
Turn the predicates here that used to print error messages
into functions that just return the error specification.
compiler/mode_errors.m:
Make a predicate used by post_typecheck.m return an error spec instead
of writing it out.
compiler/typecheck_info.m:
Record the list of errors instead of simple a count of the errors
printed.
compiler/mercury_compile.m:
Print the error message batches returned by type checking and purity
checking.
compiler/error_util.m:
Modify the way we represent severity to allow passes such as
typechecking to count the number of errors *without* printing
anything.
compiler/add_pred.m:
compiler/det_report.m:
compiler/make_hlds_warn.m:
compiler/module_qual.m:
Conform to the change in error_util.m.
compiler/Mercury.options:
Record the fact that some more compiler modules need the workaround
for trace goals.
tests/invalid/*err_exp:
tests/warnings/*exp:
Update the expected output files to conform to the changes above.
This mosly involves expecting sorted messages without duplicates.
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/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/Mercury.options,v
retrieving revision 1.23
diff -u -b -r1.23 Mercury.options
--- compiler/Mercury.options 10 Sep 2006 23:38:57 -0000 1.23
+++ compiler/Mercury.options 11 Sep 2006 14:31:45 -0000
@@ -55,3 +55,6 @@
# XXX temporary bug workaround
MCFLAGS-hlds.make_hlds.add_clause = --no-halt-at-warn
MCFLAGS-hlds.make_hlds.add_pragma = --no-halt-at-warn
+MCFLAGS-check_hlds.purity = --no-halt-at-warn
+MCFLAGS-check_hlds.typecheck = --no-halt-at-warn
+MCFLAGS-check_hlds.typeclasses = --no-halt-at-warn
Index: compiler/add_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pred.m,v
retrieving revision 1.24
diff -u -b -r1.24 add_pred.m
--- compiler/add_pred.m 10 Sep 2006 23:38:58 -0000 1.24
+++ compiler/add_pred.m 11 Sep 2006 04:49:32 -0000
@@ -502,7 +502,8 @@
InnerComponents = [always(MainPieces), verbose_only(VerbosePieces)],
Msg = simple_msg(Context,
[option_is_set(infer_det, no, InnerComponents)]),
- Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
+ Severity = severity_conditional(infer_det, no, severity_error, no),
+ Spec = error_spec(Severity, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs].
:- pred unspecified_det_for_method(sym_name::in, arity::in, pred_or_func::in,
Index: compiler/det_report.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_report.m,v
retrieving revision 1.127
diff -u -b -r1.127 det_report.m
--- compiler/det_report.m 7 Sep 2006 05:50:52 -0000 1.127
+++ compiler/det_report.m 11 Sep 2006 04:45:28 -0000
@@ -1082,7 +1082,9 @@
Pieces = [words("Warning: call to obsolete")] ++ PredPieces
++ [suffix(".")]
),
- Spec = error_spec(severity_warning, phase_detism_check,
+ Severity = severity_conditional(warn_simple_code, yes,
+ severity_warning, no),
+ Spec = error_spec(Severity, phase_detism_check,
[simple_msg(Context,
[option_is_set(warn_simple_code, yes, [always(Pieces)])])])
;
@@ -1114,7 +1116,9 @@
words("with exactly the same input arguments,"),
words("leading to infinite recursion.")]
),
- Spec = error_spec(severity_warning, phase_detism_check,
+ Severity = severity_conditional(warn_simple_code, yes,
+ severity_warning, no),
+ Spec = error_spec(Severity, phase_detism_check,
[simple_msg(Context,
[option_is_set(warn_simple_code, yes,
[always(MainPieces), verbose_only(VerbosePieces)])])])
@@ -1125,7 +1129,9 @@
++ [suffix(".")],
PrevPieces = [words("Here is the previous") | CallPieces]
++ [suffix(".")],
- Spec = error_spec(severity_warning, phase_detism_check,
+ Severity = severity_conditional(warn_duplicate_calls, yes,
+ severity_warning, no),
+ Spec = error_spec(Severity, phase_detism_check,
[simple_msg(Context,
[option_is_set(warn_duplicate_calls, yes,
[always(CurPieces)])]),
@@ -1140,7 +1146,9 @@
words("is nested inside another.")],
OuterPieces = [words("This is the outer"),
words("`promise_equivalent_solution_sets' scope.")],
- Spec = error_spec(severity_warning, phase_detism_check,
+ Severity = severity_conditional(warn_simple_code, yes,
+ severity_warning, no),
+ Spec = error_spec(Severity, phase_detism_check,
[simple_msg(Context,
[option_is_set(warn_simple_code, yes, [always(Pieces)])]),
simple_msg(OuterContext,
@@ -1156,7 +1164,9 @@
Pieces = [words("Unknown format values in call to"),
sym_name_and_arity(SymName / Arity), suffix(".")]
),
- Spec = error_spec(severity_warning, phase_detism_check,
+ Severity = severity_conditional(warn_unknown_format_calls, yes,
+ severity_warning, no),
+ Spec = error_spec(Severity, phase_detism_check,
[simple_msg(Context,
[option_is_set(warn_unknown_format_calls, yes,
[always(Pieces)])])])
@@ -1164,7 +1174,9 @@
DetMsg = bad_format(SymName, Arity, Msg),
Pieces = [words("Mismatched format and values in call to"),
sym_name_and_arity(SymName / Arity), suffix(":"), nl, words(Msg)],
- Spec = error_spec(severity_warning, phase_detism_check,
+ Severity = severity_conditional(warn_known_bad_format_calls, yes,
+ severity_warning, no),
+ Spec = error_spec(Severity, phase_detism_check,
[simple_msg(Context,
[option_is_set(warn_known_bad_format_calls, yes,
[always(Pieces)])])])
Index: compiler/error_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/error_util.m,v
retrieving revision 1.52
diff -u -b -r1.52 error_util.m
--- compiler/error_util.m 7 Sep 2006 05:50:53 -0000 1.52
+++ compiler/error_util.m 11 Sep 2006 05:09:38 -0000
@@ -36,6 +36,7 @@
:- module parse_tree.error_util.
:- interface.
+:- import_module libs.globals.
:- import_module libs.options.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.prog_data.
@@ -76,9 +77,28 @@
% Only set the exit status to indicate an error if --halt-at-warn
% is enabled.
- ; severity_informational.
+ ; severity_informational
% Don't set the exit status to indicate an error.
+ ; severity_conditional(
+ % If the given boolean option has the given value, then the actual
+ % severity is given by the third argument; if it has the other
+ % value, then the actual severity is given by the fourth argument.
+ % If the fourth argument is `no', then the error_spec shouldn't
+ % actually print anything if cond_option doesn't have the value
+ % in cond_option_value.
+
+ cond_option :: option,
+ cond_option_value :: bool,
+ cond_if_match :: error_severity,
+ cond_if_no_match :: maybe(error_severity)
+ ).
+
+:- type actual_severity
+ ---> actual_severity_error
+ ; actual_severity_warning
+ ; actual_severity_informational.
+
:- type error_phase
---> phase_term_to_parse_tree
; phase_parse_tree_to_hlds
@@ -148,10 +168,42 @@
% at start etc), this capability is intended only for messages
% that help debug the compiler itself.
+%-----------------------------------------------------------------------------%
+
+ % Return the worst of two actual severities.
+ %
+:- func worst_severity(actual_severity, actual_severity)
+ = actual_severity.
+
+ % Compute the actual severity of a message with the given severity
+ % (if it actually prints anything).
+ %
+:- func actual_error_severity(globals, error_severity)
+ = maybe(actual_severity).
+
+ % Compute the worst actual severity (if any) occurring a list ofmessages.
+ %
+:- func worst_severity_in_specs(globals, list(error_spec))
+ = maybe(actual_severity).
+
+ % Return `yes' if the given list contains error_specs whose actual severity
+ % is actual_severity_error.
+ %
+:- func contains_errors(globals, list(error_spec)) = bool.
+
+ % Return `yes' if the given list contains error_specs whose actual severity
+ % is actual_severity_error or actual_severity_warning.
+ %
+:- func contains_errors_and_or_warnings(globals, list(error_spec)) = bool.
+
+%-----------------------------------------------------------------------------%
+
:- pred sort_error_specs(list(error_spec)::in, list(error_spec)::out) is det.
:- pred sort_error_msgs(list(error_msg)::in, list(error_msg)::out) is det.
+%-----------------------------------------------------------------------------%
+
% write_error_spec(Spec, !NumWarnings, !NumErrors, !IO):
% write_error_specs(Specs, !NumWarnings, !NumErrors, !IO):
%
@@ -339,7 +391,6 @@
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_util.
:- import_module libs.compiler_util.
-:- import_module libs.globals.
:- import_module char.
:- import_module int.
@@ -349,6 +400,113 @@
%-----------------------------------------------------------------------------%
+worst_severity(actual_severity_error, actual_severity_error) =
+ actual_severity_error.
+worst_severity(actual_severity_error, actual_severity_warning) =
+ actual_severity_error.
+worst_severity(actual_severity_error, actual_severity_informational) =
+ actual_severity_error.
+worst_severity(actual_severity_warning, actual_severity_error) =
+ actual_severity_error.
+worst_severity(actual_severity_warning, actual_severity_warning) =
+ actual_severity_warning.
+worst_severity(actual_severity_warning, actual_severity_informational) =
+ actual_severity_warning.
+worst_severity(actual_severity_informational, actual_severity_error) =
+ actual_severity_error.
+worst_severity(actual_severity_informational, actual_severity_warning) =
+ actual_severity_warning.
+worst_severity(actual_severity_informational, actual_severity_informational) =
+ actual_severity_informational.
+
+actual_error_severity(Globals, Severity) = MaybeActual :-
+ (
+ Severity = severity_error,
+ MaybeActual = yes(actual_severity_error)
+ ;
+ Severity = severity_warning,
+ MaybeActual = yes(actual_severity_warning)
+ ;
+ Severity = severity_informational,
+ MaybeActual = yes(actual_severity_informational)
+ ;
+ Severity = severity_conditional(Option, MatchValue,
+ Match, MaybeNoMatch),
+ globals.lookup_bool_option(Globals, Option, Value),
+ ( Value = MatchValue ->
+ MaybeActual = actual_error_severity(Globals, Match)
+ ;
+ (
+ MaybeNoMatch = no,
+ MaybeActual = no
+ ;
+ MaybeNoMatch = yes(NoMatch),
+ MaybeActual = actual_error_severity(Globals, NoMatch)
+ )
+ )
+ ).
+
+worst_severity_in_specs(Globals, Specs) = MaybeWorst :-
+ worst_severity_in_specs_2(Globals, Specs, no, MaybeWorst).
+
+:- pred worst_severity_in_specs_2(globals::in, list(error_spec)::in,
+ maybe(actual_severity)::in, maybe(actual_severity)::out) is det.
+
+worst_severity_in_specs_2(_Globals, [], !MaybeWorst).
+worst_severity_in_specs_2(Globals, [Spec | Specs], !MaybeWorst) :-
+ Spec = error_spec(Severity, _, _),
+ MaybeThis = actual_error_severity(Globals, Severity),
+ (
+ !.MaybeWorst = no,
+ !:MaybeWorst = MaybeThis
+ ;
+ !.MaybeWorst = yes(_Worst),
+ MaybeThis = no
+ ;
+ !.MaybeWorst = yes(Worst),
+ MaybeThis = yes(This),
+ !:MaybeWorst = yes(worst_severity(Worst, This))
+ ),
+ worst_severity_in_specs_2(Globals, Specs, !MaybeWorst).
+
+contains_errors(Globals, Specs) = Errors :-
+ MaybeWorstActual = worst_severity_in_specs(Globals, Specs),
+ (
+ MaybeWorstActual = no,
+ Errors = no
+ ;
+ MaybeWorstActual = yes(WorstActual),
+ (
+ WorstActual = actual_severity_error,
+ Errors = yes
+ ;
+ ( WorstActual = actual_severity_warning
+ ; WorstActual = actual_severity_informational
+ ),
+ Errors = no
+ )
+ ).
+
+contains_errors_and_or_warnings(Globals, Specs) = ErrorsOrWarnings :-
+ MaybeWorstActual = worst_severity_in_specs(Globals, Specs),
+ (
+ MaybeWorstActual = no,
+ ErrorsOrWarnings = no
+ ;
+ MaybeWorstActual = yes(WorstActual),
+ (
+ ( WorstActual = actual_severity_error
+ ; WorstActual = actual_severity_warning
+ ),
+ ErrorsOrWarnings = yes
+ ;
+ WorstActual = actual_severity_informational,
+ ErrorsOrWarnings = no
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
sort_error_specs(Specs0, Specs) :-
list.sort_and_remove_dups(compare_error_specs, Specs0, Specs).
@@ -431,20 +589,29 @@
Spec = error_spec(Severity, _, Msgs),
do_write_error_msgs(Msgs, Globals, OrigExitStatus, yes, no, PrintedSome,
!IO),
+ MaybeActual = actual_error_severity(Globals, Severity),
(
- PrintedSome = no
+ PrintedSome = no,
+ expect(unify(MaybeActual, no), this_file,
+ "do_write_error_spec: MaybeActual isn't no")
;
PrintedSome = yes,
(
- Severity = severity_error,
+ MaybeActual = yes(Actual),
+ (
+ Actual = actual_severity_error,
!:NumErrors = !.NumErrors + 1,
io.set_exit_status(1, !IO)
;
- Severity = severity_warning,
+ Actual = actual_severity_warning,
!:NumWarnings = !.NumWarnings + 1,
record_warning(!IO)
;
- Severity = severity_informational
+ Actual = actual_severity_informational
+ )
+ ;
+ MaybeActual = no,
+ unexpected(this_file, "do_write_error_spec: MaybeActual is no")
)
).
Index: compiler/make_hlds_warn.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds_warn.m,v
retrieving revision 1.18
diff -u -b -r1.18 make_hlds_warn.m
--- compiler/make_hlds_warn.m 10 Sep 2006 23:39:02 -0000 1.18
+++ compiler/make_hlds_warn.m 11 Sep 2006 04:59:54 -0000
@@ -111,7 +111,9 @@
Msg = simple_msg(Context,
[option_is_set(warn_overlapping_scopes, yes,
[always(Pieces1 ++ Pieces2)])]),
- Spec = error_spec(severity_warning, phase_parse_tree_to_hlds, [Msg]).
+ Severity = severity_conditional(warn_overlapping_scopes, yes,
+ severity_warning, no),
+ Spec = error_spec(Severity, phase_parse_tree_to_hlds, [Msg]).
%-----------------------------------------------------------------------------%
@@ -338,7 +340,9 @@
SinglesMsg = simple_msg(Context,
[option_is_set(warn_singleton_vars, yes,
[always(SinglesPreamble ++ SinglesPieces)])]),
- SinglesSpec = error_spec(severity_warning, phase_parse_tree_to_hlds,
+ SingleSeverity = severity_conditional(warn_singleton_vars, yes,
+ severity_warning, no),
+ SinglesSpec = error_spec(SingleSeverity, phase_parse_tree_to_hlds,
[SinglesMsg]),
!:Specs = [SinglesSpec | !.Specs]
),
@@ -366,7 +370,9 @@
MultiMsg = simple_msg(Context,
[option_is_set(warn_singleton_vars, yes,
[always(MultiPreamble ++ MultiPieces)])]),
- MultiSpec = error_spec(severity_warning, phase_parse_tree_to_hlds,
+ MultiSeverity = severity_conditional(warn_singleton_vars, yes,
+ severity_warning, no),
+ MultiSpec = error_spec(MultiSeverity, phase_parse_tree_to_hlds,
[MultiMsg]),
!:Specs = [MultiSpec | !.Specs]
).
@@ -395,7 +401,9 @@
words("not occur in the"), words(LangStr), words("code."), nl],
Msg1 = simple_msg(Context,
[option_is_set(warn_singleton_vars, yes, [always(Pieces1)])]),
- Spec1 = error_spec(severity_warning, phase_parse_tree_to_hlds,
+ Severity1 = severity_conditional(warn_singleton_vars, yes,
+ severity_warning, no),
+ Spec1 = error_spec(Severity1, phase_parse_tree_to_hlds,
[Msg1]),
!:Specs = [Spec1 | !.Specs]
)
@@ -423,7 +431,9 @@
words("code."), nl],
Msg2 = simple_msg(Context,
[option_is_set(warn_singleton_vars, yes, [always(Pieces2)])]),
- Spec2 = error_spec(severity_warning, phase_parse_tree_to_hlds,
+ Severity2 = severity_conditional(warn_singleton_vars, yes,
+ severity_warning, no),
+ Spec2 = error_spec(Severity2, phase_parse_tree_to_hlds,
[Msg2]),
!:Specs = [Spec2 | !.Specs]
),
@@ -447,7 +457,9 @@
nl],
Msg3 = simple_msg(Context,
[option_is_set(warn_singleton_vars, yes, [always(Pieces3)])]),
- Spec3 = error_spec(severity_warning, phase_parse_tree_to_hlds,
+ Severity3 = severity_conditional(warn_singleton_vars, yes,
+ severity_warning, no),
+ Spec3 = error_spec(Severity3, phase_parse_tree_to_hlds,
[Msg3]),
!:Specs = [Spec3 | !.Specs]
),
@@ -471,7 +483,9 @@
nl],
Msg4 = simple_msg(Context,
[option_is_set(warn_singleton_vars, yes, [always(Pieces4)])]),
- Spec4 = error_spec(severity_warning, phase_parse_tree_to_hlds,
+ Severity4 = severity_conditional(warn_singleton_vars, yes,
+ severity_warning, no),
+ Spec4 = error_spec(Severity4, phase_parse_tree_to_hlds,
[Msg4]),
!:Specs = [Spec4 | !.Specs]
)
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.401
diff -u -b -r1.401 mercury_compile.m
--- compiler/mercury_compile.m 10 Sep 2006 23:39:02 -0000 1.401
+++ compiler/mercury_compile.m 12 Sep 2006 02:54:47 -0000
@@ -1982,12 +1982,16 @@
% Next typecheck the clauses.
%
maybe_write_string(Verbose, "% Type-checking...\n", !IO),
- typecheck(!HLDS, FoundTypeError, ExceededTypeCheckIterationLimit, !IO),
- (
+ maybe_write_string(Verbose, "% Type-checking clauses...\n", !IO),
+ typecheck_module(!HLDS, TypeCheckSpecs, ExceededTypeCheckIterationLimit),
+ write_error_specs(TypeCheckSpecs, 0, _NumTypeWarnings, 0, NumTypeErrors,
+ !IO),
+ maybe_report_stats(Stats, !IO),
+ ( NumTypeErrors > 0 ->
+ module_info_incr_num_errors(NumTypeErrors, !HLDS),
FoundTypeError = yes,
maybe_write_string(Verbose,
- "% Program contains type error(s).\n", !IO),
- io.set_exit_status(1, !IO)
+ "% Program contains type error(s).\n", !IO)
;
FoundTypeError = no,
maybe_write_string(Verbose, "% Program is type-correct.\n", !IO)
@@ -2782,13 +2786,12 @@
puritycheck(Verbose, Stats, !HLDS, FoundTypeError, FoundPostTypecheckError,
!IO) :-
- module_info_get_num_errors(!.HLDS, NumErrors0),
- puritycheck(FoundTypeError, FoundPostTypecheckError, !HLDS, !IO),
- module_info_get_num_errors(!.HLDS, NumErrors),
- ( NumErrors \= NumErrors0 ->
+ puritycheck(FoundTypeError, FoundPostTypecheckError, !HLDS, [], Specs),
+ write_error_specs(Specs, 0, _NumWarnings, 0, NumErrors, !IO),
+ ( NumErrors > 0 ->
+ module_info_incr_num_errors(NumErrors, !HLDS),
maybe_write_string(Verbose,
- "% Program contains purity error(s).\n", !IO),
- io.set_exit_status(1, !IO)
+ "% Program contains purity error(s).\n", !IO)
;
maybe_write_string(Verbose,
"% Program is purity-correct.\n", !IO)
Index: compiler/mode_errors.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_errors.m,v
retrieving revision 1.108
diff -u -b -r1.108 mode_errors.m
--- compiler/mode_errors.m 10 Sep 2006 23:39:03 -0000 1.108
+++ compiler/mode_errors.m 11 Sep 2006 11:31:30 -0000
@@ -20,6 +20,7 @@
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_goal.
:- import_module mdbcomp.prim_data.
+:- import_module parse_tree.error_util.
:- import_module parse_tree.prog_data.
:- import_module check_hlds.mode_info.
@@ -212,9 +213,8 @@
% declare indistinguishable modes.
% XXX This predicate should be included in the types above.
%
-:- pred report_indistinguishable_modes_error(proc_id::in, proc_id::in,
- pred_id::in, pred_info::in, module_info::in, module_info::out,
- io::di, io::uo) is det.
+:- func report_indistinguishable_modes_error(module_info, proc_id, proc_id,
+ pred_id, pred_info) = error_spec.
% Write out the inferred `mode' declarations for a list of pred_ids.
% The bool indicates whether or not to write out determinism
@@ -239,7 +239,6 @@
:- import_module libs.compiler_util.
:- import_module libs.globals.
:- import_module libs.options.
-:- import_module parse_tree.error_util.
:- import_module parse_tree.mercury_to_mercury.
:- import_module parse_tree.prog_mode.
:- import_module parse_tree.prog_out.
@@ -845,7 +844,8 @@
words("expected instantiatedness was"),
words(add_quotes(inst_to_string(ModeInfo, Inst))),
suffix("."), nl],
- Spec = error_spec(severity_error, phase_mode_check,
+ Severity = severity_conditional(errorcheck_only, no, severity_error, no),
+ Spec = error_spec(Severity, phase_mode_check,
[simple_msg(Context,
[option_is_set(errorcheck_only, no,
[always(Preamble ++ Pieces)])])]).
@@ -1314,8 +1314,8 @@
%-----------------------------------------------------------------------------%
-report_indistinguishable_modes_error(OldProcId, NewProcId, PredId, PredInfo,
- !ModuleInfo, !IO) :-
+report_indistinguishable_modes_error(ModuleInfo, OldProcId, NewProcId,
+ PredId, PredInfo) = Spec :-
pred_info_get_procedures(PredInfo, Procs),
map.lookup(Procs, OldProcId, OldProcInfo),
map.lookup(Procs, NewProcId, NewProcInfo),
@@ -1323,7 +1323,7 @@
proc_info_get_context(NewProcInfo, NewContext),
MainPieces = [words("In mode declarations for ")] ++
- describe_one_pred_name(!.ModuleInfo, should_module_qualify, PredId)
+ describe_one_pred_name(ModuleInfo, should_module_qualify, PredId)
++ [suffix(":"), nl, words("error: duplicate mode declaration."), nl],
VerbosePieces = [words("Modes"),
fixed(add_quotes(mode_decl_to_string(OldProcId, PredInfo))),
@@ -1334,9 +1334,7 @@
Spec = error_spec(severity_error, phase_mode_check,
[simple_msg(NewContext,
[always(MainPieces), verbose_only(VerbosePieces)]),
- simple_msg(OldContext, [always(OldPieces)])]),
- write_error_spec(Spec, 0, _NumWarnings, 0, NumErrors, !IO),
- module_info_incr_num_errors(NumErrors, !ModuleInfo).
+ simple_msg(OldContext, [always(OldPieces)])]).
%-----------------------------------------------------------------------------%
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.147
diff -u -b -r1.147 module_qual.m
--- compiler/module_qual.m 10 Sep 2006 23:39:04 -0000 1.147
+++ compiler/module_qual.m 11 Sep 2006 04:55:16 -0000
@@ -1581,7 +1581,9 @@
words("not used in the interface.")],
Msg = simple_msg(Context,
[option_is_set(warn_interface_imports, yes, [always(Pieces)])]),
- Spec = error_spec(severity_warning, phase_parse_tree_to_hlds, [Msg]),
+ Severity = severity_conditional(warn_interface_imports, yes,
+ severity_warning, no),
+ Spec = error_spec(Severity, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs]
).
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.402
diff -u -b -r1.402 modules.m
--- compiler/modules.m 10 Sep 2006 23:39:04 -0000 1.402
+++ compiler/modules.m 11 Sep 2006 05:00:08 -0000
@@ -2810,7 +2810,9 @@
sym_name(ModuleName), words("imports itself!")],
SelfMsg = simple_msg(Context,
[option_is_set(warn_simple_code, yes, [always(SelfPieces)])]),
- SelfSpec = error_spec(severity_warning, phase_parse_tree_to_hlds,
+ Severity = severity_conditional(warn_simple_code, yes,
+ severity_warning, no),
+ SelfSpec = error_spec(Severity, phase_parse_tree_to_hlds,
[SelfMsg]),
!:Specs = [SelfSpec | !.Specs]
;
@@ -2831,7 +2833,9 @@
Msg = simple_msg(Context,
[option_is_set(warn_simple_code, yes,
[always(MainPieces), verbose_only(VerbosePieces)])]),
- Spec = error_spec(severity_warning, phase_parse_tree_to_hlds, [Msg]),
+ Severity = severity_conditional(warn_simple_code, yes,
+ severity_warning, no),
+ Spec = error_spec(Severity, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs].
% This predicate ensures that all every import_module declaration is
@@ -2891,7 +2895,9 @@
words("`:- use_module' declarations."), nl],
Msg = simple_msg(Context,
[option_is_set(warn_simple_code, yes, [always(Pieces)])]),
- Spec = error_spec(severity_warning, phase_parse_tree_to_hlds, [Msg]),
+ Severity = severity_conditional(warn_simple_code, yes,
+ severity_warning, no),
+ Spec = error_spec(Severity, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs],
% Treat the modules with both types of import as if they
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.107
diff -u -b -r1.107 post_typecheck.m
--- compiler/post_typecheck.m 10 Sep 2006 23:39:05 -0000 1.107
+++ compiler/post_typecheck.m 12 Sep 2006 00:25:07 -0000
@@ -40,30 +40,30 @@
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module mdbcomp.prim_data.
+:- import_module parse_tree.error_util.
:- import_module parse_tree.prog_data.
:- import_module bool.
-:- import_module io.
:- import_module list.
%-----------------------------------------------------------------------------%
- % finish_preds(PredIds, ReportTypeErrors, NumErrors, FoundTypeError,
- % !Module):
+ % finish_preds(PredIds, ReportTypeErrors, NumErrors, !ModuleInfo, !Specs):
%
% Check that the all of the types which have been inferred for the
% variables in the clause do not contain any unbound type variables
% other than those that occur in the types of head variables, and that
% there are no unsatisfied type class constraints, and if
- % ReportErrors = yes, print appropriate warning/error messages.
+ % ReportErrors = yes, return the appropriate warning/error messages.
% Also bind any unbound type variables to the type `void'. Note that
% when checking assertions we take the conservative approach of warning
% about unbound type variables. There may be cases for which this doesn't
- % make sense. FoundTypeError will be `yes' if there were errors which
+ % make sense. NumErrors will be nonzero if there were errors which
% should prevent further processing (e.g. polymorphism or mode analysis).
%
-:- pred finish_preds(list(pred_id)::in, bool::in, int::out, bool::out,
- module_info::in, module_info::out, io::di, io::uo) is det.
+:- pred finish_preds(list(pred_id)::in, bool::in, int::out,
+ module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
% As above, but return the list of procedures containing unbound inst
% variables instead of reporting the errors directly.
@@ -75,13 +75,15 @@
list(proc_id)::out, pred_info::in, pred_info::out) is det.
:- pred finish_ill_typed_pred(module_info::in, pred_id::in,
- pred_info::in, pred_info::out, io::di, io::uo) is det.
+ pred_info::in, pred_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
% Now that the assertion has finished being typechecked, remove it
% from further processing and store it in the assertion_table.
%
:- pred finish_promise(promise_type::in, pred_id::in,
- module_info::in, module_info::out, io::di, io::uo) is det.
+ module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
% Handle any unresolved overloading for a predicate call.
%
@@ -120,7 +122,6 @@
:- import_module libs.compiler_util.
:- import_module libs.globals.
:- import_module libs.options.
-:- import_module parse_tree.error_util.
:- import_module parse_tree.mercury_to_mercury.
:- import_module parse_tree.prog_mode.
:- import_module parse_tree.prog_out.
@@ -141,20 +142,23 @@
%-----------------------------------------------------------------------------%
-finish_preds(PredIds, ReportTypeErrors, NumErrors,
- FoundTypeError, !ModuleInfo, !IO) :-
- finish_preds(PredIds, ReportTypeErrors, !ModuleInfo,
- 0, NumErrors0, no, FoundTypeError0, !IO),
- check_for_missing_definitions(!.ModuleInfo, NumErrors0, NumErrors,
- FoundTypeError0, FoundTypeError, !IO).
+finish_preds(PredIds, ReportTypeErrors, NumErrors, !ModuleInfo, !Specs) :-
+ do_finish_preds(PredIds, ReportTypeErrors, !ModuleInfo,
+ 0, TotalNumUnsatisfiedConstraints, !Specs),
+ check_for_missing_definitions(!.ModuleInfo,
+ [], MissingTypeDefnSpecs),
+ NumMissingTypeDefns = list.length(MissingTypeDefnSpecs),
+ NumErrors = TotalNumUnsatisfiedConstraints + NumMissingTypeDefns,
+ !:Specs = !.Specs ++ MissingTypeDefnSpecs.
-:- pred finish_preds(list(pred_id)::in, bool::in,
+:- pred do_finish_preds(list(pred_id)::in, bool::in,
module_info::in, module_info::out, int::in, int::out,
- bool::in, bool::out, io::di, io::uo) is det.
+ list(error_spec)::in, list(error_spec)::out) is det.
-finish_preds([], _, !ModuleInfo, !NumErrors, !PostTypecheckError, !IO).
-finish_preds([PredId | PredIds], ReportTypeErrors, !ModuleInfo, !NumErrors,
- !FoundTypeError, !IO) :-
+do_finish_preds([], _, !ModuleInfo, !TotalNumUnsatisfiedConstraints, !Specs).
+do_finish_preds([PredId | PredIds], ReportTypeErrors, !ModuleInfo,
+!TotalNumUnsatisfiedConstraints,
+ !Specs) :-
some [!PredInfo] (
module_info_pred_info(!.ModuleInfo, PredId, !:PredInfo),
(
@@ -162,44 +166,35 @@
; pred_info_is_pseudo_imported(!.PredInfo)
)
->
- finish_imported_pred(!.ModuleInfo, PredId, !PredInfo, !IO)
+ finish_imported_pred(!.ModuleInfo, PredId, !PredInfo, !Specs)
;
% Only report error messages for unbound type variables
% if we didn't get any type errors already; this avoids
% a lot of spurious diagnostics.
check_type_bindings(!.ModuleInfo, PredId, !PredInfo,
- ReportTypeErrors, UnboundTypeErrsInThisPred, !IO),
-
- % If there were any unsatisfied type class constraints, then that
- % can cause internal errors in polymorphism.m if we try to
- % continue, so we need to halt compilation after this pass.
- ( UnboundTypeErrsInThisPred \= 0 ->
- !:FoundTypeError = yes
- ;
- true
- ),
+ ReportTypeErrors, NumUnsatisfiedConstraints, !Specs),
finish_pred_no_io(!.ModuleInfo, ErrorProcs, !PredInfo),
report_unbound_inst_vars(!.ModuleInfo, PredId, ErrorProcs,
- !PredInfo, !IO),
+ !PredInfo, !Specs),
check_for_indistinguishable_modes(!.ModuleInfo, PredId,
- !PredInfo, !IO),
+ !PredInfo, !Specs),
% Check that main/2 has the right type.
(
ReportTypeErrors = yes,
- check_type_of_main(!.PredInfo, !IO)
+ check_type_of_main(!.PredInfo, !Specs)
;
ReportTypeErrors = no
),
- !:NumErrors = !.NumErrors + UnboundTypeErrsInThisPred
+ !:TotalNumUnsatisfiedConstraints =
+ !.TotalNumUnsatisfiedConstraints + NumUnsatisfiedConstraints
),
- module_info_set_pred_info(PredId, !.PredInfo, !ModuleInfo),
- finish_preds(PredIds, ReportTypeErrors,
- !ModuleInfo, !NumErrors, !FoundTypeError, !IO)
- ).
-
+ module_info_set_pred_info(PredId, !.PredInfo, !ModuleInfo)
+ ),
+ do_finish_preds(PredIds, ReportTypeErrors, !ModuleInfo,
+ !TotalNumUnsatisfiedConstraints, !Specs).
%-----------------------------------------------------------------------------%
% Check that the all of the types which have been inferred for the
@@ -208,10 +203,11 @@
% there are no unsatisfied type class constraints.
%
:- pred check_type_bindings(module_info::in, pred_id::in,
- pred_info::in, pred_info::out, bool::in, int::out, io::di, io::uo) is det.
+ pred_info::in, pred_info::out, bool::in, int::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
check_type_bindings(ModuleInfo, PredId, !PredInfo, ReportErrs, NumErrors,
- !IO) :-
+ !Specs) :-
(
ReportErrs = yes,
pred_info_get_unproven_body_constraints(!.PredInfo,
@@ -219,8 +215,8 @@
UnprovenConstraints0 = [_ | _]
->
list.sort_and_remove_dups(UnprovenConstraints0, UnprovenConstraints),
- report_unsatisfied_constraints(UnprovenConstraints, PredId,
- !.PredInfo, ModuleInfo, !IO),
+ report_unsatisfied_constraints(ModuleInfo, PredId, !.PredInfo,
+ UnprovenConstraints, !Specs),
list.length(UnprovenConstraints, NumErrors)
;
NumErrors = 0
@@ -232,15 +228,16 @@
clauses_info_get_vartypes(ClausesInfo0, VarTypesMap0),
map.to_assoc_list(VarTypesMap0, VarTypesList),
set.init(Set0),
- check_type_bindings_2(VarTypesList, HeadTypeParams, [], Errs, Set0, Set),
+ check_type_bindings_2(VarTypesList, HeadTypeParams,
+ [], UnresolvedVarsTypes, Set0, Set),
(
- Errs = []
+ UnresolvedVarsTypes = []
;
- Errs = [_ | _],
+ UnresolvedVarsTypes = [_ | _],
(
ReportErrs = yes,
- report_unresolved_type_warning(Errs, PredId, !.PredInfo,
- ModuleInfo, VarSet, !IO)
+ report_unresolved_type_warning(ModuleInfo, PredId, !.PredInfo,
+ VarSet, UnresolvedVarsTypes, !Specs)
;
ReportErrs = no
),
@@ -261,18 +258,20 @@
assoc_list(prog_var, mer_type)::in, assoc_list(prog_var, mer_type)::out,
set(tvar)::in, set(tvar)::out) is det.
-check_type_bindings_2([], _, !Errs, !Set).
-check_type_bindings_2([Var - Type | VarTypes], HeadTypeParams, !Errs, !Set) :-
+check_type_bindings_2([], _, !UnresolvedVarsTypes, !Set).
+check_type_bindings_2([Var - Type | VarTypes], HeadTypeParams,
+ !UnresolvedVarsTypes, !Set) :-
prog_type.vars(Type, TVars),
set.list_to_set(TVars, TVarsSet0),
set.delete_list(TVarsSet0, HeadTypeParams, TVarsSet1),
( \+ set.empty(TVarsSet1) ->
- !:Errs = [Var - Type | !.Errs],
+ !:UnresolvedVarsTypes = [Var - Type | !.UnresolvedVarsTypes],
set.union(!.Set, TVarsSet1, !:Set)
;
true
),
- check_type_bindings_2(VarTypes, HeadTypeParams, !Errs, !Set).
+ check_type_bindings_2(VarTypes, HeadTypeParams,
+ !UnresolvedVarsTypes, !Set).
% Bind all the type variables in `UnboundTypeVarsSet' to the type `void'.
%
@@ -295,15 +294,15 @@
apply_subst_to_constraint_map(VoidSubst, !ConstraintMap).
%-----------------------------------------------------------------------------%
-%
-% Report unsatisfied typeclass constraints
-%
-:- pred report_unsatisfied_constraints(list(prog_constraint)::in,
- pred_id::in, pred_info::in, module_info::in, io::di, io::uo) is det.
+ % Report unsatisfied typeclass constraints.
+ %
+:- pred report_unsatisfied_constraints(module_info::in,
+ pred_id::in, pred_info::in, list(prog_constraint)::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
-report_unsatisfied_constraints(Constraints, PredId, PredInfo, ModuleInfo,
- !IO) :-
+report_unsatisfied_constraints(ModuleInfo, PredId, PredInfo, Constraints,
+ !Specs) :-
pred_info_get_typevarset(PredInfo, TVarSet),
pred_info_context(PredInfo, Context),
@@ -319,8 +318,7 @@
[nl_indent_delta(-1)],
Msg = simple_msg(Context, [always(Pieces)]),
Spec = error_spec(severity_error, phase_type_check, [Msg]),
- % XXX _NumErrors
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO).
+ !:Specs = [Spec | !.Specs].
:- func constraint_to_error_piece(tvarset, prog_constraint)
= list(format_component).
@@ -332,65 +330,49 @@
% Report a warning: uninstantiated type parameter.
%
-:- pred report_unresolved_type_warning(assoc_list(prog_var, mer_type)::in,
- pred_id::in, pred_info::in, module_info::in, prog_varset::in,
- io::di, io::uo) is det.
-
-report_unresolved_type_warning(Errs, PredId, PredInfo, ModuleInfo, VarSet,
- !IO) :-
- record_warning(!IO),
+:- pred report_unresolved_type_warning(module_info::in, pred_id::in,
+ pred_info::in, prog_varset::in, assoc_list(prog_var, mer_type)::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
+report_unresolved_type_warning(ModuleInfo, PredId, PredInfo, VarSet, Errs,
+ !Specs) :-
pred_info_get_typevarset(PredInfo, TypeVarSet),
pred_info_context(PredInfo, Context),
- prog_out.write_context(Context, !IO),
- io.write_string("In ", !IO),
- hlds_out.write_pred_id(ModuleInfo, PredId, !IO),
- io.write_string(":\n", !IO),
-
- prog_out.write_context(Context, !IO),
- io.write_string(" warning: unresolved polymorphism.\n", !IO),
- prog_out.write_context(Context, !IO),
- ( Errs = [_] ->
- io.write_string(" The variable with an unbound type was:\n", !IO)
- ;
- io.write_string(" The variables with unbound types were:\n", !IO)
- ),
- write_type_var_list(Errs, Context, VarSet, TypeVarSet, !IO),
- prog_out.write_context(Context, !IO),
- io.write_string(" The unbound type variable(s) will be implicitly\n",
- !IO),
- prog_out.write_context(Context, !IO),
- io.write_string(" bound to the builtin type `void'.\n", !IO),
- globals.io_lookup_bool_option(verbose_errors, VerboseErrors, !IO),
- (
- VerboseErrors = yes,
- io.write_strings([
-"\tThe body of the clause contains a call to a polymorphic predicate,\n",
-"\tbut I can't determine which version should be called,\n",
-"\tbecause the type variables listed above didn't get bound.\n",
-% "\tYou may need to use an explicit type qualifier.\n",
-% XXX improve error message
-"\t(I ought to tell you which call caused the problem, but I'm afraid\n",
-"\tyou'll have to work it out yourself. My apologies.)\n"
- ], !IO)
- ;
- VerboseErrors = no,
- globals.io_set_extra_error_info(yes, !IO)
- ).
-
-:- pred write_type_var_list(assoc_list(prog_var, mer_type)::in,
- prog_context::in, prog_varset::in, tvarset::in, io::di, io::uo) is det.
-
-write_type_var_list([], _, _, _, !IO).
-write_type_var_list([Var - Type | Rest], Context, VarSet, TVarSet, !IO) :-
- prog_out.write_context(Context, !IO),
- io.write_string(" ", !IO),
- mercury_output_var(Var, VarSet, no, !IO),
- io.write_string(": ", !IO),
- mercury_output_type(TVarSet, no, Type, !IO),
- io.nl(!IO),
- write_type_var_list(Rest, Context, VarSet, TVarSet, !IO).
+ PredIdPieces =
+ describe_one_pred_name(ModuleInfo, should_not_module_qualify, PredId),
+ VarTypePieceLists =
+ list.map(var_and_type_to_pieces(VarSet, TypeVarSet), Errs),
+ list.condense(VarTypePieceLists, VarTypePieces),
+ MainPieces = [words("In")] ++ PredIdPieces ++ [suffix(":"), nl,
+ words("warning: unresolved polymorphism."), nl,
+ words(choose_number(Errs,
+ "The variable with an unbound type was:",
+ "The variables with unbound types were:")), nl_indent_delta(1)] ++
+ VarTypePieces ++
+ [nl_indent_delta(-1), words("The unbound type"),
+ words(choose_number(Errs, "variable", "variables")),
+ words("will be implicitly bound to the builtin type `void'."), nl],
+ VerbosePieces = [words("The body of the clause contains a call"),
+ words("to a polymorphic predicate,"),
+ words("but I can't determine which version should be called,"),
+ words("because the type variables listed above didn't get bound."),
+ % words("You may need to use an explicit type qualifier."),
+ % XXX improve error message
+ words("(I ought to tell you which call caused the problem,"),
+ words("but I'm afraid you'll have to work it out yourself."),
+ words("My apologies.)")],
+ Msg = simple_msg(Context,
+ [always(MainPieces), verbose_only(VerbosePieces)]),
+ Spec = error_spec(severity_warning, phase_type_check, [Msg]),
+ !:Specs = [Spec | !.Specs].
+
+:- func var_and_type_to_pieces(prog_varset, tvarset,
+ pair(prog_var, mer_type)) = list(format_component).
+
+var_and_type_to_pieces(VarSet, TVarSet, Var - Type) =
+ [words(mercury_var_to_string(Var, VarSet, no)), suffix(":"),
+ words(mercury_type_to_string(TVarSet, no, Type)), nl].
%-----------------------------------------------------------------------------%
@@ -430,25 +412,28 @@
% so that any calls to that pred from correctly-typed predicates
% won't result in spurious mode errors.
%
-finish_ill_typed_pred(ModuleInfo, PredId, !PredInfo, !IO) :-
+finish_ill_typed_pred(ModuleInfo, PredId, !PredInfo, !Specs) :-
propagate_types_into_modes(ModuleInfo, ErrorProcs, !PredInfo),
- report_unbound_inst_vars(ModuleInfo, PredId, ErrorProcs, !PredInfo, !IO),
- check_for_indistinguishable_modes(ModuleInfo, PredId, !PredInfo, !IO).
+ report_unbound_inst_vars(ModuleInfo, PredId, ErrorProcs, !PredInfo,
+ !Specs),
+ check_for_indistinguishable_modes(ModuleInfo, PredId, !PredInfo, !Specs).
% For imported preds, we just need to ensure that all constructors
% occurring in predicate mode declarations are module qualified.
%
:- pred finish_imported_pred(module_info::in, pred_id::in,
- pred_info::in, pred_info::out, io::di, io::uo) is det.
+ pred_info::in, pred_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
-finish_imported_pred(ModuleInfo, PredId, !PredInfo, !IO) :-
+finish_imported_pred(ModuleInfo, PredId, !PredInfo, !Specs) :-
% XXX Maybe the rest should be replaced with a call to
% finish_ill_typed_pred? [zs]
finish_imported_pred_no_io(ModuleInfo, ErrorProcs, !PredInfo),
- report_unbound_inst_vars(ModuleInfo, PredId, ErrorProcs, !PredInfo, !IO),
- check_for_indistinguishable_modes(ModuleInfo, PredId, !PredInfo, !IO).
+ report_unbound_inst_vars(ModuleInfo, PredId, ErrorProcs, !PredInfo,
+ !Specs),
+ check_for_indistinguishable_modes(ModuleInfo, PredId, !PredInfo, !Specs).
-finish_imported_pred_no_io(ModuleInfo, Errors, !PredInfo) :-
+finish_imported_pred_no_io(ModuleInfo, ErrorProcIds, !PredInfo) :-
% Make sure the var-types field in the clauses_info is valid for imported
% predicates. Unification procedures have clauses generated, so they
% already have valid var-types.
@@ -462,7 +447,7 @@
clauses_info_set_vartypes(VarTypes, ClausesInfo0, ClausesInfo),
pred_info_set_clauses_info(ClausesInfo, !PredInfo)
),
- propagate_types_into_modes(ModuleInfo, Errors, !PredInfo).
+ propagate_types_into_modes(ModuleInfo, ErrorProcIds, !PredInfo).
% Now that the promise has finished being typechecked, and has had all
% of its pred_ids identified, remove the promise from the list of pred ids
@@ -474,19 +459,19 @@
% or for a promise ex declaration record in the promise ex table
% the predicates used by the declaration.
%
-finish_promise(PromiseType, PromiseId, !Module, !IO) :-
+finish_promise(PromiseType, PromiseId, !ModuleInfo, !Specs) :-
% Store the declaration in the appropriate table and get the goal
% for the promise.
- store_promise(PromiseType, PromiseId, !Module, Goal),
+ store_promise(PromiseType, PromiseId, !ModuleInfo, Goal),
% Remove from further processing.
- module_info_remove_predid(PromiseId, !Module),
+ module_info_remove_predid(PromiseId, !ModuleInfo),
% If the promise is in the interface, then ensure that it doesn't refer
% to any local symbols.
- module_info_pred_info(!.Module, PromiseId, PredInfo),
+ module_info_pred_info(!.ModuleInfo, PromiseId, PredInfo),
( pred_info_is_exported(PredInfo) ->
- in_interface_check(Goal, PredInfo, !Module, !IO)
+ in_interface_check(!.ModuleInfo, PredInfo, Goal, !Specs)
;
true
).
@@ -497,44 +482,44 @@
:- pred store_promise(promise_type::in, pred_id::in,
module_info::in, module_info::out, hlds_goal::out) is det.
-store_promise(PromiseType, PromiseId, !Module, Goal) :-
+store_promise(PromiseType, PromiseId, !ModuleInfo, Goal) :-
(
% Case for assertions.
PromiseType = promise_type_true,
- module_info_get_assertion_table(!.Module, AssertTable0),
+ module_info_get_assertion_table(!.ModuleInfo, AssertTable0),
assertion_table_add_assertion(PromiseId, AssertionId,
AssertTable0, AssertTable),
- module_info_set_assertion_table(AssertTable, !Module),
- assertion.assert_id_goal(!.Module, AssertionId, Goal),
- assertion.record_preds_used_in(Goal, AssertionId, !Module)
+ module_info_set_assertion_table(AssertTable, !ModuleInfo),
+ assertion.assert_id_goal(!.ModuleInfo, AssertionId, Goal),
+ assertion.record_preds_used_in(Goal, AssertionId, !ModuleInfo)
;
% Case for exclusivity.
( PromiseType = promise_type_exclusive
; PromiseType = promise_type_exclusive_exhaustive
),
- promise_ex_goal(PromiseId, !.Module, Goal),
+ promise_ex_goal(!.ModuleInfo, PromiseId, Goal),
predids_from_goal(Goal, PredIds),
- module_info_get_exclusive_table(!.Module, Table0),
+ module_info_get_exclusive_table(!.ModuleInfo, Table0),
list.foldl(exclusive_table_add(PromiseId), PredIds, Table0, Table),
- module_info_set_exclusive_table(Table, !Module)
+ module_info_set_exclusive_table(Table, !ModuleInfo)
;
% Case for exhaustiveness -- XXX not yet implemented.
PromiseType = promise_type_exhaustive,
- promise_ex_goal(PromiseId, !.Module, Goal)
+ promise_ex_goal(!.ModuleInfo, PromiseId, Goal)
).
% Get the goal from a promise_ex declaration.
%
-:- pred promise_ex_goal(pred_id::in, module_info::in, hlds_goal::out) is det.
+:- pred promise_ex_goal(module_info::in, pred_id::in, hlds_goal::out) is det.
-promise_ex_goal(ExclusiveDecl, Module, Goal) :-
- module_info_pred_info(Module, ExclusiveDecl, PredInfo),
+promise_ex_goal(ModuleInfo, ExclusiveDeclPredId, Goal) :-
+ module_info_pred_info(ModuleInfo, ExclusiveDeclPredId, PredInfo),
pred_info_clauses_info(PredInfo, ClausesInfo),
clauses_info_clauses_only(ClausesInfo, Clauses),
( Clauses = [clause(_ProcIds, Goal0, _Lang, _Context)] ->
assertion.normalise_goal(Goal0, Goal)
;
- unexpected(this_file, "promise_ex.goal: not an promise")
+ unexpected(this_file, "promise_ex_goal: not a single clause")
).
%-----------------------------------------------------------------------------%
@@ -543,30 +528,35 @@
% refer to any constructors, functions and predicates defined in the
% implementation of that module.
%
-:- pred in_interface_check(hlds_goal::in, pred_info::in,
- module_info::in, module_info::out, io::di, io::uo) is det.
+:- pred in_interface_check(module_info::in, pred_info::in, hlds_goal::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
-in_interface_check(plain_call(PredId, _, _, _, _,SymName) - GoalInfo,
- _PredInfo, !Module, !IO) :-
- module_info_pred_info(!.Module, PredId, CallPredInfo),
+in_interface_check(ModuleInfo, PredInfo, GoalExpr - GoalInfo, !Specs) :-
+ (
+ GoalExpr = plain_call(PredId, _, _, _, _,SymName),
+ module_info_pred_info(ModuleInfo, PredId, CallPredInfo),
pred_info_get_import_status(CallPredInfo, ImportStatus),
( status_defined_in_impl_section(ImportStatus) = yes ->
goal_info_get_context(GoalInfo, Context),
PredOrFunc = pred_info_is_pred_or_func(CallPredInfo),
Arity = pred_info_orig_arity(CallPredInfo),
- IdPieces = [simple_call(simple_call_id(PredOrFunc, SymName, Arity))],
- write_assertion_interface_error(Context, IdPieces, !Module, !IO)
+ IdPieces =
+ [simple_call(simple_call_id(PredOrFunc, SymName, Arity))],
+ report_assertion_interface_error(ModuleInfo, Context, IdPieces,
+ !Specs)
;
true
- ).
-in_interface_check(generic_call(_, _, _, _) - _, _, !Module, !IO).
-in_interface_check(unify(Var, RHS, _, _, _) - GoalInfo, PredInfo,
- !Module, !IO) :-
+ )
+ ;
+ GoalExpr = generic_call(_, _, _, _)
+ ;
+ GoalExpr = unify(Var, RHS, _, _, _),
goal_info_get_context(GoalInfo, Context),
- in_interface_check_unify_rhs(RHS, Var, Context, PredInfo, !Module, !IO).
-in_interface_check(call_foreign_proc(_, PredId, _, _, _, _, _) -
- GoalInfo, _PredInfo, !Module, !IO) :-
- module_info_pred_info(!.Module, PredId, PragmaPredInfo),
+ in_interface_check_unify_rhs(ModuleInfo, PredInfo, RHS, Var, Context,
+ !Specs)
+ ;
+ GoalExpr = call_foreign_proc(_, PredId, _, _, _, _, _),
+ module_info_pred_info(ModuleInfo, PredId, PragmaPredInfo),
pred_info_get_import_status(PragmaPredInfo, ImportStatus),
( status_defined_in_impl_section(ImportStatus) = yes ->
goal_info_get_context(GoalInfo, Context),
@@ -574,87 +564,102 @@
Name = pred_info_name(PragmaPredInfo),
SymName = unqualified(Name),
Arity = pred_info_orig_arity(PragmaPredInfo),
- IdPieces = [simple_call(simple_call_id(PredOrFunc, SymName, Arity))],
- write_assertion_interface_error(Context, IdPieces, !Module, !IO)
+ IdPieces =
+ [simple_call(simple_call_id(PredOrFunc, SymName, Arity))],
+ report_assertion_interface_error(ModuleInfo, Context, IdPieces,
+ !Specs)
;
true
+ )
+ ;
+ GoalExpr = conj(_, Goals),
+ in_interface_check_list(ModuleInfo, PredInfo, Goals, !Specs)
+ ;
+ GoalExpr = switch(_, _, _),
+ unexpected(this_file, "in_interface_check: assertion contains switch.")
+ ;
+ GoalExpr = disj(Goals),
+ in_interface_check_list(ModuleInfo, PredInfo, Goals, !Specs)
+ ;
+ GoalExpr = negation(Goal),
+ in_interface_check(ModuleInfo, PredInfo, Goal, !Specs)
+ ;
+ GoalExpr = scope(_, Goal),
+ in_interface_check(ModuleInfo, PredInfo, Goal, !Specs)
+ ;
+ GoalExpr = if_then_else(_, If, Then, Else),
+ in_interface_check(ModuleInfo, PredInfo, If, !Specs),
+ in_interface_check(ModuleInfo, PredInfo, Then, !Specs),
+ in_interface_check(ModuleInfo, PredInfo, Else, !Specs)
+ ;
+ GoalExpr = shorthand(ShorthandGoal),
+ in_interface_check_shorthand(ModuleInfo, PredInfo, ShorthandGoal,
+ !Specs)
).
-in_interface_check(conj(_, Goals) - _, PredInfo, !Module, !IO) :-
- in_interface_check_list(Goals, PredInfo, !Module, !IO).
-in_interface_check(switch(_, _, _) - _, _, _, _, !IO) :-
- unexpected(this_file, "in_interface_check: assertion contains switch.").
-in_interface_check(disj(Goals) - _, PredInfo, !Module, !IO) :-
- in_interface_check_list(Goals, PredInfo, !Module, !IO).
-in_interface_check(negation(Goal) - _, PredInfo, !Module, !IO) :-
- in_interface_check(Goal, PredInfo, !Module, !IO).
-in_interface_check(scope(_, Goal) - _, PredInfo, !Module, !IO) :-
- in_interface_check(Goal, PredInfo, !Module, !IO).
-in_interface_check(if_then_else(_, If, Then, Else) - _, PredInfo,
- !Module, !IO) :-
- in_interface_check(If, PredInfo, !Module, !IO),
- in_interface_check(Then, PredInfo, !Module, !IO),
- in_interface_check(Else, PredInfo, !Module, !IO).
-in_interface_check(shorthand(ShorthandGoal) - _GoalInfo, PredInfo,
- !Module, !IO) :-
- in_interface_check_shorthand(ShorthandGoal, PredInfo, !Module, !IO).
-
-:- pred in_interface_check_shorthand(shorthand_goal_expr::in,
- pred_info::in, module_info::in, module_info::out, io::di, io::uo) is det.
-
-in_interface_check_shorthand(bi_implication(LHS, RHS), PredInfo,
- !Module, !IO) :-
- in_interface_check(LHS, PredInfo, !Module, !IO),
- in_interface_check(RHS, PredInfo, !Module, !IO).
+
+:- pred in_interface_check_shorthand(module_info::in, pred_info::in,
+ shorthand_goal_expr::in, list(error_spec)::in, list(error_spec)::out)
+ is det.
+
+in_interface_check_shorthand(ModuleInfo, PredInfo, bi_implication(LHS, RHS),
+ !Specs) :-
+ in_interface_check(ModuleInfo, PredInfo, LHS, !Specs),
+ in_interface_check(ModuleInfo, PredInfo, RHS, !Specs).
%-----------------------------------------------------------------------------%
-:- pred in_interface_check_unify_rhs(unify_rhs::in, prog_var::in,
- prog_context::in, pred_info::in, module_info::in, module_info::out,
- io::di, io::uo) is det.
-
-in_interface_check_unify_rhs(rhs_var(_), _, _, _, !Module, !IO).
-in_interface_check_unify_rhs(rhs_functor(ConsId, _, _), Var, Context,
- PredInfo, !Module, !IO) :-
+:- pred in_interface_check_unify_rhs(module_info::in, pred_info::in,
+ unify_rhs::in, prog_var::in, prog_context::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+in_interface_check_unify_rhs(ModuleInfo, PredInfo, RHS, Var, Context,
+ !Specs) :-
+ (
+ RHS = rhs_var(_)
+ ;
+ RHS = rhs_functor(ConsId, _, _),
pred_info_clauses_info(PredInfo, ClausesInfo),
clauses_info_get_vartypes(ClausesInfo, VarTypes),
map.lookup(VarTypes, Var, Type),
( type_to_ctor_and_args(Type, TypeCtor, _) ->
- module_info_get_type_table(!.Module, Types),
+ module_info_get_type_table(ModuleInfo, Types),
map.lookup(Types, TypeCtor, TypeDefn),
- hlds_data.get_type_defn_status(TypeDefn, TypeStatus),
+ get_type_defn_status(TypeDefn, TypeStatus),
( status_defined_in_impl_section(TypeStatus) = yes ->
ConsIdStr = cons_id_to_string(ConsId),
IdPieces = [words("constructor"), quote(ConsIdStr)],
- write_assertion_interface_error(Context, IdPieces, !Module, !IO)
+ report_assertion_interface_error(ModuleInfo, Context, IdPieces,
+ !Specs)
;
true
)
;
unexpected(this_file,
"in_interface_check_unify_rhs: type_to_ctor_and_args failed.")
+ )
+ ;
+ RHS = rhs_lambda_goal(_, _, _, _, _, _, _, Goal),
+ in_interface_check(ModuleInfo, PredInfo, Goal, !Specs)
).
-in_interface_check_unify_rhs(rhs_lambda_goal(_, _, _, _, _, _, _, Goal),
- _Var, _Context, PredInfo, !Module, !IO) :-
- in_interface_check(Goal, PredInfo, !Module, !IO).
%-----------------------------------------------------------------------------%
-:- pred in_interface_check_list(hlds_goals::in, pred_info::in,
- module_info::in, module_info::out, io::di, io::uo)is det.
+:- pred in_interface_check_list(module_info::in, pred_info::in, hlds_goals::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
-in_interface_check_list([], _, !Module, !IO).
-in_interface_check_list([Goal0 | Goal0s], PredInfo, !Module, !IO) :-
- in_interface_check(Goal0, PredInfo, !Module, !IO),
- in_interface_check_list(Goal0s, PredInfo, !Module, !IO).
+in_interface_check_list(_ModuleInfo, _PredInfo, [], !Specs).
+in_interface_check_list(ModuleInfo, PredInfo, [Goal0 | Goal0s], !Specs) :-
+ in_interface_check(ModuleInfo, PredInfo, Goal0, !Specs),
+ in_interface_check_list(ModuleInfo, PredInfo, Goal0s, !Specs).
%-----------------------------------------------------------------------------%
-:- pred write_assertion_interface_error(prog_context::in,
- list(format_component)::in, module_info::in, module_info::out,
- io::di, io::uo) is det.
+:- pred report_assertion_interface_error(module_info::in, prog_context::in,
+ list(format_component)::in, list(error_spec)::in, list(error_spec)::out)
+ is det.
-write_assertion_interface_error(Context, IdPieces, !ModuleInfo, !IO) :-
- module_info_get_name(!.ModuleInfo, ModuleName),
+report_assertion_interface_error(ModuleInfo, Context, IdPieces, !Specs) :-
+ module_info_get_name(ModuleInfo, ModuleName),
MainPieces =
[words("In interface for module"), sym_name(ModuleName), suffix(":"),
nl, words("error: exported promise refers to")] ++ IdPieces ++
@@ -666,14 +671,14 @@
Msgs = [always(MainPieces), verbose_only(VerbosePieces)],
Spec = error_spec(severity_error, phase_type_check,
[simple_msg(Context, Msgs)]),
- write_error_spec(Spec, 0, _NumWarnings, 0, NumErrors, !IO),
- module_info_incr_num_errors(NumErrors, !ModuleInfo).
+ !:Specs = [Spec | !.Specs].
%-----------------------------------------------------------------------------%
-:- pred check_type_of_main(pred_info::in, io::di, io::uo) is det.
+:- pred check_type_of_main(pred_info::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
-check_type_of_main(PredInfo, !IO) :-
+check_type_of_main(PredInfo, !Specs) :-
(
% Check if this predicate is the program entry point main/2.
pred_info_name(PredInfo) = "main",
@@ -694,8 +699,7 @@
words("must have type `io.state'."), nl],
Msg = simple_msg(Context, [always(Pieces)]),
Spec = error_spec(severity_error, phase_type_check, [Msg]),
- % XXX _NumErrors
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO)
+ !:Specs = [Spec | !.Specs]
)
;
true
@@ -703,18 +707,18 @@
%-----------------------------------------------------------------------------%
- % Ensure that all constructors occurring in predicate mode
- % declarations are module qualified.
+ % Ensure that all constructors occurring in predicate mode declarations
+ % are module qualified.
%
:- pred propagate_types_into_modes(module_info::in,
list(proc_id)::out, pred_info::in, pred_info::out) is det.
-propagate_types_into_modes(ModuleInfo, ErrorProcs, !PredInfo) :-
+propagate_types_into_modes(ModuleInfo, ErrorProcIds, !PredInfo) :-
pred_info_get_arg_types(!.PredInfo, ArgTypes),
pred_info_get_procedures(!.PredInfo, Procs0),
ProcIds = pred_info_procids(!.PredInfo),
propagate_types_into_proc_modes(ModuleInfo, ProcIds, ArgTypes,
- [], ErrorProcs, Procs0, Procs),
+ [], ErrorProcIds, Procs0, Procs),
pred_info_set_procedures(Procs, !PredInfo).
%-----------------------------------------------------------------------------%
@@ -724,57 +728,49 @@
proc_table::in, proc_table::out) is det.
propagate_types_into_proc_modes(_, [], _,
- ErrorProcs, list.reverse(ErrorProcs), !Procs).
+ ErrorProcIds, list.reverse(ErrorProcIds), !Procs).
propagate_types_into_proc_modes(ModuleInfo, [ProcId | ProcIds], ArgTypes,
- !ErrorProcs, !Procs) :-
+ !ErrorProcIds, !Procs) :-
map.lookup(!.Procs, ProcId, ProcInfo0),
proc_info_get_argmodes(ProcInfo0, ArgModes0),
- propagate_types_into_mode_list(ModuleInfo, ArgTypes,
- ArgModes0, ArgModes),
+ propagate_types_into_mode_list(ModuleInfo, ArgTypes, ArgModes0, ArgModes),
% Check for unbound inst vars. (This needs to be done after
% propagate_types_into_mode_list, because we need the insts
% to be module-qualified; and it needs to be done before mode analysis,
% to avoid internal errors.)
( mode_list_contains_inst_var(ArgModes, ModuleInfo, _InstVar) ->
- !:ErrorProcs = [ProcId | !.ErrorProcs]
+ !:ErrorProcIds = [ProcId | !.ErrorProcIds]
;
proc_info_set_argmodes(ArgModes, ProcInfo0, ProcInfo),
svmap.det_update(ProcId, ProcInfo, !Procs)
),
propagate_types_into_proc_modes(ModuleInfo, ProcIds, ArgTypes,
- !ErrorProcs, !Procs).
+ !ErrorProcIds, !Procs).
:- pred report_unbound_inst_vars(module_info::in, pred_id::in,
list(proc_id)::in, pred_info::in, pred_info::out,
- io::di, io::uo) is det.
+ list(error_spec)::in, list(error_spec)::out) is det.
-report_unbound_inst_vars(ModuleInfo, PredId, ErrorProcs, !PredInfo, !IO) :-
+report_unbound_inst_vars(ModuleInfo, PredId, ErrorProcIds, !PredInfo,
+ !Specs) :-
(
- ErrorProcs = []
+ ErrorProcIds = []
;
- ErrorProcs = [_ | _],
+ ErrorProcIds = [_ | _],
pred_info_get_procedures(!.PredInfo, ProcTable0),
list.foldl2(report_unbound_inst_var_error(ModuleInfo, PredId),
- ErrorProcs, ProcTable0, ProcTable, !IO),
+ ErrorProcIds, ProcTable0, ProcTable, !Specs),
pred_info_set_procedures(ProcTable, !PredInfo)
).
:- pred report_unbound_inst_var_error(module_info::in,
pred_id::in, proc_id::in, proc_table::in, proc_table::out,
- io::di, io::uo) is det.
+ list(error_spec)::in, list(error_spec)::out) is det.
report_unbound_inst_var_error(ModuleInfo, PredId, ProcId, Procs0, Procs,
- !IO) :-
+ !Specs) :-
map.lookup(Procs0, ProcId, ProcInfo),
- unbound_inst_var_error(PredId, ProcInfo, ModuleInfo, !IO),
- % delete this mode, to avoid internal errors
- map.det_remove(Procs0, ProcId, _, Procs).
-
-:- pred unbound_inst_var_error(pred_id::in, proc_info::in, module_info::in,
- io::di, io::uo) is det.
-
-unbound_inst_var_error(PredId, ProcInfo, ModuleInfo, !IO) :-
proc_info_get_context(ProcInfo, Context),
Pieces = [words("In mode declaration for")] ++
describe_one_pred_name(ModuleInfo, should_not_module_qualify, PredId)
@@ -783,15 +779,17 @@
words("(Sorry, polymorphic modes are not supported.)"), nl],
Msg = simple_msg(Context, [always(Pieces)]),
Spec = error_spec(severity_error, phase_type_check, [Msg]),
- % XXX _NumErrors
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO).
+ !:Specs = [Spec | !.Specs],
+ % Delete this mode, to avoid internal errors.
+ map.det_remove(Procs0, ProcId, _, Procs).
%-----------------------------------------------------------------------------%
:- pred check_for_indistinguishable_modes(module_info::in, pred_id::in,
- pred_info::in, pred_info::out, io::di, io::uo) is det.
+ pred_info::in, pred_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
-check_for_indistinguishable_modes(ModuleInfo, PredId, !PredInfo, !IO) :-
+check_for_indistinguishable_modes(ModuleInfo, PredId, !PredInfo, !Specs) :-
(
% Don't check for indistinguishable modes in unification predicates.
% The default (in, in) mode must be semidet, but for single-value types
@@ -806,18 +804,19 @@
;
ProcIds = pred_info_procids(!.PredInfo),
check_for_indistinguishable_modes_in_procs(ModuleInfo, PredId,
- ProcIds, [], !PredInfo, !IO)
+ ProcIds, [], !PredInfo, !Specs)
).
:- pred check_for_indistinguishable_modes_in_procs(module_info::in,
pred_id::in, list(proc_id)::in, list(proc_id)::in,
- pred_info::in, pred_info::out, io::di, io::uo) is det.
+ pred_info::in, pred_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
-check_for_indistinguishable_modes_in_procs(_, _, [], _, !PredInfo, !IO).
+check_for_indistinguishable_modes_in_procs(_, _, [], _, !PredInfo, !Specs).
check_for_indistinguishable_modes_in_procs(ModuleInfo, PredId,
- [ProcId | ProcIds], PrevProcIds, !PredInfo, !IO) :-
+ [ProcId | ProcIds], PrevProcIds, !PredInfo, !Specs) :-
check_for_indistinguishable_mode(ModuleInfo, PredId, ProcId,
- PrevProcIds, Removed, !PredInfo, !IO),
+ PrevProcIds, Removed, !PredInfo, !Specs),
(
Removed = yes,
PrevProcIds1 = PrevProcIds
@@ -826,25 +825,27 @@
PrevProcIds1 = [ProcId | PrevProcIds]
),
check_for_indistinguishable_modes_in_procs(ModuleInfo, PredId, ProcIds,
- PrevProcIds1, !PredInfo, !IO).
+ PrevProcIds1, !PredInfo, !Specs).
:- pred check_for_indistinguishable_mode(module_info::in, pred_id::in,
proc_id::in, list(proc_id)::in, bool::out,
- pred_info::in, pred_info::out, io::di, io::uo) is det.
+ pred_info::in, pred_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
-check_for_indistinguishable_mode(_, _, _, [], no, !PredInfo, !IO).
+check_for_indistinguishable_mode(_, _, _, [], no, !PredInfo, !Specs).
check_for_indistinguishable_mode(ModuleInfo, PredId, ProcId1,
- [ProcId | ProcIds], Removed, !PredInfo, !IO) :-
+ [ProcId | ProcIds], Removed, !PredInfo, !Specs) :-
( modes_are_indistinguishable(ProcId, ProcId1, !.PredInfo, ModuleInfo) ->
pred_info_get_import_status(!.PredInfo, Status),
- globals.io_lookup_bool_option(intermodule_optimization,
- Intermod, !IO),
- globals.io_lookup_bool_option(make_optimization_interface,
- MakeOptInt, !IO),
- (
- % With `--intermodule-optimization' we can read
- % the declarations for a predicate from the `.int'
- % and `.int0' files, so ignore the error in that case.
+ module_info_get_globals(ModuleInfo, Globals),
+ globals.lookup_bool_option(Globals, intermodule_optimization,
+ Intermod),
+ globals.lookup_bool_option(Globals, make_optimization_interface,
+ MakeOptInt),
+ (
+ % With `--intermodule-optimization' we can read the declarations
+ % for a predicate from the `.int' and `.int0' files, so ignore
+ % the error in that case.
(
status_defined_in_this_module(Status) = yes
;
@@ -855,8 +856,9 @@
->
% XXX We shouldn't ignore the updated ModuleInfo, which may
% differ from the old one in including an updated error count.
- report_indistinguishable_modes_error(ProcId1,
- ProcId, PredId, !.PredInfo, ModuleInfo, _NewModuleInfo, !IO)
+ Spec = report_indistinguishable_modes_error(ModuleInfo,
+ ProcId1, ProcId, PredId, !.PredInfo),
+ !:Specs = [Spec | !.Specs]
;
true
),
@@ -864,7 +866,7 @@
Removed = yes
;
check_for_indistinguishable_mode(ModuleInfo, PredId, ProcId1,
- ProcIds, Removed, !PredInfo, !IO)
+ ProcIds, Removed, !PredInfo, !Specs)
).
%-----------------------------------------------------------------------------%
@@ -1415,37 +1417,33 @@
% Mercury definition.
%
:- pred check_for_missing_definitions(module_info::in,
- int::in, int::out, bool::in, bool::out, io::di, io::uo) is det.
+ list(error_spec)::in, list(error_spec)::out) is det.
-check_for_missing_definitions(ModuleInfo, !NumErrors, !FoundTypeError, !IO) :-
+check_for_missing_definitions(ModuleInfo, !Specs) :-
module_info_get_type_table(ModuleInfo, TypeTable),
- map.foldl3(check_for_missing_definitions_2, TypeTable,
- !NumErrors, !FoundTypeError, !IO).
+ map.foldl(check_for_missing_definitions_2, TypeTable, !Specs).
:- pred check_for_missing_definitions_2(type_ctor::in, hlds_type_defn::in,
- int::in, int::out, bool::in, bool::out, io::di, io::uo) is det.
+ list(error_spec)::in, list(error_spec)::out) is det.
-check_for_missing_definitions_2(TypeCtor, TypeDefn, !NumErrors,
- !FoundTypeError, !IO) :-
+check_for_missing_definitions_2(TypeCtor, TypeDefn, !Specs) :-
(
get_type_defn_status(TypeDefn, ImportStatus),
status_defined_in_this_module(ImportStatus) = yes,
get_type_defn_body(TypeDefn, TypeBody),
TypeBody = hlds_abstract_type(_)
->
- % We expect the builtin types character, float, int and
- % string to have abstract declarations with no
- % definitions. The following types from the type_desc
- % module also only have abstract declarations:
+ % We expect the builtin types character, float, int and string to have
+ % abstract declarations with no definitions. The following types from
+ % the type_desc module also only have abstract declarations:
%
% - type_desc/0
% - pseudo_type_desc/0
% - type_ctor_desc/0
%
- % We do not emit an error for these types. In addition,
- % we also don't bother checking for corresponding
- % definitions in any of the builtin modules in the
- % standard library.
+ % We do not emit an error for these types. In addition, we also don't
+ % bother checking for corresponding definitions in any of the builtin
+ % modules in the standard library.
TypeCtor = type_ctor(SymName, Arity),
BuiltinTypeCtors = builtin_type_ctors_with_no_hlds_type_defn,
@@ -1464,10 +1462,7 @@
words("has no corresponding definition."), nl],
Msg = simple_msg(TypeContext, [always(Pieces)]),
Spec = error_spec(severity_error, phase_type_check, [Msg]),
- % XXX _NumErrors
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO),
- !:FoundTypeError = yes,
- !:NumErrors = !.NumErrors + 1
+ !:Specs = [Spec | !.Specs]
;
true
)
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.102
diff -u -b -r1.102 purity.m
--- compiler/purity.m 5 Sep 2006 06:21:30 -0000 1.102
+++ compiler/purity.m 12 Sep 2006 02:24:18 -0000
@@ -122,10 +122,11 @@
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
+:- import_module parse_tree.error_util.
:- import_module parse_tree.prog_data.
:- import_module bool.
-:- import_module io.
+:- import_module list.
%-----------------------------------------------------------------------------%
@@ -133,13 +134,13 @@
% 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
+ % in post_typecheck.m because they are usually spurious). The second
% 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::di, io::uo) is det.
+ list(error_spec)::in, list(error_spec)::out) is det.
% Rerun purity checking on a procedure after an optimization pass has
% performed transformations which might affect the procedure's purity.
@@ -152,10 +153,9 @@
pred_info::out) is det.
% Give an error message for unifications marked impure/semipure
- % that are not function calls (e.g. impure X = 4)
+ % that are not function calls (e.g. impure X = 4).
%
-:- pred impure_unification_expr_error(prog_context::in, purity::in,
- io::di, io::uo) is det.
+:- func impure_unification_expr_error(prog_context, purity) = error_spec.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -180,7 +180,6 @@
:- import_module libs.globals.
:- import_module libs.options.
:- import_module mdbcomp.prim_data.
-:- import_module parse_tree.error_util.
:- import_module parse_tree.mercury_to_mercury.
:- import_module parse_tree.module_qual.
:- import_module parse_tree.prog_data.
@@ -193,6 +192,7 @@
:- import_module assoc_list.
:- import_module bool.
:- import_module int.
+:- import_module io.
:- import_module list.
:- import_module map.
:- import_module maybe.
@@ -207,41 +207,51 @@
% Public Predicates
%
-puritycheck(FoundTypeError, PostTypecheckError, !HLDS, !IO) :-
- globals.io_lookup_bool_option(statistics, Statistics, !IO),
- globals.io_lookup_bool_option(verbose, Verbose, !IO),
-
- maybe_write_string(Verbose, "% Purity-checking clauses...\n", !IO),
- check_preds_purity(FoundTypeError, PostTypecheckError, !HLDS, !IO),
- maybe_report_stats(Statistics, !IO).
+puritycheck(FoundTypeError, PostTypecheckError, !ModuleInfo, !Specs) :-
+ module_info_get_globals(!.ModuleInfo, Globals),
+ globals.lookup_bool_option(Globals, statistics, Statistics),
+ globals.lookup_bool_option(Globals, verbose, Verbose),
+
+ trace [io(!IO)] (
+ maybe_write_string(Verbose, "% Purity-checking clauses...\n", !IO)
+ ),
+ finish_typecheck_and_check_preds_purity(FoundTypeError, PostTypecheckError,
+ !ModuleInfo, !Specs),
+ trace [io(!IO)] (
+ maybe_report_stats(Statistics, !IO)
+ ).
%-----------------------------------------------------------------------------%
% 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::di, io::uo) is det.
+:- pred finish_typecheck_and_check_preds_purity(bool::in, bool::out,
+ module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
-check_preds_purity(FoundTypeError, PostTypecheckError, !ModuleInfo, !IO) :-
+finish_typecheck_and_check_preds_purity(FoundTypeError, PostTypecheckError,
+ !ModuleInfo, !Specs) :-
module_info_predids(!.ModuleInfo, PredIds),
% Only report error messages for unbound type variables if we didn't get
% any type errors already; this avoids a lot of spurious diagnostics.
ReportTypeErrors = bool.not(FoundTypeError),
- post_typecheck.finish_preds(PredIds, ReportTypeErrors, NumErrors1,
- PostTypecheckError, !ModuleInfo, !IO),
+ post_typecheck.finish_preds(PredIds, ReportTypeErrors, NumPostErrors,
+ !ModuleInfo, !Specs),
+ ( NumPostErrors > 0 ->
+ PostTypecheckError = yes
+ ;
+ PostTypecheckError = no
+ ),
- check_preds_purity_2(PredIds, !ModuleInfo, NumErrors1, NumErrors, !IO),
- module_info_get_num_errors(!.ModuleInfo, Errs0),
- Errs = Errs0 + NumErrors,
- module_info_set_num_errors(Errs, !ModuleInfo).
-
-:- pred check_preds_purity_2(list(pred_id)::in,
- module_info::in, module_info::out, int::in, int::out,
- io::di, io::uo) is det.
+ check_preds_purity(PredIds, !ModuleInfo, !Specs).
-check_preds_purity_2([], !ModuleInfo, !NumErrors, !IO).
-check_preds_purity_2([PredId | PredIds], !ModuleInfo, !NumErrors, !IO) :-
+:- pred check_preds_purity(list(pred_id)::in,
+ module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+check_preds_purity([], !ModuleInfo, !Specs).
+check_preds_purity([PredId | PredIds], !ModuleInfo, !Specs) :-
module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
(
( pred_info_is_imported(PredInfo0)
@@ -250,22 +260,22 @@
->
PredInfo = PredInfo0
;
+ trace [io(!IO)] (
write_pred_progress_message("% Purity-checking ", PredId,
- !.ModuleInfo, !IO),
- puritycheck_pred(PredId, PredInfo0, PredInfo, !.ModuleInfo,
- PurityErrsInThisPred, !IO),
- !:NumErrors = !.NumErrors + PurityErrsInThisPred,
+ !.ModuleInfo, !IO)
+ ),
+ puritycheck_pred(PredId, PredInfo0, PredInfo, !.ModuleInfo, !Specs),
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo)
),
% Finish processing of promise declarations.
pred_info_get_goal_type(PredInfo, GoalType),
( GoalType = goal_type_promise(PromiseType) ->
- post_typecheck.finish_promise(PromiseType, PredId, !ModuleInfo, !IO)
+ post_typecheck.finish_promise(PromiseType, PredId, !ModuleInfo, !Specs)
;
true
),
- check_preds_purity_2(PredIds, !ModuleInfo, !NumErrors, !IO).
+ check_preds_purity(PredIds, !ModuleInfo, !Specs).
%-----------------------------------------------------------------------------%
%
@@ -287,9 +297,9 @@
% 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::di, io::uo) is det.
+ module_info::in, list(error_spec)::in, list(error_spec)::out) is det.
-puritycheck_pred(PredId, !PredInfo, ModuleInfo, NumErrors, !IO) :-
+puritycheck_pred(PredId, !PredInfo, ModuleInfo, !Specs) :-
pred_info_get_purity(!.PredInfo, DeclPurity) ,
pred_info_get_promised_purity(!.PredInfo, PromisedPurity),
some [!ClausesInfo] (
@@ -303,13 +313,9 @@
compute_purity(Clauses0, Clauses, !.PredInfo, purity_pure, Purity,
PurityInfo0, PurityInfo),
PurityInfo = purity_info(_, _, !:PredInfo,
- VarTypes, VarSet, RevMessages, _),
+ VarTypes, VarSet, GoalSpecs, _),
clauses_info_set_vartypes(VarTypes, !ClausesInfo),
clauses_info_set_varset(VarSet, !ClausesInfo),
- Messages = list.reverse(RevMessages),
- list.foldl(report_post_typecheck_message(ModuleInfo), Messages, !IO),
- NumErrors0 = list.length(list.filter((pred(error(_)::in) is semidet),
- Messages)),
clauses_info_set_clauses(Clauses, !ClausesInfo),
pred_info_set_clauses_info(!.ClausesInfo, !PredInfo)
),
@@ -318,27 +324,28 @@
PromisedPurity, PurityCheckResult),
(
PurityCheckResult = inconsistent_promise,
- NumErrors = NumErrors0 + 1,
- error_inconsistent_promise(ModuleInfo, !.PredInfo, PredId,
- DeclPurity, !IO)
+ Spec = error_inconsistent_promise(ModuleInfo, !.PredInfo, PredId,
+ DeclPurity),
+ PredSpecs = [Spec | GoalSpecs]
;
PurityCheckResult = unnecessary_decl,
- NumErrors = NumErrors0,
- warn_exaggerated_impurity_decl(ModuleInfo, !.PredInfo, PredId,
- DeclPurity, WorstPurity, !IO)
+ Spec = warn_exaggerated_impurity_decl(ModuleInfo, !.PredInfo, PredId,
+ DeclPurity, WorstPurity),
+ PredSpecs = [Spec | GoalSpecs]
;
PurityCheckResult = insufficient_decl,
- NumErrors = NumErrors0 + 1,
- error_inferred_impure(ModuleInfo, !.PredInfo, PredId, Purity, !IO)
+ Spec = error_inferred_impure(ModuleInfo, !.PredInfo, PredId, Purity),
+ PredSpecs = [Spec | GoalSpecs]
;
PurityCheckResult = unnecessary_promise_pure,
- NumErrors = NumErrors0,
- warn_unnecessary_promise_pure(ModuleInfo, !.PredInfo, PredId,
- PromisedPurity, !IO)
+ Spec = warn_unnecessary_promise_pure(ModuleInfo, !.PredInfo, PredId,
+ PromisedPurity),
+ PredSpecs = [Spec | GoalSpecs]
;
PurityCheckResult = no_worries,
- NumErrors = NumErrors0
- ).
+ PredSpecs = GoalSpecs
+ ),
+ !:Specs = PredSpecs ++ !.Specs.
repuritycheck_proc(ModuleInfo, proc(_PredId, ProcId), !PredInfo) :-
pred_info_get_procedures(!.PredInfo, Procs0),
@@ -540,8 +547,8 @@
goal_info_get_purity(GoalInfo, DeclaredPurity),
( DeclaredPurity \= purity_pure ->
goal_info_get_context(GoalInfo, Context),
- Message = impure_unification_expr_error(Context, DeclaredPurity),
- purity_info_add_message(error(Message), !Info)
+ Spec = impure_unification_expr_error(Context, DeclaredPurity),
+ purity_info_add_message(Spec, !Info)
;
true
),
@@ -725,8 +732,8 @@
!.Info ^ implicit_purity = dont_make_implicit_promises
->
goal_info_get_context(GoalInfo, Context),
- Message = impure_unification_expr_error(Context, DeclaredPurity),
- purity_info_add_message(error(Message), !Info)
+ Spec = impure_unification_expr_error(Context, DeclaredPurity),
+ purity_info_add_message(Spec, !Info)
;
true
).
@@ -859,8 +866,8 @@
;
less_pure(ActualPurity, DeclaredPurity)
->
- purity_info_add_message(
- error(missing_body_impurity_error(Context, PredId)), !Info)
+ Spec = error_missing_body_impurity_decl(ModuleInfo, PredId, Context),
+ purity_info_add_message(Spec, !Info)
;
% We don't warn about exaggerated impurity decls in class methods
% or instance methods --- it just means that the predicate provided
@@ -875,10 +882,9 @@
->
true
;
- purity_info_add_message(
- warning(unnecessary_body_impurity_decl(Context,
- PredId, DeclaredPurity)),
- !Info)
+ Spec = warn_unnecessary_body_impurity_decl(ModuleInfo, PredId, Context,
+ DeclaredPurity),
+ purity_info_add_message(Spec, !Info)
).
:- pred compute_goal_purity(hlds_goal::in, hlds_goal::out, purity::out,
@@ -940,8 +946,8 @@
),
Goal0 = _ - GoalInfo0,
goal_info_get_context(GoalInfo0, Context),
- purity_info_add_message(error(impure_parallel_conjunct_error(Context,
- GoalPurity)), !Info)
+ Spec = impure_parallel_conjunct_error(Context, GoalPurity),
+ purity_info_add_message(Spec, !Info)
),
!:Purity = worst_purity(GoalPurity, !.Purity),
!:ContainsTrace = worst_contains_trace(GoalContainsTrace, !.ContainsTrace),
@@ -962,46 +968,55 @@
%-----------------------------------------------------------------------------%
+:- 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, !Info) :-
+ ( ActualPurity `less_pure` DeclaredPurity ->
+ goal_info_get_context(GoalInfo, Context),
+ Spec = report_error_closure_purity(Context,
+ DeclaredPurity, ActualPurity),
+ purity_info_add_message(Spec, !Info)
+ ;
+ % We don't bother to warn if the DeclaredPurity is less pure than the
+ % ActualPurity; that would lead to too many spurious warnings.
+ true
+ ).
+
+%-----------------------------------------------------------------------------%
+
:- 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,
+ PredPieces = describe_one_pred_name(ModuleInfo, should_not_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::di, io::uo) is det.
+:- func error_inconsistent_promise(module_info, pred_info, pred_id, purity)
+ = error_spec.
-error_inconsistent_promise(ModuleInfo, PredInfo, PredId, Purity, !IO) :-
+error_inconsistent_promise(ModuleInfo, PredInfo, PredId, Purity) = Spec :-
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 ++
+ MainPieces = PredContextPieces ++
[words("error: 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),
+ VerbosePieces = [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,
- globals.io_set_extra_error_info(yes, !IO),
- Pieces = Pieces1
- ),
- write_error_pieces(Context, 0, Pieces, !IO).
+ words("no impurity declaration.")],
+ Msg = simple_msg(Context,
+ [always(MainPieces), verbose_only(VerbosePieces)]),
+ Spec = error_spec(severity_error, phase_purity_check, [Msg]).
-:- pred warn_exaggerated_impurity_decl(module_info::in, pred_info::in,
- pred_id::in, purity::in, purity::in,
- io::di, io::uo) is det.
+:- func warn_exaggerated_impurity_decl(module_info, pred_info, pred_id,
+ purity, purity) = error_spec.
warn_exaggerated_impurity_decl(ModuleInfo, PredInfo, PredId,
- DeclPurity, ActualPurity, !IO) :-
+ DeclPurity, ActualPurity) = Spec :-
pred_info_context(PredInfo, Context),
PredContextPieces = pred_context(ModuleInfo, PredInfo, PredId),
purity_name(DeclPurity, DeclPurityName),
@@ -1009,14 +1024,14 @@
Pieces = PredContextPieces ++
[words("warning: declared"), fixed(DeclPurityName),
words("but actually"), fixed(ActualPurityName ++ ".")],
- write_error_pieces(Context, 0, Pieces, !IO),
- record_warning(!IO).
+ Msg = simple_msg(Context, [always(Pieces)]),
+ Spec = error_spec(severity_warning, phase_purity_check, [Msg]).
-:- pred warn_unnecessary_promise_pure(module_info::in, pred_info::in,
- pred_id::in, purity::in, io::di, io::uo) is det.
+:- func warn_unnecessary_promise_pure(module_info, pred_info, pred_id, purity)
+ = error_spec.
-warn_unnecessary_promise_pure(ModuleInfo, PredInfo, PredId, PromisedPurity,
- !IO) :-
+warn_unnecessary_promise_pure(ModuleInfo, PredInfo, PredId, PromisedPurity)
+ = Spec :-
pred_info_context(PredInfo, Context),
PredContextPieces = pred_context(ModuleInfo, PredInfo, PredId),
(
@@ -1031,29 +1046,22 @@
PromisedPurity = purity_impure,
unexpected(this_file, "warn_unnecessary_promise_pure: promise_impure?")
),
- 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,
- globals.io_set_extra_error_info(yes, !IO),
- Pieces = PredContextPieces ++ Pieces1
- ),
- write_error_pieces(Context, 0, Pieces, !IO),
- record_warning(!IO).
+ MainPieces = [words("warning: unnecessary"), quote(Pragma),
+ words("pragma."), nl],
+ VerbosePieces = [words("This"), p_or_f(PredOrFunc),
+ words("does not invoke any"), fixed(CodeStr), words("code,"),
+ words("so there is no need for a"), quote(Pragma), words("pragma."),
+ nl],
+ Msg = simple_msg(Context,
+ [always(PredContextPieces), always(MainPieces),
+ verbose_only(VerbosePieces)]),
+ Spec = error_spec(severity_warning, phase_purity_check, [Msg]).
-:- pred error_inferred_impure(module_info::in, pred_info::in, pred_id::in,
- purity::in, io::di, io::uo) is det.
+:- func error_inferred_impure(module_info, pred_info, pred_id, purity)
+ = error_spec.
-error_inferred_impure(ModuleInfo, PredInfo, PredId, Purity, !IO) :-
+error_inferred_impure(ModuleInfo, PredInfo, PredId, Purity) = Spec :-
pred_info_context(PredInfo, Context),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
PredOrFuncStr = pred_or_func_to_full_str(PredOrFunc),
@@ -1063,75 +1071,21 @@
purity_name(DeclaredPurity, DeclaredPurityName),
Pieces1 = [words("purity error:"), fixed(PredOrFuncStr),
- words("is"), fixed(PurityName ++ "."), nl],
+ words("is"), fixed(PurityName), suffix("."), 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 ++ ".")]
+ Pieces2 = [words("It must be declared"), quote(PurityName),
+ words("or promised"), fixed(DeclaredPurityName ++ "."), nl]
),
- 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).
-
-:- type post_typecheck_messages == list(post_typecheck_message).
-
-:- type post_typecheck_error
- ---> missing_body_impurity_error(prog_context, pred_id)
- ; closure_purity_error(prog_context, purity, purity)
- % closure_purity_error(Context, DeclaredPurity, ActualPurity)
- ; impure_unification_expr_error(prog_context, purity)
- ; impure_parallel_conjunct_error(prog_context, purity).
-
-:- type post_typecheck_warning
- ---> unnecessary_body_impurity_decl(prog_context, pred_id, purity)
- ; redundant_promise_purity(prog_context, purity, purity).
+ Msg = simple_msg(Context,
+ [always(PredContextPieces), always(Pieces1), always(Pieces2)]),
+ Spec = error_spec(severity_error, phase_purity_check, [Msg]).
-:- pred report_post_typecheck_message(module_info::in,
- post_typecheck_message::in, io::di, io::uo) is det.
+:- func error_missing_body_impurity_decl(module_info, pred_id, prog_context)
+ = error_spec.
-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, !IO)
- ;
- Message = closure_purity_error(Context, DeclaredPurity, ActualPurity),
- report_error_closure_purity(Context, DeclaredPurity, ActualPurity, !IO)
- ;
- Message = impure_unification_expr_error(Context, Purity),
- impure_unification_expr_error(Context, Purity, !IO)
- ;
- Message = impure_parallel_conjunct_error(Context, Purity),
- impure_parallel_conjunct_error(Context, Purity, !IO)
- ).
-
-report_post_typecheck_message(ModuleInfo, warning(Warning), !IO) :-
- record_warning(!IO),
- (
- Warning = unnecessary_body_impurity_decl(Context, PredId,
- DeclaredPurity),
- warn_unnecessary_body_impurity_decl(ModuleInfo, PredId, Context,
- DeclaredPurity, !IO)
- ;
- Warning = redundant_promise_purity(Context, PromisedPurity,
- InsidePurity),
- warn_redundant_promise_purity(Context, PromisedPurity,
- InsidePurity, !IO)
- ).
-
-:- pred error_missing_body_impurity_decl(module_info::in, pred_id::in,
- prog_context::in, io::di, io::uo) is det.
-
-error_missing_body_impurity_decl(ModuleInfo, PredId, Context, !IO) :-
+error_missing_body_impurity_decl(ModuleInfo, PredId, Context) = Spec :-
module_info_pred_info(ModuleInfo, PredId, PredInfo),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
pred_info_get_purity(PredInfo, Purity),
@@ -1143,22 +1097,21 @@
(
PredOrFunc = predicate,
Pieces2 = [words("purity error: call must be preceded by"),
- fixed("`" ++ PurityName ++ "'"),
- words("indicator.")]
+ quote(PurityName), words("indicator."), nl]
;
PredOrFunc = function,
- Pieces2 = [words("purity error: call must be in an " ++
- "explicit unification which is preceded by"),
- fixed("`" ++ PurityName ++ "'"),
- words("indicator.")]
+ Pieces2 = [words("purity error: call must be in"),
+ words("an explicit unification which is preceded by"),
+ quote(PurityName), words("indicator."), nl]
),
- write_error_pieces(Context, 0, Pieces1 ++ Pieces2, !IO).
+ Msg = simple_msg(Context, [always(Pieces1), always(Pieces2)]),
+ Spec = error_spec(severity_error, phase_purity_check, [Msg]).
-:- pred warn_unnecessary_body_impurity_decl(module_info::in, pred_id::in,
- prog_context::in, purity::in, io::di, io::uo) is det.
+:- func warn_unnecessary_body_impurity_decl(module_info, pred_id, prog_context,
+ purity) = error_spec.
warn_unnecessary_body_impurity_decl(ModuleInfo, PredId, Context,
- DeclaredPurity, !IO) :-
+ DeclaredPurity) = Spec :-
module_info_pred_info(ModuleInfo, PredId, PredInfo),
pred_info_get_purity(PredInfo, ActualPurity),
purity_name(DeclaredPurity, DeclaredPurityName),
@@ -1167,70 +1120,58 @@
PredId),
Pieces1 = [words("In call to")] ++ PredPieces ++ [suffix(":"), nl,
- words("warning: unnecessary"),
- fixed("`" ++ DeclaredPurityName ++ "'"),
+ words("warning: unnecessary"), quote(DeclaredPurityName),
words("indicator."), nl],
( ActualPurity = purity_pure ->
- Pieces2 = [words("No purity indicator is necessary.")]
+ Pieces2 = [words("No purity indicator is necessary."), nl]
;
- Pieces2 = [words("A purity indicator of"),
- fixed("`" ++ ActualPurityName ++ "'"), words("is sufficient.")]
+ Pieces2 = [words("A purity indicator of"), quote(ActualPurityName),
+ words("is sufficient."), nl]
),
- write_error_pieces(Context, 0, Pieces1 ++ Pieces2, !IO).
+ Msg = simple_msg(Context, [always(Pieces1), always(Pieces2)]),
+ Spec = error_spec(severity_warning, phase_purity_check, [Msg]).
-:- pred warn_redundant_promise_purity(prog_context::in, purity::in, purity::in,
- io::di, io::uo) is det.
+:- func warn_redundant_promise_purity(prog_context, purity, purity)
+ = error_spec.
-warn_redundant_promise_purity(Context, PromisedPurity, InsidePurity, !IO) :-
+warn_redundant_promise_purity(Context, PromisedPurity, InsidePurity) = Spec :-
purity_name(PromisedPurity, PromisedPurityName),
DeclName = "promise_" ++ PromisedPurityName,
purity_name(InsidePurity, InsidePurityName),
- Pieces = [words("Warning: unnecessary"),
- fixed("`" ++ DeclName ++ "'"), words("goal."), nl,
+ Pieces = [words("Warning: unnecessary"), quote(DeclName),
+ words("goal."), nl,
words("The purity inside is"), words(InsidePurityName), nl],
- write_error_pieces(Context, 0, Pieces, !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, !IO) :-
- ( ActualPurity `less_pure` DeclaredPurity ->
- goal_info_get_context(GoalInfo, Context),
- purity_info_add_message(error(closure_purity_error(Context,
- 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
- ).
+ Msg = simple_msg(Context, [always(Pieces)]),
+ Spec = error_spec(severity_warning, phase_purity_check, [Msg]).
-:- pred report_error_closure_purity(prog_context::in, purity::in, purity::in,
- io::di, io::uo) is det.
+:- func report_error_closure_purity(prog_context, purity, purity) = error_spec.
-report_error_closure_purity(Context, _DeclaredPurity, ActualPurity, !IO) :-
+report_error_closure_purity(Context, _DeclaredPurity, ActualPurity) = Spec :-
purity_name(ActualPurity, ActualPurityName),
Pieces = [words("Purity error in closure: closure body is"),
- fixed(ActualPurityName ++ ","),
+ fixed(ActualPurityName), suffix(","),
words("but closure was not declared"),
- fixed(ActualPurityName ++ ".")],
- write_error_pieces(Context, 0, Pieces, !IO).
+ fixed(ActualPurityName), suffix("."), nl],
+ Msg = simple_msg(Context, [always(Pieces)]),
+ Spec = error_spec(severity_error, phase_purity_check, [Msg]).
-impure_unification_expr_error(Context, Purity, !IO) :-
+impure_unification_expr_error(Context, Purity) = Spec :-
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).
+ Msg = simple_msg(Context, [always(Pieces)]),
+ Spec = error_spec(severity_error, phase_purity_check, [Msg]).
-:- pred impure_parallel_conjunct_error(prog_context::in, purity::in,
- io::di, io::uo) is det.
+:- func impure_parallel_conjunct_error(prog_context, purity) = error_spec.
-impure_parallel_conjunct_error(Context, Purity, !IO) :-
+impure_parallel_conjunct_error(Context, Purity) = Spec :-
purity_name(Purity, PurityName),
Pieces = [words("Purity error: parallel conjunct is"),
fixed(PurityName ++ ","),
words("but parallel conjuncts must be pure.")],
- write_error_pieces(Context, 0, Pieces, !IO).
+ Msg = simple_msg(Context, [always(Pieces)]),
+ Spec = error_spec(severity_error, phase_purity_check, [Msg]).
%-----------------------------------------------------------------------------%
@@ -1244,7 +1185,7 @@
pred_info :: pred_info,
vartypes :: vartypes,
varset :: prog_varset,
- messages :: post_typecheck_messages,
+ messages :: list(error_spec),
implicit_purity :: implicit_purity_promise
% If this is make_implicit_promises then
% purity annotations are optional in the
@@ -1252,11 +1193,11 @@
% should not be generated.
).
-:- pred purity_info_add_message(post_typecheck_message::in,
+:- pred purity_info_add_message(error_spec::in,
purity_info::in, purity_info::out) is det.
-purity_info_add_message(Message, Info,
- Info ^ messages := [Message | Info ^ messages]).
+purity_info_add_message(Spec, Info0, Info) :-
+ Info = Info0 ^ messages := [Spec | Info0 ^ messages].
%-----------------------------------------------------------------------------%
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.403
diff -u -b -r1.403 typecheck.m
--- compiler/typecheck.m 7 Sep 2006 05:51:07 -0000 1.403
+++ compiler/typecheck.m 12 Sep 2006 02:55:37 -0000
@@ -80,22 +80,21 @@
:- interface.
:- import_module hlds.hlds_module.
+:- import_module parse_tree.error_util.
:- import_module bool.
-:- import_module io.
+:- import_module list.
- % typecheck(Module0, Module, FoundError, ExceededIterationLimit, !IO)
+ % typecheck_module(!ModuleInfo, Specs, ExceededIterationLimit):
%
- % Type-checks Module0 and annotates it with variable typings
- % (returning the result in Module), printing out appropriate
- % error messages.
- % FoundError is set to `yes' if there are any errors and
- % `no' otherwise.
- % ExceededIterationLimit is set to `yes' if the type inference
- % iteration limit was reached and `no' otherwise.
+ % Type checks ModuleInfo and annotates it with variable type information.
+ % Specs is set to the list of errors and warnings found, plus messages
+ % about the predicates and functions whose types have been inferred.
+ % ExceededIterationLimit is set to `yes' if the type inference iteration
+ % limit was reached and `no' otherwise.
%
-:- pred typecheck(module_info::in, module_info::out, bool::out, bool::out,
- io::di, io::uo) is det.
+:- pred typecheck_module(module_info::in, module_info::out,
+ list(error_spec)::out, bool::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -124,7 +123,6 @@
:- import_module libs.globals.
:- import_module libs.options.
:- import_module mdbcomp.prim_data.
-:- import_module parse_tree.error_util.
:- import_module parse_tree.mercury_to_mercury.
:- import_module parse_tree.modules.
:- import_module parse_tree.prog_data.
@@ -140,7 +138,6 @@
:- import_module assoc_list.
:- import_module getopt_io.
:- import_module int.
-:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module multi_map.
@@ -154,60 +151,52 @@
%-----------------------------------------------------------------------------%
-typecheck(!Module, FoundError, ExceededIterationLimit, !IO) :-
- globals.io_lookup_bool_option(statistics, Statistics, !IO),
- globals.io_lookup_bool_option(verbose, Verbose, !IO),
- maybe_write_string(Verbose, "% Type-checking clauses...\n", !IO),
- typecheck_module(!Module, FoundError, ExceededIterationLimit, !IO),
- maybe_report_stats(Statistics, !IO).
-
-%-----------------------------------------------------------------------------%
-
- % Type-check the code for all the predicates in a module.
- %
-:- pred typecheck_module(module_info::in, module_info::out,
- bool::out, bool::out, io::di, io::uo) is det.
-
-typecheck_module(!Module, FoundError, ExceededIterationLimit, !IO) :-
- module_info_predids(!.Module, PredIds),
- globals.io_lookup_int_option(type_inference_iteration_limit,
- MaxIterations, !IO),
- typecheck_to_fixpoint(1, MaxIterations, PredIds, !Module,
- FoundError, ExceededIterationLimit, !IO),
- write_type_inference_messages(PredIds, !.Module, !IO).
+typecheck_module(!ModuleInfo, Specs, ExceededIterationLimit) :-
+ module_info_predids(!.ModuleInfo, PredIds),
+ module_info_get_globals(!.ModuleInfo, Globals),
+ globals.lookup_int_option(Globals, type_inference_iteration_limit,
+ MaxIterations),
+ typecheck_to_fixpoint(1, MaxIterations, PredIds, !ModuleInfo,
+ CheckSpecs, ExceededIterationLimit),
+ construct_type_inference_messages(PredIds, !.ModuleInfo, [], InferSpecs),
+ Specs = InferSpecs ++ CheckSpecs.
% Repeatedly typecheck the code for a group of predicates
% until a fixpoint is reached, or until some errors are detected.
%
:- pred typecheck_to_fixpoint(int::in, int::in, list(pred_id)::in,
- module_info::in, module_info::out, bool::out, bool::out,
- io::di, io::uo) is det.
+ module_info::in, module_info::out, list(error_spec)::out, bool::out)
+ is det.
-typecheck_to_fixpoint(Iteration, NumIterations, PredIds, !Module,
- FoundError, ExceededIterationLimit, !IO) :-
- typecheck_module_one_iteration(Iteration, PredIds, !Module,
- no, FoundError1, no, Changed, !IO),
+typecheck_to_fixpoint(Iteration, NumIterations, PredIds, !ModuleInfo,
+ Specs, ExceededIterationLimit) :-
+ typecheck_module_one_iteration(Iteration, PredIds, !ModuleInfo,
+ [], CurSpecs, no, Changed),
+ module_info_get_globals(!.ModuleInfo, Globals),
(
( Changed = no
- ; FoundError1 = yes
+ ; contains_errors(Globals, CurSpecs) = yes
)
->
- FoundError = FoundError1,
+ Specs = CurSpecs,
ExceededIterationLimit = no
;
- globals.io_lookup_bool_option(debug_types, DebugTypes, !IO),
+ globals.lookup_bool_option(Globals, debug_types, DebugTypes),
(
DebugTypes = yes,
- write_type_inference_messages(PredIds, !.Module, !IO)
+ construct_type_inference_messages(PredIds, !.ModuleInfo,
+ [], ProgressSpecs),
+ trace [io(!IO)] (
+ write_error_specs(ProgressSpecs, 0, _, 0, _, !IO)
+ )
;
DebugTypes = no
),
( Iteration < NumIterations ->
typecheck_to_fixpoint(Iteration + 1, NumIterations, PredIds,
- !Module, FoundError, ExceededIterationLimit, !IO)
+ !ModuleInfo, Specs, ExceededIterationLimit)
;
- typecheck_report_max_iterations_exceeded(!IO),
- FoundError = yes,
+ Specs = [typecheck_report_max_iterations_exceeded(NumIterations)],
ExceededIterationLimit = yes
)
).
@@ -215,11 +204,11 @@
% Write out the inferred `pred' or `func' declarations for a list of
% predicates. Don't write out the inferred types for assertions.
%
-:- pred write_type_inference_messages(list(pred_id)::in, module_info::in,
- io::di, io::uo) is det.
+:- pred construct_type_inference_messages(list(pred_id)::in, module_info::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
-write_type_inference_messages([], _, !IO).
-write_type_inference_messages([PredId | PredIds], ModuleInfo, !IO) :-
+construct_type_inference_messages([], _, !Specs).
+construct_type_inference_messages([PredId | PredIds], ModuleInfo, !Specs) :-
module_info_pred_info(ModuleInfo, PredId, PredInfo),
pred_info_get_markers(PredInfo, Markers),
(
@@ -228,18 +217,19 @@
list.member(PredId, ValidPredIds),
\+ pred_info_get_goal_type(PredInfo, goal_type_promise(_))
->
- write_type_inference_message(PredInfo, !IO)
+ Spec = construct_type_inference_message(PredInfo),
+ !:Specs = [Spec | !.Specs]
;
true
),
- write_type_inference_messages(PredIds, ModuleInfo, !IO).
+ construct_type_inference_messages(PredIds, ModuleInfo, !Specs).
- % Write out the inferred `pred' or `func' declaration
+ % Construct a message containing the inferred `pred' or `func' declaration
% for a single predicate.
%
-:- pred write_type_inference_message(pred_info::in, io::di, io::uo) is det.
+:- func construct_type_inference_message(pred_info) = error_spec.
-write_type_inference_message(PredInfo, !IO) :-
+construct_type_inference_message(PredInfo) = Spec :-
PredName = pred_info_name(PredInfo),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
Name = unqualified(PredName),
@@ -249,25 +239,25 @@
pred_info_get_class_context(PredInfo, ClassContext),
pred_info_get_purity(PredInfo, Purity),
MaybeDet = no,
- prog_out.write_context(Context, !IO),
- io.write_string("Inferred ", !IO),
AppendVarNums = no,
(
PredOrFunc = predicate,
- mercury_output_pred_type(VarSet, ExistQVars, Name, Types,
- MaybeDet, Purity, ClassContext, Context, AppendVarNums, !IO)
+ TypeStr = mercury_pred_type_to_string(VarSet, ExistQVars, Name, Types,
+ MaybeDet, Purity, ClassContext, Context, AppendVarNums)
;
PredOrFunc = function,
pred_args_to_func_args(Types, ArgTypes, RetType),
- mercury_output_func_type(VarSet, ExistQVars, Name, ArgTypes, RetType,
- MaybeDet, Purity, ClassContext, Context, AppendVarNums, !IO)
- ).
+ TypeStr = mercury_func_type_to_string(VarSet, ExistQVars, Name,
+ ArgTypes, RetType, MaybeDet, Purity, ClassContext, Context,
+ AppendVarNums)
+ ),
+ Pieces = [words("Inferred"), words(TypeStr), nl],
+ Msg = simple_msg(Context, [always(Pieces)]),
+ Spec = error_spec(severity_informational, phase_type_check, [Msg]).
-:- pred typecheck_report_max_iterations_exceeded(io::di, io::uo) is det.
+:- func typecheck_report_max_iterations_exceeded(int) = error_spec.
-typecheck_report_max_iterations_exceeded(!IO) :-
- globals.io_lookup_int_option(type_inference_iteration_limit,
- MaxIterations, !IO),
+typecheck_report_max_iterations_exceeded(MaxIterations) = Spec :-
Pieces = [words("Type inference iteration limit exceeded."),
words("This probably indicates that your program has a type error."),
words("You should declare the types explicitly."),
@@ -276,34 +266,34 @@
words("You can use the `--type-inference-iteration-limit' option"),
words("to increase the limit).")],
Msg = error_msg(no, no, 0, [always(Pieces)]),
- Spec = error_spec(severity_error, phase_type_check, [Msg]),
- % XXX _NumErrors
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO).
+ Spec = error_spec(severity_error, phase_type_check, [Msg]).
%-----------------------------------------------------------------------------%
% Iterate over the list of pred_ids in a module.
%
:- pred typecheck_module_one_iteration(int::in, list(pred_id)::in,
- module_info::in, module_info::out, bool::in, bool::out,
- bool::in, bool::out, io::di, io::uo) is det.
+ module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out, bool::in, bool::out) is det.
-typecheck_module_one_iteration(_, [], !ModuleInfo, !Error, !Changed, !IO).
+typecheck_module_one_iteration(_, [], !ModuleInfo, !Specs, !Changed).
typecheck_module_one_iteration(Iteration, [PredId | PredIds], !ModuleInfo,
- !Error, !Changed, !IO) :-
+ !Specs, !Changed) :-
module_info_preds(!.ModuleInfo, Preds0),
map.lookup(Preds0, PredId, PredInfo0),
( pred_info_is_imported(PredInfo0) ->
true
;
typecheck_pred_if_needed(Iteration, PredId, PredInfo0,
- PredInfo1, !ModuleInfo, NewError, NewChanged, !IO),
+ PredInfo1, !ModuleInfo, PredSpecs, PredChanged),
+ module_info_get_globals(!.ModuleInfo, Globals),
+ ContainsErrors = contains_errors(Globals, PredSpecs),
(
- NewError = no,
+ ContainsErrors = no,
map.det_update(Preds0, PredId, PredInfo1, Preds),
module_info_set_preds(Preds, !ModuleInfo)
;
- NewError = yes,
+ ContainsErrors = yes,
% /********************
% This code is not needed at the moment,
% since currently we don't run mode analysis if
@@ -330,18 +320,18 @@
module_info_set_preds(Preds, !ModuleInfo),
module_info_remove_predid(PredId, !ModuleInfo)
),
- bool.or(NewError, !Error),
- bool.or(NewChanged, !Changed)
+ !:Specs = PredSpecs ++ !.Specs,
+ bool.or(PredChanged, !Changed)
),
typecheck_module_one_iteration(Iteration, PredIds, !ModuleInfo,
- !Error, !Changed, !IO).
+ !Specs, !Changed).
:- pred typecheck_pred_if_needed(int::in, pred_id::in,
pred_info::in, pred_info::out, module_info::in, module_info::out,
- bool::out, bool::out, io::di, io::uo) is det.
+ list(error_spec)::out, bool::out) is det.
typecheck_pred_if_needed(Iteration, PredId, !PredInfo, !ModuleInfo,
- Error, Changed, !IO) :-
+ Specs, Changed) :-
(
% Compiler-generated predicates are created already type-correct,
% so there's no need to typecheck them. The same is true for builtins.
@@ -365,20 +355,19 @@
;
IsEmpty = no
),
- Error = no,
+ Specs = [],
Changed = no
;
typecheck_pred(Iteration, PredId, !PredInfo, !ModuleInfo,
- Error, Changed, !IO)
+ Specs, Changed)
).
-:- pred typecheck_pred(int::in, pred_id::in,
- pred_info::in, pred_info::out, module_info::in, module_info::out,
- bool::out, bool::out, io::di, io::uo) is det.
+:- pred typecheck_pred(int::in, pred_id::in, pred_info::in, pred_info::out,
+ module_info::in, module_info::out, list(error_spec)::out, bool::out)
+ is det.
-typecheck_pred(Iteration, PredId, !PredInfo, !ModuleInfo, Error, Changed,
- !IO) :-
- globals.io_get_globals(Globals, !IO),
+typecheck_pred(Iteration, PredId, !PredInfo, !ModuleInfo, Specs, Changed) :-
+ module_info_get_globals(!.ModuleInfo, Globals),
( Iteration = 1 ->
% Goal paths are used to identify typeclass constraints.
fill_goal_path_slots_in_clauses(!.ModuleInfo, no, !PredInfo),
@@ -391,7 +380,8 @@
;
true
),
- pred_info_get_arg_types(!.PredInfo, _ArgTypeVarSet, ExistQVars0, ArgTypes0),
+ pred_info_get_arg_types(!.PredInfo, _ArgTypeVarSet, ExistQVars0,
+ ArgTypes0),
some [!ClausesInfo, !Info, !HeadTypeParams] (
pred_info_clauses_info(!.PredInfo, !:ClausesInfo),
clauses_info_get_clauses_rep(!.ClausesInfo, ClausesRep0),
@@ -399,23 +389,17 @@
clauses_info_get_varset(!.ClausesInfo, VarSet0),
clauses_info_get_explicit_vartypes(!.ClausesInfo, ExplicitVarTypes0),
pred_info_get_markers(!.PredInfo, Markers0),
- % Handle the --allow-stubs and --warn-stubs options.
- % If --allow-stubs is set, and there are no clauses,
- % issue a warning if --warn-stubs is set, and then
- % generate a "stub" clause that just throws an exception.
+ % Handle the --allow-stubs and --warn-stubs options. If --allow-stubs
+ % is set, and there are no clauses, issue a warning (if --warn-stubs
+ % is set), and then generate a "stub" clause that just throws an
+ % exception.
(
clause_list_is_empty(ClausesRep0) = yes,
globals.lookup_bool_option(Globals, allow_stubs, yes),
\+ check_marker(Markers0, marker_class_method)
->
- globals.lookup_bool_option(Globals, warn_stubs, WarnStubs),
- (
- WarnStubs = yes,
- report_no_clauses("Warning", PredId, !.PredInfo, !.ModuleInfo,
- !IO)
- ;
- WarnStubs = no
- ),
+ StartingSpecs = [report_no_clauses_stub(!.ModuleInfo, PredId,
+ !.PredInfo)],
PredPieces = describe_one_pred_name(!.ModuleInfo,
should_module_qualify, PredId),
PredName = error_pieces_to_string(PredPieces),
@@ -425,12 +409,16 @@
clauses_info_set_clauses([StubClause], !ClausesInfo),
clauses_info_set_varset(VarSet, !ClausesInfo)
;
+ StartingSpecs = [],
VarSet = VarSet0,
ClausesRep1 = ClausesRep0
),
clause_list_is_empty(ClausesRep1) = ClausesRep1IsEmpty,
(
ClausesRep1IsEmpty = yes,
+ expect(unify(StartingSpecs, []), this_file,
+ "typecheck_pred: StartingSpecs not empty"),
+
% There are no clauses for class methods. The clauses are generated
% later on, in polymorphism.expand_class_method_bodies.
( check_marker(Markers0, marker_class_method) ->
@@ -445,12 +433,10 @@
prog_type.vars_list(ArgTypes0, HeadVarsIncludingExistentials),
pred_info_set_head_type_params(HeadVarsIncludingExistentials,
!PredInfo),
- Error = no,
+ Specs = [],
Changed = no
;
- report_no_clauses("Error", PredId, !.PredInfo, !.ModuleInfo,
- !IO),
- Error = yes,
+ Specs = [report_no_clauses(!.ModuleInfo, PredId, !.PredInfo)],
Changed = no
)
;
@@ -464,14 +450,18 @@
% initial type declaration of `pred foo(T1, T2, ..., TN)'
% by make_hlds.m.
Inferring = yes,
+ trace [io(!IO)] (
write_pred_progress_message("% Inferring type of ",
- PredId, !.ModuleInfo, !IO),
+ PredId, !.ModuleInfo, !IO)
+ ),
!:HeadTypeParams = [],
PredConstraints = constraints([], [])
;
Inferring = no,
+ trace [io(!IO)] (
write_pred_progress_message("% Type-checking ", PredId,
- !.ModuleInfo, !IO),
+ !.ModuleInfo, !IO)
+ ),
prog_type.vars_list(ArgTypes0, !:HeadTypeParams),
pred_info_get_class_context(!.PredInfo, PredConstraints),
constraint_list_get_tvars(PredConstraints ^ univ_constraints,
@@ -493,15 +483,15 @@
pred_info_get_markers(!.PredInfo, Markers),
typecheck_info_init(!.ModuleInfo, PredId, IsFieldAccessFunction,
TypeVarSet0, VarSet, ExplicitVarTypes0, !.HeadTypeParams,
- Constraints, Status, Markers, !:Info),
+ Constraints, Status, Markers, StartingSpecs, !:Info),
typecheck_info_get_type_assign_set(!.Info, OrigTypeAssignSet),
get_clause_list(ClausesRep1, Clauses1),
typecheck_clause_list(HeadVars, ArgTypes0, Clauses1, Clauses,
- !Info, !IO),
- % we need to perform a final pass of context reduction
- % at the end, before checking the typeclass constraints
- perform_context_reduction(OrigTypeAssignSet, !Info, !IO),
- typecheck_check_for_ambiguity(whole_pred, HeadVars, !Info, !IO),
+ !Info),
+ % We need to perform a final pass of context reduction at the end,
+ % before checking the typeclass constraints.
+ perform_context_reduction(OrigTypeAssignSet, !Info),
+ typecheck_check_for_ambiguity(whole_pred, HeadVars, !Info),
typecheck_info_get_final_info(!.Info, !.HeadTypeParams,
ExistQVars0, ExplicitVarTypes0, TypeVarSet,
!:HeadTypeParams, InferredVarTypes0,
@@ -598,8 +588,8 @@
;
ExistQVars0 = [_ | _],
list.foldl(
- check_existq_clause(!.Info, TypeVarSet, ExistQVars0),
- Clauses, !IO),
+ check_existq_clause(TypeVarSet, ExistQVars0),
+ Clauses, !Info),
apply_var_renaming_to_var_list(ExistQVars0,
ExistTypeRenaming, ExistQVars1),
@@ -629,32 +619,33 @@
Changed = no
),
- typecheck_info_get_found_error(!.Info, Error)
+ typecheck_info_get_errors(!.Info, Specs)
)
).
-:- pred check_existq_clause(typecheck_info::in, tvarset::in, existq_tvars::in,
- clause::in, io::di, io::uo) is det.
+:- pred check_existq_clause(tvarset::in, existq_tvars::in, clause::in,
+ typecheck_info::in, typecheck_info::out) is det.
-check_existq_clause(Info, TypeVarSet, ExistQVars, Clause, !IO) :-
+check_existq_clause(TypeVarSet, ExistQVars, Clause, !Info) :-
Goal = Clause ^ clause_body,
( Goal = call_foreign_proc(_, _, _, _, _, _, Impl) - _ ->
- list.foldl(check_mention_existq_var(Info, TypeVarSet, Impl),
- ExistQVars, !IO)
+ list.foldl(check_mention_existq_var(TypeVarSet, Impl),
+ ExistQVars, !Info)
;
true
).
-:- pred check_mention_existq_var(typecheck_info::in, tvarset::in,
- pragma_foreign_code_impl::in, tvar::in, io::di, io::uo) is det.
+:- pred check_mention_existq_var(tvarset::in, pragma_foreign_code_impl::in,
+ tvar::in, typecheck_info::in, typecheck_info::out) is det.
-check_mention_existq_var(Info, TypeVarSet, Impl, TVar, !IO) :-
+check_mention_existq_var(TypeVarSet, Impl, TVar, !Info) :-
varset.lookup_name(TypeVarSet, TVar, Name),
VarName = "TypeInfo_for_" ++ Name,
( foreign_code_uses_variable(Impl, VarName) ->
true
;
- report_missing_tvar_in_foreign_code(Info, VarName, !IO)
+ Spec = report_missing_tvar_in_foreign_code(!.Info, VarName),
+ typecheck_info_add_error(Spec, !Info)
).
% Mark the predicate as a stub, and generate a clause of the form
@@ -1138,13 +1129,13 @@
%
:- pred typecheck_clause_list(list(prog_var)::in, list(mer_type)::in,
list(clause)::in, list(clause)::out,
- typecheck_info::in, typecheck_info::out, io::di, io::uo) is det.
+ typecheck_info::in, typecheck_info::out) is det.
-typecheck_clause_list(_, _, [], [], !Info, !IO).
+typecheck_clause_list(_, _, [], [], !Info).
typecheck_clause_list(HeadVars, ArgTypes, [Clause0 | Clauses0],
- [Clause | Clauses], !Info, !IO) :-
- typecheck_clause(HeadVars, ArgTypes, Clause0, Clause, !Info, !IO),
- typecheck_clause_list(HeadVars, ArgTypes, Clauses0, Clauses, !Info, !IO).
+ [Clause | Clauses], !Info) :-
+ typecheck_clause(HeadVars, ArgTypes, Clause0, Clause, !Info),
+ typecheck_clause_list(HeadVars, ArgTypes, Clauses0, Clauses, !Info).
%-----------------------------------------------------------------------------%
@@ -1165,21 +1156,22 @@
% We should perhaps do manual garbage collection here.
%
:- pred typecheck_clause(list(prog_var)::in, list(mer_type)::in,
- clause::in, clause::out,
- typecheck_info::in, typecheck_info::out, io::di, io::uo) is det.
+ clause::in, clause::out, typecheck_info::in, typecheck_info::out) is det.
-typecheck_clause(HeadVars, ArgTypes, !Clause, !Info, !IO) :-
+typecheck_clause(HeadVars, ArgTypes, !Clause, !Info) :-
Body0 = !.Clause ^ clause_body,
Context = !.Clause ^clause_context,
typecheck_info_set_context(Context, !Info),
% Typecheck the clause - first the head unification, and then the body.
- typecheck_var_has_type_list(HeadVars, ArgTypes, 1, !Info, !IO),
- typecheck_goal(Body0, Body, !Info, !IO),
- type_checkpoint("end of clause", !.Info, !IO),
+ typecheck_var_has_type_list(HeadVars, ArgTypes, 1, !Info),
+ typecheck_goal(Body0, Body, !Info),
+ trace [io(!IO)] (
+ type_checkpoint("end of clause", !.Info, !IO)
+ ),
!:Clause = !.Clause ^ clause_body := Body,
typecheck_info_set_context(Context, !Info),
- typecheck_check_for_ambiguity(clause_only, HeadVars, !Info, !IO).
+ typecheck_check_for_ambiguity(clause_only, HeadVars, !Info).
%-----------------------------------------------------------------------------%
@@ -1201,9 +1193,9 @@
; whole_pred.
:- pred typecheck_check_for_ambiguity(stuff_to_check::in, list(prog_var)::in,
- typecheck_info::in, typecheck_info::out, io::di, io::uo) is det.
+ typecheck_info::in, typecheck_info::out) is det.
-typecheck_check_for_ambiguity(StuffToCheck, HeadVars, !Info, !IO) :-
+typecheck_check_for_ambiguity(StuffToCheck, HeadVars, !Info) :-
typecheck_info_get_type_assign_set(!.Info, TypeAssignSet),
(
% There should always be a type assignment, because if there is
@@ -1226,9 +1218,9 @@
% head variables (and hence can't be resolved by looking at
% later clauses).
- typecheck_info_get_found_error(!.Info, FoundError),
+ typecheck_info_get_errors(!.Info, ErrorsSoFar),
(
- FoundError = no,
+ ErrorsSoFar = [],
(
StuffToCheck = whole_pred
;
@@ -1250,8 +1242,8 @@
identical_up_to_renaming(FinalHeadTypes1, FinalHeadTypes2)
)
->
- typecheck_info_set_found_error(yes, !Info),
- report_ambiguity_error(!.Info, TypeAssign1, TypeAssign2, !IO)
+ Spec = report_ambiguity_error(!.Info, TypeAssign1, TypeAssign2),
+ typecheck_info_add_error(Spec, !Info)
;
true
)
@@ -1260,7 +1252,7 @@
%-----------------------------------------------------------------------------%
:- pred typecheck_goal(hlds_goal::in, hlds_goal::out,
- typecheck_info::in, typecheck_info::out, io::di, io::uo) is det.
+ typecheck_info::in, typecheck_info::out) is det.
% Typecheck a goal.
% Note that we save the context of the goal in the typeinfo for
@@ -1269,7 +1261,7 @@
% context saved in the type-info. (That should probably be done
% in make_hlds, but it was easier to do here.)
%
-typecheck_goal(Goal0 - GoalInfo0, Goal - GoalInfo, !Info, !IO) :-
+typecheck_goal(Goal0 - GoalInfo0, Goal - GoalInfo, !Info) :-
goal_info_get_context(GoalInfo0, Context),
term.context_init(EmptyContext),
( Context = EmptyContext ->
@@ -1279,51 +1271,64 @@
GoalInfo = GoalInfo0,
typecheck_info_set_context(Context, !Info)
),
- typecheck_goal_2(Goal0, Goal, GoalInfo, !Info, !IO),
- check_warn_too_much_overloading(!Info, !IO).
+ typecheck_goal_2(Goal0, Goal, GoalInfo, !Info),
+ check_warn_too_much_overloading(!Info).
:- pred typecheck_goal_2(hlds_goal_expr::in, hlds_goal_expr::out,
- hlds_goal_info::in, typecheck_info::in, typecheck_info::out,
- io::di, io::uo) is det.
+ hlds_goal_info::in, typecheck_info::in, typecheck_info::out) is det.
-typecheck_goal_2(GoalExpr0, GoalExpr, GoalInfo, !Info, !IO) :-
+typecheck_goal_2(GoalExpr0, GoalExpr, GoalInfo, !Info) :-
(
GoalExpr0 = conj(ConjType, List0),
- type_checkpoint("conj", !.Info, !IO),
- typecheck_goal_list(List0, List, !Info, !IO),
+ trace [io(!IO)] (
+ type_checkpoint("conj", !.Info, !IO)
+ ),
+ typecheck_goal_list(List0, List, !Info),
GoalExpr = conj(ConjType, List)
;
GoalExpr0 = disj(List0),
- type_checkpoint("disj", !.Info, !IO),
- typecheck_goal_list(List0, List, !Info, !IO),
+ trace [io(!IO)] (
+ type_checkpoint("disj", !.Info, !IO)
+ ),
+ typecheck_goal_list(List0, List, !Info),
GoalExpr = disj(List)
;
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
- type_checkpoint("if", !.Info, !IO),
- typecheck_goal(Cond0, Cond, !Info, !IO),
- type_checkpoint("then", !.Info, !IO),
- typecheck_goal(Then0, Then, !Info, !IO),
- type_checkpoint("else", !.Info, !IO),
- typecheck_goal(Else0, Else, !Info, !IO),
- ensure_vars_have_a_type(Vars, !Info, !IO),
+ trace [io(!IO)] (
+ type_checkpoint("if", !.Info, !IO)
+ ),
+ typecheck_goal(Cond0, Cond, !Info),
+ trace [io(!IO)] (
+ type_checkpoint("then", !.Info, !IO)
+ ),
+ typecheck_goal(Then0, Then, !Info),
+ trace [io(!IO)] (
+ type_checkpoint("else", !.Info, !IO)
+ ),
+ typecheck_goal(Else0, Else, !Info),
+ ensure_vars_have_a_type(Vars, !Info),
GoalExpr = if_then_else(Vars, Cond, Then, Else)
;
GoalExpr0 = negation(SubGoal0),
- type_checkpoint("not", !.Info, !IO),
- typecheck_goal(SubGoal0, SubGoal, !Info, !IO),
+ trace [io(!IO)] (
+ type_checkpoint("not", !.Info, !IO)
+ ),
+ typecheck_goal(SubGoal0, SubGoal, !Info),
GoalExpr = negation(SubGoal)
;
GoalExpr0 = scope(Reason, SubGoal0),
- type_checkpoint("scope", !.Info, !IO),
- typecheck_goal(SubGoal0, SubGoal, !Info, !IO),
+ trace [io(!IO)] (
+ type_checkpoint("scope", !.Info, !IO)
+ ),
+ typecheck_goal(SubGoal0, SubGoal, !Info),
(
Reason = exist_quant(Vars),
- ensure_vars_have_a_type(Vars, !Info, !IO)
+ ensure_vars_have_a_type(Vars, !Info)
;
Reason = promise_purity(_, _)
;
Reason = promise_solutions(Vars, _),
- ensure_vars_have_a_type(Vars, !Info, !IO)
+ ensure_vars_have_a_type(Vars, !Info)
;
Reason = commit(_)
;
@@ -1336,12 +1341,14 @@
GoalExpr = scope(Reason, SubGoal)
;
GoalExpr0 = plain_call(_, ProcId, Args, BI, UC, Name),
- type_checkpoint("call", !.Info, !IO),
+ trace [io(!IO)] (
+ type_checkpoint("call", !.Info, !IO)
+ ),
list.length(Args, Arity),
CurCall = simple_call_id(predicate, Name, Arity),
typecheck_info_set_called_predid(plain_call_id(CurCall), !Info),
goal_info_get_goal_path(GoalInfo, GoalPath),
- typecheck_call_pred(CurCall, Args, GoalPath, PredId, !Info, !IO),
+ typecheck_call_pred(CurCall, Args, GoalPath, PredId, !Info),
GoalExpr = plain_call(PredId, ProcId, Args, BI, UC, Name)
;
GoalExpr0 = generic_call(GenericCall0, Args, Modes, Detism),
@@ -1350,8 +1357,10 @@
(
GenericCall0 = higher_order(PredVar, Purity, _, _),
GenericCall = GenericCall0,
- type_checkpoint("higher-order call", !.Info, !IO),
- typecheck_higher_order_call(PredVar, Purity, Args, !Info, !IO)
+ trace [io(!IO)] (
+ type_checkpoint("higher-order call", !.Info, !IO)
+ ),
+ typecheck_higher_order_call(PredVar, Purity, Args, !Info)
;
GenericCall0 = class_method(_, _, _, _),
unexpected(this_file,
@@ -1359,8 +1368,10 @@
;
GenericCall0 = event_call(EventName),
GenericCall = GenericCall0,
- type_checkpoint("event call", !.Info, !IO),
- typecheck_event_call(EventName, Args, !Info, !IO)
+ trace [io(!IO)] (
+ type_checkpoint("event call", !.Info, !IO)
+ ),
+ typecheck_event_call(EventName, Args, !Info)
;
GenericCall0 = cast(_),
% A cast imposes no restrictions on its argument types,
@@ -1370,11 +1381,13 @@
GoalExpr = generic_call(GenericCall, Args, Modes, Detism)
;
GoalExpr0 = unify(LHS, RHS0, UnifyMode, Unification, UnifyContext),
- type_checkpoint("unify", !.Info, !IO),
+ trace [io(!IO)] (
+ type_checkpoint("unify", !.Info, !IO)
+ ),
typecheck_info_set_arg_num(0, !Info),
typecheck_info_set_unify_context(UnifyContext, !Info),
goal_info_get_goal_path(GoalInfo, GoalPath),
- typecheck_unification(LHS, RHS0, RHS, GoalPath, !Info, !IO),
+ typecheck_unification(LHS, RHS0, RHS, GoalPath, !Info),
GoalExpr = unify(LHS, RHS, UnifyMode, Unification, UnifyContext)
;
GoalExpr0 = switch(_, _, _),
@@ -1389,43 +1402,45 @@
typecheck_info_get_type_assign_set(!.Info, OrigTypeAssignSet),
ArgVars = list.map(foreign_arg_var, Args),
goal_info_get_goal_path(GoalInfo, GoalPath),
- typecheck_call_pred_id(PredId, ArgVars, GoalPath, !Info, !IO),
- perform_context_reduction(OrigTypeAssignSet, !Info, !IO),
+ typecheck_call_pred_id(PredId, ArgVars, GoalPath, !Info),
+ perform_context_reduction(OrigTypeAssignSet, !Info),
GoalExpr = GoalExpr0
;
GoalExpr0 = shorthand(ShorthandGoal0),
- typecheck_goal_2_shorthand(ShorthandGoal0, ShorthandGoal, !Info, !IO),
+ typecheck_goal_2_shorthand(ShorthandGoal0, ShorthandGoal, !Info),
GoalExpr = shorthand(ShorthandGoal)
).
:- pred typecheck_goal_2_shorthand(shorthand_goal_expr::in,
shorthand_goal_expr::out,
- typecheck_info::in, typecheck_info::out, io::di, io::uo) is det.
+ typecheck_info::in, typecheck_info::out) is det.
typecheck_goal_2_shorthand(bi_implication(LHS0, RHS0),
- bi_implication(LHS, RHS), !Info, !IO) :-
- type_checkpoint("<=>", !.Info, !IO),
- typecheck_goal(LHS0, LHS, !Info, !IO),
- typecheck_goal(RHS0, RHS, !Info, !IO).
+ bi_implication(LHS, RHS), !Info) :-
+ trace [io(!IO)] (
+ type_checkpoint("<=>", !.Info, !IO)
+ ),
+ typecheck_goal(LHS0, LHS, !Info),
+ typecheck_goal(RHS0, RHS, !Info).
%-----------------------------------------------------------------------------%
:- pred typecheck_goal_list(list(hlds_goal)::in, list(hlds_goal)::out,
- typecheck_info::in, typecheck_info::out, io::di, io::uo) is det.
+ typecheck_info::in, typecheck_info::out) is det.
-typecheck_goal_list([], [], !Info, !IO).
-typecheck_goal_list([Goal0 | Goals0], [Goal | Goals], !Info, !IO) :-
- typecheck_goal(Goal0, Goal, !Info, !IO),
- typecheck_goal_list(Goals0, Goals, !Info, !IO).
+typecheck_goal_list([], [], !Info).
+typecheck_goal_list([Goal0 | Goals0], [Goal | Goals], !Info) :-
+ typecheck_goal(Goal0, Goal, !Info),
+ typecheck_goal_list(Goals0, Goals, !Info).
%-----------------------------------------------------------------------------%
% Ensure that each variable in Vars has been assigned a type.
%
:- pred ensure_vars_have_a_type(list(prog_var)::in,
- typecheck_info::in, typecheck_info::out, io::di, io::uo) is det.
+ typecheck_info::in, typecheck_info::out) is det.
-ensure_vars_have_a_type(Vars, !Info, !IO) :-
+ensure_vars_have_a_type(Vars, !Info) :-
(
Vars = []
;
@@ -1439,16 +1454,15 @@
prog_type.var_list_to_type_list(map.init, TypeVars, Types),
empty_hlds_constraints(EmptyConstraints),
typecheck_var_has_polymorphic_type_list(Vars, TypeVarSet, [],
- Types, EmptyConstraints, !Info, !IO)
+ Types, EmptyConstraints, !Info)
).
%-----------------------------------------------------------------------------%
:- pred typecheck_higher_order_call(prog_var::in, purity::in,
- list(prog_var)::in, typecheck_info::in, typecheck_info::out,
- io::di, io::uo) is det.
+ list(prog_var)::in, typecheck_info::in, typecheck_info::out) is det.
-typecheck_higher_order_call(PredVar, Purity, Args, !Info, !IO) :-
+typecheck_higher_order_call(PredVar, Purity, Args, !Info) :-
list.length(Args, Arity),
higher_order_pred_type(Purity, Arity, lambda_normal,
TypeVarSet, PredVarType, ArgTypes),
@@ -1457,7 +1471,7 @@
empty_hlds_constraints(EmptyConstraints),
ExistQVars = [],
typecheck_var_has_polymorphic_type_list([PredVar | Args], TypeVarSet,
- ExistQVars, [PredVarType | ArgTypes], EmptyConstraints, !Info, !IO).
+ ExistQVars, [PredVarType | ArgTypes], EmptyConstraints, !Info).
:- pred higher_order_pred_type(purity::in, int::in, lambda_eval_method::in,
tvarset::out, mer_type::out, list(mer_type)::out) is det.
@@ -1503,22 +1517,23 @@
%-----------------------------------------------------------------------------%
:- pred typecheck_event_call(string::in, list(prog_var)::in,
- typecheck_info::in, typecheck_info::out, io::di, io::uo) is det.
+ typecheck_info::in, typecheck_info::out) is det.
-typecheck_event_call(EventName, Args, !Info, !IO) :-
+typecheck_event_call(EventName, Args, !Info) :-
( event_arg_types(EventName, EventArgTypes) ->
- typecheck_var_has_type_list(Args, EventArgTypes, 1, !Info, !IO)
+ typecheck_var_has_type_list(Args, EventArgTypes, 1, !Info)
;
- report_unknown_event_call_error(EventName, !Info, !IO)
+ Spec = report_unknown_event_call_error(!.Info, EventName),
+ typecheck_info_add_error(Spec, !Info)
).
%-----------------------------------------------------------------------------%
:- pred typecheck_call_pred(simple_call_id::in, list(prog_var)::in,
- goal_path::in, pred_id::out, typecheck_info::in, typecheck_info::out,
- io::di, io::uo) is det.
+ goal_path::in, pred_id::out, typecheck_info::in, typecheck_info::out)
+ is det.
-typecheck_call_pred(CallId, Args, GoalPath, PredId, !Info, !IO) :-
+typecheck_call_pred(CallId, Args, GoalPath, PredId, !Info) :-
typecheck_info_get_type_assign_set(!.Info, OrigTypeAssignSet),
% Look up the called predicate's arg types.
@@ -1535,10 +1550,10 @@
% non-polymorphic predicate).
( PredIdList = [PredId0] ->
PredId = PredId0,
- typecheck_call_pred_id(PredId, Args, GoalPath, !Info, !IO)
+ typecheck_call_pred_id(PredId, Args, GoalPath, !Info)
;
typecheck_call_overloaded_pred(CallId, PredIdList, Args,
- GoalPath, !Info, !IO),
+ GoalPath, !Info),
% In general, we can't figure out which predicate it is until
% after we have resolved any overloading, which may require
@@ -1553,18 +1568,19 @@
% See the paper: "Type classes: an exploration of the design space",
% S. Peyton-Jones, M. Jones 1997, for a discussion of some of the
% issues.
- perform_context_reduction(OrigTypeAssignSet, !Info, !IO)
+ perform_context_reduction(OrigTypeAssignSet, !Info)
;
PredId = invalid_pred_id,
- report_pred_call_error(CallId, !Info, !IO)
+ Spec = report_pred_call_error(!.Info, CallId),
+ typecheck_info_add_error(Spec, !Info)
).
% Typecheck a call to a specific predicate.
%
:- pred typecheck_call_pred_id(pred_id::in, list(prog_var)::in, goal_path::in,
- typecheck_info::in, typecheck_info::out, io::di, io::uo) is det.
+ typecheck_info::in, typecheck_info::out) is det.
-typecheck_call_pred_id(PredId, Args, GoalPath, !Info, !IO) :-
+typecheck_call_pred_id(PredId, Args, GoalPath, !Info) :-
typecheck_info_get_module_info(!.Info, ModuleInfo),
module_info_get_predicate_table(ModuleInfo, PredicateTable),
predicate_table_get_preds(PredicateTable, Preds),
@@ -1581,21 +1597,20 @@
varset.is_empty(PredTypeVarSet),
PredClassContext = constraints([], [])
->
- typecheck_var_has_type_list(Args, PredArgTypes, 1, !Info, !IO)
+ typecheck_var_has_type_list(Args, PredArgTypes, 1, !Info)
;
module_info_get_class_table(ModuleInfo, ClassTable),
make_body_hlds_constraints(ClassTable, PredTypeVarSet,
GoalPath, PredClassContext, PredConstraints),
typecheck_var_has_polymorphic_type_list(Args, PredTypeVarSet,
- PredExistQVars, PredArgTypes, PredConstraints, !Info, !IO)
+ PredExistQVars, PredArgTypes, PredConstraints, !Info)
).
:- pred typecheck_call_overloaded_pred(simple_call_id::in, list(pred_id)::in,
- list(prog_var)::in, goal_path::in, typecheck_info::in, typecheck_info::out,
- io::di, io::uo) is det.
+ list(prog_var)::in, goal_path::in, typecheck_info::in, typecheck_info::out)
+ is det.
-typecheck_call_overloaded_pred(CallId, PredIdList, Args, GoalPath,
- !Info, !IO) :-
+typecheck_call_overloaded_pred(CallId, PredIdList, Args, GoalPath, !Info) :-
typecheck_info_get_context(!.Info, Context),
Symbol = overloaded_pred(CallId, PredIdList),
typecheck_info_add_overloaded_symbol(Symbol, Context, !Info),
@@ -1613,7 +1628,7 @@
% Then unify the types of the call arguments with the
% called predicates' arg types.
- typecheck_var_has_arg_type_list(Args, 1, ArgsTypeAssignSet, !Info, !IO).
+ typecheck_var_has_arg_type_list(Args, 1, ArgsTypeAssignSet, !Info).
:- pred get_overloaded_pred_arg_types(list(pred_id)::in, pred_table::in,
class_table::in, goal_path::in, type_assign_set::in,
@@ -1647,14 +1662,14 @@
%
:- pred typecheck_var_has_polymorphic_type_list(list(prog_var)::in,
tvarset::in, existq_tvars::in, list(mer_type)::in, hlds_constraints::in,
- typecheck_info::in, typecheck_info::out, io::di, io::uo) is det.
+ typecheck_info::in, typecheck_info::out) is det.
typecheck_var_has_polymorphic_type_list(Args, PredTypeVarSet, PredExistQVars,
- PredArgTypes, PredConstraints, !Info, !IO) :-
+ PredArgTypes, PredConstraints, !Info) :-
typecheck_info_get_type_assign_set(!.Info, TypeAssignSet0),
rename_apart(TypeAssignSet0, PredTypeVarSet, PredExistQVars,
PredArgTypes, PredConstraints, [], ArgsTypeAssignSet),
- typecheck_var_has_arg_type_list(Args, 1, ArgsTypeAssignSet, !Info, !IO).
+ typecheck_var_has_arg_type_list(Args, 1, ArgsTypeAssignSet, !Info).
:- pred rename_apart(type_assign_set::in, tvarset::in, existq_tvars::in,
list(mer_type)::in, hlds_constraints::in,
@@ -1703,27 +1718,26 @@
%
:- pred typecheck_var_has_arg_type_list(list(prog_var)::in, int::in,
args_type_assign_set::in,
- typecheck_info::in, typecheck_info::out, io::di, io::uo) is det.
+ typecheck_info::in, typecheck_info::out) is det.
-typecheck_var_has_arg_type_list([], _, ArgTypeAssignSet, !Info, !IO) :-
+typecheck_var_has_arg_type_list([], _, ArgTypeAssignSet, !Info) :-
TypeAssignSet =
convert_args_type_assign_set_check_empty_args(ArgTypeAssignSet),
typecheck_info_set_type_assign_set(TypeAssignSet, !Info).
-typecheck_var_has_arg_type_list([Var | Vars], ArgNum, ArgTypeAssignSet0, !Info,
- !IO) :-
+typecheck_var_has_arg_type_list([Var | Vars], ArgNum, ArgTypeAssignSet0,
+ !Info) :-
typecheck_info_set_arg_num(ArgNum, !Info),
typecheck_var_has_arg_type(Var, ArgTypeAssignSet0, ArgTypeAssignSet1,
- !Info, !IO),
+ !Info),
typecheck_var_has_arg_type_list(Vars, ArgNum + 1, ArgTypeAssignSet1,
- !Info, !IO).
+ !Info).
:- pred typecheck_var_has_arg_type(prog_var::in,
args_type_assign_set::in, args_type_assign_set::out,
- typecheck_info::in, typecheck_info::out, io::di, io::uo) is det.
+ typecheck_info::in, typecheck_info::out) is det.
-typecheck_var_has_arg_type(Var, ArgTypeAssignSet0, ArgTypeAssignSet, !Info,
- !IO) :-
+typecheck_var_has_arg_type(Var, ArgTypeAssignSet0, ArgTypeAssignSet, !Info) :-
typecheck_var_has_arg_type_2(ArgTypeAssignSet0,
Var, [], ArgTypeAssignSet1),
(
@@ -1731,8 +1745,8 @@
ArgTypeAssignSet0 = [_ | _]
->
skip_arg(ArgTypeAssignSet0, ArgTypeAssignSet),
- report_error_arg_var(!.Info, Var, ArgTypeAssignSet0, !IO),
- typecheck_info_set_found_error(yes, !Info)
+ Spec = report_error_arg_var(!.Info, Var, ArgTypeAssignSet0),
+ typecheck_info_add_error(Spec, !Info)
;
ArgTypeAssignSet = ArgTypeAssignSet1
).
@@ -1799,23 +1813,22 @@
% that each variable has the corresponding type.
%
:- pred typecheck_var_has_type_list(list(prog_var)::in, list(mer_type)::in,
- int::in, typecheck_info::in, typecheck_info::out, io::di, io::uo) is det.
+ int::in, typecheck_info::in, typecheck_info::out) is det.
-typecheck_var_has_type_list([], [_ | _], _, !Info, !IO) :-
+typecheck_var_has_type_list([], [_ | _], _, !Info) :-
unexpected(this_file, "typecheck_var_has_type_list: length mismatch").
-typecheck_var_has_type_list([_ | _], [], _, !Info, !IO) :-
+typecheck_var_has_type_list([_ | _], [], _, !Info) :-
unexpected(this_file, "typecheck_var_has_type_list: length mismatch").
-typecheck_var_has_type_list([], [], _, !Info, !IO).
-typecheck_var_has_type_list([Var | Vars], [Type | Types], ArgNum, !Info,
- !IO) :-
+typecheck_var_has_type_list([], [], _, !Info).
+typecheck_var_has_type_list([Var | Vars], [Type | Types], ArgNum, !Info) :-
typecheck_info_set_arg_num(ArgNum, !Info),
- typecheck_var_has_type(Var, Type, !Info, !IO),
- typecheck_var_has_type_list(Vars, Types, ArgNum + 1, !Info, !IO).
+ typecheck_var_has_type(Var, Type, !Info),
+ typecheck_var_has_type_list(Vars, Types, ArgNum + 1, !Info).
:- pred typecheck_var_has_type(prog_var::in, mer_type::in,
- typecheck_info::in, typecheck_info::out, io::di, io::uo) is det.
+ typecheck_info::in, typecheck_info::out) is det.
-typecheck_var_has_type(Var, Type, !Info, !IO) :-
+typecheck_var_has_type(Var, Type, !Info) :-
typecheck_info_get_type_assign_set(!.Info, TypeAssignSet0),
typecheck_var_has_type_2(TypeAssignSet0, Var, Type, [],
TypeAssignSet),
@@ -1823,8 +1836,8 @@
TypeAssignSet = [],
TypeAssignSet0 = [_ | _]
->
- report_error_var(!.Info, Var, Type, TypeAssignSet0, !IO),
- typecheck_info_set_found_error(yes, !Info)
+ Spec = report_error_var(!.Info, Var, Type, TypeAssignSet0),
+ typecheck_info_add_error(Spec, !Info)
;
typecheck_info_set_type_assign_set(TypeAssignSet, !Info)
).
@@ -1906,9 +1919,9 @@
% more than 50 possible type assignments.
%
:- pred check_warn_too_much_overloading(typecheck_info::in,
- typecheck_info::out, io::di, io::uo) is det.
+ typecheck_info::out) is det.
-check_warn_too_much_overloading(!Info, !IO) :-
+check_warn_too_much_overloading(!Info) :-
(
typecheck_info_get_warned_about_overloading(!.Info, AlreadyWarned),
AlreadyWarned = no,
@@ -1916,7 +1929,8 @@
list.length(TypeAssignSet, Count),
Count > 50
->
- report_warning_too_much_overloading(!.Info, !IO),
+ Spec = report_warning_too_much_overloading(!.Info),
+ typecheck_info_add_error(Spec, !Info),
typecheck_info_set_warned_about_overloading(yes, !Info)
;
true
@@ -1929,46 +1943,45 @@
% iterate over all the possible type assignments.
%
:- pred typecheck_unification(prog_var::in, unify_rhs::in, unify_rhs::out,
- goal_path::in, typecheck_info::in, typecheck_info::out,
- io::di, io::uo) is det.
+ goal_path::in, typecheck_info::in, typecheck_info::out) is det.
-typecheck_unification(X, rhs_var(Y), rhs_var(Y), _, !Info, !IO) :-
- typecheck_unify_var_var(X, Y, !Info, !IO).
+typecheck_unification(X, rhs_var(Y), rhs_var(Y), _, !Info) :-
+ typecheck_unify_var_var(X, Y, !Info).
typecheck_unification(X, rhs_functor(Functor, ExistConstraints, Args),
- rhs_functor(Functor, ExistConstraints, Args), GoalPath, !Info, !IO) :-
+ rhs_functor(Functor, ExistConstraints, Args), GoalPath, !Info) :-
typecheck_info_get_type_assign_set(!.Info, OrigTypeAssignSet),
- typecheck_unify_var_functor(X, Functor, Args, GoalPath, !Info, !IO),
- perform_context_reduction(OrigTypeAssignSet, !Info, !IO).
+ typecheck_unify_var_functor(X, Functor, Args, GoalPath, !Info),
+ perform_context_reduction(OrigTypeAssignSet, !Info).
typecheck_unification(X,
rhs_lambda_goal(Purity, PredOrFunc, EvalMethod,
NonLocals, Vars, Modes, Det, Goal0),
rhs_lambda_goal(Purity, PredOrFunc, EvalMethod,
- NonLocals, Vars, Modes, Det, Goal), _, !Info, !IO) :-
+ NonLocals, Vars, Modes, Det, Goal), _, !Info) :-
typecheck_lambda_var_has_type(Purity, PredOrFunc, EvalMethod, X, Vars,
- !Info, !IO),
- typecheck_goal(Goal0, Goal, !Info, !IO).
+ !Info),
+ typecheck_goal(Goal0, Goal, !Info).
:- pred typecheck_unify_var_var(prog_var::in, prog_var::in,
- typecheck_info::in, typecheck_info::out, io::di, io::uo) is det.
+ typecheck_info::in, typecheck_info::out) is det.
-typecheck_unify_var_var(X, Y, !Info, !IO) :-
+typecheck_unify_var_var(X, Y, !Info) :-
typecheck_info_get_type_assign_set(!.Info, TypeAssignSet0),
typecheck_unify_var_var_2(TypeAssignSet0, X, Y, [], TypeAssignSet),
(
TypeAssignSet = [],
TypeAssignSet0 = [_ | _]
->
- report_error_unif_var_var(!.Info, X, Y, TypeAssignSet0, !IO),
- typecheck_info_set_found_error(yes, !Info)
+ Spec = report_error_unif_var_var(!.Info, X, Y, TypeAssignSet0),
+ typecheck_info_add_error(Spec, !Info)
;
typecheck_info_set_type_assign_set(TypeAssignSet, !Info)
).
:- pred typecheck_unify_var_functor(prog_var::in, cons_id::in,
list(prog_var)::in, goal_path::in,
- typecheck_info::in, typecheck_info::out, io::di, io::uo) is det.
+ typecheck_info::in, typecheck_info::out) is det.
-typecheck_unify_var_functor(Var, Functor, Args, GoalPath, !Info, !IO) :-
+typecheck_unify_var_functor(Var, Functor, Args, GoalPath, !Info) :-
% Get the list of possible constructors that match this functor/arity.
% If there aren't any, report an undefined constructor error.
list.length(Args, Arity),
@@ -1976,9 +1989,9 @@
ConsDefnList, InvalidConsDefnList),
(
ConsDefnList = [],
- report_error_undef_cons(!.Info, InvalidConsDefnList, Functor, Arity,
- !IO),
- typecheck_info_set_found_error(yes, !Info)
+ Spec = report_error_undef_cons(!.Info, InvalidConsDefnList, Functor,
+ Arity),
+ typecheck_info_add_error(Spec, !Info)
;
(
ConsDefnList = [_]
@@ -2013,9 +2026,9 @@
ArgsTypeAssignSet = [],
ConsTypeAssignSet = [_ | _]
->
- report_error_functor_type(!.Info, Var, ConsDefnList,
- Functor, Arity, TypeAssignSet0, !IO),
- typecheck_info_set_found_error(yes, !Info)
+ FunctorSpec = report_error_functor_type(!.Info, Var, ConsDefnList,
+ Functor, Arity, TypeAssignSet0),
+ typecheck_info_add_error(FunctorSpec, !Info)
;
true
),
@@ -2028,9 +2041,9 @@
TypeAssignSet = [],
ArgsTypeAssignSet = [_ | _]
->
- report_error_functor_arg_types(!.Info, Var, ConsDefnList,
- Functor, Args, ArgsTypeAssignSet, !IO),
- typecheck_info_set_found_error(yes, !Info)
+ ArgSpec = report_error_functor_arg_types(!.Info, Var, ConsDefnList,
+ Functor, Args, ArgsTypeAssignSet),
+ typecheck_info_add_error(ArgSpec, !Info)
;
true
),
@@ -2312,10 +2325,10 @@
%
:- pred typecheck_lambda_var_has_type(purity::in, pred_or_func::in,
lambda_eval_method::in, prog_var::in, list(prog_var)::in,
- typecheck_info::in, typecheck_info::out, io::di, io::uo) is det.
+ typecheck_info::in, typecheck_info::out) is det.
typecheck_lambda_var_has_type(Purity, PredOrFunc, EvalMethod, Var, ArgVars,
- !Info, !IO) :-
+ !Info) :-
typecheck_info_get_type_assign_set(!.Info, TypeAssignSet0),
typecheck_lambda_var_has_type_2(TypeAssignSet0, Purity, PredOrFunc,
EvalMethod, Var, ArgVars, [], TypeAssignSet),
@@ -2323,9 +2336,9 @@
TypeAssignSet = [],
TypeAssignSet0 = [_ | _]
->
- report_error_lambda_var(!.Info, PredOrFunc, EvalMethod,
- Var, ArgVars, TypeAssignSet0, !IO),
- typecheck_info_set_found_error(yes, !Info)
+ Spec = report_error_lambda_var(!.Info, PredOrFunc, EvalMethod,
+ Var, ArgVars, TypeAssignSet0),
+ typecheck_info_add_error(Spec, !Info)
;
typecheck_info_set_type_assign_set(TypeAssignSet, !Info)
).
Index: compiler/typecheck_errors.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck_errors.m,v
retrieving revision 1.29
diff -u -b -r1.29 typecheck_errors.m
--- compiler/typecheck_errors.m 7 Sep 2006 05:51:07 -0000 1.29
+++ compiler/typecheck_errors.m 11 Sep 2006 04:59:40 -0000
@@ -9,8 +9,7 @@
% File: typecheck_errors.m.
% Main author: fjh.
%
-% This file contains predicates to report errors and debugging messages for
-% typechecking.
+% This file contains predicates to report errors for typechecking.
%
%-----------------------------------------------------------------------------%
@@ -22,9 +21,9 @@
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module mdbcomp.prim_data.
+:- import_module parse_tree.error_util.
:- import_module parse_tree.prog_data.
-:- import_module io.
:- import_module list.
%-----------------------------------------------------------------------------%
@@ -38,50 +37,47 @@
%-----------------------------------------------------------------------------%
-:- pred report_pred_call_error(simple_call_id::in,
- typecheck_info::in, typecheck_info::out, io::di, io::uo) is det.
+:- func report_pred_call_error(typecheck_info, simple_call_id) = error_spec.
+
+:- func report_unknown_event_call_error(typecheck_info, string) = error_spec.
-:- pred report_unknown_event_call_error(string::in,
- typecheck_info::in, typecheck_info::out, io::di, io::uo) is det.
+:- func report_no_clauses(module_info, pred_id, pred_info) = error_spec.
-:- pred report_no_clauses(string::in, pred_id::in, pred_info::in,
- module_info::in, io::di, io::uo) is det.
+:- func report_no_clauses_stub(module_info, pred_id, pred_info) = error_spec.
-:- pred report_warning_too_much_overloading(typecheck_info::in,
- io::di, io::uo) is det.
+:- func report_warning_too_much_overloading(typecheck_info) = error_spec.
-:- pred report_error_unif_var_var(typecheck_info::in,
- prog_var::in, prog_var::in, type_assign_set::in, io::di, io::uo) is det.
+:- func report_error_unif_var_var(typecheck_info, prog_var, prog_var,
+ type_assign_set) = error_spec.
-:- pred report_error_lambda_var(typecheck_info::in, pred_or_func::in,
- lambda_eval_method::in, prog_var::in, list(prog_var)::in,
- type_assign_set::in, io::di, io::uo) is det.
+:- func report_error_lambda_var(typecheck_info, pred_or_func,
+ lambda_eval_method, prog_var, list(prog_var), type_assign_set)
+ = error_spec.
-:- pred report_error_functor_type(typecheck_info::in,
- prog_var::in, list(cons_type_info)::in, cons_id::in, int::in,
- type_assign_set::in, io::di, io::uo) is det.
+:- func report_error_functor_type(typecheck_info, prog_var,
+ list(cons_type_info), cons_id, int, type_assign_set) = error_spec.
-:- pred report_error_functor_arg_types(typecheck_info::in, prog_var::in,
- list(cons_type_info)::in, cons_id::in, list(prog_var)::in,
- args_type_assign_set::in, io::di, io::uo) is det.
+:- func report_error_functor_arg_types(typecheck_info, prog_var,
+ list(cons_type_info), cons_id, list(prog_var), args_type_assign_set)
+ = error_spec.
-:- pred report_error_var(typecheck_info::in, prog_var::in, mer_type::in,
- type_assign_set::in, io::di, io::uo) is det.
+:- func report_error_var(typecheck_info, prog_var, mer_type, type_assign_set)
+ = error_spec.
-:- pred report_error_arg_var(typecheck_info::in, prog_var::in,
- args_type_assign_set::in, io::di, io::uo) is det.
+:- func report_error_arg_var(typecheck_info, prog_var, args_type_assign_set)
+ = error_spec.
-:- pred report_error_undef_cons(typecheck_info::in, list(cons_error)::in,
- cons_id::in, int::in, io::di, io::uo) is det.
+:- func report_error_undef_cons(typecheck_info, list(cons_error), cons_id, int)
+ = error_spec.
-:- pred report_ambiguity_error(typecheck_info::in,
- type_assign::in, type_assign::in, io::di, io::uo) is det.
+:- func report_ambiguity_error(typecheck_info, type_assign, type_assign)
+ = error_spec.
-:- pred report_unsatisfiable_constraints(type_assign_set::in,
- typecheck_info::in, typecheck_info::out, io::di, io::uo) is det.
+:- func report_unsatisfiable_constraints(typecheck_info, type_assign_set)
+ = error_spec.
-:- pred report_missing_tvar_in_foreign_code(typecheck_info::in, string::in,
- io::di, io::uo) is det.
+:- func report_missing_tvar_in_foreign_code(typecheck_info, string)
+ = error_spec.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -95,7 +91,7 @@
:- import_module hlds.pred_table.
:- import_module libs.compiler_util.
:- import_module libs.globals.
-:- import_module parse_tree.error_util.
+:- import_module libs.options.
:- import_module parse_tree.mercury_to_mercury.
:- import_module parse_tree.modules.
:- import_module parse_tree.prog_io_util.
@@ -118,40 +114,37 @@
%-----------------------------------------------------------------------------%
-report_pred_call_error(PredCallId, !Info, !IO) :-
+report_pred_call_error(Info, PredCallId) = Spec :-
PredCallId = simple_call_id(PredOrFunc0, SymName, _Arity),
- typecheck_info_get_module_info(!.Info, ModuleInfo),
+ typecheck_info_get_module_info(Info, ModuleInfo),
module_info_get_predicate_table(ModuleInfo, PredicateTable),
(
predicate_table_search_pf_sym(PredicateTable,
- calls_are_fully_qualified(!.Info ^ pred_markers),
+ calls_are_fully_qualified(Info ^ pred_markers),
PredOrFunc0, SymName, OtherIds),
predicate_table_get_preds(PredicateTable, Preds),
OtherIds = [_ | _]
->
typecheck_find_arities(Preds, OtherIds, Arities),
- Spec = report_error_pred_num_args(!.Info, PredCallId, Arities)
+ Spec = report_error_pred_num_args(Info, PredCallId, Arities)
;
- UndefMsg = report_error_undef_pred(!.Info, PredCallId),
+ UndefMsg = report_error_undef_pred(Info, PredCallId),
(
( PredOrFunc0 = predicate, PredOrFunc = function
; PredOrFunc0 = function, PredOrFunc = predicate
),
predicate_table_search_pf_sym(PredicateTable,
- calls_are_fully_qualified(!.Info ^ pred_markers),
+ calls_are_fully_qualified(Info ^ pred_markers),
PredOrFunc, SymName, OtherIds),
OtherIds = [_ | _]
->
- KindMsg = report_error_func_instead_of_pred(!.Info, PredOrFunc),
+ KindMsg = report_error_func_instead_of_pred(Info, PredOrFunc),
Msgs = [UndefMsg, KindMsg]
;
Msgs = [UndefMsg]
),
Spec = error_spec(severity_error, phase_type_check, Msgs)
- ),
- typecheck_info_set_found_error(yes, !Info),
- % XXX _NumErrors
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO).
+ ).
:- pred typecheck_find_arities(pred_table::in, list(pred_id)::in,
list(int)::out) is det.
@@ -294,23 +287,18 @@
%-----------------------------------------------------------------------------%
-report_unknown_event_call_error(EventName, !Info, !IO) :-
- typecheck_info_get_context(!.Info, Context),
- Pieces = [words("There is no event named"), quote(EventName),
- suffix(".")],
+report_unknown_event_call_error(Info, EventName) = Spec :-
+ typecheck_info_get_context(Info, Context),
+ Pieces = [words("There is no event named"), quote(EventName), suffix(".")],
Msg = simple_msg(Context, [always(Pieces)]),
- Spec = error_spec(severity_warning, phase_type_check, [Msg]),
- typecheck_info_set_found_error(yes, !Info),
- % XXX _NumErrors
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO).
+ Spec = error_spec(severity_warning, phase_type_check, [Msg]).
%-----------------------------------------------------------------------------%
-report_no_clauses(MessageKind, PredId, PredInfo, ModuleInfo, !IO) :-
- PredPieces = describe_one_pred_name(ModuleInfo,
- should_not_module_qualify, PredId),
- Pieces = [words(MessageKind), suffix(":"),
- words("no clauses for ") | PredPieces] ++ [suffix(".")],
+report_no_clauses(ModuleInfo, PredId, PredInfo) = Spec :-
+ PredPieces = describe_one_pred_name(ModuleInfo, should_not_module_qualify,
+ PredId),
+ Pieces = [words("Error: no clauses for") | PredPieces] ++ [suffix(".")],
pred_info_context(PredInfo, Context),
% It is possible (and even likely) that the error that got the exit
% status set was caused by a syntax error in a clause defining this
@@ -326,19 +314,25 @@
% without clauses we warn about in a single compiler invocation to one,
% we choose (as the lesser of two evils) to always report the error.
Msg = simple_msg(Context, [always(Pieces)]),
- Spec = error_spec(severity_warning, phase_type_check, [Msg]),
- % XXX _NumErrors
- % typecheck_info_set_found_error(yes, !Info),
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO).
+ Spec = error_spec(severity_error, phase_type_check, [Msg]).
+
+%-----------------------------------------------------------------------------%
+
+report_no_clauses_stub(ModuleInfo, PredId, PredInfo) = Spec :-
+ PredPieces = describe_one_pred_name(ModuleInfo, should_not_module_qualify,
+ PredId),
+ Pieces = [words("Warning: no clauses for ") | PredPieces] ++ [suffix(".")],
+ pred_info_context(PredInfo, Context),
+ Msg = simple_msg(Context,
+ [option_is_set(warn_stubs, yes, [always(Pieces)])]),
+ Severity = severity_conditional(warn_stubs, yes, severity_warning, no),
+ Spec = error_spec(Severity, phase_type_check, [Msg]).
%-----------------------------------------------------------------------------%
-report_warning_too_much_overloading(Info, !IO) :-
+report_warning_too_much_overloading(Info) = Spec :-
Msgs = warning_too_much_overloading_to_msgs(Info),
- Spec = error_spec(severity_warning, phase_type_check, Msgs),
- % XXX _NumErrors
- % typecheck_info_set_found_error(yes, !Info),
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO).
+ Spec = error_spec(severity_warning, phase_type_check, Msgs).
:- func warning_too_much_overloading_to_msgs(typecheck_info) = list(error_msg).
@@ -480,7 +474,7 @@
%-----------------------------------------------------------------------------%
-report_error_unif_var_var(Info, X, Y, TypeAssignSet, !IO) :-
+report_error_unif_var_var(Info, X, Y, TypeAssignSet) = Spec :-
typecheck_info_get_context(Info, Context),
typecheck_info_get_varset(Info, VarSet),
typecheck_info_get_unify_context(Info, UnifyContext),
@@ -500,13 +494,12 @@
Msg = simple_msg(Context,
[always(InClauseForPieces), always(UnifyContextPieces),
always(MainPieces), verbose_only(VerbosePieces)]),
- Spec = error_spec(severity_error, phase_type_check, [Msg]),
- % XXX _NumErrors
- % typecheck_info_set_found_error(yes, !Info),
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO).
+ Spec = error_spec(severity_error, phase_type_check, [Msg]).
+
+%-----------------------------------------------------------------------------%
report_error_lambda_var(Info, PredOrFunc, _EvalMethod, Var, ArgVars,
- TypeAssignSet, !IO) :-
+ TypeAssignSet) = Spec :-
typecheck_info_get_context(Info, Context),
typecheck_info_get_varset(Info, VarSet),
typecheck_info_get_unify_context(Info, UnifyContext),
@@ -570,13 +563,12 @@
[always(InClauseForPieces ++ UnifyContextPieces),
always(Pieces1 ++ Pieces2 ++ Pieces3 ++ Pieces4),
verbose_only(VerbosePieces)]),
- Spec = error_spec(severity_error, phase_type_check, [Msg]),
- % XXX _NumErrors
- % typecheck_info_set_found_error(yes, !Info),
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO).
+ Spec = error_spec(severity_error, phase_type_check, [Msg]).
+
+%-----------------------------------------------------------------------------%
report_error_functor_type(Info, Var, ConsDefnList, Functor, Arity,
- TypeAssignSet, !IO) :-
+ TypeAssignSet) = Spec :-
typecheck_info_get_context(Info, Context),
typecheck_info_get_varset(Info, VarSet),
typecheck_info_get_unify_context(Info, UnifyContext),
@@ -602,13 +594,12 @@
Msg = simple_msg(Context,
[always(InClauseForPieces ++ UnifyContextPieces),
always(MainPieces), verbose_only(VerbosePieces)]),
- Spec = error_spec(severity_error, phase_type_check, [Msg]),
- % XXX _NumErrors
- % typecheck_info_set_found_error(yes, !Info),
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO).
+ Spec = error_spec(severity_error, phase_type_check, [Msg]).
+
+%-----------------------------------------------------------------------------%
report_error_functor_arg_types(Info, Var, ConsDefnList, Functor, Args,
- ArgsTypeAssignSet, !IO) :-
+ ArgsTypeAssignSet) = Spec :-
typecheck_info_get_context(Info, Context),
typecheck_info_get_varset(Info, VarSet),
typecheck_info_get_unify_context(Info, UnifyContext),
@@ -681,10 +672,7 @@
Msg = simple_msg(Context,
[always(InClauseForPieces ++ UnifyContextPieces),
always(Pieces1 ++ Pieces2) | VerboseComponents]),
- Spec = error_spec(severity_error, phase_type_check, [Msg]),
- % XXX _NumErrors
- % typecheck_info_set_found_error(yes, !Info),
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO).
+ Spec = error_spec(severity_error, phase_type_check, [Msg]).
:- type mismatch_info
---> mismatch_info(
@@ -826,7 +814,7 @@
%-----------------------------------------------------------------------------%
-report_error_var(Info, Var, Type, TypeAssignSet0, !IO) :-
+report_error_var(Info, Var, Type, TypeAssignSet0) = Spec :-
typecheck_info_get_pred_markers(Info, PredMarkers),
typecheck_info_get_called_predid(Info, CalledPredId),
typecheck_info_get_arg_num(Info, ArgNum),
@@ -864,12 +852,11 @@
[always(InClauseForPieces ++ CallContextPieces),
always(Pieces1 ++ Pieces2),
verbose_only(VerbosePieces)]),
- Spec = error_spec(severity_error, phase_type_check, [Msg]),
- % XXX _NumErrors
- % typecheck_info_set_found_error(yes, !Info),
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO).
+ Spec = error_spec(severity_error, phase_type_check, [Msg]).
+
+%-----------------------------------------------------------------------------%
-report_error_arg_var(Info, Var, ArgTypeAssignSet0, !IO) :-
+report_error_arg_var(Info, Var, ArgTypeAssignSet0) = Spec :-
typecheck_info_get_pred_markers(Info, PredMarkers),
typecheck_info_get_called_predid(Info, CalledPredId),
typecheck_info_get_arg_num(Info, ArgNum),
@@ -909,14 +896,11 @@
[always(InClauseForPieces ++ CallContextPieces),
always(Pieces1 ++ Pieces2),
verbose_only(VerbosePieces)]),
- Spec = error_spec(severity_error, phase_type_check, [Msg]),
- % XXX _NumErrors
- % typecheck_info_set_found_error(yes, !Info),
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO).
+ Spec = error_spec(severity_error, phase_type_check, [Msg]).
%-----------------------------------------------------------------------------%
-report_error_undef_cons(Info, ConsErrors, Functor, Arity, !IO) :-
+report_error_undef_cons(Info, ConsErrors, Functor, Arity) = Spec :-
typecheck_info_get_pred_markers(Info, PredMarkers),
typecheck_info_get_called_predid(Info, CalledPredId),
typecheck_info_get_arg_num(Info, ArgNum),
@@ -993,9 +977,7 @@
ConsMsgs = []
),
Spec = error_spec(severity_error, phase_type_check,
- [simple_msg(Context, [InitComp | FunctorComps]) | ConsMsgs]),
- % XXX _NumErrors
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO).
+ [simple_msg(Context, [InitComp | FunctorComps]) | ConsMsgs]).
:- pred language_builtin_functor_components(string::in, arity::in,
list(error_msg_component)::out) is semidet.
@@ -1168,7 +1150,7 @@
%-----------------------------------------------------------------------------%
-report_ambiguity_error(Info, TypeAssign1, TypeAssign2, !IO) :-
+report_ambiguity_error(Info, TypeAssign1, TypeAssign2) = Spec :-
InClauseForPieces = in_clause_for_pieces(Info),
Pieces1 =
[words("error: ambiguous overloading causes type ambiguity."), nl],
@@ -1194,10 +1176,7 @@
MainMsg = simple_msg(Context,
[always(InClauseForPieces ++ Pieces1 ++ Pieces2) | VerboseComponents]),
Spec = error_spec(severity_error, phase_type_check,
- [MainMsg | WarningMsgs]),
- % XXX _NumErrors
- % typecheck_info_set_found_error(yes, !Info),
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO).
+ [MainMsg | WarningMsgs]).
:- func add_qualifiers_reminder = string.
@@ -1244,8 +1223,8 @@
%-----------------------------------------------------------------------------%
-report_unsatisfiable_constraints(TypeAssignSet, !Info, !IO) :-
- InClauseForPieces = in_clause_for_pieces(!.Info),
+report_unsatisfiable_constraints(Info, TypeAssignSet) = Spec :-
+ InClauseForPieces = in_clause_for_pieces(Info),
list.map_foldl(constraints_to_pieces, TypeAssignSet, ConstraintPieceLists,
0, NumUnsatisfied),
( NumUnsatisfied = 1 ->
@@ -1257,13 +1236,10 @@
Pieces2 = component_list_to_line_pieces(ConstraintPieceLists,
[suffix(".")]),
- typecheck_info_get_context(!.Info, Context),
+ typecheck_info_get_context(Info, Context),
Msg = simple_msg(Context,
[always(InClauseForPieces ++ Pieces1 ++ Pieces2)]),
- Spec = error_spec(severity_error, phase_type_check, [Msg]),
- % XXX _NumErrors
- typecheck_info_set_found_error(yes, !Info),
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO).
+ Spec = error_spec(severity_error, phase_type_check, [Msg]).
:- pred constraints_to_pieces(type_assign::in, list(format_component)::out,
int::in, int::out) is det.
@@ -1294,7 +1270,7 @@
%-----------------------------------------------------------------------------%
-report_missing_tvar_in_foreign_code(Info, VarName, !IO) :-
+report_missing_tvar_in_foreign_code(Info, VarName) = Spec :-
typecheck_info_get_module_info(Info, ModuleInfo),
typecheck_info_get_context(Info, Context),
typecheck_info_get_predid(Info, PredId),
@@ -1304,10 +1280,7 @@
[words("should define the variable"),
fixed(add_quotes(VarName)), suffix(".")],
Spec = error_spec(severity_error, phase_type_check,
- [simple_msg(Context, [always(Pieces)])]),
- % XXX _NumErrors
- % typecheck_info_set_found_error(yes, !Info),
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO).
+ [simple_msg(Context, [always(Pieces)])]).
%-----------------------------------------------------------------------------%
Index: compiler/typecheck_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck_info.m,v
retrieving revision 1.15
diff -u -b -r1.15 typecheck_info.m
--- compiler/typecheck_info.m 7 Sep 2006 05:51:07 -0000 1.15
+++ compiler/typecheck_info.m 11 Sep 2006 04:00:42 -0000
@@ -79,8 +79,8 @@
% that we are computing and which gets updated
% as we go along.
- found_error :: bool,
- % Did we find any type errors?
+ found_errors :: list(error_spec),
+ % The list of errors found so far (if any).
overloaded_symbols :: overloaded_symbol_map,
% The symbols used by the current predicate
@@ -113,7 +113,7 @@
:- pred typecheck_info_init(module_info::in, pred_id::in,
bool::in, tvarset::in, prog_varset::in, vartypes::in,
head_type_params::in, hlds_constraints::in, import_status::in,
- pred_markers::in, typecheck_info::out) is det.
+ pred_markers::in, list(error_spec)::in, typecheck_info::out) is det.
% typecheck_info_get_final_info(Info, OldHeadTypeParams, OldExistQVars,
% OldExplicitVarTypes, NewTypeVarSet, New* ..., TypeRenaming,
@@ -158,7 +158,8 @@
:- pred typecheck_info_get_varset(typecheck_info::in, prog_varset::out) is det.
:- pred typecheck_info_get_type_assign_set(typecheck_info::in,
type_assign_set::out) is det.
-:- pred typecheck_info_get_found_error(typecheck_info::in, bool::out) is det.
+:- pred typecheck_info_get_errors(typecheck_info::in, list(error_spec)::out)
+ is det.
:- pred typecheck_info_get_warned_about_overloading(typecheck_info::in,
bool::out) is det.
:- pred typecheck_info_get_overloaded_symbols(typecheck_info::in,
@@ -176,8 +177,6 @@
typecheck_info::in, typecheck_info::out) is det.
:- pred typecheck_info_set_type_assign_set(type_assign_set::in,
typecheck_info::in, typecheck_info::out) is det.
-:- pred typecheck_info_set_found_error(bool::in,
- typecheck_info::in, typecheck_info::out) is det.
:- pred typecheck_info_set_warned_about_overloading(bool::in,
typecheck_info::in, typecheck_info::out) is det.
:- pred typecheck_info_set_overloaded_symbols(overloaded_symbol_map::in,
@@ -202,6 +201,9 @@
:- pred typecheck_info_add_overloaded_symbol(overloaded_symbol::in,
prog_context::in, typecheck_info::in, typecheck_info::out) is det.
+:- pred typecheck_info_add_error(error_spec::in,
+ typecheck_info::in, typecheck_info::out) is det.
+
%-----------------------------------------------------------------------------%
%
% The type_assign and type_assign_set data structures.
@@ -373,13 +375,12 @@
typecheck_info_init(ModuleInfo, PredId, IsFieldAccessFunction,
TypeVarSet, VarSet, VarTypes, HeadTypeParams,
- Constraints, Status, Markers, Info) :-
+ Constraints, Status, Markers, Errors, Info) :-
CallPredId = plain_call_id(simple_call_id(predicate, unqualified(""), 0)),
term.context_init(Context),
map.init(TypeBindings),
map.init(Proofs),
map.init(ConstraintMap),
- FoundTypeError = no,
WarnedAboutOverloading = no,
map.init(OverloadedSymbols),
Info = typecheck_info(ModuleInfo, CallPredId, 0, PredId, Status, Markers,
@@ -387,7 +388,7 @@
unify_context(umc_explicit, []), VarSet,
[type_assign(VarTypes, TypeVarSet, HeadTypeParams,
TypeBindings, Constraints, Proofs, ConstraintMap)],
- FoundTypeError, OverloadedSymbols, WarnedAboutOverloading
+ Errors, OverloadedSymbols, WarnedAboutOverloading
).
typecheck_info_get_final_info(Info, OldHeadTypeParams, OldExistQVars,
@@ -412,17 +413,15 @@
apply_rec_subst_to_constraint_map(TypeBindings,
ConstraintMap0, ConstraintMap1),
- %
- % When inferring the typeclass constraints, the universal
- % constraints here may be assumed (if this is the last pass)
- % but will not have been eliminated during context reduction,
- % hence they will not yet be in the constraint map. Since
- % they may be required, put them in now.
- %
- % Additionally, existential constraints are assumed so don't
- % need to be eliminated during context reduction, so they
- % need to be put in the constraint map now.
- %
+ % When inferring the typeclass constraints, the universal constraints
+ % here may be assumed (if this is the last pass) but will not have been
+ % eliminated during context reduction, hence they will not yet be
+ % in the constraint map. Since they may be required, put them in now.
+ %
+ % Additionally, existential constraints are assumed so don't need to be
+ % eliminated during context reduction, so they need to be put in the
+ % constraint map now.
+
HLDSTypeConstraints = constraints(HLDSUnivConstraints,
HLDSExistConstraints, _),
list.foldl(update_constraint_map, HLDSUnivConstraints,
@@ -430,40 +429,33 @@
list.foldl(update_constraint_map, HLDSExistConstraints,
ConstraintMap2, ConstraintMap),
- %
% Figure out how we should rename the existential types
% in the type declaration (if any).
- %
+
get_existq_tvar_renaming(OldHeadTypeParams, OldExistQVars,
TypeBindings, ExistTypeRenaming),
+ % We used to just use the OldTypeVarSet that we got from the type
+ % assignment.
%
- % We used to just use the OldTypeVarSet that we got
- % from the type assignment.
- %
- % However, that caused serious efficiency problems,
- % because the typevarsets get bigger and bigger with each
- % inference step. Instead, we now construct a new
- % typevarset NewTypeVarSet which contains only the
- % variables we want, and we rename the type variables
- % so that they fit into this new typevarset.
- %
-
- %
- % First, find the set (sorted list) of type variables
- % that we need. This must include any type variables
- % in the inferred types, the explicit type qualifications,
- % and any existentially typed variables that will remain
- % in the declaration.
+ % However, that caused serious efficiency problems, because the
+ % typevarsets get bigger and bigger with each inference step. Instead,
+ % we now construct a new typevarset NewTypeVarSet which contains
+ % only the variables we want, and we rename the type variables so that
+ % they fit into this new typevarset.
+
+ % First, find the set (sorted list) of type variables that we need.
+ % This must include any type variables in the inferred types, the
+ % explicit type qualifications, and any existentially typed variables
+ % that will remain in the declaration.
%
% There may also be some type variables in the HeadTypeParams
- % which do not occur in the type of any variable (e.g. this
- % can happen in the case of code containing type errors).
- % We'd better keep those, too, to avoid errors
- % when we apply the TSubst to the HeadTypeParams.
- % (XXX should we do the same for TypeConstraints and
- % ConstraintProofs too?)
- %
+ % which do not occur in the type of any variable (e.g. this can happen
+ % in the case of code containing type errors). We'd better keep those,
+ % too, to avoid errors when we apply the TSubst to the HeadTypeParams.
+ % (XXX should we do the same for TypeConstraints and ConstraintProofs
+ % too?)
+
map.values(VarTypes, Types),
prog_type.vars_list(Types, TypeVars0),
map.values(OldExplicitVarTypes, ExplicitTypes),
@@ -474,15 +466,12 @@
list.condense([ExistQVarsToRemain, HeadTypeParams,
TypeVars0, ExplicitTypeVars0], TypeVars1),
list.sort_and_remove_dups(TypeVars1, TypeVars),
- %
- % Next, create a new typevarset with the same number of
- % variables.
- %
+
+ % Next, create a new typevarset with the same number of variables.
varset.squash(OldTypeVarSet, TypeVars, NewTypeVarSet, TSubst),
- %
- % Finally, rename the types and type class constraints
- % to use the new typevarset type variables.
- %
+
+ % Finally, rename the types and type class constraints to use
+ % the new typevarset type variables.
apply_variable_renaming_to_type_list(TSubst, Types, NewTypes),
map.from_corresponding_lists(Vars, NewTypes, NewVarTypes),
map.apply_to_list(HeadTypeParams, TSubst, NewHeadTypeParams),
@@ -510,9 +499,9 @@
map.det_update(!.VarTypes, Var, Type, !:VarTypes),
expand_types(Vars, TypeSubst, !VarTypes).
- % We rename any existentially quantified type variables which
- % get mapped to other type variables, unless they are mapped to
- % universally quantified type variables from the head of the predicate.
+ % We rename any existentially quantified type variables which get mapped
+ % to other type variables, unless they are mapped to universally quantified
+ % type variables from the head of the predicate.
%
:- pred get_existq_tvar_renaming(list(tvar)::in, existq_tvars::in, tsubst::in,
tvar_renaming::out) is det.
@@ -548,6 +537,9 @@
%-----------------------------------------------------------------------------%
+:- pred typecheck_info_set_errors(list(error_spec)::in,
+ typecheck_info::in, typecheck_info::out) is det.
+
typecheck_info_get_module_info(Info, Info ^ module_info).
typecheck_info_get_called_predid(Info, Info ^ call_id).
typecheck_info_get_arg_num(Info, Info ^ arg_num).
@@ -556,7 +548,7 @@
typecheck_info_get_unify_context(Info, Info ^ unify_context).
typecheck_info_get_varset(Info, Info ^ varset).
typecheck_info_get_type_assign_set(Info, Info ^ type_assign_set).
-typecheck_info_get_found_error(Info, Info ^ found_error).
+typecheck_info_get_errors(Info, Info ^ found_errors).
typecheck_info_get_warned_about_overloading(Info,
Info ^ warned_about_overloading).
typecheck_info_get_overloaded_symbols(Info, Info ^ overloaded_symbols).
@@ -570,8 +562,7 @@
Info ^ unify_context := UnifyContext).
typecheck_info_set_type_assign_set(TypeAssignSet, Info,
Info ^ type_assign_set := TypeAssignSet).
-typecheck_info_set_found_error(FoundError, Info,
- Info ^ found_error := FoundError).
+typecheck_info_set_errors(Errors, Info, Info ^ found_errors := Errors).
typecheck_info_set_warned_about_overloading(Warned, Info,
Info ^ warned_about_overloading := Warned).
typecheck_info_set_overloaded_symbols(Symbols, Info,
@@ -607,6 +598,11 @@
),
typecheck_info_set_overloaded_symbols(SymbolMap, !Info).
+typecheck_info_add_error(Error, !Info) :-
+ typecheck_info_get_errors(!.Info, Errors0),
+ Errors = [Error | Errors0],
+ typecheck_info_set_errors(Errors, !Info).
+
%-----------------------------------------------------------------------------%
type_assign_get_var_types(TA, TA ^ var_types).
Index: compiler/typeclasses.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typeclasses.m,v
retrieving revision 1.13
diff -u -b -r1.13 typeclasses.m
--- compiler/typeclasses.m 7 Sep 2006 05:51:08 -0000 1.13
+++ compiler/typeclasses.m 11 Sep 2006 04:02:23 -0000
@@ -22,8 +22,6 @@
:- import_module hlds.hlds_pred.
:- import_module parse_tree.prog_data.
-:- import_module io.
-
% perform_context_reduction(OrigTypeAssignSet, !Info) is true
% iff either
% (a) !:Info is the typecheck_info that results from performing
@@ -70,7 +68,7 @@
% subsequent calls to perform_context_reduction.
%
:- pred perform_context_reduction(type_assign_set::in,
- typecheck_info::in, typecheck_info::out, io::di, io::uo) is det.
+ typecheck_info::in, typecheck_info::out) is det.
% Apply context reduction to the list of class constraints by applying
% the instance rules or superclass rules, building up proofs for
@@ -106,8 +104,10 @@
%-----------------------------------------------------------------------------%
-perform_context_reduction(OrigTypeAssignSet, !Info, !IO) :-
- type_checkpoint("before context reduction", !.Info, !IO),
+perform_context_reduction(OrigTypeAssignSet, !Info) :-
+ trace [io(!IO)] (
+ type_checkpoint("before context reduction", !.Info, !IO)
+ ),
typecheck_info_get_module_info(!.Info, ModuleInfo),
module_info_get_class_table(ModuleInfo, ClassTable),
module_info_get_superclass_table(ModuleInfo, SuperClassTable),
@@ -122,7 +122,8 @@
TypeAssignSet0 = [_ | _],
TypeAssignSet = []
->
- report_unsatisfiable_constraints(TypeAssignSet0, !Info, !IO),
+ Spec = report_unsatisfiable_constraints(!.Info, TypeAssignSet0),
+ typecheck_info_add_error(Spec, !Info),
DeleteConstraints = (pred(TA0::in, TA::out) is det :-
type_assign_get_typeclass_constraints(TA0, Constraints0),
Constraints = (Constraints0
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/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/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
Index: tests/invalid/errors2.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/errors2.err_exp,v
retrieving revision 1.15
diff -u -b -r1.15 errors2.err_exp
--- tests/invalid/errors2.err_exp 7 Sep 2006 05:51:26 -0000 1.15
+++ tests/invalid/errors2.err_exp 11 Sep 2006 15:47:11 -0000
@@ -17,6 +17,7 @@
errors2.m:070: warning: variable `Y' occurs only once in this scope.
errors2.m:071: In clause for predicate `errors2.type_error_7'/0:
errors2.m:071: warning: variables `Z, A, B' occur only once in this scope.
+errors2.m:009: Inferred :- pred bind_type_param(int).
errors2.m:007: Error: no clauses for predicate `bind_type_param'/2.
errors2.m:023: Error: no clauses for predicate `produce_string'/1.
errors2.m:025: Error: no clauses for predicate `expect_int'/1.
@@ -107,10 +108,10 @@
errors2.m:072: B_4: int
errors2.m:072: C_5: string
errors2.m:078: In clause for predicate `type_error_8'/0:
+errors2.m:078: error: undefined predicate `from_char_list'/2.
+errors2.m:078: In clause for predicate `type_error_8'/0:
errors2.m:078: in argument 1 of call to predicate `from_char_list'/2:
errors2.m:078: error: undefined symbol `[]/0'.
-errors2.m:078: In clause for predicate `type_error_8'/0:
-errors2.m:078: error: undefined predicate `from_char_list'/2.
errors2.m:085: In clause for predicate `type_error_9'/0:
errors2.m:085: type error in unification of variable `X'
errors2.m:085: and variable `Y'.
@@ -125,4 +126,3 @@
errors2.m:085: V_6: string
errors2.m:085: V_7: character
errors2.m:085: V_8: int
-errors2.m:009: Inferred :- pred bind_type_param(int).
Index: tests/invalid/foreign_purity_mismatch.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/foreign_purity_mismatch.err_exp,v
retrieving revision 1.2
diff -u -b -r1.2 foreign_purity_mismatch.err_exp
--- tests/invalid/foreign_purity_mismatch.err_exp 7 Sep 2006 05:51:27 -0000 1.2
+++ tests/invalid/foreign_purity_mismatch.err_exp 11 Sep 2006 15:47:14 -0000
@@ -22,17 +22,14 @@
foreign_purity_mismatch.m:055: `foreign_purity_mismatch.impure_with_semipure'/1
foreign_purity_mismatch.m:055: has purity semipure but that predicate has
foreign_purity_mismatch.m:055: been declared impure.
-foreign_purity_mismatch.m:006: In predicate
-foreign_purity_mismatch.m:006: `foreign_purity_mismatch.pure_with_impure'/1:
+foreign_purity_mismatch.m:006: In predicate `pure_with_impure'/1:
foreign_purity_mismatch.m:006: purity error: predicate is impure.
foreign_purity_mismatch.m:006: It must be declared `impure' or promised pure.
-foreign_purity_mismatch.m:007: In predicate
-foreign_purity_mismatch.m:007: `foreign_purity_mismatch.pure_with_semipure'/1:
+foreign_purity_mismatch.m:007: In predicate `pure_with_semipure'/1:
foreign_purity_mismatch.m:007: purity error: predicate is semipure.
foreign_purity_mismatch.m:007: It must be declared `semipure' or promised
foreign_purity_mismatch.m:007: pure.
-foreign_purity_mismatch.m:009: In predicate
-foreign_purity_mismatch.m:009: `foreign_purity_mismatch.semipure_with_impure'/1:
+foreign_purity_mismatch.m:009: In predicate `semipure_with_impure'/1:
foreign_purity_mismatch.m:009: purity error: predicate is impure.
foreign_purity_mismatch.m:009: It must be declared `impure' or promised
foreign_purity_mismatch.m:009: semipure.
Index: tests/invalid/freefree.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/freefree.err_exp,v
retrieving revision 1.5
diff -u -b -r1.5 freefree.err_exp
--- tests/invalid/freefree.err_exp 7 Sep 2006 05:51:27 -0000 1.5
+++ tests/invalid/freefree.err_exp 12 Sep 2006 01:45:59 -0000
@@ -1,15 +1,16 @@
-freefree.m:016: In predicate `freefree.p'/0:
+freefree.m:016: In predicate `p'/0:
freefree.m:016: warning: unresolved polymorphism.
freefree.m:016: The variables with unbound types were:
freefree.m:016: Y: V_1
freefree.m:016: X: V_1
-freefree.m:016: The unbound type variable(s) will be implicitly
-freefree.m:016: bound to the builtin type `void'.
- The body of the clause contains a call to a polymorphic predicate,
- but I can't determine which version should be called,
- because the type variables listed above didn't get bound.
- (I ought to tell you which call caused the problem, but I'm afraid
- you'll have to work it out yourself. My apologies.)
+freefree.m:016: The unbound type variables will be implicitly bound to the
+freefree.m:016: builtin type `void'.
+freefree.m:016: The body of the clause contains a call to a polymorphic
+freefree.m:016: predicate, but I can't determine which version should be
+freefree.m:016: called, because the type variables listed above didn't get
+freefree.m:016: bound. (I ought to tell you which call caused the problem,
+freefree.m:016: but I'm afraid you'll have to work it out yourself. My
+freefree.m:016: apologies.)
freefree.m:019: In clause for `p':
freefree.m:019: mode error in unification of `X' and `Y'.
freefree.m:019: Variable `X' has instantiatedness `free',
Index: tests/invalid/funcs_as_preds.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/funcs_as_preds.err_exp,v
retrieving revision 1.12
diff -u -b -r1.12 funcs_as_preds.err_exp
--- tests/invalid/funcs_as_preds.err_exp 7 Sep 2006 05:51:28 -0000 1.12
+++ tests/invalid/funcs_as_preds.err_exp 11 Sep 2006 15:47:16 -0000
@@ -10,6 +10,9 @@
funcs_as_preds.m:027: without preceding `func' declaration.
funcs_as_preds.m:030: Error: clause for function `funcs_as_preds.ap'/2
funcs_as_preds.m:030: without preceding `func' declaration.
+funcs_as_preds.m:021: Inferred :- func car((list.list((list.list(T))))) = (list.list(T)).
+funcs_as_preds.m:024: Inferred :- func cdr((list.list(T))) = (list.list(T)).
+funcs_as_preds.m:027: Inferred :- func cons(T, (list.list(T))) = (list.list(T)).
funcs_as_preds.m:017: In clause for function `null'/1:
funcs_as_preds.m:017: in function result term of clause head:
funcs_as_preds.m:017: error: the language construct `='/2 should be used as a
@@ -18,7 +21,4 @@
funcs_as_preds.m:030: error: undefined predicate `null'/1.
funcs_as_preds.m:030: (There is a *function* with that name, however.
funcs_as_preds.m:030: Perhaps you forgot to add ` = ...'?)
-funcs_as_preds.m:021: Inferred :- func car((list.list((list.list(T))))) = (list.list(T)).
-funcs_as_preds.m:024: Inferred :- func cdr((list.list(T))) = (list.list(T)).
-funcs_as_preds.m:027: Inferred :- func cons(T, (list.list(T))) = (list.list(T)).
For more information, recompile with `-E'.
Index: tests/invalid/illtyped_compare.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/illtyped_compare.err_exp,v
retrieving revision 1.5
diff -u -b -r1.5 illtyped_compare.err_exp
--- tests/invalid/illtyped_compare.err_exp 7 Sep 2006 05:51:28 -0000 1.5
+++ tests/invalid/illtyped_compare.err_exp 11 Sep 2006 15:47:18 -0000
@@ -1,40 +1,40 @@
-illtyped_compare.m:017: In clause for unification predicate for type `bar_rep':
+illtyped_compare.m:017: In clause for comparison predicate for type `bar_rep':
illtyped_compare.m:017: in argument 2 of call to predicate
illtyped_compare.m:017: `illtyped_compare.compare_bar'/3:
-illtyped_compare.m:017: type error: variable `HeadVar__1' has type
+illtyped_compare.m:017: type error: variable `HeadVar__2' has type
illtyped_compare.m:017: `(illtyped_compare.bar_rep)',
illtyped_compare.m:017: expected type was `(illtyped_compare.bar)'.
illtyped_compare.m:017: The partial type assignment was:
-illtyped_compare.m:017: HeadVar__1_1: (illtyped_compare.bar_rep)
+illtyped_compare.m:017: HeadVar__1_1: comparison_result
illtyped_compare.m:017: HeadVar__2_2: (illtyped_compare.bar_rep)
-illtyped_compare.m:017: V_3: comparison_result
-illtyped_compare.m:017: In clause for unification predicate for type `bar_rep':
+illtyped_compare.m:017: HeadVar__3_3: (illtyped_compare.bar_rep)
+illtyped_compare.m:017: In clause for comparison predicate for type `bar_rep':
illtyped_compare.m:017: in argument 3 of call to predicate
illtyped_compare.m:017: `illtyped_compare.compare_bar'/3:
-illtyped_compare.m:017: type error: variable `HeadVar__2' has type
+illtyped_compare.m:017: type error: variable `HeadVar__3' has type
illtyped_compare.m:017: `(illtyped_compare.bar_rep)',
illtyped_compare.m:017: expected type was `(illtyped_compare.bar)'.
illtyped_compare.m:017: The partial type assignment was:
-illtyped_compare.m:017: HeadVar__1_1: (illtyped_compare.bar_rep)
+illtyped_compare.m:017: HeadVar__1_1: comparison_result
illtyped_compare.m:017: HeadVar__2_2: (illtyped_compare.bar_rep)
-illtyped_compare.m:017: V_3: comparison_result
-illtyped_compare.m:017: In clause for comparison predicate for type `bar_rep':
+illtyped_compare.m:017: HeadVar__3_3: (illtyped_compare.bar_rep)
+illtyped_compare.m:017: In clause for unification predicate for type `bar_rep':
illtyped_compare.m:017: in argument 2 of call to predicate
illtyped_compare.m:017: `illtyped_compare.compare_bar'/3:
-illtyped_compare.m:017: type error: variable `HeadVar__2' has type
+illtyped_compare.m:017: type error: variable `HeadVar__1' has type
illtyped_compare.m:017: `(illtyped_compare.bar_rep)',
illtyped_compare.m:017: expected type was `(illtyped_compare.bar)'.
illtyped_compare.m:017: The partial type assignment was:
-illtyped_compare.m:017: HeadVar__1_1: comparison_result
+illtyped_compare.m:017: HeadVar__1_1: (illtyped_compare.bar_rep)
illtyped_compare.m:017: HeadVar__2_2: (illtyped_compare.bar_rep)
-illtyped_compare.m:017: HeadVar__3_3: (illtyped_compare.bar_rep)
-illtyped_compare.m:017: In clause for comparison predicate for type `bar_rep':
+illtyped_compare.m:017: V_3: comparison_result
+illtyped_compare.m:017: In clause for unification predicate for type `bar_rep':
illtyped_compare.m:017: in argument 3 of call to predicate
illtyped_compare.m:017: `illtyped_compare.compare_bar'/3:
-illtyped_compare.m:017: type error: variable `HeadVar__3' has type
+illtyped_compare.m:017: type error: variable `HeadVar__2' has type
illtyped_compare.m:017: `(illtyped_compare.bar_rep)',
illtyped_compare.m:017: expected type was `(illtyped_compare.bar)'.
illtyped_compare.m:017: The partial type assignment was:
-illtyped_compare.m:017: HeadVar__1_1: comparison_result
+illtyped_compare.m:017: HeadVar__1_1: (illtyped_compare.bar_rep)
illtyped_compare.m:017: HeadVar__2_2: (illtyped_compare.bar_rep)
-illtyped_compare.m:017: HeadVar__3_3: (illtyped_compare.bar_rep)
+illtyped_compare.m:017: V_3: comparison_result
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.8
diff -u -b -r1.8 impure_method_impl.err_exp
--- tests/invalid/impure_method_impl.err_exp 7 Sep 2006 05:51:28 -0000 1.8
+++ tests/invalid/impure_method_impl.err_exp 11 Sep 2006 15:47:18 -0000
@@ -1,14 +1,14 @@
-impure_method_impl.m:022: In call to impure predicate
-impure_method_impl.m:022: `impure_method_impl.foo_m2'/2:
-impure_method_impl.m:022: purity error: call must be preceded by `impure'
-impure_method_impl.m:022: indicator.
-impure_method_impl.m:022: In type class method implementation:
-impure_method_impl.m:022: purity error: predicate is impure.
-impure_method_impl.m:022: It must be declared `impure' or promised semipure.
+impure_method_impl.m:021: In type class method implementation:
+impure_method_impl.m:021: purity error: predicate is semipure.
+impure_method_impl.m:021: It must be declared `semipure' or promised pure.
impure_method_impl.m:021: In call to semipure predicate
impure_method_impl.m:021: `impure_method_impl.foo_m1'/2:
impure_method_impl.m:021: purity error: call must be preceded by `semipure'
impure_method_impl.m:021: indicator.
-impure_method_impl.m:021: In type class method implementation:
-impure_method_impl.m:021: purity error: predicate is semipure.
-impure_method_impl.m:021: It must be declared `semipure' or promised pure.
+impure_method_impl.m:022: In type class method implementation:
+impure_method_impl.m:022: purity error: predicate is impure.
+impure_method_impl.m:022: It must be declared `impure' or promised semipure.
+impure_method_impl.m:022: In call to impure predicate
+impure_method_impl.m:022: `impure_method_impl.foo_m2'/2:
+impure_method_impl.m:022: purity error: call must be preceded by `impure'
+impure_method_impl.m:022: indicator.
Index: tests/invalid/mpj1.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/mpj1.err_exp,v
retrieving revision 1.4
diff -u -b -r1.4 mpj1.err_exp
--- tests/invalid/mpj1.err_exp 7 Sep 2006 05:51:30 -0000 1.4
+++ tests/invalid/mpj1.err_exp 11 Sep 2006 15:47:26 -0000
@@ -1,3 +1,4 @@
+mpj1.m:012: Inferred :- func f(E, E, T4) = T4 <= (mpj1.coll(E, T4)).
mpj1.m:014: In clause for function `g'/1:
mpj1.m:014: in function result term of clause head:
mpj1.m:014: in argument 2 of functor `f/3':
@@ -10,4 +11,3 @@
mpj1.m:014: L_3: T2
mpj1.m:014: V_4: string
mpj1.m:014: V_5: string <= mpj1.coll(string, T2)
-mpj1.m:012: Inferred :- func f(E, E, T4) = T4 <= (mpj1.coll(E, T4)).
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.5
diff -u -b -r1.5 multimode_missing_impure.err_exp
--- tests/invalid/multimode_missing_impure.err_exp 7 Sep 2006 05:51:30 -0000 1.5
+++ tests/invalid/multimode_missing_impure.err_exp 11 Sep 2006 15:47:28 -0000
@@ -1,10 +1,8 @@
-multimode_missing_impure.m:025: In predicate
-multimode_missing_impure.m:025: `multimode_missing_impure.test1'/1:
+multimode_missing_impure.m:025: In predicate `test1'/1:
multimode_missing_impure.m:025: purity error: predicate is impure.
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: In predicate `test2'/2:
multimode_missing_impure.m:034: purity error: predicate is impure.
multimode_missing_impure.m:034: It must be declared `impure' or promised
multimode_missing_impure.m:034: pure.
Index: tests/invalid/promise_equivalent_clauses.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/promise_equivalent_clauses.err_exp,v
retrieving revision 1.2
diff -u -b -r1.2 promise_equivalent_clauses.err_exp
--- tests/invalid/promise_equivalent_clauses.err_exp 7 Sep 2006 05:51:31 -0000 1.2
+++ tests/invalid/promise_equivalent_clauses.err_exp 11 Sep 2006 15:47:34 -0000
@@ -1,5 +1,4 @@
-promise_equivalent_clauses.m:033: In predicate
-promise_equivalent_clauses.m:033: `promise_equivalent_clauses.rsort'/2:
+promise_equivalent_clauses.m:033: In predicate `rsort'/2:
promise_equivalent_clauses.m:033: purity error: predicate is impure.
promise_equivalent_clauses.m:033: It must be declared `impure' or promised
promise_equivalent_clauses.m:033: pure.
Index: tests/invalid/record_syntax_errors.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/record_syntax_errors.err_exp,v
retrieving revision 1.16
diff -u -b -r1.16 record_syntax_errors.err_exp
--- tests/invalid/record_syntax_errors.err_exp 7 Sep 2006 05:51:32 -0000 1.16
+++ tests/invalid/record_syntax_errors.err_exp 11 Sep 2006 15:47:36 -0000
@@ -21,6 +21,7 @@
record_syntax_errors.m:057: function, for example to check the input to a
record_syntax_errors.m:057: field update, give the field of the constructor a
record_syntax_errors.m:057: different name.
+record_syntax_errors.m:023: Inferred :- func field8((record_syntax_errors.cons2)) = int.
record_syntax_errors.m:014: Error: no clauses for predicate `dcg_syntax'/2.
record_syntax_errors.m:016: Error: no clauses for predicate `dcg_syntax_2'/2.
record_syntax_errors.m:042: In clause for predicate `construct_exist_cons'/1:
@@ -47,4 +48,3 @@
record_syntax_errors.m:050: Argument 1 has type
record_syntax_errors.m:050: `(record_syntax_errors.cons2)',
record_syntax_errors.m:050: expected type was `(record_syntax_errors.cons)'.
-record_syntax_errors.m:023: Inferred :- func field8((record_syntax_errors.cons2)) = int.
Index: tests/invalid/type_inf_loop.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/type_inf_loop.err_exp,v
retrieving revision 1.6
diff -u -b -r1.6 type_inf_loop.err_exp
--- tests/invalid/type_inf_loop.err_exp 7 Sep 2006 05:51:33 -0000 1.6
+++ tests/invalid/type_inf_loop.err_exp 11 Sep 2006 15:47:41 -0000
@@ -2,9 +2,9 @@
type_inf_loop.m:001: export anything.
type_inf_loop.m:004: Error: clause for predicate `type_inf_loop.loop'/1
type_inf_loop.m:004: without preceding `pred' declaration.
+type_inf_loop.m:004: Inferred :- pred loop((pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred T1))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))).
Type inference iteration limit exceeded. This probably indicates that your
program has a type error. You should declare the types explicitly. (The
current limit is 60 iterations. You can use the
`--type-inference-iteration-limit' option to increase the limit).
-type_inf_loop.m:004: Inferred :- pred loop((pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred T1))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))).
For more information, recompile with `-E'.
Index: tests/invalid/typeclass_test_2.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/typeclass_test_2.err_exp,v
retrieving revision 1.12
diff -u -b -r1.12 typeclass_test_2.err_exp
--- tests/invalid/typeclass_test_2.err_exp 7 Sep 2006 05:51:34 -0000 1.12
+++ tests/invalid/typeclass_test_2.err_exp 11 Sep 2006 15:47:47 -0000
@@ -2,7 +2,7 @@
typeclass_test_2.m:023: Error: clause for function
typeclass_test_2.m:023: `typeclass_test_2.foo_type_num'/1
typeclass_test_2.m:023: without preceding `func' declaration.
+typeclass_test_2.m:023: Inferred :- func foo_type_num(T1) = int.
typeclass_test_2.m:010: In clause for predicate `main'/2:
typeclass_test_2.m:010: unsatisfiable typeclass constraint:
typeclass_test_2.m:010: `typeclass_test_2.numbered_type(int)'.
-typeclass_test_2.m:023: Inferred :- func foo_type_num(T1) = int.
Index: tests/invalid/typeclass_test_8.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/typeclass_test_8.err_exp,v
retrieving revision 1.10
diff -u -b -r1.10 typeclass_test_8.err_exp
--- tests/invalid/typeclass_test_8.err_exp 10 Sep 2006 23:39:16 -0000 1.10
+++ tests/invalid/typeclass_test_8.err_exp 12 Sep 2006 01:46:34 -0000
@@ -1,14 +1,15 @@
typeclass_test_8.m:004: In predicate `main'/2:
typeclass_test_8.m:004: type error: unsatisfied typeclass constraint:
typeclass_test_8.m:004: `typeclass_test_8.fooable(T)'
-typeclass_test_8.m:004: In predicate `typeclass_test_8.main'/2:
+typeclass_test_8.m:004: In predicate `main'/2:
typeclass_test_8.m:004: warning: unresolved polymorphism.
typeclass_test_8.m:004: The variable with an unbound type was:
typeclass_test_8.m:004: X: T
-typeclass_test_8.m:004: The unbound type variable(s) will be implicitly
-typeclass_test_8.m:004: bound to the builtin type `void'.
- The body of the clause contains a call to a polymorphic predicate,
- but I can't determine which version should be called,
- because the type variables listed above didn't get bound.
- (I ought to tell you which call caused the problem, but I'm afraid
- you'll have to work it out yourself. My apologies.)
+typeclass_test_8.m:004: The unbound type variable will be implicitly bound to
+typeclass_test_8.m:004: the builtin type `void'.
+typeclass_test_8.m:004: The body of the clause contains a call to a
+typeclass_test_8.m:004: polymorphic predicate, but I can't determine which
+typeclass_test_8.m:004: version should be called, because the type variables
+typeclass_test_8.m:004: listed above didn't get bound. (I ought to tell you
+typeclass_test_8.m:004: which call caused the problem, but I'm afraid you'll
+typeclass_test_8.m:004: have to work it out yourself. My apologies.)
Index: tests/invalid/types.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/types.err_exp,v
retrieving revision 1.16
diff -u -b -r1.16 types.err_exp
--- tests/invalid/types.err_exp 7 Sep 2006 05:51:34 -0000 1.16
+++ tests/invalid/types.err_exp 11 Sep 2006 15:47:49 -0000
@@ -24,6 +24,10 @@
types.m:014: In clause for predicate `q'/0:
types.m:014: error: wrong number of arguments (0; should be 1)
types.m:014: in call to predicate `p'.
+types.m:018: In clause for predicate `r'/0:
+types.m:018: error: undefined predicate `s'/0.
+types.m:020: In clause for predicate `a'/1:
+types.m:020: error: undefined predicate `b'/1.
types.m:039: In clause for predicate `bar'/1:
types.m:039: type error in unification of variable `X'
types.m:039: and constant `0'.
@@ -33,9 +37,5 @@
types.m:039: some [BarTypeParam_1]
types.m:039: X_2: BarTypeParam
types.m:050: Error: no clauses for predicate `bar2'/1.
-types.m:018: In clause for predicate `r'/0:
-types.m:018: error: undefined predicate `s'/0.
-types.m:020: In clause for predicate `a'/1:
-types.m:020: error: undefined predicate `b'/1.
types.m:048: Error: abstract declaration for type `types.t'/2 has no
types.m:048: corresponding definition.
Index: tests/invalid/unsatisfiable_constraint.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/unsatisfiable_constraint.err_exp,v
retrieving revision 1.7
diff -u -b -r1.7 unsatisfiable_constraint.err_exp
--- tests/invalid/unsatisfiable_constraint.err_exp 10 Sep 2006 23:39:17 -0000 1.7
+++ tests/invalid/unsatisfiable_constraint.err_exp 12 Sep 2006 01:46:40 -0000
@@ -3,15 +3,17 @@
unsatisfiable_constraint.m:038: `unsatisfiable_constraint.a(A, B, A, V_8)',
unsatisfiable_constraint.m:038: `unsatisfiable_constraint.a(A, B, C, V_14)',
unsatisfiable_constraint.m:038: `unsatisfiable_constraint.b(A, C)'
-unsatisfiable_constraint.m:038: In predicate `unsatisfiable_constraint.test'/1:
+unsatisfiable_constraint.m:038: In predicate `test'/1:
unsatisfiable_constraint.m:038: warning: unresolved polymorphism.
unsatisfiable_constraint.m:038: The variables with unbound types were:
unsatisfiable_constraint.m:038: C: C
unsatisfiable_constraint.m:038: B: A
-unsatisfiable_constraint.m:038: The unbound type variable(s) will be implicitly
+unsatisfiable_constraint.m:038: The unbound type variables will be implicitly
unsatisfiable_constraint.m:038: bound to the builtin type `void'.
- The body of the clause contains a call to a polymorphic predicate,
- but I can't determine which version should be called,
- because the type variables listed above didn't get bound.
- (I ought to tell you which call caused the problem, but I'm afraid
- you'll have to work it out yourself. My apologies.)
+unsatisfiable_constraint.m:038: The body of the clause contains a call to a
+unsatisfiable_constraint.m:038: polymorphic predicate, but I can't determine
+unsatisfiable_constraint.m:038: which version should be called, because the
+unsatisfiable_constraint.m:038: type variables listed above didn't get bound.
+unsatisfiable_constraint.m:038: (I ought to tell you which call caused the
+unsatisfiable_constraint.m:038: problem, but I'm afraid you'll have to work
+unsatisfiable_constraint.m:038: it out yourself. My apologies.)
cvs diff: Diffing tests/invalid/purity
Index: tests/invalid/purity/impure_func_t7.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/purity/impure_func_t7.err_exp,v
retrieving revision 1.5
diff -u -b -r1.5 impure_func_t7.err_exp
--- tests/invalid/purity/impure_func_t7.err_exp 14 Dec 2005 05:14:17 -0000 1.5
+++ tests/invalid/purity/impure_func_t7.err_exp 11 Sep 2006 15:48:03 -0000
@@ -1,7 +1,5 @@
impure_func_t7.m:029: Purity error: unification with expression was declared
impure_func_t7.m:029: impure, but expression was not a function call.
-impure_func_t7.m:029: Purity error: unification with expression was declared
-impure_func_t7.m:029: impure, but expression was not a function call.
impure_func_t7.m:037: Purity error: unification with expression was declared
impure_func_t7.m:037: impure, but expression was not a function call.
impure_func_t7.m:046: Purity error: unification with expression was declared
Index: tests/invalid/purity/purity.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/purity/purity.err_exp,v
retrieving revision 1.13
diff -u -b -r1.13 purity.err_exp
--- tests/invalid/purity/purity.err_exp 7 Sep 2006 05:51:42 -0000 1.13
+++ tests/invalid/purity/purity.err_exp 11 Sep 2006 15:48:08 -0000
@@ -1,28 +1,34 @@
-purity.m:050: In predicate `purity.w1'/0:
+purity.m:050: In predicate `w1'/0:
purity.m:050: warning: declared impure but actually pure.
-purity.m:054: In predicate `purity.w2'/0:
+purity.m:054: In predicate `w2'/0:
purity.m:054: warning: declared semipure but actually pure.
-purity.m:058: In predicate `purity.w3'/0:
+purity.m:058: In predicate `w3'/0:
purity.m:058: warning: declared impure but actually semipure.
-purity.m:062: In predicate `purity.w4'/0:
+purity.m:062: In predicate `w4'/0:
purity.m:062: warning: unnecessary `promise_pure' pragma.
-purity.m:067: In predicate `purity.w5'/0:
+purity.m:067: In predicate `w5'/0:
purity.m:067: error: declared impure but promised pure.
-purity.m:072: In predicate `purity.w6'/0:
+purity.m:072: In predicate `w6'/0:
purity.m:072: error: declared semipure but promised pure.
-purity.m:081: In predicate `purity.e1'/0:
+purity.m:081: In predicate `e1'/0:
purity.m:081: purity error: predicate is impure.
purity.m:081: It must be declared `impure' or promised pure.
-purity.m:086: In predicate `purity.e2'/0:
+purity.m:086: In predicate `e2'/0:
purity.m:086: purity error: predicate is semipure.
purity.m:086: It must be declared `semipure' or promised pure.
-purity.m:090: In predicate `purity.e3'/0:
+purity.m:090: In predicate `e3'/0:
purity.m:090: purity error: predicate is impure.
purity.m:090: It must be declared `impure' or promised semipure.
purity.m:096: In call to impure predicate `purity.imp'/0:
purity.m:096: purity error: call must be preceded by `impure' indicator.
purity.m:100: In call to semipure predicate `purity.semi'/0:
purity.m:100: purity error: call must be preceded by `semipure' indicator.
+purity.m:115: In unification predicate for type `e8':
+purity.m:115: purity error: predicate is impure.
+purity.m:115: It must be pure.
+purity.m:127: In unification predicate for type `e9':
+purity.m:127: purity error: predicate is semipure.
+purity.m:127: It must be pure.
purity.m:142: In call to impure predicate `purity.imp1'/1:
purity.m:142: purity error: call must be preceded by `impure' indicator.
purity.m:142: Purity error in closure: closure body is impure, but closure was
@@ -31,12 +37,6 @@
purity.m:148: purity error: call must be preceded by `semipure' indicator.
purity.m:148: Purity error in closure: closure body is semipure, but closure
purity.m:148: was not declared semipure.
-purity.m:115: In unification predicate for type `purity.e8':
-purity.m:115: purity error: predicate is impure.
-purity.m:115: It must be pure.
-purity.m:127: In unification predicate for type `purity.e9':
-purity.m:127: purity error: predicate is semipure.
-purity.m:127: It must be pure.
purity.m:105: In clause for `e6':
purity.m:105: in argument 1 of call to predicate `purity.in'/1:
purity.m:105: mode error: variable `X' has instantiatedness `free',
Index: tests/invalid/purity/purity_nonsense.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/purity/purity_nonsense.err_exp,v
retrieving revision 1.9
diff -u -b -r1.9 purity_nonsense.err_exp
--- tests/invalid/purity/purity_nonsense.err_exp 7 Sep 2006 05:51:42 -0000 1.9
+++ tests/invalid/purity/purity_nonsense.err_exp 11 Sep 2006 15:48:08 -0000
@@ -2,11 +2,8 @@
purity_nonsense.m:012: without preceding `pred' declaration.
purity_nonsense.m:013: Error: clause for predicate `purity_nonsense.e13'/0
purity_nonsense.m:013: without preceding `pred' declaration.
-purity_nonsense.m:018: In clause for predicate `e14'/1:
-purity_nonsense.m:018: in argument 1 (i.e. the predicate term) of impure
-purity_nonsense.m:018: higher-order predicate call:
-purity_nonsense.m:018: type error: variable `P' has type `(pred)',
-purity_nonsense.m:018: expected type was `(impure (pred))'.
+purity_nonsense.m:012: In clause for predicate `e12'/0:
+purity_nonsense.m:012: error: `impure' marker in an inappropriate place.
purity_nonsense.m:012: In clause for predicate `e12'/0:
purity_nonsense.m:012: in argument 1 of call to predicate `impure'/1:
purity_nonsense.m:012: error: the language construct `\+'/1 should be used as
@@ -21,8 +18,8 @@
purity_nonsense.m:012: in argument 1 of functor `\\+/1':
purity_nonsense.m:012: in argument 1 of functor `impure/1':
purity_nonsense.m:012: error: undefined symbol `imp/0'.
-purity_nonsense.m:012: In clause for predicate `e12'/0:
-purity_nonsense.m:012: error: `impure' marker in an inappropriate place.
+purity_nonsense.m:013: In clause for predicate `e13'/0:
+purity_nonsense.m:013: error: `semipure' marker in an inappropriate place.
purity_nonsense.m:013: In clause for predicate `e13'/0:
purity_nonsense.m:013: in argument 1 of call to predicate `semipure'/1:
purity_nonsense.m:013: error: the language construct `\+'/1 should be used as
@@ -37,6 +34,9 @@
purity_nonsense.m:013: in argument 1 of functor `\\+/1':
purity_nonsense.m:013: in argument 1 of functor `semipure/1':
purity_nonsense.m:013: error: undefined symbol `semi/0'.
-purity_nonsense.m:013: In clause for predicate `e13'/0:
-purity_nonsense.m:013: error: `semipure' marker in an inappropriate place.
+purity_nonsense.m:018: In clause for predicate `e14'/1:
+purity_nonsense.m:018: in argument 1 (i.e. the predicate term) of impure
+purity_nonsense.m:018: higher-order predicate call:
+purity_nonsense.m:018: type error: variable `P' has type `(pred)',
+purity_nonsense.m:018: expected type was `(impure (pred))'.
For more information, recompile with `-E'.
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.7
diff -u -b -r1.7 purity_type_error.err_exp
--- tests/invalid/purity/purity_type_error.err_exp 7 Sep 2006 05:51:42 -0000 1.7
+++ tests/invalid/purity/purity_type_error.err_exp 11 Sep 2006 15:48:10 -0000
@@ -6,5 +6,5 @@
purity_type_error.m:020: constant `1.00000000000000' has type `float'.
purity_type_error.m:020: The partial type assignment was:
purity_type_error.m:020: HeadVar__1_1: int
-purity_type_error.m:009: In predicate `purity_type_error.warn'/1:
+purity_type_error.m:009: In predicate `warn'/1:
purity_type_error.m:009: warning: declared impure but actually pure.
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
Index: tests/warnings/inference_test.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/warnings/inference_test.exp,v
retrieving revision 1.2
diff -u -b -r1.2 inference_test.exp
--- tests/warnings/inference_test.exp 17 Jan 2003 05:57:19 -0000 1.2
+++ tests/warnings/inference_test.exp 12 Sep 2006 04:12:21 -0000
@@ -1,5 +1,6 @@
inference_test.m:016: Inferred :- func len_func((list.list(T))) = int.
inference_test.m:019: Inferred :- pred len((list.list(T)), int).
inference_test.m:030: Inferred :- func int_zero = int.
-inference_test.m:032: Inferred :- pred unused_pred((list.list(T)), (list.list(T))) <= (inference_test.null(T)).
+inference_test.m:032: Inferred :- pred unused_pred((list.list(T)),
+inference_test.m:032: (list.list(T))) <= (inference_test.null(T)).
inference_test.m:019: Inferred :- mode len(in, out) is det.
Index: tests/warnings/purity_warnings.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/warnings/purity_warnings.exp,v
retrieving revision 1.6
diff -u -b -r1.6 purity_warnings.exp
--- tests/warnings/purity_warnings.exp 7 Sep 2006 05:51:47 -0000 1.6
+++ tests/warnings/purity_warnings.exp 12 Sep 2006 02:00:14 -0000
@@ -4,22 +4,22 @@
purity_warnings.m:022: In call to predicate `io.print'/3:
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: In predicate `impure_pred1'/2:
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: In predicate `impure_pred2'/2:
purity_warnings.m:028: warning: declared impure but actually semipure.
+purity_warnings.m:034: In predicate `semipure_pred'/2:
+purity_warnings.m:034: warning: declared semipure but actually pure.
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:060: In predicate `impure_method1a_impl'/2:
+purity_warnings.m:060: warning: declared impure but actually pure.
+purity_warnings.m:062: In predicate `semipure_method_a_impl'/2:
+purity_warnings.m:062: 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.
-purity_warnings.m:060: In predicate `purity_warnings.impure_method1a_impl'/2:
-purity_warnings.m:060: warning: declared impure but actually pure.
purity_warnings.m:071: In call to predicate `io.print'/3:
purity_warnings.m:071: warning: unnecessary `semipure' indicator.
purity_warnings.m:071: No purity indicator is necessary.
-purity_warnings.m:062: In predicate `purity_warnings.semipure_method_a_impl'/2:
-purity_warnings.m:062: warning: declared semipure but actually pure.
Index: tests/warnings/singleton_test.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/warnings/singleton_test.exp,v
retrieving revision 1.12
diff -u -b -r1.12 singleton_test.exp
--- tests/warnings/singleton_test.exp 7 Sep 2006 05:51:47 -0000 1.12
+++ tests/warnings/singleton_test.exp 12 Sep 2006 02:00:16 -0000
@@ -12,10 +12,10 @@
singleton_test.m:055: In the C code for predicate
singleton_test.m:055: `singleton_test.c_hello_world'/3:
singleton_test.m:055: warning: variable `Msg' does not occur in the C code.
-singleton_test.m:008: In function `singleton_test.my_append_func'/2:
+singleton_test.m:008: In function `my_append_func'/2:
singleton_test.m:008: warning: unresolved polymorphism.
singleton_test.m:008: The variables with unbound types were:
singleton_test.m:008: L2: V_1
singleton_test.m:008: L1: V_1
-singleton_test.m:008: The unbound type variable(s) will be implicitly
-singleton_test.m:008: bound to the builtin type `void'.
+singleton_test.m:008: The unbound type variables will be implicitly bound to
+singleton_test.m:008: the builtin type `void'.
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 messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list