[m-rev.] for review: messages for highly ambiguous overloading
Zoltan Somogyi
zs at cs.mu.OZ.AU
Wed Apr 19 16:11:32 AEST 2006
For review by anyone.
Zoltan.
When the typechecker finds highly ambiguous overloading, print what symbols
were overloaded, and where they occurred. Without this information, it is
very hard to fix the error if the predicate body is at all large.
Fix some software engineering problems encountered during this process.
Modify some predicates in error_util in order to simplify their typical usage.
Change the type_ctor type to be not simply a sym_name - int pair but a type
with its own identifying type constructor. Change several other types that
were also sym_name - int pairs (mode_id, inst_id, item_name, module_qual.id
and the related simple_call_id) to have their own function symbols too.
compiler/typecheck_info.m:
Add a field to the typecheck_info structure that records the overloaded
symbols encountered.
compiler/typecheck.m:
When processing ambiguous predicate and function symbols, record this
fact in the typecheck_info.
Add a field to the cons_type_info structure to make this possible.
compiler/typecheck_errors.m:
When printing the message about highly ambiguous overloading,
what the overloaded symbols were and where they occurred.
compiler/error_util.m:
Make error_msg_specs usable with plain in and out modes by separating
out the capability requiring special modes (storing a higher order
value in a function symbol) into its own, rarely used type.
Make component_list_to_line_pieces a bit more flexible.
compiler/prog_data.m:
compiler/module_qual.m:
compiler/recompilation.m:
Change the types listed above from being equivalence types (pairs)
to being proper discriminated union types.
compiler/*.m:
Conform to the changes above.
In some cases, simplify the code's use of error_util.
tests/warnings/ambiguous_overloading.{m,exp}:
Greatly extend this test case to test the new functionality.
tests/recompilation/*.err_exp.2
Reflect the fact that the expected messages now use the standard
error_util way of quoting sym_name/arity pairs.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/add_class.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_class.m,v
retrieving revision 1.16
diff -u -b -r1.16 add_class.m
--- compiler/add_class.m 29 Mar 2006 08:06:34 -0000 1.16
+++ compiler/add_class.m 15 Apr 2006 08:43:36 -0000
@@ -607,20 +607,21 @@
varset.init(TVarSet0),
ProcIds = [],
- % means this clause applies to _every_ mode of the procedure
+ % Means this clause applies to _every_ mode of the procedure.
GoalType = 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, !IO),
+ SimpleCallId = simple_call_id(PredOrFunc, PredName, Arity),
+
% Warn about singleton variables.
- maybe_warn_singletons(VarSet, PredOrFunc - PredName/Arity,
- !.ModuleInfo, Goal, !IO),
+ maybe_warn_singletons(VarSet, SimpleCallId, !.ModuleInfo, Goal,
+ !IO),
% Warn about variables with overlapping scopes.
- maybe_warn_overlap(Warnings, VarSet, PredOrFunc - PredName/Arity,
- !IO)
+ maybe_warn_overlap(Warnings, VarSet, SimpleCallId, !IO)
)
;
unexpected(this_file, "produce_clause: invalid instance item")
Index: compiler/add_clause.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_clause.m,v
retrieving revision 1.23
diff -u -b -r1.23 add_clause.m
--- compiler/add_clause.m 18 Apr 2006 05:47:32 -0000 1.23
+++ compiler/add_clause.m 19 Apr 2006 06:03:05 -0000
@@ -196,12 +196,10 @@
Status \= opt_imported
->
module_info_incr_errors(!ModuleInfo),
- CallIdString0 = simple_call_id_to_string(
- PredOrFunc - PredName/Arity),
- string.append(CallIdString0, ".", CallIdString),
+ CallId = simple_call_id(PredOrFunc, PredName, Arity),
ErrorPieces0 = [
words("Error: clause for automatically generated"),
- words("field access"), fixed(CallIdString), nl
+ words("field access"), simple_call_id(CallId), suffix("."), nl
],
globals.io_lookup_bool_option(verbose_errors, Verbose, !IO),
(
@@ -271,11 +269,11 @@
true
;
% Warn about singleton variables.
- maybe_warn_singletons(VarSet, PredOrFunc - PredName/Arity,
- !.ModuleInfo, Goal, !IO),
+ SimpleCallId = simple_call_id(PredOrFunc, PredName, Arity),
+ maybe_warn_singletons(VarSet, SimpleCallId, !.ModuleInfo,
+ Goal, !IO),
% Warn about variables with overlapping scopes.
- maybe_warn_overlap(Warnings, VarSet,
- PredOrFunc - PredName/Arity, !IO)
+ maybe_warn_overlap(Warnings, VarSet, SimpleCallId, !IO)
)
)
).
@@ -749,7 +747,7 @@
MaybeUnifyContext = no,
Call = call(PredId, ModeId, HeadVars, not_builtin,
MaybeUnifyContext, Name),
- CallId = call(predicate - Name/Arity)
+ CallId = call(simple_call_id(predicate, Name, Arity))
),
goal_info_init(Context, GoalInfo0),
add_goal_info_purity_feature(Purity, GoalInfo0, GoalInfo),
@@ -947,7 +945,8 @@
% DCG arguments should always be distinct variables,
% so this context should never be used.
OutputTermArgNumber = 3,
- OutputTermArgContext = call(call(function - FuncName/FuncArity)),
+ SimpleCallId = simple_call_id(function, FuncName, FuncArity),
+ OutputTermArgContext = call(call(SimpleCallId)),
ArgContexts = [
FieldArgNumber - FieldArgContext,
@@ -974,7 +973,8 @@
unexpected(this_file, "transform_dcg_record_syntax_2")
),
FieldArgNumber = 2,
- FieldArgContext = call(call(function - FuncName/FuncArity)),
+ SimpleCallId = simple_call_id(function, FuncName, FuncArity),
+ FieldArgContext = call(call(SimpleCallId)),
% DCG arguments should always be distinct variables,
% so this context should never be used.
Index: compiler/add_mode.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_mode.m,v
retrieving revision 1.9
diff -u -b -r1.9 add_mode.m
--- compiler/add_mode.m 29 Mar 2006 08:06:34 -0000 1.9
+++ compiler/add_mode.m 15 Apr 2006 09:01:03 -0000
@@ -65,7 +65,7 @@
% check if the inst is infinitely recursive (at the top level)
%
Arity = list.length(Args),
- InstId = Name - Arity,
+ InstId = inst_id(Name, Arity),
TestArgs = list.duplicate(Arity, not_reached),
check_for_cyclic_inst(Insts, InstId, InstId, TestArgs, [], Context,
InvalidMode, !IO).
@@ -81,9 +81,10 @@
insts_add(VarSet, Name, Args, eqv_inst(Body), _Cond, Context, Status, !Insts,
!IO) :-
list.length(Args, Arity),
+ InstId = inst_id(Name, Arity),
(
I = hlds_inst_defn(VarSet, Args, eqv_inst(Body), Context, Status),
- user_inst_table_insert(Name - Arity, I, !Insts)
+ user_inst_table_insert(InstId, I, !Insts)
->
true
;
@@ -93,7 +94,7 @@
% XXX we should record each error using
% module_info_incr_errors
user_inst_table_get_inst_defns(!.Insts, InstDefns),
- map.lookup(InstDefns, Name - Arity, OrigI),
+ map.lookup(InstDefns, InstId, OrigI),
OrigI = hlds_inst_defn(_, _, _, OrigContext, _),
multiple_def_error(Status, Name, Arity, "inst", Context, OrigContext,
_, !IO)
@@ -108,7 +109,7 @@
check_for_cyclic_inst(UserInstTable, OrigInstId, InstId0, Args0, Expansions0,
Context, InvalidMode, !IO) :-
( list.member(InstId0, Expansions0) ->
- report_circular_equiv_error("inst", OrigInstId, InstId0, Expansions0,
+ report_circular_inst_equiv_error(OrigInstId, InstId0, Expansions0,
Context, !IO),
InvalidMode = yes
;
@@ -121,7 +122,7 @@
EqvInst = defined_inst(user_inst(Name, Args))
->
Arity = list.length(Args),
- InstId = Name - Arity,
+ InstId = inst_id(Name, Arity),
Expansions = [InstId0 | Expansions0],
check_for_cyclic_inst(UserInstTable, OrigInstId, InstId, Args,
Expansions, Context, InvalidMode, !IO)
@@ -146,7 +147,7 @@
modes_add(VarSet, Name, Args, eqv_mode(Body), _Cond, Context, Status,
!Modes, InvalidMode, !IO) :-
list.length(Args, Arity),
- ModeId = Name - Arity,
+ ModeId = mode_id(Name, Arity),
(
I = hlds_mode_defn(VarSet, Args, eqv_mode(Body), Context, Status),
mode_table_insert(ModeId, I, !Modes)
@@ -156,8 +157,7 @@
mode_table_get_mode_defns(!.Modes, ModeDefns),
map.lookup(ModeDefns, ModeId, OrigI),
OrigI = hlds_mode_defn(_, _, _, OrigContext, _),
- % XXX we should record each error using
- % module_info_incr_errors
+ % XXX We should record each error using module_info_incr_errors.
multiple_def_error(Status, Name, Arity, "mode", Context, OrigContext,
_, !IO)
),
@@ -172,8 +172,8 @@
check_for_cyclic_mode(ModeTable, OrigModeId, ModeId0, Expansions0, Context,
InvalidMode, !IO) :-
( list.member(ModeId0, Expansions0) ->
- report_circular_equiv_error("mode", OrigModeId, ModeId0,
- Expansions0, Context, !IO),
+ report_circular_mode_equiv_error(OrigModeId, ModeId0, Expansions0,
+ Context, !IO),
InvalidMode = yes
;
mode_table_get_mode_defns(ModeTable, ModeDefns),
@@ -184,7 +184,7 @@
EqvMode = user_defined_mode(Name, Args)
->
Arity = list.length(Args),
- ModeId = Name - Arity,
+ ModeId = mode_id(Name, Arity),
Expansions = [ModeId0 | Expansions0],
check_for_cyclic_mode(ModeTable, OrigModeId, ModeId, Expansions,
Context, InvalidMode, !IO)
@@ -193,12 +193,41 @@
)
).
-:- type id == pair(sym_name, arity).
+:- pred report_circular_inst_equiv_error(inst_id::in, inst_id::in,
+ list(inst_id)::in, prog_context::in, io::di, io::uo) is det.
+
+report_circular_inst_equiv_error(OrigInstId, InstId, Expansions,
+ Context, !IO) :-
+ report_circular_equiv_error("inst", "insts",
+ inst_id_to_circ_id(OrigInstId), inst_id_to_circ_id(InstId),
+ list.map(inst_id_to_circ_id, Expansions),
+ Context, !IO).
+
+:- pred report_circular_mode_equiv_error(mode_id::in, mode_id::in,
+ list(mode_id)::in, prog_context::in, io::di, io::uo) is det.
+
+report_circular_mode_equiv_error(OrigModeId, ModeId, Expansions,
+ Context, !IO) :-
+ report_circular_equiv_error("mode", "modes",
+ mode_id_to_circ_id(OrigModeId), mode_id_to_circ_id(ModeId),
+ list.map(mode_id_to_circ_id, Expansions),
+ Context, !IO).
+
+:- type circ_id
+ ---> circ_id(sym_name, arity).
-:- pred report_circular_equiv_error(string::in, id::in, id::in, list(id)::in,
- prog_context::in, io::di, io::uo) is det.
+:- func inst_id_to_circ_id(inst_id) = circ_id.
+:- func mode_id_to_circ_id(mode_id) = circ_id.
-report_circular_equiv_error(Kind, OrigId, Id, Expansions, Context, !IO) :-
+inst_id_to_circ_id(inst_id(SymName, Arity)) = circ_id(SymName, Arity).
+mode_id_to_circ_id(mode_id(SymName, Arity)) = circ_id(SymName, Arity).
+
+:- pred report_circular_equiv_error(string::in, string::in,
+ circ_id::in, circ_id::in, list(circ_id)::in, prog_context::in,
+ io::di, io::uo) is det.
+
+report_circular_equiv_error(One, Several, OrigId, Id, Expansions, Context,
+ !IO) :-
( Id = OrigId ->
%
% Report an error message of the form
@@ -210,9 +239,9 @@
% and baz/2.
% where <kind> is either "inst" or "mode".
%
- Kinds = (if Expansions = [_] then Kind else Kind ++ "s"),
+ Kinds = choose_number(Expansions, One, Several),
ExpansionPieces = list.map(
- (func(SymName - Arity) =
+ (func(circ_id(SymName, Arity)) =
sym_name_and_arity(SymName / Arity)),
Expansions),
Pieces = [words("Error: circular equivalence"), fixed(Kinds)]
Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.29
diff -u -b -r1.29 add_pragma.m
--- compiler/add_pragma.m 29 Mar 2006 08:06:34 -0000 1.29
+++ compiler/add_pragma.m 15 Apr 2006 10:55:51 -0000
@@ -406,7 +406,7 @@
add_pragma_reserve_tag(TypeName, TypeArity, PragmaStatus, Context, !ModuleInfo,
!IO) :-
- TypeCtor = TypeName - TypeArity,
+ TypeCtor = type_ctor(TypeName, TypeArity),
module_info_get_type_table(!.ModuleInfo, Types0),
TypeStr = describe_sym_name_and_arity(TypeName / TypeArity),
ErrorPieces1 = [
@@ -751,7 +751,8 @@
ItemType = pred_or_func_to_item_type(PredOrFunc),
apply_to_recompilation_info(
recompilation.record_expanded_items(
- item_id(ItemType, SymName - Arity), ExpandedItems),
+ item_id(ItemType, item_name(SymName, Arity)),
+ ExpandedItems),
!QualInfo)
;
IsImported = no
@@ -977,9 +978,9 @@
Name = pred_info_name(PredInfo),
Arity = pred_info_orig_arity(PredInfo),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
+ SimpleCallId = simple_call_id(PredOrFunc, qualified(Module, Name), Arity),
Pieces = [words("In `:- pragma type_spec' declaration for"),
- simple_call_id(PredOrFunc - qualified(Module, Name)/Arity),
- suffix(":"), nl].
+ simple_call_id(SimpleCallId), suffix(":"), nl].
:- func report_variables(list(tvar), tvarset) = string.
@@ -1075,13 +1076,14 @@
module_info_incr_errors(!ModuleInfo),
Pieces = [words("Error: `:- pragma termination2_info'"),
words("declaration for undeclared mode of"),
- simple_call_id(PredOrFunc - SymName/Arity), suffix(".")],
+ simple_call_id(simple_call_id(PredOrFunc, SymName, Arity)),
+ suffix(".")],
write_error_pieces(Context, 0, Pieces, !IO)
)
;
module_info_incr_errors(!ModuleInfo),
Pieces = [words("Error: ambiguous predicate name"),
- simple_call_id(PredOrFunc - SymName/Arity),
+ simple_call_id(simple_call_id(PredOrFunc, SymName, Arity)),
words("in"), fixed("`pragma termination2_info'.")],
write_error_pieces(Context, 0, Pieces, !IO)
)
@@ -1160,13 +1162,14 @@
module_info_incr_errors(!ModuleInfo),
Pieces = [words("Error: `:- pragma structure_sharing'"),
words("declaration for undeclared mode of"),
- simple_call_id(PredOrFunc - SymName/Arity), suffix(".")],
+ simple_call_id(simple_call_id(PredOrFunc, SymName, Arity)),
+ suffix(".")],
write_error_pieces(Context, 0, Pieces, !IO)
)
;
module_info_incr_errors(!ModuleInfo),
Pieces = [words("Error: ambiguous predicate name"),
- simple_call_id(PredOrFunc - SymName/Arity),
+ simple_call_id(simple_call_id(PredOrFunc, SymName, Arity)),
words("in"), fixed("`pragma structure_sharing'.")],
write_error_pieces(Context, 0, Pieces, !IO)
)
@@ -1180,7 +1183,6 @@
% module_info_incr_errors(!ModuleInfo)
).
-
%-----------------------------------------------------------------------------%
add_pragma_termination_info(PredOrFunc, SymName, ModeList,
@@ -1219,13 +1221,14 @@
module_info_incr_errors(!ModuleInfo),
Pieces = [words("Error: `:- pragma termination_info'"),
words("declaration for undeclared mode of"),
- simple_call_id(PredOrFunc - SymName/Arity), suffix(".")],
+ simple_call_id(simple_call_id(PredOrFunc, SymName, Arity)),
+ suffix(".")],
write_error_pieces(Context, 0, Pieces, !IO)
)
;
module_info_incr_errors(!ModuleInfo),
Pieces = [words("Error: ambiguous predicate name"),
- simple_call_id(PredOrFunc - SymName/Arity),
+ simple_call_id(simple_call_id(PredOrFunc, SymName, Arity)),
words("in"), fixed("`pragma termination_info'.")],
write_error_pieces(Context, 0, Pieces, !IO)
)
@@ -1282,12 +1285,13 @@
( pred_info_is_imported(PredInfo1) ->
module_info_incr_errors(!ModuleInfo),
Pieces = [words("Error: `:- pragma import' declaration for imported"),
- simple_call_id(PredOrFunc - PredName/Arity), suffix(".")],
+ simple_call_id(simple_call_id(PredOrFunc, PredName, Arity)),
+ suffix(".")],
write_error_pieces(Context, 0, Pieces, !IO)
; pred_info_clause_goal_type(PredInfo1) ->
module_info_incr_errors(!ModuleInfo),
Pieces = [words("Error: `:- pragma import' declaration for"),
- simple_call_id(PredOrFunc - PredName/Arity),
+ simple_call_id(simple_call_id(PredOrFunc, PredName, Arity)),
words("with preceding clauses.")],
write_error_pieces(Context, 0, Pieces, !IO)
;
@@ -1309,7 +1313,8 @@
module_info_incr_errors(!ModuleInfo),
Pieces = [words("Error: `:- pragma import' declaration"),
words("for undeclared mode of"),
- simple_call_id(PredOrFunc - PredName/Arity), suffix(".")],
+ simple_call_id(simple_call_id(PredOrFunc, PredName, Arity)),
+ suffix(".")],
write_error_pieces(Context, 0, Pieces, !IO)
)
).
@@ -1453,7 +1458,8 @@
Pieces = [words("Error: `:- pragma foreign_proc'"),
words("(or `pragma c_code')"),
words("declaration for imported"),
- simple_call_id(PredOrFunc - PredName/Arity), suffix(".")],
+ simple_call_id(simple_call_id(PredOrFunc, PredName, Arity)),
+ suffix(".")],
write_error_pieces(Context, 0, Pieces, !IO)
;
% Don't add clauses for foreign languages other than the ones
@@ -1463,10 +1469,11 @@
pred_info_update_goal_type(pragmas, PredInfo0, !:PredInfo),
module_info_set_pred_info(PredId, !.PredInfo, !ModuleInfo)
;
- % add the pragma declaration to the proc_info for this procedure
+ % Add the pragma declaration to the proc_info for this procedure.
pred_info_get_procedures(!.PredInfo, Procs),
map.to_assoc_list(Procs, ExistingProcs),
pragma_get_modes(PVars, Modes),
+ SimpleCallId = simple_call_id(PredOrFunc, PredName, Arity),
(
% The inst variables for the foreign_proc declaration
% and predmode declarations are from different varsets.
@@ -1496,13 +1503,12 @@
pragma_get_var_infos(PVars, ArgInfoBox),
assoc_list.keys(ArgInfoBox, ArgInfo),
maybe_warn_pragma_singletons(PragmaImpl, PragmaForeignLanguage,
- ArgInfo, Context, PredOrFunc - PredName/Arity,
- !.ModuleInfo, !IO)
+ ArgInfo, Context, SimpleCallId, !.ModuleInfo, !IO)
;
module_info_incr_errors(!ModuleInfo),
Pieces = [words("Error: `:- pragma foreign_proc' declaration"),
words("for undeclared mode of"),
- simple_call_id(PredOrFunc - PredName/Arity), suffix(".")],
+ simple_call_id(SimpleCallId), suffix(".")],
write_error_pieces(Context, 0, Pieces, !IO)
)
)
@@ -1608,13 +1614,14 @@
% declaration. Tabled procedures cannot be inlined.
pred_info_get_markers(PredInfo0, Markers),
globals.io_lookup_bool_option(warn_table_with_inline, WarnInline, !IO),
+ SimpleCallId = simple_call_id(PredOrFunc, PredName, Arity),
(
check_marker(Markers, user_marked_inline),
WarnInline = yes
->
TablePragmaStr = string.format("`:- pragma %s'", [s(EvalMethodStr)]),
InlineWarning = [
- words("Warning: "), simple_call_id(PredOrFunc - PredName/Arity),
+ words("Warning: "), simple_call_id(SimpleCallId),
words("has a"), fixed(TablePragmaStr),
words("declaration but also has a"),
fixed("`:- pragma inline'"), words("declaration."), nl,
@@ -1632,7 +1639,7 @@
Pieces1 = [words("Error: "),
fixed("`:- pragma " ++ EvalMethodStr ++ "'"),
words("declaration for imported"),
- simple_call_id(PredOrFunc - PredName/Arity), suffix(".")],
+ simple_call_id(SimpleCallId), suffix(".")],
write_error_pieces(Context, 0, Pieces1, !IO)
;
% Do we have to make sure the tabled preds are stratified?
@@ -1647,7 +1654,6 @@
% Add the eval model to the proc_info for this procedure.
pred_info_get_procedures(PredInfo0, ProcTable0),
map.to_assoc_list(ProcTable0, ExistingProcs),
- SimpleCallId = PredOrFunc - PredName/Arity,
(
MaybeModes = yes(Modes),
(
@@ -2051,8 +2057,9 @@
MultipleArgs = [_ | _],
io.set_exit_status(1, !IO),
adjust_func_arity(PredOrFunc, OrigArity, Arity),
+ SimpleCallId = simple_call_id(PredOrFunc, PredName, OrigArity),
Pieces1 = [words("In `:- pragma foreign_proc' declaration for"),
- simple_call_id(PredOrFunc - PredName/OrigArity), suffix(":"), nl],
+ simple_call_id(SimpleCallId), suffix(":"), nl],
(
MultipleArgs = [MultipleArg],
Pieces2 = [words("error: variable `" ++
Index: compiler/add_special_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_special_pred.m,v
retrieving revision 1.12
diff -u -b -r1.12 add_special_pred.m
--- compiler/add_special_pred.m 29 Mar 2006 08:06:35 -0000 1.12
+++ compiler/add_special_pred.m 15 Apr 2006 07:00:33 -0000
@@ -301,7 +301,7 @@
adjust_types_with_special_preds_in_private_builtin(Type) = NormalizedType :-
( type_to_ctor_and_args(Type, TypeCtor, []) ->
( is_builtin_types_special_preds_defined_in_mercury(TypeCtor, Name) ->
- construct_type(unqualified(Name) - 0, [], NormalizedType)
+ construct_type(type_ctor(unqualified(Name), 0), [], NormalizedType)
;
NormalizedType = Type
)
@@ -346,7 +346,7 @@
special_pred_interface(SpecialPredId, Type, ArgTypes, ArgModes, Det),
Name = special_pred_name(SpecialPredId, TypeCtor),
( SpecialPredId = spec_pred_init ->
- TypeCtor = TypeSymName - _TypeArity,
+ TypeCtor = type_ctor(TypeSymName, _TypeArity),
sym_name_get_module_name(TypeSymName, ModuleName, TypeModuleName),
PredName = qualified(TypeModuleName, Name)
;
Index: compiler/add_type.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_type.m,v
retrieving revision 1.13
diff -u -b -r1.13 add_type.m
--- compiler/add_type.m 29 Mar 2006 08:06:35 -0000 1.13
+++ compiler/add_type.m 15 Apr 2006 07:02:48 -0000
@@ -84,7 +84,7 @@
item_status(Status0, NeedQual), !ModuleInfo, !IO) :-
globals.io_get_globals(Globals, !IO),
list.length(Args, Arity),
- TypeCtor = Name - Arity,
+ TypeCtor = type_ctor(Name, Arity),
convert_type_defn(TypeDefn, TypeCtor, Globals, Body0),
module_info_get_type_table(!.ModuleInfo, Types0),
(
@@ -104,8 +104,8 @@
Status1 = Status0
),
(
- % the type is exported if *any* occurrence is exported,
- % even a previous abstract occurrence
+ % The type is exported if *any* occurrence is exported,
+ % even a previous abstract occurrence.
map.search(Types0, TypeCtor, OldDefn0)
->
hlds_data.get_type_defn_status(OldDefn0, OldStatus),
@@ -113,9 +113,8 @@
hlds_data.get_type_defn_body(OldDefn0, OldBody0),
combine_is_solver_type(OldBody0, OldBody, Body0, Body),
( is_solver_type_is_inconsistent(OldBody, Body) ->
- % The existing definition has an is_solver_type
- % annotation which is different to the current
- % definition.
+ % The existing definition has an is_solver_type annotation
+ % which is different to the current definition.
module_info_incr_errors(!ModuleInfo),
Pieces0 = [words("In definition of type"),
fixed(describe_sym_name_and_arity(Name / Arity) ++ ":"), nl,
@@ -169,7 +168,7 @@
write_error_pieces(Context, 0, ErrorPieces, !IO),
module_info_incr_errors(!ModuleInfo)
;
- % if there was an existing non-abstract definition for the type
+ % If there was an existing non-abstract definition for the type, ...
MaybeOldDefn = yes(T2),
hlds_data.get_type_defn_tvarset(T2, TVarSet_2),
hlds_data.get_type_defn_tparams(T2, Params_2),
@@ -190,8 +189,8 @@
true
),
(
- % then if this definition was abstract, ignore it
- % (but update the status of the old defn if necessary)
+ % ... then if this definition was abstract, ignore it
+ % (but update the status of the old defn if necessary).
Body = abstract_type(_)
->
( Status = OrigStatus ->
@@ -224,7 +223,7 @@
Pieces, !IO)
)
;
- % otherwise issue an error message if the second
+ % ..., otherwise issue an error message if the second
% definition wasn't read while reading .opt files.
Status = opt_imported
->
@@ -238,11 +237,10 @@
map.set(Types0, TypeCtor, T, Types),
module_info_set_type_table(Types, !ModuleInfo),
(
- % XXX we can't handle abstract exported
- % polymorphic equivalence types with monomorphic
- % bodies, because the compiler stuffs up the
- % type_info handling -- the caller passes type_infos,
- % but the callee expects no type_infos
+ % XXX We can't handle abstract exported polymorphic equivalence
+ % types with monomorphic bodies, because the compiler stuffs up
+ % the type_info handling -- the caller passes type_infos,
+ % but the callee expects no type_infos.
Body = eqv_type(EqvType),
Status = abstract_exported,
list.member(Var, Args),
@@ -412,7 +410,7 @@
check_foreign_type(TypeCtor, ForeignTypeBody, Context, FoundError, !ModuleInfo,
!IO) :-
- TypeCtor = Name - Arity,
+ TypeCtor = type_ctor(Name, Arity),
module_info_get_globals(!.ModuleInfo, Globals),
generating_code(GeneratingCode, !IO),
globals.get_target(Globals, Target),
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.92
diff -u -b -r1.92 check_typeclass.m
--- compiler/check_typeclass.m 29 Mar 2006 08:06:36 -0000 1.92
+++ compiler/check_typeclass.m 15 Apr 2006 06:33:17 -0000
@@ -1640,7 +1640,7 @@
report_unbound_tvars_in_ctor_context(Vars, TypeCtor, TypeDefn, !IO) :-
get_type_defn_context(TypeDefn, Context),
get_type_defn_tvarset(TypeDefn, TVarSet),
- TypeCtor = SymName - Arity,
+ TypeCtor = type_ctor(SymName, Arity),
VarsStrs = list.map((func(Var) = mercury_var_to_string(Var, TVarSet, no)),
Vars),
Index: compiler/code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_gen.m,v
retrieving revision 1.157
diff -u -b -r1.157 code_gen.m
--- compiler/code_gen.m 31 Mar 2006 03:32:09 -0000 1.157
+++ compiler/code_gen.m 15 Apr 2006 06:49:46 -0000
@@ -1385,7 +1385,7 @@
:- pred find_arg_type_ctor_name((type_ctor)::in, string::out) is det.
find_arg_type_ctor_name(TypeCtor, TypeName) :-
- TypeCtor = TypeCtorSymName - TypeCtorArity,
+ TypeCtor = type_ctor(TypeCtorSymName, TypeCtorArity),
mdbcomp.prim_data.sym_name_to_string(TypeCtorSymName, TypeCtorName),
string.int_to_string(TypeCtorArity, ArityStr),
string.append_list([TypeCtorName, "_", ArityStr], TypeName).
Index: compiler/complexity.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/complexity.m,v
retrieving revision 1.15
diff -u -b -r1.15 complexity.m
--- compiler/complexity.m 29 Mar 2006 08:06:39 -0000 1.15
+++ compiler/complexity.m 15 Apr 2006 07:23:08 -0000
@@ -557,7 +557,8 @@
is_active_type = Type :-
mercury_term_size_prof_builtin_module(M),
- construct_type(qualified(M, "complexity_is_active") - 0, [], Type).
+ construct_type(type_ctor(qualified(M, "complexity_is_active"), 0), [],
+ Type).
%-----------------------------------------------------------------------------%
Index: compiler/deep_profiling.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/deep_profiling.m,v
retrieving revision 1.48
diff -u -b -r1.48 deep_profiling.m
--- compiler/deep_profiling.m 29 Mar 2006 08:06:40 -0000 1.48
+++ compiler/deep_profiling.m 15 Apr 2006 06:50:00 -0000
@@ -1563,7 +1563,7 @@
varset.new_named_var(VarSet0, "CSNCell", CellVar, VarSet),
mercury_profiling_builtin_module(ProfilingBuiltin),
CellTypeName = string.format("call_site_nums_%d", [i(Length)]),
- CellTypeId = qualified(ProfilingBuiltin, CellTypeName) - Length,
+ CellTypeId = type_ctor(qualified(ProfilingBuiltin, CellTypeName), Length),
construct_type(CellTypeId, [], CellType),
map.set(VarTypes0, CellVar, CellType, VarTypes),
!:DeepInfo = !.DeepInfo ^ vars := VarSet,
Index: compiler/det_report.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_report.m,v
retrieving revision 1.117
diff -u -b -r1.117 det_report.m
--- compiler/det_report.m 18 Apr 2006 05:47:33 -0000 1.117
+++ compiler/det_report.m 19 Apr 2006 06:03:06 -0000
@@ -450,7 +450,7 @@
:- pred report_determinism_problem(pred_id::in, proc_id::in, module_info::in,
string::in, determinism::in, determinism::in,
- error_msg_spec::out(known_error_msg_spec)) is det.
+ error_msg_spec::out) is det.
report_determinism_problem(PredId, ProcId, ModuleInfo, Message,
DeclaredDetism, InferredDetism, Spec) :-
@@ -524,8 +524,7 @@
%
:- pred det_diagnose_goal(hlds_goal::in, determinism::in,
list(switch_context)::in, det_info::in, bool::out,
- list(error_msg_spec)::in(known_error_msg_specs),
- list(error_msg_spec)::out(known_error_msg_specs)) is det.
+ list(error_msg_spec)::in, list(error_msg_spec)::out) is det.
det_diagnose_goal(Goal - GoalInfo, Desired, SwitchContext, DetInfo, Diagnosed,
!Specs) :-
@@ -542,8 +541,7 @@
:- pred det_diagnose_goal_2(hlds_goal_expr::in, hlds_goal_info::in,
determinism::in, determinism::in, list(switch_context)::in,
det_info::in, bool::out,
- list(error_msg_spec)::in(known_error_msg_specs),
- list(error_msg_spec)::out(known_error_msg_specs)) is det.
+ list(error_msg_spec)::in, list(error_msg_spec)::out) is det.
det_diagnose_goal_2(conj(_, Goals), _GoalInfo, Desired, _Actual, Context,
DetInfo, Diagnosed, !Specs) :-
@@ -709,7 +707,7 @@
%-----------------------------------------------------------------------------%
:- pred report_generic_call_context(prog_context::in, generic_call::in,
- error_msg_spec::out(known_error_msg_spec)) is det.
+ error_msg_spec::out) is det.
report_generic_call_context(Context, CallType, Spec) :-
hlds_goal.generic_call_id(CallType, CallId),
@@ -719,10 +717,8 @@
%-----------------------------------------------------------------------------%
:- pred det_diagnose_atomic_goal(determinism::in, determinism::in,
- list(error_msg_spec)::in(known_error_msg_specs),
- error_msg_spec::in(known_error_msg_spec),
- list(error_msg_spec)::in(known_error_msg_specs),
- list(error_msg_spec)::out(known_error_msg_specs)) is det.
+ list(error_msg_spec)::in, error_msg_spec::in,
+ list(error_msg_spec)::in, list(error_msg_spec)::out) is det.
det_diagnose_atomic_goal(Desired, Actual, InitSpecs, !.CurSpec, !Specs) :-
determinism_components(Desired, DesiredCanFail, DesiredSolns),
@@ -767,8 +763,7 @@
%
:- pred det_diagnose_conj(list(hlds_goal)::in, determinism::in,
list(switch_context)::in, det_info::in, bool::out,
- list(error_msg_spec)::in(known_error_msg_specs),
- list(error_msg_spec)::out(known_error_msg_specs)) is det.
+ list(error_msg_spec)::in, list(error_msg_spec)::out) is det.
det_diagnose_conj([], _Desired, _SwitchContext, _DetInfo, no, !Specs).
det_diagnose_conj([Goal | Goals], Desired, SwitchContext, DetInfo,
@@ -782,8 +777,7 @@
:- pred det_diagnose_disj(list(hlds_goal)::in,
determinism::in, determinism::in, list(switch_context)::in,
det_info::in, int::in, int::out, bool::out,
- list(error_msg_spec)::in(known_error_msg_specs),
- list(error_msg_spec)::out(known_error_msg_specs)) is det.
+ list(error_msg_spec)::in, list(error_msg_spec)::out) is det.
det_diagnose_disj([], _Desired, _Actual, _SwitchContext, _DetInfo,
!ClausesWithSoln, no, !Specs).
@@ -825,8 +819,7 @@
:- pred det_diagnose_switch(prog_var::in, list(case)::in, determinism::in,
list(switch_context)::in, det_info::in, bool::out,
- list(error_msg_spec)::in(known_error_msg_specs),
- list(error_msg_spec)::out(known_error_msg_specs)) is det.
+ list(error_msg_spec)::in, list(error_msg_spec)::out) is det.
det_diagnose_switch(_Var, [], _Desired, _SwitchContext, _DetInfo, no, !Specs).
det_diagnose_switch(Var, [case(ConsId, Goal) | Cases], Desired,
@@ -881,8 +874,7 @@
:- pred det_diagnose_switch_context(prog_context::in,
list(switch_context)::in, det_info::in,
- list(error_msg_spec)::in(known_error_msg_specs),
- list(error_msg_spec)::out(known_error_msg_specs)) is det.
+ list(error_msg_spec)::in, list(error_msg_spec)::out) is det.
det_diagnose_switch_context(_Context, [], _, !Specs).
det_diagnose_switch_context(Context, [SwitchContext | SwitchContexts],
@@ -902,8 +894,7 @@
:- pred det_report_call_context(prog_context::in,
maybe(call_unify_context)::in, det_info::in, pred_id::in, proc_id::in,
- list(error_msg_spec)::out(known_error_msg_specs),
- error_msg_spec::out(known_error_msg_spec)) is det.
+ list(error_msg_spec)::out, error_msg_spec::out) is det.
det_report_call_context(Context, CallUnifyContext, DetInfo, PredId, ProcId,
InitSpecs, Spec) :-
@@ -969,7 +960,7 @@
%
:- pred det_report_unify_context(bool::in, bool::in, prog_context::in,
unify_context::in, det_info::in, prog_var::in, unify_rhs::in,
- error_msg_spec::out(known_error_msg_spec)) is det.
+ error_msg_spec::out) is det.
det_report_unify_context(!.First, Last, Context, UnifyContext, DetInfo,
LHS, RHS, Spec) :-
@@ -1597,16 +1588,15 @@
lookup_var_name_in_varset(VarSet, Var) =
mercury_var_to_string(Var, VarSet, no).
-:- func failing_contexts_description(module_info::in, prog_varset::in,
- list(failing_context)::in) =
- (list(error_msg_spec)::out(known_error_msg_specs)) is det.
+:- func failing_contexts_description(module_info, prog_varset,
+ list(failing_context)) = list(error_msg_spec).
failing_contexts_description(ModuleInfo, VarSet, FailingContexts) =
list.map(failing_context_description(ModuleInfo, VarSet),
FailingContexts).
-:- func failing_context_description(module_info::in, prog_varset::in,
- failing_context::in) = (error_msg_spec::out(known_error_msg_spec)) is det.
+:- func failing_context_description(module_info, prog_varset,
+ failing_context) = error_msg_spec.
failing_context_description(ModuleInfo, VarSet, Context - FailingGoal)
= Spec :-
Index: compiler/equiv_type.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/equiv_type.m,v
retrieving revision 1.61
diff -u -b -r1.61 equiv_type.m
--- compiler/equiv_type.m 29 Mar 2006 08:06:43 -0000 1.61
+++ compiler/equiv_type.m 15 Apr 2006 11:01:45 -0000
@@ -178,11 +178,13 @@
; Item = type_defn(VarSet, Name, Args, eqv_type(Body), _Cond) ->
Items = Items0,
list.length(Args, Arity),
- svmap.set(Name - Arity, eqv_type_body(VarSet, Args, Body), !EqvMap)
+ TypeCtor = type_ctor(Name, Arity),
+ svmap.set(TypeCtor, eqv_type_body(VarSet, Args, Body), !EqvMap)
; Item = inst_defn(VarSet, Name, Args, eqv_inst(Body), _) ->
Items = Items0,
list.length(Args, Arity),
- svmap.set(Name - Arity, eqv_inst_body(VarSet, Args, Body), !EqvInstMap)
+ InstId = inst_id(Name, Arity),
+ svmap.set(InstId, eqv_inst_body(VarSet, Args, Body), !EqvInstMap)
;
Items = Items0
),
@@ -269,9 +271,8 @@
type_defn(VarSet, Name, TArgs, TypeDefn, Cond),
Error, !Info) :-
list.length(TArgs, Arity),
- maybe_record_expanded_items(ModuleName, Name,
- !.Info, UsedTypeCtors0),
- replace_in_type_defn(EqvMap, Name - Arity, TypeDefn0,
+ maybe_record_expanded_items(ModuleName, Name, !.Info, UsedTypeCtors0),
+ replace_in_type_defn(EqvMap, type_ctor(Name, Arity), TypeDefn0,
TypeDefn, ContainsCirc, VarSet0, VarSet,
UsedTypeCtors0, UsedTypeCtors),
(
@@ -281,8 +282,8 @@
ContainsCirc = no,
Error = []
),
- finish_recording_expanded_items(
- item_id(type_body_item, Name - Arity), UsedTypeCtors, !Info).
+ ItemId = item_id(type_body_item, item_name(Name, Arity)),
+ finish_recording_expanded_items(ItemId, UsedTypeCtors, !Info).
replace_in_item(ModuleName,
pred_or_func(TypeVarSet0, InstVarSet, ExistQVars, PredOrFunc,
@@ -305,8 +306,8 @@
ItemType = pred_or_func_to_item_type(PredOrFunc),
list.length(TypesAndModes, Arity),
adjust_func_arity(PredOrFunc, OrigArity, Arity),
- finish_recording_expanded_items(
- item_id(ItemType, PredName - OrigArity), ExpandedItems, !Info).
+ ItemId = item_id(ItemType, item_name(PredName, OrigArity)),
+ finish_recording_expanded_items(ItemId, ExpandedItems, !Info).
replace_in_item(ModuleName,
pred_or_func_mode(InstVarSet, MaybePredOrFunc0, PredName,
@@ -315,8 +316,7 @@
pred_or_func_mode(InstVarSet, MaybePredOrFunc, PredName,
Modes, WithInst, Det, Cond),
Errors, !Info) :-
- maybe_record_expanded_items(ModuleName, PredName,
- !.Info, ExpandedItems0),
+ maybe_record_expanded_items(ModuleName, PredName, !.Info, ExpandedItems0),
replace_in_pred_mode(PredName, length(Modes0), Context,
mode_decl, EqvInstMap, MaybePredOrFunc0, MaybePredOrFunc,
@@ -329,14 +329,13 @@
ExtraModes = [_ | _],
Modes = Modes0 ++ ExtraModes
),
-
(
MaybePredOrFunc = yes(PredOrFunc),
ItemType = pred_or_func_to_item_type(PredOrFunc),
list.length(Modes, Arity),
adjust_func_arity(PredOrFunc, OrigArity, Arity),
- finish_recording_expanded_items(
- item_id(ItemType, PredName - OrigArity), ExpandedItems, !Info)
+ ItemId = item_id(ItemType, item_name(PredName, OrigArity)),
+ finish_recording_expanded_items(ItemId, ExpandedItems, !Info)
;
MaybePredOrFunc = no
).
@@ -365,8 +364,8 @@
Methods, [], Errors, ExpandedItems1, ExpandedItems),
ClassInterface = concrete(Methods)
),
- finish_recording_expanded_items(item_id(typeclass_item, ClassName - Arity),
- ExpandedItems, !Info).
+ ItemId = item_id(typeclass_item, item_name(ClassName, Arity)),
+ finish_recording_expanded_items(ItemId, ExpandedItems, !Info).
replace_in_item(ModuleName,
instance(Constraints0, ClassName, Ts0, InstanceBody, VarSet0, ModName),
@@ -388,8 +387,8 @@
replace_in_type_list(EqvMap, Ts0, Ts, _, _,
VarSet1, VarSet, UsedTypeCtors1, UsedTypeCtors),
list.length(Ts0, Arity),
- finish_recording_expanded_items(
- item_id(typeclass_item, ClassName - Arity), UsedTypeCtors, !Info).
+ ItemId = item_id(typeclass_item, item_name(ClassName, Arity)),
+ finish_recording_expanded_items(ItemId, UsedTypeCtors, !Info).
replace_in_item(ModuleName,
pragma(Origin, type_spec(PredName, B, Arity, D, E,
@@ -428,8 +427,8 @@
ExpandedItems0, ExpandedItems1),
replace_in_inst(Inst0, EqvInstMap, Inst,
ExpandedItems1, ExpandedItems),
- finish_recording_expanded_items(
- item_id(mutable_item, QualName - 0), ExpandedItems, !Info).
+ ItemId = item_id(mutable_item, item_name(QualName, 0)),
+ finish_recording_expanded_items(ItemId, ExpandedItems, !Info).
:- pred replace_in_type_defn(eqv_map::in, type_ctor::in,
type_defn::in, type_defn::out, bool::out, tvarset::in, tvarset::out,
@@ -646,7 +645,7 @@
replace_in_type_list_2(EqvMap, TypeCtorsAlreadyExpanded,
TArgs0, TArgs, ArgsChanged, no, Circ0, !VarSet, !Info),
Arity = list.length(TArgs),
- TypeCtor = SymName - Arity,
+ TypeCtor = type_ctor(SymName, Arity),
replace_type_ctor(EqvMap, TypeCtorsAlreadyExpanded,
Type0, TypeCtor, TArgs, Kind, Type, ArgsChanged, Changed,
Circ0, Circ, !VarSet, !Info)
@@ -745,7 +744,8 @@
!:Changed = yes,
map.apply_to_list(Args0, Renaming, Args),
apply_variable_renaming_to_type(Renaming, Body0, Body1),
- record_expanded_item(item_id(type_item, TypeCtor), !Info),
+ TypeCtorItem = type_ctor_to_item_name(TypeCtor),
+ record_expanded_item(item_id(type_item, TypeCtorItem), !Info),
map.from_corresponding_lists(Args, TArgs, Subst),
apply_subst_to_type(Subst, Body1, Body),
replace_in_type_2(EqvMap, [TypeCtor | TypeCtorsAlreadyExpanded], Body,
@@ -753,7 +753,7 @@
;
(
!.Changed = yes,
- TypeCtor = SymName - _Arity,
+ TypeCtor = type_ctor(SymName, _Arity),
Type = defined(SymName, TArgs, Kind)
;
!.Changed = no,
@@ -774,7 +774,7 @@
replace_in_inst(Inst0, EqvInstMap, ExpandedInstIds, Inst, !Info) :-
( Inst0 = defined_inst(user_inst(SymName, ArgInsts)) ->
- InstId = SymName - length(ArgInsts),
+ InstId = inst_id(SymName, length(ArgInsts)),
(
set.member(InstId, ExpandedInstIds)
->
@@ -784,7 +784,8 @@
eqv_inst_body(_, EqvInstParams, EqvInst))
->
inst_substitute_arg_list(EqvInstParams, ArgInsts, EqvInst, Inst1),
- record_expanded_item(item_id(inst_item, InstId), !Info),
+ InstIdItem = inst_id_to_item_name(InstId),
+ record_expanded_item(item_id(inst_item, InstIdItem), !Info),
replace_in_inst(Inst1, EqvInstMap,
set.insert(ExpandedInstIds, InstId), Inst, !Info)
;
@@ -875,7 +876,7 @@
;
ExtraTypesAndModes = [_ | _],
OrigItemId = item_id(pred_or_func_to_item_type(PredOrFunc),
- PredName - list.length(TypesAndModes0)),
+ item_name(PredName, list.length(TypesAndModes0))),
record_expanded_item(OrigItemId, !Info),
TypesAndModes = TypesAndModes1 ++ ExtraTypesAndModes
).
@@ -912,7 +913,7 @@
MaybePredOrFunc0 = yes(RecordedPredOrFunc)
),
OrigItemId = item_id(pred_or_func_to_item_type(RecordedPredOrFunc),
- PredName - OrigArity),
+ item_name(PredName, OrigArity)),
record_expanded_item(OrigItemId, !Info)
;
ExtraModes = [],
@@ -976,10 +977,9 @@
pair(module_name, set(item_id))::in,
pair(module_name, set(item_id))::out) is det.
-record_expanded_item_2(ItemId, ModuleName - Items0,
- ModuleName - Items) :-
+record_expanded_item_2(ItemId, ModuleName - Items0, ModuleName - Items) :-
ItemId = item_id(_, ItemName),
- ( ItemName = qualified(ModuleName, _) - _ ->
+ ( ItemName = item_name(qualified(ModuleName, _), _) ->
% We don't need to record local types.
Items = Items0
;
Index: compiler/equiv_type_hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/equiv_type_hlds.m,v
retrieving revision 1.32
diff -u -b -r1.32 equiv_type_hlds.m
--- compiler/equiv_type_hlds.m 29 Mar 2006 08:06:43 -0000 1.32
+++ compiler/equiv_type_hlds.m 15 Apr 2006 11:39:36 -0000
@@ -137,7 +137,9 @@
replace_in_type_defn(ModuleName, EqvMap, TypeCtor, !Defn, !MaybeRecompInfo) :-
hlds_data.get_type_defn_tvarset(!.Defn, TVarSet0),
hlds_data.get_type_defn_body(!.Defn, Body0),
- equiv_type.maybe_record_expanded_items(ModuleName, fst(TypeCtor),
+ TypeCtor = type_ctor(TypeCtorSymName, _TypeCtorArity),
+ TypeCtorItem = type_ctor_to_item_name(TypeCtor),
+ equiv_type.maybe_record_expanded_items(ModuleName, TypeCtorSymName,
!.MaybeRecompInfo, EquivTypeInfo0),
(
Body0 = du_type(Ctors0, _, _, _, _, _),
@@ -170,13 +172,13 @@
TVarSet = TVarSet0
),
equiv_type.finish_recording_expanded_items(
- item_id(type_body_item, TypeCtor), EquivTypeInfo, !MaybeRecompInfo),
+ item_id(type_body_item, TypeCtorItem),
+ EquivTypeInfo, !MaybeRecompInfo),
hlds_data.set_type_defn_body(Body, !Defn),
hlds_data.set_type_defn_tvarset(TVarSet, !Defn).
:- pred replace_in_inst_table(eqv_map::in,
- inst_table::in, inst_table::out,
- inst_cache::in, inst_cache::out) is det.
+ inst_table::in, inst_table::out, inst_cache::in, inst_cache::out) is det.
replace_in_inst_table(EqvMap, !InstTable, !Cache) :-
% %
@@ -309,8 +311,8 @@
ItemId = item_id(pred_or_func_to_item_type(
pred_info_is_pred_or_func(!.PredInfo)),
- qualified(pred_info_module(!.PredInfo), PredName) -
- pred_info_orig_arity(!.PredInfo)),
+ item_name(qualified(pred_info_module(!.PredInfo), PredName),
+ pred_info_orig_arity(!.PredInfo))),
equiv_type.finish_recording_expanded_items(ItemId,
!.EquivTypeInfo, MaybeRecompInfo0, MaybeRecompInfo),
module_info_set_maybe_recompilation_info(MaybeRecompInfo, !ModuleInfo),
Index: compiler/error_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/error_util.m,v
retrieving revision 1.49
diff -u -b -r1.49 error_util.m
--- compiler/error_util.m 29 Mar 2006 08:06:43 -0000 1.49
+++ compiler/error_util.m 15 Apr 2006 13:43:00 -0000
@@ -5,10 +5,10 @@
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-
+%
% File: error_util.m.
% Main author: zs.
-
+%
% This module contains code that can be helpful in the formatting of
% error messages.
%
@@ -30,7 +30,7 @@
% of a list of error message components. Each component may specify
% a string to printed exactly as it is, or it may specify a string
% containing a list of words, which may be broken at white space.
-
+%
%-----------------------------------------------------------------------------%
:- module parse_tree.error_util.
@@ -117,13 +117,16 @@
:- func component_list_to_pieces(list(format_component)) =
list(format_component).
- % Convert a list of lines (each given by a list of format_components
+ % component_list_to_line_pieces(Lines, Final):
+ %
+ % Convert Lines, a list of lines (each given by a list of format_components
% *without* a final nl) into a condensed list of format_components
- % in which adjacent lines are separated by commas and newlines,
- % with only a newline (no comma) after the last.
+ % in which adjacent lines are separated by commas and newlines.
+ % What goes between the last line and the newline ending is not
+ % a comma but the value of Final.
%
-:- func component_list_to_line_pieces(list(list(format_component))) =
- list(format_component).
+:- func component_list_to_line_pieces(list(list(format_component)),
+ list(format_component)) = list(format_component).
% choose_number(List, Singular, Plural) = Form
%
@@ -180,12 +183,6 @@
% treated as a first line if the treat_as_first_call field is set to yes,
% and each call to write_error_pieces will be additionally indented
% by the number of levels indicated by the extra_indent field.
- %
- % The anything alternative allows the caller to specify an arbitrary thing
- % to be printed at any point in the sequence. Since things printed this way
- % aren't formatted as error messages should be (context at start etc), this
- % capability is intended only for messages that help debug the compiler
- % itself.
:- type error_msg_spec
---> error_msg_spec(
@@ -193,29 +190,43 @@
spec_context :: prog_context,
spec_extra_indent :: int,
spec_pieces :: list(format_component)
+ ).
+
+ % In some circumstances, we need more descriptive power than an
+ % error_msg_spec provides.
+ %
+ % The anything alternative allows the caller to specify an arbitrary thing
+ % to be printed at any point in the sequence. Since things printed this way
+ % aren't formatted as error messages should be (context at start etc), this
+ % capability is intended only for messages that help debug the compiler
+ % itself.
+
+:- type extended_error_msg_spec
+ ---> plain_spec(
+ error_msg_spec
)
; anything(
spec_write_anything :: pred(io, io)
).
-:- inst error_msg_spec ==
+:- inst extended_error_msg_spec ==
bound(
- error_msg_spec(ground, ground, ground, ground)
+ plain_spec(ground)
;
anything(pred(di, uo) is det)
).
-:- inst known_error_msg_spec ==
- bound(
- error_msg_spec(ground, ground, ground, ground)
- ).
-:- inst error_msg_specs == list_skel(error_msg_spec).
-:- inst known_error_msg_specs == list_skel(known_error_msg_spec).
+:- inst extended_error_msg_specs == list_skel(extended_error_msg_spec).
+
+:- pred extend_specs(list(error_msg_spec)::in,
+ list(extended_error_msg_spec)::out(extended_error_msg_specs)) is det.
:- pred add_to_spec_at_end(list(format_component)::in,
- error_msg_spec::in(known_error_msg_spec),
- error_msg_spec::out(known_error_msg_spec)) is det.
+ error_msg_spec::in, error_msg_spec::out) is det.
-:- pred write_error_specs(list(error_msg_spec)::in(error_msg_specs),
+:- pred write_error_specs(list(error_msg_spec)::in, io::di, io::uo) is det.
+
+:- pred write_extended_error_specs(
+ list(extended_error_msg_spec)::in(extended_error_msg_specs),
io::di, io::uo) is det.
:- func describe_sym_name(sym_name) = string.
@@ -273,15 +284,25 @@
Spec = error_msg_spec(First, Context, ExtraIndent, Pieces).
write_error_specs(Specs, !IO) :-
- write_error_specs_2(Specs, yes, !IO).
+ extend_specs(Specs, ExtendedSpecs),
+ do_write_error_specs(ExtendedSpecs, yes, !IO).
+
+write_extended_error_specs(ExtendedSpecs, !IO) :-
+ do_write_error_specs(ExtendedSpecs, yes, !IO).
+
+extend_specs([], []).
+extend_specs([Spec | Specs], [plain_spec(Spec) | ExtendedSpecs]) :-
+ extend_specs(Specs, ExtendedSpecs).
-:- pred write_error_specs_2(list(error_msg_spec)::in(error_msg_specs),
+:- pred do_write_error_specs(
+ list(extended_error_msg_spec)::in(extended_error_msg_specs),
bool::in, io::di, io::uo) is det.
-write_error_specs_2([], _First, !IO).
-write_error_specs_2([Spec | Specs], !.First, !IO) :-
+do_write_error_specs([], _First, !IO).
+do_write_error_specs([Spec | Specs], !.First, !IO) :-
(
- Spec = error_msg_spec(TreatAsFirst, Context, ExtraIndent, Pieces),
+ Spec = plain_spec(PlainSpec),
+ PlainSpec = error_msg_spec(TreatAsFirst, Context, ExtraIndent, Pieces),
(
TreatAsFirst = yes,
!:First = yes
@@ -301,7 +322,7 @@
Spec = anything(Pred),
Pred(!IO)
),
- write_error_specs_2(Specs, !.First, !IO).
+ do_write_error_specs(Specs, !.First, !IO).
string_to_words_piece(Str) = words(Str).
@@ -326,11 +347,11 @@
[Comp1, suffix(",")]
++ component_list_to_pieces([Comp2, Comp3 | Comps]).
-component_list_to_line_pieces([]) = [].
-component_list_to_line_pieces([Comps]) = Comps ++ [nl].
-component_list_to_line_pieces([Comps1, Comps2 | CompLists]) =
+component_list_to_line_pieces([], _) = [].
+component_list_to_line_pieces([Comps], Final) = Comps ++ Final ++ [nl].
+component_list_to_line_pieces([Comps1, Comps2 | CompLists], Final) =
Comps1 ++ [suffix(","), nl]
- ++ component_list_to_line_pieces([Comps2 | CompLists]).
+ ++ component_list_to_line_pieces([Comps2 | CompLists], Final).
choose_number([], _Singular, Plural) = Plural.
choose_number([_], Singular, _Plural) = Singular.
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.152
diff -u -b -r1.152 higher_order.m
--- compiler/higher_order.m 29 Mar 2006 08:06:46 -0000 1.152
+++ compiler/higher_order.m 15 Apr 2006 07:25:22 -0000
@@ -2000,7 +2000,7 @@
Args = [TypeInfoVar | SpecialPredArgs],
map.search(PredVars, TypeInfoVar,
constant(_TypeInfoConsId, TypeInfoVarArgs)),
- type_to_ctor_and_args(SpecialPredType, _ - TypeArity, _),
+ type_to_ctor_and_args(SpecialPredType, type_ctor(_, TypeArity), _),
( TypeArity = 0 ->
TypeInfoArgs = []
;
@@ -2320,7 +2320,7 @@
"tuple type in find_builtin_type_with_equivalent_compare")
;
TypeCategory = type_cat_enum,
- construct_type(unqualified("int") - 0, [], EqvType),
+ construct_type(type_ctor(unqualified("int"), 0), [], EqvType),
NeedIntCast = yes
;
TypeCategory = type_cat_variable,
Index: compiler/hlds_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_code_util.m,v
retrieving revision 1.25
diff -u -b -r1.25 hlds_code_util.m
--- compiler/hlds_code_util.m 29 Mar 2006 08:06:47 -0000 1.25
+++ compiler/hlds_code_util.m 15 Apr 2006 06:46:04 -0000
@@ -148,7 +148,7 @@
type_to_string(Type, String) :-
( type_to_ctor_and_args(Type, TypeCtor, _) ->
- TypeCtor = TypeName - TypeArity,
+ TypeCtor = type_ctor(TypeName, TypeArity),
sym_name_to_string(TypeName, "__", TypeNameString),
string.int_to_string(TypeArity, TypeArityString),
String = TypeNameString ++ "__arity" ++ TypeArityString ++ "__"
Index: compiler/hlds_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.104
diff -u -b -r1.104 hlds_data.m
--- compiler/hlds_data.m 29 Mar 2006 08:06:47 -0000 1.104
+++ compiler/hlds_data.m 15 Apr 2006 02:44:27 -0000
@@ -866,15 +866,15 @@
:- interface.
- % Identifiers for constraints which are unique across a given
- % type_assign. Integers in these values refer to the position in
- % the list of constraints at that location, beginning from 1.
- %
- % Only identifiers for constraints appearing directly on a goal are
- % needed at the moment, so there is no way to represent the
- % appropriate identifier for the superclass of such a constraint.
+ % Identifiers for constraints which are unique across a given type_assign.
+ % Integers in these values refer to the position in the list of constraints
+ % at that location, beginning from 1.
+ %
+ % Only identifiers for constraints appearing directly on a goal are needed
+ % at the moment, so there is no way to represent the appropriate identifier
+ % for the superclass of such a constraint.
%
- % XXX a more robust and efficient solution would be to allocate
+ % XXX A more robust and efficient solution would be to allocate
% unique integers to the constraints as they are encountered, and
% store the allocated integer in the relevant hlds_goal_expr.
%
@@ -940,7 +940,7 @@
%
:- type constraint_map == map(constraint_id, prog_constraint).
- % `Proof' of why a constraint is redundant
+ % `Proof' of why a constraint is redundant.
:- type constraint_proof
---> apply_instance(instance_id)
% Apply the instance decl with the given identifier. Note that
@@ -1076,11 +1076,13 @@
list(hlds_constraint)::out) is det.
make_hlds_constraint_list_2([], _, _, _, []).
-make_hlds_constraint_list_2([P | Ps], T, G, N, [H | Hs]) :-
- P = constraint(Name, Types),
- Id = constraint_id(T, G, N),
- H = constraint([Id], Name, Types),
- make_hlds_constraint_list_2(Ps, T, G, N + 1, Hs).
+make_hlds_constraint_list_2([ProgConstraint | ProgConstraints], ConstraintType,
+ GoalPath, N, [HLDSConstraint | HLDSConstraints]) :-
+ ProgConstraint = constraint(Name, Types),
+ Id = constraint_id(ConstraintType, GoalPath, N),
+ HLDSConstraint = constraint([Id], Name, Types),
+ make_hlds_constraint_list_2(ProgConstraints, ConstraintType, GoalPath,
+ N + 1, HLDSConstraints).
merge_hlds_constraints(ConstraintsA, ConstraintsB, Constraints) :-
ConstraintsA = constraints(UnprovenA, AssumedA, RedundantA),
Index: compiler/hlds_error_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_error_util.m,v
retrieving revision 1.18
diff -u -b -r1.18 hlds_error_util.m
--- compiler/hlds_error_util.m 29 Mar 2006 08:06:47 -0000 1.18
+++ compiler/hlds_error_util.m 15 Apr 2006 06:46:20 -0000
@@ -101,7 +101,7 @@
pred_info_get_origin(PredInfo, Origin),
( Origin = special_pred(SpecialId - TypeCtor) ->
special_pred_description(SpecialId, Descr),
- TypeCtor = TypeSymName - TypeArity,
+ TypeCtor = type_ctor(TypeSymName, TypeArity),
( TypeArity = 0 ->
Pieces = [words(Descr), words("for type"),
sym_name(TypeSymName)]
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.154
diff -u -b -r1.154 hlds_goal.m
--- compiler/hlds_goal.m 29 Mar 2006 08:06:47 -0000 1.154
+++ compiler/hlds_goal.m 15 Apr 2006 10:55:26 -0000
@@ -1367,7 +1367,7 @@
:- func simple_call_id_pred_or_func(simple_call_id) = pred_or_func.
-simple_call_id_pred_or_func(PredOrFunc - _) = PredOrFunc.
+simple_call_id_pred_or_func(simple_call_id(PredOrFunc, _, _)) = PredOrFunc.
%-----------------------------------------------------------------------------%
%
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.390
diff -u -b -r1.390 hlds_out.m
--- compiler/hlds_out.m 18 Apr 2006 05:47:33 -0000 1.390
+++ compiler/hlds_out.m 19 Apr 2006 06:03:07 -0000
@@ -291,10 +291,10 @@
%-----------------------------------------------------------------------------%
-write_type_ctor(Name - Arity, !IO) :-
+write_type_ctor(type_ctor(Name, Arity), !IO) :-
prog_out.write_sym_name_and_arity(Name / Arity, !IO).
-type_ctor_to_string(Name - Arity) = Str :-
+type_ctor_to_string(type_ctor(Name, Arity)) = Str :-
prog_out.sym_name_and_arity_to_string(Name / Arity, Str).
write_class_id(class_id(Name, Arity), !IO) :-
@@ -370,7 +370,7 @@
Origin = special_pred(SpecialId - TypeCtor)
->
special_pred_description(SpecialId, Descr),
- TypeCtor = _TypeSymName - TypeArity,
+ TypeCtor = type_ctor(_TypeSymName, TypeArity),
( TypeArity = 0 ->
ForStr = " for type "
;
@@ -494,7 +494,7 @@
:- func arg_number_to_string(call_id, int) = string.
-arg_number_to_string(call(PredOrFunc - _/Arity), ArgNum) =
+arg_number_to_string(call(simple_call_id(PredOrFunc, _, Arity)), ArgNum) =
(
PredOrFunc = function,
Arity = ArgNum
@@ -3074,12 +3074,12 @@
:- pred write_type_name(type_ctor::in, io::di, io::uo) is det.
-write_type_name(Name - _Arity, !IO) :-
+write_type_name(type_ctor(Name, _Arity), !IO) :-
prog_out.write_sym_name(Name, !IO).
:- func type_name_to_string(type_ctor) = string.
-type_name_to_string(Name - _Arity) =
+type_name_to_string(type_ctor(Name, _Arity)) =
prog_out.sym_name_to_escaped_string(Name).
:- pred write_type_params(tvarset::in, list(type_param)::in,
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.196
diff -u -b -r1.196 hlds_pred.m
--- compiler/hlds_pred.m 29 Mar 2006 08:06:49 -0000 1.196
+++ compiler/hlds_pred.m 15 Apr 2006 08:16:44 -0000
@@ -1433,11 +1433,12 @@
%-----------------------------------------------------------------------------%
-pred_info_get_call_id(PredInfo, PredOrFunc - qualified(Module, Name)/Arity) :-
+pred_info_get_call_id(PredInfo, SimpleCallId) :-
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
Module = pred_info_module(PredInfo),
Name = pred_info_name(PredInfo),
- Arity = pred_info_orig_arity(PredInfo).
+ Arity = pred_info_orig_arity(PredInfo),
+ SimpleCallId = simple_call_id(PredOrFunc, qualified(Module, Name), Arity).
%-----------------------------------------------------------------------------%
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.198
diff -u -b -r1.198 intermod.m
--- compiler/intermod.m 29 Mar 2006 08:06:51 -0000 1.198
+++ compiler/intermod.m 15 Apr 2006 11:40:12 -0000
@@ -937,7 +937,7 @@
;
TypeCtors = [TheTypeCtor],
MaybePredId = no,
- ( TheTypeCtor = qualified(TypeModule, _) - _ ->
+ ( TheTypeCtor = type_ctor(qualified(TypeModule, _), _) ->
unqualify_name(InstanceMethodName0, UnqualMethodName),
InstanceMethodName = qualified(TypeModule, UnqualMethodName)
;
@@ -1105,7 +1105,7 @@
should_write_type(ModuleName, TypeCtor, TypeDefn) :-
hlds_data.get_type_defn_status(TypeDefn, ImportStatus),
- TypeCtor = Name - _Arity,
+ TypeCtor = type_ctor(Name, _Arity),
Name = qualified(ModuleName, _),
import_status_to_write(ImportStatus).
@@ -1222,7 +1222,7 @@
hlds_data.get_type_defn_tparams(TypeDefn, Args),
hlds_data.get_type_defn_body(TypeDefn, Body),
hlds_data.get_type_defn_context(TypeDefn, Context),
- TypeCtor = Name - Arity,
+ TypeCtor = type_ctor(Name, Arity),
(
Ctors = Body ^ du_type_ctors,
MaybeUserEqComp = Body ^ du_type_usereq,
@@ -1313,7 +1313,7 @@
io::di, io::uo) is det.
write_mode(ModuleName, ModeId, ModeDefn, !IO) :-
- ModeId = SymName - _Arity,
+ ModeId = mode_id(SymName, _Arity),
ModeDefn = hlds_mode_defn(Varset, Args, eqv_mode(Mode), Context,
ImportStatus),
(
@@ -1340,7 +1340,7 @@
io::di, io::uo) is det.
write_inst(ModuleName, InstId, InstDefn, !IO) :-
- InstId = SymName - _Arity,
+ InstId = inst_id(SymName, _Arity),
InstDefn = hlds_inst_defn(Varset, Args, Body, Context, ImportStatus),
(
SymName = qualified(ModuleName, _),
Index: compiler/layout_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/layout_out.m,v
retrieving revision 1.64
diff -u -b -r1.64 layout_out.m
--- compiler/layout_out.m 30 Mar 2006 02:45:56 -0000 1.64
+++ compiler/layout_out.m 15 Apr 2006 06:50:18 -0000
@@ -1131,7 +1131,7 @@
;
ProcLabel = special_proc(DefiningModule, SpecialPredId,
TypeModule, TypeName, TypeArity, Mode),
- TypeCtor = qualified(TypeModule, TypeName) - TypeArity,
+ TypeCtor = type_ctor(qualified(TypeModule, TypeName), TypeArity),
PredName0 = special_pred_name(SpecialPredId, TypeCtor),
PredName = origin_name(Origin, PredName0),
sym_name_to_string(DefiningModule, DefiningModuleStr),
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.39
diff -u -b -r1.39 make_hlds_passes.m
--- compiler/make_hlds_passes.m 29 Mar 2006 08:06:59 -0000 1.39
+++ compiler/make_hlds_passes.m 15 Apr 2006 09:08:13 -0000
@@ -1593,7 +1593,7 @@
check_field_access_function(_AccessType, FieldName, FuncName, FuncArity,
FuncStatus, Context, Module, !IO) :-
adjust_func_arity(function, FuncArity, PredArity),
- FuncCallId = function - FuncName/PredArity,
+ FuncCallId = simple_call_id(function, FuncName, PredArity),
%
% Check that a function applied to an exported type
@@ -1601,12 +1601,12 @@
%
module_info_get_ctor_field_table(Module, CtorFieldTable),
(
- % Abstract types have status `abstract_exported',
- % so errors won't be reported for local field
- % access functions for them.
+ % Abstract types have status `abstract_exported', so errors won't be
+ % reported for local field access functions for them.
map.search(CtorFieldTable, FieldName, [FieldDefn]),
FieldDefn = hlds_ctor_field_defn(_, DefnStatus, _, _, _),
- DefnStatus = exported, FuncStatus \= exported
+ DefnStatus = exported,
+ FuncStatus \= exported
->
report_field_status_mismatch(Context, FuncCallId, !IO)
;
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.107
diff -u -b -r1.107 ml_code_util.m
--- compiler/ml_code_util.m 29 Mar 2006 08:07:02 -0000 1.107
+++ compiler/ml_code_util.m 15 Apr 2006 07:29:11 -0000
@@ -1318,15 +1318,15 @@
Origin, _ProcIsExported, _ProcIsImported),
( Origin = special_pred(SpecialPred - TypeCtor) ->
(
- % All type_ctors other than tuples here should be
- % module qualified, since builtin types are handled
- % separately in polymorphism.m.
+ % All type_ctors other than tuples here should be module qualified,
+ % since builtin types are handled separately in polymorphism.m.
+ TypeCtor = type_ctor(TypeCtorSymName, TypeArity),
(
- TypeCtor = unqualified(TypeName) - TypeArity,
+ TypeCtorSymName = unqualified(TypeName),
type_ctor_is_tuple(TypeCtor),
mercury_public_builtin_module(TypeModule)
;
- TypeCtor = qualified(TypeModule, TypeName) - TypeArity
+ TypeCtorSymName = qualified(TypeModule, TypeName)
)
->
(
Index: compiler/ml_tailcall.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_tailcall.m,v
retrieving revision 1.34
diff -u -b -r1.34 ml_tailcall.m
--- compiler/ml_tailcall.m 29 Mar 2006 08:07:04 -0000 1.34
+++ compiler/ml_tailcall.m 15 Apr 2006 08:18:03 -0000
@@ -589,14 +589,13 @@
(
PredLabel = pred(PredOrFunc, _MaybeModule, Name, Arity,
_CodeModel, _NonOutputFunc),
- CallId = simple_call_id_to_string(PredOrFunc -
- unqualified(Name) / Arity),
+ SimpleCallId = simple_call_id(PredOrFunc, unqualified(Name), Arity),
proc_id_to_int(ProcId, ProcNumber0),
ProcNumber = ProcNumber0 + 1,
ProcNumberStr = string.int_to_string(ProcNumber),
report_warning(mlds_get_prog_context(Context), 0, [
words("In mode number"), words(ProcNumberStr),
- words("of"), fixed(CallId ++ ":"), nl,
+ words("of"), simple_call_id(SimpleCallId), suffix(":"), nl,
words("warning: recursive call is not tail recursive.")
], !IO)
;
Index: compiler/ml_type_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_type_gen.m,v
retrieving revision 1.51
diff -u -b -r1.51 ml_type_gen.m
--- compiler/ml_type_gen.m 29 Mar 2006 08:07:04 -0000 1.51
+++ compiler/ml_type_gen.m 15 Apr 2006 07:05:14 -0000
@@ -918,7 +918,7 @@
% Miscellaneous helper routines.
%
-ml_gen_type_name(Name - Arity, QualifiedTypeName, Arity) :-
+ml_gen_type_name(type_ctor(Name, Arity), QualifiedTypeName, Arity) :-
(
Name = qualified(ModuleName, TypeName)
;
@@ -936,8 +936,8 @@
:- pred ml_gen_equality_members(maybe(unify_compare)::in,
list(mlds_defn)::out) is det.
-ml_gen_equality_members(_, []). % XXX generation of `==' members
- % is not yet implemented.
+% XXX generation of `==' members is not yet implemented.
+ml_gen_equality_members(_, []).
%-----------------------------------------------------------------------------%
%
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.98
diff -u -b -r1.98 ml_unify_gen.m
--- compiler/ml_unify_gen.m 29 Mar 2006 08:07:04 -0000 1.98
+++ compiler/ml_unify_gen.m 15 Apr 2006 07:05:31 -0000
@@ -490,7 +490,7 @@
( QualCtorName = qualified(ModuleName, CtorName) ->
module_info_get_globals(ModuleInfo, Globals),
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
- TypeCtor = TypeName - TypeArity,
+ TypeCtor = type_ctor(TypeName, TypeArity),
unqualify_name(TypeName, UnqualTypeName),
MLDS_TypeName = mlds_append_class_qualifier(MLDS_ModuleName,
module_qual, Globals, UnqualTypeName, TypeArity),
Index: compiler/ml_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_util.m,v
retrieving revision 1.44
diff -u -b -r1.44 ml_util.m
--- compiler/ml_util.m 29 Mar 2006 08:07:04 -0000 1.44
+++ compiler/ml_util.m 15 Apr 2006 07:05:42 -0000
@@ -617,7 +617,7 @@
type_ctor_needs_lowlevel_rep(Target, TypeCtor).
% XXX Do we need to do the same for the Java back-end?
-type_ctor_needs_lowlevel_rep(il, TypeName - _Arity) :-
+type_ctor_needs_lowlevel_rep(il, type_ctor(TypeName, _Arity)) :-
mercury_public_builtin_module(Builtin),
mercury_private_builtin_module(PrivateBuiltin),
RttiImplementation = unqualified("rtti_implementation"),
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.131
diff -u -b -r1.131 mlds.m
--- compiler/mlds.m 29 Mar 2006 08:07:04 -0000 1.131
+++ compiler/mlds.m 15 Apr 2006 14:22:05 -0000
@@ -1722,14 +1722,14 @@
mercury_type_to_mlds_type(ModuleInfo, Type) = MLDSType :-
(
type_to_ctor_and_args(Type, TypeCtor, [ElemType]),
- TypeCtor = qualified(unqualified("array"), "array") - 1
+ TypeCtor = type_ctor(qualified(unqualified("array"), "array"), 1)
->
MLDSElemType = mercury_type_to_mlds_type(ModuleInfo, ElemType),
MLDSType = mlds_mercury_array_type(MLDSElemType)
;
type_to_ctor_and_args(Type, TypeCtor, [RefType]),
- TypeCtor = qualified(mercury_private_builtin_module,
- "store_by_ref_type") - 1
+ TypeCtor = type_ctor(qualified(mercury_private_builtin_module,
+ "store_by_ref_type"), 1)
->
MLDSRefType = mercury_type_to_mlds_type(ModuleInfo, RefType),
MLDSType = mlds_ptr_type(MLDSRefType)
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.186
diff -u -b -r1.186 mlds_to_c.m
--- compiler/mlds_to_c.m 10 Apr 2006 06:25:40 -0000 1.186
+++ compiler/mlds_to_c.m 15 Apr 2006 07:06:27 -0000
@@ -1857,7 +1857,7 @@
(
HighLevelData = yes,
mlds_output_mercury_user_type_name(
- qualified(unqualified("array"), "array") - 1,
+ type_ctor(qualified(unqualified("array"), "array"), 1),
type_cat_user_ctor, !IO)
;
HighLevelData = no,
Index: compiler/mmc_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mmc_analysis.m,v
retrieving revision 1.15
diff -u -b -r1.15 mmc_analysis.m
--- compiler/mmc_analysis.m 29 Mar 2006 08:07:06 -0000 1.15
+++ compiler/mmc_analysis.m 15 Apr 2006 11:42:33 -0000
@@ -129,7 +129,8 @@
string_to_sym_name(ModuleId, ".", ModuleName).
pred_or_func_name_arity_to_func_id(PredOrFunc, Name, Arity, ProcId) = FuncId :-
- FuncId0 = simple_call_id_to_string(PredOrFunc - unqualified(Name)/Arity),
+ SimpleCallId = simple_call_id(PredOrFunc, unqualified(Name), Arity),
+ FuncId0 = simple_call_id_to_string(SimpleCallId),
proc_id_to_int(ProcId, ProcInt),
FuncId = FuncId0 ++ "-" ++ int_to_string(ProcInt).
Index: compiler/mode_errors.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_errors.m,v
retrieving revision 1.100
diff -u -b -r1.100 mode_errors.m
--- compiler/mode_errors.m 29 Mar 2006 08:07:07 -0000 1.100
+++ compiler/mode_errors.m 15 Apr 2006 14:30:23 -0000
@@ -265,12 +265,12 @@
%-----------------------------------------------------------------------------%
report_mode_error(ModeError, ModeInfo, !IO) :-
- Specs = mode_error_to_specs(ModeError, ModeInfo),
+ ExtendedSpecs = mode_error_to_specs(ModeError, ModeInfo),
% XXX This module needs some rearrangement for the global extra erro info
% flag to be respected properly. In the meantime we just set it to yes
% because that was the original behaviour for this module was.
globals.io_set_extra_error_info(yes, !IO),
- write_error_specs(Specs, !IO).
+ write_extended_error_specs(ExtendedSpecs, !IO).
report_mode_warning(ModeInfo, Warning, !IO) :-
Specs = mode_warning_to_specs(ModeInfo, Warning),
@@ -278,86 +278,104 @@
record_warning(!IO).
:- func mode_error_to_specs(mode_error::in, mode_info::in)
- = (list(error_msg_spec)::out(error_msg_specs)) is det.
+ = (list(extended_error_msg_spec)::out(extended_error_msg_specs)) is det.
-mode_error_to_specs(ModeError, ModeInfo) = Specs :-
+mode_error_to_specs(ModeError, ModeInfo) = ExtendedSpecs :-
(
ModeError = mode_error_disj(MergeContext, ErrorList),
- Specs = mode_error_disj_to_specs(ModeInfo, MergeContext, ErrorList)
+ Specs = mode_error_disj_to_specs(ModeInfo, MergeContext, ErrorList),
+ extend_specs(Specs, ExtendedSpecs)
;
ModeError = mode_error_par_conj(ErrorList),
- Specs = mode_error_par_conj_to_specs(ModeInfo, ErrorList)
+ Specs = mode_error_par_conj_to_specs(ModeInfo, ErrorList),
+ extend_specs(Specs, ExtendedSpecs)
;
ModeError = mode_error_higher_order_pred_var(PredOrFunc, Var, Inst,
Arity),
Specs = mode_error_higher_order_pred_var_to_specs(ModeInfo, PredOrFunc,
- Var, Inst, Arity)
+ Var, Inst, Arity),
+ extend_specs(Specs, ExtendedSpecs)
;
ModeError = mode_error_poly_unify(Var, Inst),
- Specs = mode_error_poly_unify_to_specs(ModeInfo, Var, Inst)
+ Specs = mode_error_poly_unify_to_specs(ModeInfo, Var, Inst),
+ extend_specs(Specs, ExtendedSpecs)
;
ModeError = mode_error_var_is_live(Var),
- Specs = mode_error_var_is_live_to_specs(ModeInfo, Var)
+ Specs = mode_error_var_is_live_to_specs(ModeInfo, Var),
+ extend_specs(Specs, ExtendedSpecs)
;
ModeError = mode_error_var_has_inst(Var, InstA, InstB),
- Specs = mode_error_var_has_inst_to_specs(ModeInfo, Var, InstA, InstB)
+ Specs = mode_error_var_has_inst_to_specs(ModeInfo, Var, InstA, InstB),
+ extend_specs(Specs, ExtendedSpecs)
;
ModeError = mode_error_unify_pred(Var, RHS, Type, PredOrFunc),
Specs = mode_error_unify_pred_to_specs(ModeInfo, Var, RHS, Type,
- PredOrFunc)
+ PredOrFunc),
+ extend_specs(Specs, ExtendedSpecs)
;
ModeError = mode_error_implied_mode(Var, InstA, InstB),
- Specs = mode_error_implied_mode_to_specs(ModeInfo, Var, InstA, InstB)
+ Specs = mode_error_implied_mode_to_specs(ModeInfo, Var, InstA, InstB),
+ extend_specs(Specs, ExtendedSpecs)
;
ModeError = mode_error_no_mode_decl,
- Specs = mode_error_no_mode_decl_to_specs(ModeInfo)
+ Specs = mode_error_no_mode_decl_to_specs(ModeInfo),
+ extend_specs(Specs, ExtendedSpecs)
;
ModeError = mode_error_bind_var(Reason, Var, InstA, InstB),
Specs = mode_error_bind_var_to_specs(ModeInfo, Reason, Var,
- InstA, InstB)
+ InstA, InstB),
+ extend_specs(Specs, ExtendedSpecs)
;
ModeError = mode_error_non_local_lambda_var(Var, Inst),
- Specs = mode_error_non_local_lambda_var_to_specs(ModeInfo, Var, Inst)
+ Specs = mode_error_non_local_lambda_var_to_specs(ModeInfo, Var, Inst),
+ extend_specs(Specs, ExtendedSpecs)
;
ModeError = mode_error_unify_var_var(VarA, VarB, InstA, InstB),
Specs = mode_error_unify_var_var_to_specs(ModeInfo, VarA, VarB,
- InstA, InstB)
+ InstA, InstB),
+ extend_specs(Specs, ExtendedSpecs)
;
ModeError = mode_error_unify_var_lambda(VarA, InstA, InstB),
Specs = mode_error_unify_var_lambda_to_specs(ModeInfo, VarA,
- InstA, InstB)
+ InstA, InstB),
+ extend_specs(Specs, ExtendedSpecs)
;
ModeError = mode_error_unify_var_functor(Var, Name, Args, Inst,
ArgInsts),
Specs = mode_error_unify_var_functor_to_specs(ModeInfo, Var, Name,
- Args, Inst, ArgInsts)
+ Args, Inst, ArgInsts),
+ extend_specs(Specs, ExtendedSpecs)
;
ModeError = mode_error_conj(Errors, Culprit),
- Specs = mode_error_conj_to_specs(ModeInfo, Errors, Culprit)
+ ExtendedSpecs = mode_error_conj_to_specs(ModeInfo, Errors, Culprit)
;
ModeError = mode_error_no_matching_mode(Vars, Insts),
- Specs = mode_error_no_matching_mode_to_specs(ModeInfo, Vars, Insts)
+ Specs = mode_error_no_matching_mode_to_specs(ModeInfo, Vars, Insts),
+ extend_specs(Specs, ExtendedSpecs)
;
ModeError = mode_error_in_callee(Vars, Insts,
CalleePredId, CalleeProcId, CalleeErrors),
- Specs = mode_error_in_callee_to_specs(ModeInfo, Vars, Insts,
+ ExtendedSpecs = mode_error_in_callee_to_specs(ModeInfo, Vars, Insts,
CalleePredId, CalleeProcId, CalleeErrors)
;
ModeError = mode_error_final_inst(ArgNum, Var, VarInst, Inst, Reason),
Specs = mode_error_final_inst_to_specs(ModeInfo, ArgNum, Var, VarInst,
- Inst, Reason)
+ Inst, Reason),
+ extend_specs(Specs, ExtendedSpecs)
;
ModeError = purity_error_should_be_in_promise_purity_scope(NegCtxt,
Var),
Specs = purity_error_should_be_in_promise_purity_scope_to_specs(
- NegCtxt, ModeInfo, Var)
+ NegCtxt, ModeInfo, Var),
+ extend_specs(Specs, ExtendedSpecs)
;
ModeError = purity_error_lambda_should_be_impure(Vars),
- Specs = purity_error_lambda_should_be_impure_to_specs(ModeInfo, Vars)
+ Specs = purity_error_lambda_should_be_impure_to_specs(ModeInfo, Vars),
+ extend_specs(Specs, ExtendedSpecs)
).
-:- func mode_warning_to_specs(mode_info::in, mode_warning_info::in)
- = (list(error_msg_spec)::out(error_msg_specs)) is det.
+:- func mode_warning_to_specs(mode_info, mode_warning_info)
+ = list(error_msg_spec).
mode_warning_to_specs(!.ModeInfo, Warning) = Specs :-
Warning = mode_warning_info(ModeWarning, Context, ModeContext),
@@ -376,8 +394,8 @@
%-----------------------------------------------------------------------------%
:- func mode_error_conj_to_specs(mode_info::in, list(delayed_goal)::in,
- schedule_culprit::in) = (list(error_msg_spec)::out(error_msg_specs))
- is det.
+ schedule_culprit::in)
+ = (list(extended_error_msg_spec)::out(extended_error_msg_specs)) is det.
mode_error_conj_to_specs(ModeInfo, Errors, Culprit) = Specs :-
mode_info_get_context(ModeInfo, Context),
@@ -396,8 +414,8 @@
PiecesA = [words("mode error in conjunction. The next"),
fixed(int_to_string(list.length(Errors))),
words("error messages indicate possible causes of this error.")],
- Specs1Start = [mode_info_context_to_spec(ModeInfo),
- error_msg_spec(no, Context, 0, PiecesA)],
+ Specs1Start = [plain_spec(mode_info_context_to_spec(ModeInfo)),
+ plain_spec(error_msg_spec(no, Context, 0, PiecesA))],
Specs1Rest = list.map(
mode_error_conjunct_to_specs(VarSet, Context, ModeInfo),
ImportantErrors ++ OtherErrors),
@@ -428,7 +446,7 @@
Culprit = goal_itself_was_impure,
Pieces = [words("The goal could not be reordered,"),
words("because it was impure.")],
- Specs2 = [error_msg_spec(no, Context, 0, Pieces)]
+ Specs2 = [plain_spec(error_msg_spec(no, Context, 0, Pieces))]
;
Culprit = goals_followed_by_impure_goal(ImpureGoal),
ImpureGoal = _ - ImpureGoalInfo,
@@ -436,8 +454,8 @@
Pieces1 = [words("The goal could not be reordered,"),
words("becaise it was followed by an impure goal.")],
Pieces2 = [words("This is the location of the impure goal.")],
- Specs2 = [error_msg_spec(no, Context, 0, Pieces1),
- error_msg_spec(no, ImpureGoalContext, 0, Pieces2)]
+ Specs2 = [plain_spec(error_msg_spec(no, Context, 0, Pieces1)),
+ plain_spec(error_msg_spec(no, ImpureGoalContext, 0, Pieces2))]
),
Specs = Specs1 ++ Specs2.
@@ -462,7 +480,7 @@
:- func mode_error_conjunct_to_specs(prog_varset::in, prog_context::in,
mode_info::in, delayed_goal::in)
- = (list(error_msg_spec)::out(error_msg_specs)) is det.
+ = (list(extended_error_msg_spec)::out(extended_error_msg_specs)) is det.
mode_error_conjunct_to_specs(VarSet, Context, !.ModeInfo, DelayedGoal)
= Specs :-
@@ -476,7 +494,7 @@
Pieces1 = [words("Floundered goal, waiting on { "),
words(mercury_vars_to_string(VarList, VarSet, no)),
words(" } :"), nl],
- Specs1 = [error_msg_spec(no, Context, 0, Pieces1)]
+ Specs1 = [plain_spec(error_msg_spec(no, Context, 0, Pieces1))]
;
Debug = no,
Specs1 = []
@@ -503,8 +521,8 @@
%-----------------------------------------------------------------------------%
-:- func mode_error_disj_to_specs(mode_info::in, merge_context::in,
- merge_errors::in) = (list(error_msg_spec)::out(error_msg_specs)) is det.
+:- func mode_error_disj_to_specs(mode_info, merge_context, merge_errors)
+ = list(error_msg_spec).
mode_error_disj_to_specs(ModeInfo, MergeContext, ErrorList) = Specs :-
mode_info_get_context(ModeInfo, Context),
@@ -514,8 +532,8 @@
error_msg_spec(no, Context, 0, Pieces) |
list.map(merge_error_to_spec(ModeInfo), ErrorList)].
-:- func mode_error_par_conj_to_specs(mode_info::in, merge_errors::in)
- = (list(error_msg_spec)::out(error_msg_specs)) is det.
+:- func mode_error_par_conj_to_specs(mode_info, merge_errors)
+ = list(error_msg_spec).
mode_error_par_conj_to_specs(ModeInfo, ErrorList) = Specs :-
mode_info_get_context(ModeInfo, Context),
@@ -527,8 +545,7 @@
error_msg_spec(no, Context, 0, Pieces) |
list.map(merge_error_to_spec(ModeInfo), ErrorList)].
-:- func merge_error_to_spec(mode_info::in, merge_error::in)
- = (error_msg_spec::out(error_msg_spec)) is det.
+:- func merge_error_to_spec(mode_info, merge_error) = error_msg_spec.
merge_error_to_spec(ModeInfo, Var - Insts) = Spec :-
mode_info_get_context(ModeInfo, Context),
@@ -545,9 +562,8 @@
%-----------------------------------------------------------------------------%
-:- func mode_error_bind_var_to_specs(mode_info::in, var_lock_reason::in,
- prog_var::in, mer_inst::in, mer_inst::in)
- = (list(error_msg_spec)::out(error_msg_specs)) is det.
+:- func mode_error_bind_var_to_specs(mode_info, var_lock_reason,
+ prog_var, mer_inst, mer_inst) = list(error_msg_spec).
mode_error_bind_var_to_specs(ModeInfo, Reason, Var, VarInst, Inst) = Specs :-
mode_info_get_context(ModeInfo, Context),
@@ -613,8 +629,8 @@
%-----------------------------------------------------------------------------%
-:- func mode_error_non_local_lambda_var_to_specs(mode_info::in, prog_var::in,
- mer_inst::in) = (list(error_msg_spec)::out(error_msg_specs)) is det.
+:- func mode_error_non_local_lambda_var_to_specs(mode_info, prog_var, mer_inst)
+ = list(error_msg_spec).
mode_error_non_local_lambda_var_to_specs(ModeInfo, Var, VarInst) = Specs :-
mode_info_get_context(ModeInfo, Context),
@@ -633,7 +649,7 @@
:- func mode_error_in_callee_to_specs(mode_info::in, list(prog_var)::in,
list(mer_inst)::in, pred_id::in, proc_id::in, list(mode_error_info)::in)
- = (list(error_msg_spec)::out(error_msg_specs)) is det.
+ = (list(extended_error_msg_spec)::out(extended_error_msg_specs)) is det.
mode_error_in_callee_to_specs(!.ModeInfo, Vars, Insts,
CalleePredId, CalleeProcId, CalleeModeErrors) = Specs :-
@@ -657,8 +673,8 @@
VerboseErrors = no,
Pieces2 = [words("the callee, because of the following error."), nl]
),
- InitSpecs = [mode_info_context_to_spec(!.ModeInfo),
- error_msg_spec(no, Context, 0, Pieces1 ++ Pieces2)],
+ InitSpecs = [plain_spec(mode_info_context_to_spec(!.ModeInfo)),
+ plain_spec(error_msg_spec(no, Context, 0, Pieces1 ++ Pieces2))],
(
CalleeModeErrors = [First | _],
First = mode_error_info(_, CalleeModeError,
@@ -674,8 +690,9 @@
;
LaterSpecs0 = [LaterSpecsHead0 | LaterSpecsTail],
(
- LaterSpecsHead0 = error_msg_spec(_, _, _, _),
- LaterSpecsHead = LaterSpecsHead0 ^ spec_treat_as_first := yes
+ LaterSpecsHead0 = plain_spec(Spec0),
+ Spec = Spec0 ^ spec_treat_as_first := yes,
+ LaterSpecsHead = plain_spec(Spec)
;
LaterSpecsHead0 = anything(_),
LaterSpecsHead = LaterSpecsHead0
@@ -688,8 +705,8 @@
unexpected(this_file, "report_mode_error_in_callee: no error")
).
-:- func mode_error_no_matching_mode_to_specs(mode_info::in, list(prog_var)::in,
- list(mer_inst)::in) = (list(error_msg_spec)::out(error_msg_specs)) is det.
+:- func mode_error_no_matching_mode_to_specs(mode_info, list(prog_var),
+ list(mer_inst)) = list(error_msg_spec).
mode_error_no_matching_mode_to_specs(ModeInfo, Vars, Insts) = Specs :-
mode_info_get_context(ModeInfo, Context),
@@ -710,9 +727,8 @@
Specs = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces)].
-:- func mode_error_higher_order_pred_var_to_specs(mode_info::in,
- pred_or_func::in, prog_var::in, mer_inst::in, arity::in)
- = (list(error_msg_spec)::out(error_msg_specs)) is det.
+:- func mode_error_higher_order_pred_var_to_specs(mode_info, pred_or_func,
+ prog_var, mer_inst, arity) = list(error_msg_spec).
mode_error_higher_order_pred_var_to_specs(ModeInfo, PredOrFunc, Var, VarInst,
Arity) = Specs :-
@@ -736,8 +752,8 @@
Specs = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces)].
-:- func mode_error_poly_unify_to_specs(mode_info::in, prog_var::in,
- mer_inst::in) = (list(error_msg_spec)::out(error_msg_specs)) is det.
+:- func mode_error_poly_unify_to_specs(mode_info, prog_var, mer_inst)
+ = list(error_msg_spec).
mode_error_poly_unify_to_specs(ModeInfo, Var, VarInst) = Specs :-
mode_info_get_context(ModeInfo, Context),
@@ -765,8 +781,8 @@
Specs = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces1 ++ Pieces2)].
-:- func mode_error_var_is_live_to_specs(mode_info::in, prog_var::in)
- = (list(error_msg_spec)::out(error_msg_specs)) is det.
+:- func mode_error_var_is_live_to_specs(mode_info, prog_var)
+ = list(error_msg_spec).
mode_error_var_is_live_to_specs(ModeInfo, Var) = Specs :-
mode_info_get_context(ModeInfo, Context),
@@ -778,9 +794,8 @@
Specs = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces)].
-:- func mode_error_var_has_inst_to_specs(mode_info::in, prog_var::in,
- mer_inst::in, mer_inst::in) = (list(error_msg_spec)::out(error_msg_specs))
- is det.
+:- func mode_error_var_has_inst_to_specs(mode_info, prog_var,
+ mer_inst, mer_inst) = list(error_msg_spec).
mode_error_var_has_inst_to_specs(ModeInfo, Var, VarInst, Inst) = Specs :-
mode_info_get_context(ModeInfo, Context),
@@ -794,9 +809,8 @@
Specs = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces)].
-:- func mode_error_implied_mode_to_specs(mode_info::in, prog_var::in,
- mer_inst::in, mer_inst::in) = (list(error_msg_spec)::out(error_msg_specs))
- is det.
+:- func mode_error_implied_mode_to_specs(mode_info, prog_var,
+ mer_inst, mer_inst) = list(error_msg_spec).
mode_error_implied_mode_to_specs(ModeInfo, Var, VarInst, Inst) = Specs :-
% This "error" message is really a "sorry, not implemented" message.
@@ -825,7 +839,7 @@
).
:- func mode_error_no_mode_decl_to_specs(mode_info::in)
- = (list(error_msg_spec)::out(error_msg_specs)) is det.
+ = (list(error_msg_spec)::out) is det.
mode_error_no_mode_decl_to_specs(ModeInfo) = Specs :-
mode_info_get_context(ModeInfo, Context),
@@ -833,9 +847,8 @@
Specs = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces)].
-:- func mode_error_unify_pred_to_specs(mode_info::in, prog_var::in,
- mode_error_unify_rhs::in, mer_type::in, pred_or_func::in)
- = (list(error_msg_spec)::out(error_msg_specs)) is det.
+:- func mode_error_unify_pred_to_specs(mode_info, prog_var,
+ mode_error_unify_rhs, mer_type, pred_or_func) = list(error_msg_spec).
mode_error_unify_pred_to_specs(ModeInfo, X, RHS, Type, PredOrFunc) = Specs :-
mode_info_get_context(ModeInfo, Context),
@@ -889,9 +902,8 @@
%-----------------------------------------------------------------------------%
-:- func mode_error_unify_var_var_to_specs(mode_info::in, prog_var::in,
- prog_var::in, mer_inst::in, mer_inst::in)
- = (list(error_msg_spec)::out(error_msg_specs)) is det.
+:- func mode_error_unify_var_var_to_specs(mode_info, prog_var,
+ prog_var, mer_inst, mer_inst) = list(error_msg_spec).
mode_error_unify_var_var_to_specs(ModeInfo, X, Y, InstX, InstY) = Specs :-
mode_info_get_context(ModeInfo, Context),
@@ -914,9 +926,8 @@
%-----------------------------------------------------------------------------%
-:- func mode_error_unify_var_lambda_to_specs(mode_info::in, prog_var::in,
- mer_inst::in, mer_inst::in) = (list(error_msg_spec)::out(error_msg_specs))
- is det.
+:- func mode_error_unify_var_lambda_to_specs(mode_info, prog_var,
+ mer_inst, mer_inst) = list(error_msg_spec).
mode_error_unify_var_lambda_to_specs(ModeInfo, X, InstX, InstY) = Specs :-
mode_info_get_context(ModeInfo, Context),
@@ -935,9 +946,8 @@
%-----------------------------------------------------------------------------%
-:- func mode_error_unify_var_functor_to_specs(mode_info::in, prog_var::in,
- cons_id::in, list(prog_var)::in, mer_inst::in, list(mer_inst)::in)
- = (list(error_msg_spec)::out(error_msg_specs)) is det.
+:- func mode_error_unify_var_functor_to_specs(mode_info, prog_var,
+ cons_id, list(prog_var), mer_inst, list(mer_inst)) = list(error_msg_spec).
mode_error_unify_var_functor_to_specs(ModeInfo, X, ConsId, Args,
InstX, ArgInsts) = Specs :-
@@ -975,9 +985,8 @@
%-----------------------------------------------------------------------------%
-:- func mode_warning_cannot_succeed_var_var(mode_info::in,
- prog_var::in, prog_var::in, mer_inst::in, mer_inst::in)
- = (list(error_msg_spec)::out(error_msg_specs)) is det.
+:- func mode_warning_cannot_succeed_var_var(mode_info,
+ prog_var, prog_var, mer_inst, mer_inst) = list(error_msg_spec).
mode_warning_cannot_succeed_var_var(ModeInfo, X, Y, InstX, InstY) = Specs :-
mode_info_get_context(ModeInfo, Context),
@@ -996,9 +1005,8 @@
Specs = [mode_info_context_to_spec(ModeInfo),
error_msg_spec(no, Context, 0, Pieces)].
-:- func mode_warning_cannot_succeed_var_functor(mode_info::in,
- prog_var::in, mer_inst::in, cons_id::in)
- = (list(error_msg_spec)::out(error_msg_specs)) is det.
+:- func mode_warning_cannot_succeed_var_functor(mode_info, prog_var, mer_inst,
+ cons_id) = list(error_msg_spec).
mode_warning_cannot_succeed_var_functor(ModeInfo, X, InstX, ConsId) = Specs :-
mode_info_get_context(ModeInfo, Context),
@@ -1016,8 +1024,7 @@
%-----------------------------------------------------------------------------%
-:- func mode_info_context_to_spec(mode_info::in)
- = (error_msg_spec::out(error_msg_spec)) is det.
+:- func mode_info_context_to_spec(mode_info) = error_msg_spec.
mode_info_context_to_spec(ModeInfo) = Spec :-
mode_info_get_module_info(ModeInfo, ModuleInfo),
@@ -1064,9 +1071,8 @@
%-----------------------------------------------------------------------------%
-:- func mode_error_final_inst_to_specs(mode_info::in, int::in, prog_var::in,
- mer_inst::in, mer_inst::in, final_inst_error::in)
- = (list(error_msg_spec)::out(error_msg_specs)) is det.
+:- func mode_error_final_inst_to_specs(mode_info, int, prog_var,
+ mer_inst, mer_inst, final_inst_error) = list(error_msg_spec).
mode_error_final_inst_to_specs(ModeInfo, ArgNum, Var, VarInst, Inst, Reason)
= Specs :-
@@ -1095,8 +1101,7 @@
%-----------------------------------------------------------------------------%
:- func purity_error_should_be_in_promise_purity_scope_to_specs(
- negated_context_desc::in, mode_info::in, prog_var::in) =
- (list(error_msg_spec)::out(error_msg_specs)) is det.
+ negated_context_desc, mode_info, prog_var) = list(error_msg_spec).
purity_error_should_be_in_promise_purity_scope_to_specs(NegCtxtDesc,
ModeInfo, Var) = Specs :-
@@ -1128,9 +1133,8 @@
%-----------------------------------------------------------------------------%
-:- func purity_error_lambda_should_be_impure_to_specs(mode_info::in,
- list(prog_var)::in) = (list(error_msg_spec)::out(error_msg_specs))
- is det.
+:- func purity_error_lambda_should_be_impure_to_specs(mode_info,
+ list(prog_var)) = list(error_msg_spec).
purity_error_lambda_should_be_impure_to_specs(ModeInfo, Vars) = Specs :-
mode_info_get_context(ModeInfo, Context),
Index: compiler/mode_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.185
diff -u -b -r1.185 mode_util.m
--- compiler/mode_util.m 29 Mar 2006 08:07:08 -0000 1.185
+++ compiler/mode_util.m 15 Apr 2006 08:10:51 -0000
@@ -455,7 +455,7 @@
inst_table_get_user_insts(InstTable, UserInstTable),
user_inst_table_get_inst_defns(UserInstTable, InstDefns),
list.length(Args, Arity),
- ( map.search(InstDefns, Name - Arity, InstDefn) ->
+ ( map.search(InstDefns, inst_id(Name, Arity), InstDefn) ->
InstDefn = hlds_inst_defn(_VarSet, Params, InstBody, _C, _),
inst_lookup_subst_args(InstBody, Params, Name, Args, Inst)
;
@@ -789,7 +789,7 @@
BoundInsts0, BoundInsts)
;
type_to_ctor_and_args(Type, TypeCtor, TypeArgs),
- TypeCtor = qualified(TypeModule, _) - _,
+ TypeCtor = type_ctor(qualified(TypeModule, _), _),
module_info_get_type_table(ModuleInfo, TypeTable),
map.search(TypeTable, TypeCtor, TypeDefn),
hlds_data.get_type_defn_tparams(TypeDefn, TypeParams),
@@ -900,7 +900,7 @@
list.length(Args, Arity),
module_info_get_mode_table(ModuleInfo, Modes),
mode_table_get_mode_defns(Modes, ModeDefns),
- map.search(ModeDefns, Name - Arity, HLDS_Mode),
+ map.search(ModeDefns, mode_id(Name, Arity), HLDS_Mode),
HLDS_Mode = hlds_mode_defn(_VarSet, Params, ModeDefn, _Context, _Status),
ModeDefn = eqv_mode(Mode0),
mode_substitute_arg_list(Mode0, Params, Args, Mode),
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.331
diff -u -b -r1.331 modes.m
--- compiler/modes.m 29 Mar 2006 08:07:09 -0000 1.331
+++ compiler/modes.m 15 Apr 2006 06:34:02 -0000
@@ -3164,9 +3164,9 @@
type_to_ctor_and_args(VarType, TypeCtor, _TypeArgs),
PredName = special_pred.special_pred_name(spec_pred_init, TypeCtor),
(
- TypeCtor = qualified(ModuleName, _TypeName) - _Arity
+ TypeCtor = type_ctor(qualified(ModuleName, _TypeName), _Arity)
;
- TypeCtor = unqualified(_TypeName) - _Arity,
+ TypeCtor = type_ctor(unqualified(_TypeName), _Arity),
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
module_info_get_name(ModuleInfo, ModuleName)
),
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.131
diff -u -b -r1.131 module_qual.m
--- compiler/module_qual.m 29 Mar 2006 08:07:10 -0000 1.131
+++ compiler/module_qual.m 15 Apr 2006 14:33:21 -0000
@@ -276,8 +276,8 @@
mq_info_get_types(!.Info, Types0),
mq_info_get_impl_types(!.Info, ImplTypes0),
mq_info_get_need_qual_flag(!.Info, NeedQualifier),
- id_set_insert(NeedQualifier, SymName - Arity, Types0, Types),
- id_set_insert(NeedQualifier, SymName - Arity,
+ id_set_insert(NeedQualifier, mq_id(SymName, Arity), Types0, Types),
+ id_set_insert(NeedQualifier, mq_id(SymName, Arity),
ImplTypes0, ImplTypes),
mq_info_set_types(Types, !Info),
mq_info_set_impl_types(ImplTypes, !Info)
@@ -290,7 +290,7 @@
list.length(Params, Arity),
mq_info_get_insts(!.Info, Insts0),
mq_info_get_need_qual_flag(!.Info, NeedQualifier),
- id_set_insert(NeedQualifier, SymName - Arity, Insts0, Insts),
+ id_set_insert(NeedQualifier, mq_id(SymName, Arity), Insts0, Insts),
mq_info_set_insts(Insts, !Info)
).
collect_mq_info_2(mode_defn(_, SymName, Params, _, _), !Info) :-
@@ -301,7 +301,7 @@
list.length(Params, Arity),
mq_info_get_modes(!.Info, Modes0),
mq_info_get_need_qual_flag(!.Info, NeedQualifier),
- id_set_insert(NeedQualifier, SymName - Arity, Modes0, Modes),
+ id_set_insert(NeedQualifier, mq_id(SymName, Arity), Modes0, Modes),
mq_info_set_modes(Modes, !Info)
).
collect_mq_info_2(module_defn(_, ModuleDefn), !Info) :-
@@ -334,7 +334,7 @@
list.length(Params, Arity),
mq_info_get_classes(!.Info, Classes0),
mq_info_get_need_qual_flag(!.Info, NeedQualifier),
- id_set_insert(NeedQualifier, SymName - Arity,
+ id_set_insert(NeedQualifier, mq_id(SymName, Arity),
Classes0, Classes),
mq_info_set_classes(Classes, !Info)
).
@@ -407,7 +407,7 @@
mq_info_get_modules(!.Info, Modules0),
mq_info_get_need_qual_flag(!.Info, NeedQualifier),
Arity = 0,
- id_set_insert(NeedQualifier, ModuleName - Arity, Modules0, Modules),
+ id_set_insert(NeedQualifier, mq_id(ModuleName, Arity), Modules0, Modules),
mq_info_set_modules(Modules, !Info).
:- pred add_imports(sym_list::in, mq_info::in, mq_info::out) is det.
@@ -632,21 +632,24 @@
type_defn(TVarSet, SymName, Params, TypeDefn, C) - Context,
!Info, yes, !IO) :-
list.length(Params, Arity),
- mq_info_set_error_context(mqec_type(SymName - Arity) - Context, !Info),
+ mq_info_set_error_context(mqec_type(mq_id(SymName, Arity)) - Context,
+ !Info),
qualify_type_defn(TypeDefn0, TypeDefn, !Info, !IO).
module_qualify_item(inst_defn(A, SymName, Params, InstDefn0, C) - Context,
inst_defn(A, SymName, Params, InstDefn, C) - Context,
!Info, yes, !IO) :-
list.length(Params, Arity),
- mq_info_set_error_context(mqec_inst(SymName - Arity) - Context, !Info),
+ mq_info_set_error_context(mqec_inst(mq_id(SymName, Arity)) - Context,
+ !Info),
qualify_inst_defn(InstDefn0, InstDefn, !Info, !IO).
module_qualify_item(mode_defn(A, SymName, Params, ModeDefn0, C) - Context,
mode_defn(A, SymName, Params, ModeDefn, C) - Context,
!Info, yes, !IO) :-
list.length(Params, Arity),
- mq_info_set_error_context(mqec_mode(SymName - Arity) - Context, !Info),
+ mq_info_set_error_context(mqec_mode(mq_id(SymName, Arity)) - Context,
+ !Info),
qualify_mode_defn(ModeDefn0, ModeDefn, !Info, !IO).
module_qualify_item(module_defn(A, ModuleDefn) - Context,
@@ -661,7 +664,7 @@
!Info, yes, !IO) :-
list.length(TypesAndModes0, Arity),
mq_info_set_error_context(
- mqec_pred_or_func(PredOrFunc, SymName - Arity) - Context, !Info),
+ mqec_pred_or_func(PredOrFunc, mq_id(SymName, Arity)) - Context, !Info),
qualify_types_and_modes(TypesAndModes0, TypesAndModes, !Info, !IO),
qualify_prog_constraints(Constraints0, Constraints, !Info, !IO),
map_fold2_maybe(qualify_type, WithType0, WithType, !Info, !IO),
@@ -675,7 +678,8 @@
!Info, yes, !IO) :-
list.length(Modes0, Arity),
mq_info_set_error_context(
- mqec_pred_or_func_mode(PredOrFunc, SymName - Arity) - Context, !Info),
+ mqec_pred_or_func_mode(PredOrFunc, mq_id(SymName, Arity)) - Context,
+ !Info),
qualify_mode_list(Modes0, Modes, !Info, !IO),
map_fold2_maybe(qualify_inst, WithInst0, WithInst, !Info, !IO).
module_qualify_item(Item0, Item, !Info, yes, !IO) :-
@@ -693,7 +697,7 @@
- Context,
!Info, yes, !IO) :-
list.length(Vars, Arity),
- mq_info_set_error_context(mqec_class(Name - Arity) - Context, !Info),
+ mq_info_set_error_context(mqec_class(mq_id(Name, Arity)) - Context, !Info),
qualify_prog_constraint_list(Constraints0, Constraints, !Info, !IO),
(
Interface0 = abstract,
@@ -711,13 +715,13 @@
ModName) - Context,
!Info, yes, !IO) :-
list.length(Types0, Arity),
- Id = Name0 - Arity,
+ Id = mq_id(Name0, Arity),
mq_info_set_error_context(mqec_instance(Id) - Context, !Info),
% We don't qualify the implementation yet, since that requires
% us to resolve overloading.
qualify_prog_constraint_list(Constraints0, Constraints, !Info, !IO),
- qualify_class_name(Id, Name - _, !Info, !IO),
+ qualify_class_name(Id, mq_id(Name, _), !Info, !IO),
qualify_type_list(Types0, Types, !Info, !IO),
qualify_instance_body(Name, Body0, Body).
@@ -871,8 +875,8 @@
qualify_inst_list(Insts0, Insts, !Info, !IO),
list.length(Insts, Arity),
mq_info_get_modes(!.Info, Modes),
- find_unique_match(SymName0 - Arity, SymName - _, Modes, mode_id,
- !Info, !IO).
+ find_unique_match(mq_id(SymName0, Arity), mq_id(SymName, _),
+ Modes, mode_id, !Info, !IO).
:- pred qualify_inst_list(list(mer_inst)::in, list(mer_inst)::out,
mq_info::in, mq_info::out, io::di, io::uo) is det.
@@ -935,7 +939,7 @@
;
list.length(Insts0, Arity),
mq_info_get_insts(!.Info, InstIds),
- find_unique_match(SymName0 - Arity, SymName - _,
+ find_unique_match(mq_id(SymName0, Arity), mq_id(SymName, _),
InstIds, inst_id, !Info, !IO)
).
qualify_inst_name(merge_inst(_, _), _, !Info, !IO) :-
@@ -964,7 +968,7 @@
qualify_bound_inst_list([functor(ConsId, Insts0) | BoundInsts0],
[functor(ConsId, Insts) | BoundInsts], !Info, !IO) :-
( ConsId = cons(Name, Arity) ->
- Id = Name - Arity,
+ Id = item_name(Name, Arity),
update_recompilation_info(
recompilation.record_used_item(functor_item, Id, Id), !Info)
;
@@ -1007,10 +1011,10 @@
qualify_type(defined(SymName0, Args0, Kind), defined(SymName, Args, Kind),
!Info, !IO) :-
Arity = list.length(Args0),
- TypeCtor0 = SymName0 - Arity,
+ TypeCtorId0 = mq_id(SymName0, Arity),
mq_info_get_types(!.Info, Types),
- find_unique_match(TypeCtor0, TypeCtor, Types, type_id, !Info, !IO),
- TypeCtor = SymName - _,
+ find_unique_match(TypeCtorId0, TypeCtorId, Types, type_id, !Info, !IO),
+ TypeCtorId = mq_id(SymName, _),
qualify_type_list(Args0, Args, !Info, !IO).
qualify_type(builtin(BuiltinType), builtin(BuiltinType), !Info, !IO) :-
%
@@ -1152,7 +1156,7 @@
io::di, io::uo) is det.
qualify_prog_constraint_list([], [], !Info, !IO).
-qualify_prog_constraint_list([C0|C0s], [C|Cs], !Info, !IO) :-
+qualify_prog_constraint_list([C0 | C0s], [C | Cs], !Info, !IO) :-
qualify_prog_constraint(C0, C, !Info, !IO),
qualify_prog_constraint_list(C0s, Cs, !Info, !IO).
@@ -1162,20 +1166,19 @@
qualify_prog_constraint(constraint(ClassName0, Types0),
constraint(ClassName, Types), !Info, !IO) :-
list.length(Types0, Arity),
- qualify_class_name(ClassName0 - Arity, ClassName - _, !Info, !IO),
+ qualify_class_name(mq_id(ClassName0, Arity), mq_id(ClassName, _),
+ !Info, !IO),
qualify_type_list(Types0, Types, !Info, !IO).
-:- pred qualify_class_name(pair(class_name, arity)::in,
- pair(class_name, arity)::out, mq_info::in, mq_info::out,
+:- pred qualify_class_name(mq_id::in, mq_id::out, mq_info::in, mq_info::out,
io::di, io::uo) is det.
qualify_class_name(Class0, Class, !Info, !IO) :-
mq_info_get_classes(!.Info, ClassIdSet),
find_unique_match(Class0, Class, ClassIdSet, class_id, !Info, !IO).
-:- pred qualify_class_interface(class_methods::in,
- class_methods::out, mq_info::in, mq_info::out,
- io::di, io::uo) is det.
+:- pred qualify_class_interface(class_methods::in, class_methods::out,
+ mq_info::in, mq_info::out, io::di, io::uo) is det.
qualify_class_interface([], [], !Info, !IO).
qualify_class_interface([M0 | M0s], [M | Ms], !Info, !IO) :-
@@ -1249,28 +1252,26 @@
Module = SymModule
).
- % Find the unique match in the current name space for a given id
+ % Find the unique match in the current name space for a given mq_id
% from a list of ids. If none exists, either because no match
% was found or multiple matches were found, report an error.
% This predicate assumes that type_ids, inst_ids, mode_ids and
% class_ids have the same representation.
%
-:- pred find_unique_match(id::in, id::out, id_set::in, id_type::in,
+:- pred find_unique_match(mq_id::in, mq_id::out, id_set::in, id_type::in,
mq_info::in, mq_info::out, io::di, io::uo) is det.
find_unique_match(Id0, Id, Ids, TypeOfId, !Info, !IO) :-
% Find all IDs which match the current id.
- Id0 = SymName0 - Arity,
+ Id0 = mq_id(SymName0, Arity),
mq_info_get_modules(!.Info, Modules),
- id_set_search_sym_arity(Ids, SymName0, Arity, Modules,
- MatchingModules0),
+ id_set_search_sym_arity(Ids, SymName0, Arity, Modules, MatchingModules0),
( mq_info_get_import_status(!.Info, exported) ->
% Items in the interface may only refer to modules
% imported in the interface.
- mq_info_get_interface_visible_modules(!.Info,
- InterfaceImports),
+ mq_info_get_interface_visible_modules(!.Info, InterfaceImports),
list.filter(set.contains(InterfaceImports),
MatchingModules0, MatchingModules)
;
@@ -1293,11 +1294,13 @@
MatchingModules = [Module],
% A unique match for this ID.
unqualify_name(SymName0, IdName),
- Id = qualified(Module, IdName) - Arity,
+ Id = mq_id(qualified(Module, IdName), Arity),
mq_info_set_module_used(Module, !Info),
ItemType = convert_simple_item_type(TypeOfId),
+ ItemName0 = item_name(SymName0, Arity),
+ ItemName = item_name(qualified(Module, IdName), Arity),
update_recompilation_info(
- recompilation.record_used_item(ItemType, Id0, Id),
+ recompilation.record_used_item(ItemType, ItemName0, ItemName),
!Info)
;
MatchingModules = [_, _ | _],
@@ -1345,30 +1348,31 @@
:- type error_context == pair(mq_error_context, prog_context).
-:- type id == pair(sym_name, int).
+:- type mq_id
+ ---> mq_id(sym_name, int).
:- type mq_error_context
- ---> mqec_type(id)
- ; mqec_inst(id)
- ; mqec_mode(id)
- ; mqec_pred_or_func(pred_or_func, id)
- ; mqec_pred_or_func_mode(maybe(pred_or_func), id)
+ ---> mqec_type(mq_id)
+ ; mqec_inst(mq_id)
+ ; mqec_mode(mq_id)
+ ; mqec_pred_or_func(pred_or_func, mq_id)
+ ; mqec_pred_or_func_mode(maybe(pred_or_func), mq_id)
; mqec_pragma
; mqec_lambda_expr
; mqec_clause_mode_annotation
; mqec_type_qual
- ; mqec_class(id)
- ; mqec_instance(id)
+ ; mqec_class(mq_id)
+ ; mqec_instance(mq_id)
; mqec_mutable(string).
-:- func id_to_sym_name_and_arity(id) = sym_name_and_arity.
+:- func id_to_sym_name_and_arity(mq_id) = sym_name_and_arity.
-id_to_sym_name_and_arity(SymName - Arity) = SymName / Arity.
+id_to_sym_name_and_arity(mq_id(SymName, Arity)) = SymName / Arity.
% Report an undefined type, inst or mode.
%
:- pred report_undefined(list(module_name)::in, mq_info::in,
- id::in, id_type::in, io::di, io::uo) is det.
+ mq_id::in, id_type::in, io::di, io::uo) is det.
report_undefined(MatchingModules, Info, Id, IdType, !IO) :-
mq_info_get_error_context(Info, ErrorContext - Context),
@@ -1384,7 +1388,7 @@
% If it is a qualified symbol, then check whether the module
% specified has been imported.
%
- Id = qualified(ModuleName, _) - _Arity,
+ Id = mq_id(qualified(ModuleName, _), _Arity),
mq_info_get_imported_modules(Info, ImportedModules),
\+ set.member(ModuleName, ImportedModules),
\+ ModuleName = Info ^ this_module
@@ -1399,16 +1403,14 @@
ModuleWord = "module",
HasWord = "has"
;
- MatchingModules1 = [_|_],
+ MatchingModules1 = [_ | _],
ModuleWord = "modules",
HasWord = "have"
),
- MatchingSymNames = list.map(wrap_module_name,
- MatchingModules),
+ MatchingSymNames = list.map(wrap_module_name, MatchingModules),
Pieces2 = [words("(The"), fixed(ModuleWord)] ++
component_list_to_pieces(MatchingSymNames) ++
- [fixed(HasWord),
- words("not been imported in the interface.)")]
+ [fixed(HasWord), words("not been imported in the interface.)")]
;
Pieces2 = []
),
@@ -1417,7 +1419,7 @@
% Report an error where a type, inst, mode or typeclass had
% multiple possible matches.
%
-:- pred report_ambiguous_match(error_context::in, id::in, id_type::in,
+:- pred report_ambiguous_match(error_context::in, mq_id::in, id_type::in,
list(module_name)::in, io::di, io::uo) is det.
report_ambiguous_match(ErrorContext - Context, Id, IdType, Modules, !IO) :-
@@ -1451,14 +1453,15 @@
[words("definition of mode"), wrap_id(Id)].
mq_error_context_to_pieces(mqec_inst(Id)) =
[words("definition of inst"), wrap_id(Id)].
-mq_error_context_to_pieces(mqec_pred_or_func(PredOrFunc, SymName - OrigArity))
- = Pieces :-
+mq_error_context_to_pieces(mqec_pred_or_func(PredOrFunc, Id)) = Pieces :-
+ Id = mq_id(SymName, OrigArity),
adjust_func_arity(PredOrFunc, OrigArity, Arity),
Pieces = [words("definition of "),
fixed(pred_or_func_to_full_str(PredOrFunc)),
sym_name_and_arity(SymName / Arity)].
-mq_error_context_to_pieces(mqec_pred_or_func_mode(MaybePredOrFunc,
- SymName - OrigArity)) = Pieces :-
+mq_error_context_to_pieces(mqec_pred_or_func_mode(MaybePredOrFunc, Id))
+ = Pieces :-
+ Id = mq_id(SymName, OrigArity),
(
MaybePredOrFunc = yes(PredOrFunc),
adjust_func_arity(PredOrFunc, OrigArity, Arity),
@@ -1535,9 +1538,9 @@
wrap_module_name(SymName) = sym_name(SymName).
-:- func wrap_id(id) = format_component.
+:- func wrap_id(mq_id) = format_component.
-wrap_id(Name - Arity) = sym_name_and_arity(Name / Arity).
+wrap_id(mq_id(Name, Arity)) = sym_name_and_arity(Name / Arity).
:- pred is_or_are(list(T)::in, string::out) is det.
@@ -1564,10 +1567,10 @@
%
:- pred is_builtin_atomic_type(type_ctor::in) is semidet.
-is_builtin_atomic_type(unqualified("int") - 0).
-is_builtin_atomic_type(unqualified("float") - 0).
-is_builtin_atomic_type(unqualified("string") - 0).
-is_builtin_atomic_type(unqualified("character") - 0).
+is_builtin_atomic_type(type_ctor(unqualified("int"), 0)).
+is_builtin_atomic_type(type_ctor(unqualified("float"), 0)).
+is_builtin_atomic_type(type_ctor(unqualified("string"), 0)).
+is_builtin_atomic_type(type_ctor(unqualified("character"), 0)).
%-----------------------------------------------------------------------------%
%
@@ -1579,15 +1582,14 @@
init_mq_info(Items, Globals, ReportErrors, ModuleName, Info) :-
term.context_init(Context),
- ErrorContext = mqec_type(unqualified("") - 0) - Context,
+ ErrorContext = mqec_type(mq_id(unqualified(""), 0)) - Context,
set.init(InterfaceModules0),
get_implicit_dependencies(Items, Globals, ImportDeps, UseDeps),
set.list_to_set(ImportDeps `list.append` UseDeps, ImportedModules),
% Ancestor modules are visible without being explicitly imported.
set.insert_list(ImportedModules,
- [ModuleName | get_ancestors(ModuleName)],
- InterfaceVisibleModules),
+ [ModuleName | get_ancestors(ModuleName)], InterfaceVisibleModules),
id_set_init(Empty),
globals.lookup_bool_option(Globals, smart_recompilation,
@@ -1755,15 +1757,15 @@
id_set_init(IdSet) :-
map.init(IdSet).
- % Insert an id into an id_set, aborting with an error if the
- % id is not module qualified.
+ % Insert an mq_id into an id_set, aborting with an error if the
+ % mq_id is not module qualified.
%
-:- pred id_set_insert(need_qualifier::in, id::in, id_set::in, id_set::out)
+:- pred id_set_insert(need_qualifier::in, mq_id::in, id_set::in, id_set::out)
is det.
-id_set_insert(_, unqualified(_) - _, _, _) :-
+id_set_insert(_, mq_id(unqualified(_), _), _, _) :-
unexpected(this_file, "module_qual.id_set_insert - unqualified id").
-id_set_insert(NeedQualifier, qualified(Module, Name) - Arity, !IdSet) :-
+id_set_insert(NeedQualifier, mq_id(qualified(Module, Name), Arity), !IdSet) :-
( map.search(!.IdSet, Name - Arity, ImportModules0 - UseModules0) ->
ImportModules1 = ImportModules0,
UseModules1 = UseModules0
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.387
diff -u -b -r1.387 modules.m
--- compiler/modules.m 10 Apr 2006 07:22:12 -0000 1.387
+++ compiler/modules.m 15 Apr 2006 07:10:53 -0000
@@ -1808,7 +1808,7 @@
is_necessary_impl_type(NecessaryTypeCtors, ItemAndContext) :-
ItemAndContext = Item - _,
( Item = type_defn(_, SymName, Params, _, _) ->
- TypeCtor = SymName - list.length(Params),
+ TypeCtor = type_ctor(SymName, list.length(Params)),
set.member(TypeCtor, NecessaryTypeCtors)
;
true
@@ -1916,10 +1916,8 @@
accumulate_modules(TypeCtor, !Modules) :-
% NOTE: This assumes that everything has been module qualified.
- TypeCtor = SymName - _Arity,
- (
- sym_name_get_module_name(SymName, ModuleName)
- ->
+ TypeCtor = type_ctor(SymName, _Arity),
+ ( sym_name_get_module_name(SymName, ModuleName) ->
svset.insert(ModuleName, !Modules)
;
unexpected(this_file, "accumulate_modules/3: unknown type encountered")
@@ -1933,7 +1931,7 @@
type_to_type_ctor_set(Type, !TypeCtors) :-
( type_to_ctor_and_args(Type, TypeCtor, Args) ->
- TypeCtor = SymName - _Arity,
+ TypeCtor = type_ctor(SymName, _Arity),
(
type_ctor_is_higher_order(TypeCtor, _, _, _)
->
@@ -1981,7 +1979,7 @@
; Item = module_defn(_, implementation) ->
!:InInterface = no
; Item = type_defn(_, Name, Args, Body, _) ->
- TypeCtor = Name - length(Args),
+ TypeCtor = type_ctor(Name, length(Args)),
(
!.InInterface = yes,
!:IntItems = [Item - Context | !.IntItems],
Index: compiler/name_mangle.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/name_mangle.m,v
retrieving revision 1.18
diff -u -b -r1.18 name_mangle.m
--- compiler/name_mangle.m 30 Mar 2006 02:45:58 -0000 1.18
+++ compiler/name_mangle.m 15 Apr 2006 06:30:02 -0000
@@ -138,7 +138,7 @@
TypeName, TypeArity, ModeInt), AddPrefix) = ProcLabelString :-
% Figure out the LabelName.
DummyArity = -1, % not used by make_pred_or_func_name.
- TypeCtor = qualified(TypeModule, TypeName) - TypeArity,
+ TypeCtor = type_ctor(qualified(TypeModule, TypeName), TypeArity),
PredName = special_pred_name(SpecialPredId, TypeCtor),
LabelName = make_pred_or_func_name(unqualified(""), predicate,
unqualified(""), PredName, DummyArity, AddPrefix),
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.166
diff -u -b -r1.166 opt_debug.m
--- compiler/opt_debug.m 30 Mar 2006 02:45:58 -0000 1.166
+++ compiler/opt_debug.m 15 Apr 2006 07:03:16 -0000
@@ -610,7 +610,7 @@
;
ProcLabel = special_proc(Module, SpecialPredId, TypeModule,
TypeName, TypeArity, Mode),
- TypeCtor = qualified(TypeModule, TypeName) - TypeArity,
+ TypeCtor = type_ctor(qualified(TypeModule, TypeName), TypeArity),
Str = sym_name_mangle(Module) ++ "_"
++ special_pred_name(SpecialPredId, TypeCtor) ++ "_"
++ qualify_name(sym_name_mangle(TypeModule), TypeName) ++ "_"
Index: compiler/opt_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/opt_util.m,v
retrieving revision 1.145
diff -u -b -r1.145 opt_util.m
--- compiler/opt_util.m 10 Apr 2006 04:28:21 -0000 1.145
+++ compiler/opt_util.m 15 Apr 2006 07:03:27 -0000
@@ -1474,7 +1474,7 @@
TypeName, TypeArity, Mode)) =
PredName ++ "_" ++ TypeName ++ "/" ++ int_to_string(TypeArity)
++ " mode " ++ int_to_string(Mode) :-
- TypeCtor = qualified(TypeModule, TypeName) - TypeArity,
+ TypeCtor = type_ctor(qualified(TypeModule, TypeName), TypeArity),
PredName = special_pred_name(SpecialPredId, TypeCtor).
has_both_incr_decr_sp(Instrs) :-
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.296
diff -u -b -r1.296 polymorphism.m
--- compiler/polymorphism.m 29 Mar 2006 08:07:14 -0000 1.296
+++ compiler/polymorphism.m 15 Apr 2006 06:36:25 -0000
@@ -2727,7 +2727,7 @@
TypeCtorInfoGoal, ModuleInfo, !VarSet, !VarTypes, !RttiVarMaps) :-
type_util.type_ctor_module(ModuleInfo, TypeCtor, ModuleName),
type_util.type_ctor_name(ModuleInfo, TypeCtor, TypeName),
- TypeCtor = _ - Arity,
+ TypeCtor = type_ctor(_, Arity),
ConsId = type_ctor_info_const(ModuleName, TypeName, Arity),
TypeInfoTerm = functor(ConsId, no, []),
@@ -2999,13 +2999,14 @@
%---------------------------------------------------------------------------%
type_is_typeclass_info(TypeClassInfoType) :-
- PrivateBuiltin = mercury_private_builtin_module,
- type_to_ctor_and_args(TypeClassInfoType,
- qualified(PrivateBuiltin, "typeclass_info") - 0, [_ConstraintTerm]).
+ type_to_ctor_and_args(TypeClassInfoType, TypeCtor, [_ConstraintTerm]),
+ TypeCtor = type_ctor(qualified(ModuleName, "typeclass_info"), 0),
+ ModuleName = mercury_private_builtin_module.
type_is_type_info_or_ctor_type(TypeInfoType) :-
- type_to_ctor_and_args(TypeInfoType,
- qualified(mercury_private_builtin_module, TypeName) - 0, []),
+ type_to_ctor_and_args(TypeInfoType, TypeCtor, []),
+ TypeCtor = type_ctor(qualified(ModuleName, TypeName), 0),
+ ModuleName = mercury_private_builtin_module,
( TypeName = "type_info"
; TypeName = "type_ctor_info"
).
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.100
diff -u -b -r1.100 post_typecheck.m
--- compiler/post_typecheck.m 31 Mar 2006 03:32:11 -0000 1.100
+++ compiler/post_typecheck.m 15 Apr 2006 06:36:57 -0000
@@ -878,7 +878,7 @@
(
ConsId0 = cons(Name0, Arity),
type_to_ctor_and_args(TypeOfX, TypeCtorOfX, _),
- TypeCtorOfX = qualified(TypeModule, _) - _
+ TypeCtorOfX = type_ctor(qualified(TypeModule, _), _)
->
unqualify_name(Name0, Name),
ConsId = cons(qualified(TypeModule, Name), Arity)
@@ -1321,7 +1321,7 @@
% definitions in any of the builtin modules in the
% standard library.
- TypeCtor = SymName - Arity,
+ TypeCtor = type_ctor(SymName, Arity),
BuiltinTypeCtors = builtin_type_ctors_with_no_hlds_type_defn,
(
sym_name_get_module_name(SymName, ModuleName),
Index: compiler/proc_label.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/proc_label.m,v
retrieving revision 1.18
diff -u -b -r1.18 proc_label.m
--- compiler/proc_label.m 29 Mar 2006 08:07:15 -0000 1.18
+++ compiler/proc_label.m 15 Apr 2006 07:28:44 -0000
@@ -77,15 +77,15 @@
(
% All type_ctors other than tuples here should be module qualified,
% since builtin types are handled separately in polymorphism.m.
+ TypeCtor = type_ctor(TypeCtorSymName, TypeArity),
(
- TypeCtor = unqualified(TypeName) - _,
+ TypeCtorSymName = unqualified(TypeName),
type_ctor_is_tuple(TypeCtor),
mercury_public_builtin_module(TypeModule)
;
- TypeCtor = qualified(TypeModule, TypeName) - _
+ TypeCtorSymName = qualified(TypeModule, TypeName)
)
->
- TypeCtor = _ - TypeArity,
(
ThisModule \= TypeModule,
SpecialPred = spec_pred_unify,
@@ -131,7 +131,7 @@
make_uni_label(ModuleInfo, TypeCtor, UniModeNum) = ProcLabel :-
module_info_get_name(ModuleInfo, ModuleName),
- ( TypeCtor = qualified(TypeModule, TypeName) - Arity ->
+ ( TypeCtor = type_ctor(qualified(TypeModule, TypeName), Arity) ->
( hlds_pred.in_in_unification_proc_id(UniModeNum) ->
Module = TypeModule
;
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.158
diff -u -b -r1.158 prog_data.m
--- compiler/prog_data.m 29 Mar 2006 08:07:16 -0000 1.158
+++ compiler/prog_data.m 15 Apr 2006 08:01:17 -0000
@@ -1008,7 +1008,9 @@
:- type type_term == term(tvar_type).
-:- type tvar_type ---> type_var.
+:- type tvar_type
+ ---> type_var.
+
:- type tvar == var(tvar_type).
% used for type variables
:- type tvarset == varset(tvar_type).
@@ -1016,7 +1018,8 @@
:- type tsubst == map(tvar, mer_type). % used for type substitutions
:- type tvar_renaming == map(tvar, tvar). % type renaming
-:- type type_ctor == pair(sym_name, arity).
+:- type type_ctor
+ ---> type_ctor(sym_name, arity).
:- type tvar_name_map == map(string, tvar).
@@ -1163,11 +1166,15 @@
% function.
).
-:- type inst_id == pair(sym_name, arity).
+:- type inst_id
+ ---> inst_id(sym_name, arity).
+
+:- type bound_inst
+ ---> functor(cons_id, list(mer_inst)).
-:- type bound_inst ---> functor(cons_id, list(mer_inst)).
+:- type inst_var_type
+ ---> inst_var_type.
-:- type inst_var_type ---> inst_var_type.
:- type inst_var == var(inst_var_type).
:- type inst_term == term(inst_var_type).
:- type inst_varset == varset(inst_var_type).
@@ -1239,7 +1246,8 @@
---> real_unify
; fake_unify.
-:- type mode_id == pair(sym_name, arity).
+:- type mode_id
+ ---> mode_id(sym_name, arity).
:- type mode_defn
---> eqv_mode(mer_mode).
@@ -1333,7 +1341,8 @@
:- type sym_name_and_arity
---> sym_name / arity.
-:- type simple_call_id == pair(pred_or_func, sym_name_and_arity).
+:- type simple_call_id
+ ---> simple_call_id(pred_or_func, sym_name, arity).
:- type module_specifier == sym_name.
:- type arity == int.
Index: compiler/prog_mode.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_mode.m,v
retrieving revision 1.14
diff -u -b -r1.14 prog_mode.m
--- compiler/prog_mode.m 29 Mar 2006 08:07:18 -0000 1.14
+++ compiler/prog_mode.m 15 Apr 2006 09:10:05 -0000
@@ -526,7 +526,7 @@
).
% In case we later decided to change the representation of mode_ids.
-mode_id_to_int(_ - X, X).
+mode_id_to_int(mode_id(_, X), X).
%-----------------------------------------------------------------------------%
Index: compiler/prog_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_out.m,v
retrieving revision 1.70
diff -u -b -r1.70 prog_out.m
--- compiler/prog_out.m 29 Mar 2006 08:07:18 -0000 1.70
+++ compiler/prog_out.m 15 Apr 2006 09:12:41 -0000
@@ -280,7 +280,7 @@
sym_name_and_arity_to_string(SymName/Arity) = String :-
sym_name_and_arity_to_string(SymName/Arity, String).
-write_simple_call_id(PredOrFunc - Name/Arity, !IO) :-
+write_simple_call_id(simple_call_id(PredOrFunc, Name, Arity), !IO) :-
Str = simple_call_id_to_string(PredOrFunc, Name, Arity),
io.write_string(Str, !IO).
@@ -292,7 +292,7 @@
Str = simple_call_id_to_string(PredOrFunc, Name, Arity),
io.write_string(Str, !IO).
-simple_call_id_to_string(PredOrFunc - Name/Arity) =
+simple_call_id_to_string(simple_call_id(PredOrFunc, Name, Arity)) =
simple_call_id_to_string(PredOrFunc, Name, Arity).
simple_call_id_to_string(PredOrFunc, Name/Arity) =
@@ -327,14 +327,14 @@
;
MaybePromise = no,
PredOrFuncStr = pred_or_func_to_full_str(PredOrFunc),
- simple_call_id_to_sym_name_and_arity(PredOrFunc - Name/Arity,
- SymArity),
+ SimpleCallId = simple_call_id(PredOrFunc, Name, Arity),
+ simple_call_id_to_sym_name_and_arity(SimpleCallId, SymArity),
SymArityStr = sym_name_and_arity_to_string(SymArity),
Str = PredOrFuncStr ++ " `" ++ SymArityStr ++ "'"
).
-simple_call_id_to_sym_name_and_arity(PredOrFunc - SymName/Arity,
- SymName/OrigArity) :-
+simple_call_id_to_sym_name_and_arity(SimpleCallId, SymName / OrigArity) :-
+ SimpleCallId = simple_call_id(PredOrFunc, SymName, Arity),
adjust_func_arity(PredOrFunc, OrigArity, Arity).
write_module_spec(ModuleSpec, !IO) :-
Index: compiler/prog_type.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_type.m,v
retrieving revision 1.21
diff -u -b -r1.21 prog_type.m
--- compiler/prog_type.m 29 Mar 2006 08:07:18 -0000 1.21
+++ compiler/prog_type.m 15 Apr 2006 11:33:17 -0000
@@ -464,22 +464,29 @@
( type_is_higher_order(Type, _Purity, PredOrFunc, _, TypeArgs0) ->
TypeArgs = TypeArgs0,
PredOrFuncStr = prog_out.pred_or_func_to_str(PredOrFunc),
- TypeCtor = unqualified(PredOrFuncStr) - 0
+ TypeCtor = type_ctor(unqualified(PredOrFuncStr), 0)
; type_is_tuple(Type, TypeArgs1) ->
TypeArgs = TypeArgs1,
% XXX why tuple/0 and not {}/N ?
- TypeCtor = unqualified("tuple") - 0
+ TypeCtor = type_ctor(unqualified("tuple"), 0)
;
fail
).
-type_to_ctor_and_args(defined(SymName, Args, _), SymName - Arity, Args) :-
- Arity = list.length(Args).
-type_to_ctor_and_args(builtin(BuiltinType), SymName - 0, []) :-
+type_to_ctor_and_args(Type, TypeCtor, Args) :-
+ (
+ Type = defined(SymName, Args, _),
+ Arity = list.length(Args),
+ TypeCtor = type_ctor(SymName, Arity)
+ ;
+ Type = builtin(BuiltinType),
builtin_type_to_string(BuiltinType, Name),
- SymName = unqualified(Name).
-type_to_ctor_and_args(higher_order(Args0, MaybeRet, Purity, _EvalMethod),
- SymName - Arity, Args) :-
+ SymName = unqualified(Name),
+ Arity = 0,
+ Args = [],
+ TypeCtor = type_ctor(SymName, Arity)
+ ;
+ Type = higher_order(Args0, MaybeRet, Purity, _EvalMethod),
Arity = list.length(Args0),
(
MaybeRet = yes(Ret),
@@ -500,15 +507,23 @@
;
Purity = purity_impure,
insert_module_qualifier("impure", SymName0, SymName)
+ ),
+ TypeCtor = type_ctor(SymName, Arity)
+ ;
+ Type = tuple(Args, _),
+ SymName = unqualified("{}"),
+ Arity = list.length(Args),
+ TypeCtor = type_ctor(SymName, Arity)
+ ;
+ Type = apply_n(_, _, _),
+ sorry(this_file, "apply/N types")
+ ;
+ Type = kinded(SubType, _),
+ type_to_ctor_and_args(SubType, TypeCtor, Args)
).
-type_to_ctor_and_args(tuple(Args, _), unqualified("{}") - Arity, Args) :-
- Arity = list.length(Args).
-type_to_ctor_and_args(apply_n(_, _, _), _, _) :-
- sorry(this_file, "apply/N types").
-type_to_ctor_and_args(kinded(Type, _), TypeCtor, Args) :-
- type_to_ctor_and_args(Type, TypeCtor, Args).
-type_ctor_is_higher_order(SymName - _Arity, Purity, PredOrFunc, EvalMethod) :-
+type_ctor_is_higher_order(TypeCtor, Purity, PredOrFunc, EvalMethod) :-
+ TypeCtor = type_ctor(SymName, _Arity),
get_purity_and_eval_method(SymName, Purity, EvalMethod, PorFStr),
(
PorFStr = "pred",
@@ -539,7 +554,7 @@
Purity = purity_pure
).
-type_ctor_is_tuple(unqualified("{}") - _).
+type_ctor_is_tuple(type_ctor(unqualified("{}"), _)).
type_list_to_var_list([], []).
type_list_to_var_list([Type | Types], [Var | Vars]) :-
@@ -614,7 +629,7 @@
construct_type(TypeCtor, Args, Type) :-
(
- TypeCtor = unqualified(Name) - 0,
+ TypeCtor = type_ctor(unqualified(Name), 0),
builtin_type_to_string(BuiltinType, Name)
->
Type = builtin(BuiltinType)
@@ -628,7 +643,7 @@
% XXX kind inference: we assume the kind is star.
Type = tuple(Args, star)
;
- TypeCtor = SymName - _,
+ TypeCtor = type_ctor(SymName, _),
% XXX kind inference: we assume the kind is star.
Type = defined(SymName, Args, star)
).
@@ -709,14 +724,14 @@
%-----------------------------------------------------------------------------%
builtin_type_ctors_with_no_hlds_type_defn =
- [ qualified(mercury_public_builtin_module, "int") - 0,
- qualified(mercury_public_builtin_module, "string") - 0,
- qualified(mercury_public_builtin_module, "character") - 0,
- qualified(mercury_public_builtin_module, "float") - 0,
- qualified(mercury_public_builtin_module, "pred") - 0,
- qualified(mercury_public_builtin_module, "func") - 0,
- qualified(mercury_public_builtin_module, "void") - 0,
- qualified(mercury_public_builtin_module, "tuple") - 0
+ [ type_ctor(qualified(mercury_public_builtin_module, "int"), 0),
+ type_ctor(qualified(mercury_public_builtin_module, "string"), 0),
+ type_ctor(qualified(mercury_public_builtin_module, "character"), 0),
+ type_ctor(qualified(mercury_public_builtin_module, "float"), 0),
+ type_ctor(qualified(mercury_public_builtin_module, "pred"), 0),
+ type_ctor(qualified(mercury_public_builtin_module, "func"), 0),
+ type_ctor(qualified(mercury_public_builtin_module, "void"), 0),
+ type_ctor(qualified(mercury_public_builtin_module, "tuple"), 0)
].
is_builtin_dummy_argument_type("io", "state", 0). % io.state/0
@@ -728,16 +743,16 @@
type_is_io_state(Type) :-
type_to_ctor_and_args(Type, TypeCtor, []),
mercury_std_lib_module_name("io", ModuleName),
- TypeCtor = qualified(ModuleName, "state") - 0.
+ TypeCtor = type_ctor(qualified(ModuleName, "state"), 0).
-type_ctor_is_array(qualified(unqualified("array"), "array") - 1).
+type_ctor_is_array(type_ctor(qualified(unqualified("array"), "array"), 1)).
is_introduced_type_info_type(Type) :-
type_to_ctor_and_args(Type, TypeCtor, _),
is_introduced_type_info_type_ctor(TypeCtor).
is_introduced_type_info_type_ctor(TypeCtor) :-
- TypeCtor = qualified(PrivateBuiltin, Name) - 0,
+ TypeCtor = type_ctor(qualified(PrivateBuiltin, Name), 0),
mercury_private_builtin_module(PrivateBuiltin),
( Name = "type_info"
; Name = "type_ctor_info"
@@ -826,7 +841,7 @@
% use of integers/floats/strings as type names should
% be rejected by the parser in prog_io.m, not in module_qual.m.
-make_type_ctor(term.atom(Name), Arity, unqualified(Name) - Arity).
+make_type_ctor(term.atom(Name), Arity, type_ctor(unqualified(Name), Arity)).
%-----------------------------------------------------------------------------%
@@ -852,7 +867,7 @@
(
ConsId0 = cons(Name0, OrigArity),
type_to_ctor_and_args(Type, TypeCtor, _),
- TypeCtor = qualified(TypeModule, _) - _
+ TypeCtor = type_ctor(qualified(TypeModule, _), _)
->
unqualify_name(Name0, UnqualName),
Name = qualified(TypeModule, UnqualName),
@@ -950,7 +965,7 @@
is_dummy_argument_type_with_constructors(TypeCtor, Ctors, UserEqCmp) :-
% Keep this in sync with is_dummy_argument_type below.
(
- TypeCtor = CtorSymName - TypeArity,
+ TypeCtor = type_ctor(CtorSymName, TypeArity),
CtorSymName = qualified(unqualified(ModuleName), TypeName),
is_builtin_dummy_argument_type(ModuleName, TypeName, TypeArity)
;
Index: compiler/prog_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_util.m,v
retrieving revision 1.86
diff -u -b -r1.86 prog_util.m
--- compiler/prog_util.m 29 Mar 2006 08:07:19 -0000 1.86
+++ compiler/prog_util.m 15 Apr 2006 07:17:33 -0000
@@ -628,10 +628,10 @@
;
SymName0 = unqualified(ConsName),
(
- TypeCtor = unqualified(_) - _,
+ TypeCtor = type_ctor(unqualified(_), _),
SymName = SymName0
;
- TypeCtor = qualified(TypeModule, _) - _,
+ TypeCtor = type_ctor(qualified(TypeModule, _), _),
SymName = qualified(TypeModule, ConsName)
)
),
Index: compiler/pseudo_type_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pseudo_type_info.m,v
retrieving revision 1.23
diff -u -b -r1.23 pseudo_type_info.m
--- compiler/pseudo_type_info.m 29 Mar 2006 08:07:19 -0000 1.23
+++ compiler/pseudo_type_info.m 15 Apr 2006 06:31:49 -0000
@@ -89,14 +89,14 @@
construct_pseudo_type_info(Type, NumUnivQTvars, ExistQTvars, PseudoTypeInfo) :-
( type_to_ctor_and_args(Type, TypeCtor, TypeArgs) ->
( type_is_var_arity(Type, VarArityId) ->
- TypeCtor = _QualTypeName - RealArity,
+ TypeCtor = type_ctor(_QualTypeName, RealArity),
generate_pseudo_args(TypeArgs, NumUnivQTvars, ExistQTvars,
PseudoArgs),
expect(check_var_arity(VarArityId, PseudoArgs, RealArity),
this_file, "construct_pseudo_type_info: var arity mismatch"),
PseudoTypeInfo = var_arity_pseudo_type_info(VarArityId, PseudoArgs)
;
- TypeCtor = QualTypeName - Arity,
+ TypeCtor = type_ctor(QualTypeName, Arity),
unqualify_name(QualTypeName, TypeName),
sym_name_get_module_name(QualTypeName, unqualified("builtin"),
TypeModule),
@@ -156,13 +156,13 @@
construct_type_info(Type, TypeInfo) :-
( type_to_ctor_and_args(Type, TypeCtor, TypeArgs) ->
( type_is_var_arity(Type, VarArityId) ->
- TypeCtor = _QualTypeName - RealArity,
+ TypeCtor = type_ctor(_QualTypeName, RealArity),
generate_plain_args(TypeArgs, TypeInfoArgs),
expect(check_var_arity(VarArityId, TypeInfoArgs, RealArity),
this_file, "construct_type_info: arity mismatch"),
TypeInfo = var_arity_type_info(VarArityId, TypeInfoArgs)
;
- TypeCtor = QualTypeName - Arity,
+ TypeCtor = type_ctor(QualTypeName, Arity),
unqualify_name(QualTypeName, TypeName),
sym_name_get_module_name(QualTypeName, unqualified("builtin"),
TypeModule),
Index: compiler/qual_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/qual_info.m,v
retrieving revision 1.12
diff -u -b -r1.12 qual_info.m
--- compiler/qual_info.m 29 Mar 2006 08:07:19 -0000 1.12
+++ compiler/qual_info.m 15 Apr 2006 09:09:01 -0000
@@ -259,7 +259,7 @@
MainContext, SubContext, Purity, Goal).
record_called_pred_or_func(PredOrFunc, SymName, Arity, !QualInfo) :-
- Id = SymName - Arity,
+ Id = item_name(SymName, Arity),
apply_to_recompilation_info(recompilation.record_used_item(
pred_or_func_to_item_type(PredOrFunc), Id, Id), !QualInfo).
@@ -267,7 +267,7 @@
record_used_functor(ConsId, !QualInfo) :-
( ConsId = cons(SymName, Arity) ->
- Id = SymName - Arity,
+ Id = item_name(SymName, Arity),
apply_to_recompilation_info(record_used_item(functor_item, Id, Id),
!QualInfo)
;
Index: compiler/recompilation.check.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/recompilation.check.m,v
retrieving revision 1.28
diff -u -b -r1.28 recompilation.check.m
--- compiler/recompilation.check.m 29 Mar 2006 08:07:20 -0000 1.28
+++ compiler/recompilation.check.m 15 Apr 2006 10:05:08 -0000
@@ -335,12 +335,11 @@
record_recompilation_reason(Reason, !Info)
).
-:- pred parse_name_and_arity_to_used(term::in, pair(sym_name, arity)::out)
- is semidet.
+:- pred parse_name_and_arity_to_used(term::in, item_name::out) is semidet.
parse_name_and_arity_to_used(Term, UsedClass) :-
parse_name_and_arity(Term, ClassName, ClassArity),
- UsedClass = ClassName - ClassArity.
+ UsedClass = item_name(ClassName, ClassArity).
%-----------------------------------------------------------------------------%
@@ -537,14 +536,15 @@
Term = term.functor(term.atom("ctor"), [NameArityTerm], _),
parse_name_and_arity(NameArityTerm, TypeName, TypeArity)
->
- Ctor = constructor(TypeName - TypeArity)
+ Ctor = constructor(item_name(TypeName, TypeArity))
;
Term = term.functor(term.atom("field"),
[TypeNameArityTerm, ConsNameArityTerm], _),
parse_name_and_arity(TypeNameArityTerm, TypeName, TypeArity),
parse_name_and_arity(ConsNameArityTerm, ConsName, ConsArity)
->
- Ctor = field(TypeName - TypeArity, ConsName - ConsArity)
+ Ctor = field(item_name(TypeName, TypeArity),
+ item_name(ConsName, ConsArity))
;
Reason = syntax_error(get_term_context(Term),
"error in functor match"),
@@ -552,8 +552,8 @@
).
:- type parse_resolved_item_matches(T) ==
- pred(recompilation_check_info, term, resolved_item_map(T),
- resolved_item_map(T)).
+ pred(recompilation_check_info, term,
+ resolved_item_map(T), resolved_item_map(T)).
:- inst parse_resolved_item_matches == (pred(in, in, in, out) is det).
:- pred parse_resolved_item_set(recompilation_check_info::in,
@@ -763,7 +763,7 @@
:- func make_item_id(module_name, item_type, pair(string, arity)) = item_id.
make_item_id(Module, ItemType, Name - Arity) =
- item_id(ItemType, qualified(Module, Name) - Arity).
+ item_id(ItemType, item_name(qualified(Module, Name), Arity)).
%-----------------------------------------------------------------------------%
@@ -845,7 +845,7 @@
(
NeedsCheck = yes,
check_type_defn_ambiguity_with_functor(NeedQualifier,
- Name - Arity, Body, !Info)
+ type_ctor(Name, Arity), Body, !Info)
;
NeedsCheck = no
).
@@ -969,8 +969,8 @@
\+ SymName = qualified(OldMatchingModuleName, _)
->
OldMatchingName = qualified(OldMatchingModuleName, Name),
- Reason = item_ambiguity(item_id(ItemType, SymName - Arity),
- [item_id(ItemType, OldMatchingName - Arity)]),
+ Reason = item_ambiguity(item_id(ItemType, item_name(SymName, Arity)),
+ [item_id(ItemType, item_name(OldMatchingName, Arity))]),
record_recompilation_reason(Reason, !Info)
;
true
@@ -1081,10 +1081,10 @@
AmbiguousDecls = list.map(
(func(_ - OldMatchingModule) = Item :-
OldMatchingName = qualified(OldMatchingModule, Name),
- Item = item_id(ItemType, OldMatchingName - Arity)
+ Item = item_id(ItemType, item_name(OldMatchingName, Arity))
),
set.to_sorted_list(OldMatchingModuleNames)),
- Reason = item_ambiguity(item_id(ItemType, SymName - Arity),
+ Reason = item_ambiguity(item_id(ItemType, item_name(SymName, Arity)),
AmbiguousDecls),
record_recompilation_reason(Reason, !Info)
;
@@ -1112,14 +1112,15 @@
constructor::in,
recompilation_check_info::in, recompilation_check_info::out) is det.
-check_functor_ambiguities(NeedQualifier, TypeCtor,
- ctor(_, _, Name, Args), !Info) :-
- ResolvedCtor = constructor(TypeCtor),
+check_functor_ambiguities(NeedQualifier, TypeCtor, ctor(_, _, Name, Args),
+ !Info) :-
+ TypeCtorItem = type_ctor_to_item_name(TypeCtor),
+ ResolvedCtor = constructor(TypeCtorItem),
Arity = list.length(Args),
check_functor_ambiguities(NeedQualifier, Name, exact(Arity),
ResolvedCtor, !Info),
list.foldl(check_field_ambiguities(NeedQualifier,
- field(TypeCtor, Name - Arity)), Args, !Info).
+ field(TypeCtorItem, item_name(Name, Arity))), Args, !Info).
:- pred check_field_ambiguities(need_qualifier::in, resolved_functor::in,
constructor_arg::in,
@@ -1385,7 +1386,8 @@
recompile_reason_message(removed_item(Item), no,
list.append(describe_item(Item), [words("was removed.")])).
recompile_reason_message(
- changed_or_added_instance(ModuleName, ClassName - ClassArity),
+ changed_or_added_instance(ModuleName,
+ item_name(ClassName, ClassArity)),
no,
[
words("an instance for class"),
@@ -1394,7 +1396,8 @@
words(describe_sym_name(ModuleName)),
words("was added or modified.")
]).
-recompile_reason_message(removed_instance(ModuleName, ClassName - ClassArity),
+recompile_reason_message(
+ removed_instance(ModuleName, item_name(ClassName, ClassArity)),
no,
[
words("an instance for class "),
@@ -1406,7 +1409,7 @@
:- func describe_item(item_id) = list(format_component).
-describe_item(item_id(ItemType0, SymName - Arity)) = Pieces :-
+describe_item(item_id(ItemType0, item_name(SymName, Arity))) = Pieces :-
( body_item(ItemType0, ItemType1) ->
ItemType = ItemType1,
BodyWords = "body of "
@@ -1427,28 +1430,31 @@
:- func describe_functor(sym_name, arity, resolved_functor) =
list(format_component).
-describe_functor(SymName, _Arity,
- pred_or_func(_, ModuleName, PredOrFunc, PredArity)) =
- [words(ItemTypeStr), SymNameAndArityPiece] :-
- string_to_item_type(ItemTypeStr,
- pred_or_func_to_item_type(PredOrFunc)),
+describe_functor(SymName, _Arity, ResolvedFunctor) = Pieces :-
+ ResolvedFunctor = pred_or_func(_, ModuleName, PredOrFunc, PredArity),
+ string_to_item_type(ItemTypeStr, pred_or_func_to_item_type(PredOrFunc)),
unqualify_name(SymName, UnqualName),
- SymNameAndArityPiece = words(describe_sym_name_and_arity(
- qualified(ModuleName, UnqualName) / PredArity)).
-describe_functor(SymName, Arity, constructor(TypeName - TypeArity)) =
- [words("constructor"),
- words(describe_sym_name_and_arity(SymName / Arity)),
+ SymNameAndArityPiece =
+ sym_name_and_arity(qualified(ModuleName, UnqualName) / PredArity),
+ Pieces = [words(ItemTypeStr), SymNameAndArityPiece].
+describe_functor(SymName, Arity, ResolvedFunctor) = Pieces :-
+ ResolvedFunctor = constructor(item_name(TypeName, TypeArity)),
+ Pieces = [
+ words("constructor"),
+ sym_name_and_arity(SymName / Arity),
words("of type"),
- words(describe_sym_name_and_arity(TypeName / TypeArity))
+ sym_name_and_arity(TypeName / TypeArity)
].
-describe_functor(SymName, Arity,
- field(TypeName - TypeArity, ConsName - ConsArity)) =
- [words("field access function"),
- words(describe_sym_name_and_arity(SymName / Arity)),
+describe_functor(SymName, Arity, ResolvedFunctor) = Pieces :-
+ ResolvedFunctor = field(item_name(TypeName, TypeArity),
+ item_name(ConsName, ConsArity)),
+ Pieces = [
+ words("field access function"),
+ sym_name_and_arity(SymName / Arity),
words("for constructor"),
- words(describe_sym_name_and_arity(ConsName / ConsArity)),
+ sym_name_and_arity(ConsName / ConsArity),
words("of type"),
- words(describe_sym_name_and_arity(TypeName / TypeArity))
+ sym_name_and_arity(TypeName / TypeArity)
].
%-----------------------------------------------------------------------------%
Index: compiler/recompilation.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/recompilation.m,v
retrieving revision 1.21
diff -u -b -r1.21 recompilation.m
--- compiler/recompilation.m 29 Mar 2006 08:07:20 -0000 1.21
+++ compiler/recompilation.m 15 Apr 2006 11:35:27 -0000
@@ -62,7 +62,8 @@
:- type item_id
---> item_id(item_type, item_name).
-:- type item_name == pair(sym_name, arity).
+:- type item_name
+ ---> item_name(sym_name, arity).
:- type item_type
---> type_item % Just the name of the type, not its body.
@@ -104,6 +105,14 @@
:- func pred_or_func_to_item_type(pred_or_func::in)
= (item_type::out(pred_or_func)) is det.
+:- func type_ctor_to_item_name(type_ctor) = item_name.
+:- func inst_id_to_item_name(inst_id) = item_name.
+:- func mode_id_to_item_name(mode_id) = item_name.
+
+:- func item_name_to_type_ctor(item_name) = type_ctor.
+:- func item_name_to_inst_id(item_name) = inst_id.
+:- func item_name_to_mode_id(item_name) = mode_id.
+
%-----------------------------------------------------------------------------%
:- type recompilation_info
@@ -299,6 +308,14 @@
string_to_item_type("functor", functor_item).
string_to_item_type("mutable", mutable_item).
+type_ctor_to_item_name(type_ctor(SymName, Arity)) = item_name(SymName, Arity).
+inst_id_to_item_name(inst_id(SymName, Arity)) = item_name(SymName, Arity).
+mode_id_to_item_name(mode_id(SymName, Arity)) = item_name(SymName, Arity).
+
+item_name_to_type_ctor(item_name(SymName, Arity)) = type_ctor(SymName, Arity).
+item_name_to_inst_id(item_name(SymName, Arity)) = inst_id(SymName, Arity).
+item_name_to_mode_id(item_name(SymName, Arity)) = mode_id(SymName, Arity).
+
%-----------------------------------------------------------------------------%
init_item_id_set(Init) =
@@ -387,6 +404,7 @@
).
record_used_item(ItemType, Id, QualifiedId, !Info) :-
+ QualifiedId = item_name(QualifiedName, Arity),
(
% Don't record builtin items (QualifiedId may be unqualified
% for predicates, functions and functors because they aren't
@@ -394,17 +412,16 @@
ItemType \= predicate_item,
ItemType \= function_item,
ItemType \= functor_item,
- QualifiedId = unqualified(_) - _
+ QualifiedName = unqualified(_)
->
true
;
ItemSet0 = !.Info ^ used_items,
IdSet0 = extract_ids(ItemSet0, ItemType),
- QualifiedId = QualifiedName - Arity,
unqualify_name(QualifiedName, UnqualifiedName),
ModuleName = find_module_qualifier(QualifiedName),
UnqualifiedId = UnqualifiedName - Arity,
- Id = SymName - _,
+ Id = item_name(SymName, _),
ModuleQualifier = find_module_qualifier(SymName),
( map.search(IdSet0, UnqualifiedId, MatchingNames0) ->
MatchingNames1 = MatchingNames0
Index: compiler/recompilation.usage.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/recompilation.usage.m,v
retrieving revision 1.33
diff -u -b -r1.33 recompilation.usage.m
--- compiler/recompilation.usage.m 29 Mar 2006 08:07:20 -0000 1.33
+++ compiler/recompilation.usage.m 15 Apr 2006 10:14:03 -0000
@@ -283,10 +283,9 @@
io.write_string(".\n", !IO)
).
-:- pred write_classname_and_arity(pair(class_name, arity)::in,
- io::di, io::uo) is det.
+:- pred write_classname_and_arity(item_name::in, io::di, io::uo) is det.
-write_classname_and_arity(ClassName - ClassArity, !IO) :-
+write_classname_and_arity(item_name(ClassName, ClassArity), !IO) :-
mercury_output_bracketed_sym_name(ClassName, !IO),
io.write_string("/", !IO),
io.write_int(ClassArity, !IO).
@@ -457,14 +456,14 @@
io.write_string(", ", !IO),
io.write_int(Arity, !IO),
io.write_string(")", !IO).
-write_resolved_functor(constructor(TypeName - Arity), !IO) :-
+write_resolved_functor(constructor(item_name(TypeName, Arity)), !IO) :-
io.write_string("ctor(", !IO),
mercury_output_bracketed_sym_name(TypeName, next_to_graphic_token, !IO),
io.write_string("/", !IO),
io.write_int(Arity, !IO),
io.write_string(")", !IO).
-write_resolved_functor(field(TypeName - TypeArity, ConsName - ConsArity),
- !IO) :-
+write_resolved_functor(field(item_name(TypeName, TypeArity),
+ item_name(ConsName, ConsArity)), !IO) :-
io.write_string("field(", !IO),
mercury_output_bracketed_sym_name(TypeName, next_to_graphic_token, !IO),
io.write_string("/", !IO),
@@ -635,15 +634,14 @@
%-----------------------------------------------------------------------------%
-:- pred record_used_pred_or_func(pred_or_func::in,
- pair(sym_name, arity)::in,
+:- pred record_used_pred_or_func(pred_or_func::in, item_name::in,
recompilation_usage_info::in, recompilation_usage_info::out) is det.
record_used_pred_or_func(PredOrFunc, Id, !Info) :-
ItemType = pred_or_func_to_item_type(PredOrFunc),
ItemSet0 = !.Info ^ used_items,
IdSet0 = extract_pred_or_func_set(ItemSet0, ItemType),
- Id = SymName - Arity,
+ Id = item_name(SymName, Arity),
record_resolved_item(SymName, Arity,
do_record_used_pred_or_func(PredOrFunc),
IdSet0, IdSet, !Info),
@@ -736,7 +734,7 @@
list.map(
(func(ConsDefn) = Ctor :-
ConsDefn = hlds_cons_defn(_,_,_, TypeCtor, _),
- Ctor = constructor(TypeCtor)
+ Ctor = constructor(type_ctor_to_item_name(TypeCtor))
),
ConsDefns),
@@ -747,8 +745,7 @@
may_be_partially_qualified, SymName, PredIds)
->
MatchingPreds = list.filter_map(
- get_pred_or_func_ctors(ModuleInfo,
- SymName, Arity),
+ get_pred_or_func_ctors(ModuleInfo, SymName, Arity),
PredIds)
;
MatchingPreds = []
@@ -765,7 +762,8 @@
(func(FieldDefn) = FieldCtor :-
FieldDefn = hlds_ctor_field_defn(_, _, TypeCtor, ConsId, _),
( ConsId = cons(ConsName, ConsArity) ->
- FieldCtor = field(TypeCtor, ConsName - ConsArity)
+ FieldCtor = field(type_ctor_to_item_name(TypeCtor),
+ item_name(ConsName, ConsArity))
;
unexpected(this_file, "weird cons_id in hlds_field_defn")
)
@@ -840,8 +838,8 @@
resolved_item_list(T)::in, resolved_item_list(T)::out,
recompilation_usage_info::in, recompilation_usage_info::out) is det.
-record_resolved_item_2(ModuleQualifier,
- SymName, Arity, RecordItem, Recorded, !List, !Info) :-
+record_resolved_item_2(ModuleQualifier, SymName, Arity, RecordItem, Recorded,
+ !List, !Info) :-
!.List = [],
map.init(Map0),
record_resolved_item_3(ModuleQualifier, SymName, Arity, RecordItem,
@@ -904,9 +902,10 @@
:- pred find_items_used_by_item(item_type::in, item_name::in,
recompilation_usage_info::in, recompilation_usage_info::out) is det.
-find_items_used_by_item(type_item, TypeCtor, !Info) :-
+find_items_used_by_item(type_item, TypeCtorItem, !Info) :-
ModuleInfo = !.Info ^ module_info,
module_info_get_type_table(ModuleInfo, Types),
+ TypeCtor = item_name_to_type_ctor(TypeCtorItem),
map.lookup(Types, TypeCtor, TypeDefn),
hlds_data.get_type_defn_body(TypeDefn, TypeBody),
( TypeBody = eqv_type(Type) ->
@@ -916,27 +915,30 @@
;
true
).
-find_items_used_by_item(type_body_item, TypeCtor, !Info) :-
+find_items_used_by_item(type_body_item, TypeCtorItem, !Info) :-
ModuleInfo = !.Info ^ module_info,
module_info_get_type_table(ModuleInfo, Types),
+ TypeCtor = item_name_to_type_ctor(TypeCtorItem),
map.lookup(Types, TypeCtor, TypeDefn),
hlds_data.get_type_defn_body(TypeDefn, TypeBody),
find_items_used_by_type_body(TypeBody, !Info).
-find_items_used_by_item(mode_item, ModeId, !Info):-
+find_items_used_by_item(mode_item, ModeIdItem, !Info):-
ModuleInfo = !.Info ^ module_info,
module_info_get_mode_table(ModuleInfo, Modes),
mode_table_get_mode_defns(Modes, ModeDefns),
+ ModeId = item_name_to_mode_id(ModeIdItem),
map.lookup(ModeDefns, ModeId, ModeDefn),
find_items_used_by_mode_defn(ModeDefn, !Info).
-find_items_used_by_item(inst_item, InstId, !Info):-
+find_items_used_by_item(inst_item, InstIdItem, !Info):-
ModuleInfo = !.Info ^ module_info,
module_info_get_inst_table(ModuleInfo, Insts),
inst_table_get_user_insts(Insts, UserInsts),
user_inst_table_get_inst_defns(UserInsts, UserInstDefns),
+ InstId = item_name_to_inst_id(InstIdItem),
map.lookup(UserInstDefns, InstId, InstDefn),
find_items_used_by_inst_defn(InstDefn, !Info).
find_items_used_by_item(typeclass_item, ClassItemId, !Info) :-
- ClassItemId = ClassName - ClassArity,
+ ClassItemId = item_name(ClassName, ClassArity),
ClassId = class_id(ClassName, ClassArity),
ModuleInfo = !.Info ^ module_info,
module_info_get_class_table(ModuleInfo, Classes),
@@ -974,10 +976,10 @@
find_items_used_by_instances(ClassId, InstanceDefns, !Info) :-
ClassId = class_id(Name, Arity),
- NameArity = Name - Arity,
- ( item_is_local(!.Info, NameArity) ->
- record_expanded_items_used_by_item(typeclass_item, NameArity, !Info),
- list.foldl(find_items_used_by_instance(NameArity), InstanceDefns,
+ ClassIdItem = item_name(Name, Arity),
+ ( item_is_local(!.Info, ClassIdItem) ->
+ record_expanded_items_used_by_item(typeclass_item, ClassIdItem, !Info),
+ list.foldl(find_items_used_by_instance(ClassIdItem), InstanceDefns,
!Info)
;
true
@@ -1102,7 +1104,7 @@
find_items_used_by_preds_3(PredOrFunc, Name, Arity, ModuleQualifier, _,
!Info) :-
SymName = module_qualify_name(ModuleQualifier, Name),
- record_used_pred_or_func(PredOrFunc, SymName - Arity, !Info).
+ record_used_pred_or_func(PredOrFunc, item_name(SymName, Arity), !Info).
:- pred find_items_used_by_pred(pred_or_func::in,
pair(string, arity)::in, pair(pred_id, module_name)::in,
@@ -1114,11 +1116,11 @@
ModuleInfo = !.Info ^ module_info,
module_info_pred_info(ModuleInfo, PredId, PredInfo),
(
- ItemId = qualified(PredModule, Name) - Arity,
+ ItemName = item_name(qualified(PredModule, Name), Arity),
(
- item_is_recorded_used(!.Info, ItemType, ItemId)
+ item_is_recorded_used(!.Info, ItemType, ItemName)
;
- item_is_local(!.Info, ItemId)
+ item_is_local(!.Info, ItemName)
)
->
% We've already recorded the items used by this predicate.
@@ -1133,20 +1135,18 @@
% of the universal class constraints in the pred_info.
pred_info_get_class_context(PredInfo, MethodClassContext),
MethodClassContext = constraints(MethodUnivConstraints, _),
- (
- MethodUnivConstraints = [constraint(ClassName0, ClassArgs) | _]
- ->
+ ( MethodUnivConstraints = [constraint(ClassName0, ClassArgs) | _] ->
ClassName = ClassName0,
ClassArity = list.length(ClassArgs)
;
unexpected(this_file, "class method with no class constraints")
),
- maybe_record_item_to_process(typeclass_item, ClassName - ClassArity,
- !Info)
+ maybe_record_item_to_process(typeclass_item,
+ item_name(ClassName, ClassArity), !Info)
;
- NameArity = qualified(PredModule, Name) - Arity,
- record_expanded_items_used_by_item(ItemType, NameArity, !Info),
- record_imported_item(ItemType, NameArity, !Info),
+ ItemName = item_name(qualified(PredModule, Name), Arity),
+ record_expanded_items_used_by_item(ItemType, ItemName, !Info),
+ record_imported_item(ItemType, ItemName, !Info),
pred_info_get_arg_types(PredInfo, ArgTypes),
find_items_used_by_types(ArgTypes, !Info),
pred_info_get_procedures(PredInfo, Procs),
@@ -1246,8 +1246,8 @@
find_items_used_by_simple_item_set_3(ItemType, Name, Arity, _, Module,
!Info) :-
- maybe_record_item_to_process(ItemType, qualified(Module, Name) - Arity,
- !Info).
+ maybe_record_item_to_process(ItemType,
+ item_name(qualified(Module, Name), Arity), !Info).
:- pred find_items_used_by_types(list(mer_type)::in,
recompilation_usage_info::in, recompilation_usage_info::out) is det.
@@ -1261,11 +1261,12 @@
find_items_used_by_type(Type, !Info) :-
( type_to_ctor_and_args(Type, TypeCtor, TypeArgs) ->
(
- % Unqualified type-ids are builtin types.
- TypeCtor = qualified(_, _) - _,
+ % Unqualified type constructor names are builtins.
+ TypeCtor = type_ctor(qualified(_, _), _),
\+ type_ctor_is_higher_order(TypeCtor, _, _, _)
->
- maybe_record_item_to_process(type_item, TypeCtor, !Info)
+ TypeCtorItem = type_ctor_to_item_name(TypeCtor),
+ maybe_record_item_to_process(type_item, TypeCtorItem, !Info)
;
true
),
@@ -1288,7 +1289,8 @@
find_items_used_by_inst(Inst2, !Info).
find_items_used_by_mode(user_defined_mode(ModeName, ArgInsts), !Info) :-
list.length(ArgInsts, ModeArity),
- maybe_record_item_to_process(mode_item, ModeName - ModeArity, !Info),
+ maybe_record_item_to_process(mode_item, item_name(ModeName, ModeArity),
+ !Info),
find_items_used_by_insts(ArgInsts, !Info).
:- pred find_items_used_by_insts(list(mer_inst)::in,
@@ -1320,7 +1322,7 @@
find_items_used_by_inst_name(InstName, !Info).
find_items_used_by_inst(abstract_inst(Name, ArgInsts), !Info) :-
list.length(ArgInsts, Arity),
- maybe_record_item_to_process(inst_item, Name - Arity, !Info),
+ maybe_record_item_to_process(inst_item, item_name(Name, Arity), !Info),
find_items_used_by_insts(ArgInsts, !Info).
:- pred find_items_used_by_bound_inst(bound_inst::in,
@@ -1340,7 +1342,7 @@
find_items_used_by_inst_name(user_inst(Name, ArgInsts), !Info) :-
list.length(ArgInsts, Arity),
- maybe_record_item_to_process(inst_item, Name - Arity, !Info),
+ maybe_record_item_to_process(inst_item, item_name(Name, Arity), !Info),
find_items_used_by_insts(ArgInsts, !Info).
find_items_used_by_inst_name(merge_inst(Inst1, Inst2), !Info) :-
find_items_used_by_inst(Inst1, !Info),
@@ -1381,60 +1383,59 @@
find_items_used_by_class_constraint(constraint(ClassName, ArgTypes), !Info) :-
ClassArity = list.length(ArgTypes),
- maybe_record_item_to_process(typeclass_item, ClassName - ClassArity,
- !Info),
+ maybe_record_item_to_process(typeclass_item,
+ item_name(ClassName, ClassArity), !Info),
find_items_used_by_types(ArgTypes, !Info).
-:- pred maybe_record_item_to_process(item_type::in, pair(sym_name, arity)::in,
+:- pred maybe_record_item_to_process(item_type::in, item_name::in,
recompilation_usage_info::in, recompilation_usage_info::out) is det.
-maybe_record_item_to_process(ItemType, NameArity, !Info) :-
+maybe_record_item_to_process(ItemType, ItemName, !Info) :-
( ItemType = typeclass_item ->
Classes0 = !.Info ^ used_typeclasses,
- set.insert(Classes0, NameArity, Classes),
+ set.insert(Classes0, ItemName, Classes),
!:Info = !.Info ^ used_typeclasses := Classes
;
true
),
- ( item_is_recorded_used(!.Info, ItemType, NameArity) ->
+ ( item_is_recorded_used(!.Info, ItemType, ItemName) ->
% This item has already been recorded.
true
- ; item_is_local(!.Info, NameArity) ->
+ ; item_is_local(!.Info, ItemName) ->
% Ignore local items. The items used by them have already been recorded
% by module_qual.m.
true
;
Queue0 = !.Info ^ item_queue,
- queue.put(Queue0, item_id(ItemType, NameArity), Queue),
+ queue.put(Queue0, item_id(ItemType, ItemName), Queue),
!:Info = !.Info ^ item_queue := Queue,
- record_imported_item(ItemType, NameArity, !Info),
- record_expanded_items_used_by_item(ItemType, NameArity, !Info)
+ record_imported_item(ItemType, ItemName, !Info),
+ record_expanded_items_used_by_item(ItemType, ItemName, !Info)
).
-:- pred item_is_recorded_used(recompilation_usage_info::in, item_type::in,
- pair(sym_name, arity)::in) is semidet.
+:- pred item_is_recorded_used(recompilation_usage_info::in,
+ item_type::in, item_name::in) is semidet.
-item_is_recorded_used(Info, ItemType, NameArity) :-
+item_is_recorded_used(Info, ItemType, ItemName) :-
ImportedItems = Info ^ imported_items,
- NameArity = qualified(ModuleName, Name) - Arity,
+ ItemName = item_name(qualified(ModuleName, Name), Arity),
map.search(ImportedItems, ModuleName, ModuleIdSet),
ModuleItemIdSet = extract_ids(ModuleIdSet, ItemType),
set.member(Name - Arity, ModuleItemIdSet).
-:- pred item_is_local(recompilation_usage_info::in,
- pair(sym_name, arity)::in) is semidet.
+:- pred item_is_local(recompilation_usage_info::in, item_name::in) is semidet.
-item_is_local(Info, NameArity) :-
- NameArity = qualified(ModuleName, _) - _,
+item_is_local(Info, ItemName) :-
+ ItemName = item_name(qualified(ModuleName, _), _),
module_info_get_name(Info ^ module_info, ModuleName).
-:- pred record_imported_item(item_type::in,
- pair(sym_name, arity)::in,
+:- pred record_imported_item(item_type::in, item_name::in,
recompilation_usage_info::in, recompilation_usage_info::out) is det.
-record_imported_item(ItemType, SymName - Arity, !Info) :-
+record_imported_item(ItemType, ItemName, !Info) :-
+ ItemName = item_name(SymName, Arity),
( SymName = qualified(Module0, Name0) ->
Module = Module0,
Name = Name0
Index: compiler/recompilation.version.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/recompilation.version.m,v
retrieving revision 1.43
diff -u -b -r1.43 recompilation.version.m
--- compiler/recompilation.version.m 29 Mar 2006 08:07:20 -0000 1.43
+++ compiler/recompilation.version.m 15 Apr 2006 09:58:57 -0000
@@ -187,16 +187,17 @@
% Pragmas in the interface aren't common so this won't be too much of
% a problem.
AddIfNotExisting = yes,
+ ItemName = item_name(SymName, Arity),
(
MaybePredOrFunc = yes(PredOrFunc),
ItemType = pred_or_func_to_item_type(PredOrFunc),
- add_gathered_item(Item, item_id(ItemType, SymName - Arity),
+ add_gathered_item(Item, item_id(ItemType, ItemName),
ItemContext, Section, AddIfNotExisting, !GatheredItems)
;
MaybePredOrFunc = no,
- add_gathered_item(Item, item_id(predicate_item, SymName - Arity),
+ add_gathered_item(Item, item_id(predicate_item, ItemName),
ItemContext, Section, AddIfNotExisting, !GatheredItems),
- add_gathered_item(Item, item_id(function_item, SymName - Arity),
+ add_gathered_item(Item, item_id(function_item, ItemName),
ItemContext, Section, AddIfNotExisting, !GatheredItems)
),
@@ -301,11 +302,11 @@
NameItem = Item,
BodyItem = Item
),
- TypeCtor = Name - list.length(Args),
+ TypeCtorItem = item_name(Name, list.length(Args)),
GatheredItems0 = !.Info ^ gathered_items,
- add_gathered_item(NameItem, item_id(type_item, TypeCtor),
+ add_gathered_item(NameItem, item_id(type_item, TypeCtorItem),
ItemContext, !.Section, yes, GatheredItems0, GatheredItems1),
- add_gathered_item(BodyItem, item_id(type_body_item, TypeCtor),
+ add_gathered_item(BodyItem, item_id(type_body_item, TypeCtorItem),
ItemContext, !.Section, yes, GatheredItems1, GatheredItems),
!:Info = !.Info ^ gathered_items := GatheredItems
;
@@ -313,12 +314,13 @@
->
Instances0 = !.Info ^ instances,
ClassArity = list.length(ClassArgs),
- ( map.search(Instances0, ClassName - ClassArity, InstanceItems0) ->
- InstanceItems = InstanceItems0
+ ClassItemName = item_name(ClassName, ClassArity),
+ ( map.search(Instances0, ClassItemName, InstanceItemsPrime) ->
+ InstanceItems = InstanceItemsPrime
;
InstanceItems = []
),
- map.set(Instances0, ClassName - ClassArity,
+ map.set(Instances0, ClassItemName,
[!.Section - (Item - ItemContext) | InstanceItems], Instances),
!:Info = !.Info ^ instances := Instances
;
@@ -332,7 +334,7 @@
WithInst = yes(_)
->
GatheredItems0 = !.Info ^ gathered_items,
- ItemName = SymName - list.length(Modes),
+ ItemName = item_name(SymName, list.length(Modes)),
add_gathered_item(Item, item_id(predicate_item, ItemName),
ItemContext, !.Section, yes, GatheredItems0, GatheredItems1),
add_gathered_item(Item, item_id(function_item, ItemName),
@@ -363,8 +365,8 @@
add_gathered_item(Item, ItemId, ItemContext, Section, AddIfNotExisting,
!GatheredItems) :-
- ItemId = item_id(ItemType, Id),
- Id = SymName - Arity,
+ ItemId = item_id(ItemType, ItemName),
+ ItemName = item_name(SymName, Arity),
unqualify_name(SymName, Name),
IdMap0 = extract_ids(!.GatheredItems, ItemType),
NameArity = Name - Arity,
@@ -493,16 +495,16 @@
item_to_item_id_2(clause(_, _, _, _, _, _), no).
item_to_item_id_2(type_defn(_, Name, Params, _, _),
- yes(item_id(type_item, Name - Arity))) :-
+ yes(item_id(type_item, item_name(Name, Arity)))) :-
list.length(Params, Arity).
item_to_item_id_2(inst_defn(_, Name, Params, _, _),
- yes(item_id(inst_item, Name - Arity))) :-
+ yes(item_id(inst_item, item_name(Name, Arity)))) :-
list.length(Params, Arity).
item_to_item_id_2(mode_defn(_, Name, Params, _, _),
- yes(item_id(mode_item, Name - Arity))) :-
+ yes(item_id(mode_item, item_name(Name, Arity)))) :-
list.length(Params, Arity).
item_to_item_id_2(module_defn(_, _), no).
-item_to_item_id_2(Item, yes(item_id(ItemType, SymName - Arity))) :-
+item_to_item_id_2(Item, yes(item_id(ItemType, item_name(SymName, Arity)))) :-
Item = pred_or_func(_, _, _, PredOrFunc, SymName, TypesAndModes, WithType,
_, _, _, _, _),
% For predicates or functions defined using `with_type` annotations
@@ -524,7 +526,7 @@
MaybePredOrFunc = yes(PredOrFunc),
adjust_func_arity(PredOrFunc, Arity, list.length(Modes)),
ItemType = pred_or_func_to_item_type(PredOrFunc),
- ItemId = yes(item_id(ItemType, SymName - Arity))
+ ItemId = yes(item_id(ItemType, item_name(SymName, Arity)))
;
MaybePredOrFunc = no,
% We need to handle these separately because a `:- mode' declaration
@@ -537,7 +539,7 @@
item_to_item_id_2(pragma(_, _), no).
item_to_item_id_2(promise(_, _, _, _), no).
item_to_item_id_2(Item,
- yes(item_id(typeclass_item, ClassName - ClassArity))) :-
+ yes(item_id(typeclass_item, item_name(ClassName, ClassArity)))) :-
Item = typeclass(_, _, ClassName, ClassVars, _, _),
list.length(ClassVars, ClassArity).
@@ -1027,10 +1029,10 @@
write_version_number(VersionNumber, !IO).
:- pred write_symname_arity_version_number(
- pair(pair(sym_name, int), version_number)::in, io::di, io::uo) is det.
+ pair(item_name, version_number)::in, io::di, io::uo) is det.
-write_symname_arity_version_number(SymNameArity - VersionNumber, !IO) :-
- SymNameArity = SymName - Arity,
+write_symname_arity_version_number(ItemName - VersionNumber, !IO) :-
+ ItemName = item_name(SymName, Arity),
mercury_output_bracketed_sym_name(SymName, next_to_graphic_token, !IO),
io.write_string("/", !IO),
io.write_int(Arity, !IO),
@@ -1092,7 +1094,7 @@
(pred(NameTerm::in, Name::out) is semidet :-
NameTerm = term.functor(term.atom(Name), [], _)
),
- map_parser(parse_item_version_number(ParseName), ItemsVNsTerms,
+ map_parser(parse_key_version_number(ParseName), ItemsVNsTerms,
Result0),
(
Result0 = ok(VNsAL),
@@ -1110,8 +1112,8 @@
(pred(NameTerm::in, Name::out) is semidet :-
sym_name_and_args(NameTerm, Name, [])
),
- map_parser(parse_item_version_number(ParseName),
- InstanceVNsTerms, Result1),
+ map_parser(parse_item_version_number(ParseName), InstanceVNsTerms,
+ Result1),
(
Result1 = ok(VNsAL),
map.from_assoc_list(VNsAL, VNsMap),
@@ -1124,10 +1126,11 @@
Result = error("invalid item type version numbers", Term)
).
-:- pred parse_item_version_number(pred(term, T)::(pred(in, out) is semidet),
- term::in, maybe1(pair(pair(T, arity), version_number))::out) is det.
+:- pred parse_key_version_number(
+ pred(term, string)::(pred(in, out) is semidet), term::in,
+ maybe1(pair(pair(string, arity), version_number))::out) is det.
-parse_item_version_number(ParseName, Term, Result) :-
+parse_key_version_number(ParseName, Term, Result) :-
(
Term = term.functor(term.atom("-"),
[ItemNameArityTerm, VersionNumberTerm], _),
@@ -1138,6 +1141,25 @@
VersionNumber = term_to_version_number(VersionNumberTerm)
->
Result = ok((Name - Arity) - VersionNumber)
+ ;
+ Result = error("error in item version number", Term)
+ ).
+
+:- pred parse_item_version_number(
+ pred(term, sym_name)::(pred(in, out) is semidet), term::in,
+ maybe1(pair(item_name, version_number))::out) is det.
+
+parse_item_version_number(ParseName, Term, Result) :-
+ (
+ Term = term.functor(term.atom("-"),
+ [ItemNameArityTerm, VersionNumberTerm], _),
+ ItemNameArityTerm = term.functor(term.atom("/"),
+ [NameTerm, ArityTerm], _),
+ ParseName(NameTerm, SymName),
+ ArityTerm = term.functor(term.integer(Arity), _, _),
+ VersionNumber = term_to_version_number(VersionNumberTerm)
+ ->
+ Result = ok(item_name(SymName, Arity) - VersionNumber)
;
Result = error("error in item version number", Term)
).
Index: compiler/rtti.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rtti.m,v
retrieving revision 1.70
diff -u -b -r1.70 rtti.m
--- compiler/rtti.m 29 Mar 2006 08:07:20 -0000 1.70
+++ compiler/rtti.m 15 Apr 2006 06:59:19 -0000
@@ -1496,12 +1496,11 @@
impl_ctor_rep_to_string(ImplCtor, RepStr)
;
TypeCtorDetails = foreign(IsStable),
- (
ModuleName = TypeCtorData ^ tcr_module_name,
TypeName = TypeCtorData ^ tcr_type_name,
TypeArity = TypeCtorData ^ tcr_arity,
- type_ctor_is_array(qualified(ModuleName, TypeName) - TypeArity)
- ->
+ TypeCtor = type_ctor(qualified(ModuleName, TypeName), TypeArity),
+ ( type_ctor_is_array(TypeCtor) ->
% XXX This is a kludge to allow accurate GC to trace arrays.
% We should allow users to provide tracing functions for
% foreign types.
Index: compiler/size_prof.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/size_prof.m,v
retrieving revision 1.37
diff -u -b -r1.37 size_prof.m
--- compiler/size_prof.m 29 Mar 2006 08:07:21 -0000 1.37
+++ compiler/size_prof.m 15 Apr 2006 07:26:29 -0000
@@ -1062,7 +1062,8 @@
record_known_type_ctor_info(Var, TypeCtorModule, TypeCtorName, TypeCtorArity,
!Info) :-
- TypeCtor = qualified(TypeCtorModule, TypeCtorName) - TypeCtorArity,
+ TypeCtor = type_ctor(qualified(TypeCtorModule, TypeCtorName),
+ TypeCtorArity),
TypeCtorMap0 = !.Info ^ type_ctor_map,
RevTypeCtorMap0 = !.Info ^ rev_type_ctor_map,
map.set(TypeCtorMap0, TypeCtor, Var, TypeCtorMap),
@@ -1080,8 +1081,8 @@
( list.map(map.search(RevTypeInfoMap0), ArgTypeInfoVars, ArgTypes) ->
list.length(ArgTypes, Arity),
% Just in case TypeCtorInfo0 has fake arity, e.g. if it is a tuple.
- TypeCtor0 = SymName - _DeclArity,
- TypeCtor1 = SymName - Arity,
+ TypeCtor0 = type_ctor(SymName, _DeclArity),
+ TypeCtor1 = type_ctor(SymName, Arity),
construct_type(TypeCtor1, ArgTypes, Type),
record_type_info_var(Type, Var, !Info)
;
Index: compiler/special_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/special_pred.m,v
retrieving revision 1.60
diff -u -b -r1.60 special_pred.m
--- compiler/special_pred.m 29 Mar 2006 08:07:21 -0000 1.60
+++ compiler/special_pred.m 15 Apr 2006 06:53:27 -0000
@@ -130,7 +130,7 @@
special_pred_mode_num(_, 0).
% mode num for special procs is always 0 (the first mode)
-special_pred_name(SpecialPred, SymName - Arity) = Name :-
+special_pred_name(SpecialPred, type_ctor(SymName, Arity)) = Name :-
BaseName = get_special_pred_id_target_name(SpecialPred),
AppendTypeId = spec_pred_name_append_type_id,
(
@@ -284,13 +284,13 @@
is_builtin_types_special_preds_defined_in_mercury(TypeCtor, TypeName) :-
Builtin = mercury_public_builtin_module,
- ( TypeCtor = qualified(Builtin, "int") - 0
- ; TypeCtor = qualified(Builtin, "string") - 0
- ; TypeCtor = qualified(Builtin, "character") - 0
- ; TypeCtor = qualified(Builtin, "float") - 0
- ; TypeCtor = qualified(Builtin, "pred") - 0
- ),
- TypeCtor = qualified(_Module, TypeName) - _Arity.
+ TypeCtor = type_ctor(qualified(Builtin, TypeName), 0),
+ ( TypeName = "int"
+ ; TypeName = "string"
+ ; TypeName = "character"
+ ; TypeName = "float"
+ ; TypeName = "pred"
+ ).
%-----------------------------------------------------------------------------%
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.107
diff -u -b -r1.107 table_gen.m
--- compiler/table_gen.m 29 Mar 2006 08:07:24 -0000 1.107
+++ compiler/table_gen.m 15 Apr 2006 07:27:35 -0000
@@ -3093,39 +3093,39 @@
trie_node_type = Type :-
mercury_table_builtin_module(TB),
- construct_type(qualified(TB, "ml_trie_node") - 0, [], Type).
+ construct_type(type_ctor(qualified(TB, "ml_trie_node"), 0), [], Type).
memo_non_record_type = Type :-
mercury_table_builtin_module(TB),
- construct_type(qualified(TB, "memo_non_record") - 0, [], Type).
+ construct_type(type_ctor(qualified(TB, "memo_non_record"), 0), [], Type).
subgoal_type = Type :-
mercury_table_builtin_module(TB),
- construct_type(qualified(TB, "ml_subgoal") - 0, [], Type).
+ construct_type(type_ctor(qualified(TB, "ml_subgoal"), 0), [], Type).
answer_block_type = Type :-
mercury_table_builtin_module(TB),
- construct_type(qualified(TB, "ml_answer_block") - 0, [], Type).
+ construct_type(type_ctor(qualified(TB, "ml_answer_block"), 0), [], Type).
loop_status_type = Type :-
mercury_table_builtin_module(TB),
- construct_type(qualified(TB, "loop_status") - 0, [], Type).
+ construct_type(type_ctor(qualified(TB, "loop_status"), 0), [], Type).
memo_det_status_type = Type :-
mercury_table_builtin_module(TB),
- construct_type(qualified(TB, "memo_det_status") - 0, [], Type).
+ construct_type(type_ctor(qualified(TB, "memo_det_status"), 0), [], Type).
memo_semi_status_type = Type :-
mercury_table_builtin_module(TB),
- construct_type(qualified(TB, "memo_semi_status") - 0, [], Type).
+ construct_type(type_ctor(qualified(TB, "memo_semi_status"), 0), [], Type).
memo_non_status_type = Type :-
mercury_table_builtin_module(TB),
- construct_type(qualified(TB, "memo_non_status") - 0, [], Type).
+ construct_type(type_ctor(qualified(TB, "memo_non_status"), 0), [], Type).
mm_status_type = Type :-
mercury_table_builtin_module(TB),
- construct_type(qualified(TB, "mm_status") - 0, [], Type).
+ construct_type(type_ctor(qualified(TB, "mm_status"), 0), [], Type).
%-----------------------------------------------------------------------------%
@@ -3133,13 +3133,13 @@
consumer_type = Type :-
mercury_table_builtin_module(TB),
- construct_type(qualified(TB, "ml_consumer") - 0, [], Type).
+ construct_type(type_ctor(qualified(TB, "ml_consumer"), 0), [], Type).
:- func generator_type = mer_type.
generator_type = Type :-
mercury_table_builtin_module(TB),
- construct_type(qualified(TB, "ml_generator") - 0, [], Type).
+ construct_type(type_ctor(qualified(TB, "ml_generator"), 0), [], Type).
:- type maybe_specified_method
---> all_same(arg_tabling_method)
Index: compiler/term_norm.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_norm.m,v
retrieving revision 1.18
diff -u -b -r1.18 term_norm.m
--- compiler/term_norm.m 29 Mar 2006 08:07:25 -0000 1.18
+++ compiler/term_norm.m 15 Apr 2006 07:27:45 -0000
@@ -239,7 +239,7 @@
( map.search(WeightMap, TypeCtor - ConsId, WeightInfo0) ->
WeightInfo = WeightInfo0
; type_ctor_is_tuple(TypeCtor) ->
- TypeCtor = _ - Arity,
+ TypeCtor = type_ctor(_, Arity),
find_weights_for_tuple(Arity, WeightInfo)
;
fail
Index: compiler/tupling.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/tupling.m,v
retrieving revision 1.22
diff -u -b -r1.22 tupling.m
--- compiler/tupling.m 29 Mar 2006 08:07:27 -0000 1.22
+++ compiler/tupling.m 15 Apr 2006 07:27:56 -0000
@@ -627,7 +627,7 @@
list.length(FieldVars, TupleArity),
proc_info_get_vartypes(!.ProcInfo, VarTypes),
list.map(map.lookup(VarTypes), FieldVars, TupleArgTypes),
- construct_type(unqualified("{}") - TupleArity, TupleArgTypes,
+ construct_type(type_ctor(unqualified("{}"), TupleArity), TupleArgTypes,
TupleConsType),
proc_info_create_var_from_type(TupleConsType,
yes("TuplingCellVar"), CellVar, !ProcInfo),
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.76
diff -u -b -r1.76 type_ctor_info.m
--- compiler/type_ctor_info.m 29 Mar 2006 08:07:27 -0000 1.76
+++ compiler/type_ctor_info.m 15 Apr 2006 06:33:02 -0000
@@ -130,7 +130,7 @@
ModuleInfo, TypeCtorGenInfos) :-
gen_type_ctor_gen_infos(TypeCtors, TypeTable, ModuleName, ModuleInfo,
TypeCtorGenInfos1),
- TypeCtor = SymName - TypeArity,
+ TypeCtor = type_ctor(SymName, TypeArity),
(
SymName = qualified(TypeModuleName, TypeName),
(
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.163
diff -u -b -r1.163 type_util.m
--- compiler/type_util.m 29 Mar 2006 08:07:27 -0000 1.163
+++ compiler/type_util.m 15 Apr 2006 06:40:01 -0000
@@ -309,13 +309,13 @@
%-----------------------------------------------------------------------------%
-type_ctor_module(_ModuleInfo, TypeName - _Arity, ModuleName) :-
+type_ctor_module(_ModuleInfo, type_ctor(TypeName, _Arity), ModuleName) :-
sym_name_get_module_name(TypeName, unqualified(""), ModuleName).
-type_ctor_name(_ModuleInfo, Name0 - _Arity, Name) :-
+type_ctor_name(_ModuleInfo, type_ctor(Name0, _Arity), Name) :-
unqualify_name(Name0, Name).
-type_ctor_arity(_ModuleInfo, _Name - Arity, Arity).
+type_ctor_arity(_ModuleInfo, type_ctor(_Name, Arity), Arity).
type_is_atomic(Type, ModuleInfo) :-
type_to_ctor_and_args(Type, TypeCtor, _),
@@ -344,7 +344,7 @@
type_category_is_atomic(type_cat_user_ctor) = no.
type_ctor_has_hand_defined_rtti(Type, Body) :-
- Type = qualified(mercury_private_builtin_module, Name) - 0,
+ Type = type_ctor(qualified(mercury_private_builtin_module, Name), 0),
( Name = "type_info"
; Name = "type_ctor_info"
; Name = "typeclass_info"
@@ -365,24 +365,24 @@
).
classify_type_ctor(ModuleInfo, TypeCtor) = TypeCategory :-
- PrivateBuiltin = mercury_private_builtin_module,
- ( TypeCtor = unqualified("character") - 0 ->
+ PB = mercury_private_builtin_module,
+ ( TypeCtor = type_ctor(unqualified("character"), 0) ->
TypeCategory = type_cat_char
- ; TypeCtor = unqualified("int") - 0 ->
+ ; TypeCtor = type_ctor(unqualified("int"), 0) ->
TypeCategory = type_cat_int
- ; TypeCtor = unqualified("float") - 0 ->
+ ; TypeCtor = type_ctor(unqualified("float"), 0) ->
TypeCategory = type_cat_float
- ; TypeCtor = unqualified("string") - 0 ->
+ ; TypeCtor = type_ctor(unqualified("string"), 0) ->
TypeCategory = type_cat_string
- ; TypeCtor = unqualified("void") - 0 ->
+ ; TypeCtor = type_ctor(unqualified("void"), 0) ->
TypeCategory = type_cat_void
- ; TypeCtor = qualified(PrivateBuiltin, "type_info") - 0 ->
+ ; TypeCtor = type_ctor(qualified(PB, "type_info"), 0) ->
TypeCategory = type_cat_type_info
- ; TypeCtor = qualified(PrivateBuiltin, "type_ctor_info") - 0 ->
+ ; TypeCtor = type_ctor(qualified(PB, "type_ctor_info"), 0) ->
TypeCategory = type_cat_type_ctor_info
- ; TypeCtor = qualified(PrivateBuiltin, "typeclass_info") - 0 ->
+ ; TypeCtor = type_ctor(qualified(PB, "typeclass_info"), 0) ->
TypeCategory = type_cat_typeclass_info
- ; TypeCtor = qualified(PrivateBuiltin, "base_typeclass_info") - 0 ->
+ ; TypeCtor = type_ctor(qualified(PB, "base_typeclass_info"), 0) ->
TypeCategory = type_cat_base_typeclass_info
; type_ctor_is_higher_order(TypeCtor, _, _, _) ->
TypeCategory = type_cat_higher_order
@@ -489,7 +489,7 @@
% Keep this in sync with is_dummy_argument_type_with_constructors
% above.
(
- TypeCtor = CtorSymName - TypeArity,
+ TypeCtor = type_ctor(CtorSymName, TypeArity),
CtorSymName = qualified(unqualified(ModuleName), TypeName),
is_builtin_dummy_argument_type(ModuleName, TypeName, TypeArity)
;
@@ -540,7 +540,7 @@
switch_type_num_functors(ModuleInfo, Type, NumFunctors) :-
type_to_ctor_and_args(Type, TypeCtor, _),
- ( TypeCtor = unqualified("character") - 0 ->
+ ( TypeCtor = type_ctor(unqualified("character"), 0) ->
% XXX The following code uses the source machine's character size,
% not the target's, so it won't work if cross-compiling to a machine
% with a different size character.
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.392
diff -u -b -r1.392 typecheck.m
--- compiler/typecheck.m 29 Mar 2006 08:07:27 -0000 1.392
+++ compiler/typecheck.m 15 Apr 2006 08:12:24 -0000
@@ -5,10 +5,10 @@
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-
+%
% File: typecheck.m.
% Main author: fjh.
-
+%
% This file contains the Mercury type-checker.
%
% The predicates in this module are named as follows:
@@ -1234,30 +1234,34 @@
hlds_goal_info::in, typecheck_info::in, typecheck_info::out,
io::di, io::uo) is det.
-typecheck_goal_2(conj(ConjType, List0), conj(ConjType, List), _, !Info, !IO) :-
+typecheck_goal_2(GoalExpr0, GoalExpr, GoalInfo, !Info, !IO) :-
+ (
+ GoalExpr0 = conj(ConjType, List0),
checkpoint("conj", !Info, !IO),
- typecheck_goal_list(List0, List, !Info, !IO).
-
-typecheck_goal_2(disj(List0), disj(List), _, !Info, !IO) :-
+ typecheck_goal_list(List0, List, !Info, !IO),
+ GoalExpr = conj(ConjType, List)
+ ;
+ GoalExpr0 = disj(List0),
checkpoint("disj", !Info, !IO),
- typecheck_goal_list(List0, List, !Info, !IO).
-
-typecheck_goal_2(if_then_else(Vars, Cond0, Then0, Else0),
- if_then_else(Vars, Cond, Then, Else), _, !Info, !IO) :-
+ typecheck_goal_list(List0, List, !Info, !IO),
+ GoalExpr = disj(List)
+ ;
+ GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
checkpoint("if", !Info, !IO),
typecheck_goal(Cond0, Cond, !Info, !IO),
checkpoint("then", !Info, !IO),
typecheck_goal(Then0, Then, !Info, !IO),
checkpoint("else", !Info, !IO),
typecheck_goal(Else0, Else, !Info, !IO),
- ensure_vars_have_a_type(Vars, !Info, !IO).
-
-typecheck_goal_2(not(SubGoal0), not(SubGoal), _, !Info, !IO) :-
+ ensure_vars_have_a_type(Vars, !Info, !IO),
+ GoalExpr = if_then_else(Vars, Cond, Then, Else)
+ ;
+ GoalExpr0 = not(SubGoal0),
checkpoint("not", !Info, !IO),
- typecheck_goal(SubGoal0, SubGoal, !Info, !IO).
-
-typecheck_goal_2(scope(Reason, SubGoal0), scope(Reason, SubGoal), _, !Info,
- !IO) :-
+ typecheck_goal(SubGoal0, SubGoal, !Info, !IO),
+ GoalExpr = not(SubGoal)
+ ;
+ GoalExpr0 = scope(Reason, SubGoal0),
checkpoint("scope", !Info, !IO),
typecheck_goal(SubGoal0, SubGoal, !Info, !IO),
(
@@ -1274,19 +1278,19 @@
Reason = barrier(_)
;
Reason = from_ground_term(_)
- ).
-
-typecheck_goal_2(call(_, B, Args, D, E, Name),
- call(PredId, B, Args, D, E, Name), GoalInfo, !Info, !IO) :-
+ ),
+ GoalExpr = scope(Reason, SubGoal)
+ ;
+ GoalExpr0 = call(_, B, Args, D, E, Name),
checkpoint("call", !Info, !IO),
list.length(Args, Arity),
- typecheck_info_set_called_predid(call(predicate - Name/Arity), !Info),
+ CurCall = simple_call_id(predicate, Name, Arity),
+ typecheck_info_set_called_predid(call(CurCall), !Info),
goal_info_get_goal_path(GoalInfo, GoalPath),
- typecheck_call_pred(predicate - Name/Arity, Args, GoalPath,
- PredId, !Info, !IO).
-
-typecheck_goal_2(generic_call(GenericCall0, Args, C, D),
- generic_call(GenericCall, Args, C, D), _GoalInfo, !Info, !IO) :-
+ typecheck_call_pred(CurCall, Args, GoalPath, PredId, !Info, !IO),
+ GoalExpr = call(PredId, B, Args, D, E, Name)
+ ;
+ GoalExpr0 = generic_call(GenericCall0, Args, C, D),
hlds_goal.generic_call_id(GenericCall0, CallId),
typecheck_info_set_called_predid(CallId, !Info),
(
@@ -1296,41 +1300,44 @@
typecheck_higher_order_call(PredVar, Purity, Args, !Info, !IO)
;
GenericCall0 = class_method(_, _, _, _),
- unexpected(this_file, "typecheck_goal_2: unexpected class method call")
+ unexpected(this_file, "typecheck_goal_2:
+ unexpected class method call")
;
GenericCall0 = cast(_),
% A cast imposes no restrictions on its argument types,
% so nothing needs to be done here.
GenericCall = GenericCall0
- ).
-
-typecheck_goal_2(unify(LHS, RHS0, C, D, UnifyContext),
- unify(LHS, RHS, C, D, UnifyContext), GoalInfo, !Info, !IO) :-
+ ),
+ GoalExpr = generic_call(GenericCall, Args, C, D)
+ ;
+ GoalExpr0 = unify(LHS, RHS0, C, D, UnifyContext),
checkpoint("unify", !Info, !IO),
typecheck_info_set_arg_num(0, !Info),
typecheck_info_set_unify_context(UnifyContext, !Info),
goal_info_get_goal_path(GoalInfo, GoalPath),
- typecheck_unification(LHS, RHS0, RHS, GoalPath, !Info, !IO).
-
-typecheck_goal_2(switch(_, _, _), _, _, !Info, !IO) :-
- unexpected(this_file, "typecheck_goal_2: unexpected switch").
-
-typecheck_goal_2(Goal @ foreign_proc(_, PredId, _, Args, _, _), Goal, GoalInfo,
- !Info, !IO) :-
- % Foreign_procs are automatically generated, so they will
- % always be type-correct, but we need to do the type analysis in order
- % to correctly compute the HeadTypeParams that result from
- % existentially typed foreign_procs. (We could probably do that
- % more efficiently than the way it is done below, though.)
+ typecheck_unification(LHS, RHS0, RHS, GoalPath, !Info, !IO),
+ GoalExpr = unify(LHS, RHS, C, D, UnifyContext)
+ ;
+ GoalExpr0 = switch(_, _, _),
+ unexpected(this_file, "typecheck_goal_2: unexpected switch")
+ ;
+ GoalExpr0 = foreign_proc(_, PredId, _, Args, _, _),
+ % Foreign_procs are automatically generated, so they will always be
+ % type-correct, but we need to do the type analysis in order to
+ % correctly compute the HeadTypeParams that result from existentially
+ % typed foreign_procs. (We could probably do that more efficiently
+ % than the way it is done below, though.)
typecheck_info_get_type_assign_set(!.Info, OrigTypeAssignSet),
ArgVars = list.map(foreign_arg_var, Args),
goal_info_get_goal_path(GoalInfo, GoalPath),
typecheck_call_pred_id(PredId, ArgVars, GoalPath, !Info, !IO),
- perform_context_reduction(OrigTypeAssignSet, !Info, !IO).
-
-typecheck_goal_2(shorthand(ShorthandGoal0), shorthand(ShorthandGoal), _, !Info,
- !IO) :-
- typecheck_goal_2_shorthand(ShorthandGoal0, ShorthandGoal, !Info, !IO).
+ perform_context_reduction(OrigTypeAssignSet, !Info, !IO),
+ GoalExpr = GoalExpr0
+ ;
+ GoalExpr0 = shorthand(ShorthandGoal0),
+ typecheck_goal_2_shorthand(ShorthandGoal0, ShorthandGoal, !Info, !IO),
+ GoalExpr = shorthand(ShorthandGoal)
+ ).
:- pred typecheck_goal_2_shorthand(shorthand_goal_expr::in,
shorthand_goal_expr::out,
@@ -1461,10 +1468,9 @@
% argument types.
%
:- pred typecheck_call_pred_adjust_arg_types(simple_call_id::in,
- list(prog_var)::in, goal_path::in,
- adjust_arg_types::in(adjust_arg_types),
- pred_id::out, typecheck_info::in, typecheck_info::out,
- io::di, io::uo) is det.
+ list(prog_var)::in, goal_path::in, adjust_arg_types::in(adjust_arg_types),
+ pred_id::out, typecheck_info::in, typecheck_info::out, io::di, io::uo)
+ is det.
typecheck_call_pred_adjust_arg_types(CallId, Args, GoalPath, AdjustArgTypes,
PredId, !Info, !IO) :-
@@ -1474,7 +1480,7 @@
typecheck_info_get_module_info(!.Info, ModuleInfo),
module_info_get_predicate_table(ModuleInfo, PredicateTable),
(
- CallId = PorF - SymName/Arity,
+ CallId = simple_call_id(PorF, SymName, Arity),
predicate_table_search_pf_sym_arity(PredicateTable,
calls_are_fully_qualified(!.Info ^ pred_markers),
PorF, SymName, Arity, PredIdList)
@@ -1487,7 +1493,7 @@
typecheck_call_pred_id_adjust_arg_types(PredId, Args,
GoalPath, AdjustArgTypes, !Info, !IO)
;
- typecheck_call_overloaded_pred(PredIdList, Args,
+ typecheck_call_overloaded_pred(CallId, PredIdList, Args,
GoalPath, AdjustArgTypes, !Info, !IO),
% In general, we can't figure out which predicate it is until
@@ -1555,12 +1561,18 @@
PredExistQVars, PredArgTypes, PredConstraints, !Info, !IO)
).
-:- pred typecheck_call_overloaded_pred(list(pred_id)::in, list(prog_var)::in,
- goal_path::in, adjust_arg_types::in(adjust_arg_types),
+:- pred typecheck_call_overloaded_pred(simple_call_id::in, list(pred_id)::in,
+ list(prog_var)::in, goal_path::in, adjust_arg_types::in(adjust_arg_types),
typecheck_info::in, typecheck_info::out, io::di, io::uo) is det.
-typecheck_call_overloaded_pred(PredIdList, Args, GoalPath, AdjustArgTypes,
- !Info, !IO) :-
+typecheck_call_overloaded_pred(CallId, PredIdList, Args, GoalPath,
+ AdjustArgTypes, !Info, !IO) :-
+ typecheck_info_get_overloaded_symbols(!.Info, OverloadedSymbols0),
+ typecheck_info_get_context(!.Info, Context),
+ Symbol = overloaded_symbol(Context, overloaded_pred(CallId, PredIdList)),
+ set.insert(OverloadedSymbols0, Symbol, OverloadedSymbols),
+ typecheck_info_set_overloaded_symbols(OverloadedSymbols, !Info),
+
% Let the new arg_type_assign_set be the cross-product of the current
% type_assign_set and the set of possible lists of argument types
% for the overloaded predicate, suitable renamed apart.
@@ -1942,7 +1954,18 @@
!IO),
typecheck_info_set_found_error(yes, !Info)
;
- ConsDefnList = [_ | _],
+ (
+ ConsDefnList = [_]
+ ;
+ ConsDefnList = [_, _ | _],
+ typecheck_info_get_overloaded_symbols(!.Info, OverloadedSymbols0),
+ typecheck_info_get_context(!.Info, Context),
+ Sources = list.map(project_cons_type_info_source, ConsDefnList),
+ Symbol = overloaded_symbol(Context,
+ overloaded_func(Functor, Sources)),
+ set.insert(OverloadedSymbols0, Symbol, OverloadedSymbols),
+ typecheck_info_set_overloaded_symbols(OverloadedSymbols, !Info)
+ ),
% Produce the ConsTypeAssignSet, which is essentially the
% cross-product of the TypeAssignSet0 and the ConsDefnList.
@@ -1951,7 +1974,7 @@
!.Info, ConsDefnList, [], ConsTypeAssignSet),
(
ConsTypeAssignSet = [],
- TypeAssignSet0 \= []
+ TypeAssignSet0 = [_ | _]
->
% This should never happen, since undefined ctors
% should be caught by the check just above.
@@ -1962,8 +1985,7 @@
),
% Check that the type of the functor matches the type of the variable.
- typecheck_functor_type(ConsTypeAssignSet, Var, [],
- ArgsTypeAssignSet),
+ typecheck_functor_type(ConsTypeAssignSet, Var, [], ArgsTypeAssignSet),
(
ArgsTypeAssignSet = [],
ConsTypeAssignSet = [_ | _]
@@ -2001,11 +2023,12 @@
)
).
-:- type cons_type ---> cons_type(mer_type, list(mer_type)).
+:- type cons_type
+ ---> cons_type(mer_type, list(mer_type)).
+
:- type cons_type_assign_set == list(pair(type_assign, cons_type)).
- % typecheck_unify_var_functor_get_ctors(TypeAssignSet, Info,
- % ConsDefns):
+ % typecheck_unify_var_functor_get_ctors(TypeAssignSet, Info, ConsDefns):
%
% Iterate over all the different possible type assignments and
% constructor definitions.
@@ -2014,9 +2037,9 @@
%
% TypeAssign - cons_type(Type, ArgTypes)
%
- % where `cons_type(Type, ArgTypes)' records one of the possible
- % types for the constructor in `ConsDefns', and where `TypeAssign' is
- % the type assignment renamed apart from the types of the constructors.
+ % where `cons_type(Type, ArgTypes)' records one of the possible types
+ % for the constructor in `ConsDefns', and where `TypeAssign' is the type
+ % assignment renamed apart from the types of the constructors.
%
:- pred typecheck_unify_var_functor_get_ctors(type_assign_set::in,
typecheck_info::in, list(cons_type_info)::in,
@@ -2189,7 +2212,7 @@
get_cons_stuff(ConsDefn, TypeAssign0, _Info, ConsType, ArgTypes, TypeAssign) :-
ConsDefn = cons_type_info(ConsTypeVarSet, ConsExistQVars0,
- ConsType0, ArgTypes0, ClassConstraints0),
+ ConsType0, ArgTypes0, ClassConstraints0, _Source),
% Rename apart the type vars in the type of the constructor
% and the types of its arguments.
@@ -2427,7 +2450,7 @@
make_body_hlds_constraints(ClassTable, PredTypeVarSet,
GoalPath, PredClassContext, PredConstraints),
ConsInfo = cons_type_info(PredTypeVarSet, PredExistQVars,
- PredType, ArgTypes, PredConstraints),
+ PredType, ArgTypes, PredConstraints, source_pred(PredId)),
!:ConsInfos = [ConsInfo | !.ConsInfos]
;
unexpected(this_file, "make_pred_cons_info: split_list failed")
@@ -2439,7 +2462,9 @@
% We don't support first-class polymorphism, so you can't take
% the address of an existentially quantified function. You can however
% call such a function, so long as you pass *all* the parameters.
- ( PredExistQVars = [] ; PredAsFuncArity = FuncArity )
+ ( PredExistQVars = []
+ ; PredAsFuncArity = FuncArity
+ )
->
(
list.split_list(FuncArity, CompleteArgTypes,
@@ -2458,7 +2483,8 @@
make_body_hlds_constraints(ClassTable, PredTypeVarSet,
GoalPath, PredClassContext, PredConstraints),
ConsInfo = cons_type_info(PredTypeVarSet,
- PredExistQVars, FuncType, FuncArgTypes, PredConstraints),
+ PredExistQVars, FuncType, FuncArgTypes, PredConstraints,
+ source_pred(PredId)),
!:ConsInfos = [ConsInfo | !.ConsInfos]
;
unexpected(this_file, "make_pred_cons_info: split_list failed")
@@ -2479,11 +2505,23 @@
builtin_apply_type(_Info, Functor, Arity, ConsTypeInfos) :-
Functor = cons(unqualified(ApplyName), _),
- ( ApplyName = "apply", Purity = purity_pure
- ; ApplyName = "", Purity = purity_pure
% XXX FIXME handle impure apply/N more elegantly (e.g. nicer syntax)
- ; ApplyName = "impure_apply", Purity = purity_impure
- ; ApplyName = "semipure_apply", Purity = purity_semipure
+ (
+ ApplyName = "apply",
+ ApplyNameToUse = ApplyName,
+ Purity = purity_pure
+ ;
+ ApplyName = "",
+ ApplyNameToUse = "apply",
+ Purity = purity_pure
+ ;
+ ApplyName = "impure_apply",
+ ApplyNameToUse = ApplyName,
+ Purity = purity_impure
+ ;
+ ApplyName = "semipure_apply",
+ ApplyNameToUse = ApplyName,
+ Purity = purity_semipure
),
Arity >= 1,
Arity1 = Arity - 1,
@@ -2492,7 +2530,8 @@
ExistQVars = [],
empty_hlds_constraints(EmptyConstraints),
ConsTypeInfos = [cons_type_info(TypeVarSet, ExistQVars, RetType,
- [FuncType | ArgTypes], EmptyConstraints)].
+ [FuncType | ArgTypes], EmptyConstraints,
+ source_apply(ApplyNameToUse))].
% builtin_field_access_function_type(Info, GoalPath, Functor,
% Arity, ConsTypeInfos):
@@ -2542,14 +2581,13 @@
).
:- pred get_field_access_constructor(typecheck_info::in, goal_path::in,
- sym_name::in, arity::in, field_access_type::in,
- hlds_ctor_field_defn::in, existq_tvars::out, maybe_cons_type_info::out)
- is semidet.
+ sym_name::in, arity::in, field_access_type::in, hlds_ctor_field_defn::in,
+ existq_tvars::out, maybe_cons_type_info::out) is semidet.
get_field_access_constructor(Info, GoalPath, FuncName, Arity, AccessType,
FieldDefn, OrigExistTVars, FunctorConsTypeInfo) :-
FieldDefn = hlds_ctor_field_defn(_, _, TypeCtor, ConsId, _),
- TypeCtor = qualified(TypeModule, _) - _,
+ TypeCtor = type_ctor(qualified(TypeModule, _), _),
% If the user has supplied a declaration, we use that instead
% of the automatically generated version, unless we are typechecking
@@ -2595,19 +2633,26 @@
convert_field_access_cons_type_info(ClassTable, AccessType, FieldName,
FieldDefn, FunctorConsTypeInfo, OrigExistTVars, ConsTypeInfo) :-
FunctorConsTypeInfo = cons_type_info(TVarSet0, ExistQVars,
- FunctorType, ConsArgTypes, Constraints0),
+ FunctorType, ConsArgTypes, Constraints0, Source0),
+ ( Source0 = source_type(SourceTypePrime) ->
+ SourceType = SourceTypePrime
+ ;
+ unexpected(this_file, "convert_field_access_cons_type_info: not type")
+ ),
FieldDefn = hlds_ctor_field_defn(_, _, _, _, FieldNumber),
list.index1_det(ConsArgTypes, FieldNumber, FieldType),
(
AccessType = get,
+ Source = source_get_field_access(SourceType),
RetType = FieldType,
ArgTypes = [FunctorType],
TVarSet = TVarSet0,
Constraints = Constraints0,
ConsTypeInfo = ok(cons_type_info(TVarSet, ExistQVars,
- RetType, ArgTypes, Constraints))
+ RetType, ArgTypes, Constraints, Source))
;
AccessType = set,
+ Source = source_set_field_access(SourceType),
% When setting a polymorphic field, the type of the field in the result
% is not necessarily the same as in the input. If a type variable
@@ -2633,7 +2678,7 @@
Constraints = Constraints0,
ConsTypeInfo = ok(cons_type_info(TVarSet, ExistQVars,
- RetType, ArgTypes, Constraints))
+ RetType, ArgTypes, Constraints, Source))
;
TVarsInField = [_ | _],
@@ -2688,7 +2733,7 @@
RetType = OutputFunctorType,
ArgTypes = [FunctorType, RenamedFieldType],
ConsTypeInfo = ok(cons_type_info(TVarSet, ExistQVars,
- RetType, ArgTypes, Constraints))
+ RetType, ArgTypes, Constraints, Source))
;
% This field cannot be set. Pass out some information so that
% we can give a better error message. Errors involving changing
@@ -2755,10 +2800,9 @@
% and recompilation.check.check_functor_ambiguities.
%
:- pred typecheck_info_get_ctor_list(typecheck_info::in, cons_id::in, int::in,
- goal_path::in, list(cons_type_info)::out, list(cons_error)::out)
- is det.
+ goal_path::in, list(cons_type_info)::out, list(cons_error)::out) is det.
-typecheck_info_get_ctor_list(Info, Functor, Arity, GoalPath, ConsInfoList,
+typecheck_info_get_ctor_list(Info, Functor, Arity, GoalPath, ConsInfos,
ConsErrors) :-
(
% If we're typechecking the clause added for a field access function
@@ -2771,87 +2815,82 @@
->
(
builtin_field_access_function_type(Info, GoalPath,
- Functor, Arity, FieldAccessConsInfoList)
+ Functor, Arity, FieldAccessConsInfos)
->
- split_cons_errors(FieldAccessConsInfoList,
- ConsInfoList, ConsErrors)
+ split_cons_errors(FieldAccessConsInfos, ConsInfos, ConsErrors)
;
- ConsInfoList = [],
+ ConsInfos = [],
ConsErrors = []
)
;
typecheck_info_get_ctor_list_2(Info, Functor, Arity, GoalPath,
- ConsInfoList, ConsErrors)
+ ConsInfos, ConsErrors)
).
:- pred typecheck_info_get_ctor_list_2(typecheck_info::in, cons_id::in,
- int::in, goal_path::in, list(cons_type_info)::out,
- list(cons_error)::out) is det.
+ int::in, goal_path::in, list(cons_type_info)::out, list(cons_error)::out)
+ is det.
-typecheck_info_get_ctor_list_2(Info, Functor, Arity, GoalPath, ConsInfoList,
- ConsErrors) :-
+typecheck_info_get_ctor_list_2(Info, Functor, Arity, GoalPath, ConsInfos,
+ DataConsErrors) :-
empty_hlds_constraints(EmptyConstraints),
- % Check if `Functor/Arity' has been defined as a constructor
- % in some discriminated union type(s). This gives
- % us a list of possible cons_type_infos.
+ % Check if `Functor/Arity' has been defined as a constructor in some
+ % discriminated union type(s). This gives us a list of possible
+ % cons_type_infos.
typecheck_info_get_ctors(Info, Ctors),
(
Functor = cons(_, _),
- map.search(Ctors, Functor, HLDS_ConsDefnList)
+ map.search(Ctors, Functor, HLDS_ConsDefns)
->
convert_cons_defn_list(Info, GoalPath, do_not_flip_constraints,
- HLDS_ConsDefnList, MaybeConsInfoList0)
+ HLDS_ConsDefns, PlainMaybeConsInfos)
;
- MaybeConsInfoList0 = []
+ PlainMaybeConsInfos = []
),
- % For "existentially typed" functors, whether the functor
- % is actually existentially typed depends on whether it is
- % used as a constructor or as a deconstructor. As a constructor,
- % it is universally typed, but as a deconstructor, it is
- % existentially typed. But type checking and polymorphism need
- % to know whether it is universally or existentially quantified
- % _before_ mode analysis has inferred the mode of the unification.
- % Therefore, we use a special syntax for construction unifications
- % with existentially quantified functors: instead of just using the
- % functor name (e.g. "Y = foo(X)", the programmer must use the
- % special functor name "new foo" (e.g. "Y = 'new foo'(X)").
- %
- % Here we check for occurrences of functor names starting with
- % "new ". For these, we look up the original functor in the
- % constructor symbol table, and for any occurrences of that
- % functor we flip the quantifiers on the type definition
- % (i.e. convert the existential quantifiers and constraints
- % into universal ones).
+ % For "existentially typed" functors, whether the functor is actually
+ % existentially typed depends on whether it is used as a constructor
+ % or as a deconstructor. As a constructor, it is universally typed,
+ % but as a deconstructor, it is existentially typed. But type checking
+ % and polymorphism need to know whether it is universally or existentially
+ % quantified _before_ mode analysis has inferred the mode of the
+ % unification. Therefore, we use a special syntax for construction
+ % unifications with existentially quantified functors: instead of
+ % just using the functor name (e.g. "Y = foo(X)", the programmer must use
+ % the special functor name "new foo" (e.g. "Y = 'new foo'(X)").
+ %
+ % Here we check for occurrences of functor names starting with "new ".
+ % For these, we look up the original functor in the constructor symbol
+ % table, and for any occurrences of that functor we flip the quantifiers on
+ % the type definition (i.e. convert the existential quantifiers and
+ % constraints into universal ones).
(
Functor = cons(Name, Arity),
remove_new_prefix(Name, OrigName),
OrigFunctor = cons(OrigName, Arity),
- map.search(Ctors, OrigFunctor, HLDS_ExistQConsDefnList)
+ map.search(Ctors, OrigFunctor, HLDS_ExistQConsDefns)
->
- convert_cons_defn_list(Info, GoalPath,
- flip_constraints_for_new, HLDS_ExistQConsDefnList,
- UnivQuantifiedConsInfoList),
- list.append(UnivQuantifiedConsInfoList,
- MaybeConsInfoList0, MaybeConsInfoList1)
+ convert_cons_defn_list(Info, GoalPath, flip_constraints_for_new,
+ HLDS_ExistQConsDefns, UnivQuantifiedMaybeConsInfos)
;
- MaybeConsInfoList1 = MaybeConsInfoList0
+ UnivQuantifiedMaybeConsInfos = []
),
% Check if Functor is a field access function for which the user
% has not supplied a declaration.
(
builtin_field_access_function_type(Info, GoalPath, Functor,
- Arity, FieldAccessConsInfoList)
+ Arity, FieldAccessMaybeConsInfosPrime)
->
- MaybeConsInfoList = FieldAccessConsInfoList ++
- MaybeConsInfoList1
+ FieldAccessMaybeConsInfos = FieldAccessMaybeConsInfosPrime
;
- MaybeConsInfoList = MaybeConsInfoList1
+ FieldAccessMaybeConsInfos = []
),
- split_cons_errors(MaybeConsInfoList, ConsInfoList1, ConsErrors),
+ DataMaybeConsInfos = PlainMaybeConsInfos ++ UnivQuantifiedMaybeConsInfos
+ ++ FieldAccessMaybeConsInfos,
+ split_cons_errors(DataMaybeConsInfos, DataConsInfos, DataConsErrors),
% Check if Functor is a constant of one of the builtin atomic types
% (string, float, int, character). If so, insert the resulting
@@ -2860,19 +2899,18 @@
Arity = 0,
builtin_atomic_type(Functor, BuiltInTypeName)
->
- construct_type(unqualified(BuiltInTypeName) - 0, [], ConsType),
+ TypeCtor = type_ctor(unqualified(BuiltInTypeName), 0),
+ construct_type(TypeCtor, [], ConsType),
varset.init(ConsTypeVarSet),
ConsInfo = cons_type_info(ConsTypeVarSet, [], ConsType, [],
- EmptyConstraints),
- ConsInfoList2 = [ConsInfo | ConsInfoList1]
+ EmptyConstraints, source_builtin_type(BuiltInTypeName)),
+ BuiltinConsInfos = [ConsInfo]
;
- ConsInfoList2 = ConsInfoList1
+ BuiltinConsInfos = []
),
% Check if Functor is a tuple constructor.
- (
- Functor = cons(unqualified("{}"), TupleArity)
- ->
+ ( Functor = cons(unqualified("{}"), TupleArity) ->
% Make some fresh type variables for the argument types. These have
% kind `star' since there are values (namely the arguments of the
% tuple constructor) which have these types.
@@ -2883,34 +2921,38 @@
prog_type.var_list_to_type_list(map.init, TupleArgTVars,
TupleArgTypes),
- construct_type(unqualified("{}") - TupleArity, TupleArgTypes,
- TupleConsType),
+ TupleTypeCtor = type_ctor(unqualified("{}"), TupleArity),
+ construct_type(TupleTypeCtor, TupleArgTypes, TupleConsType),
% Tuples can't have existentially typed arguments.
TupleExistQVars = [],
- TupleConsInfo = cons_type_info(TupleConsTypeVarSet,
- TupleExistQVars, TupleConsType,
- TupleArgTypes, EmptyConstraints),
- ConsInfoList3 = [TupleConsInfo | ConsInfoList2]
+ TupleConsInfo = cons_type_info(TupleConsTypeVarSet, TupleExistQVars,
+ TupleConsType, TupleArgTypes, EmptyConstraints,
+ source_builtin_type("tuple")),
+ TupleConsInfos = [TupleConsInfo]
;
- ConsInfoList3 = ConsInfoList2
+ TupleConsInfos = []
),
% Check if Functor is the name of a predicate which takes at least
% Arity arguments. If so, insert the resulting cons_type_info
% at the start of the list.
- ( builtin_pred_type(Info, Functor, Arity, GoalPath, PredConsInfoList) ->
- ConsInfoList4 = ConsInfoList3 ++ PredConsInfoList
+ ( builtin_pred_type(Info, Functor, Arity, GoalPath, PredConsInfosPrime) ->
+ PredConsInfos = PredConsInfosPrime
;
- ConsInfoList4 = ConsInfoList3
+ PredConsInfos = []
),
% Check for higher-order function calls.
- ( builtin_apply_type(Info, Functor, Arity, ApplyConsInfoList) ->
- ConsInfoList = ConsInfoList4 ++ ApplyConsInfoList
+ ( builtin_apply_type(Info, Functor, Arity, ApplyConsInfosPrime) ->
+ ApplyConsInfos = ApplyConsInfosPrime
;
- ConsInfoList = ConsInfoList4
- ).
+ ApplyConsInfos = []
+ ),
+
+ OtherConsInfos = BuiltinConsInfos ++ TupleConsInfos
+ ++ PredConsInfos ++ ApplyConsInfos,
+ ConsInfos = DataConsInfos ++ OtherConsInfos.
:- pred split_cons_errors(list(maybe_cons_type_info)::in,
list(cons_type_info)::out, list(cons_error)::out) is det.
@@ -3040,7 +3082,7 @@
make_body_hlds_constraints(ClassTable, ConsTypeVarSet,
GoalPath, ProgConstraints, Constraints),
ConsTypeInfo = ok(cons_type_info(ConsTypeVarSet, ExistQVars,
- ConsType, ArgTypes, Constraints))
+ ConsType, ArgTypes, Constraints, source_type(TypeCtor)))
).
%-----------------------------------------------------------------------------%
Index: compiler/typecheck_errors.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck_errors.m,v
retrieving revision 1.19
diff -u -b -r1.19 typecheck_errors.m
--- compiler/typecheck_errors.m 29 Mar 2006 08:07:28 -0000 1.19
+++ compiler/typecheck_errors.m 15 Apr 2006 13:52:32 -0000
@@ -133,7 +133,7 @@
%-----------------------------------------------------------------------------%
report_pred_call_error(PredCallId, !Info, !IO) :-
- PredCallId = PredOrFunc0 - SymName/_Arity,
+ PredCallId = simple_call_id(PredOrFunc0, SymName, _Arity),
typecheck_info_get_module_info(!.Info, ModuleInfo),
module_info_get_predicate_table(ModuleInfo, PredicateTable),
(
@@ -173,7 +173,8 @@
:- pred report_error_pred_num_args(typecheck_info::in, simple_call_id::in,
list(int)::in, io::di, io::uo) is det.
-report_error_pred_num_args(Info, PredOrFunc - SymName/Arity, Arities, !IO) :-
+report_error_pred_num_args(Info, SimpleCallId, Arities, !IO) :-
+ SimpleCallId = simple_call_id(PredOrFunc, SymName, Arity),
write_context_and_pred_id(Info, !IO),
typecheck_info_get_context(Info, Context),
prog_out.write_context(Context, !IO),
@@ -210,8 +211,8 @@
:- pred report_error_undef_pred(typecheck_info::in, simple_call_id::in,
io::di, io::uo) is det.
-report_error_undef_pred(Info, PredOrFunc - PredCallId, !IO) :-
- PredCallId = PredName/Arity,
+report_error_undef_pred(Info, SimpleCallId, !IO) :-
+ SimpleCallId = simple_call_id(_PredOrFunc, PredName, Arity),
typecheck_info_get_context(Info, Context),
write_typecheck_info_context(Info, !IO),
(
@@ -290,7 +291,7 @@
"a list of variables.\n", !IO)
;
io.write_string(" error: undefined ", !IO),
- write_simple_call_id(PredOrFunc - PredCallId, !IO),
+ write_simple_call_id(SimpleCallId, !IO),
( PredName = qualified(ModuleQualifier, _) ->
maybe_report_missing_import(Info, ModuleQualifier, !IO)
;
@@ -345,22 +346,114 @@
report_warning_too_much_overloading(Info, !IO) :-
typecheck_info_get_context(Info, Context),
make_pred_id_preamble(Info, Preamble),
- SmallWarning = [fixed(Preamble),
- words("warning: highly ambiguous overloading.") ],
+ InitWarning = [fixed(Preamble),
+ words("warning: highly ambiguous overloading."), nl],
+
globals.io_lookup_bool_option(verbose_errors, VerboseErrors, !IO),
(
VerboseErrors = yes,
VerboseWarning = [
- words("This may cause type-checking to be very"),
- words("slow. It may also make your code"),
- words("difficult to understand.") ],
- list.append(SmallWarning, VerboseWarning, Warning)
+ words("This may cause type-checking to be very slow."),
+ words("It may also make your code difficult to understand."), nl],
+ InitVerboseWarning = InitWarning ++ VerboseWarning
;
VerboseErrors = no,
globals.io_set_extra_error_info(yes, !IO),
- Warning = SmallWarning
+ InitVerboseWarning = InitWarning
+ ),
+ FirstSpec = error_msg_spec(yes, Context, 0, InitVerboseWarning),
+
+ typecheck_info_get_overloaded_symbols(Info, OverloadedSymbolSet),
+ set.to_sorted_list(OverloadedSymbolSet, OverloadedSymbols),
+ (
+ OverloadedSymbols = [],
+ Specs = [FirstSpec]
+ ;
+ (
+ OverloadedSymbols = [_],
+ SecondSpecPieces =
+ [words("The following symbol was overloaded"),
+ words("in the following context."), nl]
+ ;
+ OverloadedSymbols = [_, _ | _],
+ SecondSpecPieces =
+ [words("The following symbols were overloaded"),
+ words("in the following contexts."), nl]
),
- error_util.report_warning(Context, 0, Warning, !IO).
+ SecondSpec = error_msg_spec(no, Context, 0, SecondSpecPieces),
+ typecheck_info_get_module_info(Info, ModuleInfo),
+ DetailSpecs = list.map(describe_overloaded_symbol(ModuleInfo),
+ OverloadedSymbols),
+ Specs = [FirstSpec, SecondSpec | DetailSpecs]
+ ),
+ record_warning(!IO),
+ write_error_specs(Specs, !IO).
+
+:- func describe_overloaded_symbol(module_info, overloaded_symbol)
+ = error_msg_spec.
+
+describe_overloaded_symbol(ModuleInfo, Symbol) = Spec :-
+ Symbol = overloaded_symbol(Context, Info),
+ (
+ Info = overloaded_pred(CallId, PredIds),
+ StartPieces = [words("The predicate symbol"),
+ simple_call_id(CallId), suffix("."), nl,
+ words("The possible matches are:"), nl_indent_delta(1)],
+ PredIdPiecesList = list.map(describe_one_pred_name(ModuleInfo,
+ should_module_qualify), PredIds),
+ PredIdPieces = component_list_to_line_pieces(PredIdPiecesList,
+ [suffix(".")]),
+ Pieces = StartPieces ++ PredIdPieces
+ ;
+ Info = overloaded_func(ConsId, Sources),
+ ( ConsId = cons(SymName, Arity) ->
+ ConsIdPiece = sym_name_and_arity(SymName / Arity)
+ ;
+ ConsIdPiece = fixed(cons_id_to_string(ConsId))
+ ),
+ StartPieces = [words("The function symbol"), ConsIdPiece,
+ suffix("."), nl,
+ words("The possible matches are:"), nl_indent_delta(1)],
+ SourcePiecesList = list.map(describe_cons_type_info_source(ModuleInfo),
+ Sources),
+ SourcePieces = component_list_to_line_pieces(SourcePiecesList,
+ [suffix(".")]),
+ Pieces = StartPieces ++ SourcePieces
+ ),
+ Spec = error_msg_spec(no, Context, 0, Pieces).
+
+:- func describe_cons_type_info_source(module_info, cons_type_info_source)
+ = list(format_component).
+
+describe_cons_type_info_source(ModuleInfo, Source) = Pieces :-
+ (
+ Source = source_type(TypeCtor),
+ TypeCtor = type_ctor(SymName, Arity),
+ Pieces = [words("the type constructor"),
+ sym_name_and_arity(SymName / Arity)]
+ ;
+ Source = source_builtin_type(TypeCtorName),
+ Pieces = [words("the builtin type constructor"), quote(TypeCtorName)]
+ ;
+ Source = source_get_field_access(TypeCtor),
+ TypeCtor = type_ctor(SymName, Arity),
+ Pieces = [words("a `get' field access function"),
+ words("for the type constructor"),
+ sym_name_and_arity(SymName / Arity)]
+ ;
+ Source = source_set_field_access(TypeCtor),
+ TypeCtor = type_ctor(SymName, Arity),
+ Pieces = [words("a `set' field access function"),
+ words("for the type constructor"),
+ sym_name_and_arity(SymName / Arity)]
+ ;
+ Source = source_pred(PredId),
+ Pieces = describe_one_pred_name(ModuleInfo, should_module_qualify,
+ PredId)
+ ;
+ Source = source_apply(ApplyOp),
+ Pieces = [words("the builtin operator constructor"), quote(ApplyOp)]
+ ).
%-----------------------------------------------------------------------------%
@@ -558,12 +651,11 @@
% can affect the valid types for the arguments.
%
(
- % could the type of the functor be polymorphic?
+ % Could the type of the functor be polymorphic?
list.member(ConsDefn, ConsDefnList),
- ConsDefn = cons_type_info(_, _, _, ConsArgTypes, _),
- ConsArgTypes \= []
+ ConsDefn ^ cti_arg_types = [_ | _]
->
- % if so, print out the type of `Var'
+ % If so, print out the type of `Var'.
prog_out.write_context(Context, !IO),
io.write_string(" ", !IO),
write_argument_name(VarSet, Var, !IO),
@@ -1039,7 +1131,8 @@
report_cons_error(Context, ConsError, !IO) :-
(
- ConsError = foreign_type_constructor(TypeName - TypeArity, _),
+ ConsError = foreign_type_constructor(TypeCtor, _),
+ TypeCtor = type_ctor(TypeName, TypeArity),
Pieces = [words("There are"),
fixed("`:- pragma foreign_type'"),
words("declarations for type"),
@@ -1089,7 +1182,7 @@
write_error_pieces_not_first_line(DefnContext, 0, Pieces, !IO)
;
ConsError = new_on_non_existential_type(TypeCtor),
- TypeCtor = TypeName - TypeArity,
+ TypeCtor = type_ctor(TypeName, TypeArity),
Pieces = [words("Invalid use of `new'"),
words("on a constructor of type"),
sym_name_and_arity(TypeName / TypeArity),
@@ -1322,8 +1415,8 @@
io::di, io::uo) is det.
% XXX Should we mention the context here?
-write_cons_type(cons_type_info(TVarSet, ExistQVars, ConsType, ArgTypes, _),
- Functor, _, !IO) :-
+write_cons_type(ConsInfo, Functor, _, !IO) :-
+ ConsInfo = cons_type_info(TVarSet, ExistQVars, ConsType, ArgTypes, _, _),
(
ArgTypes = [_ | _],
(
Index: compiler/typecheck_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck_info.m,v
retrieving revision 1.9
diff -u -b -r1.9 typecheck_info.m
--- compiler/typecheck_info.m 29 Mar 2006 08:07:28 -0000 1.9
+++ compiler/typecheck_info.m 15 Apr 2006 08:01:37 -0000
@@ -29,6 +29,7 @@
:- import_module bool.
:- import_module io.
:- import_module list.
+:- import_module set.
%-----------------------------------------------------------------------------%
%
@@ -80,11 +81,32 @@
found_error :: bool,
% Did we find any type errors?
+ overloaded_symbols :: set(overloaded_symbol),
+ % The set of symbols used by the current
+ % predicate that have more than one accessible
+ % definition.
+
warned_about_overloading :: bool
% Have we already warned about highly
% ambiguous overloading?
).
+:- type overloaded_symbol
+ ---> overloaded_symbol(
+ prog_context,
+ overloaded_symbol_info
+ ).
+
+:- type overloaded_symbol_info
+ ---> overloaded_pred(
+ simple_call_id,
+ list(pred_id)
+ )
+ ; overloaded_func(
+ cons_id,
+ list(cons_type_info_source)
+ ).
+
%-----------------------------------------------------------------------------%
%
% typecheck_info initialisation and finalisation.
@@ -141,6 +163,8 @@
:- pred typecheck_info_get_found_error(typecheck_info::in, bool::out) is det.
:- pred typecheck_info_get_warned_about_overloading(typecheck_info::in,
bool::out) is det.
+:- pred typecheck_info_get_overloaded_symbols(typecheck_info::in,
+ set(overloaded_symbol)::out) is det.
:- pred typecheck_info_get_pred_import_status(typecheck_info::in,
import_status::out) is det.
@@ -158,6 +182,8 @@
typecheck_info::in, typecheck_info::out) is det.
:- pred typecheck_info_set_warned_about_overloading(bool::in,
typecheck_info::in, typecheck_info::out) is det.
+:- pred typecheck_info_set_overloaded_symbols(set(overloaded_symbol)::in,
+ typecheck_info::in, typecheck_info::out) is det.
:- pred typecheck_info_set_pred_import_status(import_status::in,
typecheck_info::in, typecheck_info::out) is det.
@@ -275,16 +301,37 @@
:- type cons_type_info
---> cons_type_info(
- tvarset, % Type variables.
- existq_tvars, % Existentially quantified type vars.
- mer_type, % Constructor type.
- list(mer_type), % Types of the arguments.
- hlds_constraints % Constraints introduced by this
+ cti_varset :: tvarset,
+ % Type variables.
+
+ cti_exit_tvars :: existq_tvars,
+ % Existentially quantified type vars.
+
+ cti_result_type :: mer_type,
+ % Constructor type.
+
+ cti_arg_types :: list(mer_type),
+ % Types of the arguments.
+
+ cti_constraints :: hlds_constraints,
+ % Constraints introduced by this
% constructor (e.g. if it is actually
% a function, or if it is an existentially
% quantified data constructor).
+
+ cti_source :: cons_type_info_source
).
+:- type cons_type_info_source
+ ---> source_type(type_ctor)
+ ; source_builtin_type(string)
+ ; source_get_field_access(type_ctor)
+ ; source_set_field_access(type_ctor)
+ ; source_apply(string)
+ ; source_pred(pred_id).
+
+:- func project_cons_type_info_source(cons_type_info) = cons_type_info_source.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -308,20 +355,20 @@
typecheck_info_init(ModuleInfo, PredId, IsFieldAccessFunction,
TypeVarSet, VarSet, VarTypes, HeadTypeParams,
Constraints, Status, Markers, Info) :-
- CallPredId = call(predicate - unqualified("") / 0),
+ CallPredId = call(simple_call_id(predicate, unqualified(""), 0)),
term.context_init(Context),
map.init(TypeBindings),
map.init(Proofs),
map.init(ConstraintMap),
FoundTypeError = no,
WarnedAboutOverloading = no,
- Info = typecheck_info(
- ModuleInfo, CallPredId, 0, PredId, Status, Markers,
+ set.init(OverloadedSymbols),
+ Info = typecheck_info(ModuleInfo, CallPredId, 0, PredId, Status, Markers,
IsFieldAccessFunction, Context,
unify_context(explicit, []), VarSet,
[type_assign(VarTypes, TypeVarSet, HeadTypeParams,
TypeBindings, Constraints, Proofs, ConstraintMap)],
- FoundTypeError, WarnedAboutOverloading
+ FoundTypeError, OverloadedSymbols, WarnedAboutOverloading
).
typecheck_info_get_final_info(Info, OldHeadTypeParams, OldExistQVars,
@@ -493,6 +540,7 @@
typecheck_info_get_found_error(Info, Info ^ found_error).
typecheck_info_get_warned_about_overloading(Info,
Info ^ warned_about_overloading).
+typecheck_info_get_overloaded_symbols(Info, Info ^ overloaded_symbols).
typecheck_info_get_pred_import_status(Info, Info ^ import_status).
typecheck_info_set_called_predid(PredCallId, Info,
@@ -507,6 +555,8 @@
Info ^ found_error := FoundError).
typecheck_info_set_warned_about_overloading(Warned, Info,
Info ^ warned_about_overloading := Warned).
+typecheck_info_set_overloaded_symbols(Symbols, Info,
+ Info ^ overloaded_symbols := Symbols).
typecheck_info_set_pred_import_status(Status, Info,
Info ^ import_status := Status).
@@ -552,12 +602,12 @@
varnums = yes.
-write_type_assign_set([], _) --> [].
-write_type_assign_set([TypeAssign | TypeAssigns], VarSet) -->
- io.write_string("\t"),
- write_type_assign(TypeAssign, VarSet),
- io.write_string("\n"),
- write_type_assign_set(TypeAssigns, VarSet).
+write_type_assign_set([], _, !IO).
+write_type_assign_set([TypeAssign | TypeAssigns], VarSet, !IO) :-
+ io.write_string("\t", !IO),
+ write_type_assign(TypeAssign, VarSet, !IO),
+ io.write_string("\n", !IO),
+ write_type_assign_set(TypeAssigns, VarSet, !IO).
:- pred write_type_assign(type_assign::in, prog_varset::in, io::di, io::uo)
is det.
@@ -635,11 +685,9 @@
FoundOne = yes,
io.write_string(",\n\t ", !IO)
),
- apply_rec_subst_to_constraint(TypeBindings, Constraint,
- BoundConstraint),
+ apply_rec_subst_to_constraint(TypeBindings, Constraint, BoundConstraint),
retrieve_prog_constraint(BoundConstraint, ProgConstraint),
- mercury_output_constraint(TypeVarSet, varnums, ProgConstraint,
- !IO),
+ mercury_output_constraint(TypeVarSet, varnums, ProgConstraint, !IO),
write_type_assign_constraints(Operator, Constraints, TypeBindings,
TypeVarSet, yes, !IO).
@@ -699,6 +747,8 @@
get_caller_arg_assign(ArgsTypeAssign) = ArgsTypeAssign ^ caller_arg_assign.
get_callee_arg_types(ArgsTypeAssign) = ArgsTypeAssign ^ callee_arg_types.
get_callee_constraints(ArgsTypeAssign) = ArgsTypeAssign ^ callee_constraints.
+
+project_cons_type_info_source(CTI) = CTI ^ cti_source.
%-----------------------------------------------------------------------------%
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_gen.m,v
retrieving revision 1.165
diff -u -b -r1.165 unify_gen.m
--- compiler/unify_gen.m 30 Mar 2006 02:46:00 -0000 1.165
+++ compiler/unify_gen.m 15 Apr 2006 07:40:41 -0000
@@ -1096,8 +1096,8 @@
var_type_msg(Type, Msg) :-
( type_to_ctor_and_args(Type, TypeCtor, _) ->
- TypeCtor = TypeSym - TypeArity,
- mdbcomp.prim_data.sym_name_to_string(TypeSym, TypeSymStr),
+ TypeCtor = type_ctor(TypeSym, TypeArity),
+ sym_name_to_string(TypeSym, TypeSymStr),
string.int_to_string(TypeArity, TypeArityStr),
string.append_list([TypeSymStr, "/", TypeArityStr], Msg)
;
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.164
diff -u -b -r1.164 unify_proc.m
--- compiler/unify_proc.m 29 Mar 2006 08:07:28 -0000 1.164
+++ compiler/unify_proc.m 15 Apr 2006 08:42:21 -0000
@@ -270,8 +270,9 @@
module_info_get_maybe_recompilation_info(!.ModuleInfo, MaybeRecompInfo0),
(
MaybeRecompInfo0 = yes(RecompInfo0),
- recompilation.record_used_item(type_body_item, TypeCtor, TypeCtor,
- RecompInfo0, RecompInfo),
+ TypeCtorItem = type_ctor_to_item_name(TypeCtor),
+ recompilation.record_used_item(type_body_item,
+ TypeCtorItem, TypeCtorItem, RecompInfo0, RecompInfo),
module_info_set_maybe_recompilation_info(yes(RecompInfo), !ModuleInfo)
;
MaybeRecompInfo0 = no
@@ -287,7 +288,7 @@
map.search(TypeTable, TypeCtor, TypeDefn),
hlds_data.get_type_defn_body(TypeDefn, TypeBody),
(
- TypeCtor = TypeName - _TypeArity,
+ TypeCtor = type_ctor(TypeName, _TypeArity),
TypeName = qualified(TypeModuleName, _),
module_info_get_name(!.ModuleInfo, ModuleName),
ModuleName = TypeModuleName,
@@ -316,7 +317,7 @@
% For polymorphic types, add extra modes for the type_infos.
in_mode(InMode),
- TypeCtor = _ - TypeArity,
+ TypeCtor = type_ctor(_, TypeArity),
list.duplicate(TypeArity, InMode, TypeInfoModes),
list.append(TypeInfoModes, ArgModes0, ArgModes),
@@ -490,7 +491,7 @@
add_lazily_generated_unify_pred(TypeCtor, PredId, !ModuleInfo) :-
( type_ctor_is_tuple(TypeCtor) ->
- TypeCtor = _ - TupleArity,
+ TypeCtor = type_ctor(_, TupleArity),
% Build a hlds_type_body for the tuple constructor, which will
% be used by generate_clause_info.
@@ -711,7 +712,7 @@
),
PredName = special_pred.special_pred_name(spec_pred_init, TypeCtor),
hlds_module.module_info_get_name(ModuleInfo, ModuleName),
- TypeCtor = TypeSymName - _TypeArity,
+ TypeCtor = type_ctor(TypeSymName, _TypeArity),
sym_name_get_module_name(TypeSymName, ModuleName, TypeModuleName),
InitPred = qualified(TypeModuleName, PredName),
PredId = invalid_pred_id,
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
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/recompilation
Index: tests/recompilation/add_constructor_r.err_exp.2
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/recompilation/add_constructor_r.err_exp.2,v
retrieving revision 1.2
diff -u -b -r1.2 add_constructor_r.err_exp.2
--- tests/recompilation/add_constructor_r.err_exp.2 18 Jan 2003 17:02:10 -0000 1.2
+++ tests/recompilation/add_constructor_r.err_exp.2 16 Apr 2006 21:16:27 -0000
@@ -1,3 +1,3 @@
Recompiling module `add_constructor_r':
- addition of constructor `c/1' of type `add_constructor_r_2.bar/0' could cause
- an ambiguity with constructor `c/1' of type `add_constructor_r.t/0'.
+ addition of constructor `c'/1 of type `add_constructor_r_2.bar'/0 could cause
+ an ambiguity with constructor `c'/1 of type `add_constructor_r.t'/0.
Index: tests/recompilation/field_r.err_exp.2
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/recompilation/field_r.err_exp.2,v
retrieving revision 1.2
diff -u -b -r1.2 field_r.err_exp.2
--- tests/recompilation/field_r.err_exp.2 18 Jan 2003 17:02:10 -0000 1.2
+++ tests/recompilation/field_r.err_exp.2 16 Apr 2006 21:17:46 -0000
@@ -1,4 +1,4 @@
Recompiling module `field_r':
- addition of field access function `f/1' for constructor `field_r_2.t3/1' of
- type `field_r_2.t3/0' could cause an ambiguity with constructor `f/1' of type
- `field_r.t/0'.
+ addition of field access function `f'/1 for constructor `field_r_2.t3'/1 of
+ type `field_r_2.t3'/0 could cause an ambiguity with constructor `f'/1 of type
+ `field_r.t'/0.
Index: tests/recompilation/func_overloading_r.err_exp.2
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/recompilation/func_overloading_r.err_exp.2,v
retrieving revision 1.2
diff -u -b -r1.2 func_overloading_r.err_exp.2
--- tests/recompilation/func_overloading_r.err_exp.2 18 Jan 2003 17:02:10 -0000 1.2
+++ tests/recompilation/func_overloading_r.err_exp.2 16 Apr 2006 21:18:00 -0000
@@ -1,3 +1,3 @@
Recompiling module `func_overloading_r':
- addition of function `func_overloading_r_2.f/1' could cause an ambiguity with
- constructor `f/1' of type `func_overloading_r.t/0'.
+ addition of function `func_overloading_r_2.f'/1 could cause an ambiguity with
+ constructor `f'/1 of type `func_overloading_r.t'/0.
Index: tests/recompilation/pred_ctor_ambiguity_r.err_exp.2
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/recompilation/pred_ctor_ambiguity_r.err_exp.2,v
retrieving revision 1.2
diff -u -b -r1.2 pred_ctor_ambiguity_r.err_exp.2
--- tests/recompilation/pred_ctor_ambiguity_r.err_exp.2 18 Jan 2003 17:02:10 -0000 1.2
+++ tests/recompilation/pred_ctor_ambiguity_r.err_exp.2 16 Apr 2006 21:18:34 -0000
@@ -1,3 +1,3 @@
Recompiling module `pred_ctor_ambiguity_r':
- addition of predicate `pred_ctor_ambiguity_r_2.c/2' could cause an ambiguity
- with constructor `c/1' of type `pred_ctor_ambiguity_r.t/0'.
+ addition of predicate `pred_ctor_ambiguity_r_2.c'/2 could cause an ambiguity
+ with constructor `c'/1 of type `pred_ctor_ambiguity_r.t'/0.
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/ambiguous_overloading.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/warnings/ambiguous_overloading.exp,v
retrieving revision 1.3
diff -u -b -r1.3 ambiguous_overloading.exp
--- tests/warnings/ambiguous_overloading.exp 14 May 2004 08:40:33 -0000 1.3
+++ tests/warnings/ambiguous_overloading.exp 16 Apr 2006 21:28:53 -0000
@@ -1,2 +1,63 @@
-ambiguous_overloading.m:015: In clause for predicate `ambig_overload/1':
-ambiguous_overloading.m:015: warning: highly ambiguous overloading.
+ambiguous_overloading.m:041: In clause for predicate `ambig_overload1/1':
+ambiguous_overloading.m:041: warning: highly ambiguous overloading.
+ambiguous_overloading.m:041: The following symbol was overloaded in the
+ambiguous_overloading.m:041: following context.
+ambiguous_overloading.m:041: The function symbol `f'/0.
+ambiguous_overloading.m:041: The possible matches are:
+ambiguous_overloading.m:041: the type constructor
+ambiguous_overloading.m:041: `ambiguous_overloading.foo'/0,
+ambiguous_overloading.m:041: the type constructor
+ambiguous_overloading.m:041: `ambiguous_overloading.bar'/0,
+ambiguous_overloading.m:041: the builtin type constructor `character'.
+ambiguous_overloading.m:045: In clause for predicate `ambig_overload2/1':
+ambiguous_overloading.m:045: warning: highly ambiguous overloading.
+ambiguous_overloading.m:045: The following symbols were overloaded in the
+ambiguous_overloading.m:045: following contexts.
+ambiguous_overloading.m:045: The function symbol `a1'/0.
+ambiguous_overloading.m:045: The possible matches are:
+ambiguous_overloading.m:045: the type constructor
+ambiguous_overloading.m:045: `ambiguous_overloading.qux'/0,
+ambiguous_overloading.m:045: the type constructor
+ambiguous_overloading.m:045: `ambiguous_overloading.baz'/0.
+ambiguous_overloading.m:045: The function symbol `a2'/0.
+ambiguous_overloading.m:045: The possible matches are:
+ambiguous_overloading.m:045: the type constructor
+ambiguous_overloading.m:045: `ambiguous_overloading.qux'/0,
+ambiguous_overloading.m:045: the type constructor
+ambiguous_overloading.m:045: `ambiguous_overloading.baz'/0.
+ambiguous_overloading.m:055: In clause for predicate `test_lt/1': warning:
+ambiguous_overloading.m:055: highly ambiguous overloading.
+ambiguous_overloading.m:055: The following symbols were overloaded in the
+ambiguous_overloading.m:055: following contexts.
+ambiguous_overloading.m:050: The predicate symbol predicate `</2'.
+ambiguous_overloading.m:050: The possible matches are:
+ambiguous_overloading.m:050: predicate `float.</2',
+ambiguous_overloading.m:050: predicate `int.</2'.
+ambiguous_overloading.m:051: The predicate symbol predicate `</2'.
+ambiguous_overloading.m:051: The possible matches are:
+ambiguous_overloading.m:051: predicate `float.</2',
+ambiguous_overloading.m:051: predicate `int.</2'.
+ambiguous_overloading.m:052: The predicate symbol predicate `</2'.
+ambiguous_overloading.m:052: The possible matches are:
+ambiguous_overloading.m:052: predicate `float.</2',
+ambiguous_overloading.m:052: predicate `int.</2'.
+ambiguous_overloading.m:053: The predicate symbol predicate `</2'.
+ambiguous_overloading.m:053: The possible matches are:
+ambiguous_overloading.m:053: predicate `float.</2',
+ambiguous_overloading.m:053: predicate `int.</2'.
+ambiguous_overloading.m:054: The predicate symbol predicate `</2'.
+ambiguous_overloading.m:054: The possible matches are:
+ambiguous_overloading.m:054: predicate `float.</2',
+ambiguous_overloading.m:054: predicate `int.</2'.
+ambiguous_overloading.m:055: The predicate symbol predicate `</2'.
+ambiguous_overloading.m:055: The possible matches are:
+ambiguous_overloading.m:055: predicate `float.</2',
+ambiguous_overloading.m:055: predicate `int.</2'.
+ambiguous_overloading.m:071: In clause for predicate `set_browser_param_from_option_table/3':
+ambiguous_overloading.m:071: warning: highly ambiguous overloading.
+ambiguous_overloading.m:071: The following symbol was overloaded in the
+ambiguous_overloading.m:071: following context.
+ambiguous_overloading.m:071: The function symbol `lookup_bool_option'/2.
+ambiguous_overloading.m:071: The possible matches are:
+ambiguous_overloading.m:071: predicate `getopt.lookup_bool_option/3',
+ambiguous_overloading.m:071: function `getopt.lookup_bool_option/2'.
Index: tests/warnings/ambiguous_overloading.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/warnings/ambiguous_overloading.m,v
retrieving revision 1.1
diff -u -b -r1.1 ambiguous_overloading.m
--- tests/warnings/ambiguous_overloading.m 19 Apr 2000 07:26:31 -0000 1.1
+++ tests/warnings/ambiguous_overloading.m 15 Apr 2006 13:22:39 -0000
@@ -2,16 +2,83 @@
:- module ambiguous_overloading.
:- interface.
+
+:- import_module getopt.
+:- import_module io.
:- import_module list.
:- type foo ---> f ; g.
:- type bar ---> f ; h.
-:- pred ambig_overload(list(foo)::out) is det.
+:- pred ambig_overload1(list(foo)::out) is det.
+
+:- type baz ---> a1 ; a2 ; a3.
+:- type qux ---> a1 ; a2 ; a4.
+
+:- pred ambig_overload2(list(baz)::out) is det.
+
+:- pred test_lt(int::out) is det.
+
+:- type set_param
+ ---> set_print
+ ; set_browse
+ ; set_print_all
+ ; set_flat
+ ; set_raw_pretty
+ ; set_verbose
+ ; set_pretty.
+
+:- pred set_browser_param_from_option_table(option_table(set_param)::in,
+ io::di, io::uo) is det.
:- implementation.
-ambig_overload(L) :-
+:- import_module bool.
+:- import_module int.
+:- import_module float.
+
+ambig_overload1(L) :-
A = f, B = f, C = f, D = f, E = f, F = f, G = f,
L = [A, B, C, D, E, F, G].
+ambig_overload2(L) :-
+ A = a1, B = a1, C = a2, D = a2, E = a1, F = a1, G = a2,
+ L = [A, B, C, D, E, F, G].
+
+test_lt(X) :-
+ (
+ X1 < Y1,
+ X2 < Y2,
+ X3 < Y3,
+ X4 < Y4,
+ X5 < Y5,
+ X6 < Y6,
+ X7 < Y7,
+ X1 = 1, Y1 = 11,
+ X2 = 2, Y2 = 12,
+ X3 = 3, Y3 = 13,
+ X4 = 4.0, Y4 = 14.0,
+ X5 = 5.0, Y5 = 15.0,
+ X6 = 6.0, Y6 = 16.0,
+ X7 = 7.0, Y7 = 17.0
+ ->
+ X = 0
+ ;
+ X = 1
+ ).
+
+set_browser_param_from_option_table(OptionTable, !IO) :-
+ set_browser_param(
+ lookup_bool_option(OptionTable, set_print),
+ lookup_bool_option(OptionTable, set_browse),
+ lookup_bool_option(OptionTable, set_print_all),
+ lookup_bool_option(OptionTable, set_flat),
+ lookup_bool_option(OptionTable, set_raw_pretty),
+ lookup_bool_option(OptionTable, set_verbose),
+ lookup_bool_option(OptionTable, set_pretty),
+ !IO).
+
+:- pred set_browser_param(bool::in, bool::in, bool::in, bool::in,
+ bool::in, bool::in, bool::in, io::di, io::uo) is det.
+
+set_browser_param(_, _, _, _, _, _, _, !IO).
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list