[m-rev.] diff: more error message handling improvements
Zoltan Somogyi
zs at csse.unimelb.edu.au
Fri Oct 13 14:51:27 AEST 2006
Modify check_typeclass.m to gather up all error messages, and print them all
at once after sorting.
Modify the determinism analysis pass to generate error_specs directly, instead
of generating context_det_msgs and converting those to error_specs later.
Separate the simplify pass's mechanism for generating error messages from
the determinism pass.
compiler/check_typeclass.m:
Return all error messages instead of printing them when generated.
Keep the error messages outside the instance_method_info structure,
and give the fields of the structure names.
compiler/det_analysis.m:
Generate error specs directly.
compiler/det_report.m:
Delete the context_det_msg data type and the predicates that operated
on it, since they are no longer needed. The code that used to convert a
context_det_msg into an error_spec is now dispersed to the sites that
generate the error report in the first place. These sites are mostly
in det_analysis.m and simplify.m, with a few in other modules
(e.g. common.m and format_call.m). Export some auxiliary functions
that the these sites now need.
compiler/simplify.m:
Generate error_specs directly, instead of through context_det_msgs,
and return them to the caller for printing.
compiler/common.m:
compiler/format_call.m:
Conform to the change to det_report.m.
compiler/unused_import.m:
Return all error messages instead of printing them when generated.
compiler/mercury_compile.m:
Print the error message batches returned by the modified passes.
Use the version of globals in module_infos in preference to the one
in the I/O state, since we would like to phase out the latter.
Don't explicitly sort error_specs, since write_error_specs will do
it anyway.
compiler/error_util.m:
Separate the error messages of the simplify pass from those of
determinism analysis.
Provide a standard way to format type constructor names.
Require the calls to provide the globals when printing error_specs.
This is to allow callers to provide the globals from a module_info,
instead of the one in the I/O state.
compiler/passes_aux.m:
Provide support for passes that have lists of error_specs threaded
through them, as simplify now does.
Rename some predicates to avoid some ambiguities.
compiler/deforest.m:
compiler/pd_util.m:
compiler/unify_proc.m:
compiler/unused_args.m:
Conform to the change to the interface of determinism analysis.
compiler/inlining.m:
Do not thread the I/O state through this module.
compiler/make.module_dep_file.m:
compiler/make_hlds_passes.m:
compiler/ml_tailcall.m:
compiler/mode_errors.m:
compiler/modes.m:
compiler/modules.m:
compiler/stratify.m:
compiler/table_gen.m:
Conform to the change in error_util.
compiler/prog_data.m:
Rename some function symbols to avoid some ambiguities.
compiler/add_class.m:
compiler/base_typeclass_info.m:
compiler/hlds_out.m:
compiler/intermod.m:
compiler/module_qual.m:
compiler/prog_io_typeclass.m:
compiler/recompilation.check.m:
compiler/recompilation.usage.m:
compiler/recompilation.version.m:
compiler/type_class_info.m:
Conform to the change in prog_data.m.
tests/invalid/*err_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/add_class.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_class.m,v
retrieving revision 1.21
diff -u -b -r1.21 add_class.m
--- compiler/add_class.m 10 Sep 2006 23:38:57 -0000 1.21
+++ compiler/add_class.m 12 Oct 2006 08:00:31 -0000
@@ -83,9 +83,11 @@
list.length(Vars, ClassArity),
ClassId = class_id(Name, ClassArity),
Status = item_status(ImportStatus0, _),
- ( Interface = abstract ->
+ (
+ Interface = class_interface_abstract,
make_status_abstract(ImportStatus0, ImportStatus1)
;
+ Interface = class_interface_concrete(_),
ImportStatus1 = ImportStatus0
),
HLDSFunDeps = list.map(make_hlds_fundep(Vars), FunDeps),
@@ -99,11 +101,11 @@
OldVarSet, OldContext),
combine_status(ImportStatus1, OldStatus, ImportStatus),
(
- OldInterface = concrete(_),
+ OldInterface = class_interface_concrete(_),
ClassMethods0 = OldMethods,
ClassInterface = OldInterface
;
- OldInterface = abstract,
+ OldInterface = class_interface_abstract,
ClassMethods0 = [],
ClassInterface = Interface
),
@@ -127,8 +129,8 @@
Context, OldContext, Extras, !Specs),
ErrorOrPrevDef = yes
;
- Interface = concrete(_),
- OldInterface = concrete(_)
+ Interface = class_interface_concrete(_),
+ OldInterface = class_interface_concrete(_)
->
multiple_def_error(ImportStatus, Name, ClassArity,
"typeclass", Context, OldContext, [], !Specs),
@@ -148,7 +150,7 @@
(
ErrorOrPrevDef = no,
(
- Interface = concrete(Methods),
+ Interface = class_interface_concrete(Methods),
module_add_class_interface(Name, Vars, Methods,
Status, PredProcIds0, !ModuleInfo, !Specs),
% Get rid of the `no's from the list of maybes
@@ -163,7 +165,7 @@
% corresponding list of pred_proc_ids for instance definitions.
list.sort(PredProcIds1, ClassMethods)
;
- Interface = abstract,
+ Interface = class_interface_abstract,
ClassMethods = ClassMethods0
),
@@ -505,11 +507,11 @@
IsOverlapping = (pred((Context - OtherContext)::out) is nondet :-
NewInstanceDefn = hlds_instance_defn(_, _Status, Context,
_, Types, Body, _, VarSet, _),
- Body \= abstract, % XXX
+ Body = instance_body_concrete(_), % XXX
list.member(OtherInstanceDefn, InstanceDefns),
OtherInstanceDefn = hlds_instance_defn(_, _OtherStatus,
OtherContext, _, OtherTypes, OtherBody, _, OtherVarSet, _),
- OtherBody \= abstract, % XXX
+ OtherBody = instance_body_concrete(_), % XXX
tvarset_merge_renaming(VarSet, OtherVarSet, _NewVarSet, Renaming),
apply_variable_renaming_to_type_list(Renaming, OtherTypes,
NewOtherTypes),
@@ -539,7 +541,7 @@
!QualInfo, !Specs) :-
(
% Handle the `pred(<MethodName>/<Arity>) is <ImplName>' syntax.
- InstanceProcDefn = name(InstancePredName),
+ InstanceProcDefn = instance_proc_def_name(InstancePredName),
% Add the body of the introduced pred.
% First the goal info, ...
goal_info_init(GoalInfo0),
@@ -570,7 +572,7 @@
HeadVars, ClausesRep, RttiVarMaps, HasForeignClauses)
;
% Handle the arbitrary clauses syntax.
- InstanceProcDefn = clauses(InstanceClauses),
+ InstanceProcDefn = instance_proc_def_clauses(InstanceClauses),
clauses_info_init(PredArity, ClausesInfo0),
list.foldl4(
produce_instance_method_clause(PredOrFunc, Context, Status),
Index: compiler/base_typeclass_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/base_typeclass_info.m,v
retrieving revision 1.49
diff -u -b -r1.49 base_typeclass_info.m
--- compiler/base_typeclass_info.m 27 Sep 2006 06:16:46 -0000 1.49
+++ compiler/base_typeclass_info.m 12 Oct 2006 07:57:20 -0000
@@ -94,9 +94,9 @@
_TermContext, InstanceConstraints, InstanceTypes, Body,
PredProcIds, _Varset, _SuperClassProofs),
(
- Body = concrete(_),
- % Only make the base_typeclass_info if the instance
- % declaration originally came from _this_ module.
+ Body = instance_body_concrete(_),
+ % Only make the base_typeclass_info if the instance declaration
+ % originally came from _this_ module.
status_defined_in_this_module(ImportStatus) = yes
->
make_instance_string(InstanceTypes, InstanceString),
@@ -107,8 +107,8 @@
InstanceString, BaseTypeClassInfo),
!:RttiDataList = [RttiData | !.RttiDataList]
;
- % The instance decl is from another module,
- % or is abstract, so we don't bother including it.
+ % The instance decl is from another module, or is abstract,
+ % so we don't bother including it.
true
).
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.102
diff -u -b -r1.102 check_typeclass.m
--- compiler/check_typeclass.m 2 Oct 2006 05:21:08 -0000 1.102
+++ compiler/check_typeclass.m 12 Oct 2006 08:50:52 -0000
@@ -70,12 +70,14 @@
:- import_module hlds.
:- import_module hlds.hlds_module.
:- import_module hlds.make_hlds.
+:- import_module parse_tree.
+:- import_module parse_tree.error_util.
-:- import_module bool.
-:- import_module io.
+:- import_module list.
-:- pred check_typeclasses(make_hlds_qual_info::in, make_hlds_qual_info::out,
- module_info::in, module_info::out, bool::out, io::di, io::uo) is det.
+:- pred check_typeclasses(module_info::in, module_info::out,
+ make_hlds_qual_info::in, make_hlds_qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
@@ -96,8 +98,6 @@
:- import_module libs.options.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
-:- import_module parse_tree.
-:- import_module parse_tree.error_util.
:- import_module parse_tree.mercury_to_mercury.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_out.
@@ -106,7 +106,8 @@
:- import_module parse_tree.prog_util.
:- import_module assoc_list.
-:- import_module list.
+:- import_module bool.
+:- import_module io.
:- import_module map.
:- import_module maybe.
:- import_module multi_map.
@@ -122,93 +123,87 @@
%---------------------------------------------------------------------------%
-check_typeclasses(!QualInfo, !ModuleInfo, FoundError, !IO) :-
- globals.io_lookup_bool_option(verbose, Verbose, !IO),
- maybe_write_string(Verbose, "% Checking typeclass instances...\n", !IO),
- check_typeclass.check_instance_decls(!QualInfo, !ModuleInfo,
- FoundInstanceError, !IO),
+check_typeclasses(!ModuleInfo, !QualInfo, !Specs) :-
+ module_info_get_globals(!.ModuleInfo, Globals),
+ globals.lookup_bool_option(Globals, verbose, Verbose),
+ trace [io(!IO1)] (
+ maybe_write_string(Verbose, "% Checking typeclass instances...\n",
+ !IO1)
+ ),
+ check_instance_decls(!ModuleInfo, !QualInfo, !Specs),
- maybe_write_string(Verbose, "% Checking for cyclic classes...\n", !IO),
- check_for_cyclic_classes(!ModuleInfo, FoundCycleError, !IO),
+ trace [io(!IO2)] (
+ maybe_write_string(Verbose, "% Checking for cyclic classes...\n",
+ !IO2)
+ ),
+ check_for_cyclic_classes(!ModuleInfo, !Specs),
+ trace [io(!IO3)] (
maybe_write_string(Verbose,
- "% Checking for missing concrete instances...\n", !IO),
- check_for_missing_concrete_instances(!ModuleInfo, FoundMissingError, !IO),
+ "% Checking for missing concrete instances...\n", !IO3)
+ ),
+ check_for_missing_concrete_instances(!ModuleInfo, !Specs),
+ trace [io(!IO4)] (
maybe_write_string(Verbose,
- "% Checking functional dependencies on instances...\n", !IO),
- check_functional_dependencies(!ModuleInfo, FoundFunDepError, !IO),
-
- maybe_write_string(Verbose, "% Checking typeclass constraints...\n", !IO),
- check_constraints(!ModuleInfo, FoundConstraintsError, !IO),
+ "% Checking functional dependencies on instances...\n", !IO4)
+ ),
+ check_functional_dependencies(!ModuleInfo, !Specs),
- FoundError = bool.or_list([FoundInstanceError, FoundCycleError,
- FoundMissingError, FoundFunDepError, FoundConstraintsError]).
+ trace [io(!IO5)] (
+ maybe_write_string(Verbose, "% Checking typeclass constraints...\n",
+ !IO5)
+ ),
+ check_typeclass_constraints(!ModuleInfo, !Specs).
%---------------------------------------------------------------------------%
-:- type error_message == pair(prog_context, list(format_component)).
-:- type error_messages == list(error_message).
-
-:- pred check_instance_decls(make_hlds_qual_info::in, make_hlds_qual_info::out,
- module_info::in, module_info::out, bool::out, io::di, io::uo) is det.
+:- pred check_instance_decls(module_info::in, module_info::out,
+ make_hlds_qual_info::in, make_hlds_qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
-check_instance_decls(!QualInfo, !ModuleInfo, FoundError, !IO) :-
+check_instance_decls(!ModuleInfo, !QualInfo, !Specs) :-
module_info_get_class_table(!.ModuleInfo, ClassTable),
module_info_get_instance_table(!.ModuleInfo, InstanceTable0),
map.to_assoc_list(InstanceTable0, InstanceList0),
- list.map_foldl2(check_one_class(ClassTable), InstanceList0,
- InstanceList, check_tc_info([], !.ModuleInfo, !.QualInfo),
- check_tc_info(Errors, !:ModuleInfo, !:QualInfo), !IO),
+ list.map_foldl3(check_one_class(ClassTable), InstanceList0, InstanceList,
+ !ModuleInfo, !QualInfo, [], NewSpecs),
+ module_info_get_globals(!.ModuleInfo, Globals),
+ Errors = contains_errors(Globals, NewSpecs),
(
- Errors = [],
+ Errors = no,
map.from_assoc_list(InstanceList, InstanceTable),
- module_info_set_instance_table(InstanceTable, !ModuleInfo),
- FoundError = no
+ module_info_set_instance_table(InstanceTable, !ModuleInfo)
;
- Errors = [_ | _],
- list.reverse(Errors, ErrorList),
- WriteError = (pred(E::in, IO0::di, IO::uo) is det :-
- E = ErrorContext - ErrorPieces,
- write_error_pieces(ErrorContext, 0, ErrorPieces, IO0, IO)
- ),
- list.foldl(WriteError, ErrorList, !IO),
- io.set_exit_status(1, !IO),
- FoundError = yes
- ).
-
-:- type check_tc_info
- ---> check_tc_info(
- error_messages :: error_messages,
- module_info :: module_info,
- qual_info :: make_hlds_qual_info
- ).
+ Errors = yes
+ ),
+ !:Specs = NewSpecs ++ !.Specs.
% Check all the instances of one class.
%
:- pred check_one_class(class_table::in,
pair(class_id, list(hlds_instance_defn))::in,
pair(class_id, list(hlds_instance_defn))::out,
- check_tc_info::in, check_tc_info::out, io::di, io::uo) is det.
+ module_info::in, module_info::out,
+ make_hlds_qual_info::in, make_hlds_qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
-check_one_class(ClassTable, ClassId - InstanceDefns0,
- ClassId - InstanceDefns, !CheckTCInfo, !IO) :-
+check_one_class(ClassTable, ClassId - InstanceDefns0, ClassId - InstanceDefns,
+ !ModuleInfo, !QualInfo, !Specs) :-
map.lookup(ClassTable, ClassId, ClassDefn),
ClassDefn = hlds_class_defn(ImportStatus, SuperClasses, _FunDeps,
_Ancestors, ClassVars, _Kinds, Interface, ClassInterface,
ClassVarSet, TermContext),
(
status_defined_in_this_module(ImportStatus) = yes,
- Interface = abstract
+ Interface = class_interface_abstract
->
ClassId = class_id(ClassName, ClassArity),
- ErrorPieces = [
- words("Error: no definition for typeclass"),
- sym_name_and_arity(ClassName / ClassArity)
- ],
- Messages0 = !.CheckTCInfo ^ error_messages,
- !:CheckTCInfo = !.CheckTCInfo ^ error_messages :=
- [TermContext - ErrorPieces | Messages0],
+ Pieces = [words("Error: no definition for typeclass"),
+ sym_name_and_arity(ClassName / ClassArity), nl],
+ Msg = simple_msg(TermContext, [always(Pieces)]),
+ Spec = error_spec(severity_error, phase_type_check, [Msg]),
+ !:Specs = [Spec | !.Specs],
InstanceDefns = InstanceDefns0
;
solutions.solutions(
@@ -217,11 +212,11 @@
ClassProc = hlds_class_proc(PredId, _)
),
PredIds),
- list.map_foldl2(
+ list.map_foldl3(
check_class_instance(ClassId, SuperClasses, ClassVars,
ClassInterface, Interface, ClassVarSet, PredIds),
InstanceDefns0, InstanceDefns,
- !CheckTCInfo, !IO)
+ !ModuleInfo, !QualInfo, !Specs)
).
% Check one instance of one class.
@@ -230,64 +225,57 @@
list(tvar)::in, hlds_class_interface::in, class_interface::in,
tvarset::in, list(pred_id)::in,
hlds_instance_defn::in, hlds_instance_defn::out,
- check_tc_info::in, check_tc_info::out,
- io::di, io::uo) is det.
+ module_info::in, module_info::out,
+ make_hlds_qual_info::in, make_hlds_qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
check_class_instance(ClassId, SuperClasses, Vars, HLDSClassInterface,
ClassInterface, ClassVarSet, PredIds, !InstanceDefn,
- check_tc_info(Errors0, ModuleInfo0, QualInfo0),
- check_tc_info(Errors, ModuleInfo, QualInfo),
- !IO):-
+ !ModuleInfo, !QualInfo, !Specs):-
% Check conformance of the instance body.
!.InstanceDefn = hlds_instance_defn(_, _, TermContext, _, _,
InstanceBody, _, _, _),
(
- InstanceBody = abstract,
- ModuleInfo = ModuleInfo0,
- QualInfo = QualInfo0,
- Errors1 = Errors0
+ InstanceBody = instance_body_abstract
;
- InstanceBody = concrete(InstanceMethods),
+ InstanceBody = instance_body_concrete(InstanceMethods),
check_concrete_class_instance(ClassId, Vars,
HLDSClassInterface, ClassInterface,
PredIds, TermContext, InstanceMethods,
- !InstanceDefn, Errors0, Errors1,
- ModuleInfo0, ModuleInfo, QualInfo0, QualInfo, !IO)
+ !InstanceDefn, !ModuleInfo, !QualInfo, !Specs)
),
- % Check that the superclass constraints are satisfied for the
- % types in this instance declaration.
+ % Check that the superclass constraints are satisfied for the types
+ % in this instance declaration.
check_superclass_conformance(ClassId, SuperClasses, Vars, ClassVarSet,
- ModuleInfo, !InstanceDefn, Errors1, Errors).
+ !.ModuleInfo, !InstanceDefn, !Specs).
:- pred check_concrete_class_instance(class_id::in, list(tvar)::in,
hlds_class_interface::in, class_interface::in,
list(pred_id)::in, term.context::in,
instance_methods::in, hlds_instance_defn::in, hlds_instance_defn::out,
- error_messages::in, error_messages::out,
module_info::in, module_info::out,
- make_hlds_qual_info::in, make_hlds_qual_info::out, io::di, io::uo) is det.
+ make_hlds_qual_info::in, make_hlds_qual_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
check_concrete_class_instance(ClassId, Vars, HLDSClassInterface,
ClassInterface, PredIds, TermContext, InstanceMethods, !InstanceDefn,
- !Errors, !ModuleInfo, !QualInfo, !IO) :-
+ !ModuleInfo, !QualInfo, !Specs) :-
(
- ClassInterface = abstract,
+ ClassInterface = class_interface_abstract,
ClassId = class_id(ClassName, ClassArity),
- ErrorPieces = [
- words("Error: instance declaration for"),
- words("abstract typeclass"),
- sym_name_and_arity(ClassName / ClassArity),
- suffix(".")
- ],
- !:Errors = [TermContext - ErrorPieces | !.Errors]
+ Pieces = [words("Error: instance declaration for abstract typeclass"),
+ sym_name_and_arity(ClassName / ClassArity), suffix("."), nl],
+ Msg = simple_msg(TermContext, [always(Pieces)]),
+ Spec = error_spec(severity_error, phase_type_check, [Msg]),
+ !:Specs = [Spec | !.Specs]
;
- ClassInterface = concrete(_),
+ ClassInterface = class_interface_concrete(_),
InstanceCheckInfo0 = instance_check_info(!.InstanceDefn,
- [], !.Errors, !.ModuleInfo, !.QualInfo),
+ [], !.ModuleInfo, !.QualInfo),
list.foldl2(check_instance_pred(ClassId, Vars, HLDSClassInterface),
- PredIds, InstanceCheckInfo0, InstanceCheckInfo, !IO),
+ PredIds, InstanceCheckInfo0, InstanceCheckInfo, !Specs),
InstanceCheckInfo = instance_check_info(!:InstanceDefn,
- RevInstanceMethods, !:Errors, !:ModuleInfo, !:QualInfo),
+ RevInstanceMethods, !:ModuleInfo, !:QualInfo),
% We need to make sure that the MaybePredProcs field is set to yes(_)
% after this pass. Normally that will be handled by
@@ -309,13 +297,13 @@
!:InstanceDefn = !.InstanceDefn ^ instance_hlds_interface
:= MaybePredProcs,
!:InstanceDefn = !.InstanceDefn ^ instance_body
- := concrete(OrderedInstanceMethods),
+ := instance_body_concrete(OrderedInstanceMethods),
% Check if there are any instance methods left over, which did not
% match any of the methods from the class interface.
Context = !.InstanceDefn ^ instance_context,
check_for_bogus_methods(InstanceMethods, ClassId, PredIds,
- Context, !.ModuleInfo, !Errors)
+ Context, !.ModuleInfo, !Specs)
).
% Check if there are any instance methods left over, which did not match
@@ -324,10 +312,10 @@
%
:- pred check_for_bogus_methods(instance_methods::in, class_id::in,
list(pred_id)::in, prog_context::in, module_info::in,
- error_messages::in, error_messages::out) is det.
+ list(error_spec)::in, list(error_spec)::out) is det.
check_for_bogus_methods(InstanceMethods, ClassId, ClassPredIds, Context,
- ModuleInfo, !Errors) :-
+ ModuleInfo, !Specs) :-
module_info_get_predicate_table(ModuleInfo, PredTable),
DefnIsOK = (pred(Method::in) is semidet :-
% Find this method definition's p/f, name, arity
@@ -362,8 +350,10 @@
ErrorMsgBody0 = list.map(format_method_name, BogusInstanceMethods),
ErrorMsgBody1 = list.condense(ErrorMsgBody0),
ErrorMsgBody = list.append(ErrorMsgBody1, [suffix(".")]),
- NewError = Context - ( ErrorMsgStart ++ ErrorMsgBody ),
- !:Errors = [NewError | !.Errors]
+ Pieces = ErrorMsgStart ++ ErrorMsgBody,
+ Msg = simple_msg(Context, [always(Pieces)]),
+ Spec = error_spec(severity_error, phase_type_check, [Msg]),
+ !:Specs = [Spec | !.Specs]
).
:- func format_method_name(instance_method) = format_components.
@@ -381,7 +371,6 @@
instance_methods, % The instance methods in reverse
% order of the methods in the class
% declaration.
- error_messages,
module_info,
make_hlds_qual_info
).
@@ -390,26 +379,35 @@
% method.
:- type instance_method_info
---> instance_method_info(
- module_info,
- make_hlds_qual_info,
- sym_name, % Name that the introduced pred
- % should be given.
- arity, % Arity of the method.
- % (For funcs, this is
- % the original arity,
- % not the arity as a
- % predicate.)
- existq_tvars, % Existentially quantified
- % type variables.
- list(mer_type), % Expected types of arguments.
- prog_constraints, % Constraints from class method.
- list(modes_and_detism), % Modes and determinisms of the
- % required procs.
- error_messages, % Error messages that have been
- % generated.
- tvarset,
- import_status, % Import status of instance decl.
- pred_or_func % Is method pred or func?
+ im_module_info :: module_info,
+ im_qual_info :: make_hlds_qual_info,
+
+ % Name that the introduced pred should be given.
+ im_introduced_pred_name :: sym_name,
+
+ % Arity of the method. (For funcs, this is the original arity,
+ % not the arity as a predicate.)
+ im_method_arity :: arity,
+
+ % Existentially quantified type variables.
+ im_existq_tvars :: existq_tvars,
+
+ % Expected types of arguments.
+ im_expected_arg_types :: list(mer_type),
+
+ % Constraints from class method.
+ im_method_constraints :: prog_constraints,
+
+ % Modes and determinisms of the required procs.
+ im_modes_and_detism :: list(modes_and_detism),
+
+ im_tvarset :: tvarset,
+
+ % Import status of instance decl.
+ im_import_status :: import_status,
+
+ % Is method pred or func?
+ im_pred_or_func :: pred_or_func
).
%----------------------------------------------------------------------------%
@@ -418,12 +416,13 @@
%
:- pred check_instance_pred(class_id::in, list(tvar)::in,
hlds_class_interface::in, pred_id::in,
- instance_check_info::in, instance_check_info::out, io::di, io::uo) is det.
+ instance_check_info::in, instance_check_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
check_instance_pred(ClassId, ClassVars, ClassInterface, PredId,
- !InstanceCheckInfo, !IO) :-
+ !InstanceCheckInfo, !Specs) :-
!.InstanceCheckInfo = instance_check_info(InstanceDefn0,
- OrderedMethods0, Errors0, ModuleInfo0, QualInfo0),
+ OrderedMethods0, ModuleInfo0, QualInfo0),
solutions.solutions((pred(ProcId::out) is nondet :-
list.member(ClassProc, ClassInterface),
ClassProc = hlds_class_proc(PredId, ProcId)
@@ -473,18 +472,18 @@
MethodInfo0 = instance_method_info(ModuleInfo0, QualInfo0, PredName,
Arity, ExistQVars, ArgTypes, ClassContext, ArgModes,
- Errors0, ArgTypeVars, Status, PredOrFunc),
+ ArgTypeVars, Status, PredOrFunc),
check_instance_pred_procs(ClassId, ClassVars, MethodName, Markers,
InstanceDefn0, InstanceDefn, OrderedMethods0, OrderedMethods,
- MethodInfo0, MethodInfo, !IO),
+ MethodInfo0, MethodInfo, !Specs),
MethodInfo = instance_method_info(ModuleInfo, QualInfo, _PredName,
_Arity, _ExistQVars, _ArgTypes, _ClassContext, _ArgModes,
- Errors, _ArgTypeVars, _Status, _PredOrFunc),
+ _ArgTypeVars, _Status, _PredOrFunc),
!:InstanceCheckInfo = instance_check_info(InstanceDefn,
- OrderedMethods, Errors, ModuleInfo, QualInfo).
+ OrderedMethods, ModuleInfo, QualInfo).
:- type modes_and_detism
---> modes_and_detism(
@@ -497,17 +496,17 @@
pred_markers::in, hlds_instance_defn::in, hlds_instance_defn::out,
instance_methods::in, instance_methods::out,
instance_method_info::in, instance_method_info::out,
- io::di, io::uo) is det.
+ list(error_spec)::in, list(error_spec)::out) is det.
check_instance_pred_procs(ClassId, ClassVars, MethodName, Markers,
InstanceDefn0, InstanceDefn, OrderedInstanceMethods0,
- OrderedInstanceMethods, Info0, Info, !IO) :-
- InstanceDefn0 = hlds_instance_defn(InstanceModuleName, B,
+ OrderedInstanceMethods, !Info, !Specs) :-
+ InstanceDefn0 = hlds_instance_defn(InstanceModuleName, InstanceStatus,
InstanceContext, InstanceConstraints, InstanceTypes,
- InstanceBody, MaybeInstancePredProcs, InstanceVarSet, I),
- Info0 = instance_method_info(ModuleInfo, QualInfo, PredName, Arity,
- ExistQVars, ArgTypes, ClassContext, ArgModes, Errors0,
- ArgTypeVars, Status, PredOrFunc),
+ InstanceBody, MaybeInstancePredProcs, InstanceVarSet, InstanceProofs),
+ !.Info = instance_method_info(_ModuleInfo, _QualInfo, _PredName, Arity,
+ _ExistQVars, _ArgTypes, _ClassContext, _ArgModes, _ArgTypeVars,
+ _Status, PredOrFunc),
get_matching_instance_defns(InstanceBody, PredOrFunc, MethodName,
Arity, MatchingInstanceMethods),
(
@@ -518,10 +517,7 @@
InstanceTypes, InstanceConstraints,
InstanceVarSet, InstanceModuleName,
InstancePredDefn, Context,
- InstancePredId, InstanceProcIds, Info0, Info, [], Specs),
- % XXX _NumErrors
- write_error_specs(Specs, 0, _NumWarnings, 0, _NumErrors, !IO),
-
+ InstancePredId, InstanceProcIds, !Info, !Specs),
MakeClassProc = (pred(TheProcId::in, PredProcId::out) is det :-
PredProcId = hlds_class_proc(InstancePredId, TheProcId)
),
@@ -533,11 +529,12 @@
MaybeInstancePredProcs = no,
InstancePredProcs = InstancePredProcs1
),
- InstanceDefn = hlds_instance_defn(InstanceModuleName, B,
+ InstanceDefn = hlds_instance_defn(InstanceModuleName, InstanceStatus,
Context, InstanceConstraints, InstanceTypes,
- InstanceBody, yes(InstancePredProcs), InstanceVarSet, I)
+ InstanceBody, yes(InstancePredProcs), InstanceVarSet,
+ InstanceProofs)
;
- MatchingInstanceMethods = [I1, I2 | Is],
+ MatchingInstanceMethods = [Instance1, Instance2 | LaterInstances],
% Duplicate method definition error.
OrderedInstanceMethods = OrderedInstanceMethods0,
InstanceDefn = InstanceDefn0,
@@ -545,29 +542,28 @@
ClassNameString = sym_name_to_string(ClassName),
InstanceTypesString = mercury_type_list_to_string(InstanceVarSet,
InstanceTypes),
- ErrorHeaderPieces =
+ HeaderPieces =
[words("In instance declaration for"),
- fixed("`" ++ ClassNameString ++ "'("
- ++ InstanceTypesString ++ "):"),
+ words("`" ++ ClassNameString ++
+ "(" ++ InstanceTypesString ++ ")':"),
words("multiple implementations of type class"),
p_or_f(PredOrFunc), words("method"),
- sym_name_and_arity(MethodName / Arity), suffix(".")],
- I1 = instance_method(_, _, _, _, I1Context),
- Heading =
- [I1Context - [words("First definition appears here.")],
- InstanceContext - ErrorHeaderPieces],
- list.map((pred(Definition::in, ContextAndError::out) is det :-
- Definition = instance_method(_, _, _, _, TheContext),
- Error = [words("Subsequent definition appears here.")],
- ContextAndError = TheContext - Error
- ), [I2 | Is], SubsequentErrors),
-
- % Errors are built up in reverse.
- list.append(SubsequentErrors, Heading, NewErrors),
- list.append(NewErrors, Errors0, Errors),
- Info = instance_method_info(ModuleInfo, QualInfo, PredName, Arity,
- ExistQVars, ArgTypes, ClassContext, ArgModes, Errors, ArgTypeVars,
- Status, PredOrFunc)
+ sym_name_and_arity(MethodName / Arity), suffix("."), nl],
+ HeadingMsg = simple_msg(InstanceContext, [always(HeaderPieces)]),
+ Instance1Context = Instance1 ^ instance_method_decl_context,
+ FirstPieces = [words("First definition appears here."), nl],
+ FirstMsg = simple_msg(Instance1Context, [always(FirstPieces)]),
+ DefnToMsg = (pred(Definition::in, Msg::out) is det :-
+ TheContext = Definition ^ instance_method_decl_context,
+ SubsequentPieces =
+ [words("Subsequent definition appears here."), nl],
+ Msg = simple_msg(TheContext, [always(SubsequentPieces)])
+ ),
+ list.map(DefnToMsg, [Instance2 | LaterInstances], LaterMsgs),
+
+ Spec = error_spec(severity_error, phase_type_check,
+ [HeadingMsg, FirstMsg | LaterMsgs]),
+ !:Specs = [Spec | !.Specs]
;
MatchingInstanceMethods = [],
% Undefined method error.
@@ -578,17 +574,16 @@
InstanceTypesString = mercury_type_list_to_string(InstanceVarSet,
InstanceTypes),
- Error = [words("In instance declaration for"),
- quote(ClassNameString ++ "(" ++ InstanceTypesString ++ ")"),
+ Pieces = [words("In instance declaration for"),
+ words("`" ++ ClassNameString ++
+ "(" ++ InstanceTypesString ++ ")'"),
suffix(":"),
words("no implementation for type class"), p_or_f(PredOrFunc),
words("method"), sym_name_and_arity(MethodName / Arity),
- suffix(".")
- ],
- Errors = [InstanceContext - Error | Errors0],
- Info = instance_method_info(ModuleInfo, QualInfo, PredName,
- Arity, ExistQVars, ArgTypes, ClassContext,
- ArgModes, Errors, ArgTypeVars, Status, PredOrFunc)
+ suffix("."), nl],
+ Msg = simple_msg(InstanceContext, [always(Pieces)]),
+ Spec = error_spec(severity_error, phase_type_check, [Msg]),
+ !:Specs = [Spec | !.Specs]
).
% Get all the instance definitions which match the specified
@@ -598,9 +593,9 @@
:- pred get_matching_instance_defns(instance_body::in, pred_or_func::in,
sym_name::in, arity::in, instance_methods::out) is det.
-get_matching_instance_defns(abstract, _, _, _, []).
-get_matching_instance_defns(concrete(InstanceMethods), PredOrFunc, MethodName,
- MethodArity, ResultList) :-
+get_matching_instance_defns(instance_body_abstract, _, _, _, []).
+get_matching_instance_defns(instance_body_concrete(InstanceMethods),
+ PredOrFunc, MethodName, MethodArity, ResultList) :-
% First find the instance method definitions that match this
% predicate/function's name and arity
list.filter(
@@ -611,10 +606,12 @@
InstanceMethods, MatchingMethods),
(
MatchingMethods = [First, _Second | _],
- First = instance_method(_, _, _, _, FirstContext),
+ FirstContext = First ^ instance_method_decl_context,
\+ (
list.member(DefnViaName, MatchingMethods),
- DefnViaName = instance_method(_, _, name(_), _, _)
+ DefnViaName = instance_method(_, _, InstanceProcDef, _, _),
+ InstanceProcDef = DefnViaName ^ instance_method_proc_def,
+ InstanceProcDef = instance_proc_def_name(_)
)
->
% If all of the instance method definitions for this pred/func
@@ -622,12 +619,13 @@
% combine them all into a single definition.
MethodToClause = (pred(Method::in, Clauses::out) is semidet :-
Method = instance_method(_, _, Defn, _, _),
- Defn = clauses(Clauses)
+ Defn = instance_proc_def_clauses(Clauses)
),
list.filter_map(MethodToClause, MatchingMethods, ClausesList),
list.condense(ClausesList, FlattenedClauses),
CombinedMethod = instance_method(PredOrFunc, MethodName,
- clauses(FlattenedClauses), MethodArity, FirstContext),
+ instance_proc_def_clauses(FlattenedClauses), MethodArity,
+ FirstContext),
ResultList = [CombinedMethod]
;
% If there are less than two matching method definitions,
@@ -650,7 +648,7 @@
Info0 = instance_method_info(ModuleInfo0, QualInfo0, PredName,
Arity, ExistQVars0, ArgTypes0, ClassMethodClassContext0,
- ArgModes, Errors, TVarSet0, Status0, PredOrFunc),
+ ArgModes, TVarSet0, Status0, PredOrFunc),
% Rename the instance variables apart from the class variables.
tvarset_merge_renaming(TVarSet0, InstanceVarSet, TVarSet1, Renaming),
@@ -700,13 +698,15 @@
map.init(Proofs),
map.init(ConstraintMap),
add_marker(marker_class_instance_method, Markers0, Markers1),
- ( InstancePredDefn = name(_) ->
+ (
+ InstancePredDefn = instance_proc_def_name(_),
% For instance methods which are defined using the named syntax
% (e.g. "pred(...) is ...") rather than the clauses syntax, we record
% an additional marker; the only effect of this marker is that we
% output slightly different error messages for such predicates.
add_marker(marker_named_class_instance_method, Markers1, Markers)
;
+ InstancePredDefn = instance_proc_def_clauses(_),
Markers = Markers1
),
@@ -754,8 +754,8 @@
module_info_set_predicate_table(PredicateTable, ModuleInfo1, ModuleInfo),
Info = instance_method_info(ModuleInfo, QualInfo, PredName, Arity,
- ExistQVars, ArgTypes, ClassContext, ArgModes, Errors,
- TVarSet, Status, PredOrFunc).
+ ExistQVars, ArgTypes, ClassContext, ArgModes, TVarSet, Status,
+ PredOrFunc).
%---------------------------------------------------------------------------%
@@ -799,10 +799,10 @@
:- pred check_superclass_conformance(class_id::in, list(prog_constraint)::in,
list(tvar)::in, tvarset::in, module_info::in,
hlds_instance_defn::in, hlds_instance_defn::out,
- error_messages::in, error_messages::out) is det.
+ list(error_spec)::in, list(error_spec)::out) is det.
check_superclass_conformance(ClassId, ProgSuperClasses0, ClassVars0,
- ClassVarSet, ModuleInfo, InstanceDefn0, InstanceDefn, !Errors) :-
+ ClassVarSet, ModuleInfo, InstanceDefn0, InstanceDefn, !Specs) :-
InstanceDefn0 = hlds_instance_defn(A, B, Context, InstanceProgConstraints,
InstanceTypes, F, G, InstanceVarSet0, Proofs0),
@@ -853,20 +853,22 @@
InstanceProgConstraints, InstanceTypes, F, G,
InstanceVarSet2, Proofs1)
;
- UnprovenConstraints = [_ | _],
+ UnprovenConstraints = [_ | UnprovenConstraintsTail],
ClassId = class_id(ClassName, _ClassArity),
ClassNameString = sym_name_to_string(ClassName),
InstanceTypesString = mercury_type_list_to_string(InstanceVarSet2,
InstanceTypes),
constraint_list_to_string(ClassVarSet, UnprovenConstraints,
ConstraintsString),
- string.append_list([
- "In instance declaration for `",
- ClassNameString, "(", InstanceTypesString, ")': ",
- "superclass constraint(s) not satisfied: ",
- ConstraintsString, "."],
- NewError),
- !:Errors = [Context - [words(NewError)] | !.Errors],
+ Pieces = [words("In instance declaration for"),
+ words("`" ++ ClassNameString ++ "(" ++ InstanceTypesString ++ ")'"),
+ words(choose_number(UnprovenConstraintsTail,
+ "superclass constraint", "superclass constraints")),
+ words("not satisfied:"), words(ConstraintsString), suffix("."),
+ nl],
+ Msg = simple_msg(Context, [always(Pieces)]),
+ Spec = error_spec(severity_error, phase_type_check, [Msg]),
+ !:Specs = [Spec | !.Specs],
InstanceDefn = InstanceDefn0
).
@@ -895,17 +897,17 @@
% Check that every abstract instance in the interface of a module
% has a corresponding concrete instance in the implementation.
%
-:- pred check_for_missing_concrete_instances(
- module_info::in, module_info::out, bool::out, io::di, io::uo) is det.
+:- pred check_for_missing_concrete_instances(module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
-check_for_missing_concrete_instances(!ModuleInfo, FoundError, !IO) :-
+check_for_missing_concrete_instances(!ModuleInfo, !Specs) :-
module_info_get_instance_table(!.ModuleInfo, InstanceTable),
% Grab all the abstract instance declarations in the interface of this
% module and all the concrete instances defined in the implementation.
gather_abstract_and_concrete_instances(InstanceTable,
AbstractInstances, ConcreteInstances),
- map.foldl2(check_for_corresponding_instances(ConcreteInstances),
- AbstractInstances, no, FoundError, !IO).
+ map.foldl(check_for_corresponding_instances(ConcreteInstances),
+ AbstractInstances, !Specs).
% gather_abstract_and_concrete_instances(Table,
% AbstractInstances, ConcreteInstances).
@@ -949,7 +951,7 @@
IsImported = no,
Body = InstanceDefn ^ instance_body,
(
- Body = abstract,
+ Body = instance_body_abstract,
IsExported = status_is_exported_to_non_submodules(ImportStatus),
(
IsExported = yes,
@@ -958,7 +960,7 @@
IsExported = no
)
;
- Body = concrete(_),
+ Body = instance_body_concrete(_),
svmulti_map.add(ClassId, InstanceDefn, !Concretes)
)
;
@@ -966,19 +968,20 @@
).
:- pred check_for_corresponding_instances(instance_table::in,
- class_id::in, list(hlds_instance_defn)::in, bool::in, bool::out,
- io::di, io::uo) is det.
+ class_id::in, list(hlds_instance_defn)::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
check_for_corresponding_instances(Concretes, ClassId, InstanceDefns,
- !FoundError, !IO) :-
- list.foldl2(check_for_corresponding_instances_2(Concretes, ClassId),
- InstanceDefns, !FoundError, !IO).
+ !Specs) :-
+ list.foldl(check_for_corresponding_instances_2(Concretes, ClassId),
+ InstanceDefns, !Specs).
:- pred check_for_corresponding_instances_2(instance_table::in, class_id::in,
- hlds_instance_defn::in, bool::in, bool::out, io::di, io::uo) is det.
+ hlds_instance_defn::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
check_for_corresponding_instances_2(Concretes, ClassId, AbstractInstance,
- !FoundError, !IO) :-
+ !Specs) :-
AbstractTypes = AbstractInstance ^ instance_types,
( multi_map.search(Concretes, ClassId, ConcreteInstances) ->
(
@@ -998,15 +1001,13 @@
),
(
MissingConcreteError = yes,
- !:FoundError = yes,
ClassId = class_id(ClassName, _),
ClassNameString = sym_name_to_string(ClassName),
AbstractTypesString = mercury_type_list_to_string(
AbstractInstance ^ instance_tvarset, AbstractTypes),
AbstractInstanceName = ClassNameString ++
"(" ++ AbstractTypesString ++ ")",
- % XXX Should we mention any constraints on the instance
- % declaration here?
+ % XXX Should we mention any constraints on the instance declaration?
Pieces = [words("Error: abstract instance declaration"),
words("for"), quote(AbstractInstanceName),
words("has no corresponding concrete"),
@@ -1014,8 +1015,7 @@
AbstractInstanceContext = AbstractInstance ^ instance_context,
Msg = simple_msg(AbstractInstanceContext, [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]
;
MissingConcreteError = no
).
@@ -1027,22 +1027,15 @@
% of ancestors with functional dependencies for each class, and enter
% this information in the class table.
%
-:- pred check_for_cyclic_classes(module_info::in, module_info::out, bool::out,
- io::di, io::uo) is det.
+:- pred check_for_cyclic_classes(module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
-check_for_cyclic_classes(!ModuleInfo, Errors, !IO) :-
+check_for_cyclic_classes(!ModuleInfo, !Specs) :-
module_info_get_class_table(!.ModuleInfo, ClassTable0),
ClassIds = map.keys(ClassTable0),
foldl3(find_cycles([]), ClassIds, ClassTable0, ClassTable, set.init, _,
[], Cycles),
- (
- Cycles = [],
- Errors = no
- ;
- Cycles = [_ | _],
- Errors = yes,
- foldl(report_cyclic_classes(ClassTable), Cycles, !IO)
- ),
+ !:Specs = list.map(report_cyclic_classes(ClassTable), Cycles) ++ !.Specs,
module_info_set_class_table(ClassTable, !ModuleInfo).
:- type class_path == list(class_id).
@@ -1120,8 +1113,7 @@
find_cycles_2(Path, ClassId, Params, NewAncestors0, !ClassTable,
!Visited, !Cycles),
map.from_corresponding_lists(Params, Args, Binding),
- apply_subst_to_prog_constraint_list(Binding, NewAncestors0,
- NewAncestors),
+ apply_subst_to_prog_constraint_list(Binding, NewAncestors0, NewAncestors),
list.append(NewAncestors, !Ancestors).
% find_cycle(ClassId, PathRemaining, PathSoFar, Cycle):
@@ -1147,10 +1139,9 @@
% module.m:NNN: Error: cyclic superclass relation detected:
% module.m:NNN: `foo/N' <= `bar/N' <= `baz/N' <= `foo/N'
%
-:- pred report_cyclic_classes(class_table::in, class_path::in, io::di, io::uo)
- is det.
+:- func report_cyclic_classes(class_table, class_path) = error_spec.
-report_cyclic_classes(ClassTable, ClassPath, !IO) :-
+report_cyclic_classes(ClassTable, ClassPath) = Spec :-
(
ClassPath = [],
unexpected(this_file, "report_cyclic_classes: empty cycle found.")
@@ -1163,9 +1154,7 @@
RevPieces = foldl(add_path_element, Tail, RevPieces0),
Pieces = list.reverse(RevPieces),
Msg = simple_msg(Context, [always(Pieces)]),
- Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
- % XXX _NumErrors
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO)
+ Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg])
).
:- func add_path_element(class_id, list(format_component))
@@ -1191,46 +1180,45 @@
% arguments.
%
:- pred check_functional_dependencies(module_info::in, module_info::out,
- bool::out, io::di, io::uo) is det.
+ list(error_spec)::in, list(error_spec)::out) is det.
-check_functional_dependencies(!ModuleInfo, FoundError, !IO) :-
+check_functional_dependencies(!ModuleInfo, !Specs) :-
module_info_get_instance_table(!.ModuleInfo, InstanceTable),
map.keys(InstanceTable, ClassIds),
- list.foldl3(check_fundeps_class, ClassIds, !ModuleInfo, no, FoundError,
- !IO).
+ list.foldl2(check_fundeps_class, ClassIds, !ModuleInfo, !Specs).
:- pred check_fundeps_class(class_id::in, module_info::in, module_info::out,
- bool::in, bool::out, io::di, io::uo) is det.
+ list(error_spec)::in, list(error_spec)::out) is det.
-check_fundeps_class(ClassId, !ModuleInfo, !FoundError, !IO) :-
+check_fundeps_class(ClassId, !ModuleInfo, !Specs) :-
module_info_get_class_table(!.ModuleInfo, ClassTable),
map.lookup(ClassTable, ClassId, ClassDefn),
module_info_get_instance_table(!.ModuleInfo, InstanceTable),
map.lookup(InstanceTable, ClassId, InstanceDefns),
FunDeps = ClassDefn ^ class_fundeps,
check_range_restrictedness(ClassId, InstanceDefns, FunDeps,
- !ModuleInfo, !FoundError, !IO),
+ !ModuleInfo, !Specs),
check_consistency(ClassId, ClassDefn, InstanceDefns, FunDeps,
- !ModuleInfo, !FoundError, !IO).
+ !ModuleInfo, !Specs).
:- pred check_range_restrictedness(class_id::in, list(hlds_instance_defn)::in,
hlds_class_fundeps::in, module_info::in, module_info::out,
- bool::in, bool::out, io::di, io::uo) is det.
+ list(error_spec)::in, list(error_spec)::out) is det.
-check_range_restrictedness(_, [], _, !ModuleInfo, !FoundError, !IO).
+check_range_restrictedness(_, [], _, !ModuleInfo, !Specs).
check_range_restrictedness(ClassId, [InstanceDefn | InstanceDefns], FunDeps,
- !ModuleInfo, !FoundError, !IO) :-
- list.foldl3(check_range_restrictedness_2(ClassId, InstanceDefn),
- FunDeps, !ModuleInfo, !FoundError, !IO),
+ !ModuleInfo, !Specs) :-
+ list.foldl2(check_range_restrictedness_2(ClassId, InstanceDefn),
+ FunDeps, !ModuleInfo, !Specs),
check_range_restrictedness(ClassId, InstanceDefns, FunDeps,
- !ModuleInfo, !FoundError, !IO).
+ !ModuleInfo, !Specs).
:- pred check_range_restrictedness_2(class_id::in, hlds_instance_defn::in,
hlds_class_fundep::in, module_info::in, module_info::out,
- bool::in, bool::out, io::di, io::uo) is det.
+ list(error_spec)::in, list(error_spec)::out) is det.
check_range_restrictedness_2(ClassId, InstanceDefn, FunDep, !ModuleInfo,
- !FoundError, !IO) :-
+ !Specs) :-
Types = InstanceDefn ^ instance_types,
FunDep = fundep(Domain, Range),
DomainTypes = restrict_list_elements(Domain, Types),
@@ -1245,10 +1233,9 @@
UnboundVars = []
;
UnboundVars = [_ | _],
- report_range_restriction_error(ClassId, InstanceDefn, UnboundVars,
- !IO),
- !:FoundError = yes,
- module_info_incr_errors(!ModuleInfo)
+ Spec = report_range_restriction_error(ClassId, InstanceDefn,
+ UnboundVars),
+ !:Specs = [Spec | !.Specs]
).
% The error message is intended to look like this:
@@ -1259,10 +1246,10 @@
% long_module_name:001: functional dependency, but are not in the
% long_module_name:001: domain.
-:- pred report_range_restriction_error(class_id::in, hlds_instance_defn::in,
- list(tvar)::in, io::di, io::uo) is det.
+:- func report_range_restriction_error(class_id, hlds_instance_defn,
+ list(tvar)) = error_spec.
-report_range_restriction_error(ClassId, InstanceDefn, Vars, !IO) :-
+report_range_restriction_error(ClassId, InstanceDefn, Vars) = Spec :-
ClassId = class_id(SymName, Arity),
TVarSet = InstanceDefn ^ instance_tvarset,
Context = InstanceDefn ^ instance_context,
@@ -1280,43 +1267,41 @@
words(choose_number(Vars, "is", "are")),
words("not in the domain."), 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).
+ Spec = error_spec(severity_error, phase_type_check, [Msg]).
% Check the consistency of each (unordered) pair of instances.
%
:- pred check_consistency(class_id::in, hlds_class_defn::in,
list(hlds_instance_defn)::in, hlds_class_fundeps::in,
- module_info::in, module_info::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) is det.
-check_consistency(_, _, [], _, !ModuleInfo, !FoundError, !IO).
+check_consistency(_, _, [], _, !ModuleInfo, !Specs).
check_consistency(ClassId, ClassDefn, [Instance | Instances], FunDeps,
- !ModuleInfo, !FoundError, !IO) :-
- list.foldl3(check_consistency_pair(ClassId, ClassDefn, FunDeps, Instance),
- Instances, !ModuleInfo, !FoundError, !IO),
- check_consistency(ClassId, ClassDefn, Instances, FunDeps, !ModuleInfo,
- !FoundError, !IO).
+ !ModuleInfo, !Specs) :-
+ list.foldl2(check_consistency_pair(ClassId, ClassDefn, FunDeps, Instance),
+ Instances, !ModuleInfo, !Specs),
+ check_consistency(ClassId, ClassDefn, Instances, FunDeps,
+ !ModuleInfo, !Specs).
:- pred check_consistency_pair(class_id::in, hlds_class_defn::in,
hlds_class_fundeps::in, hlds_instance_defn::in, hlds_instance_defn::in,
- module_info::in, module_info::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) is det.
check_consistency_pair(ClassId, ClassDefn, FunDeps, InstanceA, InstanceB,
- !ModuleInfo, !FoundError, !IO) :-
- list.foldl3(
+ !ModuleInfo, !Specs) :-
+ list.foldl2(
check_consistency_pair_2(ClassId, ClassDefn, InstanceA, InstanceB),
- FunDeps, !ModuleInfo, !FoundError, !IO).
+ FunDeps, !ModuleInfo, !Specs).
:- pred check_consistency_pair_2(class_id::in, hlds_class_defn::in,
hlds_instance_defn::in, hlds_instance_defn::in, hlds_class_fundep::in,
- module_info::in, module_info::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) is det.
check_consistency_pair_2(ClassId, ClassDefn, InstanceA, InstanceB, FunDep,
- !ModuleInfo, !FoundError, !IO) :-
+ !ModuleInfo, !Specs) :-
TVarSetA = InstanceA ^ instance_tvarset,
TVarSetB = InstanceB ^ instance_tvarset,
tvarset_merge_renaming(TVarSetA, TVarSetB, _, Renaming),
@@ -1337,21 +1322,19 @@
( RangeA = RangeB ->
true
;
- report_consistency_error(ClassId, ClassDefn, InstanceA,
- InstanceB, FunDep, !IO),
- !:FoundError = yes,
- module_info_incr_errors(!ModuleInfo)
+ Spec = report_consistency_error(ClassId, ClassDefn,
+ InstanceA, InstanceB, FunDep),
+ !:Specs = [Spec | !.Specs]
)
;
true
).
-:- pred report_consistency_error(class_id::in, hlds_class_defn::in,
- hlds_instance_defn::in, hlds_instance_defn::in, hlds_class_fundep::in,
- io::di, io::uo) is det.
+:- func report_consistency_error(class_id, hlds_class_defn,
+ hlds_instance_defn, hlds_instance_defn, hlds_class_fundep) = error_spec.
-report_consistency_error(ClassId, ClassDefn, InstanceA, InstanceB, FunDep,
- !IO) :-
+report_consistency_error(ClassId, ClassDefn, InstanceA, InstanceB, FunDep)
+ = Spec :-
ClassId = class_id(SymName, Arity),
Params = ClassDefn ^ class_vars,
TVarSet = ClassDefn ^ class_tvarset,
@@ -1373,9 +1356,7 @@
MsgA = simple_msg(ContextA, [always(PiecesA)]),
MsgB = error_msg(yes(ContextB), yes, 0, [always(PiecesB)]),
- Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [MsgA, MsgB]),
- % XXX _NumErrors
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO).
+ Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [MsgA, MsgB]).
%---------------------------------------------------------------------------%
@@ -1386,22 +1367,22 @@
% constraints are not all determined by the type variables in the
% constructor arguments and the functional dependencies.
%
-:- pred check_typeclass.check_constraints(module_info::in,
- module_info::out, bool::out, io::di, io::uo) is det.
+:- pred check_typeclass_constraints(module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
-check_typeclass.check_constraints(!ModuleInfo, FoundError, !IO) :-
+check_typeclass_constraints(!ModuleInfo, !Specs) :-
module_info_predids(!.ModuleInfo, PredIds),
- list.foldl3(check_pred_constraints, PredIds, !ModuleInfo,
- no, FoundError0, !IO),
+ list.foldl2(check_pred_constraints, PredIds, !ModuleInfo, !Specs),
module_info_get_type_table(!.ModuleInfo, TypeTable),
map.keys(TypeTable, TypeCtors),
- list.foldl3(check_ctor_constraints(TypeTable), TypeCtors, !ModuleInfo,
- FoundError0, FoundError, !IO).
+ list.foldl2(check_ctor_constraints(TypeTable), TypeCtors,
+ !ModuleInfo, !Specs).
-:- pred check_pred_constraints(pred_id::in, module_info::in,
- module_info::out, bool::in, bool::out, io::di, io::uo) is det.
+:- pred check_pred_constraints(pred_id::in,
+ module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
-check_pred_constraints(PredId, !ModuleInfo, !FoundError, !IO) :-
+check_pred_constraints(PredId, !ModuleInfo, !Specs) :-
module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
(
pred_info_get_import_status(PredInfo, ImportStatus),
@@ -1409,10 +1390,13 @@
->
true
;
+ trace [io(!IO)] (
write_pred_progress_message("% Checking typeclass constraints on ",
- PredId, !.ModuleInfo, !IO),
- check_pred_type_ambiguities(PredInfo, !ModuleInfo, !FoundError, !IO),
- check_constraint_quant(PredInfo, !ModuleInfo, !FoundError, !IO)
+ PredId, !.ModuleInfo, !IO)
+ ),
+
+ check_pred_type_ambiguities(PredInfo, !ModuleInfo, !Specs),
+ check_constraint_quant(PredInfo, !ModuleInfo, !Specs)
).
:- func needs_ambiguity_check(import_status) = bool.
@@ -1429,10 +1413,11 @@
needs_ambiguity_check(status_exported_to_submodules) = yes.
needs_ambiguity_check(status_local) = yes.
-:- pred check_pred_type_ambiguities(pred_info::in, module_info::in,
- module_info::out, bool::in, bool::out, io::di, io::uo) is det.
+:- pred check_pred_type_ambiguities(pred_info::in,
+ module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
-check_pred_type_ambiguities(PredInfo, !ModuleInfo, !FoundError, !IO) :-
+check_pred_type_ambiguities(PredInfo, !ModuleInfo, !Specs) :-
pred_info_get_typevarset(PredInfo, TVarSet),
pred_info_get_arg_types(PredInfo, ArgTypes),
pred_info_get_class_context(PredInfo, Constraints),
@@ -1442,30 +1427,29 @@
UnboundTVars = []
;
UnboundTVars = [_ | _],
- report_unbound_tvars_in_pred_context(UnboundTVars, PredInfo, !IO),
- !:FoundError = yes,
- module_info_incr_errors(!ModuleInfo)
+ Spec = report_unbound_tvars_in_pred_context(UnboundTVars, PredInfo),
+ !:Specs = [Spec | !.Specs]
).
-:- pred check_ctor_constraints(type_table::in, type_ctor::in, module_info::in,
- module_info::out, bool::in, bool::out, io::di, io::uo) is det.
+:- pred check_ctor_constraints(type_table::in, type_ctor::in,
+ module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
-check_ctor_constraints(TypeTable, TypeCtor, !ModuleInfo, !FoundError, !IO) :-
+check_ctor_constraints(TypeTable, TypeCtor, !ModuleInfo, !Specs) :-
map.lookup(TypeTable, TypeCtor, TypeDefn),
get_type_defn_body(TypeDefn, Body),
( Body = hlds_du_type(Ctors, _, _, _, _, _) ->
- list.foldl3(check_ctor_type_ambiguities(TypeCtor, TypeDefn),
- Ctors, !ModuleInfo, !FoundError, !IO)
+ list.foldl2(check_ctor_type_ambiguities(TypeCtor, TypeDefn), Ctors,
+ !ModuleInfo, !Specs)
;
true
).
:- pred check_ctor_type_ambiguities(type_ctor::in, hlds_type_defn::in,
constructor::in, module_info::in, module_info::out,
- bool::in, bool::out, io::di, io::uo) is det.
+ list(error_spec)::in, list(error_spec)::out) is det.
-check_ctor_type_ambiguities(TypeCtor, TypeDefn, Ctor, !ModuleInfo,
- !FoundError, !IO) :-
+check_ctor_type_ambiguities(TypeCtor, TypeDefn, Ctor, !ModuleInfo, !Specs) :-
Ctor = ctor(ExistQVars, Constraints, _, CtorArgs),
assoc_list.values(CtorArgs, ArgTypes),
type_vars_list(ArgTypes, ArgTVars),
@@ -1478,10 +1462,9 @@
UnboundTVars = []
;
UnboundTVars = [_ | _],
- report_unbound_tvars_in_ctor_context(UnboundTVars, TypeCtor,
- TypeDefn, !IO),
- !:FoundError = yes,
- module_info_incr_errors(!ModuleInfo)
+ Spec = report_unbound_tvars_in_ctor_context(UnboundTVars, TypeCtor,
+ TypeDefn),
+ !:Specs = [Spec | !.Specs]
).
:- pred get_unbound_tvars(tvarset::in, list(tvar)::in, prog_constraints::in,
@@ -1633,10 +1616,10 @@
% long_module_name:002: T occurs in the constraints, but is not
% long_module_name:002: determined by the constructor's argument types.
-:- pred report_unbound_tvars_in_pred_context(list(tvar)::in, pred_info::in,
- io::di, io::uo) is det.
+:- func report_unbound_tvars_in_pred_context(list(tvar), pred_info)
+ = error_spec.
-report_unbound_tvars_in_pred_context(Vars, PredInfo, !IO) :-
+report_unbound_tvars_in_pred_context(Vars, PredInfo) = Spec :-
pred_info_context(PredInfo, Context),
pred_info_get_arg_types(PredInfo, TVarSet, _, ArgTypes),
PredName = pred_info_name(PredInfo),
@@ -1668,14 +1651,12 @@
Msg = simple_msg(Context,
[always(Pieces),
verbose_only(report_unbound_tvars_explanation)]),
- 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]).
-:- pred report_unbound_tvars_in_ctor_context(list(tvar)::in, type_ctor::in,
- hlds_type_defn::in, io::di, io::uo) is det.
+:- func report_unbound_tvars_in_ctor_context(list(tvar), type_ctor,
+ hlds_type_defn) = error_spec.
-report_unbound_tvars_in_ctor_context(Vars, TypeCtor, TypeDefn, !IO) :-
+report_unbound_tvars_in_ctor_context(Vars, TypeCtor, TypeDefn) = Spec :-
get_type_defn_context(TypeDefn, Context),
get_type_defn_tvarset(TypeDefn, TVarSet),
TypeCtor = type_ctor(SymName, Arity),
@@ -1695,9 +1676,7 @@
Msg = simple_msg(Context,
[always(Pieces),
verbose_only(report_unbound_tvars_explanation)]),
- 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]).
:- func report_unbound_tvars_explanation = list(format_component).
@@ -1736,10 +1715,10 @@
% universally (existentially) quantified.
%
:- pred check_constraint_quant(pred_info::in,
- module_info::in, module_info::out, bool::in, bool::out,
- io::di, io::uo) is det.
+ module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
-check_constraint_quant(PredInfo, !ModuleInfo, !FoundError, !IO) :-
+check_constraint_quant(PredInfo, !ModuleInfo, !Specs) :-
pred_info_get_exist_quant_tvars(PredInfo, ExistQVars),
pred_info_get_class_context(PredInfo, Constraints),
Constraints = constraints(UnivCs, ExistCs),
@@ -1749,11 +1728,11 @@
list.member(V, ExistQVars)
), BadUnivTVars),
maybe_report_badly_quantified_vars(PredInfo, universal_constraint,
- BadUnivTVars, !ModuleInfo, !FoundError, !IO),
+ BadUnivTVars, !ModuleInfo, !Specs),
prog_type.constraint_list_get_tvars(ExistCs, ExistTVars),
list.delete_elems(ExistTVars, ExistQVars, BadExistTVars),
maybe_report_badly_quantified_vars(PredInfo, existential_constraint,
- BadExistTVars, !ModuleInfo, !FoundError, !IO).
+ BadExistTVars, !ModuleInfo, !Specs).
:- type quant_error_type
---> universal_constraint
@@ -1761,24 +1740,22 @@
:- pred maybe_report_badly_quantified_vars(pred_info::in, quant_error_type::in,
list(tvar)::in, module_info::in, module_info::out,
- bool::in, bool::out, io::di, io::uo) is det.
+ list(error_spec)::in, list(error_spec)::out) is det.
maybe_report_badly_quantified_vars(PredInfo, QuantErrorType, TVars,
- !ModuleInfo, !FoundError, !IO) :-
+ !ModuleInfo, !Specs) :-
(
TVars = []
;
TVars = [_ | _],
- report_badly_quantified_vars(PredInfo, QuantErrorType, TVars, !IO),
- module_info_incr_errors(!ModuleInfo),
- !:FoundError = yes,
- io.set_exit_status(1, !IO)
+ Spec = report_badly_quantified_vars(PredInfo, QuantErrorType, TVars),
+ !:Specs = [Spec | !.Specs]
).
-:- pred report_badly_quantified_vars(pred_info::in, quant_error_type::in,
- list(tvar)::in, io::di, io::uo) is det.
+:- func report_badly_quantified_vars(pred_info, quant_error_type, list(tvar))
+ = error_spec.
-report_badly_quantified_vars(PredInfo, QuantErrorType, TVars, !IO) :-
+report_badly_quantified_vars(PredInfo, QuantErrorType, TVars) = Spec :-
pred_info_get_typevarset(PredInfo, TVarSet),
pred_info_context(PredInfo, Context),
@@ -1804,9 +1781,7 @@
[Are, BlahConstrained, suffix(","), words("but"), Are,
BlahQuantified, suffix("."), 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).
+ Spec = error_spec(severity_error, phase_type_check, [Msg]).
%---------------------------------------------------------------------------%
Index: compiler/common.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/common.m,v
retrieving revision 1.99
diff -u -b -r1.99 common.m
--- compiler/common.m 27 Sep 2006 06:16:49 -0000 1.99
+++ compiler/common.m 12 Oct 2006 08:54:14 -0000
@@ -99,10 +99,13 @@
:- import_module hlds.instmap.
:- import_module libs.
:- import_module libs.compiler_util.
+:- import_module libs.options.
+:- import_module parse_tree.error_util.
:- import_module parse_tree.prog_type.
-:- import_module transform_hlds. % for pd_cost, etc.
+:- import_module transform_hlds.
:- import_module transform_hlds.pd_cost.
+:- import_module bool.
:- import_module eqvclass.
:- import_module map.
:- import_module maybe.
@@ -571,9 +574,22 @@
types_match_exactly_list(OutputArgTypes1, OutputArgTypes2)
->
goal_info_get_context(GoalInfo, Context),
- Msg = duplicate_call(SeenCall, PrevContext),
- ContextMsg = context_det_msg(Context, Msg),
- simplify_info_do_add_det_msg(ContextMsg, !Info)
+ CallPieces = det_report_seen_call_id(ModuleInfo, SeenCall),
+ CurPieces = [words("Warning: redundant") | CallPieces]
+ ++ [suffix(".")],
+ PrevPieces = [words("Here is the previous") | CallPieces]
+ ++ [suffix(".")],
+ Severity = severity_conditional(warn_duplicate_calls, yes,
+ severity_warning, no),
+ Msg = simple_msg(Context,
+ [option_is_set(warn_duplicate_calls, yes,
+ [always(CurPieces)])]),
+ PrevMsg = error_msg(yes(PrevContext), yes, 0,
+ [option_is_set(warn_duplicate_calls, yes,
+ [always(PrevPieces)])]),
+ Spec = error_spec(Severity, phase_simplify(report_in_any_mode),
+ [Msg, PrevMsg]),
+ simplify_info_do_add_error_spec(Spec, !Info)
;
true
),
Index: compiler/deforest.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/deforest.m,v
retrieving revision 1.74
diff -u -b -r1.74 deforest.m
--- compiler/deforest.m 2 Oct 2006 05:21:09 -0000 1.74
+++ compiler/deforest.m 12 Oct 2006 10:27:18 -0000
@@ -52,8 +52,8 @@
:- import_module check_hlds.det_report.
:- import_module check_hlds.inst_match.
:- import_module check_hlds.mode_info.
-:- import_module check_hlds.modes.
:- import_module check_hlds.mode_util.
+:- import_module check_hlds.modes.
:- import_module check_hlds.purity.
:- import_module check_hlds.simplify.
:- import_module check_hlds.unique_modes.
@@ -69,6 +69,7 @@
:- import_module libs.globals.
:- import_module libs.options.
:- import_module mdbcomp.prim_data.
+:- import_module parse_tree.error_util.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_type_subst.
@@ -104,7 +105,7 @@
% Find out which arguments of each procedure are switched on at the top
% level or are constructed in a way which is possibly deforestable.
Task0 = update_module_cookie(get_branch_vars_proc, UnivProcArgInfo0),
- process_all_nonimported_procs(Task0, Task, !ModuleInfo, !IO),
+ process_all_nonimported_procs_update(Task0, Task, !ModuleInfo, !IO),
(
Task = update_module_cookie(_, UnivProcArgInfo),
univ_to_type(UnivProcArgInfo, ProcArgInfo1)
@@ -140,14 +141,15 @@
% inference on the specialized versions after constraint propagation,
% because some nondet predicates will have become semidet.
list.foldl(reset_inferred_proc_determinism, Versions, !ModuleInfo),
- module_info_get_num_errors(!.ModuleInfo, Errors5),
- disable_det_warnings(OptionsToRestore, !IO),
- determinism_pass(!ModuleInfo, !IO),
- restore_det_warnings(OptionsToRestore, !IO),
+ module_info_get_globals(!.ModuleInfo, Globals0),
+ disable_det_warnings(OptionsToRestore, Globals0, Globals1),
+ determinism_pass(!ModuleInfo, Specs),
+ restore_det_warnings(OptionsToRestore, Globals1, Globals),
+ module_info_set_globals(Globals, !ModuleInfo),
- module_info_get_num_errors(!.ModuleInfo, Errors),
- expect(unify(Errors5, Errors), this_file,
+ FoundErrors = contains_errors(Globals, Specs),
+ expect(unify(FoundErrors, no), this_file,
"determinism errors after deforestation")
;
true
@@ -249,7 +251,7 @@
% then we re-run determinism analysis. As with
% inlining.m, this avoids problems with inlining
% erroneous procedures.
- det_infer_proc(PredId, ProcId, !ModuleInfo, Globals, _, _, _)
+ det_infer_proc(PredId, ProcId, !ModuleInfo, _, _, _)
;
RerunDet = no
),
Index: compiler/det_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_analysis.m,v
retrieving revision 1.200
diff -u -b -r1.200 det_analysis.m
--- compiler/det_analysis.m 27 Sep 2006 06:16:50 -0000 1.200
+++ compiler/det_analysis.m 12 Oct 2006 16:02:27 -0000
@@ -56,12 +56,10 @@
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module hlds.instmap.
-:- import_module libs.
-:- import_module libs.globals.
:- import_module parse_tree.
+:- import_module parse_tree.error_util.
:- import_module parse_tree.prog_data.
-:- import_module io.
:- import_module list.
:- import_module maybe.
@@ -71,22 +69,23 @@
% declarations, and determinism checking for all other predicates.
%
:- pred determinism_pass(module_info::in, module_info::out,
- io::di, io::uo) is det.
+ list(error_spec)::out) is det.
% Check the determinism of a single procedure (only works if the
% determinism of the procedures it calls has already been inferred).
%
:- pred determinism_check_proc(proc_id::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)::out) is det.
% Infer the determinism of a procedure.
%
-:- pred det_infer_proc(pred_id::in, proc_id::in, module_info::in,
- module_info::out, globals::in, determinism::out, determinism::out,
- list(context_det_msg)::out) is det.
+:- pred det_infer_proc(pred_id::in, proc_id::in,
+ module_info::in, module_info::out, determinism::out, determinism::out,
+ list(error_spec)::out) is det.
-:- type pess_info % short for promise_equivalent_solution_sets_info
+:- type pess_info
---> pess_info(prog_vars, prog_context).
+ % short for promise_equivalent_solution_sets_info
% Infers the determinism of `Goal0' and returns this in `Detism'.
% It annotates the goal and all its subgoals with their determinism
@@ -94,8 +93,8 @@
%
:- pred det_infer_goal(hlds_goal::in, hlds_goal::out, instmap::in,
soln_context::in, list(failing_context)::in, maybe(pess_info)::in,
- det_info::in, determinism::out,
- list(failing_context)::out, list(context_det_msg)::out) is det.
+ det_info::in, determinism::out, list(failing_context)::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
% Work out how many solutions are needed for a given determinism.
%
@@ -114,8 +113,11 @@
:- import_module check_hlds.type_util.
:- import_module hlds.code_model.
:- import_module hlds.goal_util.
+:- import_module hlds.hlds_error_util.
:- import_module hlds.hlds_out.
:- import_module hlds.pred_table.
+:- import_module libs.
+:- import_module libs.globals.
:- import_module libs.compiler_util.
:- import_module libs.options.
:- import_module parse_tree.mercury_to_mercury.
@@ -124,6 +126,7 @@
:- import_module assoc_list.
:- import_module bool.
+:- import_module io.
:- import_module map.
:- import_module pair.
:- import_module set.
@@ -132,67 +135,80 @@
%-----------------------------------------------------------------------------%
-determinism_pass(!ModuleInfo, !IO) :-
+determinism_pass(!ModuleInfo, Specs) :-
determinism_declarations(!.ModuleInfo, DeclaredProcs, UndeclaredProcs,
NoInferProcs),
list.foldl(set_non_inferred_proc_determinism, NoInferProcs, !ModuleInfo),
- globals.io_lookup_bool_option(verbose, Verbose, !IO),
- globals.io_lookup_bool_option(debug_det, Debug, !IO),
+ module_info_get_globals(!.ModuleInfo, Globals),
+ globals.lookup_bool_option(Globals, verbose, Verbose),
+ globals.lookup_bool_option(Globals, debug_det, Debug),
(
UndeclaredProcs = [],
- Msgs = []
+ InferenceSpecs = []
;
UndeclaredProcs = [_ | _],
- maybe_write_string(Verbose, "% Doing determinism inference...\n", !IO),
- global_inference_pass(!ModuleInfo, UndeclaredProcs, Debug, Msgs, !IO),
+ trace [io(!IO)] (
+ maybe_write_string(Verbose, "% Doing determinism inference...\n",
+ !IO)
+ ),
+ global_inference_pass(!ModuleInfo, UndeclaredProcs, Debug,
+ InferenceSpecs),
+ trace [io(!IO)] (
maybe_write_string(Verbose, "% done.\n", !IO)
+ )
+ ),
+ trace [io(!IO)] (
+ maybe_write_string(Verbose, "% Doing determinism checking...\n", !IO)
),
- maybe_write_string(Verbose, "% Doing determinism checking...\n", !IO),
global_final_pass(!ModuleInfo, UndeclaredProcs, DeclaredProcs, Debug,
- Msgs, !IO),
- maybe_write_string(Verbose, "% done.\n", !IO).
+ FinalSpecs),
+ Specs = InferenceSpecs ++ FinalSpecs,
+ trace [io(!IO)] (
+ maybe_write_string(Verbose, "% done.\n", !IO)
+ ).
-determinism_check_proc(ProcId, PredId, !ModuleInfo, !IO) :-
- globals.io_lookup_bool_option(debug_det, Debug, !IO),
- global_final_pass(!ModuleInfo, [], [proc(PredId, ProcId)], Debug, [], !IO).
+determinism_check_proc(ProcId, PredId, !ModuleInfo, Specs) :-
+ module_info_get_globals(!.ModuleInfo, Globals),
+ globals.lookup_bool_option(Globals, debug_det, Debug),
+ global_final_pass(!ModuleInfo, [], [proc(PredId, ProcId)], Debug, Specs).
%-----------------------------------------------------------------------------%
:- pred global_inference_pass(module_info::in, module_info::out,
- pred_proc_list::in, bool::in, list(context_det_msg)::out,
- io::di, io::uo) is det.
+ pred_proc_list::in, bool::in, list(error_spec)::out) is det.
% Iterate until a fixpoint is reached. This can be expensive if a module
% has many predicates with undeclared determinisms. If this ever becomes
% a problem, we should switch to doing iterations only on strongly
% connected components of the dependency graph.
%
-global_inference_pass(!ModuleInfo, ProcList, Debug, Msgs, !IO) :-
- global_inference_single_pass(ProcList, Debug, !ModuleInfo, [], Msgs1,
- unchanged, Changed, !IO),
- maybe_write_string(Debug, "% Inference pass complete\n", !IO),
+global_inference_pass(!ModuleInfo, ProcList, Debug, Specs) :-
+ global_inference_single_pass(ProcList, Debug, !ModuleInfo, [], Specs1,
+ unchanged, Changed),
+ trace [io(!IO)] (
+ maybe_write_string(Debug, "% Inference pass complete\n", !IO)
+ ),
(
Changed = changed,
- global_inference_pass(!ModuleInfo, ProcList, Debug, Msgs, !IO)
+ global_inference_pass(!ModuleInfo, ProcList, Debug, Specs)
;
Changed = unchanged,
% We have arrived at a fixpoint. Therefore all the messages we have
% are based on the final determinisms of all procedures, which means
- % it is safe to return them to be printed them.
- Msgs = Msgs1
+ % it is safe to return them to be printed.
+ Specs = Specs1
).
:- pred global_inference_single_pass(pred_proc_list::in, bool::in,
module_info::in, module_info::out,
- list(context_det_msg)::in, list(context_det_msg)::out,
- maybe_changed::in, maybe_changed::out, io::di, io::uo) is det.
+ list(error_spec)::in, list(error_spec)::out,
+ maybe_changed::in, maybe_changed::out) is det.
-global_inference_single_pass([], _, !ModuleInfo, !Msgs, !Changed, !IO).
+global_inference_single_pass([], _, !ModuleInfo, !Specs, !Changed).
global_inference_single_pass([proc(PredId, ProcId) | PredProcs], Debug,
- !ModuleInfo, !Msgs, !Changed, !IO) :-
- globals.io_get_globals(Globals, !IO),
- det_infer_proc(PredId, ProcId, !ModuleInfo, Globals, OldDetism, NewDetism,
- ProcMsgs),
+ !ModuleInfo, !Specs, !Changed) :-
+ det_infer_proc(PredId, ProcId, !ModuleInfo, OldDetism, NewDetism,
+ ProcSpecs),
( NewDetism = OldDetism ->
ChangeStr = "old"
;
@@ -201,38 +217,36 @@
),
(
Debug = yes,
+ trace [io(!IO)] (
io.write_string("% Inferred " ++ ChangeStr ++ " detism ", !IO),
mercury_output_det(NewDetism, !IO),
io.write_string(" for ", !IO),
hlds_out.write_pred_proc_id(!.ModuleInfo, PredId, ProcId, !IO),
io.write_string("\n", !IO)
+ )
;
Debug = no
),
- list.append(ProcMsgs, !Msgs),
- global_inference_single_pass(PredProcs, Debug, !ModuleInfo, !Msgs,
- !Changed, !IO).
+ !:Specs = ProcSpecs ++ !.Specs,
+ global_inference_single_pass(PredProcs, Debug, !ModuleInfo, !Specs,
+ !Changed).
:- pred global_final_pass(module_info::in, module_info::out,
pred_proc_list::in, pred_proc_list::in, bool::in,
- list(context_det_msg)::in, io::di, io::uo) is det.
+ list(error_spec)::out) is det.
-global_final_pass(!ModuleInfo, UndeclaredProcs, DeclaredProcs, Debug, !.Msgs,
- !IO) :-
+global_final_pass(!ModuleInfo, UndeclaredProcs, DeclaredProcs, Debug,
+ !:Specs) :-
% We have already iterated global_inference_single_pass to a fixpoint
% on the undeclared procs.
- global_inference_single_pass(DeclaredProcs, Debug, !ModuleInfo, !Msgs,
- unchanged, _, !IO),
- % We sort the messages by context.
- list.sort_and_remove_dups(!Msgs),
- det_report_and_handle_msgs(!.Msgs, !ModuleInfo, !IO),
- global_checking_pass(UndeclaredProcs ++ DeclaredProcs, !ModuleInfo, !IO).
+ global_inference_single_pass(DeclaredProcs, Debug, !ModuleInfo,
+ [], !:Specs, unchanged, _),
+ global_checking_pass(UndeclaredProcs ++ DeclaredProcs, !.ModuleInfo,
+ !Specs).
%-----------------------------------------------------------------------------%
-det_infer_proc(PredId, ProcId, !ModuleInfo, Globals, OldDetism, NewDetism,
- !:Msgs) :-
-
+det_infer_proc(PredId, ProcId, !ModuleInfo, OldDetism, NewDetism, !:Specs) :-
% Get the proc_info structure for this procedure.
module_info_preds(!.ModuleInfo, Preds0),
map.lookup(Preds0, PredId, Pred0),
@@ -268,9 +282,9 @@
proc_info_get_goal(Proc0, Goal0),
proc_info_get_initial_instmap(Proc0, !.ModuleInfo, InstMap0),
proc_info_get_vartypes(Proc0, VarTypes),
- det_info_init(!.ModuleInfo, VarTypes, PredId, ProcId, Globals, DetInfo),
+ det_info_init(!.ModuleInfo, VarTypes, PredId, ProcId, DetInfo),
det_infer_goal(Goal0, Goal, InstMap0, SolnContext, [], no, DetInfo,
- InferDetism, _, !:Msgs),
+ InferDetism, _, [], !:Specs),
% Take the worst of the old and inferred detisms. This is needed to prevent
% loops on p :- not(p), at least if the initial assumed detism is det.
@@ -298,9 +312,17 @@
ToBeCheckedCodeModel \= model_det
->
proc_info_get_context(Proc0, ProcContext),
- IOStateMsg = has_io_state_but_not_det(PredId, ProcId),
- IOStateContextMsg = context_det_msg(ProcContext, IOStateMsg),
- !:Msgs = [IOStateContextMsg | !.Msgs]
+ IOStateProcPieces = describe_one_proc_name_mode(!.ModuleInfo,
+ should_not_module_qualify, proc(PredId, ProcId)),
+ IOStatePieces = [words("In")] ++ IOStateProcPieces ++ [suffix(":"), nl,
+ words("error: invalid determinism for a predicate"),
+ words("with I/O state arguments.")],
+ IOStateVerbosePieces = [words("Valid determinisms are "),
+ words("det, cc_multi and erroneous.")],
+ IOStateSpec = error_spec(severity_error, phase_detism_check,
+ [simple_msg(ProcContext,
+ [always(IOStatePieces), verbose_only(IOStateVerbosePieces)])]),
+ !:Specs = [IOStateSpec | !.Specs]
;
true
),
@@ -322,9 +344,13 @@
get_exported_proc_context(ExportedProcs, PredId, ProcId,
PragmaContext)
->
- ExportMsg = export_model_non_proc(PredId, ProcId, NewDetism),
- ExportContextMsg = context_det_msg(PragmaContext, ExportMsg),
- list.cons(ExportContextMsg, !Msgs)
+ ExportPieces = [words("Error: "),
+ fixed("`:- pragma export' declaration"),
+ words("for a procedure that has a determinism of"),
+ fixed(hlds_out.determinism_to_string(NewDetism) ++ ".")],
+ ExportSpec = error_spec(severity_error, phase_detism_check,
+ [simple_msg(PragmaContext, [always(ExportPieces)])]),
+ !:Specs = [ExportSpec | !.Specs]
;
unexpected(this_file,
"Cannot find proc in table of pragma exported procs")
@@ -357,7 +383,7 @@
det_infer_goal(Goal0 - GoalInfo0, Goal - GoalInfo, InstMap0, !.SolnContext,
RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo, Detism,
- GoalFailingContexts, !:Msgs) :-
+ GoalFailingContexts, !Specs) :-
goal_info_get_nonlocals(GoalInfo0, NonLocalVars),
goal_info_get_instmap_delta(GoalInfo0, InstmapDelta),
@@ -405,7 +431,7 @@
det_infer_goal_2(Goal0, Goal1, GoalInfo0, InstMap0, !.SolnContext,
RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- InternalDetism0, GoalFailingContexts, !:Msgs),
+ InternalDetism0, GoalFailingContexts, !Specs),
determinism_components(InternalDetism0, InternalCanFail, InternalSolns0),
(
@@ -512,12 +538,12 @@
:- pred det_infer_goal_2(hlds_goal_expr::in, hlds_goal_expr::out,
hlds_goal_info::in, instmap::in, soln_context::in,
list(failing_context)::in, maybe(pess_info)::in, det_info::in,
- determinism::out, list(failing_context)::out, list(context_det_msg)::out)
- is det.
+ determinism::out, list(failing_context)::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
det_infer_goal_2(GoalExpr0, GoalExpr, GoalInfo, InstMap0, SolnContext,
RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo, Detism,
- GoalFailingContexts, !:Msgs) :-
+ GoalFailingContexts, !Specs) :-
(
GoalExpr0 = conj(ConjType, Goals0),
(
@@ -526,71 +552,71 @@
% determinism of the goals of that conjuction.
det_infer_conj(Goals0, Goals, InstMap0, SolnContext,
RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- Detism, [], GoalFailingContexts, !:Msgs)
+ Detism, [], GoalFailingContexts, !Specs)
;
ConjType = parallel_conj,
det_infer_par_conj(Goals0, Goals, GoalInfo, InstMap0, SolnContext,
RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- Detism, GoalFailingContexts, !:Msgs)
+ Detism, GoalFailingContexts, !Specs)
),
GoalExpr = conj(ConjType, Goals)
;
GoalExpr0 = disj(Goals0),
det_infer_disj(Goals0, Goals, GoalInfo, InstMap0, SolnContext,
RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- Detism, GoalFailingContexts, !:Msgs),
+ Detism, GoalFailingContexts, !Specs),
GoalExpr = disj(Goals)
;
GoalExpr0 = switch(Var, SwitchCanFail, Cases0),
det_infer_switch(Var, SwitchCanFail, Cases0, Cases, GoalInfo, InstMap0,
SolnContext, RightFailingContexts, MaybePromiseEqvSolutionSets,
- DetInfo, Detism, GoalFailingContexts, !:Msgs),
+ DetInfo, Detism, GoalFailingContexts, !Specs),
GoalExpr = switch(Var, SwitchCanFail, Cases)
;
GoalExpr0 = plain_call(PredId, ProcId0, Args, Builtin, UnifyContext,
Name),
det_infer_call(PredId, ProcId0, ProcId, GoalInfo, SolnContext,
RightFailingContexts, DetInfo,
- Detism, GoalFailingContexts, !:Msgs),
+ Detism, GoalFailingContexts, !Specs),
GoalExpr = plain_call(PredId, ProcId, Args, Builtin, UnifyContext,
Name)
;
GoalExpr0 = generic_call(GenericCall, _ArgVars, _Modes, CallDetism),
det_infer_generic_call(GenericCall, CallDetism, GoalInfo, SolnContext,
RightFailingContexts, DetInfo,
- Detism, GoalFailingContexts, !:Msgs),
+ Detism, GoalFailingContexts, !Specs),
GoalExpr = GoalExpr0
;
GoalExpr0 = unify(LHS, RHS0, Mode, Unify, UnifyContext),
det_infer_unify(LHS, RHS0, Unify, UnifyContext, RHS, GoalInfo,
InstMap0, SolnContext, RightFailingContexts, DetInfo, Detism,
- GoalFailingContexts, !:Msgs),
+ GoalFailingContexts, !Specs),
GoalExpr = unify(LHS, RHS, Mode, Unify, UnifyContext)
;
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
det_infer_if_then_else(Cond0, Cond, Then0, Then, Else0, Else,
InstMap0, SolnContext, RightFailingContexts,
MaybePromiseEqvSolutionSets, DetInfo, Detism,
- GoalFailingContexts, !:Msgs),
+ GoalFailingContexts, !Specs),
GoalExpr = if_then_else(Vars, Cond, Then, Else)
;
GoalExpr0 = negation(Goal0),
det_infer_not(Goal0, Goal, GoalInfo, InstMap0,
MaybePromiseEqvSolutionSets, DetInfo, Detism,
- GoalFailingContexts, !:Msgs),
+ GoalFailingContexts, !Specs),
GoalExpr = negation(Goal)
;
GoalExpr0 = scope(Reason, Goal0),
det_infer_scope(Reason, Goal0, Goal, GoalInfo, InstMap0, SolnContext,
RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- Detism, GoalFailingContexts, !:Msgs),
+ Detism, GoalFailingContexts, !Specs),
GoalExpr = scope(Reason, Goal)
;
GoalExpr0 = call_foreign_proc(Attributes, PredId, ProcId,
_Args, _ExtraArgs, _MaybeTraceRuntimeCond, PragmaCode),
det_infer_foreign_proc(Attributes, PredId, ProcId, PragmaCode,
GoalInfo, SolnContext, RightFailingContexts, DetInfo, Detism,
- GoalFailingContexts, !:Msgs),
+ GoalFailingContexts, !Specs),
GoalExpr = GoalExpr0
;
GoalExpr0 = shorthand(_),
@@ -602,15 +628,16 @@
:- pred det_infer_conj(list(hlds_goal)::in, list(hlds_goal)::out, instmap::in,
soln_context::in, list(failing_context)::in, maybe(pess_info)::in,
- det_info::in, determinism::out, list(failing_context)::in,
- list(failing_context)::out, list(context_det_msg)::out) is det.
+ det_info::in, determinism::out,
+ list(failing_context)::in, list(failing_context)::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
det_infer_conj([], [], _InstMap0, _SolnContext, _RightFailingContexts,
_MaybePromiseEqvSolutionSets, _DetInfo, detism_det,
- !ConjFailingContexts, []).
+ !ConjFailingContexts, !Specs).
det_infer_conj([Goal0 | Goals0], [Goal | Goals], InstMap0, SolnContext,
RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo, Detism,
- !ConjFailingContexts, Msgs) :-
+ !ConjFailingContexts, !Specs) :-
% We should look to see when we get to a not_reached point
% and optimize away the remaining elements of the conjunction.
% But that optimization is done in the code generator anyway.
@@ -622,7 +649,7 @@
update_instmap(Goal0, InstMap0, InstMap1),
det_infer_conj(Goals0, Goals, InstMap1, SolnContext,
RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- TailDetism, !ConjFailingContexts, TailMsgs),
+ TailDetism, !ConjFailingContexts, !Specs),
determinism_components(TailDetism, TailCanFail, _TailMaxSolns),
% Next, work out whether the first conjunct is in a first_soln context
@@ -642,25 +669,24 @@
det_infer_goal(Goal0, Goal, InstMap0, HeadSolnContext,
!.ConjFailingContexts ++ RightFailingContexts,
MaybePromiseEqvSolutionSets, DetInfo, HeadDetism,
- GoalFailingContexts, HeadMsgs),
+ GoalFailingContexts, !Specs),
% Finally combine the results computed above.
det_conjunction_detism(HeadDetism, TailDetism, Detism),
- !:ConjFailingContexts = GoalFailingContexts ++ !.ConjFailingContexts,
- Msgs = HeadMsgs ++ TailMsgs.
+ !:ConjFailingContexts = GoalFailingContexts ++ !.ConjFailingContexts.
:- pred det_infer_par_conj(list(hlds_goal)::in, list(hlds_goal)::out,
hlds_goal_info::in, instmap::in, soln_context::in,
list(failing_context)::in, maybe(pess_info)::in, det_info::in,
- determinism::out, list(failing_context)::out, list(context_det_msg)::out)
- is det.
+ determinism::out, list(failing_context)::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
det_infer_par_conj(Goals0, Goals, GoalInfo, InstMap0, SolnContext,
RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- Detism, GoalFailingContexts, !:Msgs) :-
+ Detism, GoalFailingContexts, !Specs) :-
det_infer_par_conj_goals(Goals0, Goals, InstMap0, SolnContext,
RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- Detism, [], GoalFailingContexts, !:Msgs),
+ Detism, [], GoalFailingContexts, !Specs),
(
determinism_components(Detism, CanFail, Solns),
CanFail = cannot_fail,
@@ -669,53 +695,64 @@
true
;
goal_info_get_context(GoalInfo, Context),
- det_info_get_pred_id(DetInfo, PredId),
- det_info_get_proc_id(DetInfo, ProcId),
- Msg = par_conj_not_det(Detism, PredId, ProcId, GoalInfo, Goals),
- ContextMsg = context_det_msg(Context, Msg),
- !:Msgs = [ContextMsg | !.Msgs]
+ determinism_components(Detism, CanFail, MaxSoln),
+ ( CanFail \= cannot_fail ->
+ First = "Error: parallel conjunct may fail."
+ ; MaxSoln = at_most_many ->
+ First = "Error: parallel conjunct may have multiple solutions."
+ ;
+ unexpected(this_file,
+ "strange determinism error for parallel conjunction")
+ ),
+ Rest = "The current implementation supports only "
+ ++ "single-solution non-failing parallel conjunctions.",
+ Pieces = [words(First), words(Rest)],
+ det_diagnose_conj(Goals, detism_det, [], DetInfo, GoalMsgs),
+ sort_error_msgs(GoalMsgs, SortedGoalMsgs),
+ Spec = error_spec(severity_error, phase_detism_check,
+ [simple_msg(Context, [always(Pieces)])] ++ SortedGoalMsgs),
+ !:Specs = [Spec | !.Specs]
).
:- pred det_infer_par_conj_goals(list(hlds_goal)::in, list(hlds_goal)::out,
instmap::in, soln_context::in, list(failing_context)::in,
maybe(pess_info)::in, det_info::in, determinism::out,
list(failing_context)::in, list(failing_context)::out,
- list(context_det_msg)::out) is det.
+ list(error_spec)::in, list(error_spec)::out) is det.
det_infer_par_conj_goals([], [], _InstMap0, _SolnContext,
_RightFailingContexts, _MaybePromiseEqvSolutionSets, _DetInfo,
- detism_det, !ConjFailingContexts, []).
+ detism_det, !ConjFailingContexts, !Specs).
det_infer_par_conj_goals([Goal0 | Goals0], [Goal | Goals], InstMap0,
SolnContext, RightFailingContexts, MaybePromiseEqvSolutionSets,
- DetInfo, Detism, !ConjFailingContexts, Msgs) :-
+ DetInfo, Detism, !ConjFailingContexts, !Specs) :-
det_infer_goal(Goal0, Goal, InstMap0, SolnContext, RightFailingContexts,
MaybePromiseEqvSolutionSets, DetInfo, HeadDetism, GoalFailingContexts,
- HeadMsgs),
+ !Specs),
determinism_components(HeadDetism, HeadCanFail, HeadMaxSolns),
det_infer_par_conj_goals(Goals0, Goals, InstMap0, SolnContext,
RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- TailDetism, !ConjFailingContexts, TailMsgs),
+ TailDetism, !ConjFailingContexts, !Specs),
determinism_components(TailDetism, TailCanFail, TailMaxSolns),
det_conjunction_maxsoln(HeadMaxSolns, TailMaxSolns, MaxSolns),
det_conjunction_canfail(HeadCanFail, TailCanFail, CanFail),
determinism_components(Detism, CanFail, MaxSolns),
- !:ConjFailingContexts = GoalFailingContexts ++ !.ConjFailingContexts,
- Msgs = HeadMsgs ++ TailMsgs.
+ !:ConjFailingContexts = GoalFailingContexts ++ !.ConjFailingContexts.
:- pred det_infer_disj(list(hlds_goal)::in, list(hlds_goal)::out,
hlds_goal_info::in, instmap::in, soln_context::in,
list(failing_context)::in, maybe(pess_info)::in, det_info::in,
- determinism::out, list(failing_context)::out, list(context_det_msg)::out)
- is det.
+ determinism::out, list(failing_context)::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
det_infer_disj(Goals0, Goals, GoalInfo, InstMap0, SolnContext,
RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- Detism, GoalFailingContexts, !:Msgs) :-
+ Detism, GoalFailingContexts, !Specs) :-
det_infer_disj_goals(Goals0, Goals, InstMap0, SolnContext,
RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- can_fail, at_most_zero, Detism, [], GoalFailingContexts0, !:Msgs),
+ can_fail, at_most_zero, Detism, [], GoalFailingContexts0, !Specs),
(
Goals = [],
goal_info_get_context(GoalInfo, Context),
@@ -729,18 +766,18 @@
instmap::in, soln_context::in, list(failing_context)::in,
maybe(pess_info)::in, det_info::in, can_fail::in, soln_count::in,
determinism::out, list(failing_context)::in, list(failing_context)::out,
- list(context_det_msg)::out) is det.
+ list(error_spec)::in, list(error_spec)::out) is det.
det_infer_disj_goals([], [], _InstMap0, _SolnContext, _RightFailingContexts,
_MaybePromiseEqvSolutionSets, _DetInfo, CanFail, MaxSolns, Detism,
- !DisjFailingContexts, []) :-
+ !DisjFailingContexts, !Specs) :-
determinism_components(Detism, CanFail, MaxSolns).
det_infer_disj_goals([Goal0 | Goals0], [Goal | Goals], InstMap0, SolnContext,
RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- !.CanFail, !.MaxSolns, Detism, !DisjFailingContexts, Msgs) :-
+ !.CanFail, !.MaxSolns, Detism, !DisjFailingContexts, !Specs) :-
det_infer_goal(Goal0, Goal, InstMap0, SolnContext, RightFailingContexts,
MaybePromiseEqvSolutionSets, DetInfo, FirstDetism, GoalFailingContexts,
- FirstMsgs),
+ !Specs),
determinism_components(FirstDetism, FirstCanFail, FirstMaxSolns),
Goal = _ - GoalInfo,
% If a disjunct cannot succeed but is marked with the
@@ -776,9 +813,8 @@
),
det_infer_disj_goals(Goals0, Goals, InstMap0, SolnContext,
RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- !.CanFail, !.MaxSolns, Detism, !DisjFailingContexts, LaterMsgs),
- !:DisjFailingContexts = GoalFailingContexts ++ !.DisjFailingContexts,
- Msgs = FirstMsgs ++ LaterMsgs.
+ !.CanFail, !.MaxSolns, Detism, !DisjFailingContexts, !Specs),
+ !:DisjFailingContexts = GoalFailingContexts ++ !.DisjFailingContexts.
%-----------------------------------------------------------------------------%
@@ -786,12 +822,12 @@
list(case)::in, list(case)::out,
hlds_goal_info::in, instmap::in, soln_context::in,
list(failing_context)::in, maybe(pess_info)::in, det_info::in,
- determinism::out, list(failing_context)::out, list(context_det_msg)::out)
- is det.
+ determinism::out, list(failing_context)::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
det_infer_switch(Var, SwitchCanFail, Cases0, Cases, GoalInfo, InstMap0,
SolnContext, RightFailingContexts, MaybePromiseEqvSolutionSets,
- DetInfo, Detism, GoalFailingContexts, !:Msgs) :-
+ DetInfo, Detism, GoalFailingContexts, !Specs) :-
% The determinism of a switch is the worst of the determinism of each
% of the cases. Also, if only a subset of the constructors are handled,
% then it is semideterministic or worse - this is determined
@@ -800,7 +836,7 @@
det_infer_switch_cases(Cases0, Cases, InstMap0, SolnContext,
RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
cannot_fail, at_most_zero, CasesDetism, [], GoalFailingContexts0,
- !:Msgs),
+ !Specs),
determinism_components(CasesDetism, CasesCanFail, CasesSolns),
% The switch variable tests are in a first_soln context if and only
% if the switch goal as a whole was in a first_soln context and the
@@ -816,7 +852,7 @@
ExaminesRep = yes,
det_check_for_noncanonical_type(Var, ExaminesRep, SwitchCanFail,
SwitchSolnContext, GoalFailingContexts0, RightFailingContexts,
- GoalInfo, ccuc_switch, DetInfo, SwitchSolns, !Msgs),
+ GoalInfo, ccuc_switch, DetInfo, SwitchSolns, !Specs),
det_conjunction_canfail(SwitchCanFail, CasesCanFail, CanFail),
det_conjunction_maxsoln(SwitchSolns, CasesSolns, NumSolns),
determinism_components(Detism, CanFail, NumSolns),
@@ -834,41 +870,41 @@
soln_context::in, list(failing_context)::in, maybe(pess_info)::in,
det_info::in, can_fail::in, soln_count::in, determinism::out,
list(failing_context)::in, list(failing_context)::out,
- list(context_det_msg)::out) is det.
+ list(error_spec)::in, list(error_spec)::out) is det.
det_infer_switch_cases([], [], _InstMap0, _SolnContext, _RightFailingContexts,
_MaybePromiseEqvSolutionSets, _DetInfo, CanFail, MaxSolns,
- Detism, !SwitchFailingContexts, []) :-
+ Detism, !SwitchFailingContexts, !Specs) :-
determinism_components(Detism, CanFail, MaxSolns).
det_infer_switch_cases([Case0 | Cases0], [Case | Cases], InstMap0, SolnContext,
RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- !.CanFail, !.MaxSolns, Detism, !SwitchFailingContexts, Msgs) :-
+ !.CanFail, !.MaxSolns, Detism, !SwitchFailingContexts, !Specs) :-
% Technically, we should update the instmap to reflect the knowledge that
% the var is bound to this particular constructor, but we wouldn't use
% that information here anyway, so we don't bother.
Case0 = case(ConsId, Goal0),
det_infer_goal(Goal0, Goal, InstMap0, SolnContext, RightFailingContexts,
MaybePromiseEqvSolutionSets, DetInfo, FirstDetism, GoalFailingContexts,
- FirstMsgs),
+ !Specs),
Case = case(ConsId, Goal),
determinism_components(FirstDetism, FirstCanFail, FirstMaxSolns),
det_switch_canfail(!.CanFail, FirstCanFail, !:CanFail),
det_switch_maxsoln(!.MaxSolns, FirstMaxSolns, !:MaxSolns),
det_infer_switch_cases(Cases0, Cases, InstMap0, SolnContext,
RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo,
- !.CanFail, !.MaxSolns, Detism, !SwitchFailingContexts, LaterMsgs),
- !:SwitchFailingContexts = GoalFailingContexts ++ !.SwitchFailingContexts,
- Msgs = FirstMsgs ++ LaterMsgs.
+ !.CanFail, !.MaxSolns, Detism, !SwitchFailingContexts, !Specs),
+ !:SwitchFailingContexts = GoalFailingContexts ++ !.SwitchFailingContexts.
%-----------------------------------------------------------------------------%
:- pred det_infer_call(pred_id::in, proc_id::in, proc_id::out,
hlds_goal_info::in, soln_context::in,
list(failing_context)::in, det_info::in, determinism::out,
- list(failing_context)::out, list(context_det_msg)::out) is det.
+ list(failing_context)::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
det_infer_call(PredId, ProcId0, ProcId, GoalInfo, SolnContext,
- RightFailingContexts, DetInfo, Detism, GoalFailingContexts, !:Msgs) :-
+ RightFailingContexts, DetInfo, Detism, GoalFailingContexts, !Specs) :-
% For calls, just look up the determinism entry associated with
% the called predicate.
% This is the point at which annotations start changing
@@ -887,16 +923,26 @@
ProcIdPrime)
->
ProcId = ProcIdPrime,
- !:Msgs = [],
determinism_components(Detism, CanFail, at_most_many)
;
goal_info_get_context(GoalInfo, GoalContext),
det_get_proc_info(DetInfo, ProcInfo),
proc_info_get_varset(ProcInfo, VarSet),
- Msg = cc_pred_in_wrong_context(GoalInfo, Detism0,
- PredId, ProcId0, VarSet, RightFailingContexts),
- ContextMsg = context_det_msg(GoalContext, Msg),
- !:Msgs = [ContextMsg],
+ det_info_get_module_info(DetInfo, ModuleInfo),
+ PredPieces = describe_one_pred_name(ModuleInfo,
+ should_module_qualify, PredId),
+ FirstPieces = [words("Error: call to")] ++ PredPieces ++
+ [words("with determinism"),
+ quote(mercury_det_to_string(Detism0)),
+ words("occurs in a context which requires all solutions."),
+ nl],
+ ContextMsgs = failing_contexts_description(ModuleInfo, VarSet,
+ RightFailingContexts),
+ Spec = error_spec(severity_error, phase_detism_check,
+ [simple_msg(GoalContext, [always(FirstPieces)])] ++
+ ContextMsgs),
+ !:Specs = [Spec | !.Specs],
+
ProcId = ProcId0,
% Code elsewhere relies on the assumption that
% SolnContext = all_solns => NumSolns \= at_most_many_cc,
@@ -904,7 +950,6 @@
determinism_components(Detism, CanFail, at_most_many)
)
;
- !:Msgs = [],
ProcId = ProcId0,
Detism = Detism0
),
@@ -920,11 +965,12 @@
:- pred det_infer_generic_call(generic_call::in, determinism::in,
hlds_goal_info::in, soln_context::in,
list(failing_context)::in, det_info::in, determinism::out,
- list(failing_context)::out, list(context_det_msg)::out) is det.
+ list(failing_context)::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
det_infer_generic_call(GenericCall, CallDetism,
GoalInfo, SolnContext, RightFailingContexts, DetInfo,
- Detism, GoalFailingContexts, !:Msgs) :-
+ Detism, GoalFailingContexts, !Specs) :-
determinism_components(CallDetism, CanFail, NumSolns),
goal_info_get_context(GoalInfo, Context),
(
@@ -935,16 +981,21 @@
% Class method calls are only introduced by polymorphism.
det_get_proc_info(DetInfo, ProcInfo),
proc_info_get_varset(ProcInfo, VarSet),
- Msg = higher_order_cc_pred_in_wrong_context(GoalInfo, CallDetism,
- VarSet, RightFailingContexts),
- ContextMsg = context_det_msg(Context, Msg),
- !:Msgs = [ContextMsg],
+ FirstPieces = [words("Error: higher-order call to predicate with"),
+ words("determinism"), quote(mercury_det_to_string(CallDetism)),
+ words("occurs in a context which requires all solutions."), nl],
+ det_info_get_module_info(DetInfo, ModuleInfo),
+ ContextMsgs = failing_contexts_description(ModuleInfo, VarSet,
+ RightFailingContexts),
+ Spec = error_spec(severity_error, phase_detism_check,
+ [simple_msg(Context, [always(FirstPieces)])] ++ ContextMsgs),
+ !:Specs = [Spec | !.Specs],
+
% Code elsewhere relies on the assumption that
% SolnContext = all_soln => NumSolns \= at_most_many_cc,
% so we need to enforce that here.
determinism_components(Detism, CanFail, at_most_many)
;
- !:Msgs = [],
Detism = CallDetism
),
(
@@ -959,11 +1010,12 @@
pred_id::in, proc_id::in, pragma_foreign_code_impl::in,
hlds_goal_info::in, soln_context::in,
list(failing_context)::in, det_info::in, determinism::out,
- list(failing_context)::out, list(context_det_msg)::out) is det.
+ list(failing_context)::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
det_infer_foreign_proc(Attributes, PredId, ProcId, PragmaCode,
GoalInfo, SolnContext, RightFailingContexts, DetInfo,
- Detism, GoalFailingContexts, !:Msgs) :-
+ Detism, GoalFailingContexts, !Specs) :-
% Foreign_procs are handled in the same way as predicate calls.
det_info_get_module_info(DetInfo, ModuleInfo),
@@ -978,12 +1030,19 @@
Detism0 = detism_erroneous
->
proc_info_get_context(ProcInfo, ProcContext),
- WillNotThrowMsg = will_not_throw_with_erroneous(PredId, ProcId),
- WillNotThrowContextMsg =
- context_det_msg(ProcContext, WillNotThrowMsg),
- !:Msgs = [WillNotThrowContextMsg]
+ WillNotThrowProcPieces = describe_one_proc_name_mode(ModuleInfo,
+ should_not_module_qualify, proc(PredId, ProcId)),
+ WillNotThrowPieces = WillNotThrowProcPieces ++
+ [words("has determinism erroneous but also has"),
+ words("foreign clauses that have a"),
+ fixed("`will_not_throw_exception' attribute."),
+ words("This attribute cannot be applied"),
+ words("to erroneous procedures.")],
+ WillNotThrowSpec = error_spec(severity_error, phase_detism_check,
+ [simple_msg(ProcContext, [always(WillNotThrowPieces)])]),
+ !:Specs = [WillNotThrowSpec | !.Specs]
;
- !:Msgs = []
+ true
),
( PragmaCode = fc_impl_model_non(_, _, _, _, _, _, _, _, _) ->
% Foreign_procs codes of this form can have more than one
@@ -998,11 +1057,20 @@
->
goal_info_get_context(GoalInfo, GoalContext),
proc_info_get_varset(ProcInfo, VarSet),
- WrongContextMsg = cc_pred_in_wrong_context(GoalInfo, Detism0,
- PredId, ProcId, VarSet, RightFailingContexts),
- WrongContextContextMsg = context_det_msg(GoalContext,
- WrongContextMsg),
- !:Msgs = [WrongContextContextMsg | !.Msgs],
+ WrongContextPredPieces = describe_one_pred_name(ModuleInfo,
+ should_module_qualify, PredId),
+ WrongContextFirstPieces = [words("Error: call to")] ++
+ WrongContextPredPieces ++
+ [words("with determinism"),
+ quote(mercury_det_to_string(Detism0)),
+ words("occurs in a context which requires all solutions."),
+ nl],
+ ContextMsgs = failing_contexts_description(ModuleInfo, VarSet,
+ RightFailingContexts),
+ Spec = error_spec(severity_error, phase_detism_check,
+ [simple_msg(GoalContext, [always(WrongContextFirstPieces)])] ++
+ ContextMsgs),
+ !:Specs = [Spec | !.Specs],
NumSolns = at_most_many
;
NumSolns = NumSolns1
@@ -1019,9 +1087,14 @@
;
MaybeDetism = no,
proc_info_get_context(ProcInfo, Context),
- Msg = pragma_c_code_without_det_decl(PredId, ProcId),
- ContextMsg = context_det_msg(Context, Msg),
- !:Msgs = [ContextMsg],
+ ProcPieces = describe_one_proc_name_mode(ModuleInfo,
+ should_not_module_qualify, proc(PredId, ProcId)),
+ Pieces = [words("In")] ++ ProcPieces ++ [suffix(":"), nl,
+ words("error: `:- pragma foreign_proc(...)'"),
+ words("for a procedure without a determinism declaration.")],
+ Spec = error_spec(severity_error, phase_detism_check,
+ [simple_msg(Context, [always(Pieces)])]),
+ !:Specs = [Spec | !.Specs],
Detism = detism_erroneous,
GoalFailingContexts = []
).
@@ -1032,11 +1105,12 @@
unification::in, unify_context::in, unify_rhs::out,
hlds_goal_info::in, instmap::in, soln_context::in,
list(failing_context)::in, det_info::in, determinism::out,
- list(failing_context)::out, list(context_det_msg)::out) is det.
+ list(failing_context)::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
det_infer_unify(LHS, RHS0, Unify, UnifyContext, RHS, GoalInfo, InstMap0,
SolnContext, RightFailingContexts, DetInfo, Detism,
- GoalFailingContexts, !:Msgs) :-
+ GoalFailingContexts, !Specs) :-
% Unifications are either deterministic or semideterministic.
(
RHS0 = rhs_lambda_goal(Purity, PredOrFunc, EvalMethod, NonLocalVars,
@@ -1049,24 +1123,22 @@
det_info_get_module_info(DetInfo, ModuleInfo),
instmap.pre_lambda_update(ModuleInfo, Vars, Modes, InstMap0, InstMap1),
det_infer_goal(Goal0, Goal, InstMap1, LambdaSolnContext, [],
- no, DetInfo, LambdaInferredDet, _LambdaFailingContexts, GoalMsgs),
+ no, DetInfo, LambdaInferredDet, _LambdaFailingContexts, !Specs),
det_check_lambda(LambdaDeclaredDet, LambdaInferredDet,
- Goal, GoalInfo, DetInfo, CheckLambdaMsgs),
- !:Msgs = GoalMsgs ++ CheckLambdaMsgs,
+ Goal, GoalInfo, DetInfo, !Specs),
RHS = rhs_lambda_goal(Purity, PredOrFunc, EvalMethod, NonLocalVars,
Vars, Modes, LambdaDeclaredDet, Goal)
;
( RHS0 = rhs_var(_)
; RHS0 = rhs_functor(_, _, _)
),
- RHS = RHS0,
- !:Msgs = []
+ RHS = RHS0
),
det_infer_unify_canfail(Unify, UnifyCanFail),
det_infer_unify_examines_rep(Unify, ExaminesRepresentation),
det_check_for_noncanonical_type(LHS, ExaminesRepresentation,
UnifyCanFail, SolnContext, RightFailingContexts, [], GoalInfo,
- ccuc_unify(UnifyContext), DetInfo, UnifyNumSolns, !Msgs),
+ ccuc_unify(UnifyContext), DetInfo, UnifyNumSolns, !Specs),
determinism_components(Detism, UnifyCanFail, UnifyNumSolns),
(
UnifyCanFail = can_fail,
@@ -1102,11 +1174,12 @@
hlds_goal::in, hlds_goal::out, hlds_goal::in, hlds_goal::out,
instmap::in, soln_context::in, list(failing_context)::in,
maybe(pess_info)::in, det_info::in, determinism::out,
- list(failing_context)::out, list(context_det_msg)::out) is det.
+ list(failing_context)::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
det_infer_if_then_else(Cond0, Cond, Then0, Then, Else0, Else, InstMap0,
SolnContext, RightFailingContexts, MaybePromiseEqvSolutionSets,
- DetInfo, Detism, GoalFailingContexts, !:Msgs) :-
+ DetInfo, Detism, GoalFailingContexts, !Specs) :-
% We process the goal right-to-left, doing the `then' before the
% condition of the if-then-else, so that we can propagate the
% SolnContext correctly.
@@ -1115,7 +1188,7 @@
update_instmap(Cond0, InstMap0, InstMap1),
det_infer_goal(Then0, Then, InstMap1, SolnContext, RightFailingContexts,
MaybePromiseEqvSolutionSets, DetInfo, ThenDetism, ThenFailingContexts,
- ThenMsgs),
+ !Specs),
determinism_components(ThenDetism, ThenCanFail, ThenMaxSoln),
% Next, work out the right soln_context to use for the condition.
@@ -1133,13 +1206,13 @@
det_infer_goal(Cond0, Cond, InstMap0, CondSolnContext,
ThenFailingContexts ++ RightFailingContexts,
MaybePromiseEqvSolutionSets, DetInfo,
- CondDetism, _CondFailingContexts, CondMsgs),
+ CondDetism, _CondFailingContexts, !Specs),
determinism_components(CondDetism, CondCanFail, CondMaxSoln),
% Process the `else' part
det_infer_goal(Else0, Else, InstMap0, SolnContext, RightFailingContexts,
MaybePromiseEqvSolutionSets, DetInfo, ElseDetism, ElseFailingContexts,
- ElseMsgs),
+ !Specs),
determinism_components(ElseDetism, ElseCanFail, ElseMaxSoln),
% Finally combine the results from the three parts.
@@ -1166,15 +1239,15 @@
% Failing contexts in the condition are ignored, since they can't lead
% to failure of the if-then-else as a whole without one or more failing
% contexts in the then part or the else part.
- GoalFailingContexts = ThenFailingContexts ++ ElseFailingContexts,
- !:Msgs = CondMsgs ++ ThenMsgs ++ ElseMsgs.
+ GoalFailingContexts = ThenFailingContexts ++ ElseFailingContexts.
:- pred det_infer_not(hlds_goal::in, hlds_goal::out, hlds_goal_info::in,
instmap::in, maybe(pess_info)::in, det_info::in, determinism::out,
- list(failing_context)::out, list(context_det_msg)::out) is det.
+ list(failing_context)::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
det_infer_not(Goal0, Goal, GoalInfo, InstMap0, MaybePromiseEqvSolutionSets,
- DetInfo, Detism, GoalFailingContexts, !:Msgs) :-
+ DetInfo, Detism, GoalFailingContexts, !Specs) :-
% Negations are almost always semideterministic. It is an error for
% a negation to further instantiate any non-local variable. Such errors
% will be reported by the mode analysis.
@@ -1184,7 +1257,7 @@
% Answer: yes, probably, but it's not a high priority.
det_infer_goal(Goal0, Goal, InstMap0, first_soln, [],
MaybePromiseEqvSolutionSets, DetInfo, NegDetism, _NegatedGoalCanFail,
- !:Msgs),
+ !Specs),
det_negation_det(NegDetism, MaybeDetism),
(
MaybeDetism = no,
@@ -1208,12 +1281,12 @@
:- pred det_infer_scope(scope_reason::in, hlds_goal::in, hlds_goal::out,
hlds_goal_info::in, instmap::in, soln_context::in,
list(failing_context)::in, maybe(pess_info)::in, det_info::in,
- determinism::out, list(failing_context)::out, list(context_det_msg)::out)
- is det.
+ determinism::out, list(failing_context)::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
det_infer_scope(Reason, Goal0, Goal, GoalInfo, InstMap0, SolnContext,
RightFailingContexts, MaybePromiseEqvSolutionSets0, DetInfo, Detism,
- GoalFailingContexts, !:Msgs) :-
+ GoalFailingContexts, !Specs) :-
% Existential quantification may require a cut to throw away solutions,
% but we cannot rely on explicit quantification to detect this.
% Therefore cuts are handled in det_infer_goal.
@@ -1226,44 +1299,82 @@
(
Kind = equivalent_solutions,
SolnContextToUse = first_soln,
- MaybePromiseEqvSolutionSets = MaybePromiseEqvSolutionSets0,
- PromiseMsgs = []
+ MaybePromiseEqvSolutionSets = MaybePromiseEqvSolutionSets0
;
Kind = equivalent_solution_sets,
SolnContextToUse = SolnContext,
(
MaybePromiseEqvSolutionSets0 = no,
- MaybePromiseEqvSolutionSets = yes(pess_info(Vars, Context)),
- PromiseMsgs = []
+ MaybePromiseEqvSolutionSets = yes(pess_info(Vars, Context))
;
- MaybePromiseEqvSolutionSets0 = yes(pess_info(OldVars,
- OldContext)),
- PromiseMsg = nested_promise_eqv_solution_sets(OldContext),
- PromiseScopeMsg = context_det_msg(Context, PromiseMsg),
- PromiseMsgs = [PromiseScopeMsg],
- AllVars = set.union(list_to_set(OldVars), list_to_set(Vars)),
+ MaybePromiseEqvSolutionSets0 = yes(PESSInfo),
+ PESSInfo = pess_info(OuterVars, OuterContext),
+ NestedPieces = [words("Error: "),
+ words("`promise_equivalent_solution_sets' scope"),
+ words("is nested inside another.")],
+ NestedOuterPieces = [words("This is the outer"),
+ words("`promise_equivalent_solution_sets' scope.")],
+ NestedSeverity = severity_conditional(warn_simple_code, yes,
+ severity_warning, no),
+ NestedSpec = error_spec(NestedSeverity, phase_detism_check,
+ [simple_msg(Context,
+ [option_is_set(warn_simple_code, yes,
+ [always(NestedPieces)])]),
+ simple_msg(OuterContext,
+ [option_is_set(warn_simple_code, yes,
+ [always(NestedOuterPieces)])])
+ ]),
+ !:Specs = [NestedSpec | !.Specs],
+ AllVars = set.union(list_to_set(OuterVars), list_to_set(Vars)),
MaybePromiseEqvSolutionSets =
- yes(pess_info(to_sorted_list(AllVars), OldContext))
+ yes(pess_info(to_sorted_list(AllVars), OuterContext))
)
;
Kind = equivalent_solution_sets_arbitrary,
(
MaybePromiseEqvSolutionSets0 = no,
- PromiseMsg = arbitrary_without_promise,
- PromiseScopeMsg = context_det_msg(Context, PromiseMsg),
- PromiseMsgs = [PromiseScopeMsg]
+ ArbitraryPieces = [words("Error: "),
+ words("this `arbitrary' scope is not nested inside"),
+ words("a `promise_equivalent_solution_sets' scope.")],
+ ArbitrarySpec = error_spec(severity_error, phase_detism_check,
+ [simple_msg(Context, [always(ArbitraryPieces)])]),
+ !:Specs = [ArbitrarySpec | !.Specs]
;
MaybePromiseEqvSolutionSets0 = yes(pess_info(OldVars,
- OldContext)),
- IntersectVars = set.intersect(list_to_set(OldVars),
+ PromiseContext)),
+ OverlapVars = set.intersect(list_to_set(OldVars),
list_to_set(Vars)),
- ( set.empty(IntersectVars) ->
- PromiseMsgs = []
+ ( set.empty(OverlapVars) ->
+ true
;
- PromiseMsg = arbitrary_promise_overlap(OldContext,
- VarSet, IntersectVars),
- PromiseScopeMsg = context_det_msg(Context, PromiseMsg),
- PromiseMsgs = [PromiseScopeMsg]
+ OverlapVarNames = list.map(
+ lookup_var_name_in_varset(VarSet),
+ set.to_sorted_list(OverlapVars)),
+ (
+ OverlapVarNames = [],
+ unexpected(this_file, "det_report_msg: " ++
+ "arbitrary_promise_overlap empty")
+ ;
+ OverlapVarNames = [_],
+ OverlapVarStr = "the variable"
+ ;
+ OverlapVarNames = [_, _ | _],
+ OverlapVarStr = "the following variables:"
+ ),
+ OverlapPieces = [words("Error: "),
+ words("this `arbitrary' scope and the"),
+ words("`promise_equivalent_solution_sets' scope"),
+ words("it is nested inside overlap on"),
+ words(OverlapVarStr)] ++
+ list_to_pieces(OverlapVarNames) ++ [suffix(".")],
+ OverlapPromisePieces = [words("This is the outer "),
+ words("`promise_equivalent_solution_sets' scope.")],
+ OverlapSpec = error_spec(severity_error,
+ phase_detism_check,
+ [simple_msg(Context, [always(OverlapPieces)]),
+ simple_msg(PromiseContext,
+ [always(OverlapPromisePieces)])]),
+ !:Specs = [OverlapSpec | !.Specs]
)
),
MaybePromiseEqvSolutionSets = no,
@@ -1277,34 +1388,66 @@
% Which vars were bound inside the scope but not listed
% in the promise_equivalent_solution{s,_sets} or arbitrary scope?
- set.difference(BoundVars, set.list_to_set(Vars), BugVars),
- ( set.empty(BugVars) ->
- ScopeMsgs1 = []
- ;
- ScopeMsg1 = promise_solutions_missing_vars(Kind, VarSet, BugVars),
- ContextScopeMsg1 = context_det_msg(Context, ScopeMsg1),
- ScopeMsgs1 = [ContextScopeMsg1]
+ set.difference(BoundVars, set.list_to_set(Vars), MissingVars),
+ ( set.empty(MissingVars) ->
+ true
+ ;
+ MissingVarNames = list.map(lookup_var_name_in_varset(VarSet),
+ set.to_sorted_list(MissingVars)),
+ MissingKindStr = promise_solutions_kind_str(Kind),
+ (
+ MissingVarNames = [],
+ unexpected(this_file,
+ "det_infer_scope: promise_solutions_missing_vars empty")
+ ;
+ MissingVarNames = [_],
+ MissingListStr = "a variable that is not listed:"
+ ;
+ MissingVarNames = [_, _ | _],
+ MissingListStr = "some variables that are not listed:"
+ ),
+ MissingPieces = [words("Error: the"), quote(MissingKindStr),
+ words("goal binds"), words(MissingListStr)]
+ ++ list_to_pieces(MissingVarNames) ++ [suffix(".")],
+ MissingSpec = error_spec(severity_error, phase_detism_check,
+ [simple_msg(Context, [always(MissingPieces)])]),
+ !:Specs = [MissingSpec | !.Specs]
),
% Which vars were listed in the promise_equivalent_solutions
% but not bound inside the scope?
set.difference(set.list_to_set(Vars), BoundVars, ExtraVars),
( set.empty(ExtraVars) ->
- ScopeMsgs2 = []
+ true
+ ;
+ ExtraVarNames = list.map(lookup_var_name_in_varset(VarSet),
+ set.to_sorted_list(ExtraVars)),
+ ExtraKindStr = promise_solutions_kind_str(Kind),
+ (
+ ExtraVarNames = [],
+ unexpected(this_file,
+ "det_infer_scope: promise_solutions_extra_vars empty")
;
- ScopeMsg2 = promise_solutions_extra_vars(Kind, VarSet, ExtraVars),
- ContextScopeMsg2 = context_det_msg(Context, ScopeMsg2),
- ScopeMsgs2 = [ContextScopeMsg2]
+ ExtraVarNames = [_],
+ ExtraListStr = "an extra variable:"
+ ;
+ ExtraVarNames = [_, _ | _],
+ ExtraListStr = "some extra variables:"
+ ),
+ ExtraPieces = [words("Error: the"), quote(ExtraKindStr),
+ words("goal lists"), words(ExtraListStr)] ++
+ list_to_pieces(ExtraVarNames) ++ [suffix(".")],
+ ExtraSpec = error_spec(severity_error, phase_detism_check,
+ [simple_msg(Context, [always(ExtraPieces)])]),
+ !:Specs = [ExtraSpec | !.Specs]
),
- ScopeMsgs = ScopeMsgs1 ++ ScopeMsgs2,
det_infer_goal(Goal0, Goal, InstMap0, SolnContextToUse,
RightFailingContexts, MaybePromiseEqvSolutionSets, DetInfo, Detism,
- GoalFailingContexts, SubMsgs),
- !:Msgs = PromiseMsgs ++ SubMsgs ++ ScopeMsgs
+ GoalFailingContexts, !Specs)
;
Reason = trace_goal(_, _, _, _),
det_infer_goal(Goal0, Goal, InstMap0, SolnContext,
RightFailingContexts, MaybePromiseEqvSolutionSets0, DetInfo,
- Detism, GoalFailingContexts, !:Msgs),
+ Detism, GoalFailingContexts, !Specs),
(
( Detism = detism_det
; Detism = detism_cc_multi
@@ -1312,10 +1455,14 @@
->
true
;
- TraceMsg = trace_goal_not_det(Detism),
goal_info_get_context(GoalInfo, Context),
- ContextMsg = context_det_msg(Context, TraceMsg),
- !:Msgs = [ContextMsg | !.Msgs]
+ DetismStr = determinism_to_string(Detism),
+ Pieces = [words("Error: trace goal has determinism"),
+ quote(DetismStr), suffix(","),
+ words("should be det or cc_multi.")],
+ Spec = error_spec(severity_error, phase_detism_check,
+ [simple_msg(Context, [always(Pieces)])]),
+ !:Specs = [Spec | !.Specs]
)
;
( Reason = exist_quant(_)
@@ -1326,7 +1473,7 @@
),
det_infer_goal(Goal0, Goal, InstMap0, SolnContext,
RightFailingContexts, MaybePromiseEqvSolutionSets0, DetInfo,
- Detism, GoalFailingContexts, !:Msgs)
+ Detism, GoalFailingContexts, !Specs)
).
%-----------------------------------------------------------------------------%
@@ -1370,11 +1517,11 @@
:- pred det_check_for_noncanonical_type(prog_var::in, bool::in, can_fail::in,
soln_context::in, list(failing_context)::in, list(failing_context)::in,
hlds_goal_info::in, cc_unify_context::in, det_info::in, soln_count::out,
- list(context_det_msg)::in, list(context_det_msg)::out) is det.
+ list(error_spec)::in, list(error_spec)::out) is det.
det_check_for_noncanonical_type(Var, ExaminesRepresentation, CanFail,
SolnContext, FailingContextsA, FailingContextsB, GoalInfo, GoalContext,
- DetInfo, NumSolns, !Msgs) :-
+ DetInfo, NumSolns, !Specs) :-
(
% Check for unifications that attempt to examine the representation
% of a type that does not have a single representation for each
@@ -1389,16 +1536,87 @@
( CanFail = can_fail ->
goal_info_get_context(GoalInfo, Context),
proc_info_get_varset(ProcInfo, VarSet),
- Msg = cc_unify_can_fail(GoalInfo, Var, Type, VarSet, GoalContext),
- ContextMsg = context_det_msg(Context, Msg),
- !:Msgs = [ContextMsg | !.Msgs]
+ (
+ GoalContext = ccuc_switch,
+ VarStr = mercury_var_to_string(Var, VarSet, no),
+ Pieces0 = [words("In switch on variable"), quote(VarStr),
+ suffix(":"), nl]
+ ;
+ GoalContext = ccuc_unify(UnifyContext),
+ hlds_out.unify_context_to_pieces(UnifyContext, [], Pieces0)
+ ),
+ (
+ Pieces0 = [],
+ ErrorMsg = "Error:"
+ ;
+ Pieces0 = [_ | _],
+ ErrorMsg = "error:"
+ ),
+ Pieces1 = [words(ErrorMsg),
+ words("unification for non-canonical type"),
+ top_ctor_of_type(Type),
+ words("is not guaranteed to succeed.")],
+ VerbosePieces = [words("Since the type has a user-defined"),
+ words("equality predicate, I must presume that"),
+ words("there is more than one possible concrete"),
+ words("representation for each abstract value"),
+ words("of this type. The success of this unification"),
+ words("might depend on the choice of concrete"),
+ words("representation. Figuring out whether there is"),
+ words("a solution to this unification would require"),
+ words("backtracking over all possible"),
+ words("representations, but I'm not going to do that"),
+ words("implicitly. (If that's really what you want,"),
+ words("you must do it explicitly.)")],
+ Spec = error_spec(severity_error, phase_detism_check,
+ [simple_msg(Context,
+ [always(Pieces0 ++ Pieces1),
+ verbose_only(VerbosePieces)])]),
+ !:Specs = [Spec | !.Specs]
; SolnContext = all_solns ->
goal_info_get_context(GoalInfo, Context),
proc_info_get_varset(ProcInfo, VarSet),
- Msg = cc_unify_in_wrong_context(GoalInfo, Var, Type, VarSet,
- GoalContext, FailingContextsA ++ FailingContextsB),
- ContextMsg = context_det_msg(Context, Msg),
- !:Msgs = [ContextMsg | !.Msgs]
+ (
+ GoalContext = ccuc_switch,
+ VarStr = mercury_var_to_string(Var, VarSet, no),
+ Pieces0 = [words("In switch on variable `" ++ VarStr ++ "':"),
+ nl]
+ ;
+ GoalContext = ccuc_unify(UnifyContext),
+ unify_context_first_to_pieces(yes, _, UnifyContext, [], Pieces0)
+ ),
+ (
+ Pieces0 = [],
+ ErrorMsg = "Error:"
+ ;
+ Pieces0 = [_ | _],
+ ErrorMsg = "error:"
+ ),
+ Pieces1 = [words(ErrorMsg),
+ words("unification for non-canonical type"),
+ top_ctor_of_type(Type),
+ words("occurs in a context which requires all solutions."),
+ nl],
+ VerbosePieces = [words("Since the type has a user-defined"),
+ words("equality predicate, I must presume that"),
+ words("there is more than one possible concrete"),
+ words("representation for each abstract value"),
+ words("of this type. The results of this unification"),
+ words("might depend on the choice of concrete"),
+ words("representation. Finding all possible"),
+ words("solutions to this unification would require"),
+ words("backtracking over all possible"),
+ words("representations, but I'm not going to do that"),
+ words("implicitly. (If that's really what you want,"),
+ words("you must do it explicitly.)")],
+ det_info_get_module_info(DetInfo, ModuleInfo),
+ ContextMsgs = failing_contexts_description(ModuleInfo, VarSet,
+ FailingContextsA ++ FailingContextsB),
+ Spec = error_spec(severity_error, phase_detism_check,
+ [simple_msg(Context,
+ [always(Pieces0 ++ Pieces1), verbose_only(VerbosePieces)])]
+ ++ ContextMsgs),
+ !:Specs = [Spec | !.Specs]
;
true
),
Index: compiler/det_report.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_report.m,v
retrieving revision 1.130
diff -u -b -r1.130 det_report.m
--- compiler/det_report.m 27 Sep 2006 06:16:51 -0000 1.130
+++ compiler/det_report.m 12 Oct 2006 05:53:34 -0000
@@ -23,75 +23,16 @@
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
-:- import_module mdbcomp.
-:- import_module mdbcomp.prim_data.
+:- import_module libs.globals.
:- import_module parse_tree.
+:- import_module parse_tree.error_util.
:- import_module parse_tree.prog_data.
-:- import_module io.
:- import_module list.
:- import_module pair.
-:- import_module set.
%-----------------------------------------------------------------------------%
-:- type context_det_msg
- ---> context_det_msg(prog_context, det_msg).
-
-:- type det_msg
- % The following are warnings.
-
- ---> multidet_disj(list(prog_context))
- ; det_disj(list(prog_context))
- ; semidet_disj(list(prog_context))
- ; zero_soln_disj(list(prog_context))
- ; zero_soln_disjunct
- ; ite_cond_cannot_fail
- ; ite_cond_cannot_succeed
- ; negated_goal_cannot_fail
- ; negated_goal_cannot_succeed
- ; goal_cannot_succeed
- ; det_goal_has_no_outputs
- ; warn_call_to_obsolete(pred_id)
- % Warning about calls to predicates for which there is
- % a `:- pragma obsolete' declaration.
- ; warn_infinite_recursion
- % Warning about recursive calls which would cause infinite loops.
- ; duplicate_call(seen_call_id, prog_context)
- % Multiple calls with the same input args.
- ; unknown_format_string(sym_name, arity)
- ; unknown_format_values(sym_name, arity)
- ; bad_format(sym_name, arity, string)
- ; nested_promise_eqv_solution_sets(prog_context)
-
- % The following are errors.
-
- ; cc_unify_can_fail(hlds_goal_info, prog_var, mer_type,
- prog_varset, cc_unify_context)
- ; cc_unify_in_wrong_context(hlds_goal_info, prog_var,
- mer_type, prog_varset, cc_unify_context, list(failing_context))
- ; cc_pred_in_wrong_context(hlds_goal_info, determinism,
- pred_id, proc_id, prog_varset, list(failing_context))
- ; higher_order_cc_pred_in_wrong_context(hlds_goal_info, determinism,
- prog_varset, list(failing_context))
- ; error_in_lambda(determinism, determinism, % declared, inferred
- hlds_goal, hlds_goal_info, pred_id, proc_id)
- ; par_conj_not_det(determinism, pred_id, proc_id,
- hlds_goal_info, list(hlds_goal))
- ; pragma_c_code_without_det_decl(pred_id, proc_id)
- ; has_io_state_but_not_det(pred_id, proc_id)
- ; will_not_throw_with_erroneous(pred_id, proc_id)
- ; export_model_non_proc(pred_id, proc_id, determinism)
- % Procedure with multi or nondet detism exported
- % via :- pragma export ...
- ; arbitrary_without_promise
- ; arbitrary_promise_overlap(prog_context, prog_varset, set(prog_var))
- ; promise_solutions_missing_vars(promise_solutions_kind, prog_varset,
- set(prog_var))
- ; promise_solutions_extra_vars(promise_solutions_kind, prog_varset,
- set(prog_var))
- ; trace_goal_not_det(determinism).
-
:- type seen_call_id
---> seen_call(pred_id, proc_id)
; higher_order_call.
@@ -116,39 +57,44 @@
% Check all the determinism declarations in this module.
% This is the main predicate exported by this module.
%
-:- pred global_checking_pass(pred_proc_list::in,
- module_info::in, module_info::out, io::di, io::uo) is det.
+:- pred global_checking_pass(pred_proc_list::in, module_info::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
% Check a lambda goal with the specified declared and inferred
% determinisms.
%
:- pred det_check_lambda(determinism::in, determinism::in, hlds_goal::in,
- hlds_goal_info::in, det_info::in, list(context_det_msg)::out) is det.
+ hlds_goal_info::in, det_info::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
- % Print some determinism warning and/or error messages,
- % and update the module info accordingly.
+ % det_diagnose_conj(Goals, Desired, FailingContexts, DetInfo, Msgs):
+ %
+ % The conjunction Goals should have determinism Desired, but doesn't.
+ % Find out what is wrong, and return a list of messages giving the causes.
%
-:- pred det_report_and_handle_msgs(list(context_det_msg)::in,
- module_info::in, module_info::out, io::di, io::uo) is det.
+ % det_diagnose_conj is used for both normal [sequential] conjunctions
+ % and parallel conjunctions.
+ %
+:- pred det_diagnose_conj(list(hlds_goal)::in, determinism::in,
+ list(switch_context)::in, det_info::in, list(error_msg)::out) is det.
- % Print some determinism warning and/or error messages,
- % and return the number of warnings and errors, so that code
- % somewhere elsewhere can update the module info.
+ % Return a printable representation of the given promise_solutions_kind.
%
-:- pred det_report_msgs(list(context_det_msg)::in, module_info::in,
- int::out, int::out, io::di, io::uo) is det.
+:- func promise_solutions_kind_str(promise_solutions_kind) = string.
-:- type msg_modes
- ---> all_modes % The warning should be reported only
- % if it occurs in all modes of the predicate.
+ % Return the name of the given variable in the given varset.
+ %
+:- func lookup_var_name_in_varset(prog_varset, prog_var) = string.
- ; any_mode. % The warning should be reported
- % if it occurs in any mode of the predicate
+ % Describe the given list of failing contexts.
+ %
+:- func failing_contexts_description(module_info, prog_varset,
+ list(failing_context)) = list(error_msg).
- % Decide if the warning should be reported if it occurs in
- % any mode of the predicate, not only if it occurs in all modes.
+ % Describe a call we have seen.
%
-:- pred det_msg_is_any_mode_msg(det_msg::in, msg_modes::out) is det.
+:- func det_report_seen_call_id(module_info, seen_call_id)
+ = list(format_component).
%-----------------------------------------------------------------------------%
@@ -157,9 +103,11 @@
% Call this predicate before rerunning determinism analysis after an
% optimization pass to disable all warnings. Errors will still be reported.
%
-:- pred disable_det_warnings(options_to_restore::out, io::di, io::uo) is det.
+:- pred disable_det_warnings(options_to_restore::out,
+ globals::in, globals::out) is det.
-:- pred restore_det_warnings(options_to_restore::in, io::di, io::uo) is det.
+:- pred restore_det_warnings(options_to_restore::in,
+ globals::in, globals::out) is det.
%-----------------------------------------------------------------------------%
@@ -182,10 +130,10 @@
:- import_module hlds.hlds_out.
:- import_module libs.
:- import_module libs.compiler_util.
-:- import_module libs.globals.
:- import_module libs.options.
+:- import_module mdbcomp.
+:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.prim_data.
-:- import_module parse_tree.error_util.
:- import_module parse_tree.mercury_to_mercury.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_type.
@@ -197,6 +145,7 @@
:- import_module int.
:- import_module map.
:- import_module maybe.
+:- import_module set.
:- import_module solutions.
:- import_module string.
:- import_module term.
@@ -204,38 +153,38 @@
%-----------------------------------------------------------------------------%
-global_checking_pass([], !ModuleInfo, !IO).
-global_checking_pass([proc(PredId, ProcId) | Rest], !ModuleInfo, !IO) :-
- module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
+global_checking_pass([], _, !Specs).
+global_checking_pass([proc(PredId, ProcId) | Rest], ModuleInfo, !Specs) :-
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
PredInfo, ProcInfo),
- check_determinism(PredId, ProcId, PredInfo, ProcInfo, !ModuleInfo, !IO),
- check_determinism_of_main(PredId, ProcId, PredInfo, ProcInfo, !ModuleInfo,
- !IO),
- check_for_multisoln_func(PredId, ProcId, PredInfo, ProcInfo, !ModuleInfo,
- !IO),
- global_checking_pass(Rest, !ModuleInfo, !IO).
+ check_determinism(PredId, ProcId, PredInfo, ProcInfo, ModuleInfo, !Specs),
+ check_determinism_of_main(PredId, ProcId, PredInfo, ProcInfo,
+ !Specs),
+ check_for_multisoln_func(PredId, ProcId, PredInfo, ProcInfo, ModuleInfo,
+ !Specs),
+ global_checking_pass(Rest, ModuleInfo, !Specs).
:- pred check_determinism(pred_id::in, proc_id::in, pred_info::in,
- proc_info::in, module_info::in, module_info::out, io::di, io::uo) is det.
+ proc_info::in, module_info::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
-check_determinism(PredId, ProcId, PredInfo0, ProcInfo0, !ModuleInfo, !IO) :-
+check_determinism(PredId, ProcId, PredInfo0, ProcInfo0, ModuleInfo, !Specs) :-
proc_info_get_declared_determinism(ProcInfo0, MaybeDetism),
proc_info_get_inferred_determinism(ProcInfo0, InferredDetism),
(
- MaybeDetism = no,
- CmpSpecs = []
+ MaybeDetism = no
;
MaybeDetism = yes(DeclaredDetism),
compare_determinisms(DeclaredDetism, InferredDetism, Cmp),
(
- Cmp = sameas,
- CmpSpecs = []
+ Cmp = sameas
;
Cmp = looser,
- globals.io_lookup_bool_option(warn_det_decls_too_lax,
- ShouldIssueWarning, !IO),
- globals.io_lookup_bool_option(warn_inferred_erroneous,
- WarnAboutInferredErroneous, !IO),
+ module_info_get_globals(ModuleInfo, Globals),
+ globals.lookup_bool_option(Globals, warn_det_decls_too_lax,
+ ShouldIssueWarning),
+ globals.lookup_bool_option(Globals, warn_inferred_erroneous,
+ WarnAboutInferredErroneous),
pred_info_get_markers(PredInfo0, Markers),
(
ShouldIssueWarning = yes,
@@ -268,42 +217,37 @@
->
Message = "warning: determinism declaration " ++
"could be tighter.\n",
- report_determinism_problem(PredId, ProcId, !.ModuleInfo,
+ report_determinism_problem(PredId, ProcId, ModuleInfo,
Message, DeclaredDetism, InferredDetism, ReportMsgs),
ReportSpec = error_spec(severity_warning, phase_detism_check,
ReportMsgs),
- CmpSpecs = [ReportSpec]
+ !:Specs = [ReportSpec | !.Specs]
;
- CmpSpecs = []
+ true
)
;
Cmp = tighter,
Message = "error: determinism declaration not satisfied.\n",
- report_determinism_problem(PredId, ProcId, !.ModuleInfo, Message,
+ report_determinism_problem(PredId, ProcId, ModuleInfo, Message,
DeclaredDetism, InferredDetism, ReportMsgs),
proc_info_get_goal(ProcInfo0, Goal),
proc_info_get_vartypes(ProcInfo0, VarTypes),
- globals.io_get_globals(Globals, !IO),
- det_info_init(!.ModuleInfo, VarTypes, PredId, ProcId, Globals,
- DetInfo),
+ det_info_init(ModuleInfo, VarTypes, PredId, ProcId, DetInfo),
det_diagnose_goal(Goal, DeclaredDetism, [], DetInfo, GoalMsgs0),
sort_error_msgs(GoalMsgs0, GoalMsgs),
ReportSpec = error_spec(severity_error, phase_detism_check,
ReportMsgs ++ GoalMsgs),
- CmpSpecs = [ReportSpec]
+ !:Specs = [ReportSpec | !.Specs]
)
),
% Make sure the code model is valid given the eval method.
proc_info_get_eval_method(ProcInfo0, EvalMethod),
- ( valid_determinism_for_eval_method(EvalMethod, InferredDetism) = yes ->
- proc_info_set_eval_method(EvalMethod, ProcInfo0, ProcInfo),
- pred_info_get_procedures(PredInfo0, ProcTable0),
- map.det_update(ProcTable0, ProcId, ProcInfo, ProcTable),
- pred_info_set_procedures(ProcTable, PredInfo0, PredInfo),
- module_info_set_pred_info(PredId, PredInfo, !ModuleInfo),
- ValidSpecs = []
+ Valid = valid_determinism_for_eval_method(EvalMethod, InferredDetism),
+ (
+ Valid = yes
;
+ Valid = no,
proc_info_get_context(ProcInfo0, Context),
MainPieces =
[words("Error: `pragma "
@@ -315,23 +259,18 @@
solutions.solutions(get_valid_dets(EvalMethod), Detisms),
DetismStrs = list.map(determinism_to_string, Detisms),
list.sort(DetismStrs, SortedDetismStrs),
- ( list.length(Detisms) = 1 ->
- Plural = ""
- ;
- Plural = "s"
- ),
DetismPieces = list_to_pieces(SortedDetismStrs),
VerbosePieces =
[words("The pragma requested is only valid"),
- words("for the following determinism" ++ Plural ++ ":") |
+ words("for the following"),
+ words(choose_number(Detisms, "determinism", "determinisms")),
+ suffix(":") |
DetismPieces] ++ [suffix("."), nl],
- ValidSpecs = [error_spec(severity_error, phase_detism_check,
+ ValidSpec = error_spec(severity_error, phase_detism_check,
[simple_msg(Context,
- [always(MainPieces), verbose_only(VerbosePieces)])])]
- ),
- write_error_specs(CmpSpecs ++ ValidSpecs, 0, _NumWarnings, 0, NumErrors,
- !IO),
- module_info_incr_num_errors(NumErrors, !ModuleInfo).
+ [always(MainPieces), verbose_only(VerbosePieces)])]),
+ !:Specs = [ValidSpec | !.Specs]
+ ).
:- pred get_valid_dets(eval_method::in, determinism::out) is nondet.
@@ -355,11 +294,10 @@
determinism(detism_failure).
:- pred check_determinism_of_main(pred_id::in, proc_id::in,
- pred_info::in, proc_info::in, module_info::in, module_info::out,
- io::di, io::uo) is det.
+ pred_info::in, proc_info::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
-check_determinism_of_main(_PredId, _ProcId, PredInfo, ProcInfo,
- !ModuleInfo, !IO) :-
+check_determinism_of_main(_PredId, _ProcId, PredInfo, ProcInfo, !Specs) :-
% Check that `main/2' has determinism `det' or `cc_multi',
% as required by the language reference manual.
proc_info_get_declared_determinism(ProcInfo, MaybeDetism),
@@ -378,23 +316,23 @@
Pieces = [words("Error: main/2 must be `det' or `cc_multi'.")],
Spec = error_spec(severity_error, phase_detism_check,
[simple_msg(ProcContext, [always(Pieces)])]),
- write_error_spec(Spec, 0, _NumWarnings, 0, NumErrors, !IO),
- module_info_incr_num_errors(NumErrors, !ModuleInfo)
+ !:Specs = [Spec | !.Specs]
;
true
).
:- pred check_for_multisoln_func(pred_id::in, proc_id::in, pred_info::in,
- proc_info::in, module_info::in, module_info::out, io::di, io::uo) is det.
+ proc_info::in, module_info::in,
+ list(error_spec)::in, list(error_spec)::out) is det.
-check_for_multisoln_func(PredId, _ProcId, PredInfo, ProcInfo,
- !ModuleInfo, !IO) :-
+check_for_multisoln_func(PredId, _ProcId, PredInfo, ProcInfo, ModuleInfo,
+ !Specs) :-
proc_info_get_inferred_determinism(ProcInfo, InferredDetism),
- % Functions can only have more than one solution if it is a
- % non-standard mode. Otherwise, they would not be referentially
- % transparent. (Nondeterministic "functions" like C's `rand()'
- % function are not allowed.)
+ % Functions can only have more than one solution if it is a non-standard
+ % mode. Otherwise, they would not be referentially transparent.
+ % (Nondeterministic "functions" like C's `rand()' function are not
+ % allowed.)
(
% If it is a mode for a function...
pred_info_is_pred_or_func(PredInfo) = function,
@@ -408,13 +346,13 @@
(
list.member(FuncArgMode, FuncArgModes)
=>
- mode_is_fully_input(!.ModuleInfo, FuncArgMode)
+ mode_is_fully_input(ModuleInfo, FuncArgMode)
)
->
% ... then it is an error.
proc_info_get_context(ProcInfo, FuncContext),
proc_info_get_inst_varset(ProcInfo, InstVarSet),
- PredModePieces = describe_one_pred_name_mode(!.ModuleInfo,
+ PredModePieces = describe_one_pred_name_mode(ModuleInfo,
should_not_module_qualify, PredId, InstVarSet, PredArgModes),
MainPieces = [words("Error: invalid determinism for")]
++ PredModePieces ++ [suffix(":"), nl,
@@ -424,8 +362,7 @@
Spec = error_spec(severity_error, phase_detism_check,
[simple_msg(FuncContext,
[always(MainPieces), verbose_only(VerbosePieces)])]),
- write_error_spec(Spec, 0, _NumWarnings, 0, NumErrors, !IO),
- module_info_incr_num_errors(NumErrors, !ModuleInfo)
+ !:Specs = [Spec | !.Specs]
;
true
).
@@ -442,24 +379,34 @@
].
det_check_lambda(DeclaredDetism, InferredDetism, Goal, GoalInfo, DetInfo,
- Msgs) :-
+ !Specs) :-
compare_determinisms(DeclaredDetism, InferredDetism, Cmp),
(
Cmp = tighter,
det_info_get_pred_id(DetInfo, PredId),
det_info_get_proc_id(DetInfo, ProcId),
goal_info_get_context(GoalInfo, Context),
- Msg = error_in_lambda(DeclaredDetism, InferredDetism, Goal, GoalInfo,
- PredId, ProcId),
- ContextMsg = context_det_msg(Context, Msg),
- Msgs = [ContextMsg]
+ det_info_get_module_info(DetInfo, ModuleInfo),
+ PredPieces = describe_one_proc_name_mode(ModuleInfo,
+ should_not_module_qualify, proc(PredId, ProcId)),
+ Pieces =
+ [words("In")] ++ PredPieces ++ [suffix(":"), nl,
+ words("Determinism error in lambda expression."), nl,
+ words("Declared"),
+ quote(determinism_to_string(DeclaredDetism)), suffix(","),
+ words("inferred"),
+ quote(determinism_to_string(InferredDetism)), suffix("'.")],
+ det_diagnose_goal(Goal, DeclaredDetism, [], DetInfo, GoalMsgs),
+ sort_error_msgs(GoalMsgs, SortedGoalMsgs),
+ Spec = error_spec(severity_error, phase_detism_check,
+ [simple_msg(Context, [always(Pieces)])] ++ SortedGoalMsgs),
+ !:Specs = [Spec | !.Specs]
;
( Cmp = sameas
; Cmp = looser
- ),
+ )
% We don't bother issuing warnings if the determinism was too loose;
% that will often be the case, and should not be warned about.
- Msgs = []
).
:- pred report_determinism_problem(pred_id::in, proc_id::in, module_info::in,
@@ -534,7 +481,7 @@
%-----------------------------------------------------------------------------%
% The given goal should have determinism Desired, but doesn't.
- % Find out what is wrong and print a report of the cause.
+ % Find out what is wrong, and return a list of messages giving the causes.
%
:- pred det_diagnose_goal(hlds_goal::in, determinism::in,
list(switch_context)::in, det_info::in, list(error_msg)::out) is det.
@@ -757,12 +704,6 @@
),
Msgs = [simple_msg(Context, [always(StartingPieces ++ Pieces)])].
- % det_diagnose_conj is used for both normal [sequential] conjunction
- % and parallel conjunction.
- %
-:- pred det_diagnose_conj(list(hlds_goal)::in, determinism::in,
- list(switch_context)::in, det_info::in, list(error_msg)::out) is det.
-
det_diagnose_conj([], _Desired, _SwitchContext, _DetInfo, []).
det_diagnose_conj([Goal | Goals], Desired, SwitchContext, DetInfo, Msgs) :-
det_diagnose_goal(Goal, Desired, SwitchContext, DetInfo, Msgs1),
@@ -993,508 +934,6 @@
%-----------------------------------------------------------------------------%
-:- type det_msg_type
- ---> simple_code_warning
- ; call_warning
- ; format_unknown
- ; format_known_bad
- ; det_error.
-
-det_report_and_handle_msgs(Msgs, !ModuleInfo, !IO) :-
- (
- Msgs = []
- % fast path for the usual case
- ;
- Msgs = [_ | _],
- det_report_msgs(Msgs, !.ModuleInfo, WarnCnt, ErrCnt, !IO),
- globals.io_lookup_bool_option(halt_at_warn, HaltAtWarn, !IO),
- (
- (
- ErrCnt > 0
- ;
- WarnCnt > 0,
- HaltAtWarn = yes
- )
- ->
- io.set_exit_status(1, !IO),
- module_info_incr_errors(!ModuleInfo)
- ;
- true
- )
- ).
-
-det_report_msgs(ContextMsgs, ModuleInfo, WarnCnt, ErrCnt, !IO) :-
- Specs0 = list.map(det_report_to_error_spec(ModuleInfo), ContextMsgs),
- % Programmers prefer reading messages in order of context.
- sort_error_specs(Specs0, Specs),
- write_error_specs(Specs, 0, WarnCnt, 0, ErrCnt, !IO).
-
-:- func det_report_to_error_spec(module_info, context_det_msg) = error_spec.
-
-det_report_to_error_spec(ModuleInfo, ContextDetMsg) = Spec :-
- ContextDetMsg = context_det_msg(Context, DetMsg),
- (
- (
- DetMsg = multidet_disj(DisjunctContexts),
- Pieces = [words("Warning: the disjunction with arms on lines"),
- words(det_report_context_lines(DisjunctContexts)),
- words("has no outputs, but can succeed more than once.")]
- ;
- DetMsg = det_disj(DisjunctContexts),
- Pieces = [words("Warning: the disjunction with arms on lines"),
- words(det_report_context_lines(DisjunctContexts)),
- words("will succeed exactly once.")]
- ;
- DetMsg = semidet_disj(DisjunctContexts),
- Pieces = [words("Warning: the disjunction with arms on lines"),
- words(det_report_context_lines(DisjunctContexts)),
- words("is semidet, yet it has an output.")]
- ;
- DetMsg = zero_soln_disj(DisjunctContexts),
- Pieces = [words("Warning: the disjunction with arms on lines"),
- words(det_report_context_lines(DisjunctContexts)),
- words("cannot succeed.")]
- ;
- DetMsg = zero_soln_disjunct,
- Pieces = [words("Warning: this disjunct"),
- words("will never have any solutions.")]
- ;
- DetMsg = ite_cond_cannot_fail,
- Pieces = [words("Warning: the condition of this if-then-else"),
- words("cannot fail.")]
- ;
- DetMsg = ite_cond_cannot_succeed,
- Pieces = [words("Warning: the condition of this if-then-else"),
- words("cannot succeed.")]
- ;
- DetMsg = negated_goal_cannot_fail,
- Pieces = [words("Warning: the negated goal cannot fail.")]
- ;
- DetMsg = negated_goal_cannot_succeed,
- Pieces = [words("Warning: the negated goal cannot succeed.")]
- ;
- DetMsg = warn_call_to_obsolete(PredId),
- % XXX warn_obsolete isn't really a simple code warning.
- % We should add a separate warning type for this.
- PredPieces = describe_one_pred_name(ModuleInfo,
- should_module_qualify, PredId),
- Pieces = [words("Warning: call to obsolete")] ++ PredPieces
- ++ [suffix(".")]
- ),
- 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)])])])
- ;
- (
- DetMsg = goal_cannot_succeed,
- MainPieces = [words("Warning: this goal cannot succeed.")],
- VerbosePieces =
- [words("The compiler will optimize away this goal,"),
- words("replacing it with `fail'."),
- words("To disable this optimization, use"),
- words("the `--fully-strict' option.")]
- ;
- DetMsg = det_goal_has_no_outputs,
- MainPieces = [words("Warning: det goal has no outputs.")],
- VerbosePieces =
- [words("The compiler will optimize away this goal,"),
- words("replacing it with `true'."),
- words("To disable this optimization, use"),
- words("the `--fully-strict' option.")]
- ;
- DetMsg = warn_infinite_recursion,
- % It would be better if we supplied more information than just
- % the line number, e.g. we should print the name of the containing
- % predicate.
- MainPieces = [words("Warning: recursive call will lead"),
- words("to infinite recursion.")],
- VerbosePieces = [words("If this recursive call is executed,"),
- words("the procedure will call itself"),
- words("with exactly the same input arguments,"),
- words("leading to infinite recursion.")]
- ),
- 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)])])])
- ;
- DetMsg = duplicate_call(SeenCall, PrevContext),
- CallPieces = det_report_seen_call_id(ModuleInfo, SeenCall),
- CurPieces = [words("Warning: redundant") | CallPieces]
- ++ [suffix(".")],
- PrevPieces = [words("Here is the previous") | CallPieces]
- ++ [suffix(".")],
- 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)])]),
- error_msg(yes(PrevContext), yes, 0,
- [option_is_set(warn_duplicate_calls, yes,
- [always(PrevPieces)])])
- ])
- ;
- DetMsg = nested_promise_eqv_solution_sets(OuterContext),
- Pieces = [words("Error: "),
- words("`promise_equivalent_solution_sets' scope"),
- words("is nested inside another.")],
- OuterPieces = [words("This is the outer"),
- words("`promise_equivalent_solution_sets' scope.")],
- 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,
- [option_is_set(warn_simple_code, yes, [always(OuterPieces)])])
- ])
- ;
- (
- DetMsg = unknown_format_string(SymName, Arity),
- Pieces = [words("Unknown format string in call to"),
- sym_name_and_arity(SymName / Arity), suffix(".")]
- ;
- DetMsg = unknown_format_values(SymName, Arity),
- Pieces = [words("Unknown format values in call to"),
- sym_name_and_arity(SymName / Arity), suffix(".")]
- ),
- 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)])])])
- ;
- 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)],
- 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)])])])
- ;
- DetMsg = cc_unify_can_fail(_GoalInfo, Var, Type, VarSet, GoalContext),
- (
- GoalContext = ccuc_switch,
- VarStr = mercury_var_to_string(Var, VarSet, no),
- Pieces0 = [words("In switch on variable"), quote(VarStr),
- suffix(":"), nl]
- ;
- GoalContext = ccuc_unify(UnifyContext),
- hlds_out.unify_context_to_pieces(UnifyContext, [], Pieces0)
- ),
- ( type_to_ctor_and_args(Type, TypeCtor, _TypeArgs) ->
- TypeCtor = type_ctor(TypeCtorName, TypeCtorArity),
- TypeCtorSymName = TypeCtorName / TypeCtorArity
- ;
- unexpected(this_file, "det_report_to_error_spec: " ++
- "cc_unify_can_fail: type_to_ctor_and_args failed")
- ),
- (
- Pieces0 = [],
- ErrorMsg = "Error:"
- ;
- Pieces0 = [_ | _],
- ErrorMsg = "error:"
- ),
- Pieces1 = [words(ErrorMsg),
- words("unification for non-canonical type"),
- sym_name_and_arity(TypeCtorSymName),
- words("is not guaranteed to succeed.")],
- VerbosePieces = [words("Since the type has a user-defined"),
- words("equality predicate, I must presume that"),
- words("there is more than one possible concrete"),
- words("representation for each abstract value"),
- words("of this type. The success of this unification"),
- words("might depend on the choice of concrete"),
- words("representation. Figuring out whether there is"),
- words("a solution to this unification would require"),
- words("backtracking over all possible"),
- words("representations, but I'm not going to do that"),
- words("implicitly. (If that's really what you want,"),
- words("you must do it explicitly.)")],
- Spec = error_spec(severity_error, phase_detism_check,
- [simple_msg(Context,
- [always(Pieces0 ++ Pieces1), verbose_only(VerbosePieces)])])
- ;
- DetMsg = cc_unify_in_wrong_context(_GoalInfo, Var, Type, VarSet,
- GoalContext, FailingContexts),
- (
- GoalContext = ccuc_switch,
- VarStr = mercury_var_to_string(Var, VarSet, no),
- Pieces0 = [words("In switch on variable `" ++ VarStr ++ "':"), nl]
- ;
- GoalContext = ccuc_unify(UnifyContext),
- unify_context_first_to_pieces(yes, _, UnifyContext, [], Pieces0)
- ),
- ( type_to_ctor_and_args(Type, TypeCtor, _TypeArgs) ->
- TypeCtorStr = hlds_out.type_ctor_to_string(TypeCtor)
- ;
- unexpected(this_file, "det_report_msg: " ++
- "cc_unify_in_wrong_context: type_to_ctor_and_args failed")
- ),
- (
- Pieces0 = [],
- ErrorMsg = "Error:"
- ;
- Pieces0 = [_ | _],
- ErrorMsg = "error:"
- ),
- Pieces1 = [words(ErrorMsg),
- words("unification for non-canonical type"),
- words("`" ++ TypeCtorStr ++ "'"),
- words("occurs in a context which requires all solutions."), nl],
- VerbosePieces = [words("Since the type has a user-defined"),
- words("equality predicate, I must presume that"),
- words("there is more than one possible concrete"),
- words("representation for each abstract value"),
- words("of this type. The results of this unification"),
- words("might depend on the choice of concrete"),
- words("representation. Finding all possible"),
- words("solutions to this unification would require"),
- words("backtracking over all possible"),
- words("representations, but I'm not going to do that"),
- words("implicitly. (If that's really what you want,"),
- words("you must do it explicitly.)")],
- ContextMsgs = failing_contexts_description(ModuleInfo, VarSet,
- FailingContexts),
- Spec = error_spec(severity_error, phase_detism_check,
- [simple_msg(Context,
- [always(Pieces0 ++ Pieces1), verbose_only(VerbosePieces)])]
- ++ ContextMsgs)
- ;
- DetMsg = cc_pred_in_wrong_context(_GoalInfo, Detism, PredId,
- _ModeId, VarSet, FailingContexts),
- PredPieces = describe_one_pred_name(ModuleInfo, should_module_qualify,
- PredId),
- FirstPieces = [words("Error: call to")] ++ PredPieces ++
- [words("with determinism"), quote(mercury_det_to_string(Detism)),
- words("occurs in a context which requires all solutions."), nl],
- ContextMsgs = failing_contexts_description(ModuleInfo, VarSet,
- FailingContexts),
- Spec = error_spec(severity_error, phase_detism_check,
- [simple_msg(Context, [always(FirstPieces)])] ++ ContextMsgs)
- ;
- DetMsg = higher_order_cc_pred_in_wrong_context(_GoalInfo, Detism,
- VarSet, FailingContexts),
- FirstPieces = [words("Error: higher-order call to predicate with"),
- words("determinism"), quote(mercury_det_to_string(Detism)),
- words("occurs in a context which requires all solutions."), nl],
- ContextMsgs = failing_contexts_description(ModuleInfo, VarSet,
- FailingContexts),
- Spec = error_spec(severity_error, phase_detism_check,
- [simple_msg(Context, [always(FirstPieces)])] ++ ContextMsgs)
- ;
- DetMsg = error_in_lambda(DeclaredDetism, InferredDetism,
- Goal, _GoalInfo, PredId, ProcId),
- PredPieces = describe_one_proc_name_mode(ModuleInfo,
- should_not_module_qualify, proc(PredId, ProcId)),
- Pieces =
- [words("In")] ++ PredPieces ++ [suffix(":"), nl,
- words("Determinism error in lambda expression."), nl,
- words("Declared"),
- quote(determinism_to_string(DeclaredDetism)), suffix(","),
- words("inferred"),
- quote(determinism_to_string(InferredDetism)), suffix("'.")],
- module_info_get_globals(ModuleInfo, Globals),
- module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
- proc_info_get_vartypes(ProcInfo, VarTypes),
- det_info_init(ModuleInfo, VarTypes, PredId, ProcId, Globals, DetInfo),
- det_diagnose_goal(Goal, DeclaredDetism, [], DetInfo, GoalMsgs0),
- sort_error_msgs(GoalMsgs0, GoalMsgs),
- Spec = error_spec(severity_error, phase_detism_check,
- [simple_msg(Context, [always(Pieces)])] ++ GoalMsgs)
- ;
- DetMsg = par_conj_not_det(InferredDetism, PredId, ProcId,
- _GoalInfo, Goals),
- determinism_components(InferredDetism, CanFail, MaxSoln),
- ( CanFail \= cannot_fail ->
- First = "Error: parallel conjunct may fail."
- ; MaxSoln = at_most_many ->
- First = "Error: parallel conjunct may have multiple solutions."
- ;
- unexpected(this_file,
- "strange determinism error for parallel conjunction")
- ),
- Rest = "The current implementation supports only "
- ++ "single-solution non-failing parallel conjunctions.",
- Pieces = [words(First), words(Rest)],
- module_info_get_globals(ModuleInfo, Globals),
- module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
- proc_info_get_vartypes(ProcInfo, VarTypes),
- det_info_init(ModuleInfo, VarTypes, PredId, ProcId, Globals, DetInfo),
- det_diagnose_conj(Goals, detism_det, [], DetInfo, GoalMsgs0),
- sort_error_msgs(GoalMsgs0, GoalMsgs),
- Spec = error_spec(severity_error, phase_detism_check,
- [simple_msg(Context, [always(Pieces)])] ++ GoalMsgs)
- ;
- DetMsg = pragma_c_code_without_det_decl(PredId, ProcId),
- ProcPieces = describe_one_proc_name_mode(ModuleInfo,
- should_not_module_qualify, proc(PredId, ProcId)),
- Pieces = [words("In")] ++ ProcPieces ++ [suffix(":"), nl,
- words("error: `:- pragma c_code(...)' for a procedure"),
- words("without a determinism declaration.")],
- Spec = error_spec(severity_error, phase_detism_check,
- [simple_msg(Context, [always(Pieces)])])
- ;
- DetMsg = has_io_state_but_not_det(PredId, ProcId),
- ProcPieces = describe_one_proc_name_mode(ModuleInfo,
- should_not_module_qualify, proc(PredId, ProcId)),
- Pieces = [words("In")] ++ ProcPieces ++ [suffix(":"), nl,
- words("error: invalid determinism for a predicate"),
- words("with I/O state arguments.")],
- VerbosePieces = [words("Valid determinisms are "),
- words("det, cc_multi and erroneous.")],
- Spec = error_spec(severity_error, phase_detism_check,
- [simple_msg(Context,
- [always(Pieces), verbose_only(VerbosePieces)])])
- ;
- (
- DetMsg = will_not_throw_with_erroneous(PredId, ProcId),
- ProcPieces = describe_one_proc_name_mode(ModuleInfo,
- should_not_module_qualify, proc(PredId, ProcId)),
- Pieces = ProcPieces ++
- [words("has determinism erroneous but also has"),
- words("foreign clauses that have a"),
- fixed("`will_not_throw_exception' attribute."),
- words("This attribute cannot be applied"),
- words("to erroneous procedures.")]
- ;
- DetMsg = export_model_non_proc(_PredId, _ProcId, Detism),
- Pieces = [words("Error: "),
- fixed("`:- pragma export' declaration"),
- words("for a procedure that has a determinism of"),
- fixed(hlds_out.determinism_to_string(Detism) ++ ".")]
- ;
- DetMsg = arbitrary_without_promise,
- Pieces = [words("Error: "),
- words("this `arbitrary' scope is not nested inside"),
- words("a `promise_equivalent_solution_sets' scope.")]
- ),
- Spec = error_spec(severity_error, phase_detism_check,
- [simple_msg(Context, [always(Pieces)])])
- ;
- DetMsg = arbitrary_promise_overlap(PromiseContext, VarSet,
- OverlapVars),
- VarNames = list.map(lookup_var_name_in_varset(VarSet),
- set.to_sorted_list(OverlapVars)),
- (
- VarNames = [],
- unexpected(this_file, "det_report_msg: " ++
- "arbitrary_promise_overlap empty")
- ;
- VarNames = [_],
- VarStr = "the variable"
- ;
- VarNames = [_, _ | _],
- VarStr = "the following variables:"
- ),
- Pieces = [words("Error: "),
- words("this `arbitrary' scope and the"),
- words("`promise_equivalent_solution_sets' scope"),
- words("it is nested inside overlap on"), words(VarStr)]
- ++ list_to_pieces(VarNames) ++ [suffix(".")],
- PromisePieces = [words("This is the outer "),
- words("`promise_equivalent_solution_sets' scope.")],
- Spec = error_spec(severity_error, phase_detism_check,
- [simple_msg(Context, [always(Pieces)]),
- simple_msg(PromiseContext, [always(PromisePieces)])])
- ;
- DetMsg = promise_solutions_missing_vars(Kind, VarSet, Vars),
- VarNames = list.map(lookup_var_name_in_varset(VarSet),
- set.to_sorted_list(Vars)),
- KindStr = promise_solutions_kind_str(Kind),
- (
- VarNames = [],
- unexpected(this_file, "det_report_msg: " ++
- "promise_solutions_missing_vars empty")
- ;
- VarNames = [_],
- ListStr = "a variable that is not listed:"
- ;
- VarNames = [_, _ | _],
- ListStr = "some variables that are not listed:"
- ),
- Pieces = [words("Error: the"), words(add_quotes(KindStr)),
- words("goal binds"), words(ListStr)]
- ++ list_to_pieces(VarNames) ++ [suffix(".")],
- Spec = error_spec(severity_error, phase_detism_check,
- [simple_msg(Context, [always(Pieces)])])
- ;
- DetMsg = promise_solutions_extra_vars(Kind, VarSet, Vars),
- VarNames = list.map(lookup_var_name_in_varset(VarSet),
- set.to_sorted_list(Vars)),
- KindStr = promise_solutions_kind_str(Kind),
- (
- VarNames = [],
- unexpected(this_file,
- "det_report_msg: promise_solutions_extra_vars empty")
- ;
- VarNames = [_],
- ListStr = "an extra variable:"
- ;
- VarNames = [_, _ | _],
- ListStr = "some extra variables:"
- ),
- Pieces = [words("Error: the"), words(add_quotes(KindStr)),
- words("goal lists"), words(ListStr)] ++
- list_to_pieces(VarNames) ++ [suffix(".")],
- Spec = error_spec(severity_error, phase_detism_check,
- [simple_msg(Context, [always(Pieces)])])
- ;
- DetMsg = trace_goal_not_det(Detism),
- DetismStr = determinism_to_string(Detism),
- Pieces = [words("Error: trace goal has determinism"),
- quote(DetismStr), suffix(","),
- words("should be det or cc_multi.")],
- Spec = error_spec(severity_error, phase_detism_check,
- [simple_msg(Context, [always(Pieces)])])
- ).
-
-det_msg_is_any_mode_msg(multidet_disj(_), all_modes).
-det_msg_is_any_mode_msg(det_disj(_), all_modes).
-det_msg_is_any_mode_msg(semidet_disj(_), all_modes).
-det_msg_is_any_mode_msg(zero_soln_disj(_), all_modes).
-det_msg_is_any_mode_msg(zero_soln_disjunct, all_modes).
-det_msg_is_any_mode_msg(ite_cond_cannot_fail, all_modes).
-det_msg_is_any_mode_msg(ite_cond_cannot_succeed, all_modes).
-det_msg_is_any_mode_msg(negated_goal_cannot_fail, all_modes).
-det_msg_is_any_mode_msg(negated_goal_cannot_succeed, all_modes).
-det_msg_is_any_mode_msg(goal_cannot_succeed, all_modes).
-det_msg_is_any_mode_msg(det_goal_has_no_outputs, all_modes).
-det_msg_is_any_mode_msg(warn_call_to_obsolete(_), all_modes).
-det_msg_is_any_mode_msg(warn_infinite_recursion, any_mode).
-det_msg_is_any_mode_msg(duplicate_call(_, _), any_mode).
-det_msg_is_any_mode_msg(unknown_format_string(_, _), any_mode).
-det_msg_is_any_mode_msg(unknown_format_values(_, _), any_mode).
-det_msg_is_any_mode_msg(bad_format(_, _, _), any_mode).
-det_msg_is_any_mode_msg(cc_unify_can_fail(_, _, _, _, _), any_mode).
-det_msg_is_any_mode_msg(cc_unify_in_wrong_context(_, _, _, _, _, _), any_mode).
-det_msg_is_any_mode_msg(cc_pred_in_wrong_context(_, _, _, _, _, _), any_mode).
-det_msg_is_any_mode_msg(higher_order_cc_pred_in_wrong_context(_, _, _, _),
- any_mode).
-det_msg_is_any_mode_msg(error_in_lambda(_, _, _, _, _, _), any_mode).
-det_msg_is_any_mode_msg(par_conj_not_det(_, _, _, _, _), any_mode).
-det_msg_is_any_mode_msg(pragma_c_code_without_det_decl(_, _), any_mode).
-det_msg_is_any_mode_msg(has_io_state_but_not_det(_, _), any_mode).
-det_msg_is_any_mode_msg(will_not_throw_with_erroneous(_, _), any_mode).
-det_msg_is_any_mode_msg(export_model_non_proc(_, _, _), any_mode).
-det_msg_is_any_mode_msg(nested_promise_eqv_solution_sets(_), any_mode).
-det_msg_is_any_mode_msg(arbitrary_without_promise, any_mode).
-det_msg_is_any_mode_msg(arbitrary_promise_overlap(_, _, _), any_mode).
-det_msg_is_any_mode_msg(promise_solutions_missing_vars(_, _, _), any_mode).
-det_msg_is_any_mode_msg(promise_solutions_extra_vars(_, _, _), any_mode).
-det_msg_is_any_mode_msg(trace_goal_not_det(_), any_mode).
-
-:- func promise_solutions_kind_str(promise_solutions_kind) = string.
-
promise_solutions_kind_str(equivalent_solutions)
= "promise_equivalent_solutions".
promise_solutions_kind_str(equivalent_solution_sets)
@@ -1502,23 +941,16 @@
promise_solutions_kind_str(equivalent_solution_sets_arbitrary)
= "arbitrary".
-:- func lookup_var_name_in_varset(prog_varset, prog_var) = string.
-
lookup_var_name_in_varset(VarSet, Var) =
mercury_var_to_string(Var, VarSet, no).
-:- func failing_contexts_description(module_info, prog_varset,
- list(failing_context)) = list(error_msg).
-
failing_contexts_description(ModuleInfo, VarSet, FailingContexts) =
- list.map(failing_context_description(ModuleInfo, VarSet),
- FailingContexts).
+ list.map(failing_context_description(ModuleInfo, VarSet), FailingContexts).
:- func failing_context_description(module_info, prog_varset,
failing_context) = error_msg.
-failing_context_description(ModuleInfo, VarSet, Context - FailingGoal)
- = Msg :-
+failing_context_description(ModuleInfo, VarSet, Context - FailingGoal) = Msg :-
(
FailingGoal = incomplete_switch(Var),
VarStr = mercury_var_to_string(Var, VarSet, no),
@@ -1556,9 +988,6 @@
%-----------------------------------------------------------------------------%
-:- func det_report_seen_call_id(module_info, seen_call_id)
- = list(format_component).
-
det_report_seen_call_id(ModuleInfo, SeenCall) = Pieces :-
(
SeenCall = seen_call(PredId, _),
@@ -1596,24 +1025,24 @@
:- type options_to_restore == assoc_list(option, option_data).
-disable_det_warnings(OptionsToRestore, !IO) :-
- globals.io_lookup_option(warn_simple_code, WarnSimple, !IO),
- globals.io_lookup_option(warn_det_decls_too_lax,
- WarnDeclsTooLax, !IO),
- globals.io_set_option(warn_simple_code, bool(no), !IO),
- globals.io_set_option(warn_det_decls_too_lax, bool(no), !IO),
+disable_det_warnings(OptionsToRestore, !Globals) :-
+ globals.lookup_option(!.Globals, warn_simple_code, WarnSimple),
+ globals.lookup_option(!.Globals, warn_det_decls_too_lax, WarnDeclsTooLax),
+ globals.set_option(warn_simple_code, bool(no), !Globals),
+ globals.set_option(warn_det_decls_too_lax, bool(no), !Globals),
OptionsToRestore = [
warn_simple_code - WarnSimple,
warn_det_decls_too_lax - WarnDeclsTooLax
].
-restore_det_warnings(OptionsToRestore, !IO) :-
- list.foldl(restore_option, OptionsToRestore, !IO).
+restore_det_warnings(OptionsToRestore, !Globals) :-
+ list.foldl(restore_option, OptionsToRestore, !Globals).
-:- pred restore_option(pair(option, option_data)::in, io::di, io::uo) is det.
+:- pred restore_option(pair(option, option_data)::in,
+ globals::in, globals::out) is det.
-restore_option(Option - Value, !IO) :-
- globals.io_set_option(Option, Value, !IO).
+restore_option(Option - Value, !Globals) :-
+ globals.set_option(Option, Value, !Globals).
%-----------------------------------------------------------------------------%
Index: compiler/det_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_util.m,v
retrieving revision 1.41
diff -u -b -r1.41 det_util.m
--- compiler/det_util.m 27 Sep 2006 06:16:51 -0000 1.41
+++ compiler/det_util.m 12 Oct 2006 02:40:18 -0000
@@ -24,8 +24,6 @@
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module hlds.instmap.
-:- import_module libs.
-:- import_module libs.globals.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.
@@ -70,7 +68,7 @@
det_info::in) is semidet.
:- pred det_info_init(module_info::in, vartypes::in, pred_id::in, proc_id::in,
- globals::in, det_info::out) is det.
+ det_info::out) is det.
:- pred det_info_get_module_info(det_info::in, module_info::out) is det.
:- pred det_info_get_pred_id(det_info::in, pred_id::out) is det.
@@ -90,7 +88,9 @@
:- implementation.
+:- import_module libs.
:- import_module libs.compiler_util.
+:- import_module libs.globals.
:- import_module libs.options.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.prog_util.
@@ -169,7 +169,8 @@
fully_strict :: bool % --fully-strict
).
-det_info_init(ModuleInfo, VarTypes, PredId, ProcId, Globals, DetInfo) :-
+det_info_init(ModuleInfo, VarTypes, PredId, ProcId, DetInfo) :-
+ module_info_get_globals(ModuleInfo, Globals),
globals.lookup_bool_option(Globals, reorder_conj, ReorderConj),
globals.lookup_bool_option(Globals, reorder_disj, ReorderDisj),
globals.lookup_bool_option(Globals, fully_strict, FullyStrict),
Index: compiler/equiv_type.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/equiv_type.m,v
retrieving revision 1.70
diff -u -b -r1.70 equiv_type.m
--- compiler/equiv_type.m 25 Sep 2006 18:31:20 -0000 1.70
+++ compiler/equiv_type.m 12 Oct 2006 08:07:17 -0000
@@ -407,15 +407,15 @@
Constraints0, Constraints, VarSet0, VarSet,
ExpandedItems0, ExpandedItems1, !UsedModules),
(
- ClassInterface0 = abstract,
- ClassInterface = abstract,
+ ClassInterface0 = class_interface_abstract,
+ ClassInterface = class_interface_abstract,
ExpandedItems = ExpandedItems1,
Errors = []
;
- ClassInterface0 = concrete(Methods0),
+ ClassInterface0 = class_interface_concrete(Methods0),
replace_in_class_interface(Location, Methods0, EqvMap, EqvInstMap,
Methods, [], Errors, ExpandedItems1, ExpandedItems, !UsedModules),
- ClassInterface = concrete(Methods)
+ ClassInterface = class_interface_concrete(Methods)
),
ItemId = item_id(typeclass_item, item_name(ClassName, Arity)),
finish_recording_expanded_items(ItemId, ExpandedItems, !Info).
Index: compiler/error_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/error_util.m,v
retrieving revision 1.55
diff -u -b -r1.55 error_util.m
--- compiler/error_util.m 2 Oct 2006 05:21:10 -0000 1.55
+++ compiler/error_util.m 12 Oct 2006 05:47:52 -0000
@@ -99,6 +99,10 @@
; actual_severity_warning
; actual_severity_informational.
+:- type mode_report_control
+ ---> report_in_any_mode
+ ; report_only_if_in_all_modes.
+
:- type error_phase
---> phase_read_files
; phase_term_to_parse_tree
@@ -107,6 +111,7 @@
; phase_mode_check
; phase_purity_check
; phase_detism_check
+ ; phase_simplify(mode_report_control)
; phase_termination_analysis
; phase_accumulator_intro
; phase_interface_gen
@@ -205,8 +210,8 @@
%-----------------------------------------------------------------------------%
- % write_error_spec(Spec, !NumWarnings, !NumErrors, !IO):
- % write_error_specs(Specs, !NumWarnings, !NumErrors, !IO):
+ % write_error_spec(Spec, Globals, !NumWarnings, !NumErrors, !IO):
+ % write_error_specs(Specs, Globals, !NumWarnings, !NumErrors, !IO):
%
% Write out the error message(s) specified by Spec or Specs, minus the
% parts whose conditions are false. Increment !NumWarnings by the number
@@ -216,9 +221,11 @@
% components but they aren't being printed out, set the flag for reminding
% the user about --verbose-errors.
%
-:- pred write_error_spec(error_spec::in, int::in, int::out,
+ % Look up option values in the supplied Globals.
+ %
+:- pred write_error_spec(error_spec::in, globals::in, int::in, int::out,
int::in, int::out, io::di, io::uo) is det.
-:- pred write_error_specs(list(error_spec)::in, int::in, int::out,
+:- pred write_error_specs(list(error_spec)::in, globals::in, int::in, int::out,
int::in, int::out, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
@@ -258,6 +265,11 @@
% the sym_name, followed by '/' and the arity,
% all surrounded by `' quotes.
+ ; top_ctor_of_type(mer_type)
+ % The top level type constructor of the given type,
+ % which must have one (i.e. must not be a
+ % variable).
+
; p_or_f(pred_or_func)
% Output the string "predicate" or "function"
% as appropriate.
@@ -394,12 +406,14 @@
:- implementation.
:- import_module parse_tree.prog_out.
+:- import_module parse_tree.prog_type.
:- import_module parse_tree.prog_util.
:- import_module libs.compiler_util.
:- import_module char.
:- import_module int.
:- import_module list.
+:- import_module require.
:- import_module string.
:- import_module term.
@@ -576,12 +590,11 @@
%-----------------------------------------------------------------------------%
-write_error_spec(Spec, !NumWarnings, !NumErrors, !IO) :-
- write_error_specs([Spec], !NumWarnings, !NumErrors, !IO).
+write_error_spec(Spec, Globals, !NumWarnings, !NumErrors, !IO) :-
+ write_error_specs([Spec], Globals, !NumWarnings, !NumErrors, !IO).
-write_error_specs(Specs0, !NumWarnings, !NumErrors, !IO) :-
+write_error_specs(Specs0, Globals, !NumWarnings, !NumErrors, !IO) :-
sort_error_specs(Specs0, Specs),
- io_get_globals(Globals, !IO),
io.get_exit_status(OrigExitStatus, !IO),
list.foldl3(do_write_error_spec(Globals, OrigExitStatus), Specs,
!NumWarnings, !NumErrors, !IO).
@@ -893,6 +906,16 @@
Word = simple_call_id_to_string(SimpleCallId),
Str = join_string_and_tail(Word, Components, TailStr)
;
+ Component = top_ctor_of_type(Type),
+ ( type_to_ctor_and_args(Type, TypeCtor, _) ->
+ TypeCtor = type_ctor(TypeCtorName, TypeCtorArity),
+ SymName = TypeCtorName / TypeCtorArity,
+ Word = sym_name_and_arity_to_word(SymName),
+ Str = join_string_and_tail(Word, Components, TailStr)
+ ;
+ error("error_pieces_to_string: type is variable")
+ )
+ ;
Component = nl,
Str = "\n" ++ TailStr
;
@@ -972,6 +995,16 @@
Word = sym_name_and_arity_to_word(SymNameAndArity),
RevWords1 = [plain_word(Word) | RevWords0]
;
+ Component = top_ctor_of_type(Type),
+ ( type_to_ctor_and_args(Type, TypeCtor, _) ->
+ TypeCtor = type_ctor(TypeCtorName, TypeCtorArity),
+ SymName = TypeCtorName / TypeCtorArity,
+ RevWords1 = [plain_word(sym_name_and_arity_to_word(SymName))
+ | RevWords0]
+ ;
+ error("convert_components_to_paragraphs_acc: type is variable")
+ )
+ ;
Component = p_or_f(PredOrFunc),
Word = pred_or_func_to_string(PredOrFunc),
RevWords1 = [plain_word(Word) | RevWords0]
Index: compiler/format_call.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/format_call.m,v
retrieving revision 1.6
diff -u -b -r1.6 format_call.m
--- compiler/format_call.m 27 Sep 2006 06:16:52 -0000 1.6
+++ compiler/format_call.m 12 Oct 2006 09:03:42 -0000
@@ -80,18 +80,17 @@
:- module check_hlds.format_call.
:- interface.
-:- import_module check_hlds.det_report.
:- import_module hlds.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_module.
:- import_module parse_tree.
+:- import_module parse_tree.error_util.
:- import_module parse_tree.prog_data.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module list.
-:- import_module set.
%-----------------------------------------------------------------------------%
@@ -99,7 +98,7 @@
prog_var::out, prog_var::out) is semidet.
:- pred find_format_call_errors(module_info::in, hlds_goal::in,
- set(context_det_msg)::in, set(context_det_msg)::out) is det.
+ list(error_spec)::in, list(error_spec)::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -109,13 +108,16 @@
:- import_module hlds.hlds_pred.
:- import_module libs.
:- import_module libs.compiler_util.
+:- import_module libs.options.
+:- import_module bool.
:- import_module counter.
:- import_module exception.
:- import_module map.
:- import_module maybe.
:- import_module pair.
:- import_module require.
+:- import_module set.
:- import_module string.
:- import_module svmap.
:- import_module svset.
@@ -207,10 +209,9 @@
!Msgs).
:- pred check_format_call_site(conj_maps::in, conj_pred_map::in,
- format_call_site::in, set(context_det_msg)::in, set(context_det_msg)::out)
- is det.
+ format_call_site::in, list(error_spec)::in, list(error_spec)::out) is det.
-check_format_call_site(ConjMaps, PredMap, FormatCallSite, !Msgs) :-
+check_format_call_site(ConjMaps, PredMap, FormatCallSite, !Specs) :-
FormatCallSite = format_call_site(StringVar, ValuesVar,
ModuleName, Name, Arity, Context, CurId),
SymName = qualified(ModuleName, Name),
@@ -222,9 +223,17 @@
MaybeFormatString = yes(FormatString0)
;
MaybeFormatString = no,
- StringMsg = unknown_format_string(SymName, Arity),
- ContextStringMsg = context_det_msg(Context, StringMsg),
- svset.insert(ContextStringMsg, !Msgs)
+ UnknownFormatPieces = [words("Unknown format string in call to"),
+ sym_name_and_arity(SymName / Arity), suffix("."), nl],
+ UnknownFormatSeverity =
+ severity_conditional(warn_unknown_format_calls, yes,
+ severity_warning, no),
+ UnknownFormatMsg = simple_msg(Context,
+ [option_is_set(warn_unknown_format_calls, yes,
+ [always(UnknownFormatPieces)])]),
+ UnknownFormatSpec = error_spec(UnknownFormatSeverity,
+ phase_detism_check, [UnknownFormatMsg]),
+ !:Specs = [UnknownFormatSpec | !.Specs]
),
(
@@ -236,9 +245,18 @@
MaybeValues = yes(Values0)
;
MaybeValues = no,
- ValuesMsg = unknown_format_values(SymName, Arity),
- ContextValuesMsg = context_det_msg(Context, ValuesMsg),
- svset.insert(ContextValuesMsg, !Msgs)
+ UnknownFormatValuesPieces =
+ [words("Unknown format values in call to"),
+ sym_name_and_arity(SymName / Arity), suffix("."), nl],
+ UnknownFormatValuesSeverity =
+ severity_conditional(warn_unknown_format_calls, yes,
+ severity_warning, no),
+ UnknownFormatValuesMsg = simple_msg(Context,
+ [option_is_set(warn_unknown_format_calls, yes,
+ [always(UnknownFormatValuesPieces)])]),
+ UnknownFormatValuesSpec = error_spec(UnknownFormatValuesSeverity,
+ phase_detism_check, [UnknownFormatValuesMsg]),
+ !:Specs = [UnknownFormatValuesSpec | !.Specs]
),
(
@@ -257,9 +275,18 @@
;
ExceptionMsg = ExceptionMsg0
),
- BadMsg = bad_format(SymName, Arity, ExceptionMsg),
- ContextBadMsg = context_det_msg(Context, BadMsg),
- svset.insert(ContextBadMsg, !Msgs)
+ BadFormatPieces =
+ [words("Mismatched format and values in call to"),
+ sym_name_and_arity(SymName / Arity), suffix(":"), nl,
+ words(ExceptionMsg)],
+ BadFormatMsg = simple_msg(Context,
+ [option_is_set(warn_known_bad_format_calls, yes,
+ [always(BadFormatPieces)])]),
+ BadFormatSeverity = severity_conditional(
+ warn_known_bad_format_calls, yes, severity_warning, no),
+ BadFormatSpec = error_spec(BadFormatSeverity,
+ phase_simplify(report_in_any_mode), [BadFormatMsg]),
+ !:Specs = [BadFormatSpec | !.Specs]
;
% We can't decode arbitrary exception values, but string.m
% shouldn't throw anything but software_errors, so ignoring
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.406
diff -u -b -r1.406 hlds_out.m
--- compiler/hlds_out.m 4 Oct 2006 06:36:55 -0000 1.406
+++ compiler/hlds_out.m 12 Oct 2006 07:58:02 -0000
@@ -3538,10 +3538,10 @@
write_indent(Indent, !IO),
(
- Body = abstract,
+ Body = instance_body_abstract,
io.write_string("% abstract", !IO)
;
- Body = concrete(Methods),
+ Body = instance_body_concrete(Methods),
io.write_string("% Instance Methods: ", !IO),
mercury_output_instance_methods(Methods, !IO)
),
Index: compiler/inlining.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inlining.m,v
retrieving revision 1.146
diff -u -b -r1.146 inlining.m
--- compiler/inlining.m 30 Aug 2006 04:45:59 -0000 1.146
+++ compiler/inlining.m 12 Oct 2006 05:43:24 -0000
@@ -88,13 +88,12 @@
:- import_module parse_tree.prog_data.
:- import_module bool.
-:- import_module io.
:- import_module list.
:- import_module map.
%-----------------------------------------------------------------------------%
-:- pred inlining(module_info::in, module_info::out, io::di, io::uo) is det.
+:- pred inlining(module_info::in, module_info::out) is det.
% This heuristic is used for both local and intermodule inlining.
%
@@ -170,6 +169,7 @@
:- import_module assoc_list.
:- import_module bool.
:- import_module int.
+:- import_module io.
:- import_module list.
:- import_module maybe.
:- import_module pair.
@@ -197,8 +197,7 @@
).
-inlining(!ModuleInfo, !IO) :-
- %
+inlining(!ModuleInfo) :-
% Package up all the inlining options
% - whether to inline simple conj's of builtins
% - whether to inline predicates that are only called once
@@ -208,8 +207,8 @@
% if inlining a procedure would cause the number of variables to exceed
% this threshold then we don't inline it.
% - whether we're in an MLDS grade
- %
- globals.io_get_globals(Globals, !IO),
+
+ module_info_get_globals(!.ModuleInfo, Globals),
globals.lookup_bool_option(Globals, inline_simple, Simple),
globals.lookup_bool_option(Globals, inline_single_use, SingleUse),
globals.lookup_int_option(Globals, inline_call_cost, CallCost),
@@ -219,7 +218,7 @@
SimpleThreshold),
globals.lookup_int_option(Globals, inline_vars_threshold, VarThreshold),
globals.lookup_bool_option(Globals, highlevel_code, HighLevelCode),
- globals.io_get_trace_level(TraceLevel, !IO),
+ globals.get_trace_level(Globals, TraceLevel),
AnyTracing = bool.not(given_trace_level_is_none(TraceLevel)),
Params = params(Simple, SingleUse, CallCost, CompoundThreshold,
SimpleThreshold, VarThreshold, HighLevelCode, AnyTracing),
@@ -254,29 +253,29 @@
hlds_dependency_info_get_dependency_ordering(DepInfo, SCCs),
list.condense(SCCs, PredProcs),
set.init(InlinedProcs0),
- do_inlining(PredProcs, NeededMap, Params, InlinedProcs0, !ModuleInfo, !IO),
+ do_inlining(PredProcs, NeededMap, Params, InlinedProcs0, !ModuleInfo),
% The dependency graph is now out of date and needs to be rebuilt.
module_info_clobber_dependency_info(!ModuleInfo).
:- pred do_inlining(list(pred_proc_id)::in, needed_map::in,
inline_params::in, set(pred_proc_id)::in,
- module_info::in, module_info::out, io::di, io::uo) is det.
+ module_info::in, module_info::out) is det.
-do_inlining([], _Needed, _Params, _Inlined, !Module, !IO).
-do_inlining([PPId | PPIds], Needed, Params, !.Inlined, !Module, !IO) :-
- in_predproc(PPId, !.Inlined, Params, !Module, !IO),
- mark_predproc(PPId, Needed, Params, !.Module, !Inlined, !IO),
- do_inlining(PPIds, Needed, Params, !.Inlined, !Module, !IO).
+do_inlining([], _Needed, _Params, _Inlined, !Module).
+do_inlining([PPId | PPIds], Needed, Params, !.Inlined, !Module) :-
+ in_predproc(PPId, !.Inlined, Params, !Module),
+ mark_predproc(PPId, Needed, Params, !.Module, !Inlined),
+ do_inlining(PPIds, Needed, Params, !.Inlined, !Module).
% This predicate effectively adds implicit `pragma inline' directives
% for procedures that match its heuristic.
%
:- pred mark_predproc(pred_proc_id::in, needed_map::in,
inline_params::in, module_info::in,
- set(pred_proc_id)::in, set(pred_proc_id)::out, io::di, io::uo) is det.
+ set(pred_proc_id)::in, set(pred_proc_id)::out) is det.
-mark_predproc(PredProcId, NeededMap, Params, ModuleInfo, !InlinedProcs, !IO) :-
+mark_predproc(PredProcId, NeededMap, Params, ModuleInfo, !InlinedProcs) :-
(
Simple = Params ^ simple,
SingleUse = Params ^ single_use,
@@ -313,7 +312,7 @@
% Don't inline recursive predicates (unless explicitly requested).
\+ goal_calls(CalledGoal, PredProcId)
->
- mark_proc_as_inlined(PredProcId, ModuleInfo, !InlinedProcs, !IO)
+ mark_proc_as_inlined(PredProcId, ModuleInfo, !InlinedProcs)
;
true
).
@@ -369,16 +368,18 @@
is_flat_simple_goal_list(Goals).
:- pred mark_proc_as_inlined(pred_proc_id::in, module_info::in,
- set(pred_proc_id)::in, set(pred_proc_id)::out, io::di, io::uo) is det.
+ set(pred_proc_id)::in, set(pred_proc_id)::out) is det.
-mark_proc_as_inlined(proc(PredId, ProcId), ModuleInfo, !InlinedProcs, !IO) :-
+mark_proc_as_inlined(proc(PredId, ProcId), ModuleInfo, !InlinedProcs) :-
svset.insert(proc(PredId, ProcId), !InlinedProcs),
module_info_pred_info(ModuleInfo, PredId, PredInfo),
( pred_info_requested_inlining(PredInfo) ->
true
;
+ trace [io(!IO)] (
write_proc_progress_message("% Inlining ", PredId, ProcId,
ModuleInfo, !IO)
+ )
).
%-----------------------------------------------------------------------------%
@@ -441,9 +442,9 @@
).
:- pred in_predproc(pred_proc_id::in, set(pred_proc_id)::in, inline_params::in,
- module_info::in, module_info::out, io::di, io::uo) is det.
+ module_info::in, module_info::out) is det.
-in_predproc(PredProcId, InlinedProcs, Params, !ModuleInfo, !IO) :-
+in_predproc(PredProcId, InlinedProcs, Params, !ModuleInfo) :-
VarThresh = Params ^ var_threshold,
HighLevelCode = Params ^ highlevel_code,
AnyTracing = Params ^ any_tracing,
@@ -520,10 +521,9 @@
% If the determinism of some sub-goals has changed, then we re-run
% determinism analysis, because propagating the determinism information
% through the procedure may lead to more efficient code.
- globals.io_get_globals(Globals, !IO),
(
DetChanged = yes,
- det_infer_proc(PredId, ProcId, !ModuleInfo, Globals, _, _, _)
+ det_infer_proc(PredId, ProcId, !ModuleInfo, _, _, _)
;
DetChanged = no
).
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.210
diff -u -b -r1.210 intermod.m
--- compiler/intermod.m 2 Oct 2006 05:21:12 -0000 1.210
+++ compiler/intermod.m 12 Oct 2006 08:19:06 -0000
@@ -765,7 +765,7 @@
%
SaveInfo = !.Info,
(
- Interface0 = concrete(Methods0),
+ Interface0 = instance_body_concrete(Methods0),
(
MaybePredProcIds = yes(ClassProcs),
GetPredId =
@@ -789,33 +789,27 @@
bool.and_list(DoWriteMethodsList, DoWriteMethods),
(
DoWriteMethods = yes,
- Interface = concrete(Methods)
+ Interface = instance_body_concrete(Methods)
;
DoWriteMethods = no,
- %
% Write an abstract instance declaration if any of the methods
% cannot be written to the `.opt' file for any reason.
- %
- Interface = abstract,
+ Interface = instance_body_abstract,
- %
% Don't write declarations for any of the methods if one
% can't be written.
- %
!:Info = SaveInfo
)
;
- Interface0 = abstract,
+ Interface0 = instance_body_abstract,
Interface = Interface0
),
(
- %
% Don't write an abstract instance declaration
% if the declaration is already in the `.int' file.
- %
(
- Interface = abstract
+ Interface = instance_body_abstract
=>
status_is_exported(Status) = no
)
@@ -847,7 +841,7 @@
InstanceMethod0 = instance_method(PredOrFunc, MethodName,
InstanceMethodDefn0, MethodArity, MethodContext),
(
- InstanceMethodDefn0 = name(InstanceMethodName0),
+ InstanceMethodDefn0 = instance_proc_def_name(InstanceMethodName0),
PredOrFunc = function,
(
find_func_matching_instance_method(ModuleInfo, InstanceMethodName0,
@@ -861,7 +855,7 @@
MaybePredId = no,
PredIds = PredIds0
),
- InstanceMethodDefn = name(InstanceMethodName)
+ InstanceMethodDefn = instance_proc_def_name(InstanceMethodName)
;
% This will force add_proc to return DoWrite = no.
PredId = invalid_pred_id,
@@ -871,18 +865,17 @@
InstanceMethodDefn = InstanceMethodDefn0
)
;
- InstanceMethodDefn0 = name(InstanceMethodName0),
+ InstanceMethodDefn0 = instance_proc_def_name(InstanceMethodName0),
PredOrFunc = predicate,
init_markers(Markers),
resolve_pred_overloading(ModuleInfo, Markers,
MethodCallArgTypes, MethodCallTVarSet,
InstanceMethodName0, InstanceMethodName, PredId),
PredIds = [PredId | PredIds0],
- InstanceMethodDefn = name(InstanceMethodName)
+ InstanceMethodDefn = instance_proc_def_name(InstanceMethodName)
;
- InstanceMethodDefn0 = clauses(_ItemList),
- %
- % XXX for methods defined using this syntax it is a little tricky
+ InstanceMethodDefn0 = instance_proc_def_clauses(_ItemList),
+ % XXX For methods defined using this syntax it is a little tricky
% to write out the .opt files, so for now I've just disabled
% intermodule optimization for type class instance declarations
% using the new syntax.
Index: compiler/make.module_dep_file.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make.module_dep_file.m,v
retrieving revision 1.23
diff -u -b -r1.23 make.module_dep_file.m
--- compiler/make.module_dep_file.m 1 Oct 2006 04:16:59 -0000 1.23
+++ compiler/make.module_dep_file.m 12 Oct 2006 06:48:19 -0000
@@ -531,11 +531,11 @@
io.set_output_stream(ErrorStream, _, !IO),
split_into_submodules(ModuleName, Items, SubModuleList, [], Specs),
sort_error_specs(Specs, SortedSpecs),
- write_error_specs(SortedSpecs, 0, _NumWarnings, 0, _NumErrors,
- !IO),
+ globals.io_get_globals(Globals, !IO),
+ write_error_specs(SortedSpecs, Globals, 0, _NumWarnings,
+ 0, _NumErrors, !IO),
io.set_output_stream(OldOutputStream, _, !IO),
- globals.io_get_globals(Globals, !IO),
assoc_list.keys(SubModuleList, SubModuleNames),
list.map(init_dependencies(SourceFileName, ModuleName,
SubModuleNames, Error, Globals),
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.57
diff -u -b -r1.57 make_hlds_passes.m
--- compiler/make_hlds_passes.m 5 Oct 2006 04:45:32 -0000 1.57
+++ compiler/make_hlds_passes.m 12 Oct 2006 08:01:11 -0000
@@ -136,14 +136,14 @@
do_parse_tree_to_hlds(unit_module(Name, Items), MQInfo0, EqvMap, UsedModules,
ModuleInfo, QualInfo, InvalidTypes, InvalidModes, !IO) :-
- some [!Module, !Specs] (
+ some [!ModuleInfo, !Specs] (
globals.io_get_globals(Globals, !IO),
mq_info_get_partial_qualifier_info(MQInfo0, PQInfo),
- module_info_init(Name, Items, Globals, PQInfo, no, !:Module),
- module_info_set_used_modules(UsedModules, !Module),
+ module_info_init(Name, Items, Globals, PQInfo, no, !:ModuleInfo),
+ module_info_set_used_modules(UsedModules, !ModuleInfo),
!:Specs = [],
add_item_list_decls_pass_1(Items,
- item_status(status_local, may_be_unqualified), !Module,
+ item_status(status_local, may_be_unqualified), !ModuleInfo,
no, InvalidModes0, !Specs),
globals.io_lookup_bool_option(statistics, Statistics, !IO),
maybe_write_string(Statistics, "% Processed all items in pass 1\n",
@@ -152,7 +152,7 @@
add_item_list_decls_pass_2(Items,
item_status(status_local, may_be_unqualified),
- !Module, [], Pass2Specs),
+ !ModuleInfo, [], Pass2Specs),
(
Pass2Specs = [],
InvalidTypes1 = no
@@ -168,9 +168,9 @@
% may cause a compiler abort.
(
InvalidTypes1 = no,
- module_info_get_type_table(!.Module, Types),
- map.foldl3(process_type_defn, Types, no, InvalidTypes2, !Module,
- !Specs)
+ module_info_get_type_table(!.ModuleInfo, Types),
+ map.foldl3(process_type_defn, Types, no, InvalidTypes2,
+ !ModuleInfo, !Specs)
;
InvalidTypes1 = yes,
InvalidTypes2 = yes
@@ -180,21 +180,21 @@
% type declaration, hence no hlds_type_defn is generated for them.
(
Name = mercury_public_builtin_module,
- compiler_generated_rtti_for_builtins(!.Module)
+ compiler_generated_rtti_for_builtins(!.ModuleInfo)
->
list.foldl(add_builtin_type_ctor_special_preds,
- builtin_type_ctors_with_no_hlds_type_defn, !Module)
+ builtin_type_ctors_with_no_hlds_type_defn, !ModuleInfo)
;
true
),
% Balance any data structures that need it.
- module_info_optimize(!Module),
+ module_info_optimize(!ModuleInfo),
maybe_write_string(Statistics, "% Processed all items in pass 2\n",
!IO),
maybe_report_stats(Statistics, !IO),
init_qual_info(MQInfo0, EqvMap, QualInfo0),
- add_item_list_clauses(Items, status_local, !Module,
+ add_item_list_clauses(Items, status_local, !ModuleInfo,
QualInfo0, QualInfo, !Specs),
qual_info_get_mq_info(QualInfo, MQInfo),
@@ -205,13 +205,15 @@
% The predid list is constructed in reverse order, for efficiency,
% so we return it to the correct order here.
- module_info_reverse_predids(!Module),
+ module_info_reverse_predids(!ModuleInfo),
sort_error_specs(!.Specs, SortedSpecs),
- write_error_specs(SortedSpecs, 0, _NumWarnings, 0, NumErrors, !IO),
- module_info_incr_num_errors(NumErrors, !Module),
+ module_info_get_globals(!.ModuleInfo, CurGlobals),
+ write_error_specs(SortedSpecs, CurGlobals, 0, _NumWarnings,
+ 0, NumErrors, !IO),
+ module_info_incr_num_errors(NumErrors, !ModuleInfo),
- ModuleInfo = !.Module
+ ModuleInfo = !.ModuleInfo
).
:- pred add_builtin_type_ctor_special_preds(type_ctor::in,
@@ -634,9 +636,11 @@
Item = item_instance(Constraints, Name, Types, Body, VarSet,
InstanceModuleName),
!.Status = item_status(ImportStatus, _),
- ( Body = abstract ->
+ (
+ Body = instance_body_abstract,
make_status_abstract(ImportStatus, BodyStatus)
;
+ Body = instance_body_concrete(_),
BodyStatus = ImportStatus
),
module_add_instance_defn(InstanceModuleName, Constraints, Name, Types,
@@ -2046,13 +2050,13 @@
semidet_fail.
maybe_check_field_access_function(FuncName, FuncArity, Status, Context,
- Module, !Specs) :-
+ ModuleInfo, !Specs) :-
(
- is_field_access_function_name(Module, FuncName, FuncArity,
+ is_field_access_function_name(ModuleInfo, FuncName, FuncArity,
AccessType, FieldName)
->
check_field_access_function(AccessType, FieldName, FuncName,
- FuncArity, Status, Context, Module, !Specs)
+ FuncArity, Status, Context, ModuleInfo, !Specs)
;
true
).
@@ -2062,12 +2066,12 @@
module_info::in, list(error_spec)::in, list(error_spec)::out) is det.
check_field_access_function(_AccessType, FieldName, FuncName, FuncArity,
- FuncStatus, Context, Module, !Specs) :-
+ FuncStatus, Context, ModuleInfo, !Specs) :-
adjust_func_arity(function, FuncArity, PredArity),
FuncCallId = simple_call_id(function, FuncName, PredArity),
% Check that a function applied to an exported type is also exported.
- module_info_get_ctor_field_table(Module, CtorFieldTable),
+ module_info_get_ctor_field_table(ModuleInfo, CtorFieldTable),
(
% Abstract types have status `abstract_exported', so errors won't be
% reported for local field access functions for them.
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.408
diff -u -b -r1.408 mercury_compile.m
--- compiler/mercury_compile.m 5 Oct 2006 04:45:32 -0000 1.408
+++ compiler/mercury_compile.m 12 Oct 2006 14:35:11 -0000
@@ -302,8 +302,8 @@
MaybeMCFlags = no
;
Errors = [],
- globals.io_lookup_maybe_string_option(config_file,
- MaybeConfigFile, !IO),
+ globals.io_lookup_maybe_string_option(config_file, MaybeConfigFile,
+ !IO),
(
MaybeConfigFile = yes(ConfigFile),
read_options_file(ConfigFile, Variables0, MaybeVariables, !IO),
@@ -602,8 +602,8 @@
% and then we'll continue with the normal work of
% the compilation, which will be done by the callback
% function (`process_args').
- maybe_mlds_to_gcc.run_gcc_backend(FirstModuleName, CallBack,
- ModulesToLink, !IO),
+ maybe_mlds_to_gcc.run_gcc_backend(FirstModuleName, CallBack, ModulesToLink,
+ !IO),
% Now we know what the real module name was, so we
% can rename the assembler file if needed (see above).
@@ -1032,8 +1032,7 @@
true
;
split_into_submodules(ModuleName, Items, SubModuleList, [], Specs),
- sort_error_specs(Specs, SortedSpecs),
- write_error_specs(SortedSpecs, 0, _NumWarnings, 0, _NumErrors,
+ write_error_specs(Specs, Globals, 0, _NumWarnings, 0, _NumErrors,
!IO),
list.foldl(apply_process_module(ProcessModule,
FileName, ModuleName, MaybeTimestamp), SubModuleList, !IO)
@@ -1154,14 +1153,15 @@
ModulesToLink, FactTableObjFiles, !IO) :-
read_module_or_file(FileOrModule, yes, ModuleName, FileName,
MaybeTimestamp, Items, Error, ReadModules0, ReadModules, !IO),
- globals.io_lookup_bool_option(halt_at_syntax_errors, HaltSyntax, !IO),
+ globals.io_get_globals(Globals, !IO),
+ globals.lookup_bool_option(Globals, halt_at_syntax_errors, HaltSyntax),
( halt_at_module_error(HaltSyntax, Error) ->
ModulesToLink = [],
FactTableObjFiles = []
;
split_into_submodules(ModuleName, Items, SubModuleList0, [], Specs),
- sort_error_specs(Specs, SortedSpecs),
- write_error_specs(SortedSpecs, 0, _NumWarnings, 0, _NumErrors, !IO),
+ write_error_specs(Specs, Globals, 0, _NumWarnings, 0, _NumErrors,
+ !IO),
( MaybeModulesToRecompile = some_modules(ModulesToRecompile) ->
ToRecompile = (pred((SubModule - _)::in) is semidet :-
list.member(SubModule, ModulesToRecompile)
@@ -1173,10 +1173,9 @@
assoc_list.keys(SubModuleList0, NestedSubModules0),
list.delete_all(NestedSubModules0, ModuleName, NestedSubModules),
- globals.io_get_globals(Globals, !IO),
find_timestamp_files(ModuleName, Globals, FindTimestampFiles),
- globals.io_lookup_bool_option(trace_prof, TraceProf, !IO),
+ globals.lookup_bool_option(Globals, trace_prof, TraceProf),
(
non_traced_mercury_builtin_module(ModuleName),
@@ -1191,8 +1190,8 @@
% there should never be part of an execution trace
% anyway; they are effectively language primitives.
% (They may still be parts of stack traces.)
- globals.io_lookup_bool_option(trace_stack_layout, TSL, !IO),
- globals.io_get_trace_level(TraceLevel, !IO),
+ globals.lookup_bool_option(Globals, trace_stack_layout, TSL),
+ globals.get_trace_level(Globals, TraceLevel),
globals.io_set_option(trace_stack_layout, bool(no), !IO),
globals.io_set_trace_level_none(!IO),
@@ -1775,8 +1774,7 @@
module_name_to_file_name(ModuleName, ".m", no, FileName, !IO),
module_qualify_items(Items0, Items, Globals, ModuleName, yes(FileName),
MQInfo, UndefTypes, UndefModes, [], Specs),
- sort_error_specs(Specs, SortedSpecs),
- write_error_specs(SortedSpecs, 0, _NumWarnings, 0, _NumErrors, !IO),
+ write_error_specs(Specs, Globals, 0, _NumWarnings, 0, _NumErrors, !IO),
maybe_write_string(Verbose, "% done.\n", !IO),
maybe_report_stats(Stats, !IO).
@@ -1831,7 +1829,8 @@
Msg = error_msg(no, no, 0, [always(Pieces)]),
Spec = error_spec(severity_warning, phase_read_files, [Msg]),
% XXX _NumErrors
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO)
+ write_error_spec(Spec, Globals, 0, _NumWarnings, 0, _NumErrors,
+ !IO)
;
WarnNoTransOptDeps = no
)
@@ -1924,18 +1923,18 @@
;
FoundUndefTypeError = no,
maybe_write_string(Verbose, "% Checking typeclasses...\n", !IO),
- check_typeclass.check_typeclasses(QualInfo0, QualInfo, !HLDS,
- FoundTypeclassError, !IO),
+ check_typeclass.check_typeclasses(!HLDS, QualInfo0, QualInfo,
+ [], Specs),
maybe_dump_hlds(!.HLDS, 5, "typeclass", !DumpInfo, !IO),
set_module_recomp_info(QualInfo, !HLDS),
+ write_error_specs(Specs, Globals, 0, _NumWarnings, 0, NumErrors, !IO),
+
% We can't continue after a typeclass error, since typecheck
% can get internal errors.
- (
- FoundTypeclassError = yes,
+ ( NumErrors > 0 ->
!:FoundError = yes
;
- FoundTypeclassError = no,
frontend_pass_no_type_error(FoundUndefModeError, !FoundError,
!HLDS, !DumpInfo, !IO)
)
@@ -1992,8 +1991,8 @@
maybe_write_string(Verbose, "% Type-checking...\n", !IO),
maybe_write_string(Verbose, "% Type-checking clauses...\n", !IO),
typecheck_module(!HLDS, TypeCheckSpecs, ExceededTypeCheckIterationLimit),
- write_error_specs(TypeCheckSpecs, 0, _NumTypeWarnings, 0, NumTypeErrors,
- !IO),
+ write_error_specs(TypeCheckSpecs, Globals, 0, _NumTypeWarnings,
+ 0, NumTypeErrors, !IO),
maybe_report_stats(Stats, !IO),
( NumTypeErrors > 0 ->
module_info_incr_num_errors(NumTypeErrors, !HLDS),
@@ -2300,13 +2299,14 @@
bool::out, dump_info::in, dump_info::out, io::di, io::uo) is det.
frontend_pass_by_phases(!HLDS, FoundError, !DumpInfo, !IO) :-
- globals.io_lookup_bool_option(verbose, Verbose, !IO),
- globals.io_lookup_bool_option(statistics, Stats, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, verbose, Verbose),
+ globals.lookup_bool_option(Globals, statistics, Stats),
maybe_polymorphism(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 30, "polymorphism", !DumpInfo, !IO),
- maybe_unused_imports(Verbose, Stats, !HLDS, !IO),
+ maybe_unused_imports(Verbose, Stats, !.HLDS, UnusedImportSpecs, !IO),
maybe_dump_hlds(!.HLDS, 31, "unused_imports", !DumpInfo, !IO),
maybe_mode_constraints(Verbose, Stats, !HLDS, !IO),
@@ -2326,26 +2326,37 @@
detect_cse(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 45, "cse", !DumpInfo, !IO),
- check_determinism(Verbose, Stats, !HLDS, FoundDetError, !IO),
+ check_determinism(Verbose, Stats, !HLDS, DetismSpecs, !IO),
maybe_dump_hlds(!.HLDS, 50, "determinism", !DumpInfo, !IO),
+ Specs1 = UnusedImportSpecs ++ DetismSpecs,
+ write_error_specs(Specs1, Globals, 0, _NumWarnings1, 0, NumErrors1,
+ !IO),
+ module_info_incr_num_errors(NumErrors1, !HLDS),
+
check_unique_modes(Verbose, Stats, !HLDS, FoundUniqError, !IO),
maybe_dump_hlds(!.HLDS, 55, "unique_modes", !DumpInfo, !IO),
check_stratification(Verbose, Stats, !HLDS, FoundStratError, !IO),
maybe_dump_hlds(!.HLDS, 60, "stratification", !DumpInfo, !IO),
- simplify(yes, frontend, Verbose, Stats, process_all_nonimported_procs,
- !HLDS, !IO),
+ simplify(yes, frontend, Verbose, Stats, !HLDS, SimplifySpecs, !IO),
maybe_dump_hlds(!.HLDS, 65, "frontend_simplify", !DumpInfo, !IO),
+ % Once the other passes have all been converted to return error_specs,
+ % we can write them out all at once.
+ write_error_specs(SimplifySpecs, Globals, 0, _NumWarnings2,
+ 0, NumErrors2, !IO),
+ module_info_incr_num_errors(NumErrors2, !HLDS),
+
% Work out whether we encountered any errors.
io.get_exit_status(ExitStatus, !IO),
(
FoundModeError = no,
- FoundDetError = no,
FoundUniqError = no,
FoundStratError = no,
+ NumErrors1 = 0,
+ NumErrors2 = 0,
% Strictly speaking, we shouldn't need to check the exit status.
% But the values returned for FoundModeError etc. aren't always
% correct.
@@ -2365,8 +2376,9 @@
dump_info::in, dump_info::out, io::di, io::uo) is det.
middle_pass(ModuleName, !HLDS, !DumpInfo, !IO) :-
- globals.io_lookup_bool_option(verbose, Verbose, !IO),
- globals.io_lookup_bool_option(statistics, Stats, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, verbose, Verbose),
+ globals.lookup_bool_option(Globals, statistics, Stats),
maybe_read_experimental_complexity_file(!HLDS, !IO),
@@ -2485,8 +2497,10 @@
% propagation and we cannot do that once the term-size profiling or deep
% profiling transformations have been applied.
%
- simplify(no, pre_prof_transforms, Verbose, Stats,
- process_all_nonimported_procs, !HLDS, !IO),
+ simplify(no, pre_prof_transforms, Verbose, Stats, !HLDS, SimplifySpecs,
+ !IO),
+ expect(unify(contains_errors(Globals, SimplifySpecs), no), this_file,
+ "middle_pass: simplify has errors"),
maybe_dump_hlds(!.HLDS, 215, "pre_prof_transform_simplify", !DumpInfo,
!IO),
@@ -2550,8 +2564,9 @@
dump_info::in, dump_info::out, io::di, io::uo) is det.
backend_pass_by_phases(!HLDS, !GlobalData, LLDS, !DumpInfo, !IO) :-
- globals.io_lookup_bool_option(verbose, Verbose, !IO),
- globals.io_lookup_bool_option(statistics, Stats, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, verbose, Verbose),
+ globals.lookup_bool_option(Globals, statistics, Stats),
maybe_saved_vars(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 310, "saved_vars_const", !DumpInfo, !IO),
@@ -2562,8 +2577,9 @@
maybe_followcode(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 320, "followcode", !DumpInfo, !IO),
- simplify(no, ll_backend, Verbose, Stats, process_all_nonimported_procs,
- !HLDS, !IO),
+ simplify(no, ll_backend, Verbose, Stats, !HLDS, SimplifySpecs, !IO),
+ expect(unify(contains_errors(Globals, SimplifySpecs), no), this_file,
+ "backend_pass_by_phases: simplify has errors"),
maybe_dump_hlds(!.HLDS, 325, "ll_backend_simplify", !DumpInfo, !IO),
compute_liveness(Verbose, Stats, !HLDS, !IO),
@@ -2584,7 +2600,7 @@
!IO),
% maybe_dump_global_data(!.GlobalData, !IO),
- maybe_do_optimize(!.GlobalData, Verbose, Stats, LLDS1, LLDS, !IO).
+ maybe_do_optimize(!.HLDS, !.GlobalData, Verbose, Stats, LLDS1, LLDS, !IO).
:- pred backend_pass_by_preds(module_info::in, module_info::out,
global_data::in, global_data::out, list(c_procedure)::out,
@@ -2798,7 +2814,8 @@
puritycheck(Verbose, Stats, !HLDS, FoundTypeError, FoundPostTypecheckError,
!IO) :-
puritycheck(FoundTypeError, FoundPostTypecheckError, !HLDS, [], Specs),
- write_error_specs(Specs, 0, _NumWarnings, 0, NumErrors, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ write_error_specs(Specs, Globals, 0, _NumWarnings, 0, NumErrors, !IO),
( NumErrors > 0 ->
module_info_incr_num_errors(NumErrors, !HLDS),
maybe_write_string(Verbose,
@@ -2899,17 +2916,17 @@
).
:- pred check_determinism(bool::in, bool::in,
- module_info::in, module_info::out, bool::out, io::di, io::uo) is det.
+ module_info::in, module_info::out, list(error_spec)::out,
+ io::di, io::uo) is det.
-check_determinism(Verbose, Stats, !HLDS, FoundError, !IO) :-
- module_info_get_num_errors(!.HLDS, NumErrors0),
- determinism_pass(!HLDS, !IO),
- module_info_get_num_errors(!.HLDS, NumErrors),
- ( NumErrors \= NumErrors0 ->
+check_determinism(Verbose, Stats, !HLDS, Specs, !IO) :-
+ determinism_pass(!HLDS, Specs),
+ module_info_get_globals(!.HLDS, Globals),
+ FoundError = contains_errors(Globals, Specs),
+ (
FoundError = yes,
maybe_write_string(Verbose,
- "% Program contains determinism error(s).\n", !IO),
- io.set_exit_status(1, !IO)
+ "% Program contains determinism error(s).\n", !IO)
;
FoundError = no,
maybe_write_string(Verbose, "% Program is determinism-correct.\n", !IO)
@@ -3128,12 +3145,11 @@
% The first stage of LLDS code generation.
:- pred simplify(bool::in, simplify_pass::in, bool::in, bool::in,
- pred(task, module_info, module_info, io, io)::in(pred(task, in, out,
- di, uo) is det),
- module_info::in, module_info::out, io::di, io::uo) is det.
+ module_info::in, module_info::out, list(error_spec)::out,
+ io::di, io::uo) is det.
-simplify(Warn, SimplifyPass, Verbose, Stats, Process, !HLDS, !IO) :-
- globals.io_get_globals(Globals, !IO),
+simplify(Warn, SimplifyPass, Verbose, Stats, !HLDS, Specs, !IO) :-
+ module_info_get_globals(!.HLDS, Globals),
globals.lookup_bool_option(Globals, profile_deep, DeepProf),
globals.lookup_bool_option(Globals, record_term_sizes_as_words, TSWProf),
globals.lookup_bool_option(Globals, record_term_sizes_as_cells, TSCProf),
@@ -3147,7 +3163,7 @@
SimplifyPass = pre_prof_transforms,
IsProfPass = no
->
- true
+ Specs = []
;
maybe_write_string(Verbose, "% Simplifying goals...\n", !IO),
maybe_flush_output(Verbose, !IO),
@@ -3187,7 +3203,9 @@
Simplifications = list_to_simplifications(!.SimpList)
),
- Process(update_pred_error(simplify_pred(Simplifications)), !HLDS, !IO),
+ process_all_nonimported_procs_errors(
+ update_pred_error(simplify_pred(Simplifications)),
+ !HLDS, [], Specs, !IO),
maybe_write_string(Verbose, "% done.\n", !IO),
maybe_report_stats(Stats, !IO)
).
@@ -3404,10 +3422,11 @@
module_info::in, module_info::out, io::di, io::uo) is det.
maybe_polymorphism(Verbose, Stats, !HLDS, !IO) :-
- globals.io_lookup_bool_option(polymorphism, Polymorphism, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, polymorphism, Polymorphism),
(
Polymorphism = yes,
- globals.io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
+ globals.lookup_bool_option(Globals, very_verbose, VeryVerbose),
(
VeryVerbose = no,
maybe_write_string(Verbose,
@@ -3438,24 +3457,29 @@
).
:- pred maybe_unused_imports(bool::in, bool::in,
- module_info::in, module_info::out, io::di, io::uo) is det.
+ module_info::in, list(error_spec)::out, io::di, io::uo) is det.
-maybe_unused_imports(Verbose, Stats, !HLDS, !IO) :-
- globals.io_lookup_bool_option(warn_unused_imports, WarnUnusedImports, !IO),
- ( WarnUnusedImports = yes,
+maybe_unused_imports(Verbose, Stats, HLDS, Specs, !IO) :-
+ module_info_get_globals(HLDS, Globals),
+ globals.lookup_bool_option(Globals, warn_unused_imports,
+ WarnUnusedImports),
+ (
+ WarnUnusedImports = yes,
maybe_write_string(Verbose, "% Checking for unused imports...", !IO),
- unused_imports(!HLDS, !IO),
+ unused_imports(HLDS, Specs, !IO),
maybe_write_string(Verbose, " done.\n", !IO),
maybe_report_stats(Stats, !IO)
- ; WarnUnusedImports = no,
- true
+ ;
+ WarnUnusedImports = no,
+ Specs = []
).
:- pred maybe_type_ctor_infos(bool::in, bool::in,
module_info::in, module_info::out, io::di, io::uo) is det.
maybe_type_ctor_infos(Verbose, Stats, !HLDS, !IO) :-
- globals.io_lookup_bool_option(type_ctor_info, TypeCtorInfo, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, type_ctor_info, TypeCtorInfo),
(
TypeCtorInfo = yes,
maybe_write_string(Verbose,
@@ -3472,7 +3496,8 @@
bool::in, bool::in, dump_info::in, dump_info::out, io::di, io::uo) is det.
maybe_bytecodes(HLDS0, ModuleName, Verbose, Stats, !DumpInfo, !IO) :-
- globals.io_lookup_bool_option(generate_bytecode, GenBytecode, !IO),
+ module_info_get_globals(HLDS0, Globals),
+ globals.lookup_bool_option(Globals, generate_bytecode, GenBytecode),
(
GenBytecode = yes,
map_args_to_regs(Verbose, Stats, HLDS0, HLDS1, !IO),
@@ -3506,15 +3531,17 @@
module_info::in, module_info::out, io::di, io::uo) is det.
maybe_untuple_arguments(Verbose, Stats, !HLDS, !IO) :-
- globals.io_lookup_bool_option(untuple, Untuple, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, untuple, Untuple),
(
Untuple = yes,
maybe_write_string(Verbose, "% Untupling...\n", !IO),
maybe_flush_output(Verbose, !IO),
untuple_arguments(!HLDS, !IO),
maybe_write_string(Verbose, "% done.\n", !IO),
- simplify(no, post_untuple, Verbose, Stats,
- process_all_nonimported_procs, !HLDS, !IO),
+ simplify(no, post_untuple, Verbose, Stats, !HLDS, SimplifySpecs, !IO),
+ expect(unify(contains_errors(Globals, SimplifySpecs), no), this_file,
+ "maybe_untuple_arguments: simplify has errors"),
maybe_report_stats(Stats, !IO)
;
Untuple = no
@@ -3524,7 +3551,8 @@
module_info::in, module_info::out, io::di, io::uo) is det.
maybe_tuple_arguments(Verbose, Stats, !HLDS, !IO) :-
- globals.io_lookup_bool_option(tuple, Tuple, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, untuple, Tuple),
(
Tuple = yes,
maybe_write_string(Verbose, "% Tupling...\n", !IO),
@@ -3540,10 +3568,11 @@
module_info::in, module_info::out, io::di, io::uo) is det.
maybe_higher_order(Verbose, Stats, !HLDS, !IO) :-
- globals.io_lookup_bool_option(optimize_higher_order, HigherOrder, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, optimize_higher_order, HigherOrder),
% --type-specialization implies --user-guided-type-specialization.
- globals.io_lookup_bool_option(user_guided_type_specialization, Types,
- !IO),
+ globals.lookup_bool_option(Globals, user_guided_type_specialization,
+ Types),
% Always produce the specialized versions for which
% `:- pragma type_spec' declarations exist, because
@@ -3572,10 +3601,11 @@
module_info::in, module_info::out, io::di, io::uo) is det.
maybe_do_inlining(Verbose, Stats, !HLDS, !IO) :-
- globals.io_lookup_bool_option(allow_inlining, Allow, !IO),
- globals.io_lookup_bool_option(inline_simple, Simple, !IO),
- globals.io_lookup_bool_option(inline_single_use, SingleUse, !IO),
- globals.io_lookup_int_option(inline_compound_threshold, Threshold, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, allow_inlining, Allow),
+ globals.lookup_bool_option(Globals, inline_simple, Simple),
+ globals.lookup_bool_option(Globals, inline_single_use, SingleUse),
+ globals.lookup_int_option(Globals, inline_compound_threshold, Threshold),
(
Allow = yes,
( Simple = yes
@@ -3585,7 +3615,7 @@
->
maybe_write_string(Verbose, "% Inlining...\n", !IO),
maybe_flush_output(Verbose, !IO),
- inlining(!HLDS, !IO),
+ inlining(!HLDS),
maybe_write_string(Verbose, "% done.\n", !IO),
maybe_report_stats(Stats, !IO)
;
@@ -3596,11 +3626,12 @@
module_info::in, module_info::out, io::di, io::uo) is det.
maybe_deforestation(Verbose, Stats, !HLDS, !IO) :-
- globals.io_lookup_bool_option(deforestation, Deforest, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, deforestation, Deforest),
% --constraint-propagation implies --local-constraint-propagation.
- globals.io_lookup_bool_option(local_constraint_propagation, Constraints,
- !IO),
+ globals.lookup_bool_option(Globals, local_constraint_propagation,
+ Constraints),
(
( Deforest = yes
; Constraints = yes
@@ -3637,7 +3668,8 @@
io::di, io::uo) is det.
maybe_loop_inv(Verbose, Stats, !HLDS, !DumpInfo, !IO) :-
- globals.io_lookup_bool_option(loop_invariants, LoopInv, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, loop_invariants, LoopInv),
(
LoopInv = yes,
% We run the mark_static pass because we need the construct_how flag
@@ -3660,7 +3692,8 @@
module_info::in, module_info::out, io::di, io::uo) is det.
maybe_delay_construct(Verbose, Stats, !HLDS, !IO) :-
- globals.io_lookup_bool_option(delay_construct, DelayConstruct, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, delay_construct, DelayConstruct),
(
DelayConstruct = yes,
maybe_write_string(Verbose,
@@ -3678,7 +3711,7 @@
module_info::in, module_info::out, io::di, io::uo) is det.
maybe_unused_args(Verbose, Stats, !HLDS, !IO) :-
- globals.io_get_globals(Globals, !IO),
+ module_info_get_globals(!.HLDS, Globals),
globals.lookup_bool_option(Globals, intermod_unused_args, Intermod),
globals.lookup_bool_option(Globals, optimize_unused_args, Optimize),
globals.lookup_bool_option(Globals, warn_unused_args, Warn),
@@ -3701,7 +3734,8 @@
module_info::in, module_info::out, io::di, io::uo) is det.
maybe_unneeded_code(Verbose, Stats, !HLDS, !IO) :-
- globals.io_lookup_bool_option(unneeded_code, UnneededCode, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, unneeded_code, UnneededCode),
(
UnneededCode = yes,
maybe_write_string(Verbose,
@@ -3719,7 +3753,8 @@
module_info::in, module_info::out, io::di, io::uo) is det.
maybe_eliminate_dead_procs(Verbose, Stats, !HLDS, !IO) :-
- globals.io_lookup_bool_option(optimize_dead_procs, Dead, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, optimize_dead_procs, Dead),
(
Dead = yes,
maybe_write_string(Verbose, "% Eliminating dead procedures...\n", !IO),
@@ -3735,8 +3770,8 @@
module_info::in, module_info::out, io::di, io::uo) is det.
maybe_structure_sharing_analysis(Verbose, Stats, !HLDS, !IO) :-
- globals.io_lookup_bool_option(structure_sharing_analysis,
- Sharing, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, structure_sharing_analysis, Sharing),
(
Sharing = yes,
maybe_write_string(Verbose, "% Structure sharing analysis...\n",
@@ -3767,8 +3802,9 @@
module_info::in, module_info::out, io::di, io::uo) is det.
maybe_structure_reuse_analysis(Verbose, Stats, !HLDS, !IO) :-
- globals.io_lookup_bool_option(structure_reuse_analysis,
- ReuseAnalysis, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, structure_reuse_analysis,
+ ReuseAnalysis),
(
ReuseAnalysis = yes,
maybe_write_string(Verbose, "% Structure reuse analysis...\n",
@@ -3785,8 +3821,9 @@
module_info::in, module_info::out, io::di, io::uo) is det.
maybe_term_size_prof(Verbose, Stats, !HLDS, !IO) :-
- globals.io_lookup_bool_option(record_term_sizes_as_words, AsWords, !IO),
- globals.io_lookup_bool_option(record_term_sizes_as_cells, AsCells, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, record_term_sizes_as_words, AsWords),
+ globals.lookup_bool_option(Globals, record_term_sizes_as_cells, AsCells),
(
AsWords = yes,
AsCells = yes,
@@ -3822,11 +3859,12 @@
module_info::in, module_info::out, io::di, io::uo) is det.
maybe_read_experimental_complexity_file(!HLDS, !IO) :-
- globals.io_lookup_string_option(experimental_complexity, FileName, !IO),
- globals.io_lookup_bool_option(record_term_sizes_as_words,
- RecordTermSizesAsWords, !IO),
- globals.io_lookup_bool_option(record_term_sizes_as_cells,
- RecordTermSizesAsCells, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_string_option(Globals, experimental_complexity, FileName),
+ globals.lookup_bool_option(Globals, record_term_sizes_as_words,
+ RecordTermSizesAsWords),
+ globals.lookup_bool_option(Globals, record_term_sizes_as_cells,
+ RecordTermSizesAsCells),
bool.or(RecordTermSizesAsWords, RecordTermSizesAsCells,
RecordTermSizes),
( FileName = "" ->
@@ -3888,7 +3926,8 @@
module_info::in, module_info::out, io::di, io::uo) is det.
maybe_deep_profiling(Verbose, Stats, !HLDS, !IO) :-
- globals.io_lookup_bool_option(profile_deep, ProfileDeep, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, profile_deep, ProfileDeep),
(
ProfileDeep = yes,
maybe_write_string(Verbose,
@@ -3905,7 +3944,8 @@
module_info::in, module_info::out, io::di, io::uo) is det.
maybe_introduce_accumulators(Verbose, Stats, !HLDS, !IO) :-
- globals.io_lookup_bool_option(introduce_accumulators, Optimize, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, introduce_accumulators, Optimize),
(
Optimize = yes,
maybe_write_string(Verbose,
@@ -3923,7 +3963,8 @@
module_info::in, module_info::out, io::di, io::uo) is det.
maybe_lco(Verbose, Stats, !HLDS, !IO) :-
- globals.io_lookup_bool_option(optimize_constructor_last_call, LCO, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, optimize_constructor_last_call, LCO),
(
LCO = yes,
maybe_write_string(Verbose,
@@ -3954,7 +3995,8 @@
module_info::in, module_info::out, io::di, io::uo) is det.
maybe_saved_vars(Verbose, Stats, !HLDS, !IO) :-
- globals.io_lookup_bool_option(optimize_saved_vars_const, SavedVars, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, optimize_saved_vars_const, SavedVars),
(
SavedVars = yes,
maybe_write_string(Verbose,
@@ -3972,7 +4014,8 @@
module_info::in, module_info::out, io::di, io::uo) is det.
maybe_stack_opt(Verbose, Stats, !HLDS, !IO) :-
- globals.io_lookup_bool_option(optimize_saved_vars_cell, SavedVars, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, optimize_saved_vars_cell, SavedVars),
(
SavedVars = yes,
maybe_write_string(Verbose,
@@ -3990,8 +4033,9 @@
module_info::in, module_info::out, io::di, io::uo) is det.
maybe_followcode(Verbose, Stats, !HLDS, !IO) :-
- globals.io_lookup_bool_option(follow_code, FollowCode, !IO),
- globals.io_lookup_bool_option(prev_code, PrevCode, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, follow_code, FollowCode),
+ globals.lookup_bool_option(Globals, prev_code, PrevCode),
(
( FollowCode = yes
; PrevCode = yes
@@ -4011,10 +4055,11 @@
module_info::in, module_info::out, io::di, io::uo) is det.
compute_liveness(Verbose, Stats, !HLDS, !IO) :-
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, parallel_liveness, ParallelLiveness),
+ globals.lookup_int_option(Globals, debug_liveness, DebugLiveness),
maybe_write_string(Verbose, "% Computing liveness...\n", !IO),
maybe_flush_output(Verbose, !IO),
- globals.io_lookup_bool_option(parallel_liveness, ParallelLiveness, !IO),
- globals.io_lookup_int_option(debug_liveness, DebugLiveness, !IO),
(
ParallelLiveness = yes,
DebugLiveness = -1
@@ -4053,7 +4098,8 @@
module_info::in, module_info::out, io::di, io::uo) is det.
maybe_goal_paths(Verbose, Stats, !HLDS, !IO) :-
- globals.io_get_trace_level(TraceLevel, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.get_trace_level(Globals, TraceLevel),
( given_trace_level_is_none(TraceLevel) = no ->
maybe_write_string(Verbose, "% Calculating goal paths...", !IO),
maybe_flush_output(Verbose, !IO),
@@ -4076,11 +4122,12 @@
maybe_write_string(Verbose, "% done.\n", !IO),
maybe_report_stats(Stats, !IO).
-:- pred maybe_do_optimize(global_data::in, bool::in, bool::in,
+:- pred maybe_do_optimize(module_info::in, global_data::in, bool::in, bool::in,
list(c_procedure)::in, list(c_procedure)::out, io::di, io::uo) is det.
-maybe_do_optimize(GlobalData, Verbose, Stats, !LLDS, !IO) :-
- globals.io_lookup_bool_option(optimize, Optimize, !IO),
+maybe_do_optimize(HLDS, GlobalData, Verbose, Stats, !LLDS, !IO) :-
+ module_info_get_globals(HLDS, Globals),
+ globals.lookup_bool_option(Globals, optimize, Optimize),
(
Optimize = yes,
maybe_write_string(Verbose, "% Doing optimizations...\n", !IO),
@@ -4146,15 +4193,16 @@
output_pass(HLDS, GlobalData0, Procs, ModuleName, CompileErrors,
FactTableObjFiles, !IO) :-
- globals.io_lookup_bool_option(verbose, Verbose, !IO),
- globals.io_lookup_bool_option(statistics, Stats, !IO),
+ module_info_get_globals(HLDS, Globals),
+ globals.lookup_bool_option(Globals, verbose, Verbose),
+ globals.lookup_bool_option(Globals, statistics, Stats),
% Here we generate the LLDS representations for various data structures
% used for RTTI, type classes, and stack layouts.
% XXX This should perhaps be part of backend_pass rather than output_pass.
type_ctor_info.generate_rtti(HLDS, TypeCtorRttiData),
generate_base_typeclass_info_rtti(HLDS, OldTypeClassInfoRttiData),
- globals.io_lookup_bool_option(new_type_class_rtti, NewTypeClassRtti, !IO),
+ globals.lookup_bool_option(Globals, new_type_class_rtti, NewTypeClassRtti),
generate_type_class_info_rtti(HLDS, NewTypeClassRtti,
NewTypeClassInfoRttiData),
list.append(OldTypeClassInfoRttiData, NewTypeClassInfoRttiData,
@@ -4186,7 +4234,7 @@
export.produce_header_file(C_ExportDecls, ModuleName, !IO),
% Finally we invoke the C compiler to compile it.
- globals.io_lookup_bool_option(target_code_only, TargetCodeOnly, !IO),
+ globals.lookup_bool_option(Globals, target_code_only, TargetCodeOnly),
(
TargetCodeOnly = no,
io.output_stream(OutputStream, !IO),
@@ -4218,7 +4266,8 @@
C_Includes, C_BodyCode0, _C_ExportDecls, C_ExportDefns),
MangledModuleName = sym_name_mangle(ModuleSymName),
string.append(MangledModuleName, "_module", ModuleName),
- globals.io_lookup_int_option(procs_per_c_function, ProcsPerFunc, !IO),
+ module_info_get_globals(ModuleInfo, Globals),
+ globals.lookup_int_option(Globals, procs_per_c_function, ProcsPerFunc),
get_c_body_code(C_BodyCode0, C_BodyCode),
( ProcsPerFunc = 0 ->
% ProcsPerFunc = 0 really means infinity -
@@ -4373,11 +4422,13 @@
dump_info::in, dump_info::out, io::di, io::uo) is det.
mlds_backend(!HLDS, MLDS, !DumpInfo, !IO) :-
- globals.io_lookup_bool_option(verbose, Verbose, !IO),
- globals.io_lookup_bool_option(statistics, Stats, !IO),
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, verbose, Verbose),
+ globals.lookup_bool_option(Globals, statistics, Stats),
- simplify(no, ml_backend, Verbose, Stats,
- process_all_nonimported_procs, !HLDS, !IO),
+ simplify(no, ml_backend, Verbose, Stats, !HLDS, SimplifySpecs, !IO),
+ expect(unify(contains_errors(Globals, SimplifySpecs), no), this_file,
+ "ml_backend: simplify has errors"),
maybe_dump_hlds(!.HLDS, 405, "ml_backend_simplify", !DumpInfo, !IO),
% NOTE: it is unsafe for passes after add_trail_ops to reorder
@@ -4418,7 +4469,7 @@
% chain_gc_stack_frame pass of ml_elim_nested,
% because we need to unlink the stack frame from the
% stack chain before tail calls.
- globals.io_lookup_bool_option(optimize_tailcalls, OptimizeTailCalls, !IO),
+ globals.lookup_bool_option(Globals, optimize_tailcalls, OptimizeTailCalls),
(
OptimizeTailCalls = yes,
maybe_write_string(Verbose, "% Detecting tail calls...\n", !IO),
@@ -4431,17 +4482,16 @@
maybe_report_stats(Stats, !IO),
maybe_dump_mlds(MLDS20, 20, "tailcalls", !IO),
- % Warning about non-tail calls needs to come after detection
- % of tail calls
- globals.io_lookup_bool_option(warn_non_tail_recursion, WarnTailCalls,
- !IO),
+ % Warning about non-tail calls must come after detection of tail calls.
+ globals.lookup_bool_option(Globals, warn_non_tail_recursion,
+ WarnTailCalls),
(
OptimizeTailCalls = yes,
WarnTailCalls = yes
->
maybe_write_string(Verbose,
"% Warning about non-tail recursive calls...\n", !IO),
- ml_warn_tailcalls(MLDS20, !IO),
+ ml_warn_tailcalls(Globals, MLDS20, !IO),
maybe_write_string(Verbose, "% done.\n", !IO)
;
true
@@ -4456,11 +4506,11 @@
%
% However, we need to disable optimize_initializations, because
% ml_elim_nested doesn't correctly handle code containing initializations.
- globals.io_lookup_bool_option(optimize, Optimize, !IO),
+ globals.lookup_bool_option(Globals, optimize, Optimize),
(
Optimize = yes,
- globals.io_lookup_bool_option(optimize_initializations,
- OptimizeInitializations, !IO),
+ globals.lookup_bool_option(Globals, optimize_initializations,
+ OptimizeInitializations),
globals.io_set_option(optimize_initializations, bool(no), !IO),
maybe_write_string(Verbose, "% Optimizing MLDS...\n", !IO),
ml_optimize.optimize(MLDS20, MLDS25, !IO),
@@ -4482,7 +4532,7 @@
% for accurate GC needs to be done first, because the code for doing that
% can't handle the env_ptr references that the other pass generates.
- globals.io_get_gc_method(GC, !IO),
+ globals.get_gc_method(Globals, GC),
( GC = gc_accurate ->
maybe_write_string(Verbose,
"% Threading GC stack frames...\n", !IO),
@@ -4494,7 +4544,7 @@
maybe_report_stats(Stats, !IO),
maybe_dump_mlds(MLDS30, 30, "gc_frames", !IO),
- globals.io_lookup_bool_option(gcc_nested_functions, NestedFuncs, !IO),
+ globals.lookup_bool_option(Globals, gcc_nested_functions, NestedFuncs),
(
NestedFuncs = no,
maybe_write_string(Verbose, "% Flattening nested functions...\n", !IO),
@@ -4604,10 +4654,11 @@
dump_info::in, dump_info::out, io::di, io::uo) is det.
maybe_dump_hlds(HLDS, StageNum, StageName, !DumpInfo, !IO) :-
- globals.io_lookup_bool_option(verbose, Verbose, !IO),
- globals.io_lookup_accumulating_option(dump_hlds, DumpHLDSStages, !IO),
- globals.io_lookup_accumulating_option(dump_trace_counts, DumpTraceStages,
- !IO),
+ module_info_get_globals(HLDS, Globals),
+ globals.lookup_bool_option(Globals, verbose, Verbose),
+ globals.lookup_accumulating_option(Globals, dump_hlds, DumpHLDSStages),
+ globals.lookup_accumulating_option(Globals, dump_trace_counts,
+ DumpTraceStages),
StageNumStr = stage_num_str(StageNum),
( should_dump_stage(StageNum, StageNumStr, StageName, DumpHLDSStages) ->
module_info_get_name(HLDS, ModuleName),
@@ -4695,8 +4746,9 @@
:- pred dump_hlds(string::in, module_info::in, io::di, io::uo) is det.
dump_hlds(DumpFile, HLDS, !IO) :-
- globals.io_lookup_bool_option(verbose, Verbose, !IO),
- globals.io_lookup_bool_option(statistics, Stats, !IO),
+ module_info_get_globals(HLDS, Globals),
+ globals.lookup_bool_option(Globals, verbose, Verbose),
+ globals.lookup_bool_option(Globals, statistics, Stats),
maybe_write_string(Verbose, "% Dumping out HLDS to `", !IO),
maybe_write_string(Verbose, DumpFile, !IO),
maybe_write_string(Verbose, "'...", !IO),
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.305
diff -u -b -r1.305 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 2 Oct 2006 05:21:13 -0000 1.305
+++ compiler/mercury_to_mercury.m 12 Oct 2006 08:16:55 -0000
@@ -807,10 +807,10 @@
mercury_format_fundeps_and_prog_constraint_list(FunDeps, Constraints,
VarSet, AppendVarnums, !IO),
(
- Interface = abstract,
+ Interface = class_interface_abstract,
io.write_string(".\n", !IO)
;
- Interface = concrete(Methods),
+ Interface = class_interface_concrete(Methods),
io.write_string(" where [\n", !IO),
output_class_methods(Methods, !IO),
io.write_string("\n].\n", !IO)
@@ -830,9 +830,9 @@
mercury_format_prog_constraint_list(Constraints, VarSet, "<=",
AppendVarnums, !IO),
(
- Body = abstract
+ Body = instance_body_abstract
;
- Body = concrete(Methods),
+ Body = instance_body_concrete(Methods),
io.write_string(" where [\n", !IO),
mercury_output_instance_methods(Methods, !IO),
io.write_string("\n]", !IO)
@@ -935,7 +935,7 @@
output_instance_method(Method, !IO) :-
Method = instance_method(PredOrFunc, Name1, Defn, Arity, Context),
(
- Defn = name(Name2),
+ Defn = instance_proc_def_name(Name2),
io.write_char('\t', !IO),
(
PredOrFunc = function,
@@ -950,7 +950,7 @@
io.write_string(") is ", !IO),
mercury_output_bracketed_sym_name(Name2, !IO)
;
- Defn = clauses(ItemList),
+ Defn = instance_proc_def_clauses(ItemList),
% XXX should we output the term contexts?
io.write_string("\t(", !IO),
io.write_list(ItemList, "),\n\t(",
Index: compiler/ml_tailcall.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_tailcall.m,v
retrieving revision 1.42
diff -u -b -r1.42 ml_tailcall.m
--- compiler/ml_tailcall.m 1 Oct 2006 04:57:31 -0000 1.42
+++ compiler/ml_tailcall.m 12 Oct 2006 06:49:19 -0000
@@ -57,20 +57,20 @@
:- interface.
:- import_module ml_backend.mlds.
+:- import_module libs.globals.
:- import_module io.
%-----------------------------------------------------------------------------%
- % Traverse the MLDS, marking all optimizable tail calls
- % as tail calls.
+ % Traverse the MLDS, marking all optimizable tail calls as tail calls.
%
:- pred ml_mark_tailcalls(mlds::in, mlds::out, io::di, io::uo) is det.
% Traverse the MLDS, warning about all directly recursive calls
% that are not marked as tail calls.
%
-:- pred ml_warn_tailcalls(mlds::in, io::di, io::uo) is det.
+:- pred ml_warn_tailcalls(globals::in, mlds::in, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -515,9 +515,9 @@
%-----------------------------------------------------------------------------%
-ml_warn_tailcalls(MLDS, !IO) :-
+ml_warn_tailcalls(Globals, MLDS, !IO) :-
solutions.solutions(nontailcall_in_mlds(MLDS), Warnings),
- list.foldl(report_nontailcall_warning, Warnings, !IO).
+ list.foldl(report_nontailcall_warning(Globals), Warnings, !IO).
:- type tailcall_warning
---> tailcall_warning(
@@ -583,11 +583,11 @@
% If so, construct an appropriate warning.
Warning = tailcall_warning(PredLabel, ProcId, Context).
-:- pred report_nontailcall_warning(tailcall_warning::in,
+:- pred report_nontailcall_warning(globals::in, tailcall_warning::in,
io::di, io::uo) is det.
-report_nontailcall_warning(tailcall_warning(PredLabel, ProcId, Context),
- !IO) :-
+report_nontailcall_warning(Globals, Warning, !IO) :-
+ Warning = tailcall_warning(PredLabel, ProcId, Context),
(
PredLabel = mlds_user_pred_label(PredOrFunc, _MaybeModule, Name, Arity,
_CodeModel, _NonOutputFunc),
@@ -600,7 +600,7 @@
words("warning: recursive call is not tail recursive."), nl],
Msg = simple_msg(mlds_get_prog_context(Context), [always(Pieces)]),
Spec = error_spec(severity_warning, phase_code_gen, [Msg]),
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO)
+ write_error_spec(Spec, Globals, 0, _NumWarnings, 0, _NumErrors, !IO)
;
PredLabel = mlds_special_pred_label(_, _, _, _)
% Don't warn about these.
Index: compiler/mode_errors.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_errors.m,v
retrieving revision 1.110
diff -u -b -r1.110 mode_errors.m
--- compiler/mode_errors.m 27 Sep 2006 06:16:55 -0000 1.110
+++ compiler/mode_errors.m 12 Oct 2006 05:57:52 -0000
@@ -282,8 +282,9 @@
report_mode_error(ModeError, !ModeInfo, !IO) :-
Spec = mode_error_to_spec(ModeError, !.ModeInfo),
- write_error_spec(Spec, 0, _NumWarnings, 0, NumErrors, !IO),
mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
+ module_info_get_globals(ModuleInfo0, Globals),
+ write_error_spec(Spec, Globals, 0, _NumWarnings, 0, NumErrors, !IO),
module_info_incr_num_errors(NumErrors, ModuleInfo0, ModuleInfo),
mode_info_set_module_info(ModuleInfo, !ModeInfo).
@@ -294,8 +295,9 @@
report_mode_warning(Warning, !ModeInfo, !IO) :-
Spec = mode_warning_to_spec(!.ModeInfo, Warning),
- write_error_spec(Spec, 0, _NumWarnings, 0, NumErrors, !IO),
mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
+ module_info_get_globals(ModuleInfo0, Globals),
+ write_error_spec(Spec, Globals, 0, _NumWarnings, 0, NumErrors, !IO),
module_info_incr_num_errors(NumErrors, ModuleInfo0, ModuleInfo),
mode_info_set_module_info(ModuleInfo, !ModeInfo).
@@ -1183,7 +1185,9 @@
Spec = error_spec(severity_error, phase_mode_check,
[simple_msg(Context,
[always(MainPieces), verbose_only(VerbosePieces)])]),
- write_error_spec(Spec, 0, _NumWarnings, 0, NumErrors, !IO),
+ module_info_get_globals(!.ModuleInfo, Globals),
+ write_error_spec(Spec, Globals, 0, _NumWarnings, 0, NumErrors,
+ !IO),
module_info_incr_num_errors(NumErrors, !ModuleInfo)
)
;
@@ -1194,7 +1198,8 @@
++ [suffix("."), nl],
Spec = error_spec(severity_error, phase_mode_check,
[simple_msg(Context, [always(Pieces)])]),
- write_error_spec(Spec, 0, _NumWarnings, 0, NumErrors, !IO),
+ module_info_get_globals(!.ModuleInfo, Globals),
+ write_error_spec(Spec, Globals, 0, _NumWarnings, 0, NumErrors, !IO),
module_info_incr_num_errors(NumErrors, !ModuleInfo)
).
@@ -1311,7 +1316,8 @@
Pieces = [words(Verb), words(Detail), nl],
Msg = simple_msg(Context, [always(Pieces)]),
Spec = error_spec(severity_informational, phase_mode_check, [Msg]),
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO)
+ module_info_get_globals(ModuleInfo, Globals),
+ write_error_spec(Spec, Globals, 0, _NumWarnings, 0, _NumErrors, !IO)
).
%-----------------------------------------------------------------------------%
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.347
diff -u -b -r1.347 modes.m
--- compiler/modes.m 2 Oct 2006 05:21:18 -0000 1.347
+++ compiler/modes.m 12 Oct 2006 05:59:58 -0000
@@ -465,7 +465,7 @@
;
% Stop if we have exceeded the iteration limit.
( MaxIterations =< 1 ->
- report_max_iterations_exceeded(!IO),
+ report_max_iterations_exceeded(!.ModuleInfo, !IO),
UnsafeToContinue = yes
;
globals.io_lookup_bool_option(debug_modes, DebugModes, !IO),
@@ -506,11 +506,12 @@
)
).
-:- pred report_max_iterations_exceeded(io::di, io::uo) is det.
+:- pred report_max_iterations_exceeded(module_info::in, io::di, io::uo) is det.
-report_max_iterations_exceeded(!IO) :-
- globals.io_lookup_int_option(mode_inference_iteration_limit,
- MaxIterations, !IO),
+report_max_iterations_exceeded(ModuleInfo, !IO) :-
+ module_info_get_globals(ModuleInfo, Globals),
+ globals.lookup_int_option(Globals, mode_inference_iteration_limit,
+ MaxIterations),
Pieces = [words("Mode analysis iteration limit exceeded."), nl,
words("You may need to declare the modes explicitly"),
words("or use the `--mode-inference-iteration-limit' option"),
@@ -520,7 +521,7 @@
Msg = error_msg(no, no, 0, [always(Pieces)]),
Spec = error_spec(severity_error, phase_mode_check, [Msg]),
% XXX _NumErrors
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO).
+ write_error_spec(Spec, Globals, 0, _NumWarnings, 0, _NumErrors, !IO).
% copy_pred_bodies(OldPredTable, ProcId, ModuleInfo0, ModuleInfo):
%
@@ -3387,7 +3388,8 @@
Msg = simple_msg(Context,
[always(MainPieces), verbose_only(VerbosePieces)]),
Spec = error_spec(severity_error, phase_mode_check, [Msg]),
- write_error_spec(Spec, 0, _NumWarnings, 0, NumErrors, !IO),
+ module_info_get_globals(!.ModuleInfo, Globals),
+ write_error_spec(Spec, Globals, 0, _NumWarnings, 0, NumErrors, !IO),
module_info_incr_num_errors(NumErrors, !ModuleInfo).
:- pred report_eval_method_destroys_uniqueness(proc_info::in,
@@ -3409,7 +3411,8 @@
Msg = simple_msg(Context,
[always(MainPieces), verbose_only(VerbosePieces)]),
Spec = error_spec(severity_error, phase_mode_check, [Msg]),
- write_error_spec(Spec, 0, _NumWarnings, 0, NumErrors, !IO),
+ module_info_get_globals(!.ModuleInfo, Globals),
+ write_error_spec(Spec, Globals, 0, _NumWarnings, 0, NumErrors, !IO),
module_info_incr_num_errors(NumErrors, !ModuleInfo).
:- pred report_wrong_mode_for_main(proc_info::in,
@@ -3420,7 +3423,8 @@
Pieces = [words("Error: main/2 must have mode `(di, uo)'."), nl],
Msg = simple_msg(Context, [always(Pieces)]),
Spec = error_spec(severity_error, phase_mode_check, [Msg]),
- write_error_spec(Spec, 0, _NumWarnings, 0, NumErrors, !IO),
+ module_info_get_globals(!.ModuleInfo, Globals),
+ write_error_spec(Spec, Globals, 0, _NumWarnings, 0, NumErrors, !IO),
module_info_incr_num_errors(NumErrors, !ModuleInfo).
%-----------------------------------------------------------------------------%
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.149
diff -u -b -r1.149 module_qual.m
--- compiler/module_qual.m 2 Oct 2006 05:21:18 -0000 1.149
+++ compiler/module_qual.m 12 Oct 2006 08:09:16 -0000
@@ -715,12 +715,12 @@
mq_info_set_error_context(mqec_class(mq_id(Name, Arity)) - Context, !Info),
qualify_prog_constraint_list(Constraints0, Constraints, !Info, !Specs),
(
- Interface0 = abstract,
- Interface = abstract
+ Interface0 = class_interface_abstract,
+ Interface = class_interface_abstract
;
- Interface0 = concrete(Methods0),
+ Interface0 = class_interface_concrete(Methods0),
qualify_class_interface(Methods0, Methods, !Info, !Specs),
- Interface = concrete(Methods)
+ Interface = class_interface_concrete(Methods)
).
module_qualify_item(
@@ -1262,8 +1262,12 @@
:- pred qualify_instance_body(sym_name::in, instance_body::in,
instance_body::out) is det.
-qualify_instance_body(_ClassName, abstract, abstract).
-qualify_instance_body(ClassName, concrete(M0s), concrete(Ms)) :-
+qualify_instance_body(ClassName, InstanceBody0, InstanceBody) :-
+ (
+ InstanceBody0 = instance_body_abstract,
+ InstanceBody = instance_body_abstract
+ ;
+ InstanceBody0 = instance_body_concrete(M0s),
( ClassName = unqualified(_) ->
Ms = M0s
;
@@ -1274,6 +1278,8 @@
M = instance_method(A, Method, C, D, E)
),
list.map(Qualify, M0s, Ms)
+ ),
+ InstanceBody = instance_body_concrete(Ms)
).
:- pred add_module_qualifier(sym_name::in, sym_name::in, sym_name::out) is det.
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.406
diff -u -b -r1.406 modules.m
--- compiler/modules.m 5 Oct 2006 04:45:33 -0000 1.406
+++ compiler/modules.m 12 Oct 2006 08:10:21 -0000
@@ -1267,8 +1267,8 @@
(
Specs = [_ | _],
sort_error_specs(Specs, SortedSpecs),
- write_error_specs(SortedSpecs, 0, _NumWarnings, 0, _NumErrors,
- !IO),
+ write_error_specs(SortedSpecs, Globals, 0, _NumWarnings,
+ 0, _NumErrors, !IO),
io.write_strings(["`", FileName, "' not written.\n"], !IO)
;
Specs = [],
@@ -1389,8 +1389,8 @@
% the exit status at zero) if we found some warnings.
globals.io_set_option(halt_at_warn, bool(no), !IO),
sort_error_specs(Specs, SortedSpecs),
- write_error_specs(SortedSpecs, 0, _NumWarnings, 0, NumErrors,
- !IO),
+ write_error_specs(SortedSpecs, Globals, 0, _NumWarnings,
+ 0, NumErrors, !IO),
( NumErrors > 0 ->
module_name_to_file_name(ModuleName, ".int", no, IntFileName,
!IO),
@@ -1433,7 +1433,7 @@
module_qualify_items(ShortInterfaceItems0, ShortInterfaceItems,
Globals, ModuleName, no, _, _, _, [], Specs),
sort_error_specs(Specs, SortedSpecs),
- write_error_specs(SortedSpecs, 0, _NumWarnings, 0, _NumErrors,
+ write_error_specs(SortedSpecs, Globals, 0, _NumWarnings, 0, _NumErrors,
!IO),
% XXX why do we do this even if there are some errors?
write_interface_file(SourceFileName, ModuleName, ".int3",
@@ -2155,8 +2155,9 @@
]),
Msg = simple_msg(Context, [Component]),
Spec = error_spec(Severity, phase_term_to_parse_tree, [Msg]),
+ globals.io_get_globals(Globals, !IO),
% XXX _NumErrors
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO).
+ write_error_spec(Spec, Globals, 0, _NumWarnings, 0, _NumErrors, !IO).
%-----------------------------------------------------------------------------%
@@ -2541,7 +2542,8 @@
ImpImportedModules ++ ImpUsedModules, Items, !Specs),
sort_error_specs(!.Specs, SortedSpecs),
- write_error_specs(SortedSpecs, 0, _NumWarnings, 0, _NumErrors, !IO),
+ write_error_specs(SortedSpecs, Globals, 0, _NumWarnings,
+ 0, _NumErrors, !IO),
module_imports_get_error(!.Module, Error)
).
@@ -2639,7 +2641,8 @@
Items, !Specs),
sort_error_specs(!.Specs, SortedSpecs),
- write_error_specs(SortedSpecs, 0, _NumWarnings, 0, _NumErrors, !IO),
+ write_error_specs(SortedSpecs, Globals, 0, _NumWarnings, 0, _NumErrors,
+ !IO),
module_imports_get_error(!.Module, Error)
).
@@ -3891,8 +3894,9 @@
string.append(FileName, ".m", SourceFileName),
split_into_submodules(ModuleName, Items, SubModuleList, [], Specs),
sort_error_specs(Specs, SortedSpecs),
- write_error_specs(SortedSpecs, 0, _NumWarnings, 0, _NumErrors, !IO),
globals.io_get_globals(Globals, !IO),
+ write_error_specs(SortedSpecs, Globals, 0, _NumWarnings, 0, _NumErrors,
+ !IO),
assoc_list.keys(SubModuleList, SubModuleNames),
list.map(init_dependencies(SourceFileName, ModuleName, SubModuleNames,
Error, Globals), SubModuleList, ModuleImportsList),
@@ -6045,6 +6049,7 @@
read_mod_ignore_errors(ModuleName, ".m",
"Getting dependencies for module", Search, no, Items0, Error,
FileName0, _, !IO),
+ globals.io_get_globals(Globals, !IO),
(
Items0 = [],
Error = fatal_module_errors
@@ -6058,9 +6063,9 @@
Items = Items0,
split_into_submodules(ModuleName, Items, SubModuleList, [], Specs),
sort_error_specs(Specs, SortedSpecs),
- write_error_specs(SortedSpecs, 0, _NumWarnings, 0, _NumErrors, !IO)
+ write_error_specs(SortedSpecs, Globals, 0, _NumWarnings, 0, _NumErrors,
+ !IO)
),
- globals.io_get_globals(Globals, !IO),
assoc_list.keys(SubModuleList, SubModuleNames),
list.map(init_dependencies(FileName, ModuleName, SubModuleNames,
Error, Globals), SubModuleList, ModuleImportsList).
@@ -6960,7 +6965,7 @@
(
InInterface1 = yes,
Item = item_instance(_, _, _, Body, _, _) - InstanceContext,
- Body \= abstract
+ Body \= instance_body_abstract
->
report_non_abstract_instance_in_interface(InstanceContext, !Specs)
;
@@ -7263,7 +7268,7 @@
item_needs_imports(item_pred_or_func_mode(_, _, _, _, _, _, _)) = yes.
item_needs_imports(Item @ item_typeclass(_, _, _, _, _, _)) =
(
- Item ^ tc_class_methods = abstract,
+ Item ^ tc_class_methods = class_interface_abstract,
\+ (
list.member(Constraint, Item ^ tc_constraints),
Constraint = constraint(_, ConstraintArgs),
@@ -7363,7 +7368,7 @@
make_abstract_defn(item_instance(_, _, _, _, _, _) @ Item0, int2, Item) :-
make_abstract_instance(Item0, Item).
make_abstract_defn(item_typeclass(_, _, _, _, _, _) @ Item, _,
- Item ^ tc_class_methods := abstract).
+ Item ^ tc_class_methods := class_interface_abstract).
:- pred make_abstract_unify_compare(item::in, short_interface_kind::in,
item::out) is semidet.
@@ -7397,8 +7402,8 @@
make_abstract_instance(Item0, Item) :-
Item0 = item_instance(_Constraints, _Class, _ClassTypes, Body0,
_TVarSet, _ModName),
- Body0 = concrete(_),
- Body = abstract,
+ Body0 = instance_body_concrete(_),
+ Body = instance_body_abstract,
Item = Item0 ^ ci_method_instances := Body.
:- pred maybe_strip_import_decls(item_list::in, item_list::out) is det.
Index: compiler/passes_aux.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/passes_aux.m,v
retrieving revision 1.83
diff -u -b -r1.83 passes_aux.m
--- compiler/passes_aux.m 22 Aug 2006 05:04:01 -0000 1.83
+++ compiler/passes_aux.m 12 Oct 2006 10:24:21 -0000
@@ -20,6 +20,7 @@
:- 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.
@@ -51,10 +52,6 @@
; update_module_cookie(pred(pred_id, proc_id, proc_info, proc_info,
univ, univ, module_info, module_info), univ).
-:- type pred_error_task ==
- pred(pred_id, module_info, module_info, pred_info, pred_info,
- int, int, io, io).
-
% Note that update_module_cookie causes some difficulties.
% Ideally, it should be implemented using existential types:
%
@@ -85,7 +82,7 @@
; update_proc_io(pred(in, in, in, in, out, di, uo) is det)
; update_proc_error(pred(in, in, in, out, in, out, out, out, di, uo)
is det)
- ; update_pred_error(pred(in, in, out, in, out, out, out, di, uo)
+ ; update_pred_error(pred(in, in, out, in, out, in, out, di, uo)
is det)
; update_module(pred(in, in, in, in, out, in, out) is det)
; update_module_io(pred(in, in, in, out, in, out, di, uo) is det)
@@ -93,25 +90,43 @@
is det, ground)
)).
-:- inst pred_error_task ==
- (pred(in, in, out, in, out, out, out, di, uo) is det).
-
:- mode task == task >> task.
+:- type pred_error_task ==
+ pred(pred_id, module_info, module_info, pred_info, pred_info,
+ list(error_spec), list(error_spec), io, io).
+
+:- inst pred_error_task ==
+ (pred(in, in, out, in, out, in, out, di, uo) is det).
+
+:- pred process_all_nonimported_procs_errors(task::task,
+ module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
:- pred process_all_nonimported_procs(task::task,
module_info::in, module_info::out, io::di, io::uo) is det.
+:- pred process_all_nonimported_procs_update_errors(
+ task::task, task::out(task), module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
+:- pred process_all_nonimported_procs_update(task::task, task::out(task),
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
% Process procedures for which a given test succeeds.
%
-:- pred process_matching_nonimported_procs(task::task,
+:- pred process_matching_nonimported_procs_errors(task::task,
pred(pred_info)::in(pred(in) is semidet),
- module_info::in, module_info::out, io::di, io::uo) is det.
-
-:- pred process_matching_nonimported_procs(task::task, task::out(task),
+ module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
+:- pred process_matching_nonimported_procs(task::task,
pred(pred_info)::in(pred(in) is semidet),
module_info::in, module_info::out, io::di, io::uo) is det.
-:- pred process_all_nonimported_procs(task::task, task::out(task),
+:- pred process_matching_nonimported_procs_update_errors(
+ task::task, task::out(task), pred(pred_info)::in(pred(in) is semidet),
+ module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
+:- pred process_matching_nonimported_procs_update(
+ task::task, task::out(task), pred(pred_info)::in(pred(in) is semidet),
module_info::in, module_info::out, io::di, io::uo) is det.
:- pred write_pred_progress_message(string::in, pred_id::in, module_info::in,
@@ -218,34 +233,63 @@
%-----------------------------------------------------------------------------%
-process_all_nonimported_procs(Task, !ModuleInfo, !IO) :-
+process_all_nonimported_procs_errors(Task, !ModuleInfo, !Specs, !IO) :-
True = (pred(_PredInfo::in) is semidet :- true),
- process_matching_nonimported_procs(Task, True, !ModuleInfo, !IO).
+ process_matching_nonimported_procs_errors(Task, True, !ModuleInfo,
+ !Specs, !IO).
-process_all_nonimported_procs(!Task, !ModuleInfo, !IO) :-
+process_all_nonimported_procs(Task, !ModuleInfo, !IO) :-
+ process_all_nonimported_procs_errors(Task, !ModuleInfo, [], Specs, !IO),
+ expect(unify(Specs, []), this_file,
+ "process_all_nonimported_procs: Specs").
+
+process_all_nonimported_procs_update_errors(!Task, !ModuleInfo, !Specs, !IO) :-
True = (pred(_PredInfo::in) is semidet :- true),
- process_matching_nonimported_procs(!Task, True, !ModuleInfo, !IO).
+ process_matching_nonimported_procs_update_errors(!Task, True, !ModuleInfo,
+ !Specs, !IO).
-process_matching_nonimported_procs(Task, Filter, !ModuleInfo, !IO) :-
+process_all_nonimported_procs_update(!Task, !ModuleInfo, !IO) :-
+ process_all_nonimported_procs_update_errors(!Task, !ModuleInfo,
+ [], Specs, !IO),
+ expect(unify(Specs, []), this_file,
+ "process_all_nonimported_procs_update: Specs").
+
+process_matching_nonimported_procs_errors(Task, Filter, !ModuleInfo,
+ !Specs, !IO) :-
module_info_predids(!.ModuleInfo, PredIds),
( Task = update_pred_error(Pred) ->
- list.foldl2(process_nonimported_pred(Pred, Filter), PredIds,
- !ModuleInfo, !IO)
+ list.foldl3(process_nonimported_pred(Pred, Filter), PredIds,
+ !ModuleInfo, !Specs, !IO)
;
process_nonimported_procs_in_preds(PredIds, Task, _, Filter,
!ModuleInfo, !IO)
).
-process_matching_nonimported_procs(Task0, Task, Filter, !ModuleInfo, !IO) :-
+process_matching_nonimported_procs(Task, Filter, !ModuleInfo, !IO) :-
+ process_matching_nonimported_procs_errors(Task, Filter, !ModuleInfo,
+ [], Specs, !IO),
+ expect(unify(Specs, []), this_file,
+ "process_matching_nonimported_procs: Specs").
+
+process_matching_nonimported_procs_update_errors(Task0, Task, Filter,
+ !ModuleInfo, !Specs, !IO) :-
module_info_predids(!.ModuleInfo, PredIds),
process_nonimported_procs_in_preds(PredIds, Task0, Task, Filter,
!ModuleInfo, !IO).
+process_matching_nonimported_procs_update(Task0, Task, Filter,
+ !ModuleInfo, !IO) :-
+ process_matching_nonimported_procs_update_errors(Task0, Task, Filter,
+ !ModuleInfo, [], Specs, !IO),
+ expect(unify(Specs, []), this_file,
+ "process_matching_nonimported_procs_update_errors: Specs").
+
:- pred process_nonimported_pred(pred_error_task::in(pred_error_task),
pred(pred_info)::in(pred(in) is semidet), 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, io::di, io::uo) is det.
-process_nonimported_pred(Task, Filter, PredId, !ModuleInfo, !IO) :-
+process_nonimported_pred(Task, Filter, PredId, !ModuleInfo, !Specs, !IO) :-
module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
(
( pred_info_is_imported(PredInfo0)
@@ -254,9 +298,8 @@
->
true
;
- Task(PredId, !ModuleInfo, PredInfo0, PredInfo, WarnCnt, ErrCnt, !IO),
- module_info_set_pred_info(PredId, PredInfo, !ModuleInfo),
- passes_aux.handle_errors(WarnCnt, ErrCnt, !ModuleInfo, !IO)
+ Task(PredId, !ModuleInfo, PredInfo0, PredInfo, !Specs, !IO),
+ module_info_set_pred_info(PredId, PredInfo, !ModuleInfo)
).
:- pred process_nonimported_procs_in_preds(list(pred_id)::in,
Index: compiler/pd_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pd_util.m,v
retrieving revision 1.55
diff -u -b -r1.55 pd_util.m
--- compiler/pd_util.m 20 Aug 2006 08:21:23 -0000 1.55
+++ compiler/pd_util.m 12 Oct 2006 05:50:48 -0000
@@ -172,6 +172,7 @@
:- import_module libs.compiler_util.
:- import_module libs.globals.
:- import_module libs.options.
+:- import_module parse_tree.error_util.
:- import_module parse_tree.prog_type.
:- import_module transform_hlds.constraint.
:- import_module transform_hlds.pd_cost.
@@ -246,10 +247,9 @@
pd_simplify_goal(Simplifications, Goal0, Goal, !PDInfo, !IO) :-
% Construct a simplify_info.
pd_info_get_module_info(!.PDInfo, ModuleInfo0),
- module_info_get_globals(ModuleInfo0, Globals),
pd_info_get_pred_proc_id(!.PDInfo, proc(PredId, ProcId)),
proc_info_get_vartypes(ProcInfo0, VarTypes0),
- det_info_init(ModuleInfo0, VarTypes0, PredId, ProcId, Globals, DetInfo0),
+ det_info_init(ModuleInfo0, VarTypes0, PredId, ProcId, DetInfo0),
pd_info_get_instmap(!.PDInfo, InstMap0),
pd_info_get_proc_info(!.PDInfo, ProcInfo0),
simplify_info_init(DetInfo0, Simplifications, InstMap0, ProcInfo0,
@@ -375,18 +375,17 @@
ModuleInfo0, ModuleInfo),
pd_info_set_module_info(ModuleInfo, !PDInfo),
- module_info_get_globals(ModuleInfo, Globals),
proc_info_get_vartypes(ProcInfo, VarTypes),
- det_info_init(ModuleInfo, VarTypes, PredId, ProcId, Globals, DetInfo),
+ det_info_init(ModuleInfo, VarTypes, PredId, ProcId, DetInfo),
pd_info_get_instmap(!.PDInfo, InstMap),
det_infer_goal(Goal0, Goal, InstMap, SolnContext, [], no, DetInfo, _, _,
- Msgs),
+ [], Specs),
% Make sure there were no errors.
- disable_det_warnings(OptionsToRestore, !IO),
- det_report_msgs(Msgs, ModuleInfo, _, ErrCnt, !IO),
- restore_det_warnings(OptionsToRestore, !IO),
- expect(unify(ErrCnt, 0), this_file,
+ globals.io_get_globals(Globals, !IO),
+ disable_det_warnings(_OptionsToRestore, Globals, GlobalsToUse),
+ write_error_specs(Specs, GlobalsToUse, 0, _NumWarnings, 0, NumErrors, !IO),
+ expect(unify(NumErrors, 0), this_file,
"rerun_det_analysis: determinism errors").
%-----------------------------------------------------------------------------%
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.176
diff -u -b -r1.176 prog_data.m
--- compiler/prog_data.m 25 Sep 2006 18:31:32 -0000 1.176
+++ compiler/prog_data.m 12 Oct 2006 07:54:20 -0000
@@ -644,33 +644,35 @@
---> class_id(class_name, arity).
:- type class_interface
- ---> abstract
- ; concrete(class_methods).
+ ---> class_interface_abstract
+ ; class_interface_concrete(class_methods).
:- type instance_method
---> instance_method(
- pred_or_func,
- sym_name, % method name
- instance_proc_def,
- arity,
- prog_context % context of the instance declaration
+ instance_method_p_or_f :: pred_or_func,
+ instance_method_name :: sym_name,
+ instance_method_proc_def :: instance_proc_def,
+ instance_method_arity :: arity,
+
+ % The context of the instance declaration.
+ instance_method_decl_context :: prog_context
).
:- type instance_proc_def
- ---> name(
+ ---> instance_proc_def_name(
% defined using the `pred(...) is <Name>' syntax
sym_name
)
- ; clauses(
+ ; instance_proc_def_clauses(
% defined using clauses
list(item) % the items must be either
% pred_clause or func_clause items
).
:- type instance_body
- ---> abstract
- ; concrete(instance_methods).
+ ---> instance_body_abstract
+ ; instance_body_concrete(instance_methods).
:- type instance_methods == list(instance_method).
Index: compiler/prog_io_typeclass.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_typeclass.m,v
retrieving revision 1.54
diff -u -b -r1.54 prog_io_typeclass.m
--- compiler/prog_io_typeclass.m 30 Aug 2006 04:46:01 -0000 1.54
+++ compiler/prog_io_typeclass.m 12 Oct 2006 08:12:12 -0000
@@ -100,7 +100,7 @@
MaybeParsedNameAndVars = ok1(ParsedNameAndVars),
( ParsedNameAndVars = item_typeclass(_, _, _, _, _, _) ->
Result = ok1((ParsedNameAndVars
- ^ tc_class_methods := concrete(MethodList))
+ ^ tc_class_methods := class_interface_concrete(MethodList))
^ tc_varset := TVarSet)
;
% If the item we get back isn't a typeclass,
@@ -236,8 +236,8 @@
list.sort_and_remove_dups(TermVars, SortedTermVars),
list.length(SortedTermVars) = list.length(TermVars) : int
->
- Result = ok1(item_typeclass([], [], ClassName, Vars, abstract,
- TVarSet))
+ Result = ok1(item_typeclass([], [], ClassName, Vars,
+ class_interface_abstract, TVarSet))
;
Msg = "expected distinct variables as class parameters",
Result = error1([Msg - Name])
@@ -614,8 +614,8 @@
"with distinct variables as arguments",
Result = error1([Msg - ErrorTerm])
;
- Result = ok1(item_instance([], ClassName, Types, abstract, TVarSet,
- ModuleName))
+ Result = ok1(item_instance([], ClassName, Types,
+ instance_body_abstract, TVarSet, ModuleName))
).
:- pred type_is_functor_and_vars(mer_type::in) is semidet.
@@ -668,7 +668,7 @@
Types, _, _, ModName)
->
Result0 = ok1(item_instance(Constraints, NameString, Types,
- concrete(MethodList), TVarSet, ModName)),
+ instance_body_concrete(MethodList), TVarSet, ModName)),
check_tvars_in_instance_constraint(Result0, Name, Result)
;
% If the item we get back isn't a typeclass,
@@ -744,7 +744,8 @@
"instance method", ok2(InstanceMethodName, []))
->
Result = ok1(instance_method(predicate, ClassMethodName,
- name(InstanceMethodName), ArityInt, TermContext))
+ instance_proc_def_name(InstanceMethodName), ArityInt,
+ TermContext))
;
Msg = "expected `pred(<Name> / <Arity>) is <InstanceMethod>'",
Result = error1([Msg - MethodTerm])
@@ -761,7 +762,8 @@
"instance method", ok2(InstanceMethodName, []))
->
Result = ok1(instance_method(function, ClassMethodName,
- name(InstanceMethodName), ArityInt, TermContext))
+ instance_proc_def_name(InstanceMethodName), ArityInt,
+ TermContext))
;
Msg = "expected `func(<Name> / <Arity>) is <InstanceMethod>'",
Result = error1([Msg - MethodTerm])
@@ -792,7 +794,7 @@
->
adjust_func_arity(PredOrFunc, ArityInt, list.length(HeadArgs)),
Result = ok1(instance_method(PredOrFunc, ClassMethodName,
- clauses([Item]), ArityInt, Context))
+ instance_proc_def_clauses([Item]), ArityInt, Context))
;
Msg = "expected clause or " ++
"`pred(<Name> / <Arity>) is <InstanceName>' or " ++
Index: compiler/recompilation.check.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/recompilation.check.m,v
retrieving revision 1.34
diff -u -b -r1.34 recompilation.check.m
--- compiler/recompilation.check.m 7 Sep 2006 05:51:05 -0000 1.34
+++ compiler/recompilation.check.m 12 Oct 2006 08:12:38 -0000
@@ -872,7 +872,7 @@
NeedsCheck, !Info),
(
NeedsCheck = yes,
- Interface = concrete(Methods)
+ Interface = class_interface_concrete(Methods)
->
list.foldl(check_class_method_for_ambiguities(NeedQualifier,
OldTimestamp, VersionNumbers), Methods, !Info)
Index: compiler/recompilation.usage.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/recompilation.usage.m,v
retrieving revision 1.38
diff -u -b -r1.38 recompilation.usage.m
--- compiler/recompilation.usage.m 7 Sep 2006 05:51:05 -0000 1.38
+++ compiler/recompilation.usage.m 12 Oct 2006 08:12:51 -0000
@@ -948,9 +948,9 @@
ClassInterface = ClassDefn ^ class_interface,
find_items_used_by_class_constraints(Constraints, !Info),
(
- ClassInterface = abstract
+ ClassInterface = class_interface_abstract
;
- ClassInterface = concrete(Methods),
+ ClassInterface = class_interface_concrete(Methods),
list.foldl(find_items_used_by_class_method, Methods, !Info)
),
module_info_get_instance_table(ModuleInfo, Instances),
Index: compiler/recompilation.version.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/recompilation.version.m,v
retrieving revision 1.54
diff -u -b -r1.54 recompilation.version.m
--- compiler/recompilation.version.m 7 Sep 2006 05:51:06 -0000 1.54
+++ compiler/recompilation.version.m 12 Oct 2006 08:14:07 -0000
@@ -221,7 +221,7 @@
% Does this pragma match any of the methods of this class.
list.member(_ - ClassItem, !.ClassItems),
ClassItem = item_typeclass(_, _, _, _, Interface, _) - _,
- Interface = concrete(Methods),
+ Interface = class_interface_concrete(Methods),
list.member(Method, Methods),
Method = method_pred_or_func(_, _, _, MethodPredOrFunc, SymName,
TypesAndModes, WithType, _, _, _, _, _, _),
@@ -428,11 +428,12 @@
Section - (PredOrFuncModeItem - ItemContext)
| MatchingItems0]
;
- Item ^ tc_class_methods = concrete(Methods0)
+ Item ^ tc_class_methods = class_interface_concrete(Methods0)
->
MethodsList = list.map(split_class_method_types_and_modes, Methods0),
list.condense(MethodsList, Methods),
- TypeclassItem = Item ^ tc_class_methods := concrete(Methods),
+ TypeclassItem = Item ^ tc_class_methods
+ := class_interface_concrete(Methods),
MatchingItems = [Section - (TypeclassItem - ItemContext)
| MatchingItems0]
;
@@ -946,9 +947,15 @@
:- pred class_interface_is_unchanged(class_interface::in,
class_interface::in) is semidet.
-class_interface_is_unchanged(abstract, abstract).
-class_interface_is_unchanged(concrete(Methods1), concrete(Methods2)) :-
- class_methods_are_unchanged(Methods1, Methods2).
+class_interface_is_unchanged(Interface0, Interface) :-
+ (
+ Interface0 = class_interface_abstract,
+ Interface = class_interface_abstract
+ ;
+ Interface0 = class_interface_concrete(Methods1),
+ class_methods_are_unchanged(Methods1, Methods2),
+ Interface = class_interface_concrete(Methods2)
+ ).
:- pred class_methods_are_unchanged(class_methods::in,
class_methods::in) is semidet.
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.192
diff -u -b -r1.192 simplify.m
--- compiler/simplify.m 5 Oct 2006 04:45:34 -0000 1.192
+++ compiler/simplify.m 12 Oct 2006 10:28:48 -0000
@@ -32,7 +32,6 @@
:- interface.
:- import_module check_hlds.common.
-:- import_module check_hlds.det_report.
:- import_module check_hlds.det_util.
:- import_module hlds.
:- import_module hlds.hlds_goal.
@@ -42,6 +41,7 @@
:- import_module hlds.instmap.
:- import_module libs.
:- import_module libs.globals.
+:- import_module parse_tree.error_util.
:- import_module bool.
:- import_module io.
@@ -51,7 +51,7 @@
:- pred simplify_pred(simplifications::in, pred_id::in,
module_info::in, module_info::out, pred_info::in, pred_info::out,
- int::out, int::out, io::di, io::uo) is det.
+ list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
:- pred simplify_proc(simplifications::in, pred_id::in, proc_id::in,
module_info::in, module_info::out, proc_info::in, proc_info::out,
@@ -59,7 +59,7 @@
:- pred simplify_proc_return_msgs(simplifications::in, pred_id::in,
proc_id::in, module_info::in, module_info::out,
- proc_info::in, proc_info::out, set(context_det_msg)::out, bool::out,
+ proc_info::in, proc_info::out, list(error_spec)::out, bool::out,
io::di, io::uo) is det.
:- pred simplify_process_goal(hlds_goal::in, hlds_goal::out,
@@ -128,6 +128,7 @@
:- import_module check_hlds.unify_proc.
:- import_module hlds.goal_form.
:- import_module hlds.goal_util.
+:- import_module hlds.hlds_error_util.
:- import_module hlds.hlds_module.
:- import_module hlds.passes_aux.
:- import_module hlds.pred_table.
@@ -290,8 +291,7 @@
%-----------------------------------------------------------------------------%
-simplify_pred(Simplifications0, PredId, !ModuleInfo, !PredInfo,
- WarnCnt, ErrCnt, !IO) :-
+simplify_pred(Simplifications0, PredId, !ModuleInfo, !PredInfo, !Specs, !IO) :-
write_pred_progress_message("% Simplifying ", PredId, !.ModuleInfo, !IO),
ProcIds = pred_info_non_imported_procids(!.PredInfo),
% Don't warn for compiler-generated procedures.
@@ -300,52 +300,49 @@
;
Simplifications = Simplifications0
),
- MaybeMsgs0 = no,
+ MaybeSpecs0 = no,
simplify_procs(Simplifications, PredId, ProcIds, !ModuleInfo, !PredInfo,
- MaybeMsgs0, MaybeMsgs, !IO),
+ MaybeSpecs0, MaybeSpecs, !IO),
+ module_info_get_globals(!.ModuleInfo, Globals),
(
- MaybeMsgs = yes(Msgs0 - Msgs1),
- set.union(Msgs0, Msgs1, Msgs2),
- set.to_sorted_list(Msgs2, Msgs),
- det_report_msgs(Msgs, !.ModuleInfo, WarnCnt, ErrCnt, !IO)
- ;
- MaybeMsgs = no,
- WarnCnt = 0,
- ErrCnt = 0
+ MaybeSpecs = yes(AnyModeSpecSet - AllModeSpecSet),
+ set.union(AnyModeSpecSet, AllModeSpecSet, SpecSet),
+ set.to_sorted_list(SpecSet, NewSpecs),
+ !:Specs = NewSpecs ++ !.Specs
+ ;
+ MaybeSpecs = no
),
- globals.io_lookup_bool_option(detailed_statistics, Statistics, !IO),
+ globals.lookup_bool_option(Globals, detailed_statistics, Statistics),
maybe_report_stats(Statistics, !IO).
:- pred simplify_procs(simplifications::in, pred_id::in,
list(proc_id)::in, module_info::in, module_info::out,
pred_info::in, pred_info::out,
- maybe(pair(set(context_det_msg)))::in,
- maybe(pair(set(context_det_msg)))::out,
+ maybe(pair(set(error_spec)))::in, maybe(pair(set(error_spec)))::out,
io::di, io::uo) is det.
-simplify_procs(_, _, [], !ModuleInfo, !PredInfo, !Msgs, !IO).
+simplify_procs(_, _, [], !ModuleInfo, !PredInfo, !MaybeSpecs, !IO).
simplify_procs(Simplifications, PredId, [ProcId | ProcIds], !ModuleInfo,
- !PredInfo, !MaybeMsgs, !IO) :-
+ !PredInfo, !MaybeSpecs, !IO) :-
pred_info_get_procedures(!.PredInfo, Procs0),
map.lookup(Procs0, ProcId, Proc0),
simplify_proc_return_msgs(Simplifications, PredId, ProcId,
- !ModuleInfo, Proc0, Proc, ProcMsgSet, MayHaveParallelConj, !IO),
+ !ModuleInfo, Proc0, Proc, ProcSpecs, MayHaveParallelConj, !IO),
map.det_update(Procs0, ProcId, Proc, Procs),
pred_info_set_procedures(Procs, !PredInfo),
- set.to_sorted_list(ProcMsgSet, ProcMsgs),
- list.filter((pred(context_det_msg(_, Msg)::in) is semidet :-
- det_msg_is_any_mode_msg(Msg, any_mode)
- ), ProcMsgs, ProcAnyModeMsgs, ProcAllModeMsgs),
- set.sorted_list_to_set(ProcAnyModeMsgs, ProcAnyModeMsgSet),
- set.sorted_list_to_set(ProcAllModeMsgs, ProcAllModeMsgSet),
- (
- !.MaybeMsgs = yes(AnyModeMsgSet0 - AllModeMsgSet0),
- set.union(AnyModeMsgSet0, ProcAnyModeMsgSet, AnyModeMsgSet),
- set.intersect(AllModeMsgSet0, ProcAllModeMsgSet, AllModeMsgSet),
- !:MaybeMsgs = yes(AllModeMsgSet - AnyModeMsgSet)
+ list.filter((pred(error_spec(_, Phase, _)::in) is semidet :-
+ Phase = phase_simplify(report_only_if_in_all_modes)
+ ), ProcSpecs, ProcAllModeSpecs, ProcAnyModeSpecs),
+ set.sorted_list_to_set(ProcAnyModeSpecs, ProcAnyModeSpecSet),
+ set.sorted_list_to_set(ProcAllModeSpecs, ProcAllModeSpecSet),
+ (
+ !.MaybeSpecs = yes(AnyModeSpecSet0 - AllModeSpecSet0),
+ set.union(AnyModeSpecSet0, ProcAnyModeSpecSet, AnyModeSpecSet),
+ set.intersect(AllModeSpecSet0, ProcAllModeSpecSet, AllModeSpecSet),
+ !:MaybeSpecs = yes(AllModeSpecSet - AnyModeSpecSet)
;
- !.MaybeMsgs = no,
- !:MaybeMsgs = yes(ProcAnyModeMsgSet - ProcAllModeMsgSet)
+ !.MaybeSpecs = no,
+ !:MaybeSpecs = yes(ProcAnyModeSpecSet - ProcAllModeSpecSet)
),
% This is ugly, but we want to avoid running the dependent parallel
% conjunction pass on predicates not containing parallel conjunctions
@@ -360,7 +357,7 @@
MayHaveParallelConj = no
),
simplify_procs(Simplifications, PredId, ProcIds, !ModuleInfo, !PredInfo,
- !MaybeMsgs, !IO).
+ !MaybeSpecs, !IO).
simplify_proc(Simplifications, PredId, ProcId, !ModuleInfo, !Proc, !IO) :-
write_pred_progress_message("% Simplifying ", PredId, !.ModuleInfo, !IO),
@@ -372,8 +369,7 @@
turn_off_common_struct_threshold = 1000.
simplify_proc_return_msgs(Simplifications0, PredId, ProcId, !ModuleInfo,
- !ProcInfo, DetMsgs, MayHaveParallelConj, !IO) :-
- module_info_get_globals(!.ModuleInfo, Globals),
+ !ProcInfo, ErrorSpecs, MayHaveParallelConj, !IO) :-
proc_info_get_vartypes(!.ProcInfo, VarTypes0),
NumVars = map.count(VarTypes0),
( NumVars > turn_off_common_struct_threshold ->
@@ -385,7 +381,7 @@
;
Simplifications = Simplifications0
),
- det_info_init(!.ModuleInfo, VarTypes0, PredId, ProcId, Globals, DetInfo0),
+ det_info_init(!.ModuleInfo, VarTypes0, PredId, ProcId, DetInfo0),
proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo, InstMap0),
simplify_info_init(DetInfo0, Simplifications, InstMap0, !.ProcInfo, Info0),
proc_info_get_goal(!.ProcInfo, Goal0),
@@ -416,7 +412,7 @@
proc_info_set_goal(Goal, !ProcInfo),
proc_info_set_rtti_varmaps(RttiVarMaps, !ProcInfo),
simplify_info_get_module_info(Info, !:ModuleInfo),
- simplify_info_get_det_msgs(Info, DetMsgs0),
+ simplify_info_get_error_specs(Info, ErrorSpecs0),
(
Info ^ format_calls = yes,
(
@@ -430,11 +426,11 @@
% build the format strings or values, which means that the new version
% in Goal may not contain the information find_format_call_errors needs
% to avoid spurious messages about unknown format strings or values.
- find_format_call_errors(!.ModuleInfo, Goal0, DetMsgs0, DetMsgs1)
+ find_format_call_errors(!.ModuleInfo, Goal0, ErrorSpecs0, ErrorSpecs1)
;
% Either there are no calls to check or we would ignore the added
% messages anyway.
- DetMsgs1 = DetMsgs0
+ ErrorSpecs1 = ErrorSpecs0
),
pred_info_get_import_status(PredInfo, Status),
IsDefinedHere = status_defined_in_this_module(Status),
@@ -443,10 +439,10 @@
% Don't generate any warnings or even errors if the predicate isn't
% defined here; any such messages will be generated when we compile
% the module the predicate comes from.
- set.init(DetMsgs)
+ ErrorSpecs = []
;
IsDefinedHere = yes,
- DetMsgs = DetMsgs1
+ ErrorSpecs = ErrorSpecs1
),
MayHaveParallelConj = Info ^ may_have_parallel_conj.
@@ -536,7 +532,7 @@
simplify_info_get_det_info(!.Info, DetInfo),
det_infer_goal(Goal3, Goal, InstMap0, SolnContext, [], no, DetInfo,
- _, _, _)
+ _, _, [], _)
;
Goal = Goal3
).
@@ -586,9 +582,20 @@
)
)
->
- Msg = goal_cannot_succeed,
- ContextMsg = context_det_msg(Context, Msg),
- simplify_info_add_det_msg(ContextMsg, !Info)
+ MainPieces = [words("Warning: this goal cannot succeed.")],
+ VerbosePieces =
+ [words("The compiler will optimize away this goal,"),
+ words("replacing it with `fail'."),
+ words("To disable this optimization, use"),
+ words("the `--fully-strict' option.")],
+ Msg = simple_msg(Context,
+ [option_is_set(warn_simple_code, yes,
+ [always(MainPieces), verbose_only(VerbosePieces)])]),
+ Severity = severity_conditional(warn_simple_code, yes,
+ severity_warning, no),
+ Spec = error_spec(Severity,
+ phase_simplify(report_only_if_in_all_modes), [Msg]),
+ simplify_info_add_error_spec(Spec, !Info)
;
true
),
@@ -653,7 +660,7 @@
% ->
% Msg = det_goal_has_no_outputs,
% ContextMsg = context_det_msg(Context, Msg),
-% simplify_info_add_det_msg(ContextMsg, !Info)
+% simplify_info_add_error_spec(ContextMsg, !Info)
% ;
% true
% ),
@@ -1131,9 +1138,15 @@
;
InsideDuplForSwitch = no,
goal_info_get_context(GoalInfo0, Context),
- Msg = ite_cond_cannot_fail,
- ContextMsg = context_det_msg(Context, Msg),
- simplify_info_add_det_msg(ContextMsg, !Info)
+ Pieces = [words("Warning: the condition of this if-then-else"),
+ words("cannot fail.")],
+ Msg = simple_msg(Context,
+ [option_is_set(warn_simple_code, yes, [always(Pieces)])]),
+ Severity = severity_conditional(warn_simple_code, yes,
+ severity_warning, no),
+ Spec = error_spec(Severity,
+ phase_simplify(report_only_if_in_all_modes), [Msg]),
+ simplify_info_add_error_spec(Spec, !Info)
),
simplify_info_set_requantify(!Info),
simplify_info_set_rerun_det(!Info)
@@ -1142,11 +1155,10 @@
det_negation_det(CondDetism0, MaybeNegDetism),
(
Cond0 = negation(NegCond) - _,
- % XXX BUG! This optimization is only safe if it
- % preserves mode correctness, which means in particular
- % that the the negated goal must not clobber any
- % variables.
- % For now I've just disabled the optimization.
+ % XXX BUG! This optimization is only safe if it preserves mode
+ % correctness, which means in particular that the negated goal
+ % must not clobber any variables. For now I've just disabled
+ % the optimization.
semidet_fail
->
Cond = NegCond
@@ -1186,9 +1198,15 @@
;
InsideDuplForSwitch = no,
goal_info_get_context(GoalInfo0, Context),
- Msg = ite_cond_cannot_succeed,
- ContextMsg = context_det_msg(Context, Msg),
- simplify_info_add_det_msg(ContextMsg, !Info)
+ Pieces = [words("Warning: the condition of this if-then-else"),
+ words("cannot succeed.")],
+ Msg = simple_msg(Context,
+ [option_is_set(warn_simple_code, yes, [always(Pieces)])]),
+ Severity = severity_conditional(warn_simple_code, yes,
+ severity_warning, no),
+ Spec = error_spec(Severity,
+ phase_simplify(report_only_if_in_all_modes), [Msg]),
+ simplify_info_add_error_spec(Spec, !Info)
),
simplify_info_set_requantify(!Info),
simplify_info_set_rerun_det(!Info)
@@ -1286,13 +1304,23 @@
determinism_components(Detism, CanFail, MaxSoln),
goal_info_get_context(GoalInfo0, Context),
( CanFail = cannot_fail ->
- Msg = negated_goal_cannot_fail,
- ContextMsg = context_det_msg(Context, Msg),
- simplify_info_add_det_msg(ContextMsg, !Info)
+ Pieces = [words("Warning: the negated goal cannot fail.")],
+ Msg = simple_msg(Context,
+ [option_is_set(warn_simple_code, yes, [always(Pieces)])]),
+ Severity = severity_conditional(warn_simple_code, yes,
+ severity_warning, no),
+ Spec = error_spec(Severity,
+ phase_simplify(report_only_if_in_all_modes), [Msg]),
+ simplify_info_add_error_spec(Spec, !Info)
; MaxSoln = at_most_zero ->
- Msg = negated_goal_cannot_succeed,
- ContextMsg = context_det_msg(Context, Msg),
- simplify_info_add_det_msg(ContextMsg, !Info)
+ Pieces = [words("Warning: the negated goal cannot succeed.")],
+ Msg = simple_msg(Context,
+ [option_is_set(warn_simple_code, yes, [always(Pieces)])]),
+ Severity = severity_conditional(warn_simple_code, yes,
+ severity_warning, no),
+ Spec = error_spec(Severity,
+ phase_simplify(report_only_if_in_all_modes), [Msg]),
+ simplify_info_add_error_spec(Spec, !Info)
;
true
),
@@ -1622,6 +1650,7 @@
!Info) :-
simplify_info_get_module_info(!.Info, ModuleInfo),
module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo),
+ goal_info_get_context(GoalInfo0, GoalContext),
% Check for calls to predicates with `pragma obsolete' declarations.
(
simplify_do_warn_obsolete(!.Info),
@@ -1643,10 +1672,19 @@
pred_info_get_markers(ThisPredInfo, ThisPredMarkers),
not check_marker(ThisPredMarkers, marker_obsolete)
->
- goal_info_get_context(GoalInfo0, Context1),
- ObsoleteMsg = warn_call_to_obsolete(PredId),
- ObsoleteContextMsg = context_det_msg(Context1, ObsoleteMsg),
- simplify_info_add_det_msg(ObsoleteContextMsg, !Info)
+ % XXX warn_obsolete isn't really a simple code warning.
+ % We should add a separate warning type for this.
+ ObsoletePredPieces = describe_one_pred_name(ModuleInfo,
+ should_module_qualify, PredId),
+ ObsoletePieces = [words("Warning: call to obsolete")] ++
+ ObsoletePredPieces ++ [suffix("."), nl],
+ ObsoleteMsg = simple_msg(GoalContext,
+ [option_is_set(warn_simple_code, yes, [always(ObsoletePieces)])]),
+ ObsoleteSeverity = severity_conditional(warn_simple_code, yes,
+ severity_warning, no),
+ ObsoleteSpec = error_spec(ObsoleteSeverity,
+ phase_simplify(report_in_any_mode), [ObsoleteMsg]),
+ simplify_info_add_error_spec(ObsoleteSpec, !Info)
;
true
),
@@ -1714,10 +1752,26 @@
pred_info_get_purity(PredInfo1, Purity),
\+ Purity = purity_impure
->
- goal_info_get_context(GoalInfo0, Context2),
- InfiniteRecMsg = warn_infinite_recursion,
- InfiniteRecContextMsg = context_det_msg(Context2, InfiniteRecMsg),
- simplify_info_add_det_msg(InfiniteRecContextMsg, !Info)
+ % It would be better if we supplied more information than just
+ % the line number, e.g. we should print the name of the containing
+ % predicate.
+
+ InfiniteRecMainPieces = [words("Warning: recursive call will lead to"),
+ words("infinite recursion.")],
+ InfiniteRecVerbosePieces =
+ [words("If this recursive call is executed,"),
+ words("the procedure will call itself"),
+ words("with exactly the same input arguments,"),
+ words("leading to infinite recursion.")],
+ InfiniteRecMsg = simple_msg(GoalContext,
+ [option_is_set(warn_simple_code, yes,
+ [always(InfiniteRecMainPieces),
+ verbose_only(InfiniteRecVerbosePieces)])]),
+ InfiniteRecSeverity = severity_conditional(warn_simple_code, yes,
+ severity_warning, no),
+ InfiniteRecSpec = error_spec(InfiniteRecSeverity,
+ phase_simplify(report_in_any_mode), [InfiniteRecMsg]),
+ simplify_info_add_error_spec(InfiniteRecSpec, !Info)
;
true
),
@@ -2451,9 +2505,15 @@
Goal0 \= disj([]) - _
->
goal_info_get_context(GoalInfo, Context),
- Msg = zero_soln_disjunct,
- ContextMsg = context_det_msg(Context, Msg),
- simplify_info_add_det_msg(ContextMsg, !Info)
+ Pieces = [words("Warning: this disjunct"),
+ words("will never have any solutions.")],
+ Msg = simple_msg(Context,
+ [option_is_set(warn_simple_code, yes, [always(Pieces)])]),
+ Severity = severity_conditional(warn_simple_code, yes,
+ severity_warning, no),
+ Spec = error_spec(Severity,
+ phase_simplify(report_only_if_in_all_modes), [Msg]),
+ simplify_info_add_error_spec(Spec, !Info)
;
true
),
@@ -2598,7 +2658,7 @@
:- type simplify_info
---> simplify_info(
det_info :: det_info,
- msgs :: set(context_det_msg),
+ error_specs :: list(error_spec),
simplifications :: simplifications,
common_info :: common_info,
% Info about common subexpressions.
@@ -2636,8 +2696,7 @@
proc_info_get_varset(ProcInfo, VarSet),
proc_info_get_inst_varset(ProcInfo, InstVarSet),
proc_info_get_rtti_varmaps(ProcInfo, RttiVarMaps),
- set.init(Msgs),
- Info = simplify_info(DetInfo, Msgs, Simplifications,
+ Info = simplify_info(DetInfo, [], Simplifications,
common_info_init, InstMap, VarSet, InstVarSet,
no, no, no, 0, 0, RttiVarMaps, no, no, no).
@@ -2660,14 +2719,13 @@
:- interface.
:- import_module parse_tree.prog_data.
-:- import_module set.
:- pred simplify_info_init(det_info::in, simplifications::in,
instmap::in, proc_info::in, simplify_info::out) is det.
:- pred simplify_info_get_det_info(simplify_info::in, det_info::out) is det.
-:- pred simplify_info_get_det_msgs(simplify_info::in,
- set(context_det_msg)::out) is det.
+:- pred simplify_info_get_error_specs(simplify_info::in, list(error_spec)::out)
+ is det.
:- pred simplify_info_get_simplifications(simplify_info::in,
simplifications::out) is det.
:- pred simplify_info_get_common_info(simplify_info::in, common_info::out)
@@ -2696,7 +2754,7 @@
simplify_info::in, simplify_info::out) is det.
:- pred simplify_info_set_rtti_varmaps(rtti_varmaps::in,
simplify_info::in, simplify_info::out) is det.
-:- pred simplify_info_do_add_det_msg(context_det_msg::in,
+:- pred simplify_info_do_add_error_spec(error_spec::in,
simplify_info::in, simplify_info::out) is det.
:- pred simplify_info_incr_cost_delta(int::in,
@@ -2712,7 +2770,7 @@
bool::out) is det.
simplify_info_get_det_info(Info, Info ^ det_info).
-simplify_info_get_det_msgs(Info, Info ^ msgs).
+simplify_info_get_error_specs(Info, Info ^ error_specs).
simplify_info_get_simplifications(Info, Info ^ simplifications).
simplify_info_get_common_info(Info, Info ^ common_info).
simplify_info_get_instmap(Info, Info ^ instmap).
@@ -2751,7 +2809,7 @@
:- pred simplify_info_set_det_info(det_info::in,
simplify_info::in, simplify_info::out) is det.
-:- pred simplify_info_set_det_msgs(set(context_det_msg)::in,
+:- pred simplify_info_set_error_specs(list(error_spec)::in,
simplify_info::in, simplify_info::out) is det.
:- pred simplify_info_set_simplifications(simplifications::in,
simplify_info::in, simplify_info::out) is det.
@@ -2768,7 +2826,7 @@
:- pred simplify_info_set_inside_duplicated_for_switch(bool::in,
simplify_info::in, simplify_info::out) is det.
-:- pred simplify_info_add_det_msg(context_det_msg::in,
+:- pred simplify_info_add_error_spec(error_spec::in,
simplify_info::in, simplify_info::out) is det.
:- pred simplify_info_set_cost_delta(int::in,
simplify_info::in, simplify_info::out) is det.
@@ -2783,7 +2841,7 @@
simplify_info::in, simplify_info::out) is det.
simplify_info_set_det_info(Det, Info, Info ^ det_info := Det).
-simplify_info_set_det_msgs(Msgs, Info, Info ^ msgs := Msgs).
+simplify_info_set_error_specs(Specs, Info, Info ^ error_specs := Specs).
simplify_info_set_simplifications(Simp, Info, Info ^ simplifications := Simp).
simplify_info_set_instmap(InstMap, Info, Info ^ instmap := InstMap).
simplify_info_set_common_info(Common, Info, Info ^ common_info := Common).
@@ -2802,17 +2860,17 @@
simplify_info_incr_cost_delta(Incr, Info,
Info ^ cost_delta := Info ^ cost_delta + Incr).
-simplify_info_add_det_msg(Msg, !Info) :-
+simplify_info_add_error_spec(Spec, !Info) :-
( simplify_do_warn_simple_code(!.Info) ->
- simplify_info_do_add_det_msg(Msg, !Info)
+ simplify_info_do_add_error_spec(Spec, !Info)
;
true
).
-simplify_info_do_add_det_msg(Msg, !Info) :-
- simplify_info_get_det_msgs(!.Info, Msgs0),
- set.insert(Msgs0, Msg, Msgs),
- simplify_info_set_det_msgs(Msgs, !Info).
+simplify_info_do_add_error_spec(Spec, !Info) :-
+ simplify_info_get_error_specs(!.Info, Specs0),
+ Specs = [Spec | Specs0],
+ simplify_info_set_error_specs(Specs, !Info).
simplify_info_enter_lambda(Info, Info ^ lambdas := Info ^ lambdas + 1).
simplify_info_leave_lambda(Info, Info ^ lambdas := LambdaCount) :-
Index: compiler/state_var.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/state_var.m,v
retrieving revision 1.17
diff -u -b -r1.17 state_var.m
--- compiler/state_var.m 10 Sep 2006 23:39:09 -0000 1.17
+++ compiler/state_var.m 12 Oct 2006 08:06:23 -0000
@@ -964,18 +964,24 @@
%-----------------------------------------------------------------------------%
-expand_bang_state_var_args_in_instance_method_heads(abstract) = abstract.
-
-expand_bang_state_var_args_in_instance_method_heads(concrete(Methods)) =
- concrete(list.map(expand_method_bsvs, Methods)).
+expand_bang_state_var_args_in_instance_method_heads(InstanceBody) = Expanded :-
+ (
+ InstanceBody = instance_body_abstract,
+ Expanded = instance_body_abstract
+ ;
+ InstanceBody = instance_body_concrete(Methods),
+ Expanded = instance_body_concrete(
+ list.map(expand_method_bsvs, Methods))
+ ).
:- func expand_method_bsvs(instance_method) = instance_method.
expand_method_bsvs(IM) = IM :-
- IM = instance_method(_, _, name(_), _, _).
+ IM = instance_method(_, _, instance_proc_def_name(_), _, _).
expand_method_bsvs(IM0) = IM :-
- IM0 = instance_method(PredOrFunc, Method, clauses(Cs0), Arity0, Ctxt),
+ IM0 = instance_method(PredOrFunc, Method, instance_proc_def_clauses(Cs0),
+ Arity0, Ctxt),
Cs = list.map(expand_item_bsvs, Cs0),
% Note that the condition should always succeed...
%
@@ -984,7 +990,8 @@
;
Arity = Arity0
),
- IM = instance_method(PredOrFunc, Method, clauses(Cs), Arity, Ctxt).
+ IM = instance_method(PredOrFunc, Method, instance_proc_def_clauses(Cs),
+ Arity, Ctxt).
% The instance method clause items will all be clause items.
%
Index: compiler/stratify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/stratify.m,v
retrieving revision 1.57
diff -u -b -r1.57 stratify.m
--- compiler/stratify.m 27 Sep 2006 06:17:04 -0000 1.57
+++ compiler/stratify.m 12 Oct 2006 06:00:29 -0000
@@ -879,8 +879,9 @@
Msg = simple_msg(Context,
[always(Preamble ++ MainPieces), verbose_only(VerbosePieces)]),
Spec = error_spec(Severity, phase_code_gen, [Msg]),
+ module_info_get_globals(!.ModuleInfo, Globals),
% XXX _NumErrors
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO).
+ write_error_spec(Spec, Globals, 0, _NumWarnings, 0, _NumErrors, !IO).
%-----------------------------------------------------------------------------%
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.122
diff -u -b -r1.122 table_gen.m
--- compiler/table_gen.m 2 Oct 2006 05:21:24 -0000 1.122
+++ compiler/table_gen.m 12 Oct 2006 06:50:00 -0000
@@ -317,7 +317,8 @@
Pieces = ProcPieces ++ [words("contains untabled I/O primitive."), nl],
Msg = simple_msg(Context, [always(Pieces)]),
Spec = error_spec(severity_error, phase_code_gen, [Msg]),
- write_error_spec(Spec, 0, _NumWarnings, 0, NumErrors, !IO),
+ module_info_get_globals(!.ModuleInfo, Globals),
+ write_error_spec(Spec, Globals, 0, _NumWarnings, 0, NumErrors, !IO),
module_info_incr_num_errors(NumErrors, !ModuleInfo).
%-----------------------------------------------------------------------------%
@@ -346,7 +347,8 @@
% We don't want to increment the error count, since that would combine
% with --halt-at-warn to prevent the clean compilation of the library.
Spec = error_spec(severity_informational, phase_code_gen, [Msg]),
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO),
+ module_info_get_globals(!.ModuleInfo, Globals),
+ write_error_spec(Spec, Globals, 0, _NumWarnings, 0, _NumErrors, !IO),
% XXX We set the evaluation method to eval_normal here to prevent
% problems in the ml code generator if we are compiling in a grade
Index: compiler/type_class_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_class_info.m,v
retrieving revision 1.22
diff -u -b -r1.22 type_class_info.m
--- compiler/type_class_info.m 27 Sep 2006 06:17:05 -0000 1.22
+++ compiler/type_class_info.m 12 Oct 2006 07:57:37 -0000
@@ -141,13 +141,12 @@
ImportStatus = InstanceDefn ^ instance_status,
Body = InstanceDefn ^ instance_body,
(
- Body = concrete(_),
+ Body = instance_body_concrete(_),
% Only make the RTTI structure for the type class instance if the
% instance declaration originally came from _this_ module.
status_defined_in_this_module(ImportStatus) = yes
->
- RttiData = generate_instance_decl(ModuleInfo, ClassId,
- InstanceDefn),
+ RttiData = generate_instance_decl(ModuleInfo, ClassId, InstanceDefn),
!:RttiDatas = [RttiData | !.RttiDatas]
;
true
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.406
diff -u -b -r1.406 typecheck.m
--- compiler/typecheck.m 27 Sep 2006 06:17:06 -0000 1.406
+++ compiler/typecheck.m 12 Oct 2006 06:01:35 -0000
@@ -181,7 +181,7 @@
construct_type_inference_messages(PredIds, !.ModuleInfo,
[], ProgressSpecs),
trace [io(!IO)] (
- write_error_specs(ProgressSpecs, 0, _, 0, _, !IO)
+ write_error_specs(ProgressSpecs, Globals, 0, _, 0, _, !IO)
)
;
DebugTypes = no
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.175
diff -u -b -r1.175 unify_proc.m
--- compiler/unify_proc.m 2 Oct 2006 05:21:29 -0000 1.175
+++ compiler/unify_proc.m 12 Oct 2006 05:37:40 -0000
@@ -458,15 +458,23 @@
module_info_remove_predid(PredId, !ModuleInfo),
Changed = Changed1
;
- ( HowToCheckGoal = check_unique_modes ->
+ (
+ HowToCheckGoal = check_unique_modes,
detect_switches_in_proc(ProcId, PredId, !ModuleInfo),
detect_cse_in_proc(ProcId, PredId, !ModuleInfo, !IO),
- determinism_check_proc(ProcId, PredId, !ModuleInfo, !IO),
+ determinism_check_proc(ProcId, PredId, !ModuleInfo, Specs),
+ (
+ Specs = []
+ ;
+ Specs = [_ | _],
+ unexpected(this_file, "modecheck_queued_proc: found error")
+ ),
save_proc_info(ProcId, PredId, !.ModuleInfo, !OldPredTable),
unique_modes.check_proc(ProcId, PredId, !ModuleInfo, Changed2,
!IO),
bool.or(Changed1, Changed2, Changed)
;
+ HowToCheckGoal = check_modes,
Changed = Changed1
)
).
Index: compiler/unused_args.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unused_args.m,v
retrieving revision 1.137
diff -u -b -r1.137 unused_args.m
--- compiler/unused_args.m 2 Oct 2006 05:21:30 -0000 1.137
+++ compiler/unused_args.m 12 Oct 2006 06:51:24 -0000
@@ -1790,7 +1790,7 @@
set(pred_id)::in, set(pred_id)::out, io::di, io::uo) is det.
maybe_warn_unused_args(no, _, _, _, _, _, !WarnedPredIds, !IO).
-maybe_warn_unused_args(yes, _ModuleInfo, PredInfo, PredId, ProcId,
+maybe_warn_unused_args(yes, ModuleInfo, PredInfo, PredId, ProcId,
UnusedArgs0, !WarnedPredIds, !IO) :-
( set.member(PredId, !.WarnedPredIds) ->
true
@@ -1807,7 +1807,7 @@
adjust_unused_args(NumToDrop, UnusedArgs0, UnusedArgs),
(
UnusedArgs = [_ | _],
- report_unused_args(PredInfo, UnusedArgs, !IO)
+ report_unused_args(ModuleInfo, PredInfo, UnusedArgs, !IO)
;
UnusedArgs = []
)
@@ -1831,19 +1831,19 @@
% in every mode of a predicate are warned about. The warning is
% suppressed for type_infos.
%
-:- pred report_unused_args(pred_info::in, list(int)::in,
+:- pred report_unused_args(module_info::in, pred_info::in, list(int)::in,
io::di, io::uo) is det.
-report_unused_args(PredInfo, UnusedArgs, !IO) :-
+report_unused_args(ModuleInfo, PredInfo, UnusedArgs, !IO) :-
list.length(UnusedArgs, NumArgs),
pred_info_context(PredInfo, Context),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
- Module = pred_info_module(PredInfo),
- Name = pred_info_name(PredInfo),
+ ModuleName = pred_info_module(PredInfo),
+ PredName = pred_info_name(PredInfo),
Arity = pred_info_orig_arity(PredInfo),
Pieces1 = [words("In"), fixed(pred_or_func_to_full_str(PredOrFunc)),
- sym_name_and_arity(qualified(Module, Name) / Arity), suffix(":"), nl,
- words("warning:")],
+ sym_name_and_arity(qualified(ModuleName, PredName) / Arity),
+ suffix(":"), nl, words("warning:")],
( NumArgs = 1 ->
Pieces2 = [words("argument") | format_arg_list(UnusedArgs)] ++
[words("is unused."), nl]
@@ -1853,8 +1853,9 @@
),
Msg = simple_msg(Context, [always(Pieces1 ++ Pieces2)]),
Spec = error_spec(severity_warning, phase_code_gen, [Msg]),
+ module_info_get_globals(ModuleInfo, Globals),
% XXX _NumErrors
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO).
+ write_error_spec(Spec, Globals, 0, _NumWarnings, 0, _NumErrors, !IO).
:- func format_arg_list(list(int)) = list(format_component).
Index: compiler/unused_imports.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unused_imports.m,v
retrieving revision 1.3
diff -u -b -r1.3 unused_imports.m
--- compiler/unused_imports.m 27 Sep 2006 06:17:09 -0000 1.3
+++ compiler/unused_imports.m 12 Oct 2006 11:00:16 -0000
@@ -21,16 +21,19 @@
:- module check_hlds.unused_imports.
:- interface.
-:- import_module io.
-
:- import_module hlds.
:- import_module hlds.hlds_module.
+:- import_module parse_tree.
+:- import_module parse_tree.error_util.
+
+:- import_module io.
+:- import_module list.
% This predicate issues a warning for each import_module
% which is not directly used in this module, plus those
% which are in the interface but should be in the implementation.
%
-:- pred unused_imports(module_info::in, module_info::out,
+:- pred unused_imports(module_info::in, list(error_spec)::out,
io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
@@ -38,7 +41,6 @@
:- implementation.
-:- import_module hlds.
:- import_module hlds.hlds_clauses.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_goal.
@@ -47,8 +49,6 @@
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
-:- import_module parse_tree.
-:- import_module parse_tree.error_util.
:- import_module parse_tree.modules.
:- import_module parse_tree.prog_data.
@@ -56,7 +56,6 @@
:- import_module libs.compiler_util.
:- import_module bool.
-:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module pair.
@@ -67,9 +66,11 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-unused_imports(!ModuleInfo, !IO) :-
+unused_imports(ModuleInfo, !:Specs, !IO) :-
+ !:Specs = [],
+ module_info_get_name(ModuleInfo, ModuleName),
+ module_name_to_file_name(ModuleName, ".m", no, FileName, !IO),
- %
% Each parent module of the current module imports are inherited by
% this module so we have to add the used modules of the parents to
% the set of used modules, as an import in the parent may only be
@@ -77,7 +78,7 @@
%
% We also consider the implicitly imported modules to be used as
% the user cannot do anything about them.
- %
+
ImplicitImports = [
mercury_public_builtin_module,
mercury_private_builtin_module,
@@ -85,50 +86,46 @@
mercury_profiling_builtin_module,
mercury_term_size_prof_builtin_module,
mercury_par_builtin_module],
- module_info_get_used_modules(!.ModuleInfo, UsedModules0),
+ module_info_get_used_modules(ModuleInfo, UsedModules0),
list.foldl(add_all_modules(visibility_public), ImplicitImports,
UsedModules0, UsedModules1),
- used_modules(!.ModuleInfo, UsedModules1, UsedModules),
+ used_modules(ModuleInfo, UsedModules1, UsedModules),
- %
% The unused imports is simply the set of imports minus all the
% used modules.
- %
- module_info_get_imported_module_specifiers(!.ModuleInfo, ImportedModules),
+ module_info_get_imported_module_specifiers(ModuleInfo, ImportedModules),
UsedInImplementation = UsedModules ^ impl_used_modules,
- UnusedImports = to_sorted_list(
- ImportedModules `difference`
+ UnusedImports = to_sorted_list(ImportedModules `difference`
(UsedInInterface `union` UsedInImplementation)),
- ( UnusedImports = [_|_],
- output_warning(!.ModuleInfo, UnusedImports, "", !IO)
- ; UnusedImports = [],
- true
+ (
+ UnusedImports = [_ | _],
+ ImportSpec = generate_warning(ModuleName, FileName, UnusedImports, ""),
+ !:Specs = [ImportSpec | !.Specs]
+ ;
+ UnusedImports = []
),
-
- %
% Determine the modules imported in the interface but not used in
% the interface.
- %
- module_info_get_interface_module_specifiers(!.ModuleInfo,
- InterfaceImports),
+ module_info_get_interface_module_specifiers(ModuleInfo, InterfaceImports),
UsedInInterface = UsedModules ^ int_used_modules,
UnusedInterfaceImports = to_sorted_list(InterfaceImports
`difference` UsedInInterface `difference` set(UnusedImports)),
- ( UnusedInterfaceImports = [_|_],
- output_warning(!.ModuleInfo, UnusedInterfaceImports, " interface", !IO)
- ; UnusedInterfaceImports = [],
- true
+ (
+ UnusedInterfaceImports = [_ | _],
+ InterfaceImportSpec = generate_warning(ModuleName, FileName,
+ UnusedInterfaceImports, " interface"),
+ !:Specs = [InterfaceImportSpec | !.Specs]
+ ;
+ UnusedInterfaceImports = []
).
-:- pred output_warning(module_info::in, list(module_name)::in, string::in,
- io::di, io::uo) is det.
+:- func generate_warning(module_name, string, list(module_name), string)
+ = error_spec.
-output_warning(ModuleInfo, UnusedImports, Location, !IO) :-
- module_info_get_name(ModuleInfo, ModuleName),
- module_name_to_file_name(ModuleName, ".m", no, FileName, !IO),
+generate_warning(ModuleName, FileName, UnusedImports, Location) = Spec :-
term.context_init(FileName, 1, Context),
ModuleWord = choose_number(UnusedImports, "module", "modules"),
IsOrAre = is_or_are(UnusedImports),
@@ -150,9 +147,7 @@
words("but"), fixed(IsOrAre),
words("not used" ++ InThe ++ Location ++ ".")],
Msg = simple_msg(Context, [always(Pieces)]),
- Spec = error_spec(severity_warning, phase_code_gen, [Msg]),
- write_error_spec(Spec, 0, _NumWarnings, 0, _NumErrors, !IO),
- record_warning(!IO).
+ Spec = error_spec(severity_warning, phase_code_gen, [Msg]).
%-----------------------------------------------------------------------------%
@@ -163,7 +158,6 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
- %
% Scan each item in the module_info recording the module qualifications on
% the item and if that module is used in the interface or implementation
% section of the module.
@@ -205,16 +199,17 @@
( status_defined_in_this_module(ImportStatus) = yes ->
Visibility = item_visibility(ImportStatus),
- ( TypeBody = hlds_du_type(Ctors, _, _, _, _, _),
+ (
+ TypeBody = hlds_du_type(Ctors, _, _, _, _, _),
list.foldl(ctor_used_modules(Visibility), Ctors, !UsedModules)
- ; TypeBody = hlds_eqv_type(EqvType),
+ ;
+ TypeBody = hlds_eqv_type(EqvType),
mer_type_used_modules(Visibility, EqvType, !UsedModules)
;
( TypeBody = hlds_foreign_type(_)
; TypeBody = hlds_solver_type(_, _)
; TypeBody = hlds_abstract_type(_)
- ),
- true
+ )
)
;
true
@@ -224,7 +219,8 @@
used_modules::in, used_modules::out) is det.
ctor_used_modules(Visibility, ctor(_, Constraints, _, Args), !UsedModules) :-
- list.foldl(prog_constraint_used_module(Visibility), Constraints, !UsedModules),
+ list.foldl(prog_constraint_used_module(Visibility), Constraints,
+ !UsedModules),
list.foldl(
(pred(_ - Arg::in, !.M::in, !:M::out) is det :-
mer_type_used_modules(Visibility, Arg, !M)
@@ -233,8 +229,8 @@
:- pred prog_constraint_used_module(item_visibility::in, prog_constraint::in,
used_modules::in, used_modules::out) is det.
-prog_constraint_used_module(Visibility,
- constraint(ClassName, Args), !UsedModules) :-
+prog_constraint_used_module(Visibility, constraint(ClassName, Args),
+ !UsedModules) :-
add_sym_name_module(Visibility, ClassName, !UsedModules),
list.foldl(mer_type_used_modules(Visibility), Args, !UsedModules).
@@ -249,10 +245,11 @@
( status_defined_in_this_module(ImportStatus) = yes ->
Visibility = item_visibility(ImportStatus),
InstBody = InstDefn ^ inst_body,
- ( InstBody = eqv_inst(Inst),
+ (
+ InstBody = eqv_inst(Inst),
mer_inst_used_modules(Visibility, Inst, !UsedModules)
- ; InstBody = abstract_inst,
- true
+ ;
+ InstBody = abstract_inst
)
;
true
@@ -356,10 +353,11 @@
proc_info_used_modules(Visibility, _ProcId, ProcInfo, !UsedModules) :-
proc_info_get_maybe_declared_argmodes(ProcInfo, MaybeArgModes),
- ( MaybeArgModes = yes(Modes),
+ (
+ MaybeArgModes = yes(Modes),
list.foldl(mer_mode_used_modules(Visibility), Modes, !UsedModules)
- ; MaybeArgModes = no,
- true
+ ;
+ MaybeArgModes = no
).
:- pred clauses_info_used_modules(clauses_info::in,
@@ -387,7 +385,8 @@
hlds_goal_used_modules(plain_call(_, _, _, _, _, Name) - _, !UsedModules) :-
add_sym_name_module(visibility_private, Name, !UsedModules).
hlds_goal_used_modules(generic_call(Call, _, _, _) - _, !UsedModules) :-
- ( Call = class_method(_, _, ClassId, CallId),
+ (
+ Call = class_method(_, _, ClassId, CallId),
ClassId = class_id(ClassName, _),
add_sym_name_module(visibility_private, ClassName, !UsedModules),
@@ -397,8 +396,7 @@
( Call = higher_order(_, _, _, _)
; Call = event_call(_)
; Call = cast(_)
- ),
- true
+ )
).
hlds_goal_used_modules(
call_foreign_proc(_, _, _, _, _, _, _) - _, !UsedModules).
@@ -420,20 +418,19 @@
hlds_goal_used_modules(If, !UsedModules),
hlds_goal_used_modules(Then, !UsedModules),
hlds_goal_used_modules(Else, !UsedModules).
-hlds_goal_used_modules(
- shorthand(bi_implication(GoalA, GoalB)) - _, !UsedModules) :-
+hlds_goal_used_modules(shorthand(bi_implication(GoalA, GoalB)) - _,
+ !UsedModules) :-
hlds_goal_used_modules(GoalA, !UsedModules),
hlds_goal_used_modules(GoalB, !UsedModules).
-
:- pred unify_rhs_used_modules(unify_rhs::in,
used_modules::in, used_modules::out) is det.
unify_rhs_used_modules(rhs_var(_), !UsedModules).
unify_rhs_used_modules(rhs_functor(ConsId, _, _), !UsedModules) :-
cons_id_used_modules(visibility_private, ConsId, !UsedModules).
-unify_rhs_used_modules(
- rhs_lambda_goal(_, _, _, _, _, _, _, Goal), !UsedModules) :-
+unify_rhs_used_modules(rhs_lambda_goal(_, _, _, _, _, _, _, Goal),
+ !UsedModules) :-
hlds_goal_used_modules(Goal, !UsedModules).
:- pred cons_id_used_modules(item_visibility::in, cons_id::in,
@@ -473,18 +470,19 @@
used_modules::in, used_modules::out) is det.
mer_type_used_modules_2(_Status, type_variable(_, _), !UsedModules).
-mer_type_used_modules_2(Visibility,
- defined_type(Name, Args, _), !UsedModules) :-
+mer_type_used_modules_2(Visibility, defined_type(Name, Args, _),
+ !UsedModules) :-
add_sym_name_module(Visibility, Name, !UsedModules),
list.foldl(mer_type_used_modules(Visibility), Args, !UsedModules).
mer_type_used_modules_2(_Status, builtin_type(_), !UsedModules).
mer_type_used_modules_2(Visibility,
higher_order_type(Args, MaybeReturn, _, _), !UsedModules) :-
list.foldl(mer_type_used_modules(Visibility), Args, !UsedModules),
- ( MaybeReturn = yes(Return),
+ (
+ MaybeReturn = yes(Return),
mer_type_used_modules(Visibility, Return, !UsedModules)
- ; MaybeReturn = no,
- true
+ ;
+ MaybeReturn = no
).
mer_type_used_modules_2(Visibility, tuple_type(Args, _), !UsedModules) :-
list.foldl(mer_type_used_modules(Visibility), Args, !UsedModules).
@@ -502,8 +500,8 @@
mer_mode_used_modules(Visibility, Inst0 -> Inst, !UsedModules) :-
mer_inst_used_modules(Visibility, Inst0, !UsedModules),
mer_inst_used_modules(Visibility, Inst, !UsedModules).
-mer_mode_used_modules(Visibility,
- user_defined_mode(Name, Insts), !UsedModules) :-
+mer_mode_used_modules(Visibility, user_defined_mode(Name, Insts),
+ !UsedModules) :-
add_sym_name_module(Visibility, Name, !UsedModules),
list.foldl(mer_inst_used_modules(Visibility), Insts, !UsedModules).
@@ -518,14 +516,14 @@
mer_inst_used_modules(Visibility, free(Type), !UsedModules) :-
mer_type_used_modules(Visibility, Type, !UsedModules).
mer_inst_used_modules(Visibility, bound(_, BoundInsts), !UsedModules) :-
- list.foldl(bound_inst_info_used_modules(Visibility),
- BoundInsts, !UsedModules).
+ list.foldl(bound_inst_info_used_modules(Visibility), BoundInsts,
+ !UsedModules).
mer_inst_used_modules(Visibility, ground(_, GroundInstInfo), !UsedModules) :-
ground_inst_info_used_modules(Visibility, GroundInstInfo, !UsedModules).
mer_inst_used_modules(_, not_reached, !UsedModules).
mer_inst_used_modules(_, inst_var(_), !UsedModules).
-mer_inst_used_modules(Visibility,
- constrained_inst_vars(_InstVars, Inst), !UsedModules) :-
+mer_inst_used_modules(Visibility, constrained_inst_vars(_InstVars, Inst),
+ !UsedModules) :-
mer_inst_used_modules(Visibility, Inst, !UsedModules).
mer_inst_used_modules(Visibility, defined_inst(InstName), !UsedModules) :-
inst_name_used_modules(Visibility, InstName, !UsedModules).
@@ -538,8 +536,8 @@
:- pred bound_inst_info_used_modules(item_visibility::in, bound_inst::in,
used_modules::in, used_modules::out) is det.
-bound_inst_info_used_modules(Visibility,
- bound_functor(ConsId, Insts), !UsedModules) :-
+bound_inst_info_used_modules(Visibility, bound_functor(ConsId, Insts),
+ !UsedModules) :-
cons_id_used_modules(Visibility, ConsId, !UsedModules),
list.foldl(mer_inst_used_modules(Visibility), Insts, !UsedModules).
@@ -562,15 +560,15 @@
inst_name_used_modules(Visibility, merge_inst(Inst0, Inst), !UsedModules) :-
mer_inst_used_modules(Visibility, Inst0, !UsedModules),
mer_inst_used_modules(Visibility, Inst, !UsedModules).
-inst_name_used_modules(Visibility,
- unify_inst(_, Inst0, Inst, _), !UsedModules) :-
+inst_name_used_modules(Visibility, unify_inst(_, Inst0, Inst, _),
+ !UsedModules) :-
mer_inst_used_modules(Visibility, Inst0, !UsedModules),
mer_inst_used_modules(Visibility, Inst, !UsedModules).
-inst_name_used_modules(Visibility,
- ground_inst(InstName, _, _, _), !UsedModules) :-
+inst_name_used_modules(Visibility, ground_inst(InstName, _, _, _),
+ !UsedModules) :-
inst_name_used_modules(Visibility, InstName, !UsedModules).
-inst_name_used_modules(Visibility,
- any_inst(InstName, _, _, _), !UsedModules) :-
+inst_name_used_modules(Visibility, any_inst(InstName, _, _, _),
+ !UsedModules) :-
inst_name_used_modules(Visibility, InstName, !UsedModules).
inst_name_used_modules(Visibility, shared_inst(InstName), !UsedModules) :-
inst_name_used_modules(Visibility, InstName, !UsedModules).
@@ -585,9 +583,8 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
- %
% Determine if the given import_status implies item is visibility_public
- % (in the interface or visibility_private (in the implementation).
+ % (in the interface) or visibility_private (in the implementation).
%
:- func item_visibility(import_status) = item_visibility.
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/cyclic_typeclass_3.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/cyclic_typeclass_3.err_exp,v
retrieving revision 1.3
diff -u -b -r1.3 cyclic_typeclass_3.err_exp
--- tests/invalid/cyclic_typeclass_3.err_exp 14 Sep 2005 05:26:44 -0000 1.3
+++ tests/invalid/cyclic_typeclass_3.err_exp 12 Oct 2006 13:32:15 -0000
@@ -1,10 +1,10 @@
-cyclic_typeclass_3.m:014: Error: cyclic superclass relation detected:
-cyclic_typeclass_3.m:014: `cyclic_typeclass_3.c'/1 <=
-cyclic_typeclass_3.m:014: `cyclic_typeclass_3.e'/1 <=
-cyclic_typeclass_3.m:014: `cyclic_typeclass_3.i'/1 <=
-cyclic_typeclass_3.m:014: `cyclic_typeclass_3.c'/1
cyclic_typeclass_3.m:012: Error: cyclic superclass relation detected:
cyclic_typeclass_3.m:012: `cyclic_typeclass_3.a'/1 <=
cyclic_typeclass_3.m:012: `cyclic_typeclass_3.b'/1 <=
cyclic_typeclass_3.m:012: `cyclic_typeclass_3.g'/1 <=
cyclic_typeclass_3.m:012: `cyclic_typeclass_3.a'/1
+cyclic_typeclass_3.m:014: Error: cyclic superclass relation detected:
+cyclic_typeclass_3.m:014: `cyclic_typeclass_3.c'/1 <=
+cyclic_typeclass_3.m:014: `cyclic_typeclass_3.e'/1 <=
+cyclic_typeclass_3.m:014: `cyclic_typeclass_3.i'/1 <=
+cyclic_typeclass_3.m:014: `cyclic_typeclass_3.c'/1
Index: tests/invalid/hawkins_mm_fail_reset.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/hawkins_mm_fail_reset.err_exp,v
retrieving revision 1.3
diff -u -b -r1.3 hawkins_mm_fail_reset.err_exp
--- tests/invalid/hawkins_mm_fail_reset.err_exp 7 Sep 2006 05:51:28 -0000 1.3
+++ tests/invalid/hawkins_mm_fail_reset.err_exp 12 Oct 2006 15:37:41 -0000
@@ -1,13 +1,13 @@
+hawkins_mm_fail_reset.m:020: In `entry'(out):
+hawkins_mm_fail_reset.m:020: warning: determinism declaration could be
+hawkins_mm_fail_reset.m:020: tighter.
+hawkins_mm_fail_reset.m:020: Declared `nondet', inferred `failure'.
hawkins_mm_fail_reset.m:027: Error: `pragma minimal_model' declaration not
hawkins_mm_fail_reset.m:027: allowed for procedure with determinism
hawkins_mm_fail_reset.m:027: `failure'.
hawkins_mm_fail_reset.m:036: Error: `pragma minimal_model' declaration not
hawkins_mm_fail_reset.m:036: allowed for procedure with determinism
hawkins_mm_fail_reset.m:036: `failure'.
-hawkins_mm_fail_reset.m:020: In `entry'(out):
-hawkins_mm_fail_reset.m:020: warning: determinism declaration could be
-hawkins_mm_fail_reset.m:020: tighter.
-hawkins_mm_fail_reset.m:020: Declared `nondet', inferred `failure'.
hawkins_mm_fail_reset.m:030: Warning: this disjunct will never have any
hawkins_mm_fail_reset.m:030: solutions.
hawkins_mm_fail_reset.m:033: Warning: this disjunct will never have any
Index: tests/invalid/invalid_main.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/invalid_main.err_exp,v
retrieving revision 1.4
diff -u -b -r1.4 invalid_main.err_exp
--- tests/invalid/invalid_main.err_exp 7 Sep 2006 05:51:28 -0000 1.4
+++ tests/invalid/invalid_main.err_exp 12 Oct 2006 15:37:45 -0000
@@ -1,6 +1,6 @@
invalid_main.m:004: Error: arguments of main/2 must have type `io.state'.
+invalid_main.m:004: Error: main/2 must be `det' or `cc_multi'.
invalid_main.m:004: In `main'(di, out):
invalid_main.m:004: warning: determinism declaration could be tighter.
invalid_main.m:004: Declared `multi', inferred `det'.
-invalid_main.m:004: Error: main/2 must be `det' or `cc_multi'.
invalid_main.m:004: Error: main/2 must have mode `(di, uo)'.
Index: tests/invalid/one_member.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/one_member.err_exp,v
retrieving revision 1.3
diff -u -b -r1.3 one_member.err_exp
--- tests/invalid/one_member.err_exp 7 Sep 2006 05:51:31 -0000 1.3
+++ tests/invalid/one_member.err_exp 12 Oct 2006 15:37:56 -0000
@@ -1,12 +1,15 @@
one_member.m:044: Error: this `arbitrary' scope is not nested inside a
one_member.m:044: `promise_equivalent_solution_sets' scope.
+one_member.m:047: In `one_member2'(in, out):
+one_member.m:047: warning: determinism declaration could be tighter.
+one_member.m:047: Declared `nondet', inferred `semidet'.
one_member.m:051: Error: the `arbitrary' goal lists an extra variable: Tree.
one_member.m:051: Error: this `arbitrary' scope and the
one_member.m:051: `promise_equivalent_solution_sets' scope it is nested
one_member.m:051: inside overlap on the variable Item.
one_member.m:050: This is the outer `promise_equivalent_solution_sets' scope.
one_member.m:052: Error: unification for non-canonical type
-one_member.m:052: `one_member.set_ctree234/1' occurs in a context which
+one_member.m:052: `one_member.set_ctree234'/1 occurs in a context which
one_member.m:052: requires all solutions.
one_member.m:052: Since the type has a user-defined equality predicate, I
one_member.m:052: must presume that there is more than one possible concrete
@@ -21,6 +24,3 @@
one_member.m:061: Error: `promise_equivalent_solution_sets' scope is nested
one_member.m:061: inside another.
one_member.m:060: This is the outer `promise_equivalent_solution_sets' scope.
-one_member.m:047: In `one_member2'(in, out):
-one_member.m:047: warning: determinism declaration could be tighter.
-one_member.m:047: Declared `nondet', inferred `semidet'.
Index: tests/invalid/pragma_c_code_no_det.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/pragma_c_code_no_det.err_exp,v
retrieving revision 1.4
diff -u -b -r1.4 pragma_c_code_no_det.err_exp
--- tests/invalid/pragma_c_code_no_det.err_exp 7 Sep 2006 05:51:31 -0000 1.4
+++ tests/invalid/pragma_c_code_no_det.err_exp 12 Oct 2006 17:07:17 -0000
@@ -1,7 +1,7 @@
-pragma_c_code_no_det.m:012: In `c_code'(out):
-pragma_c_code_no_det.m:012: error: `:- pragma c_code(...)' for a procedure
-pragma_c_code_no_det.m:012: without a determinism declaration.
pragma_c_code_no_det.m:005: In `test'(out):
pragma_c_code_no_det.m:005: warning: determinism declaration could be
pragma_c_code_no_det.m:005: tighter.
pragma_c_code_no_det.m:005: Declared `det', inferred `erroneous'.
+pragma_c_code_no_det.m:012: In `c_code'(out):
+pragma_c_code_no_det.m:012: error: `:- pragma foreign_proc(...)' for a
+pragma_c_code_no_det.m:012: procedure without a determinism declaration.
Index: tests/invalid/quant_constraint_1.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/quant_constraint_1.err_exp,v
retrieving revision 1.3
diff -u -b -r1.3 quant_constraint_1.err_exp
--- tests/invalid/quant_constraint_1.err_exp 7 Sep 2006 05:51:31 -0000 1.3
+++ tests/invalid/quant_constraint_1.err_exp 12 Oct 2006 15:38:00 -0000
@@ -1,6 +1,6 @@
quant_constraint_1.m:015: In declaration of predicate `quant_constraint_1.p'/2:
-quant_constraint_1.m:015: type variable T2 is universally constrained, but is
-quant_constraint_1.m:015: existentially quantified.
-quant_constraint_1.m:015: In declaration of predicate `quant_constraint_1.p'/2:
quant_constraint_1.m:015: type variable T1 is existentially constrained, but
quant_constraint_1.m:015: is universally quantified.
+quant_constraint_1.m:015: In declaration of predicate `quant_constraint_1.p'/2:
+quant_constraint_1.m:015: type variable T2 is universally constrained, but is
+quant_constraint_1.m:015: existentially quantified.
Index: tests/invalid/range_restrict.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/range_restrict.err_exp,v
retrieving revision 1.2
diff -u -b -r1.2 range_restrict.err_exp
--- tests/invalid/range_restrict.err_exp 14 Sep 2005 05:26:50 -0000 1.2
+++ tests/invalid/range_restrict.err_exp 12 Oct 2006 15:38:00 -0000
@@ -1,8 +1,8 @@
-range_restrict.m:012: In instance for typeclass `range_restrict.foo'/2:
-range_restrict.m:012: functional dependency not satisfied: type variables Y
-range_restrict.m:012: and Z occur in the range of the functional dependency,
-range_restrict.m:012: but are not in the domain.
range_restrict.m:011: In instance for typeclass `range_restrict.foo'/2:
range_restrict.m:011: functional dependency not satisfied: type variable Y
range_restrict.m:011: occurs in the range of the functional dependency, but
range_restrict.m:011: is not in the domain.
+range_restrict.m:012: In instance for typeclass `range_restrict.foo'/2:
+range_restrict.m:012: functional dependency not satisfied: type variables Y
+range_restrict.m:012: and Z occur in the range of the functional dependency,
+range_restrict.m:012: but are not in the domain.
Index: tests/invalid/typeclass_test_5.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/typeclass_test_5.err_exp,v
retrieving revision 1.10
diff -u -b -r1.10 typeclass_test_5.err_exp
--- tests/invalid/typeclass_test_5.err_exp 7 Sep 2006 05:51:34 -0000 1.10
+++ tests/invalid/typeclass_test_5.err_exp 12 Oct 2006 15:38:13 -0000
@@ -1,8 +1,8 @@
-typeclass_test_5.m:020: In instance declaration for `typeclass_test_5.c2'(int):
+typeclass_test_5.m:020: In instance declaration for `typeclass_test_5.c2(int)'
+typeclass_test_5.m:020: superclass constraints not satisfied:
+typeclass_test_5.m:020: `typeclass_test_5.c1(int)'.
+typeclass_test_5.m:020: In instance declaration for `typeclass_test_5.c2(int)':
typeclass_test_5.m:020: multiple implementations of type class predicate
typeclass_test_5.m:020: method `typeclass_test_5.p'/1.
typeclass_test_5.m:021: First definition appears here.
typeclass_test_5.m:022: Subsequent definition appears here.
-typeclass_test_5.m:020: In instance declaration for `typeclass_test_5.c2(int)':
-typeclass_test_5.m:020: superclass constraint(s) not satisfied:
-typeclass_test_5.m:020: `typeclass_test_5.c1(int)'.
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/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
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