[m-rev.] for review: diagnose non-contiguous clauses
Zoltan Somogyi
zs at csse.unimelb.edu.au
Mon Aug 17 19:02:38 AEST 2009
For review by anyone. Anyone have better names for the options that aren't
excessively long?
Zoltan.
Add a mechanism for generating warnings when the various clauses of a predicate
or function are not contiguous.
This mechanism consists of two options:
--warn-non-contiguous-clauses
--warn-non-contiguous-foreign-procs
The first option generates warnings when the Mercury clauses of a predicate
or function are not contiguous, but it ignores any foreign_procs of that
predicate or function, and thus allows these to be away from the Mercury
clauses and each other. This option is enabled by default.
The second option generating warnings unless both the Mercury clauses and
all the foreign_procs of the predicate or function are all contiguous.
This option is not enabled by default, because many library modules
group foreign_procs not by predicate, but by foreign language. (All C foreign
procs for a group of predicates, then all the Java foreign procs for that group
of predicates, etc.)
compiler/hlds_clauses.m:
Store, next to the representation of each clause list, information
about the locations (item numbers and context) of the clauses.
We store two versions of this information, one version for each option.
Make the predicates that access the clause list access the location
information as well, to ensure that any code that adds clauses also
records their location.
Add a predicate that tests for non-contiguity.
Add a specific type to represent the modes that a clause applies to.
This replaces the error-prone scheme we used to use that represented
the notion "this clause applies to all modes" with an empty list of
modes. This allows us to remove the code in add_pragma.m that used
to replace these empty lists with the list of actual modes they
represented.
Change the prefix on the fields of clauses_info to avoid ambiguities.
Add a prefix to the names of the function symbols of the clauses_rep
type to avoid ambiguities.
compiler/add_clause.m:
compiler/add_pragma.m:
When adding Mercury clauses and pragma foreign_procs to a predicate or
function, record the location of the clause or foreign_procs. We do so
even if the clause or foreign_proc is overridden by another. For
example, when compiling to C, a Mercury clause overrides an Erlang
foreign_proc, and a C foreign_proc overrides a Mercury clause.
Fix an old bug where a foreign_proc that should override Mercury
clauses overrode only one Mercury clause, and left the others
in the predicate, to yield a disjunction with some Mercury disjuncts
and a foreign_proc disjunct. This disjunction would then yield
determinism errors if it had outputs.
The new code that fixes the bug has a much more direct implicit
correctness argument, and should be significantly easier to understand.
It also avoids doing unnecessary work. (The old code could make a
decision to ignore a clause, yet still proceed to transform it,
just to ignore the result of the transformation.)
compiler/options.m:
Add the new options.
doc/user_guide.texi:
Document the new options. Fix an inconsistency between options.m and
user_guide.texi for a nearby option.
compiler/make_hlds_passes.m:
Pass the information that add_clause.m and add_pragma.m need.
compiler/typecheck.m:
Detect non-contiguous clauses and call typecheck_errors to generate
error messages.
compiler/typecheck_errors.m:
Add functions for formatting error messages about non-contiguous
clauses.
compiler/hlds_out.m:
Do not print the modes to which a clause applies for the usual case,
in which the clause applies to all modes.
compiler/clause_to_proc.m:
Simplify some code.
Rename a predicate to better reflect its purpose.
Conform to the changes above.
compiler/intermod.m:
Rename a predicate to avoid ambiguities.
Conform to the changes above.
compiler/add_class.m:
compiler/add_pred.m:
compiler/add_special_pred.m:
compiler/assertion.m:
compiler/build_mode_constraints.m:
compiler/dead_proc_elim.m:
compiler/dependency_graph.m:
compiler/goal_path.m:
compiler/headvar_names.m:
compiler/hhf.m:
compiler/higher_order.m:
compiler/hlds_pred.m:
compiler/implementation_defined_literals.m:
compiler/mode_constraints.m:
compiler/modes.m:
compiler/ordering_mode_constraints.m:
compiler/polymorphism.m:
compiler/post_typecheck.m:
compiler/proc_gen.m:
compiler/prop_mode_constraints.m:
compiler/purity.m:
compiler/type_constraints.m:
compiler/unify_proc.m:
compiler/unused_imports.m:
Conform to the changes above.
compiler/goal_form.m:
The new warnings pointed out a non-contiguous clause in goal_form.m.
Since this clause happened to be a duplicate of another clause, this
diff deletes it. The duplicate clause was not detected because the
predicate is semidet, and has no outputs.
compiler/mlds_to_c.m:
compiler/rbmm.points_to_analysis.m:
deep_profiler/measurements.m:
library/library.m:
library/list.m:
Fix non-contiguous clauses pointed out by the new warnings.
library/bit_buffer.m:
Fix programming style.
tests/invalid/types2.err_exp:
This test has non-contiguous clauses, so expect the new warning.
tests/warnings/warn_contiguous.{m,exp}:
tests/warnings/warn_non_contiguous.{m,exp}:
tests/warnings/warn_non_contiguous_foreign.{m,exp}:
tests/warnings/warn_non_contiguous_foreign_group.{m,exp}:
New test cases that exercise the new capability.
tests/warnings/Mmakefile:
tests/warnings/Mercury.options:
Enable and specify the options for the new tests.
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.31
diff -u -b -r1.31 add_class.m
--- compiler/add_class.m 28 Jul 2008 08:34:16 -0000 1.31
+++ compiler/add_class.m 10 Aug 2009 20:15:53 -0000
@@ -623,7 +623,7 @@
make_n_fresh_vars("HeadVar__", PredArity, HeadVars, VarSet0, VarSet),
construct_pred_or_func_call(invalid_pred_id, PredOrFunc,
InstancePredName, HeadVars, GoalInfo, IntroducedGoal, !QualInfo),
- IntroducedClause = clause([], IntroducedGoal, impl_lang_mercury,
+ IntroducedClause = clause(all_modes, IntroducedGoal, impl_lang_mercury,
Context),
map.init(TVarNameMap),
@@ -633,11 +633,13 @@
rtti_varmaps_init(RttiVarMaps),
HasForeignClauses = no,
ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap, VarTypes,
- HeadVarVec, ClausesRep, RttiVarMaps, HasForeignClauses)
+ HeadVarVec, ClausesRep, init_clause_item_numbers_comp_gen,
+ RttiVarMaps, HasForeignClauses)
;
% Handle the arbitrary clauses syntax.
InstanceProcDefn = instance_proc_def_clauses(InstanceClauses),
- clauses_info_init(PredOrFunc, PredArity, ClausesInfo0),
+ clauses_info_init(PredOrFunc, PredArity,
+ init_clause_item_numbers_comp_gen, ClausesInfo0),
list.foldl4(
produce_instance_method_clause(PredOrFunc, Context, Status),
InstanceClauses, !ModuleInfo, !QualInfo,
@@ -664,18 +666,19 @@
HeadTerms = expand_bang_state_var_args(HeadTerms0),
PredArity = list.length(HeadTerms),
adjust_func_arity(PredOrFunc, Arity, PredArity),
- % The tvarset argument is only used for explicit type
- % qualifications, of which there are none in this
- % clause, so it is set to a dummy value.
+ % TVarSet0 is only used for explicit type qualifications, of which
+ % there are none in this clause, so this dummy value should be ok.
varset.init(TVarSet0),
+ % AllProcIds is only used when the predicate has foreign procs,
+ % which the instance method pred should not have, so this dummy value
+ % should be ok.
+ AllProcIds = [],
- ProcIds = [],
- % Means this clause applies to _every_ mode of the procedure.
GoalType = goal_type_none, % goal is not a promise
- clauses_info_add_clause(ProcIds, CVarSet, TVarSet0, HeadTerms,
- Body, Context, Status, PredOrFunc, Arity, GoalType, Goal,
- VarSet, _TVarSet, !ClausesInfo, Warnings, !ModuleInfo,
- !QualInfo, !Specs),
+ clauses_info_add_clause(all_modes, AllProcIds, CVarSet, TVarSet0,
+ HeadTerms, Body, Context, no, Status, PredOrFunc, Arity,
+ GoalType, Goal, VarSet, _TVarSet, !ClausesInfo, Warnings,
+ !ModuleInfo, !QualInfo, !Specs),
SimpleCallId = simple_call_id(PredOrFunc, PredName, Arity),
Index: compiler/add_clause.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_clause.m,v
retrieving revision 1.56
diff -u -b -r1.56 add_clause.m
--- compiler/add_clause.m 14 Aug 2009 20:37:45 -0000 1.56
+++ compiler/add_clause.m 17 Aug 2009 06:46:25 -0000
@@ -25,14 +25,14 @@
:- pred module_add_clause(prog_varset::in, pred_or_func::in, sym_name::in,
list(prog_term)::in, goal::in, import_status::in, prog_context::in,
- goal_type::in, module_info::in, module_info::out,
+ maybe(int)::in, goal_type::in, module_info::in, module_info::out,
qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-:- pred clauses_info_add_clause(list(proc_id)::in,
+:- pred clauses_info_add_clause(clause_applicable_modes::in, list(proc_id)::in,
prog_varset::in, tvarset::in, list(prog_term)::in, goal::in,
- prog_context::in, import_status::in, pred_or_func::in, arity::in,
- goal_type::in, hlds_goal::out, prog_varset::out, tvarset::out,
+ prog_context::in, maybe(int)::in, import_status::in, pred_or_func::in,
+ arity::in, goal_type::in, hlds_goal::out, prog_varset::out, tvarset::out,
clauses_info::in, clauses_info::out, list(quant_warning)::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
@@ -94,7 +94,7 @@
%-----------------------------------------------------------------------------%
module_add_clause(ClauseVarSet, PredOrFunc, PredName, Args0, Body, Status,
- Context, GoalType, !ModuleInfo, !QualInfo, !Specs) :-
+ Context, MaybeSeqNum, GoalType, !ModuleInfo, !QualInfo, !Specs) :-
( illegal_state_var_func_result(PredOrFunc, Args0, SVar) ->
IllegalSVarResult = yes(SVar)
;
@@ -150,12 +150,12 @@
map.lookup(Preds0, PredId, !:PredInfo),
trace [io(!IO)] (
- globals.io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
+ module_info_get_globals(!.ModuleInfo, Globals),
+ globals.lookup_bool_option(Globals, very_verbose, VeryVerbose),
(
VeryVerbose = yes,
pred_info_get_clauses_info(!.PredInfo, MsgClauses),
- NumClauses =
- num_clauses_in_clauses_rep(MsgClauses ^ clauses_rep),
+ NumClauses = num_clauses_in_clauses_rep(MsgClauses ^ cli_rep),
io.format("%% Processing clause %d for ", [i(NumClauses + 1)],
!IO),
write_pred_or_func(PredOrFunc, !IO),
@@ -232,10 +232,11 @@
maybe_add_default_func_mode(!PredInfo, _),
select_applicable_modes(Args, ClauseVarSet, Status, Context,
PredId, !.PredInfo, ArgTerms, ProcIdsForThisClause,
- !ModuleInfo, !QualInfo, !Specs),
- clauses_info_add_clause(ProcIdsForThisClause, ClauseVarSet,
- TVarSet0, ArgTerms, Body, Context, Status, PredOrFunc,
- Arity, GoalType, Goal, VarSet, TVarSet, Clauses0, Clauses,
+ AllProcIds, !ModuleInfo, !QualInfo, !Specs),
+ clauses_info_add_clause(ProcIdsForThisClause, AllProcIds,
+ ClauseVarSet, TVarSet0, ArgTerms, Body,
+ Context, MaybeSeqNum, Status, PredOrFunc, Arity,
+ GoalType, Goal, VarSet, TVarSet, Clauses0, Clauses,
Warnings, !ModuleInfo, !QualInfo, !Specs),
pred_info_set_clauses_info(Clauses, !PredInfo),
( GoalType = goal_type_promise(PromiseType) ->
@@ -284,21 +285,21 @@
%
:- pred select_applicable_modes(list(prog_term)::in, prog_varset::in,
import_status::in, prog_context::in, pred_id::in, pred_info::in,
- list(prog_term)::out, list(proc_id)::out,
+ list(prog_term)::out, clause_applicable_modes::out, list(proc_id)::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
select_applicable_modes(Args0, VarSet, Status, Context, PredId, PredInfo,
- Args, ProcIds, !ModuleInfo, !QualInfo, !Specs) :-
+ Args, ApplProcIds, AllProcIds, !ModuleInfo, !QualInfo, !Specs) :-
+ AllProcIds = pred_info_all_procids(PredInfo),
get_mode_annotations(Args0, Args, empty, ModeAnnotations),
(
ModeAnnotations = modes(ModeList0),
% The user specified some mode annotations on this clause.
- % First module-qualify the mode annotations. The annotations
- % on clauses from `.opt' files will already be fully module
- % qualified.
- %
+ % First module-qualify the mode annotations. The annotations on
+ % clauses from `.opt' files will already be fully module qualified.
+
( Status = status_opt_imported ->
ModeList = ModeList0
;
@@ -315,35 +316,25 @@
get_procedure_matching_declmodes_with_renaming(ExistingProcs,
ModeList, !.ModuleInfo, ProcId)
->
- ProcIds = [ProcId]
+ ApplProcIds = selected_modes([ProcId])
;
undeclared_mode_error(ModeList, VarSet, PredId, PredInfo,
!.ModuleInfo, Context, !Specs),
- % apply the clause to all modes
- % XXX would it be better to apply it to none?
- ProcIds = pred_info_all_procids(PredInfo)
- )
- ;
- ModeAnnotations = empty,
- ( pred_info_pragma_goal_type(PredInfo) ->
- % We are only allowed to mix foreign procs and
- % mode specific clauses, so make this clause
- % mode specific but apply to all modes.
- ProcIds = pred_info_all_procids(PredInfo)
- ;
- % this means the clauses applies to all modes
- ProcIds = []
+ % Apply the clause to all modes.
+ % XXX Would it be better to apply it to none?
+ ApplProcIds = selected_modes(AllProcIds)
)
;
- ModeAnnotations = none,
+ ( ModeAnnotations = empty
+ ; ModeAnnotations = none
+ ),
( pred_info_pragma_goal_type(PredInfo) ->
% We are only allowed to mix foreign procs and
% mode specific clauses, so make this clause
% mode specific but apply to all modes.
- ProcIds = pred_info_all_procids(PredInfo)
+ ApplProcIds = selected_modes(AllProcIds)
;
- % this means the clauses applies to all modes
- ProcIds = []
+ ApplProcIds = all_modes
)
;
ModeAnnotations = mixed,
@@ -357,7 +348,7 @@
% Apply the clause to all modes.
% XXX Would it be better to apply it to none?
- ProcIds = pred_info_all_procids(PredInfo)
+ ApplProcIds = selected_modes(AllProcIds)
).
:- pred undeclared_mode_error(list(mer_mode)::in, prog_varset::in,
@@ -471,11 +462,12 @@
MaybeAnnotation = no
).
-clauses_info_add_clause(ModeIds0, CVarSet, TVarSet0, Args, Body, Context,
- Status, PredOrFunc, Arity, GoalType, Goal, VarSet, TVarSet,
- !ClausesInfo, Warnings, !ModuleInfo, !QualInfo, !Specs) :-
+clauses_info_add_clause(ApplModeIds0, AllModeIds, CVarSet, TVarSet0,
+ Args, Body, Context, MaybeSeqNum, Status, PredOrFunc, Arity,
+ GoalType, Goal, VarSet, TVarSet, !ClausesInfo, Warnings,
+ !ModuleInfo, !QualInfo, !Specs) :-
!.ClausesInfo = clauses_info(VarSet0, ExplicitVarTypes0,
- TVarNameMap0, InferredVarTypes, HeadVars, ClausesRep0,
+ TVarNameMap0, InferredVarTypes, HeadVars, ClausesRep0, ItemNumbers0,
RttiVarMaps, HasForeignClauses),
IsEmpty = clause_list_is_empty(ClausesRep0),
(
@@ -518,28 +510,45 @@
get_clause_list_any_order(ClausesRep0, AnyOrderClauseList),
ForeignModeIds = list.condense(list.filter_map(
(func(C) = ProcIds is semidet :-
- C = clause(ProcIds, _, ClauseLang, _),
- not ClauseLang = impl_lang_mercury
+ C = clause(ApplProcIds, _, ClauseLang, _),
+ ClauseLang = impl_lang_foreign(_),
+ (
+ ApplProcIds = all_modes,
+ unexpected(this_file,
+ "clauses_info_add_clause: all_modes foreign_proc")
+ ;
+ ApplProcIds = selected_modes(ProcIds)
+ )
),
AnyOrderClauseList)),
+ (
+ ApplModeIds0 = all_modes,
+ ModeIds0 = AllModeIds
+ ;
+ ApplModeIds0 = selected_modes(ModeIds0)
+ ),
ModeIds = list.delete_elems(ModeIds0, ForeignModeIds),
(
ModeIds = [],
ClausesRep = ClausesRep0
;
ModeIds = [_ | _],
- Clause = clause(ModeIds, Goal, impl_lang_mercury, Context),
+ ApplicableModeIds = selected_modes(ModeIds),
+ Clause = clause(ApplicableModeIds, Goal, impl_lang_mercury,
+ Context),
add_clause(Clause, ClausesRep0, ClausesRep)
)
;
HasForeignClauses = no,
- Clause = clause(ModeIds0, Goal, impl_lang_mercury, Context),
+ Clause = clause(ApplModeIds0, Goal, impl_lang_mercury, Context),
add_clause(Clause, ClausesRep0, ClausesRep)
),
qual_info_get_var_types(!.QualInfo, ExplicitVarTypes),
+ add_clause_item_number(MaybeSeqNum, Context, item_is_clause,
+ ItemNumbers0, ItemNumbers),
!:ClausesInfo = clauses_info(VarSet, ExplicitVarTypes, TVarNameMap,
- InferredVarTypes, HeadVars, ClausesRep, RttiVarMaps,
- HasForeignClauses)
+ InferredVarTypes, HeadVars, ClausesRep, ItemNumbers,
+ RttiVarMaps, HasForeignClauses)
).
:- pred add_clause_transform(prog_var_renaming::in,
Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.94
diff -u -b -r1.94 add_pragma.m
--- compiler/add_pragma.m 14 Aug 2009 20:37:46 -0000 1.94
+++ compiler/add_pragma.m 17 Aug 2009 06:46:25 -0000
@@ -96,7 +96,7 @@
:- pred module_add_pragma_foreign_proc(pragma_foreign_proc_attributes::in,
sym_name::in, pred_or_func::in, list(pragma_var)::in, prog_varset::in,
inst_varset::in, pragma_foreign_code_impl::in, import_status::in,
- prog_context::in, module_info::in, module_info::out,
+ prog_context::in, maybe(int)::in, module_info::in, module_info::out,
qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
@@ -458,8 +458,8 @@
prog_context::in, module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-add_pragma_foreign_export_2(Arity, PredTable, Origin, Lang, Name, PredId, Modes,
- ExportedName, Context, !ModuleInfo, !Specs) :-
+add_pragma_foreign_export_2(Arity, PredTable, Origin, Lang, Name, PredId,
+ Modes, ExportedName, Context, !ModuleInfo, !Specs) :-
predicate_table_get_preds(PredTable, Preds),
map.lookup(Preds, PredId, PredInfo),
pred_info_get_procedures(PredInfo, Procs),
@@ -513,8 +513,7 @@
% Only add the foreign export if the specified language matches
% one of the foreign languages available for this backend.
module_info_get_globals(!.ModuleInfo, Globals),
- globals.get_backend_foreign_languages(Globals,
- ForeignLanguages),
+ globals.get_backend_foreign_languages(Globals, ForeignLanguages),
(
% XXX C# exports currently cause an
% assertion failure in the MLDS->IL code generator.
@@ -1495,7 +1494,7 @@
SubstOk = yes(RenamedSubst),
pred_info_get_procedures(PredInfo0, Procs0),
handle_pragma_type_spec_modes(SymName, Arity, Context, MaybeModes,
- ProcIds, Procs0, Procs1, ModesOk, !ModuleInfo, !Specs),
+ MaybeProcIds, Procs0, Procs1, !ModuleInfo, !Specs),
% Remove any imported structure sharing and reuse information for the
% original procedure as they won't be (directly) applicable.
map.map_values(reset_imported_structure_sharing_reuse, Procs1, Procs),
@@ -1504,7 +1503,7 @@
DoTypeSpec),
globals.lookup_bool_option(Globals, smart_recompilation, Smart),
(
- ModesOk = yes,
+ MaybeProcIds = yes(ProcIds),
% Even if we aren't doing type specialization, we need to create
% the interface procedures for local predicates to check the
% type-class correctness of the requested specializations.
@@ -1548,15 +1547,17 @@
% is done.
do_construct_pred_or_func_call(PredId, PredOrFunc,
SymName, Args, GoalInfo, Goal),
- Clause = clause(ProcIds, Goal, impl_lang_mercury, Context),
+ Clause = clause(selected_modes(ProcIds), Goal, impl_lang_mercury,
+ Context),
map.init(TVarNameMap),
ArgsVec = proc_arg_vector_init(PredOrFunc, Args),
set_clause_list([Clause], ClausesRep),
rtti_varmaps_init(RttiVarMaps),
HasForeignClauses = no,
Clauses = clauses_info(ArgVarSet, VarTypes0, TVarNameMap,
- VarTypes0, ArgsVec, ClausesRep, RttiVarMaps,
- HasForeignClauses),
+ VarTypes0, ArgsVec, ClausesRep,
+ init_clause_item_numbers_comp_gen,
+ RttiVarMaps, HasForeignClauses),
pred_info_get_markers(PredInfo0, Markers0),
add_marker(marker_calls_are_fully_qualified, Markers0, Markers),
map.init(Proofs),
@@ -1852,13 +1853,13 @@
% specifies a known procedure.
%
:- pred handle_pragma_type_spec_modes(sym_name::in, arity::in,
- prog_context::in, maybe(list(mer_mode))::in, list(proc_id)::out,
- proc_table::in, proc_table::out, bool::out,
+ prog_context::in, maybe(list(mer_mode))::in,
+ maybe(list(proc_id))::out, proc_table::in, proc_table::out,
module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-handle_pragma_type_spec_modes(SymName, Arity, Context, MaybeModes, ProcIds,
- !Procs, ModesOk, !ModuleInfo, !Specs) :-
+handle_pragma_type_spec_modes(SymName, Arity, Context, MaybeModes,
+ MaybeProcIds, !Procs, !ModuleInfo, !Specs) :-
(
MaybeModes = yes(Modes),
map.to_assoc_list(!.Procs, ExistingProcs),
@@ -1869,18 +1870,17 @@
map.lookup(!.Procs, ProcId, ProcInfo),
map.det_insert(map.init, ProcId, ProcInfo, !:Procs),
ProcIds = [ProcId],
- ModesOk = yes
+ MaybeProcIds = yes(ProcIds)
;
- ProcIds = [],
module_info_incr_errors(!ModuleInfo),
undefined_mode_error(SymName, Arity, Context,
"`:- pragma type_spec' declaration", !Specs),
- ModesOk = no
+ MaybeProcIds = no
)
;
MaybeModes = no,
map.keys(!.Procs, ProcIds),
- ModesOk = yes
+ MaybeProcIds = yes(ProcIds)
).
:- pred reset_imported_structure_sharing_reuse(proc_id::in,
@@ -2236,25 +2236,30 @@
% Lookup some information we need from the pred_info and proc_info.
PredName = pred_info_name(!.PredInfo),
PredModule = pred_info_module(!.PredInfo),
- pred_info_get_clauses_info(!.PredInfo, Clauses0),
pred_info_get_purity(!.PredInfo, Purity),
pred_info_get_markers(!.PredInfo, Markers),
+ pred_info_get_clauses_info(!.PredInfo, ClausesInfo0),
+ ItemNumbers0 = ClausesInfo0 ^ cli_item_numbers,
+ add_clause_item_number(no, Context, item_is_foreign_proc,
+ ItemNumbers0, ItemNumbers),
+ ClausesInfo1 = ClausesInfo0 ^ cli_item_numbers := ItemNumbers,
+
% Add the code for this `pragma import' to the clauses_info.
clauses_info_add_pragma_foreign_proc(pragma_import_foreign_proc,
Purity, Attributes, PredId, ProcId,
- VarSet, PragmaVars, ArgTypes, PragmaImpl, Context, PredOrFunc,
- qualified(PredModule, PredName), Arity, Markers, Clauses0, Clauses,
- !ModuleInfo, !Specs),
+ VarSet, PragmaVars, ArgTypes, PragmaImpl, Context,
+ PredOrFunc, qualified(PredModule, PredName), Arity, Markers,
+ ClausesInfo1, ClausesInfo, !ModuleInfo, !Specs),
% Store the clauses_info etc. back into the pred_info.
- pred_info_set_clauses_info(Clauses, !PredInfo).
+ pred_info_set_clauses_info(ClausesInfo, !PredInfo).
%-----------------------------------------------------------------------------%
module_add_pragma_foreign_proc(Attributes0, PredName, PredOrFunc, PVars,
- ProgVarSet, _InstVarset, PragmaImpl, Status, Context, !ModuleInfo,
- !QualInfo, !Specs) :-
+ ProgVarSet, _InstVarset, PragmaImpl, Status, Context, MaybeItemNumber,
+ !ModuleInfo, !QualInfo, !Specs) :-
% Begin by replacing any maybe_thread_safe foreign_proc attributes
% with the actual thread safety attributes which we get from the
% `--maybe-thread-safe' option.
@@ -2316,7 +2321,6 @@
predicate_table_get_preds(PredTable1, Preds0),
some [!PredInfo] (
map.lookup(Preds0, PredId, !:PredInfo),
- PredInfo0 = !.PredInfo,
% status_opt_imported preds are initially tagged as status_imported
% and are tagged as status_opt_imported only if/when we see a clause
@@ -2326,31 +2330,21 @@
;
true
),
- (
- % If this procedure was previously defined as clauses only
- % then we need to turn all the non mode-specific clauses
- % into mode-specific clauses.
- pred_info_clause_goal_type(!.PredInfo)
- ->
- pred_info_get_clauses_info(!.PredInfo, CInfo0),
- clauses_info_clauses_only(CInfo0, ClauseList0),
- ClauseList = list.map(
- (func(C) = Res :-
- AllProcIds = pred_info_all_procids(!.PredInfo),
- ( C = clause([], Goal, impl_lang_mercury, Ctxt) ->
- Res = clause(AllProcIds, Goal, impl_lang_mercury, Ctxt)
- ;
- Res = C
- )
- ), ClauseList0),
- clauses_info_set_clauses(ClauseList, CInfo0, CInfo),
- pred_info_set_clauses_info(CInfo, !PredInfo)
- ;
- true
- ),
+
+ % Record the existence of this "clause".
+ pred_info_get_clauses_info(!.PredInfo, ClausesInfo0),
+ ItemNumbers0 = ClausesInfo0 ^ cli_item_numbers,
+ add_clause_item_number(MaybeItemNumber, Context, item_is_foreign_proc,
+ ItemNumbers0, ItemNumbers),
+ ClausesInfo1 = ClausesInfo0 ^ cli_item_numbers := ItemNumbers,
+ pred_info_set_clauses_info(ClausesInfo1, !PredInfo),
+ module_info_set_pred_info(PredId, !.PredInfo, !ModuleInfo),
+
+ PredInfo0 = !.PredInfo,
+
CurrentBackend = lookup_current_backend(Globals),
- (
ExtraAttrs = get_extra_attributes(Attributes),
+ (
is_applicable_for_current_backend(CurrentBackend, ExtraAttrs) = no
->
% Ignore this foreign_proc.
@@ -2394,15 +2388,15 @@
get_procedure_matching_declmodes_with_renaming(ExistingProcs,
Modes, !.ModuleInfo, ProcId)
->
- pred_info_get_clauses_info(!.PredInfo, Clauses0),
pred_info_get_arg_types(!.PredInfo, ArgTypes),
pred_info_get_purity(!.PredInfo, Purity),
pred_info_get_markers(!.PredInfo, Markers),
clauses_info_add_pragma_foreign_proc(standard_foreign_proc,
Purity, Attributes, PredId, ProcId, ProgVarSet, PVars,
- ArgTypes, PragmaImpl, Context, PredOrFunc, PredName,
- Arity, Markers, Clauses0, Clauses, !ModuleInfo, !Specs),
- pred_info_set_clauses_info(Clauses, !PredInfo),
+ ArgTypes, PragmaImpl, Context, PredOrFunc,
+ PredName, Arity, Markers, ClausesInfo1, ClausesInfo,
+ !ModuleInfo, !Specs),
+ pred_info_set_clauses_info(ClausesInfo, !PredInfo),
pred_info_update_goal_type(goal_type_foreign, !PredInfo),
map.det_update(Preds0, PredId, !.PredInfo, Preds),
predicate_table_set_preds(Preds, PredTable1, PredTable),
@@ -3214,9 +3208,10 @@
% Fact tables procedures should be considered pure.
set_purity(purity_pure, Attrs2, Attrs3),
add_extra_attribute(refers_to_llds_stack, Attrs3, Attrs),
+ MaybeItemNumber = no,
module_add_pragma_foreign_proc(Attrs, SymName, PredOrFunc, PragmaVars,
ProgVarSet, InstVarSet, fc_impl_ordinary(C_ProcCode, no), Status,
- Context, !ModuleInfo, !QualInfo, !Specs),
+ Context, MaybeItemNumber, !ModuleInfo, !QualInfo, !Specs),
( C_ExtraCode = "" ->
true
;
@@ -3266,15 +3261,15 @@
:- pred clauses_info_add_pragma_foreign_proc(foreign_proc_origin::in,
purity::in, pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
prog_varset::in, list(pragma_var)::in, list(mer_type)::in,
- pragma_foreign_code_impl::in, prog_context::in, pred_or_func::in,
- sym_name::in, arity::in, pred_markers::in,
+ pragma_foreign_code_impl::in, prog_context::in,
+ pred_or_func::in, sym_name::in, arity::in, pred_markers::in,
clauses_info::in, clauses_info::out, module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
clauses_info_add_pragma_foreign_proc(Origin, Purity, Attributes0,
PredId, ProcId, PVarSet, PVars, OrigArgTypes, PragmaImpl0,
- Context, PredOrFunc, PredName, Arity, Markers, !ClausesInfo,
- !ModuleInfo, !Specs) :-
+ Context, PredOrFunc, PredName, Arity, Markers,
+ !ClausesInfo, !ModuleInfo, !Specs) :-
module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
( pred_info_is_builtin(PredInfo) ->
% When bootstrapping a change that redefines a builtin as
@@ -3284,28 +3279,31 @@
Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs]
;
+ AllProcIds = pred_info_all_procids(PredInfo),
clauses_info_do_add_pragma_foreign_proc(Origin, Purity, Attributes0,
- PredId, ProcId, PVarSet, PVars, OrigArgTypes, PragmaImpl0,
- Context, PredOrFunc, PredName, Arity, Markers, !ClausesInfo,
- !ModuleInfo, !Specs)
+ PredId, ProcId, AllProcIds, PVarSet, PVars, OrigArgTypes,
+ PragmaImpl0, Context, PredOrFunc, PredName, Arity,
+ Markers, !ClausesInfo, !ModuleInfo, !Specs)
).
:- pred clauses_info_do_add_pragma_foreign_proc(foreign_proc_origin::in,
purity::in, pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
- prog_varset::in, list(pragma_var)::in, list(mer_type)::in,
- pragma_foreign_code_impl::in, prog_context::in, pred_or_func::in,
- sym_name::in, arity::in, pred_markers::in,
+ list(proc_id)::in, prog_varset::in, list(pragma_var)::in,
+ list(mer_type)::in, pragma_foreign_code_impl::in, prog_context::in,
+ pred_or_func::in, sym_name::in, arity::in, pred_markers::in,
clauses_info::in, clauses_info::out, module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
clauses_info_do_add_pragma_foreign_proc(Origin, Purity, Attributes0,
- PredId, ProcId, PVarSet, PVars, OrigArgTypes, PragmaImpl0,
- Context, PredOrFunc, PredName, Arity, Markers, !ClausesInfo,
- !ModuleInfo, !Specs) :-
+ PredId, ProcId, AllProcIds, PVarSet, PVars, OrigArgTypes, PragmaImpl0,
+ Context, PredOrFunc, PredName, Arity, Markers,
+ !ClausesInfo, !ModuleInfo, !Specs) :-
+ % Our caller should have already added this foreign_proc to ItemNumbers.
!.ClausesInfo = clauses_info(VarSet0, ExplicitVarTypes, TVarNameMap,
- InferredVarTypes, HeadVars, ClauseRep, RttiVarMaps,
- _HasForeignClauses),
- get_clause_list(ClauseRep, ClauseList),
+ InferredVarTypes, HeadVars, ClauseRep, ItemNumbers,
+ RttiVarMaps, _HasForeignClauses),
+
+ get_clause_list(ClauseRep, Clauses),
% Find all the existing clauses for this mode, and extract their
% implementation language and clause number (that is, their index
@@ -3313,10 +3311,9 @@
module_info_get_globals(!.ModuleInfo, Globals),
globals.get_target(Globals, Target),
NewLang = get_foreign_language(Attributes0),
- list.foldl3(
- decide_action(PredName, Arity, PredOrFunc, Context, Globals,
- Target, NewLang, ProcId),
- ClauseList, add, FinalAction, 1, _, !Specs),
+ add_foreign_proc_update_existing_clauses(PredName, Arity, PredOrFunc,
+ Context, Globals, Target, NewLang, AllProcIds, ProcId,
+ Clauses, NewClauses0, Overridden, !Specs),
globals.get_backend_foreign_languages(Globals, BackendForeignLanguages),
pragma_get_vars(PVars, Args0),
@@ -3328,7 +3325,7 @@
PVars, PredName, PredOrFunc, Context, !ModuleInfo,
Attributes0, Attributes1, PragmaImpl0, PragmaImpl),
- % Check for arguments occurring multiple times.
+ % Check for arguments occurring more than once.
bag.init(ArgBag0),
bag.insert_list(ArgBag0, Args0, ArgBag),
bag.to_assoc_list(ArgBag, ArgBagAL0),
@@ -3400,7 +3397,13 @@
!:Specs = [Spec | !.Specs]
)
),
- % Put the purity in the goal_info in case this foreign code is inlined.
+ (
+ Overridden = overridden_by_old_foreign_proc
+ ;
+ Overridden = not_overridden_by_old_foreign_proc,
+
+ % Put the purity in the goal_info in case this foreign code is
+ % inlined.
goal_info_set_purity(Purity, GoalInfo1, GoalInfo),
% XXX ARGVEC - the foreign_args field in the hlds_goal_expr type
% should also be a an proc_arg_vector rather than a list.
@@ -3411,36 +3414,23 @@
Args0, HeadVarList, OrigArgTypes, Attributes1, Attributes),
ExtraArgs = [],
MaybeTraceRuntimeCond = no,
- HldsGoal0 = hlds_goal(
- call_foreign_proc(Attributes, PredId, ProcId, ForeignArgs,
- ExtraArgs, MaybeTraceRuntimeCond, PragmaImpl),
- GoalInfo),
+ GoalExpr = call_foreign_proc(Attributes, PredId, ProcId,
+ ForeignArgs, ExtraArgs, MaybeTraceRuntimeCond, PragmaImpl),
+ HldsGoal0 = hlds_goal(GoalExpr, GoalInfo),
map.init(EmptyVarTypes),
rtti_varmaps_init(EmptyRttiVarmaps),
implicitly_quantify_clause_body(HeadVarList, _Warnings,
HldsGoal0, HldsGoal, VarSet0, VarSet, EmptyVarTypes, _,
EmptyRttiVarmaps, _),
- NewClause = clause([ProcId], HldsGoal, impl_lang_foreign(NewLang),
- Context),
- (
- FinalAction = ignore,
- NewClauseList = ClauseList
- ;
- FinalAction = add,
- NewClauseList = [NewClause | ClauseList]
- ;
- FinalAction = replace(N),
- list.replace_nth_det(ClauseList, N, NewClause, NewClauseList)
- ;
- FinalAction = split_add(N, Clause),
- list.replace_nth_det(ClauseList, N, Clause, NewClauseListTail),
- NewClauseList = [NewClause | NewClauseListTail]
- ),
+ NewClause = clause(selected_modes([ProcId]), HldsGoal,
+ impl_lang_foreign(NewLang), Context),
+ NewClauses = [NewClause | NewClauses0],
HasForeignClauses = yes,
- set_clause_list(NewClauseList, NewClauseRep),
+ set_clause_list(NewClauses, NewClauseRep),
!:ClausesInfo = clauses_info(VarSet, ExplicitVarTypes, TVarNameMap,
- InferredVarTypes, HeadVars, NewClauseRep, RttiVarMaps,
- HasForeignClauses)
+ InferredVarTypes, HeadVars, NewClauseRep, ItemNumbers,
+ RttiVarMaps, HasForeignClauses)
+ )
).
% Rename any user annotated structure sharing information from the
@@ -3497,61 +3487,116 @@
CurrentBackend = low_level_backend
).
- % As we traverse the clauses, at each one decide which action to perform.
- %
- % If there are no clauses, we will simply add this clause.
- %
- % If there are matching foreign_proc clauses for this proc_id,
- % we will either replace them or ignore the new clause
- % (depending on the preference of the two foreign languages).
- %
- % If there is a matching Mercury clause for this proc_id, we will either
- % - replace it if there is only one matching mode in its proc_id list.
- % - remove the matching proc_id from its proc_id list, and add this
- % clause as a new clause for this mode.
-
-:- type foreign_proc_action
- ---> ignore
- ; add
- ; split_add(int, clause)
- ; replace(int).
-
-:- pred decide_action(sym_name::in, arity::in, pred_or_func::in,
- prog_context::in, globals::in, compilation_target::in,
- foreign_language::in, proc_id::in, clause::in,
- foreign_proc_action::in, foreign_proc_action::out,
- int::in, int::out, list(error_spec)::in, list(error_spec)::out) is det.
-
-decide_action(PredName, Arity, PredOrFunc, NewContext, Globals,
- Target, NewLang, ProcId, Clause, !Action, !ClauseNum, !Specs) :-
- Clause = clause(ProcIds, Body, ClauseLang, ClauseContext),
+:- type overridden_by_old_foreign_proc
+ ---> overridden_by_old_foreign_proc
+ ; not_overridden_by_old_foreign_proc.
+
+:- pred add_foreign_proc_update_existing_clauses(sym_name::in, arity::in,
+ pred_or_func::in, prog_context::in, globals::in, compilation_target::in,
+ foreign_language::in, list(proc_id)::in, proc_id::in,
+ list(clause)::in, list(clause)::out,
+ overridden_by_old_foreign_proc::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+add_foreign_proc_update_existing_clauses(PredName, Arity, PredOrFunc,
+ NewContext, Globals, Target, NewLang, AllProcIds, NewClauseProcId,
+ Clauses0, Clauses, Overridden, !Specs) :-
+ (
+ Clauses0 = [],
+ Clauses = [],
+ Overridden = not_overridden_by_old_foreign_proc
+ ;
+ Clauses0 = [FirstClause0 | LaterClauses0],
+ add_foreign_proc_update_existing_clauses(PredName, Arity, PredOrFunc,
+ NewContext, Globals, Target, NewLang, AllProcIds, NewClauseProcId,
+ LaterClauses0, LaterClauses, LaterOverridden, !Specs),
+ FirstClause0 = clause(ApplProcIds0, Body, ClauseLang, ClauseContext),
(
ClauseLang = impl_lang_mercury,
- ( ProcIds = [ProcId] ->
- !:Action = replace(!.ClauseNum)
- ; list.delete_first(ProcIds, ProcId, MercuryProcIds) ->
- NewMercuryClause = clause(MercuryProcIds, Body, ClauseLang,
- ClauseContext),
- !:Action = split_add(!.ClauseNum, NewMercuryClause)
+ (
+ ApplProcIds0 = all_modes,
+ ProcIds0 = AllProcIds
;
- true
- )
+ ApplProcIds0 = selected_modes(ProcIds0)
+ ),
+ ( list.delete_first(ProcIds0, NewClauseProcId, ProcIds) ->
+ (
+ ProcIds = [],
+ % This clause is totally overridden by the new
+ % foreign_proc, so delete it.
+ Clauses = LaterClauses
+ ;
+ ProcIds = [_ | _],
+ % This clause is overridden by the new foreign_proc only
+ % in some modes, so mark it as being applicable only in the
+ % remaining modes.
+ FirstClause = clause(selected_modes(ProcIds), Body,
+ ClauseLang, ClauseContext),
+ Clauses = [FirstClause | LaterClauses]
+ )
+ ;
+ % This clause is not applicable to the mode of the new
+ % foreign_proc, so leave it alone.
+ Clauses = [FirstClause0 | LaterClauses]
+ ),
+ % A Mercury clause can never take precedence over a foreign_proc.
+ Overridden = LaterOverridden
;
ClauseLang = impl_lang_foreign(OldLang),
- ( list.member(ProcId, ProcIds) ->
(
- yes = prefer_foreign_language(Globals, Target,
- OldLang, NewLang)
- ->
- % This language is preferred to the old
- % language, so we should replace it
- !:Action = replace(!.ClauseNum)
+ ApplProcIds0 = all_modes,
+ unexpected(this_file,
+ "add_foreign_proc_update_existing_clauses: all_modes")
;
- % Just ignore the clause - if they are both for the same
- % language then we emit an error message as well.
+ ApplProcIds0 = selected_modes(ProcIds0)
+ ),
+ ( list.delete_first(ProcIds0, NewClauseProcId, ProcIds) ->
+ PreferNewForeignLang = prefer_foreign_language(Globals, Target,
+ OldLang, NewLang),
+ (
+ PreferNewForeignLang = yes,
+ (
+ ProcIds = [],
+ % The language of the new foreign_proc is preferred
+ % to the language of the old foreign_proc,
+ % so we should replace the old foreign_proc.
+ Clauses = LaterClauses,
+ Overridden = LaterOverridden
+ ;
+ ProcIds = [_ | _],
+ % The language of the new foreign_proc is preferred
+ % to the language of the old foreign_proc,
+ % but the old foreign_proc is still applicable
+ % in some modes, so we keep it in those modes.
+ %
+ % XXX This should not happen.
+ FirstClause = clause(selected_modes(ProcIds), Body,
+ ClauseLang, ClauseContext),
+ Clauses = [FirstClause | LaterClauses],
+ Overridden = LaterOverridden
+ ),
+ % Any later clause that overrides the new foreign_proc
+ % should have overridden this old foreign_proc as well.
+ expect(
+ unify(LaterOverridden,
+ not_overridden_by_old_foreign_proc),
+ this_file,
+ "inconsistent old foreign_procs")
+ ;
+ PreferNewForeignLang = no,
+ % We prefer the old foreign_proc to the new one,
+ % so keep the old one and tell our caller to ignore
+ % the new one.
+ Clauses = [FirstClause0 | LaterClauses],
+ Overridden = overridden_by_old_foreign_proc,
+
+ % However, if the old and the new foreign_procs are
+ % in the same language, then we emit an error message
+ % as well.
% XXX This won't detect multiple clauses in languages
- % that are not supported by this backend.
- !:Action = ignore,
+ % that are not supported by this backend, since we filter
+ % out foreign_procs in such languages way before we get
+ % here.
( OldLang = NewLang ->
PiecesA = [
words("Error: multiple clauses for"),
@@ -3575,10 +3620,13 @@
)
)
;
- true
+ % This old foreign_proc is not overridden by the new one,
+ % so leave it alone.
+ Clauses = [FirstClause0 | LaterClauses],
+ Overridden = LaterOverridden
)
- ),
- !:ClauseNum = !.ClauseNum + 1.
+ )
+ ).
% Find the procedure with argmodes which match the ones we want.
%
@@ -3662,14 +3710,13 @@
inst_var_renamings::in, inst_var_renamings::out,
module_info::in) is semidet.
- mode_list_matches_with_renaming_2([], [], !Renaming, _).
- mode_list_matches_with_renaming_2([ModeA | ModesA], [ModeB | ModesB],
+mode_list_matches_with_renaming_2([], [], !Renaming, _).
+mode_list_matches_with_renaming_2([ModeA | ModesA], [ModeB | ModesB],
!Substs, ModuleInfo) :-
- %
% We use mode_get_insts_semidet instead of mode_get_insts to avoid
% aborting if there are undefined modes. (Undefined modes get
% reported later).
- %
+
mode_get_insts_semidet(ModuleInfo, ModeA, InstAInitial, InstAFinal),
mode_get_insts_semidet(ModuleInfo, ModeB, InstBInitial, InstBFinal),
match_insts_with_renaming(ModuleInfo, InstAInitial, InstBInitial,
Index: compiler/add_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pred.m,v
retrieving revision 1.38
diff -u -b -r1.38 add_pred.m
--- compiler/add_pred.m 11 Jun 2009 07:00:06 -0000 1.38
+++ compiler/add_pred.m 10 Aug 2009 20:20:11 -0000
@@ -176,7 +176,8 @@
;
PredName = qualified(MNameOfPred, PName),
module_info_get_predicate_table(!.ModuleInfo, PredTable0),
- clauses_info_init(PredOrFunc, Arity, ClausesInfo),
+ clauses_info_init(PredOrFunc, Arity, init_clause_item_numbers_user,
+ ClausesInfo),
map.init(Proofs),
map.init(ConstraintMap),
purity_to_markers(Purity, PurityMarkers),
@@ -338,7 +339,7 @@
Stub = no,
% Construct a clause containing that pseudo-recursive call.
Goal = hlds_goal(GoalExpr, GoalInfo),
- Clause = clause([], Goal, impl_lang_mercury, Context),
+ Clause = clause(all_modes, Goal, impl_lang_mercury, Context),
set_clause_list([Clause], ClausesRep)
;
Stub = yes,
@@ -353,7 +354,8 @@
rtti_varmaps_init(RttiVarMaps),
HasForeignClauses = no,
ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap, VarTypes,
- HeadVars, ClausesRep, RttiVarMaps, HasForeignClauses),
+ HeadVars, ClausesRep, init_clause_item_numbers_comp_gen,
+ RttiVarMaps, HasForeignClauses),
pred_info_set_clauses_info(ClausesInfo, !PredInfo),
% It's pointless but harmless to inline these clauses. The main purpose
@@ -492,7 +494,8 @@
preds_add_implicit(ModuleInfo, ModuleName, PredName, Arity, Status, Context,
Origin, PredOrFunc, PredId, !PredicateTable) :-
- clauses_info_init(PredOrFunc, Arity, ClausesInfo),
+ clauses_info_init(PredOrFunc, Arity, init_clause_item_numbers_user,
+ ClausesInfo),
preds_add_implicit_2(ClausesInfo, ModuleInfo, ModuleName, PredName,
Arity, Status, Context, Origin, PredOrFunc, PredId, !PredicateTable).
Index: compiler/add_special_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_special_pred.m,v
retrieving revision 1.26
diff -u -b -r1.26 add_special_pred.m
--- compiler/add_special_pred.m 21 Jul 2008 03:10:06 -0000 1.26
+++ compiler/add_special_pred.m 10 Aug 2009 20:20:27 -0000
@@ -383,7 +383,8 @@
% XXX we probably shouldn't hardcode this as predicate but since
% all current special_preds are predicates at the moment it doesn't
% matter.
- clauses_info_init(pf_predicate, Arity, ClausesInfo0),
+ clauses_info_init(pf_predicate, Arity, init_clause_item_numbers_comp_gen,
+ ClausesInfo0),
Origin = origin_special_pred(SpecialPredId - TypeCtor),
adjust_special_pred_status(SpecialPredId, Status0, Status),
map.init(Proofs),
Index: compiler/assertion.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/assertion.m,v
retrieving revision 1.66
diff -u -b -r1.66 assertion.m
--- compiler/assertion.m 11 Jun 2009 07:00:06 -0000 1.66
+++ compiler/assertion.m 10 Aug 2009 05:30:57 -0000
@@ -441,7 +441,8 @@
assertion_table_lookup(AssertTable, AssertId, PredId),
module_info_pred_info(Module, PredId, PredInfo),
pred_info_get_clauses_info(PredInfo, ClausesInfo),
- clauses_info_clauses_only(ClausesInfo, Clauses),
+ clauses_info_get_clauses_rep(ClausesInfo, ClausesRep, _ItemNumbers),
+ get_clause_list(ClausesRep, Clauses),
( Clauses = [clause(_ProcIds, Goal0, _Lang, _Context)] ->
normalise_goal(Goal0, Goal)
;
Index: compiler/build_mode_constraints.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/build_mode_constraints.m,v
retrieving revision 1.35
diff -u -b -r1.35 build_mode_constraints.m
--- compiler/build_mode_constraints.m 4 Jun 2009 04:39:19 -0000 1.35
+++ compiler/build_mode_constraints.m 10 Aug 2009 04:55:17 -0000
@@ -354,7 +354,8 @@
!Constraints) :-
pred_info_get_clauses_info(PredInfo, ClausesInfo),
clauses_info_get_headvars(ClausesInfo, HeadVars),
- clauses_info_clauses_only(ClausesInfo, Clauses),
+ clauses_info_get_clauses_rep(ClausesInfo, ClausesRep, _ItemNumbers),
+ get_clause_list(ClausesRep, Clauses),
clauses_info_get_varset(ClausesInfo, ProgVarset),
(
@@ -362,7 +363,7 @@
% to produce constraints for.
Clauses = []
;
- Clauses = [FirstClause|_],
+ Clauses = [FirstClause | _],
% Use the first clause for the context of the top level
% goal constraints.
Index: compiler/clause_to_proc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/clause_to_proc.m,v
retrieving revision 1.82
diff -u -b -r1.82 clause_to_proc.m
--- compiler/clause_to_proc.m 27 Feb 2008 07:23:03 -0000 1.82
+++ compiler/clause_to_proc.m 10 Aug 2009 17:14:53 -0000
@@ -139,7 +139,8 @@
copy_module_clauses_to_procs(PredIds, !ModuleInfo) :-
module_info_preds(!.ModuleInfo, PredTable0),
- list.foldl(copy_pred_clauses_to_procs, PredIds, PredTable0, PredTable),
+ list.foldl(copy_pred_clauses_to_procs_if_needed, PredIds,
+ PredTable0, PredTable),
module_info_set_preds(PredTable, !ModuleInfo).
% For each mode of the given predicate, copy the clauses relevant
@@ -148,23 +149,21 @@
% This is not the only predicate in the compiler that does this task;
% the other is polymorphism.process_proc.
%
-:- pred copy_pred_clauses_to_procs(pred_id::in,
+:- pred copy_pred_clauses_to_procs_if_needed(pred_id::in,
pred_table::in, pred_table::out) is det.
-copy_pred_clauses_to_procs(PredId, !PredTable) :-
+copy_pred_clauses_to_procs_if_needed(PredId, !PredTable) :-
map.lookup(!.PredTable, PredId, PredInfo0),
- (
- do_copy_clauses_to_procs(PredInfo0)
- ->
+ ( should_copy_clauses_to_procs(PredInfo0) ->
copy_clauses_to_procs(PredInfo0, PredInfo),
map.det_update(!.PredTable, PredId, PredInfo, !:PredTable)
;
true
).
-:- pred do_copy_clauses_to_procs(pred_info::in) is semidet.
+:- pred should_copy_clauses_to_procs(pred_info::in) is semidet.
-do_copy_clauses_to_procs(PredInfo) :-
+should_copy_clauses_to_procs(PredInfo) :-
% Don't process typeclass methods, because their proc_infos
% are generated already mode-correct.
pred_info_get_markers(PredInfo, PredMarkers),
@@ -191,11 +190,12 @@
copy_clauses_to_proc(ProcId, ClausesInfo, !Proc) :-
ClausesInfo = clauses_info(VarSet0, _, _, VarTypes, HeadVars,
- ClausesRep, RttiInfo, _),
+ ClausesRep, _ItemNumbers, RttiInfo, _HaveForeignClauses),
get_clause_list(ClausesRep, Clauses),
select_matching_clauses(Clauses, ProcId, MatchingClauses),
get_clause_goals(MatchingClauses, GoalList),
- ( GoalList = [SingleGoal] ->
+ (
+ GoalList = [SingleGoal],
SingleGoal = hlds_goal(SingleExpr, _),
(
SingleExpr = call_foreign_proc(_, _, _, Args, ExtraArgs,
@@ -223,24 +223,23 @@
),
Goal = SingleGoal
;
- VarSet = VarSet0,
-
- % Convert the list of clauses into a disjunction,
- % and construct a goal_info for the disjunction.
-
% We use the context of the first clause, unless there weren't
% any clauses at all, in which case we use the context of the
% mode declaration.
- %
- goal_info_init(GoalInfo0),
(
- GoalList = [FirstGoal | _],
+ GoalList = [FirstGoal, _ | _],
FirstGoal = hlds_goal(_, FirstGoalInfo),
Context = goal_info_get_context(FirstGoalInfo)
;
GoalList = [],
proc_info_get_context(!.Proc, Context)
),
+
+ % Convert the list of clauses into a disjunction,
+ % and construct a goal_info for the disjunction.
+
+ VarSet = VarSet0,
+ goal_info_init(GoalInfo0),
goal_info_set_context(Context, GoalInfo0, GoalInfo1),
% The non-local vars are just the head variables.
@@ -293,20 +292,19 @@
select_matching_clauses([], _, []).
select_matching_clauses([Clause | Clauses], ProcId, MatchingClauses) :-
- Clause = clause(ProcIds, _, _, _),
- % An empty list here means that the clause applies to all procs.
+ select_matching_clauses(Clauses, ProcId, MatchingClausesTail),
+ Clause = clause(ApplicableProcIds, _, _, _),
(
- ProcIds = [],
- MatchingClauses = [Clause | MatchingClauses1]
+ ApplicableProcIds = all_modes,
+ MatchingClauses = [Clause | MatchingClausesTail]
;
- ProcIds = [_ | _],
+ ApplicableProcIds = selected_modes(ProcIds),
( list.member(ProcId, ProcIds) ->
- MatchingClauses = [Clause | MatchingClauses1]
+ MatchingClauses = [Clause | MatchingClausesTail]
;
- MatchingClauses = MatchingClauses1
+ MatchingClauses = MatchingClausesTail
)
- ),
- select_matching_clauses(Clauses, ProcId, MatchingClauses1).
+ ).
:- pred get_clause_goals(list(clause)::in, list(hlds_goal)::out) is det.
@@ -336,7 +334,7 @@
\+ map.is_empty(Subn),
% Only process preds for which we copied clauses to procs.
- do_copy_clauses_to_procs(PredInfo0)
+ should_copy_clauses_to_procs(PredInfo0)
->
pred_info_get_procedures(PredInfo0, Procs0),
ProcIds = pred_info_all_non_imported_procids(PredInfo0),
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.132
diff -u -b -r1.132 dead_proc_elim.m
--- compiler/dead_proc_elim.m 11 Jun 2009 07:00:07 -0000 1.132
+++ compiler/dead_proc_elim.m 5 Aug 2009 17:12:49 -0000
@@ -1028,7 +1028,8 @@
!.Needed, NeededNames),
module_info_pred_info(ModuleInfo, PredId, PredInfo),
pred_info_get_clauses_info(PredInfo, ClausesInfo),
- clauses_info_get_clauses_rep(ClausesInfo, ClausesRep),
+ clauses_info_get_clauses_rep(ClausesInfo, ClausesRep,
+ _ItemNumbers),
get_clause_list_any_order(ClausesRep, Clauses),
list.foldl(dead_pred_elim_process_clause, Clauses, !DeadInfo)
),
Index: compiler/dependency_graph.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dependency_graph.m,v
retrieving revision 1.104
diff -u -b -r1.104 dependency_graph.m
--- compiler/dependency_graph.m 11 Jun 2009 07:00:08 -0000 1.104
+++ compiler/dependency_graph.m 5 Aug 2009 17:13:03 -0000
@@ -333,7 +333,7 @@
true
;
pred_info_get_clauses_info(PredInfo, ClausesInfo),
- clauses_info_get_clauses_rep(ClausesInfo, ClausesRep),
+ clauses_info_get_clauses_rep(ClausesInfo, ClausesRep, _ItemNumbers),
get_clause_list_any_order(ClausesRep, Clauses),
Goals = list.map(func(clause(_, Goal, _, _)) = Goal, Clauses),
digraph.lookup_key(!.DepGraph, PredId, Caller),
Index: compiler/goal_form.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_form.m,v
retrieving revision 1.47
diff -u -b -r1.47 goal_form.m
--- compiler/goal_form.m 10 Mar 2009 05:00:29 -0000 1.47
+++ compiler/goal_form.m 11 Aug 2009 07:32:54 -0000
@@ -488,9 +488,6 @@
%-----------------------------------------------------------------------------%
-goal_cannot_throw(ModuleInfo, Goal) :-
- goal_can_throw_func(yes(ModuleInfo), Goal) = no.
-
:- func goal_can_throw_func(maybe(module_info), hlds_goal) = bool.
goal_can_throw_func(MaybeModuleInfo, hlds_goal(GoalExpr, GoalInfo))
Index: compiler/goal_path.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_path.m,v
retrieving revision 1.54
diff -u -b -r1.54 goal_path.m
--- compiler/goal_path.m 10 Mar 2009 05:00:29 -0000 1.54
+++ compiler/goal_path.m 10 Aug 2009 04:49:26 -0000
@@ -91,11 +91,14 @@
fill_goal_path_slots_in_clauses(ModuleInfo, OmitModeEquivPrefix, !PredInfo) :-
pred_info_get_clauses_info(!.PredInfo, ClausesInfo0),
- clauses_info_clauses_only(ClausesInfo0, Clauses0),
+ clauses_info_get_clauses_rep(ClausesInfo0, ClausesRep0, ItemNumbers),
+ get_clause_list(ClausesRep0, Clauses0),
clauses_info_get_vartypes(ClausesInfo0, VarTypes),
SlotInfo = slot_info(VarTypes, ModuleInfo, OmitModeEquivPrefix),
list.map_foldl(fill_slots_in_clause(SlotInfo), Clauses0, Clauses, 1, _),
- clauses_info_set_clauses(Clauses, ClausesInfo0, ClausesInfo),
+ set_clause_list(Clauses, ClausesRep),
+ clauses_info_set_clauses_rep(ClausesRep, ItemNumbers,
+ ClausesInfo0, ClausesInfo),
pred_info_set_clauses_info(ClausesInfo, !PredInfo).
:- pred fill_slots_in_clause(slot_info::in, clause::in, clause::out,
Index: compiler/headvar_names.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/headvar_names.m,v
retrieving revision 1.5
diff -u -b -r1.5 headvar_names.m
--- compiler/headvar_names.m 28 Sep 2007 03:17:11 -0000 1.5
+++ compiler/headvar_names.m 10 Aug 2009 02:47:52 -0000
@@ -63,9 +63,10 @@
;
MakeOpt = no,
pred_info_get_clauses_info(!.PredInfo, ClausesInfo0),
- clauses_info_clauses_only(ClausesInfo0, Clauses0),
+ clauses_info_get_clauses_rep(ClausesInfo0, ClausesRep0, ItemNumbers),
clauses_info_get_headvars(ClausesInfo0, HeadVars0),
clauses_info_get_varset(ClausesInfo0, VarSet0),
+ get_clause_list(ClausesRep0, Clauses0),
(
Clauses0 = []
;
@@ -87,7 +88,8 @@
clauses_info_set_headvars(HeadVars, ClausesInfo0, ClausesInfo1),
SingleClause = clause(ApplicableProcs, Goal, Language, Context),
- clauses_info_set_clauses([SingleClause],
+ set_clause_list([SingleClause], ClausesRep),
+ clauses_info_set_clauses_rep(ClausesRep, ItemNumbers,
ClausesInfo1, ClausesInfo2),
clauses_info_set_varset(VarSet, ClausesInfo2, ClausesInfo),
pred_info_set_clauses_info(ClausesInfo, !PredInfo)
Index: compiler/hhf.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hhf.m,v
retrieving revision 1.38
diff -u -b -r1.38 hhf.m
--- compiler/hhf.m 16 Jul 2009 07:27:11 -0000 1.38
+++ compiler/hhf.m 10 Aug 2009 02:52:40 -0000
@@ -146,7 +146,7 @@
Info0 = hhf_info(InstGraph0, VarSet0, VarTypes0),
clauses_info_get_headvar_list(!.ClausesInfo, HeadVars),
- clauses_info_clauses(Clauses0, !ClausesInfo),
+ clauses_info_clauses(Clauses0, ItemNumbers, !ClausesInfo),
(
% % For simple mode checking we do not give the inst_graph any
@@ -160,7 +160,8 @@
Clauses0, Clauses, Info0, Info1)
),
- clauses_info_set_clauses(Clauses, !ClausesInfo),
+ set_clause_list(Clauses, ClausesRep),
+ clauses_info_set_clauses_rep(ClausesRep, ItemNumbers, !ClausesInfo),
complete_inst_graph(ModuleInfo, Info1, Info),
% XXX Comment out the above line for incomplete, quick checking.
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.182
diff -u -b -r1.182 higher_order.m
--- compiler/higher_order.m 12 Jun 2009 02:08:58 -0000 1.182
+++ compiler/higher_order.m 6 Aug 2009 13:56:08 -0000
@@ -2674,7 +2674,8 @@
set_clause_list([], ClausesRep),
EmptyHeadVars = proc_arg_vector_init(pf_predicate, []),
ClausesInfo = clauses_info(EmptyVarSet, EmptyVarTypes, EmptyTVarNameMap,
- EmptyVarTypes, EmptyHeadVars, ClausesRep, EmptyRttiVarMaps, no),
+ EmptyVarTypes, EmptyHeadVars, ClausesRep,
+ init_clause_item_numbers_comp_gen, EmptyRttiVarMaps, no),
Origin = origin_transformed(Transform, OrigOrigin, CallerPredId),
pred_info_init(PredModule, SymName, Arity, PredOrFunc, Context, Origin,
Status, GoalType, MarkerList, Types, ArgTVarSet, ExistQVars,
Index: compiler/hlds_clauses.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_clauses.m,v
retrieving revision 1.10
diff -u -b -r1.10 hlds_clauses.m
--- compiler/hlds_clauses.m 17 May 2007 03:52:43 -0000 1.10
+++ compiler/hlds_clauses.m 11 Aug 2009 08:33:12 -0000
@@ -25,6 +25,8 @@
:- import_module bool.
:- import_module list.
+:- import_module maybe.
+:- import_module term.
%-----------------------------------------------------------------------------%
@@ -38,38 +40,38 @@
%
:- type clauses_info
---> clauses_info(
- clauses_varset :: prog_varset,
% The varset describing the clauses.
+ cli_varset :: prog_varset,
+
+ % Variable types from explicit qualifications.
+ cli_explicit_vartypes :: vartypes,
- clauses_explicit_vartypes :: vartypes,
- % Variable types from explicit
- % qualifications.
-
- clauses_tvar_name_map :: tvar_name_map,
- % Map from variable name to type
- % variable for the type variables
- % occurring in the argument types.
- % This is used to process explicit
- % type qualifications.
-
- clauses_vartypes :: vartypes,
- % Variable types inferred by
- % typecheck.m.
+ % Map from variable name to type variable for the type
+ % variables occurring in the argument types. This is used
+ % to process explicit qualifications.
+ cli_tvar_name_map :: tvar_name_map,
+
+ % Variable types inferred by typecheck.m.
+ cli_vartypes :: vartypes,
- clauses_headvars :: proc_arg_vector(prog_var),
% The head variables.
+ cli_headvars :: proc_arg_vector(prog_var),
+
+ % The clauses themselves (some may be pragma foreign_procs).
+ cli_rep :: clauses_rep,
- clauses_rep :: clauses_rep,
+ % Information about where the clauses came fro.
+ cli_item_numbers :: clause_item_numbers,
- clauses_rtti_varmaps :: rtti_varmaps,
- % This field is computed by
- % polymorphism.m.
+ % This field is computed by polymorphism.m.
+ cli_rtti_varmaps :: rtti_varmaps,
- have_foreign_clauses :: bool
% Do we have foreign language clauses?
+ cli_have_foreign_clauses :: bool
).
-:- pred clauses_info_init(pred_or_func::in, int::in, clauses_info::out) is det.
+:- pred clauses_info_init(pred_or_func::in, int::in, clause_item_numbers::in,
+ clauses_info::out) is det.
:- pred clauses_info_init_for_assertion(prog_vars::in, clauses_info::out)
is det.
@@ -130,25 +132,19 @@
:- pred clauses_info_get_headvar_list(clauses_info::in, list(prog_var)::out)
is det.
-:- pred clauses_info_get_clauses_rep(clauses_info::in, clauses_rep::out) is det.
-
- % Return the list of clauses in program order.
- %
-:- pred clauses_info_clauses_only(clauses_info::in, list(clause)::out) is det.
+:- pred clauses_info_get_clauses_rep(clauses_info::in, clauses_rep::out,
+ clause_item_numbers::out) is det.
% Return the list of clauses in program order, and if necessary update
% the cache of this info in the clauses_info.
%
-:- pred clauses_info_clauses(list(clause)::out,
+:- pred clauses_info_clauses(list(clause)::out, clause_item_numbers::out,
clauses_info::in, clauses_info::out) is det.
:- pred clauses_info_set_headvars(proc_arg_vector(prog_var)::in,
clauses_info::in, clauses_info::out) is det.
-:- pred clauses_info_set_clauses(list(clause)::in,
- clauses_info::in, clauses_info::out) is det.
-
-:- pred clauses_info_set_clauses_rep(clauses_rep::in,
+:- pred clauses_info_set_clauses_rep(clauses_rep::in, clause_item_numbers::in,
clauses_info::in, clauses_info::out) is det.
:- pred clauses_info_set_varset(prog_varset::in,
@@ -171,20 +167,77 @@
:- type clause
---> clause(
- applicable_procs :: list(proc_id),
- % Modes for which this clause applies
- % ([] means it applies to all modes).
-
+ % Modes for which this clause applies.
+ clause_applicable_procs :: clause_applicable_modes,
clause_body :: hlds_goal,
clause_lang :: implementation_language,
clause_context :: prog_context
).
+:- type clause_applicable_modes
+ ---> all_modes
+ % This clause is applicable to all modes of the predicate.
+
+ ; selected_modes(list(proc_id)).
+ % This clause or foreign_proc is applicable only to this given
+ % list of modes.
+ %
+ % The list should always be sorted, and should never be empty.
+ %
+ % The list *may* be the same as the list of all the modes of the
+ % predicate. If it is, this indicates that the clause came from
+ % a mode-specific clause or foreign_proc, contexts that would
+ % normally imply that the clause is applicable only to one selected
+ % mode, but that we don't know what that mode is, perhaps because
+ % of an error in the predicate's definition, such as a
+ % mode-specific clause for a nonexistent mode.
+ %
+ % For such erroneous clauses and foreign_procs, this is the only
+ % way to get them to be typechecked (at least for now).
+
+%-----------------------------------------------------------------------------%
+
+ % We want to know whether the clauses of each predicate (which may include
+ % pragma foreign_procs) are contiguous in the source code or not.
+ %
+ % To this end, we record the item numbers of all the clauses of the
+
+:- type clause_item_numbers.
+
+:- type clause_item_number_region
+ ---> clause_item_number_region(
+ cnr_lower_item_number :: int,
+ cnr_upper_item_number :: int,
+ cnr_lower_item_context :: term.context,
+ cnr_upper_item_context :: term.context
+ ).
+
+:- type clause_item_number_types
+ ---> only_clauses
+ ; clauses_and_foreign_procs.
+
+:- pred clauses_are_non_contiguous(clause_item_numbers::in,
+ clause_item_number_types::in,
+ clause_item_number_region::out, clause_item_number_region::out,
+ list(clause_item_number_region)::out) is semidet.
+
+:- type clause_item_number_type
+ ---> item_is_clause
+ ; item_is_foreign_proc.
+
+:- pred add_clause_item_number(maybe(int)::in, term.context::in,
+ clause_item_number_type::in,
+ clause_item_numbers::in, clause_item_numbers::out) is det.
+
+:- func init_clause_item_numbers_user = clause_item_numbers.
+:- func init_clause_item_numbers_comp_gen = clause_item_numbers.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
+:- import_module libs.compiler_util.
:- import_module parse_tree.prog_util.
:- import_module int.
@@ -192,9 +245,134 @@
:- import_module term.
:- import_module varset.
+:- type clause_item_numbers
+ ---> user_clauses(
+ % This field records the locations of the Mercury language
+ % clauses only.
+ list(clause_item_number_region),
+
+ % This field records the locations of both the Mercury language
+ % clauses and the foreign language foreign_procs.
+ list(clause_item_number_region)
+ )
+ ; comp_gen_clauses.
+
+init_clause_item_numbers_user = user_clauses([], []).
+init_clause_item_numbers_comp_gen = comp_gen_clauses.
+
+clauses_are_non_contiguous(ClauseItemNumbers, Type, FirstRegion, SecondRegion,
+ LaterRegions) :-
+ ClauseItemNumbers = user_clauses(MercuryRegions, BothRegions),
+ (
+ Type = only_clauses,
+ MercuryRegions = [FirstRegion, SecondRegion | LaterRegions]
+ ;
+ Type = clauses_and_foreign_procs,
+ BothRegions = [FirstRegion, SecondRegion | LaterRegions]
+ ).
+
+add_clause_item_number(MaybeItemNumber, Context, Type, !ClauseItemNumbers) :-
+ (
+ MaybeItemNumber = no,
+ (
+ !.ClauseItemNumbers = user_clauses(_MercuryRegions, _BothRegions)
+ % This can happen for predicates defined in foreign languages
+ % through pragma import. The ordinary declaration of the
+ % predicate initializes !.ClauseItemNumbers to user_clauses,
+ % and the first clue we have that the predicate actually has
+ % no user clauses is the pragma import, whose processing
+ % will yield a call to add_clause_item_number that ends up
+ % here.
+ %
+ % We could insist on _MercuryRegions and _BothRegions being [],
+ % but that would cause a compiler abort if a predicate had
+ % some clauses and/or foreign_procs followed by a pragma import.
+ % Such situations should be caught and reported by our ancestors.
+ ;
+ !.ClauseItemNumbers = comp_gen_clauses
+ )
+ ;
+ MaybeItemNumber = yes(ItemNumber),
+ (
+ !.ClauseItemNumbers = user_clauses(MercuryRegions0, BothRegions0),
+ (
+ Type = item_is_clause,
+ add_clause_item_number_regions(ItemNumber, Context,
+ MercuryRegions0, MercuryRegions)
+ ;
+ Type = item_is_foreign_proc,
+ MercuryRegions = MercuryRegions0
+ ),
+ add_clause_item_number_regions(ItemNumber, Context,
+ BothRegions0, BothRegions),
+ !:ClauseItemNumbers = user_clauses(MercuryRegions, BothRegions)
+ ;
+ !.ClauseItemNumbers = comp_gen_clauses
+ % Do not record the locations of any clauses that shouldn't be
+ % there in the first place, since any error messages about such
+ % clauses being out of order would be misleading (the error isn't
+ % their non-contiguity, but their very existence).
+ )
+ ).
+
+:- pred add_clause_item_number_regions(int::in, term.context::in,
+ list(clause_item_number_region)::in, list(clause_item_number_region)::out)
+ is det.
+
+add_clause_item_number_regions(ItemNum, Context, !Regions) :-
+ (
+ !.Regions = [],
+ NewRegion = clause_item_number_region(ItemNum, ItemNum,
+ Context, Context),
+ !:Regions = [NewRegion]
+ ;
+ !.Regions = [FirstRegion0 | LaterRegions0],
+ FirstRegion0 = clause_item_number_region(
+ LowerNum0, UpperNum0, LowerContext0, UpperContext0),
+ ( ItemNum < LowerNum0 - 1 ->
+ NewRegion = clause_item_number_region(ItemNum, ItemNum,
+ Context, Context),
+ !:Regions = [NewRegion, FirstRegion0 | LaterRegions0]
+ ; ItemNum = LowerNum0 - 1 ->
+ FirstRegion = clause_item_number_region(ItemNum, UpperNum0,
+ Context, UpperContext0),
+ !:Regions = [FirstRegion | LaterRegions0]
+ ; ItemNum =< UpperNum0 ->
+ unexpected(this_file,
+ "add_clause_item_number: duplicate item number")
+ ; ItemNum = UpperNum0 + 1 ->
+ FirstRegion = clause_item_number_region(LowerNum0, ItemNum,
+ LowerContext0, Context),
+ !:Regions = [FirstRegion | LaterRegions0]
+ ;
+ add_clause_item_number_regions(ItemNum, Context,
+ LaterRegions0, LaterRegions1),
+ % See if need to merge FirstRegion0 with the first region
+ % of LaterRegions1.
+ (
+ LaterRegions1 = [],
+ unexpected(this_file,
+ "add_clause_item_number: insertion yields empty list")
+ ;
+ LaterRegions1 = [FirstLaterRegion1 | LaterLaterRegions1],
+ FirstLaterRegion1 = clause_item_number_region(
+ LowerNum1, UpperNum1, _LowerContext1, UpperContext1),
+ ( UpperNum0 + 1 = LowerNum1 ->
+ FirstRegion =
+ clause_item_number_region(LowerNum0, UpperNum1,
+ LowerContext0, UpperContext1),
+ !:Regions = [FirstRegion | LaterLaterRegions1]
+ ;
+ !:Regions = [FirstRegion0, FirstLaterRegion1
+ | LaterLaterRegions1]
+ )
+ )
+ )
+ ).
+
%-----------------------------------------------------------------------------%
-clauses_info_init(PredOrFunc, Arity, ClausesInfo) :-
+clauses_info_init(PredOrFunc, Arity, ItemNumbers, ClausesInfo) :-
map.init(VarTypes),
map.init(TVarNameMap),
varset.init(VarSet0),
@@ -204,7 +382,7 @@
HasForeignClauses = no,
set_clause_list([], ClausesRep),
ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap, VarTypes,
- HeadVarVec, ClausesRep, RttiVarMaps, HasForeignClauses).
+ HeadVarVec, ClausesRep, ItemNumbers, RttiVarMaps, HasForeignClauses).
clauses_info_init_for_assertion(HeadVars, ClausesInfo) :-
varset.init(VarSet),
@@ -217,25 +395,31 @@
rtti_varmaps_init(RttiVarMaps),
HasForeignClauses = no,
ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap, VarTypes,
- HeadVarVec, ClausesRep, RttiVarMaps, HasForeignClauses).
+ HeadVarVec, ClausesRep, init_clause_item_numbers_comp_gen,
+ RttiVarMaps, HasForeignClauses).
-clauses_info_get_varset(CI, CI ^ clauses_varset).
-clauses_info_get_explicit_vartypes(CI, CI ^ clauses_explicit_vartypes).
-clauses_info_get_vartypes(CI, CI ^ clauses_vartypes).
-clauses_info_get_headvars(CI, CI ^ clauses_headvars).
+clauses_info_get_varset(CI, CI ^ cli_varset).
+clauses_info_get_explicit_vartypes(CI, CI ^ cli_explicit_vartypes).
+clauses_info_get_vartypes(CI, CI ^ cli_vartypes).
+clauses_info_get_headvars(CI, CI ^ cli_headvars).
clauses_info_get_headvar_list(CI, List) :-
- List = proc_arg_vector_to_list(CI ^ clauses_headvars).
-clauses_info_get_clauses_rep(CI, CI ^ clauses_rep).
-clauses_info_get_rtti_varmaps(CI, CI ^ clauses_rtti_varmaps).
-
-clauses_info_set_varset(X, CI, CI ^ clauses_varset := X).
-clauses_info_set_explicit_vartypes(X, CI, CI ^ clauses_explicit_vartypes := X).
-clauses_info_set_vartypes(X, CI, CI ^ clauses_vartypes := X).
-clauses_info_set_headvars(X, CI, CI ^ clauses_headvars := X).
-clauses_info_set_clauses(X, CI, CI ^ clauses_rep := Rep) :-
- set_clause_list(X, Rep).
-clauses_info_set_clauses_rep(X, CI, CI ^ clauses_rep := X).
-clauses_info_set_rtti_varmaps(X, CI, CI ^ clauses_rtti_varmaps := X).
+ List = proc_arg_vector_to_list(CI ^ cli_headvars).
+clauses_info_get_clauses_rep(CI, CI ^ cli_rep, CI ^ cli_item_numbers).
+clauses_info_get_rtti_varmaps(CI, CI ^ cli_rtti_varmaps).
+
+clauses_info_set_varset(X, !CI) :-
+ !CI ^ cli_varset := X.
+clauses_info_set_explicit_vartypes(X, !CI) :-
+ !CI ^ cli_explicit_vartypes := X.
+clauses_info_set_vartypes(X, !CI) :-
+ !CI ^ cli_vartypes := X.
+clauses_info_set_headvars(X, !CI) :-
+ !CI ^ cli_headvars := X.
+clauses_info_set_clauses_rep(X, Y, !CI) :-
+ !CI ^ cli_rep := X,
+ !CI ^ cli_item_numbers := Y.
+clauses_info_set_rtti_varmaps(X, !CI) :-
+ !CI ^ cli_rtti_varmaps := X.
% In each of the alternatives below, the num field gives the number of
% clauses. In the forw_list and both_forw fields, the clauses are in
@@ -246,29 +430,29 @@
%
% holds.
:- type clauses_rep
- ---> rev(
+ ---> cr_rev(
rev_num :: int,
rev_list :: list(clause)
)
- ; forw(
+ ; cr_forw(
forw_num :: int,
forw_list :: list(clause)
)
- ; both(
+ ; cr_both(
both_num :: int,
both_rev :: list(clause),
both_forw :: list(clause)
).
-init_clauses_rep = forw(0, []).
+init_clauses_rep = cr_forw(0, []).
clause_list_is_empty(ClausesRep) = IsEmpty :-
(
- ClausesRep = rev(_, List)
+ ClausesRep = cr_rev(_, List)
;
- ClausesRep = forw(_, List)
+ ClausesRep = cr_forw(_, List)
;
- ClausesRep = both(_, List, _)
+ ClausesRep = cr_both(_, List, _)
),
(
List = [],
@@ -280,69 +464,66 @@
num_clauses_in_clauses_rep(ClausesRep) = NumClauses :-
(
- ClausesRep = rev(NumClauses, _)
+ ClausesRep = cr_rev(NumClauses, _)
;
- ClausesRep = forw(NumClauses, _)
+ ClausesRep = cr_forw(NumClauses, _)
;
- ClausesRep = both(NumClauses, _, _)
+ ClausesRep = cr_both(NumClauses, _, _)
).
get_clause_list_any_order(ClausesRep, Clauses) :-
(
- ClausesRep = rev(_, Clauses)
+ ClausesRep = cr_rev(_, Clauses)
;
- ClausesRep = forw(_, Clauses)
+ ClausesRep = cr_forw(_, Clauses)
;
- ClausesRep = both(_, _, Clauses)
+ ClausesRep = cr_both(_, _, Clauses)
).
get_clause_list(ClausesRep, Clauses) :-
(
- ClausesRep = rev(_, RevClauses),
+ ClausesRep = cr_rev(_, RevClauses),
list.reverse(RevClauses, Clauses)
;
- ClausesRep = forw(_, Clauses)
+ ClausesRep = cr_forw(_, Clauses)
;
- ClausesRep = both(_, _, Clauses)
+ ClausesRep = cr_both(_, _, Clauses)
).
-set_clause_list(Clauses, forw(list.length(Clauses), Clauses)).
-
-clauses_info_clauses_only(CI, Clauses) :-
- ClausesRep = CI ^ clauses_rep,
- get_clause_list(ClausesRep, Clauses).
+set_clause_list(Clauses, cr_forw(list.length(Clauses), Clauses)).
-clauses_info_clauses(Clauses, !CI) :-
- ClausesRep = !.CI ^ clauses_rep,
+clauses_info_clauses(Clauses, ItemNumbers, !CI) :-
+ ClausesRep = !.CI ^ cli_rep,
+ ItemNumbers = !.CI ^ cli_item_numbers,
(
- ClausesRep = rev(NumClauses, RevClauses),
+ ClausesRep = cr_rev(NumClauses, RevClauses),
list.reverse(RevClauses, Clauses),
- !:CI = !.CI ^ clauses_rep := both(NumClauses, RevClauses, Clauses)
+ !CI ^ cli_rep := cr_both(NumClauses, RevClauses, Clauses)
;
- ClausesRep = forw(_, Clauses)
+ ClausesRep = cr_forw(_, Clauses)
;
- ClausesRep = both(_, _, Clauses)
+ ClausesRep = cr_both(_, _, Clauses)
).
add_clause(Clause, !ClausesRep) :-
% We keep the clause list in reverse order, to make it possible
% to add other clauses without quadratic behavior.
(
- !.ClausesRep = rev(NumClauses0, RevClauses0),
+ !.ClausesRep = cr_rev(NumClauses0, RevClauses0),
NumClauses = NumClauses0 + 1,
RevClauses = [Clause | RevClauses0],
- !:ClausesRep = rev(NumClauses, RevClauses)
+ !:ClausesRep = cr_rev(NumClauses, RevClauses)
;
- !.ClausesRep = forw(NumClauses0, Clauses0),
+ !.ClausesRep = cr_forw(NumClauses0, Clauses0),
NumClauses = NumClauses0 + 1,
list.reverse(Clauses0, RevClauses0),
RevClauses = [Clause | RevClauses0],
- !:ClausesRep = rev(NumClauses, RevClauses)
+ !:ClausesRep = cr_rev(NumClauses, RevClauses)
;
- !.ClausesRep = both(NumClauses0, RevClauses0, _),
+ !.ClausesRep = cr_both(NumClauses0, RevClauses0, _),
NumClauses = NumClauses0 + 1,
RevClauses = [Clause | RevClauses0],
- !:ClausesRep = rev(NumClauses, RevClauses)
+ !:ClausesRep = cr_rev(NumClauses, RevClauses)
).
%-----------------------------------------------------------------------------%
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.466
diff -u -b -r1.466 hlds_out.m
--- compiler/hlds_out.m 16 Jul 2009 07:27:12 -0000 1.466
+++ compiler/hlds_out.m 10 Aug 2009 17:22:02 -0000
@@ -909,7 +909,7 @@
true
),
ClausesInfo = clauses_info(VarSet, _, _, VarTypes, HeadVars, ClausesRep,
- RttiVarMaps, _),
+ _ItemNumbers, RttiVarMaps, _HaveForeignClauses),
( string.contains_char(Verbose, 'C') ->
write_indent(Indent, !IO),
io.write_string("% pred id: ", !IO),
@@ -1163,9 +1163,13 @@
write_clause(Indent, ModuleInfo, PredId, VarSet, AppendVarNums, HeadTerms,
PredOrFunc, Clause, UseDeclaredModes, TypeQual, !IO) :-
- Clause = clause(Modes, Goal, Lang, Context),
+ Clause = clause(ApplicableModes, Goal, Lang, Context),
Indent1 = Indent + 1,
globals.io_lookup_string_option(dump_hlds_options, Verbose, !IO),
+ (
+ ApplicableModes = all_modes
+ ;
+ ApplicableModes = selected_modes(Modes),
( string.contains_char(Verbose, 'm') ->
write_indent(Indent, !IO),
io.write_string("% Modes for which this clause applies: ", !IO),
@@ -1174,6 +1178,7 @@
io.write_string("\n", !IO)
;
true
+ )
),
(
Lang = impl_lang_mercury
@@ -1184,22 +1189,21 @@
io.nl(!IO)
),
module_info_pred_info(ModuleInfo, PredId, PredInfo),
- ProcIds = pred_info_procids(PredInfo),
+ AllProcIds = pred_info_procids(PredInfo),
(
- ( Modes = []
- ; Modes = ProcIds
- )
+ ApplicableModes = selected_modes(SelectedProcIds),
+ SelectedProcIds \= AllProcIds
->
- write_clause_head(ModuleInfo, PredId, VarSet, AppendVarNums,
- HeadTerms, PredOrFunc, !IO)
- ;
- % If Modes contains more than one mode, the output will have
+ % If SelectedProcIds contains more than one mode, the output will have
% multiple clause heads. This won't be pretty and it won't be
% syntactically valid, but it is more useful for debugging
% than a compiler abort during the dumping process.
write_annotated_clause_heads(ModuleInfo, Context, PredId,
- Modes, VarSet, AppendVarNums, HeadTerms, PredOrFunc,
+ SelectedProcIds, VarSet, AppendVarNums, HeadTerms, PredOrFunc,
UseDeclaredModes, !IO)
+ ;
+ write_clause_head(ModuleInfo, PredId, VarSet, AppendVarNums,
+ HeadTerms, PredOrFunc, !IO)
),
( Goal = hlds_goal(conj(plain_conj, []), _GoalInfo) ->
io.write_string(".\n", !IO)
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.251
diff -u -b -r1.251 hlds_pred.m
--- compiler/hlds_pred.m 16 Jul 2009 07:27:12 -0000 1.251
+++ compiler/hlds_pred.m 6 Aug 2009 13:57:53 -0000
@@ -1109,13 +1109,14 @@
UnprovenBodyConstraints = [],
% The empty list of clauses is a little white lie.
- Clauses = init_clauses_rep,
+ ClausesRep = init_clauses_rep,
map.init(TVarNameMap),
proc_info_get_rtti_varmaps(ProcInfo, RttiVarMaps),
HasForeignClauses = no,
HeadVarVec = proc_arg_vector_init(PredOrFunc, HeadVars),
ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap, VarTypes,
- HeadVarVec, Clauses, RttiVarMaps, HasForeignClauses),
+ HeadVarVec, ClausesRep, init_clause_item_numbers_user,
+ RttiVarMaps, HasForeignClauses),
map.init(Procs0),
next_mode_id(Procs0, ProcId),
@@ -1707,26 +1708,22 @@
:- type deep_profile_proc_info
---> deep_profile_proc_info(
+ % This field is set during the first part of the deep profiling
+ % transformation; tail recursion, if that is enabled.
deep_rec :: maybe(deep_recursion_info),
- % This field is set during the first part of
- % the deep profiling transformation; tail
- % recursion, if that is enabled.
+ % This field is set during the second part; it will be bound
+ % to `no' before and during the first part, and to `yes'
+ % after the second. The contents of this field govern
+ % what will go into MR_ProcStatic structures.
deep_layout :: maybe(hlds_deep_layout),
- % This field is set during the second part; it
- % will be bound to `no' before and during the
- % first part, and to `yes' after the second.
- % The contents of this field govern what will
- % go into MR_ProcStatic structures.
+ % This field stores the origional body of a procedure,
+ % before either part of the deep profiling transformation
+ % was executed. For inner procedures created by the tail
+ % recursion part of the deep profiling transformation,
+ % it holds the origional body of the outer procedure.
deep_orig_body :: deep_original_body
- % This field stores the origional body of a
- % procedure, before either part of the deep
- % profiling transformation was executed. For
- % inner procedures created by the tail
- % recursion part of the deep profiling
- % transformation, it holds the origional body
- % of the outer procedure.
).
:- type deep_original_body
Index: compiler/implementation_defined_literals.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/implementation_defined_literals.m,v
retrieving revision 1.5
diff -u -b -r1.5 implementation_defined_literals.m
--- compiler/implementation_defined_literals.m 21 Jul 2009 04:10:40 -0000 1.5
+++ compiler/implementation_defined_literals.m 5 Aug 2009 17:05:58 -0000
@@ -64,12 +64,13 @@
subst_literals_in_pred(ModuleInfo, PredId, PredInfo0, PredInfo) :-
pred_info_get_clauses_info(PredInfo0, ClausesInfo0),
- clauses_info_get_clauses_rep(ClausesInfo0, ClausesRep0),
+ clauses_info_get_clauses_rep(ClausesInfo0, ClausesRep0, ItemNumbers),
get_clause_list(ClausesRep0, Clauses0),
Info = subst_literals_info(ModuleInfo, PredInfo0, PredId),
list.map(subst_literals_in_clause(Info), Clauses0, Clauses),
set_clause_list(Clauses, ClausesRep),
- clauses_info_set_clauses_rep(ClausesRep, ClausesInfo0, ClausesInfo),
+ clauses_info_set_clauses_rep(ClausesRep, ItemNumbers,
+ ClausesInfo0, ClausesInfo),
pred_info_set_clauses_info(ClausesInfo, PredInfo0, PredInfo).
:- pred subst_literals_in_clause(subst_literals_info::in, clause::in,
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.246
diff -u -b -r1.246 intermod.m
--- compiler/intermod.m 14 Aug 2009 20:37:46 -0000 1.246
+++ compiler/intermod.m 17 Aug 2009 06:46:25 -0000
@@ -249,7 +249,7 @@
% Write a declaration to the `.opt' file for
% `exported_to_submodules' predicates.
add_proc(PredId, DoWrite0, !Info),
- clauses_info_get_clauses_rep(ClausesInfo0, ClausesRep0),
+ clauses_info_get_clauses_rep(ClausesInfo0, ClausesRep0, ItemNumbers0),
(
DoWrite0 = yes,
clauses_info_get_vartypes(ClausesInfo0, VarTypes),
@@ -266,7 +266,7 @@
),
(
DoWrite = yes,
- clauses_info_set_clauses_rep(ClausesRep,
+ clauses_info_set_clauses_rep(ClausesRep, ItemNumbers0,
ClausesInfo0, ClausesInfo),
pred_info_set_clauses_info(ClausesInfo, PredInfo0, PredInfo),
map.det_update(PredTable0, PredId, PredInfo, PredTable),
@@ -310,7 +310,8 @@
),
(
pred_info_get_clauses_info(PredInfo, ClauseInfo),
- clauses_info_clauses_only(ClauseInfo, Clauses),
+ clauses_info_get_clauses_rep(ClauseInfo, ClausesRep, _ItemNumbers),
+ get_clause_list(ClausesRep, Clauses),
[ProcId | _ProcIds] = pred_info_procids(PredInfo),
pred_info_get_procedures(PredInfo, Procs),
@@ -1700,8 +1701,9 @@
pred_info_get_clauses_info(PredInfo, ClausesInfo),
clauses_info_get_varset(ClausesInfo, VarSet),
clauses_info_get_headvar_list(ClausesInfo, HeadVars),
- clauses_info_clauses_only(ClausesInfo, Clauses),
+ clauses_info_get_clauses_rep(ClausesInfo, ClausesRep, _ItemNumbers),
clauses_info_get_vartypes(ClausesInfo, VarTypes),
+ get_clause_list(ClausesRep, Clauses),
( pred_info_get_goal_type(PredInfo, goal_type_promise(PromiseType)) ->
( Clauses = [Clause] ->
@@ -1714,31 +1716,31 @@
;
pred_info_get_typevarset(PredInfo, TypeVarset),
MaybeVarTypes = varset_vartypes(TypeVarset, VarTypes),
- list.foldl(write_clause(ModuleInfo, PredId, VarSet,
+ list.foldl(intermod_write_clause(ModuleInfo, PredId, VarSet,
HeadVars, PredOrFunc, SymName, MaybeVarTypes), Clauses, !IO)
),
write_preds(ModuleInfo, PredIds, !IO).
-:- pred write_clause(module_info::in, pred_id::in, prog_varset::in,
+:- pred intermod_write_clause(module_info::in, pred_id::in, prog_varset::in,
list(prog_var)::in, pred_or_func::in, sym_name::in,
maybe_vartypes::in, clause::in, io::di, io::uo) is det.
-write_clause(ModuleInfo, PredId, VarSet, HeadVars, PredOrFunc, _SymName,
- MaybeVarTypes, Clause0, !IO) :-
- Clause0 = clause(_, _, impl_lang_mercury, _),
+intermod_write_clause(ModuleInfo, PredId, VarSet, HeadVars, PredOrFunc,
+ SymName, MaybeVarTypes, Clause0, !IO) :-
+ Clause0 = clause(ApplicableProcIds, Goal, ImplLang, _),
+ (
+ ImplLang = impl_lang_mercury,
strip_headvar_unifications(HeadVars, Clause0, ClauseHeadVars, Clause),
% Variable numbers need to be appended for the case
% where the added arguments for a DCG pred expression
% are named the same as variables in the enclosing clause.
AppendVarNums = yes,
UseDeclaredModes = yes,
- hlds_out.write_clause(1, ModuleInfo, PredId, VarSet, AppendVarNums,
- ClauseHeadVars, PredOrFunc, Clause, UseDeclaredModes, MaybeVarTypes,
- !IO).
-
-write_clause(ModuleInfo, PredId, VarSet, _HeadVars, PredOrFunc, SymName,
- _, Clause, !IO) :-
- Clause = clause(ProcIds, Goal, impl_lang_foreign(_), _),
+ write_clause(1, ModuleInfo, PredId, VarSet, AppendVarNums,
+ ClauseHeadVars, PredOrFunc, Clause, UseDeclaredModes,
+ MaybeVarTypes, !IO)
+ ;
+ ImplLang = impl_lang_foreign(_),
module_info_pred_info(ModuleInfo, PredId, PredInfo),
pred_info_get_procedures(PredInfo, Procs),
(
@@ -1746,20 +1748,33 @@
% Pull the foreign code out of the goal.
Goal = hlds_goal(conj(plain_conj, Goals), _),
list.filter(
- (pred(X::in) is semidet :-
- X = hlds_goal(call_foreign_proc(_, _, _, _, _, _, _), _)
+ (pred(G::in) is semidet :-
+ G = hlds_goal(GE, _),
+ GE = call_foreign_proc(_, _, _, _, _, _, _)
), Goals, [ForeignCodeGoal]),
- ForeignCodeGoal = hlds_goal(call_foreign_proc(Attributes,
- _, _, Args, _ExtraArgs, _MaybeTraceRuntimeCond, PragmaCode), _)
+ ForeignCodeGoal = hlds_goal(ForeignCodeGoalExpr, _),
+ ForeignCodeGoalExpr = call_foreign_proc(Attributes, _, _,
+ Args, _ExtraArgs, _MaybeTraceRuntimeCond, PragmaCode)
;
- Goal = hlds_goal(call_foreign_proc(Attributes, _, _,
- Args, _ExtraArgs, _MaybeTraceRuntimeCond, PragmaCode), _)
+ Goal = hlds_goal(GoalExpr, _),
+ GoalExpr = call_foreign_proc(Attributes, _, _,
+ Args, _ExtraArgs, _MaybeTraceRuntimeCond, PragmaCode)
)
->
- list.foldl(write_foreign_clause(Procs, PredOrFunc,
- PragmaCode, Attributes, Args, VarSet, SymName), ProcIds, !IO)
+ (
+ ApplicableProcIds = all_modes,
+ unexpected(this_file,
+ "intermod_write_clause: all_modes foreign_proc")
+ ;
+ ApplicableProcIds = selected_modes(ProcIds),
+ list.foldl(
+ write_foreign_clause(Procs, PredOrFunc, PragmaCode,
+ Attributes, Args, VarSet, SymName),
+ ProcIds, !IO)
+ )
;
unexpected(this_file, "foreign_proc expected within this goal")
+ )
).
:- pred write_foreign_clause(proc_table::in, pred_or_func::in,
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.87
diff -u -b -r1.87 make_hlds_passes.m
--- compiler/make_hlds_passes.m 14 Aug 2009 20:37:47 -0000 1.87
+++ compiler/make_hlds_passes.m 17 Aug 2009 06:46:25 -0000
@@ -1041,7 +1041,7 @@
add_pass_3_clause(ItemClause, Status, !ModuleInfo, !QualInfo, !Specs) :-
ItemClause = item_clause_info(Origin, VarSet, PredOrFunc,
- PredName, Args, Body, Context, _SeqNum),
+ PredName, Args, Body, Context, SeqNum),
( Status = status_exported ->
(
Origin = user,
@@ -1076,7 +1076,7 @@
),
% At this stage we only need know that it's not a promise declaration.
module_add_clause(VarSet, PredOrFunc, PredName, Args, Body, Status,
- Context, goal_type_none, !ModuleInfo, !QualInfo, !Specs).
+ Context, yes(SeqNum), goal_type_none, !ModuleInfo, !QualInfo, !Specs).
:- pred add_pass_3_type_defn(item_type_defn_info::in,
import_status::in, module_info::in, module_info::out,
@@ -1152,13 +1152,13 @@
list(error_spec)::in, list(error_spec)::out) is det.
add_pass_3_pragma(ItemPragma, !Status, !ModuleInfo, !QualInfo, !Specs) :-
- ItemPragma = item_pragma_info(Origin, Pragma, Context, _SeqNum),
+ ItemPragma = item_pragma_info(Origin, Pragma, Context, SeqNum),
(
Pragma = pragma_foreign_proc(Attributes, Pred, PredOrFunc,
Vars, ProgVarSet, InstVarSet, PragmaImpl),
module_add_pragma_foreign_proc(Attributes, Pred, PredOrFunc,
Vars, ProgVarSet, InstVarSet, PragmaImpl, !.Status, Context,
- !ModuleInfo, !QualInfo, !Specs)
+ yes(SeqNum), !ModuleInfo, !QualInfo, !Specs)
;
Pragma = pragma_import(Name, PredOrFunc, Modes, Attributes,
C_Function),
@@ -2785,7 +2785,7 @@
module_info_get_name(!.ModuleInfo, ModuleName),
module_add_clause(VarSet, pf_predicate, qualified(ModuleName, Name),
- HeadVars, Goal, Status, Context, goal_type_promise(PromiseType),
+ HeadVars, Goal, Status, Context, no, goal_type_promise(PromiseType),
!ModuleInfo, !QualInfo, !Specs).
add_stratified_pred(PragmaName, Name, Arity, Context, !ModuleInfo, !Specs) :-
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.236
diff -u -b -r1.236 mlds_to_c.m
--- compiler/mlds_to_c.m 11 Jun 2009 07:00:14 -0000 1.236
+++ compiler/mlds_to_c.m 11 Aug 2009 07:34:21 -0000
@@ -2614,6 +2614,10 @@
mlds_output_stmt(Indent, FuncInfo, Statement, Context, !IO) :-
(
+ Statement = ml_stmt_atomic(AtomicStatement),
+ mlds_output_atomic_stmt(Indent, FuncInfo, AtomicStatement, Context,
+ !IO)
+ ;
Statement = ml_stmt_block(Defns, Statements),
mlds_indent(Indent, !IO),
io.write_string("{\n", !IO),
@@ -3120,10 +3124,6 @@
%-----------------------------------------------------------------------------%
-mlds_output_stmt(Indent, FuncInfo, ml_stmt_atomic(AtomicStatement), Context,
- !IO) :-
- mlds_output_atomic_stmt(Indent, FuncInfo, AtomicStatement, Context, !IO).
-
:- pred mlds_output_label_name(mlds_label::in, io::di, io::uo) is det.
mlds_output_label_name(LabelName, !IO) :-
Index: compiler/mode_constraints.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_constraints.m,v
retrieving revision 1.51
diff -u -b -r1.51 mode_constraints.m
--- compiler/mode_constraints.m 11 Jun 2009 07:00:14 -0000 1.51
+++ compiler/mode_constraints.m 10 Aug 2009 05:06:35 -0000
@@ -222,7 +222,7 @@
module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
some [!ClausesInfo, !Varset, !Vartypes, !Clauses, !Goals, !RttiVarMaps] (
pred_info_get_clauses_info(PredInfo0, !:ClausesInfo),
- clauses_info_clauses_only(!.ClausesInfo, !:Clauses),
+ clauses_info_clauses(!:Clauses, ItemNumbers, !ClausesInfo),
clauses_info_get_headvar_list(!.ClausesInfo, HeadVars),
clauses_info_get_varset(!.ClausesInfo, !:Varset),
clauses_info_get_vartypes(!.ClausesInfo, !:Vartypes),
@@ -233,7 +233,8 @@
!:Clauses = list.map_corresponding(
func(Clause, Goal) = 'clause_body :='(Clause, Goal),
!.Clauses, !.Goals),
- clauses_info_set_clauses(!.Clauses, !ClausesInfo),
+ set_clause_list(!.Clauses, ClausesRep),
+ clauses_info_set_clauses_rep(ClausesRep, ItemNumbers, !ClausesInfo),
clauses_info_set_varset(!.Varset, !ClausesInfo),
clauses_info_set_vartypes(!.Vartypes, !ClausesInfo),
clauses_info_set_rtti_varmaps(!.RttiVarMaps, !ClausesInfo),
@@ -384,7 +385,8 @@
( pred_info_is_imported(PredInfo0) ->
true
;
- clauses_info_clauses_only(ClausesInfo0, Clauses0),
+ clauses_info_clauses(Clauses0, ItemNumbers,
+ ClausesInfo0, ClausesInfo1),
clauses_info_get_vartypes(ClausesInfo0, VarTypes),
NRInfo0 = number_robdd_info(!.MCI, !.ModuleInfo, VarTypes),
@@ -397,7 +399,9 @@
), Clauses0, Clauses, NRInfo0, NRInfo),
!:MCI = NRInfo ^ mc_info,
- clauses_info_set_clauses(Clauses, ClausesInfo0, ClausesInfo),
+ set_clause_list(Clauses, ClausesRep),
+ clauses_info_set_clauses_rep(ClausesRep, ItemNumbers,
+ ClausesInfo1, ClausesInfo),
pred_info_set_clauses_info(ClausesInfo, PredInfo1, PredInfo),
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo)
),
@@ -1042,7 +1046,7 @@
map.foldl2(input_output_constraints(HeadVars, InstGraph),
InstGraph, !Constraint, !ConstraintInfo),
- clauses_info_clauses(Clauses, !ClausesInfo),
+ clauses_info_clauses(Clauses, _ItemNumbers, !ClausesInfo),
list.map(pred(clause(_, Goal, _, _)::in, Goal::out) is det, Clauses,
Goals),
DisjGoal = disj(Goals),
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.380
diff -u -b -r1.380 modes.m
--- compiler/modes.m 14 Aug 2009 20:37:47 -0000 1.380
+++ compiler/modes.m 17 Aug 2009 06:46:25 -0000
@@ -847,12 +847,13 @@
% at all, in which case we use the context of the mode declaration.
module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
pred_info_get_clauses_info(PredInfo, ClausesInfo),
- clauses_info_clauses_only(ClausesInfo, ClauseList),
+ clauses_info_get_clauses_rep(ClausesInfo, ClausesRep, _ItemNumbers),
+ get_clause_list(ClausesRep, Clauses),
(
- ClauseList = [FirstClause | _],
+ Clauses = [FirstClause | _],
FirstClause = clause(_, _, _, Context)
;
- ClauseList = [],
+ Clauses = [],
proc_info_get_context(!.ProcInfo, Context)
),
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.651
diff -u -b -r1.651 options.m
--- compiler/options.m 7 Jul 2009 01:08:59 -0000 1.651
+++ compiler/options.m 11 Aug 2009 06:31:20 -0000
@@ -111,6 +111,8 @@
; warn_missing_opt_files
; warn_missing_trans_opt_files
; warn_missing_trans_opt_deps
+ ; warn_non_contiguous_clauses
+ ; warn_non_contiguous_foreign_procs
; warn_non_stratification
; warn_unification_cannot_succeed
; warn_simple_code
@@ -1009,6 +1011,8 @@
warn_nothing_exported - bool(yes),
warn_unused_args - bool(no),
warn_interface_imports - bool(yes),
+ warn_non_contiguous_clauses - bool(yes),
+ warn_non_contiguous_foreign_procs - bool(no),
warn_non_stratification - bool(no),
warn_missing_opt_files - bool(yes),
warn_missing_trans_opt_files - bool(no),
@@ -1826,6 +1830,9 @@
long_option("warn-nothing-exported", warn_nothing_exported).
long_option("warn-unused-args", warn_unused_args).
long_option("warn-interface-imports", warn_interface_imports).
+long_option("warn-non-contiguous-clauses", warn_non_contiguous_clauses).
+long_option("warn-non-contiguous-foreign-procs",
+ warn_non_contiguous_foreign_procs).
long_option("warn-non-stratification", warn_non_stratification).
long_option("warn-missing-opt-files", warn_missing_opt_files).
long_option("warn-missing-trans-opt-files", warn_missing_trans_opt_files).
@@ -3280,9 +3287,16 @@
"\tto allow `.trans_opt' files to be read when creating other",
"\t`.trans_opt' files has been lost. The information can be",
"\trecreated by running `mmake <mainmodule>.depend'",
+ "--no-warn-non-contiguous-clauses",
+ "\tDo not generate a warning if the clauses of a predicate or function",
+ "\tare not contiguous.",
+ "--warn-non-contiguous-foreign-procs",
+ "\tGenerate a warning if the clauses and foreign_procs of a predicate",
+ "\tor function are not contiguous.",
"--warn-non-stratification",
- "\tWarn about possible non-stratification in the module.",
- "\tNon-stratification occurs when a predicate/function can call",
+ "\tWarn about possible non-stratification of the predicates and/or",
+ "\tfunctions in the module.",
+ "\tNon-stratification occurs when a predicate or function can call",
"\titself negatively through some path along its call graph.",
"--no-warn-unification-cannot-succeed",
"\tDisable warnings about unifications which cannot succeed.",
Index: compiler/ordering_mode_constraints.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ordering_mode_constraints.m,v
retrieving revision 1.23
diff -u -b -r1.23 ordering_mode_constraints.m
--- compiler/ordering_mode_constraints.m 4 Jun 2009 04:39:20 -0000 1.23
+++ compiler/ordering_mode_constraints.m 10 Aug 2009 05:10:18 -0000
@@ -726,7 +726,8 @@
(
ProcIds = [],
pred_info_get_clauses_info(PredInfo, ClausesInfo),
- clauses_info_clauses_only(ClausesInfo, Clauses),
+ clauses_info_get_clauses_rep(ClausesInfo, ClausesRep, _ItemNumbers),
+ get_clause_list(ClausesRep, Clauses),
Goals = list.map(func(Clause) = clause_body(Clause), Clauses),
Indent = 0,
list.foldl(dump_goal_goal_paths(Indent), Goals, !IO)
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.341
diff -u -b -r1.341 polymorphism.m
--- compiler/polymorphism.m 21 Jul 2009 04:10:41 -0000 1.341
+++ compiler/polymorphism.m 6 Aug 2009 14:03:26 -0000
@@ -575,13 +575,15 @@
polymorphism_process_clause_info(PredInfo0, ModuleInfo0, !ClausesInfo, !:Info,
ExtraArgModes) :-
init_poly_info(ModuleInfo0, PredInfo0, !.ClausesInfo, !:Info),
- clauses_info_get_headvars(!.ClausesInfo, HeadVars0),
+ !.ClausesInfo = clauses_info(_VarSet, ExplicitVarTypes, _TVarNameMap,
+ _VarTypes, HeadVars0, ClausesRep0, ItemNumbers,
+ _RttiVarMaps, HaveForeignClauses),
setup_headvars(PredInfo0, HeadVars0, HeadVars,
ExtraArgModes, UnconstrainedTVars,
ExtraTypeInfoHeadVars, ExistTypeClassInfoHeadVars, !Info),
- clauses_info_clauses_only(!.ClausesInfo, Clauses0),
+ get_clause_list(ClausesRep0, Clauses0),
list.map_foldl(
polymorphism_process_clause(PredInfo0, HeadVars0, HeadVars,
UnconstrainedTVars, ExtraTypeInfoHeadVars,
@@ -592,12 +594,11 @@
poly_info_get_varset(!.Info, VarSet),
poly_info_get_var_types(!.Info, VarTypes),
poly_info_get_rtti_varmaps(!.Info, RttiVarMaps),
- clauses_info_get_explicit_vartypes(!.ClausesInfo, ExplicitVarTypes),
set_clause_list(Clauses, ClausesRep),
map.init(TVarNameMap), % This is only used while adding the clauses.
!:ClausesInfo = clauses_info(VarSet, ExplicitVarTypes, TVarNameMap,
- VarTypes, HeadVars, ClausesRep, RttiVarMaps,
- !.ClausesInfo ^ have_foreign_clauses).
+ VarTypes, HeadVars, ClausesRep, ItemNumbers,
+ RttiVarMaps, HaveForeignClauses).
:- pred polymorphism_process_clause(pred_info::in,
proc_arg_vector(prog_var)::in, proc_arg_vector(prog_var)::in,
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.133
diff -u -b -r1.133 post_typecheck.m
--- compiler/post_typecheck.m 11 Jun 2009 07:00:16 -0000 1.133
+++ compiler/post_typecheck.m 10 Aug 2009 06:59:35 -0000
@@ -565,7 +565,8 @@
promise_ex_goal(ModuleInfo, ExclusiveDeclPredId, Goal) :-
module_info_pred_info(ModuleInfo, ExclusiveDeclPredId, PredInfo),
pred_info_get_clauses_info(PredInfo, ClausesInfo),
- clauses_info_clauses_only(ClausesInfo, Clauses),
+ clauses_info_get_clauses_rep(ClausesInfo, ClausesRep, _ItemNumbers),
+ get_clause_list(ClausesRep, Clauses),
( Clauses = [clause(_ProcIds, Goal0, _Lang, _Context)] ->
assertion.normalise_goal(Goal0, Goal)
;
Index: compiler/proc_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/proc_gen.m,v
retrieving revision 1.32
diff -u -b -r1.32 proc_gen.m
--- compiler/proc_gen.m 7 Jul 2009 07:01:44 -0000 1.32
+++ compiler/proc_gen.m 5 Aug 2009 10:45:26 -0000
@@ -334,7 +334,7 @@
% Find out the approriate context for the predicate's interface events.
pred_info_get_clauses_info(PredInfo, ClausesInfo),
- get_clause_list(ClausesInfo ^ clauses_rep, Clauses),
+ get_clause_list(ClausesInfo ^ cli_rep, Clauses),
(
Clauses = [],
% This predicate must have been created by the compiler. In that case,
Index: compiler/prop_mode_constraints.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prop_mode_constraints.m,v
retrieving revision 1.24
diff -u -b -r1.24 prop_mode_constraints.m
--- compiler/prop_mode_constraints.m 21 Jul 2009 04:10:42 -0000 1.24
+++ compiler/prop_mode_constraints.m 10 Aug 2009 05:19:27 -0000
@@ -231,23 +231,25 @@
ensure_unique_arguments(PredId, !ModuleInfo) :-
module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
pred_info_get_clauses_info(PredInfo0, ClausesInfo0),
- clauses_info_clauses_only(ClausesInfo0, Clauses0),
+ clauses_info_get_clauses_rep(ClausesInfo0, ClausesRep0, ItemNumbers),
clauses_info_get_varset(ClausesInfo0, Varset0),
clauses_info_get_vartypes(ClausesInfo0, VarTypes0),
clauses_info_get_headvars(ClausesInfo0, HeadVars),
SeenSoFar = proc_arg_vector_to_set(HeadVars),
+ get_clause_list(ClausesRep0, Clauses0),
BodyGoals0 = list.map(func(X) = clause_body(X), Clauses0),
list.map_foldl3(ensure_unique_arguments_in_goal, BodyGoals0, BodyGoals,
SeenSoFar, _, Varset0, Varset, VarTypes0, VarTypes),
Clauses = list.map_corresponding(func(C, B) = C ^ clause_body := B,
Clauses0, BodyGoals),
+ set_clause_list(Clauses, ClausesRep),
some [!ClausesInfo] (
!:ClausesInfo = ClausesInfo0,
clauses_info_set_varset(Varset, !ClausesInfo),
clauses_info_set_vartypes(VarTypes, !ClausesInfo),
- clauses_info_set_clauses(Clauses, !ClausesInfo),
+ clauses_info_set_clauses_rep(ClausesRep, ItemNumbers, !ClausesInfo),
pred_info_set_clauses_info(!.ClausesInfo, PredInfo0, PredInfo)
),
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo).
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.130
diff -u -b -r1.130 purity.m
--- compiler/purity.m 14 Aug 2009 20:37:48 -0000 1.130
+++ compiler/purity.m 17 Aug 2009 06:46:26 -0000
@@ -312,7 +312,7 @@
pred_info_get_promised_purity(!.PredInfo, PromisedPurity),
some [!ClausesInfo] (
pred_info_get_clauses_info(!.PredInfo, !:ClausesInfo),
- clauses_info_clauses(Clauses0, !ClausesInfo),
+ clauses_info_clauses(Clauses0, ItemNumbers, !ClausesInfo),
clauses_info_get_vartypes(!.ClausesInfo, VarTypes0),
clauses_info_get_varset(!.ClausesInfo, VarSet0),
PurityInfo0 = purity_info(ModuleInfo, run_post_typecheck,
@@ -323,7 +323,8 @@
VarTypes, VarSet, GoalSpecs, _),
clauses_info_set_vartypes(VarTypes, !ClausesInfo),
clauses_info_set_varset(VarSet, !ClausesInfo),
- clauses_info_set_clauses(Clauses, !ClausesInfo),
+ set_clause_list(Clauses, ClausesRep),
+ clauses_info_set_clauses_rep(ClausesRep, ItemNumbers, !ClausesInfo),
pred_info_set_clauses_info(!.ClausesInfo, !PredInfo)
),
WorstPurity = Purity,
@@ -507,15 +508,15 @@
:- pred applies_to_all_modes(clause::in, list(proc_id)::in) is semidet.
-applies_to_all_modes(clause(ClauseProcIds, _, _, _), ProcIds) :-
+applies_to_all_modes(clause(ApplicableProcIds, _, _, _), AllProcIds) :-
(
- % An empty list here means that the clause applies to *all* procedures.
- ClauseProcIds = []
+ ApplicableProcIds = all_modes
;
+ ApplicableProcIds = selected_modes(ClauseProcIds),
% Otherwise the clause applies to the procids in the list.
% Check if this is the same as the procids for this procedure.
- list.sort(ClauseProcIds, SortedIds),
- SortedIds = ProcIds
+ list.sort(ClauseProcIds, SortedClauseProcIds),
+ SortedClauseProcIds = AllProcIds
).
:- pred compute_expr_purity(hlds_goal_expr::in, hlds_goal_expr::out,
Index: compiler/rbmm.points_to_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rbmm.points_to_analysis.m,v
retrieving revision 1.11
diff -u -b -r1.11 rbmm.points_to_analysis.m
--- compiler/rbmm.points_to_analysis.m 11 Jun 2009 07:00:18 -0000 1.11
+++ compiler/rbmm.points_to_analysis.m 11 Aug 2009 07:35:48 -0000
@@ -436,14 +436,6 @@
list.foldl2(inter_analyse_case(ModuleInfo, InfoTable), Cases,
!FPTable, !RptaInfo).
-:- pred inter_analyse_case(module_info::in,
- rpta_info_table::in, case::in, rpta_fixpoint_table::in,
- rpta_fixpoint_table::out, rpta_info::in, rpta_info::out) is det.
-
-inter_analyse_case(ModuleInfo, InfoTable, Case, !FPtable, !RptaInfo) :-
- Case = case(_, _, Goal),
- inter_analyse_goal(ModuleInfo, InfoTable, Goal, !FPtable, !RptaInfo).
-
% Unifications are ignored in interprocedural analysis
%
inter_analyse_goal_expr(unify(_, _, _, _, _), _, _, _, !FPTable, !RptaInfo).
@@ -493,6 +485,14 @@
unexpected(this_file,
"inter_analyse_goal_expr: shorthand goal not handled").
+:- pred inter_analyse_case(module_info::in,
+ rpta_info_table::in, case::in, rpta_fixpoint_table::in,
+ rpta_fixpoint_table::out, rpta_info::in, rpta_info::out) is det.
+
+inter_analyse_case(ModuleInfo, InfoTable, Case, !FPtable, !RptaInfo) :-
+ Case = case(_, _, Goal),
+ inter_analyse_goal(ModuleInfo, InfoTable, Goal, !FPtable, !RptaInfo).
+
%-----------------------------------------------------------------------------%
% As said above, the rpta_info of a procedure when it is looked
Index: compiler/type_constraints.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_constraints.m,v
retrieving revision 1.5
diff -u -b -r1.5 type_constraints.m
--- compiler/type_constraints.m 11 Jun 2009 07:00:20 -0000 1.5
+++ compiler/type_constraints.m 10 Aug 2009 05:36:18 -0000
@@ -252,7 +252,7 @@
)
->
pred_info_get_clauses_info(PredInfo, ClausesInfo0),
- clauses_info_get_clauses_rep(ClausesInfo0, ClausesRep0),
+ clauses_info_get_clauses_rep(ClausesInfo0, ClausesRep0, _ItemNumbers),
IsEmpty = clause_list_is_empty(ClausesRep0),
(
IsEmpty = yes,
@@ -286,7 +286,8 @@
pred_info_get_context(!.PredInfo, Context),
pred_info_get_clauses_info(!.PredInfo, !:ClausesInfo),
clauses_info_get_varset(!.ClausesInfo, ProgVarSet),
- clauses_info_clauses_only(!.ClausesInfo, !:Clauses),
+ clauses_info_get_clauses_rep(!.ClausesInfo, ClausesRep0, ItemNumbers),
+ get_clause_list(ClausesRep0, !:Clauses),
trace [compile_time(flag("type_error_diagnosis")), io(!IO)] (
LineNumber = string.int_to_string(term.context_line(Context)),
@@ -336,7 +337,8 @@
list.map_corresponding(set_clause_body, !.Goals, !Clauses),
list.condense([VarTypeErrors | PredErrors], NewErrors),
list.foldl(add_message_to_spec, NewErrors, !TCInfo),
- clauses_info_set_clauses(!.Clauses, !ClausesInfo),
+ set_clause_list(!.Clauses, ClausesRep),
+ clauses_info_set_clauses_rep(ClausesRep, ItemNumbers, !ClausesInfo),
list.foldl(add_unused_prog_var(!.TCInfo), HeadVars, !Vartypes),
clauses_info_set_vartypes(!.Vartypes, !ClausesInfo),
pred_info_set_clauses_info(!.ClausesInfo, !PredInfo),
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.440
diff -u -b -r1.440 typecheck.m
--- compiler/typecheck.m 11 Jun 2009 07:00:21 -0000 1.440
+++ compiler/typecheck.m 11 Aug 2009 11:24:06 -0000
@@ -352,7 +352,7 @@
)
->
pred_info_get_clauses_info(!.PredInfo, ClausesInfo0),
- clauses_info_get_clauses_rep(ClausesInfo0, ClausesRep0),
+ clauses_info_get_clauses_rep(ClausesInfo0, ClausesRep0, _ItemNumbers),
IsEmpty = clause_list_is_empty(ClausesRep0),
(
IsEmpty = yes,
@@ -388,7 +388,7 @@
pred_info_get_arg_types(!.PredInfo, _ArgTypeVarSet, ExistQVars0,
ArgTypes0),
pred_info_get_clauses_info(!.PredInfo, ClausesInfo0),
- clauses_info_get_clauses_rep(ClausesInfo0, ClausesRep0),
+ clauses_info_get_clauses_rep(ClausesInfo0, ClausesRep0, ItemNumbers0),
pred_info_get_markers(!.PredInfo, Markers0),
% Handle the --allow-stubs and --warn-stubs options. If --allow-stubs
% is set, and there are no clauses, issue a warning (if --warn-stubs
@@ -401,8 +401,8 @@
globals.lookup_bool_option(Globals, allow_stubs, yes),
\+ check_marker(Markers0, marker_class_method)
->
- StartingSpecs = [report_no_clauses_stub(!.ModuleInfo, PredId,
- !.PredInfo)],
+ Spec = report_no_clauses_stub(!.ModuleInfo, PredId, !.PredInfo),
+ StartingSpecs = [Spec],
generate_stub_clause(PredId, !PredInfo, !.ModuleInfo)
;
check_marker(Markers0, marker_builtin_stub)
@@ -414,11 +414,29 @@
)
;
ClausesRep0IsEmpty = no,
+ globals.lookup_bool_option(Globals, warn_non_contiguous_foreign_procs,
+ WarnNonContiguousForeignProcs),
+ (
+ WarnNonContiguousForeignProcs = yes,
+ StartingSpecs = report_any_non_contiguous_clauses(!.ModuleInfo,
+ PredId, !.PredInfo, ItemNumbers0, clauses_and_foreign_procs)
+ ;
+ WarnNonContiguousForeignProcs = no,
+ globals.lookup_bool_option(Globals, warn_non_contiguous_clauses,
+ WarnNonContiguousClauses),
+ (
+ WarnNonContiguousClauses = yes,
+ StartingSpecs = report_any_non_contiguous_clauses(!.ModuleInfo,
+ PredId, !.PredInfo, ItemNumbers0, only_clauses)
+ ;
+ WarnNonContiguousClauses = no,
StartingSpecs = []
+ )
+ )
),
some [!ClausesInfo, !Info, !HeadTypeParams] (
pred_info_get_clauses_info(!.PredInfo, !:ClausesInfo),
- clauses_info_get_clauses_rep(!.ClausesInfo, ClausesRep1),
+ clauses_info_get_clauses_rep(!.ClausesInfo, ClausesRep1, ItemNumbers),
clauses_info_get_headvar_list(!.ClausesInfo, HeadVars),
clauses_info_get_varset(!.ClausesInfo, VarSet),
clauses_info_get_explicit_vartypes(!.ClausesInfo, ExplicitVarTypes0),
@@ -522,7 +540,9 @@
ExplicitVarTypes1, ExplicitVarTypes),
clauses_info_set_explicit_vartypes(ExplicitVarTypes, !ClausesInfo),
- clauses_info_set_clauses(Clauses, !ClausesInfo),
+ set_clause_list(Clauses, ClausesRep),
+ clauses_info_set_clauses_rep(ClausesRep, ItemNumbers,
+ !ClausesInfo),
pred_info_set_clauses_info(!.ClausesInfo, !PredInfo),
pred_info_set_typevarset(TypeVarSet, !PredInfo),
pred_info_set_constraint_proofs(ConstraintProofs, !PredInfo),
@@ -633,6 +653,22 @@
)
).
+:- func report_any_non_contiguous_clauses(module_info, pred_id, pred_info,
+ clause_item_numbers, clause_item_number_types) = list(error_spec).
+
+report_any_non_contiguous_clauses(ModuleInfo, PredId, PredInfo,
+ ItemNumbers, Type) = Specs :-
+ (
+ clauses_are_non_contiguous(ItemNumbers, Type,
+ FirstRegion, SecondRegion, LaterRegions)
+ ->
+ Spec = report_non_contiguous_clauses(ModuleInfo, PredId,
+ PredInfo, FirstRegion, SecondRegion, LaterRegions),
+ Specs = [Spec]
+ ;
+ Specs = []
+ ).
+
:- pred check_existq_clause(tvarset::in, existq_tvars::in, clause::in,
typecheck_info::in, typecheck_info::out) is det.
@@ -681,7 +717,9 @@
PredName = error_pieces_to_string(PredPieces),
generate_stub_clause_2(PredName, !PredInfo, ModuleInfo, StubClause,
VarSet0, VarSet),
- clauses_info_set_clauses([StubClause], !ClausesInfo),
+ set_clause_list([StubClause], ClausesRep),
+ ItemNumbers = init_clause_item_numbers_comp_gen,
+ clauses_info_set_clauses_rep(ClausesRep, ItemNumbers, !ClausesInfo),
clauses_info_set_varset(VarSet, !ClausesInfo),
pred_info_set_clauses_info(!.ClausesInfo, !PredInfo)
).
@@ -716,7 +754,7 @@
% Combine the unification and call into a conjunction.
goal_info_init(Context, GoalInfo),
Body = hlds_goal(conj(plain_conj, [UnifyGoal, CallGoal]), GoalInfo),
- StubClause = clause([], Body, impl_lang_mercury, Context).
+ StubClause = clause(all_modes, Body, impl_lang_mercury, Context).
:- pred rename_instance_method_constraints(tvar_renaming::in,
pred_origin::in, pred_origin::out) is det.
@@ -909,7 +947,7 @@
maybe_add_field_access_function_clause(ModuleInfo, !PredInfo) :-
pred_info_get_import_status(!.PredInfo, ImportStatus),
pred_info_get_clauses_info(!.PredInfo, ClausesInfo0),
- clauses_info_get_clauses_rep(ClausesInfo0, ClausesRep0),
+ clauses_info_get_clauses_rep(ClausesInfo0, ClausesRep0, _ItemNumbers0),
(
pred_info_is_field_access_function(ModuleInfo, !.PredInfo),
clause_list_is_empty(ClausesRep0) = yes,
@@ -931,9 +969,11 @@
NonLocals = proc_arg_vector_to_set(HeadVars),
goal_info_set_nonlocals(NonLocals, GoalInfo0, GoalInfo),
Goal = hlds_goal(GoalExpr, GoalInfo),
- ProcIds = [], % The clause applies to all procedures.
- Clause = clause(ProcIds, Goal, impl_lang_mercury, Context),
- clauses_info_set_clauses([Clause], ClausesInfo0, ClausesInfo),
+ Clause = clause(all_modes, Goal, impl_lang_mercury, Context),
+ set_clause_list([Clause], ClausesRep),
+ ItemNumbers = init_clause_item_numbers_comp_gen,
+ clauses_info_set_clauses_rep(ClausesRep, ItemNumbers,
+ ClausesInfo0, ClausesInfo),
pred_info_update_goal_type(goal_type_clause_and_foreign, !PredInfo),
pred_info_set_clauses_info(ClausesInfo, !PredInfo),
pred_info_get_markers(!.PredInfo, Markers0),
Index: compiler/typecheck_errors.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck_errors.m,v
retrieving revision 1.43
diff -u -b -r1.43 typecheck_errors.m
--- compiler/typecheck_errors.m 11 Jun 2009 07:00:21 -0000 1.43
+++ compiler/typecheck_errors.m 11 Aug 2009 06:13:57 -0000
@@ -18,6 +18,7 @@
:- import_module check_hlds.typecheck_info.
:- import_module hlds.
+:- import_module hlds.hlds_clauses.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
@@ -51,6 +52,10 @@
:- func report_no_clauses_stub(module_info, pred_id, pred_info) = error_spec.
+:- func report_non_contiguous_clauses(module_info, pred_id, pred_info,
+ clause_item_number_region, clause_item_number_region,
+ list(clause_item_number_region)) = error_spec.
+
:- func report_warning_too_much_overloading(typecheck_info) = error_spec.
:- func report_error_too_much_overloading(typecheck_info) = error_spec.
@@ -353,6 +358,66 @@
%-----------------------------------------------------------------------------%
+report_non_contiguous_clauses(ModuleInfo, PredId, PredInfo,
+ FirstRegion, SecondRegion, LaterRegions) = Spec :-
+ PredPieces = describe_one_pred_name(ModuleInfo, should_not_module_qualify,
+ PredId),
+ FrontPieces = [words("Warning: non-contiguous clauses for ") | PredPieces]
+ ++ [suffix(".")],
+ pred_info_get_context(PredInfo, Context),
+ FrontMsg = simple_msg(Context, [always(FrontPieces)]),
+ report_non_contiguous_clause_contexts(PredPieces, 1,
+ FirstRegion, SecondRegion, LaterRegions, ContextMsgs),
+ Msgs = [FrontMsg | ContextMsgs],
+ Severity = severity_conditional(warn_non_contiguous_clauses, yes,
+ severity_warning, no),
+ Spec = error_spec(Severity, phase_type_check, Msgs).
+
+:- pred report_non_contiguous_clause_contexts(list(format_component)::in,
+ int::in, clause_item_number_region::in, clause_item_number_region::in,
+ list(clause_item_number_region)::in, list(error_msg)::out) is det.
+
+report_non_contiguous_clause_contexts(PredPieces, GapNumber,
+ FirstRegion, SecondRegion, LaterRegions, Msgs) :-
+ FirstRegion =
+ clause_item_number_region(_FirstLowerNumber, _FirstUpperNumber,
+ _FirstLowerContext, FirstUpperContext),
+ SecondRegion =
+ clause_item_number_region(_SecondLowerNumber, _SecondUpperNumber,
+ SecondLowerContext, _SecondUpperContext),
+ (
+ GapNumber = 1,
+ LaterRegions = []
+ ->
+ % There is only one gap, so don't number it.
+ GapPieces = []
+ ;
+ GapPieces = [int_fixed(GapNumber)]
+ ),
+ % The wording here is chosen be non-confusing even if a clause has a gap
+ % both before and after it, so that gaps both end and start at the context
+ % of that clause. We could do better if we had separate contexts for the
+ % start and the end of the clause, but we don't.
+ FirstPieces = [words("Gap") | GapPieces] ++
+ [words("in clauses of") | PredPieces] ++
+ [words("starts after this clause.")],
+ SecondPieces = [words("Gap") | GapPieces] ++
+ [words("in clauses of") | PredPieces] ++
+ [words("ends with this clause.")],
+ FirstMsg = simple_msg(FirstUpperContext, [always(FirstPieces)]),
+ SecondMsg = simple_msg(SecondLowerContext, [always(SecondPieces)]),
+ (
+ LaterRegions = [],
+ Msgs = [FirstMsg, SecondMsg]
+ ;
+ LaterRegions = [FirstLaterRegion | LaterLaterRegions],
+ report_non_contiguous_clause_contexts(PredPieces, GapNumber + 1,
+ SecondRegion, FirstLaterRegion, LaterLaterRegions, LaterMsgs),
+ Msgs = [FirstMsg, SecondMsg | LaterMsgs]
+ ).
+
+%-----------------------------------------------------------------------------%
+
report_warning_too_much_overloading(Info) = Spec :-
Msgs = too_much_overloading_to_msgs(Info, no),
Spec = error_spec(severity_warning, phase_type_check, Msgs).
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.205
diff -u -b -r1.205 unify_proc.m
--- compiler/unify_proc.m 21 Jul 2009 02:08:50 -0000 1.205
+++ compiler/unify_proc.m 10 Aug 2009 17:17:54 -0000
@@ -561,7 +561,8 @@
rtti_varmaps_init(RttiVarMaps),
HasForeignClauses = yes,
ClauseInfo = clauses_info(VarSet, Types, TVarNameMap, Types, ArgVec,
- ClausesRep, RttiVarMaps, HasForeignClauses).
+ ClausesRep, init_clause_item_numbers_comp_gen,
+ RttiVarMaps, HasForeignClauses).
:- pred generate_initialise_proc_body(mer_type::in, hlds_type_body::in,
prog_var::in, prog_context::in, clause::out,
@@ -2002,7 +2003,7 @@
info_set_varset(Varset, !Info),
info_set_types(Types, !Info),
info_set_rtti_varmaps(RttiVarMaps, !Info),
- Clause = clause([], Goal, impl_lang_mercury, Context).
+ Clause = clause(all_modes, Goal, impl_lang_mercury, Context).
%-----------------------------------------------------------------------------%
Index: compiler/unused_imports.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unused_imports.m,v
retrieving revision 1.20
diff -u -b -r1.20 unused_imports.m
--- compiler/unused_imports.m 11 Jun 2009 07:00:22 -0000 1.20
+++ compiler/unused_imports.m 5 Aug 2009 17:09:59 -0000
@@ -362,7 +362,7 @@
used_modules::in, used_modules::out) is det.
clauses_info_used_modules(ClausesInfo, !UsedModules) :-
- clauses_info_get_clauses_rep(ClausesInfo, ClausesRep),
+ clauses_info_get_clauses_rep(ClausesInfo, ClausesRep, _ItemNumbers),
get_clause_list(ClausesRep, Clauses),
list.foldl(clause_used_modules, Clauses, !UsedModules).
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
Index: deep_profiler/measurements.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/deep_profiler/measurements.m,v
retrieving revision 1.14
diff -u -b -r1.14 measurements.m
--- deep_profiler/measurements.m 2 Apr 2009 09:49:27 -0000 1.14
+++ deep_profiler/measurements.m 11 Aug 2009 08:15:28 -0000
@@ -199,44 +199,49 @@
).
calls(own_prof_fast_nomem_semi(Exits, Fails, _)) = Exits + Fails.
-exits(own_prof_fast_nomem_semi(Exits, _, _)) = Exits.
-fails(own_prof_fast_nomem_semi(_, Fails, _)) = Fails.
-redos(own_prof_fast_nomem_semi(_, _, _)) = 0.
-excps(own_prof_fast_nomem_semi(_, _, _)) = 0.
-callseqs(own_prof_fast_nomem_semi(_, _, CallSeqs)) = CallSeqs.
-quanta(own_prof_fast_nomem_semi(_, _, _)) = 0.
-allocs(own_prof_fast_nomem_semi(_, _, _)) = 0.
-words(own_prof_fast_nomem_semi(_, _, _)) = 0.
-
calls(own_prof_fast_det(Exits, _, _, _)) = Exits.
-exits(own_prof_fast_det(Exits, _, _, _)) = Exits.
-fails(own_prof_fast_det(_, _, _, _)) = 0.
-redos(own_prof_fast_det(_, _, _, _)) = 0.
-excps(own_prof_fast_det(_, _, _, _)) = 0.
-quanta(own_prof_fast_det(_, _, _, _)) = 0.
-callseqs(own_prof_fast_det(_, CallSeqs, _, _)) = CallSeqs.
-allocs(own_prof_fast_det(_, _, Allocs, _)) = Allocs.
-words(own_prof_fast_det(_, _, _, Words)) = Words.
-
calls(own_prof_det(Exits, _, _, _, _)) = Exits.
-exits(own_prof_det(Exits, _, _, _, _)) = Exits.
-fails(own_prof_det(_, _, _, _, _)) = 0.
-redos(own_prof_det(_, _, _, _, _)) = 0.
-excps(own_prof_det(_, _, _, _, _)) = 0.
-quanta(own_prof_det(_, Quanta, _, _, _)) = Quanta.
-callseqs(own_prof_det(_, _, CallSeqs, _, _)) = CallSeqs.
-allocs(own_prof_det(_, _, _, Allocs, _)) = Allocs.
-words(own_prof_det(_, _, _, _, Words)) = Words.
-
calls(own_prof_all(Exits, Fails, Redos, Excps, _, _, _, _)) =
Exits + Fails + Excps - Redos.
+
+exits(own_prof_fast_nomem_semi(Exits, _, _)) = Exits.
+exits(own_prof_fast_det(Exits, _, _, _)) = Exits.
+exits(own_prof_det(Exits, _, _, _, _)) = Exits.
exits(own_prof_all(Exits, _, _, _, _, _, _, _)) = Exits.
+
+fails(own_prof_fast_nomem_semi(_, Fails, _)) = Fails.
+fails(own_prof_fast_det(_, _, _, _)) = 0.
+fails(own_prof_det(_, _, _, _, _)) = 0.
fails(own_prof_all(_, Fails, _, _, _, _, _, _)) = Fails.
+
+redos(own_prof_fast_nomem_semi(_, _, _)) = 0.
+redos(own_prof_fast_det(_, _, _, _)) = 0.
+redos(own_prof_det(_, _, _, _, _)) = 0.
redos(own_prof_all(_, _, Redos, _, _, _, _, _)) = Redos.
+
+excps(own_prof_fast_nomem_semi(_, _, _)) = 0.
+excps(own_prof_fast_det(_, _, _, _)) = 0.
+excps(own_prof_det(_, _, _, _, _)) = 0.
excps(own_prof_all(_, _, _, Excps, _, _, _, _)) = Excps.
+
+quanta(own_prof_fast_nomem_semi(_, _, _)) = 0.
+quanta(own_prof_fast_det(_, _, _, _)) = 0.
+quanta(own_prof_det(_, Quanta, _, _, _)) = Quanta.
quanta(own_prof_all(_, _, _, _, Quanta, _, _, _)) = Quanta.
+
+callseqs(own_prof_fast_nomem_semi(_, _, CallSeqs)) = CallSeqs.
+callseqs(own_prof_fast_det(_, CallSeqs, _, _)) = CallSeqs.
+callseqs(own_prof_det(_, _, CallSeqs, _, _)) = CallSeqs.
callseqs(own_prof_all(_, _, _, _, _, CallSeqs, _, _)) = CallSeqs.
+
+allocs(own_prof_fast_nomem_semi(_, _, _)) = 0.
+allocs(own_prof_fast_det(_, _, Allocs, _)) = Allocs.
+allocs(own_prof_det(_, _, _, Allocs, _)) = Allocs.
allocs(own_prof_all(_, _, _, _, _, _, Allocs, _)) = Allocs.
+
+words(own_prof_fast_nomem_semi(_, _, _)) = 0.
+words(own_prof_fast_det(_, _, _, Words)) = Words.
+words(own_prof_det(_, _, _, _, Words)) = Words.
words(own_prof_all(_, _, _, _, _, _, _, Words)) = Words.
zero_own_prof_info = own_prof_fast_nomem_semi(0, 0, 0).
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.589
diff -u -b -r1.589 user_guide.texi
--- doc/user_guide.texi 12 Aug 2009 01:56:25 -0000 1.589
+++ doc/user_guide.texi 17 Aug 2009 06:46:26 -0000
@@ -6176,11 +6176,23 @@
Warn about @samp{.trans_opt} files that cannot be opened.
@sp 1
+ at item --no-warn-non-contiguous-clauses
+ at findex --no-warn-non-contiguous-clauses
+Do not generate a warning if the clauses of a predicate or function
+are not contiguous.
+
+ at sp 1
+ at item --warn-non-contiguous-foreign-procs
+ at findex --warn-non-contiguous-foreign-procs
+Generate a warning if the clauses and foreign_procs of a predicate
+or function are not contiguous.
+
+ at sp 1
@item --warn-non-stratification
@findex --warn-non-stratification
-Warn about possible non-stratification of the predicates/functions in the
-module.
-Non-stratification occurs when a predicate/function can call itself
+Warn about possible non-stratification of the predicates and/or functions
+in the module.
+Non-stratification occurs when a predicate or function can call itself
negatively through some path along its call graph.
@sp 1
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
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/fixed
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_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
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/log4m
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/mopenssl
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/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
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/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
Index: library/bit_buffer.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/bit_buffer.m,v
retrieving revision 1.2
diff -u -b -r1.2 bit_buffer.m
--- library/bit_buffer.m 31 May 2007 03:03:36 -0000 1.2
+++ library/bit_buffer.m 10 Aug 2009 20:52:18 -0000
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% vim: ts=4 sw=4 et tw=0 wm=0 ft=mercury
+% vim: ts=4 sw=4 et ft=mercury
%-----------------------------------------------------------------------------%
% Copyright (C) 2007 The University of Melbourne
% This file may only be copied under the terms of the GNU Library General
@@ -38,8 +38,7 @@
%
:- type error_stream ---> error_stream.
:- type error_state ---> error_state.
-:- type error_stream_error
- ---> error_stream_error.
+:- type error_stream_error ---> error_stream_error.
:- instance stream.error(error_stream_error).
:- instance stream.stream(error_stream, error_state).
:- instance stream.input(error_stream, error_state).
@@ -114,14 +113,13 @@
% For write buffers only.
% If we're not writing to a stream, keep a list of filled
- % bitmaps in reverse order. These will be concatenated
- % into a single bitmap by finalize_to_bitmap.
+ % bitmaps in reverse order. These will be concatenated into
+ % a single bitmap by finalize_to_bitmap.
%
mer_filled_bitmaps :: list(bitmap),
- % For read buffers only. The first error found
- % when reading from a stream. Subsequent calls
- % will return this error.
+ % For read buffers only. The first error found when reading
+ % from a stream. Subsequent calls will return this error.
%
mer_read_status :: stream.res(Error)
).
@@ -211,61 +209,69 @@
:- pragma foreign_proc("C",
bitmap(Buffer::bit_buffer_ui) = (BM::bitmap_uo),
[will_not_call_mercury, promise_pure],
- "BM = Buffer->ML_bit_buffer_bitmap;"
-).
+"
+ BM = Buffer->ML_bit_buffer_bitmap;
+").
:- pragma foreign_proc("C",
pos(Buffer::bit_buffer_ui) = (Pos::out),
[will_not_call_mercury, promise_pure],
- "Pos = Buffer->ML_bit_buffer_pos;"
-).
+"
+ Pos = Buffer->ML_bit_buffer_pos;
+").
:- pragma foreign_proc("C",
size(Buffer::bit_buffer_ui) = (Size::out),
[will_not_call_mercury, promise_pure],
- "Size = Buffer->ML_bit_buffer_size;"
-).
+"
+ Size = Buffer->ML_bit_buffer_size;
+").
:- pragma foreign_proc("C",
use_stream(Buffer::bit_buffer_ui) = (UseStream::out),
[will_not_call_mercury, promise_pure],
- "UseStream = Buffer->ML_bit_buffer_use_stream;"
-).
+"
+ UseStream = Buffer->ML_bit_buffer_use_stream;
+").
:- pragma foreign_proc("C",
stream(Buffer::bit_buffer_ui) = (Stream::out),
[will_not_call_mercury, promise_pure],
- "Stream = Buffer->ML_bit_buffer_stream;"
-).
+"
+ Stream = Buffer->ML_bit_buffer_stream;
+").
:- pragma foreign_proc("C",
state(Buffer::bit_buffer_ui) = (State::uo),
[will_not_call_mercury, promise_pure],
- "State = Buffer->ML_bit_buffer_state;"
-).
+"
+ State = Buffer->ML_bit_buffer_state;
+").
:- pragma foreign_proc("C",
filled_bitmaps(Buffer::bit_buffer_ui) = (FilledBMs::out),
[will_not_call_mercury, promise_pure],
- "FilledBMs = Buffer->ML_bit_buffer_filled_bitmaps;"
-).
+"
+ FilledBMs = Buffer->ML_bit_buffer_filled_bitmaps;
+").
:- pragma foreign_proc("C",
read_status(Buffer::bit_buffer_ui) = (ReadStatus::out),
[will_not_call_mercury, promise_pure],
- "ReadStatus = Buffer->ML_bit_buffer_read_status;"
-).
+"
+ ReadStatus = Buffer->ML_bit_buffer_read_status;
+").
:- pred set_all(bitmap::bitmap_di, bit_index::in, num_bits::in, State::di,
list(bitmap)::in, bit_buffer(Stream, State, Error)::bit_buffer_di,
bit_buffer(Stream, State, Error)::bit_buffer_uo) is det.
set_all(BM, Pos, Size, State, FilledBMs, !Buffer) :-
- !:Buffer = ((((!.Buffer ^ mer_bitmap := BM)
- ^ mer_pos := Pos)
- ^ mer_state := State)
- ^ mer_filled_bitmaps := FilledBMs)
- ^ mer_size := Size.
+ !Buffer ^ mer_bitmap := BM,
+ !Buffer ^ mer_pos := Pos,
+ !Buffer ^ mer_state := State,
+ !Buffer ^ mer_filled_bitmaps := FilledBMs,
+ !Buffer ^ mer_size := Size.
:- pragma foreign_proc("C",
set_all(BM::bitmap_di, Pos::in, Size::in, State::di, FilledBMs::in,
@@ -285,8 +291,8 @@
bit_buffer(Stream, State, Error)::bit_buffer_uo) is det.
set_bitmap(BM, Pos, !Buffer) :-
- !:Buffer = (!.Buffer ^ mer_bitmap := BM)
- ^ mer_pos := Pos.
+ !Buffer ^ mer_bitmap := BM,
+ !Buffer ^ mer_pos := Pos.
:- pragma foreign_proc("C",
set_bitmap(BM::bitmap_di, Pos::in,
Index: library/bitmap.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/bitmap.m,v
retrieving revision 1.31
diff -u -b -r1.31 bitmap.m
Index: library/library.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/library.m,v
retrieving revision 1.123
diff -u -b -r1.123 library.m
--- library/library.m 17 Jun 2009 07:48:16 -0000 1.123
+++ library/library.m 11 Aug 2009 05:45:34 -0000
@@ -162,6 +162,10 @@
:- import_module table_builtin.
:- import_module term_size_prof_builtin.
+:- pragma foreign_decl("Erlang", local, "
+-include(""erlang_conf.hrl"").
+").
+
% library.version must be implemented using pragma foreign_proc,
% so we can get at the MR_VERSION and MR_FULLARCH configuration
% parameters. We can't just generate library.m from library.m.in
@@ -202,10 +206,6 @@
+ jmercury.runtime.Constants.MR_FULLARCH;
").
-:- pragma foreign_decl("Erlang", local, "
--include(""erlang_conf.hrl"").
-").
-
:- pragma foreign_proc("Erlang",
library.version(Version::out),
[will_not_call_mercury, promise_pure, thread_safe],
Index: library/list.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/list.m,v
retrieving revision 1.181
diff -u -b -r1.181 list.m
--- library/list.m 13 Aug 2009 00:57:00 -0000 1.181
+++ library/list.m 17 Aug 2009 06:46:29 -0000
@@ -1745,6 +1745,13 @@
% reverse(A, B) <=> reverse(B, A).
:- pragma promise_equivalent_clauses(list.reverse/2).
+:- pragma foreign_proc("Erlang",
+ list.reverse(L0::in, L::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ L = lists:reverse(L0)
+").
+
list.reverse(L0::in, L::out) :-
list.reverse_2(L0, [], L).
@@ -1757,13 +1764,6 @@
list.reverse_2([X | Xs], L0, L) :-
list.reverse_2(Xs, [X | L0], L).
-:- pragma foreign_proc("Erlang",
- list.reverse(L0::in, L::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- L = lists:reverse(L0)
-").
-
%-----------------------------------------------------------------------------%
list.sort(L0, L) :-
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/c_interface/standalone_c
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
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 ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
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/types2.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/types2.err_exp,v
retrieving revision 1.2
diff -u -b -r1.2 types2.err_exp
--- tests/invalid/types2.err_exp 14 Aug 2009 20:37:55 -0000 1.2
+++ tests/invalid/types2.err_exp 17 Aug 2009 08:17:07 -0000
@@ -13,6 +13,9 @@
types2.m:014: in call to predicate `p'.
types2.m:017: Error: clause for predicate `types2.r'/0
types2.m:017: without preceding `pred' declaration.
+types2.m:017: Warning: non-contiguous clauses for predicate `r'/0.
+types2.m:017: Gap in clauses of predicate `r'/0 starts after this clause.
+types2.m:022: Gap in clauses of predicate `r'/0 ends with this clause.
types2.m:018: In clause for predicate `r'/0:
types2.m:018: error: undefined predicate `s'/0.
types2.m:020: Error: clause for predicate `types2.a'/1
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/stm
cvs diff: Diffing tests/stm/orig
cvs diff: Diffing tests/stm/orig/stm-compiler
cvs diff: Diffing tests/stm/orig/stm-compiler/test1
cvs diff: Diffing tests/stm/orig/stm-compiler/test10
cvs diff: Diffing tests/stm/orig/stm-compiler/test2
cvs diff: Diffing tests/stm/orig/stm-compiler/test3
cvs diff: Diffing tests/stm/orig/stm-compiler/test4
cvs diff: Diffing tests/stm/orig/stm-compiler/test5
cvs diff: Diffing tests/stm/orig/stm-compiler/test6
cvs diff: Diffing tests/stm/orig/stm-compiler/test7
cvs diff: Diffing tests/stm/orig/stm-compiler/test8
cvs diff: Diffing tests/stm/orig/stm-compiler/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/stmqueue
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test10
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test11
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test9
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
Index: tests/warnings/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/warnings/Mercury.options,v
retrieving revision 1.14
diff -u -b -r1.14 Mercury.options
--- tests/warnings/Mercury.options 14 Nov 2007 03:45:14 -0000 1.14
+++ tests/warnings/Mercury.options 11 Aug 2009 10:57:23 -0000
@@ -46,4 +46,18 @@
MCFLAGS-non_stratification = --warn-non-stratification --verbose-error-messages
-MCFLAGS-inst_with_no_type = --warn-insts-without-matching-type --intermodule-optimization --no-intermodule-analysis
+MCFLAGS-inst_with_no_type = \
+ --warn-insts-without-matching-type \
+ --intermodule-optimization \
+ --no-intermodule-analysis
+
+MCFLAGS-warn_contiguous_foreign = \
+ --warn-non-contiguous-clauses \
+ --no-warn-non-contiguous-foreign-procs
+MCFLAGS-warn_non_contiguous = \
+ --warn-non-contiguous-foreign-procs
+MCFLAGS-warn_non_contiguous_foreign = \
+ --warn-non-contiguous-foreign-procs
+MCFLAGS-warn_non_contiguous_foreign_group = \
+ --warn-non-contiguous-clauses \
+ --no-warn-non-contiguous-foreign-procs
Index: tests/warnings/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/warnings/Mmakefile,v
retrieving revision 1.46
diff -u -b -r1.46 Mmakefile
--- tests/warnings/Mmakefile 1 Dec 2008 00:32:58 -0000 1.46
+++ tests/warnings/Mmakefile 11 Aug 2009 11:04:50 -0000
@@ -18,9 +18,9 @@
double_underscore \
duplicate_call \
duplicate_const \
+ inf_recursion_lambda \
inference_test \
infinite_recursion \
- inf_recursion_lambda \
inst_with_no_type \
missing_if \
non_stratification \
@@ -34,6 +34,10 @@
unify_f_g \
unused_args_test \
unused_import \
+ warn_contiguous_foreign \
+ warn_non_contiguous \
+ warn_non_contiguous_foreign \
+ warn_non_contiguous_foreign_group \
warn_stubs
# We don't yet pass (or even have a .exp file for) this test.
Index: tests/warnings/warn_contiguous_foreign.exp
===================================================================
RCS file: tests/warnings/warn_contiguous_foreign.exp
diff -N tests/warnings/warn_contiguous_foreign.exp
Index: tests/warnings/warn_contiguous_foreign.m
===================================================================
RCS file: tests/warnings/warn_contiguous_foreign.m
diff -N tests/warnings/warn_contiguous_foreign.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/warnings/warn_contiguous_foreign.m 11 Aug 2009 05:30:25 -0000
@@ -0,0 +1,58 @@
+% vim: ts=4 sw=4 et ft=mercury
+
+% This is a test of the compiler's ability to properly AVOID reporting
+% non-contiguous clauses for a predicate when the totality of all clauses
+% and foreign_procs of a predicate are contiguous, but the applicable ones
+% are not contiguous.
+
+:- module warn_contiguous_foreign.
+:- interface.
+
+:- import_module io.
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module list.
+:- import_module string.
+
+main(!IO) :-
+ test(1, !IO),
+ test(3, !IO),
+ test(5, !IO),
+ test(7, !IO),
+ test(9, !IO),
+ test(11, !IO),
+ test(13, !IO).
+
+:- pred test(int::in, io::di, io::uo) is det.
+
+test(N, !IO) :-
+ p(N, M),
+ io.format("p(%d) = %d\n", [i(N), i(M)], !IO).
+
+:- pred p(int::in, int::out) is det.
+
+p(N, M) :-
+ M = N + 1.
+
+:- pragma foreign_proc("Java",
+ p(N::in, M::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ M = N + 1;
+").
+
+:- pragma foreign_proc("C",
+ p(N::in, M::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ M = N + 1;
+").
+
+:- pragma foreign_proc("Erlang",
+ p(N::in, M::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ M = N + 1
+").
Index: tests/warnings/warn_non_contiguous.exp
===================================================================
RCS file: tests/warnings/warn_non_contiguous.exp
diff -N tests/warnings/warn_non_contiguous.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/warnings/warn_non_contiguous.exp 11 Aug 2009 11:03:29 -0000
@@ -0,0 +1,14 @@
+warn_non_contiguous.m:040: Warning: non-contiguous clauses for predicate `p'/2.
+warn_non_contiguous.m:045: Gap in clauses of predicate `p'/2 starts after
+warn_non_contiguous.m:045: this clause.
+warn_non_contiguous.m:050: Gap in clauses of predicate `p'/2 ends with this
+warn_non_contiguous.m:050: clause.
+warn_non_contiguous.m:048: Warning: non-contiguous clauses for predicate `q'/2.
+warn_non_contiguous.m:042: Gap 1 in clauses of predicate `q'/2 starts after
+warn_non_contiguous.m:042: this clause.
+warn_non_contiguous.m:046: Gap 1 in clauses of predicate `q'/2 ends with this
+warn_non_contiguous.m:046: clause.
+warn_non_contiguous.m:046: Gap 2 in clauses of predicate `q'/2 starts after
+warn_non_contiguous.m:046: this clause.
+warn_non_contiguous.m:051: Gap 2 in clauses of predicate `q'/2 ends with this
+warn_non_contiguous.m:051: clause.
Index: tests/warnings/warn_non_contiguous.m
===================================================================
RCS file: tests/warnings/warn_non_contiguous.m
diff -N tests/warnings/warn_non_contiguous.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/warnings/warn_non_contiguous.m 10 Aug 2009 19:54:18 -0000
@@ -0,0 +1,52 @@
+% vim: ts=4 sw=4 et ft=mercury
+
+% This is a test of the compiler's ability to properly diagnose non-contiguous
+% clauses for a predicate.
+
+:- module warn_non_contiguous.
+:- interface.
+
+:- import_module io.
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module list.
+:- import_module string.
+
+main(!IO) :-
+ test(1, !IO),
+ test(3, !IO),
+ test(5, !IO),
+ test(7, !IO),
+ test(9, !IO),
+ test(11, !IO),
+ test(13, !IO).
+
+:- pred test(int::in, io::di, io::uo) is det.
+
+test(N, !IO) :-
+ ( p(N, PM) ->
+ io.format("p(%d) = %d\n", [i(N), i(PM)], !IO)
+ ;
+ io.format("p(%d) failed\n", [i(N)], !IO)
+ ),
+ ( q(N, QM) ->
+ io.format("q(%d) = %d\n", [i(N), i(QM)], !IO)
+ ;
+ io.format("q(%d) failed\n", [i(N)], !IO)
+ ).
+
+:- pred p(int::in, int::out) is semidet.
+
+q(10, 11).
+p(1, 2).
+p(2, 3).
+p(3, 4).
+q(11, 12).
+
+:- pred q(int::in, int::out) is semidet.
+
+p(0, 1).
+q(12, 13).
+q(13, 14).
Index: tests/warnings/warn_non_contiguous_foreign.exp
===================================================================
RCS file: tests/warnings/warn_non_contiguous_foreign.exp
diff -N tests/warnings/warn_non_contiguous_foreign.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/warnings/warn_non_contiguous_foreign.exp 11 Aug 2009 11:03:30 -0000
@@ -0,0 +1,16 @@
+warn_non_contiguous_foreign.m:051: Warning: non-contiguous clauses for
+warn_non_contiguous_foreign.m:051: predicate `p'/2.
+warn_non_contiguous_foreign.m:055: Gap in clauses of predicate `p'/2 starts
+warn_non_contiguous_foreign.m:055: after this clause.
+warn_non_contiguous_foreign.m:071: Gap in clauses of predicate `p'/2 ends
+warn_non_contiguous_foreign.m:071: with this clause.
+warn_non_contiguous_foreign.m:069: Warning: non-contiguous clauses for
+warn_non_contiguous_foreign.m:069: predicate `q'/2.
+warn_non_contiguous_foreign.m:053: Gap 1 in clauses of predicate `q'/2 starts
+warn_non_contiguous_foreign.m:053: after this clause.
+warn_non_contiguous_foreign.m:067: Gap 1 in clauses of predicate `q'/2 ends
+warn_non_contiguous_foreign.m:067: with this clause.
+warn_non_contiguous_foreign.m:067: Gap 2 in clauses of predicate `q'/2 starts
+warn_non_contiguous_foreign.m:067: after this clause.
+warn_non_contiguous_foreign.m:073: Gap 2 in clauses of predicate `q'/2 ends
+warn_non_contiguous_foreign.m:073: with this clause.
Index: tests/warnings/warn_non_contiguous_foreign.m
===================================================================
RCS file: tests/warnings/warn_non_contiguous_foreign.m
diff -N tests/warnings/warn_non_contiguous_foreign.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/warnings/warn_non_contiguous_foreign.m 10 Aug 2009 19:53:19 -0000
@@ -0,0 +1,83 @@
+% vim: ts=4 sw=4 et ft=mercury
+
+% This is a test of the compiler's ability to properly diagnose non-contiguous
+% clauses for a predicate, when some of those clauses are actually
+% foreign_procs.
+%
+% It is also a regression test for a bug that existed in versions of the
+% compiler prior to the addition of this test case in august 2009.
+% The bug was that the code for adding new foreign_procs did not handle
+% q's clauses properly. q's foreign_proc overrode the second existing Mercury
+% clause for q, but not the first. The resulting two-clause q then had a
+% disjunction, and as result it had a determinism error.
+%
+% The match against the exact text of the output of the compiler
+% guards against the reappearance of this bug.
+
+:- module warn_non_contiguous_foreign.
+:- interface.
+
+:- import_module io.
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module list.
+:- import_module string.
+
+main(!IO) :-
+ test(1, !IO),
+ test(3, !IO),
+ test(5, !IO),
+ test(7, !IO),
+ test(9, !IO),
+ test(11, !IO),
+ test(13, !IO).
+
+:- pred test(int::in, io::di, io::uo) is det.
+
+test(N, !IO) :-
+ ( p(N, PM) ->
+ io.format("p(%d) = %d\n", [i(N), i(PM)], !IO)
+ ;
+ io.format("p(%d) failed\n", [i(N)], !IO)
+ ),
+ ( q(N, QM) ->
+ io.format("q(%d) = %d\n", [i(N), i(QM)], !IO)
+ ;
+ io.format("q(%d) failed\n", [i(N)], !IO)
+ ).
+
+:- pred p(int::in, int::out) is semidet.
+
+q(10, 11).
+
+:- pragma foreign_proc("C",
+ p(N::in, M::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ if (N < 10) {
+ M = N + 1;
+ SUCCESS_INDICATOR = MR_TRUE;
+ } else {
+ SUCCESS_INDICATOR = MR_FALSE;
+ }
+").
+
+q(11, 12).
+
+:- pred q(int::in, int::out) is semidet.
+
+p(0, 1).
+
+:- pragma foreign_proc("C",
+ q(N::in, M::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ if (N < 5) {
+ M = N + 1;
+ SUCCESS_INDICATOR = MR_TRUE;
+ } else {
+ SUCCESS_INDICATOR = MR_FALSE;
+ }
+").
Index: tests/warnings/warn_non_contiguous_foreign_group.exp
===================================================================
RCS file: tests/warnings/warn_non_contiguous_foreign_group.exp
diff -N tests/warnings/warn_non_contiguous_foreign_group.exp
Index: tests/warnings/warn_non_contiguous_foreign_group.m
===================================================================
RCS file: tests/warnings/warn_non_contiguous_foreign_group.m
diff -N tests/warnings/warn_non_contiguous_foreign_group.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/warnings/warn_non_contiguous_foreign_group.m 11 Aug 2009 06:35:12 -0000
@@ -0,0 +1,72 @@
+% vim: ts=4 sw=4 et ft=mercury
+
+% This is a test of the compiler's ability to handle predicates
+% in which the Mercury clauses are together, but the foreign_procs
+% are separate from them.
+
+:- module warn_non_contiguous_foreign_group.
+:- interface.
+
+:- import_module io.
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module list.
+:- import_module string.
+
+main(!IO) :-
+ test(1, !IO),
+ test(3, !IO),
+ test(5, !IO),
+ test(7, !IO),
+ test(9, !IO),
+ test(11, !IO),
+ test(13, !IO).
+
+:- pred test(int::in, io::di, io::uo) is det.
+
+test(N, !IO) :-
+ ( p(N, PM) ->
+ io.format("p(%d) = %d\n", [i(N), i(PM)], !IO)
+ ;
+ io.format("p(%d) failed\n", [i(N)], !IO)
+ ),
+ ( q(N, QM) ->
+ io.format("q(%d) = %d\n", [i(N), i(QM)], !IO)
+ ;
+ io.format("q(%d) failed\n", [i(N)], !IO)
+ ).
+
+:- pred p(int::in, int::out) is semidet.
+
+:- pred q(int::in, int::out) is semidet.
+
+p(0, 1).
+
+q(10, 11).
+q(11, 12).
+
+:- pragma foreign_proc("C",
+ p(N::in, M::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ if (N < 10) {
+ M = N + 1;
+ SUCCESS_INDICATOR = MR_TRUE;
+ } else {
+ SUCCESS_INDICATOR = MR_FALSE;
+ }
+").
+
+:- pragma foreign_proc("C",
+ q(N::in, M::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ if (N < 5) {
+ M = N + 1;
+ SUCCESS_INDICATOR = MR_TRUE;
+ } else {
+ SUCCESS_INDICATOR = MR_FALSE;
+ }
+").
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