[m-rev.] for review: centralize compiler's knowledge of __Unify__ etc names
Zoltan Somogyi
zs at cs.mu.OZ.AU
Sat May 24 22:51:51 AEST 2003
For review by anyone.
Zoltan.
Instead of being relied on all over the place, centralize the compiler's
knowledge of the names of unify, compare and index predicates in one place,
special_pred.m. This should make it easy to change the naming scheme once
we switch over to compiler-generated type_ctor_infos for builtin types,
which will eliminate the runtime system's knowledge of the naming scheme.
compiler/hlds_pred.m:
Add a field to pred_infos that says whether the predicate is a unify,
compare or index predicate, and if so, for which type constructor.
Code that used to test the predicate's name for __Unify__ etc now
tests this field instead. Similarly the code that used to employ
devious tricks to find out the type the unify/compare/index predicate
is for.
compiler/rtti.m:
Include this field in rtti_proc_labels as well as pred_infos.
compiler/make_hlds.m:
Fill in this field as appropriate.
compiler/proc_label.m:
Replace the predicate name with special_pred_id in the proc_labels
of unify, index and compare preds.
compiler/special_pred.m:
Narrow the interface to prevent reliance on the naming scheme
for compiler-generated unify, compare and index predicates,
except when absolutely necessary, i.e. when creating names for
them.
Narrow the mechanism required to reverse-engineer the type constructor
a unify/compare/index predicate is for from the types to the
functionality required by higher_order.m.
compiler/code_gen.m:
compiler/det_report.m:
compiler/higher_order.m:
compiler/intermod.m:
compiler/layout_out.m:
compiler/magic_util.m:
compiler/ml_code_util.m:
compiler/name_mangle.m:
compiler/opt_debug.m:
compiler/opt_util.m:
compiler/optimize.m:
compiler/polymorphism.m:
compiler/post_typecheck.m:
compiler/proc_label.m:
compiler/rl_exprn.m:
compiler/rl_key.m:
compiler/simplify.m:
compiler/termination.m:
compiler/typecheck.m:
compiler/unify_proc.m:
compiler/unused_args.m:
Update code and comments to conform to the changes above.
compiler/hlds_out.m:
Don't refer to the 'type' that a unify, compare or index predicate
is for; refer to the type *constructor*.
compiler/mlds_to_java.m:
Delete an unused predicate.
tests/invalid/purity/purity.err_exp:
Update this expected output for the change in hlds_out.m.
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/code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_gen.m,v
retrieving revision 1.113
diff -u -b -r1.113 code_gen.m
--- compiler/code_gen.m 20 May 2003 16:20:41 -0000 1.113
+++ compiler/code_gen.m 23 May 2003 08:44:47 -0000
@@ -396,8 +396,11 @@
% doesn't need; work out which is and isn't needed and put
% inside the else case below
GenBytecode = yes,
- % We don't generate bytecode for __Unify__, __Compare__ etc
- % Since we will assume this code is already correct
+ % We don't generate bytecode for unify and compare preds.
+ % The automatically generated unify and compare predicates
+ % are correct by construction; for user-defined unify and
+ % compare predicates, we *assume* their correctness for now
+ % (perhaps not wisely).
\+ is_unify_or_compare_pred(PredInfo),
% Don't generate bytecode for procs with foreign code
goal_has_foreign(Goal) = no
@@ -1341,11 +1344,12 @@
pred_info_module(PredInfo, ModuleName),
pred_info_name(PredInfo, PredName),
pred_info_arity(PredInfo, Arity),
- ( special_pred_name_arity(_, _, PredName, Arity) ->
- pred_info_arg_types(PredInfo, ArgTypes),
- special_pred_get_type_det(PredName, ArgTypes, Type),
- code_gen__find_arg_type_ctor_name(Type, TypeName),
- string__append_list([PredName, "for_", TypeName], FullPredName)
+ pred_info_get_maybe_special_pred(PredInfo, MaybeSpecial),
+ ( MaybeSpecial = yes(SpecialId - TypeCtor) ->
+ code_gen__find_arg_type_ctor_name(TypeCtor, TypeName),
+ special_pred_name_arity(SpecialId, SpecialPredName, _),
+ string__append_list([SpecialPredName, "_for_", TypeName],
+ FullPredName)
;
FullPredName = PredName
),
@@ -1361,16 +1365,12 @@
string__append_list([PredOrFuncString, " ", ModuleNameString, ".",
FullPredName, "/", ArityStr, "-", ProcNumStr], PushMsg).
-:- pred code_gen__find_arg_type_ctor_name((type)::in, string::out) is det.
+:- pred code_gen__find_arg_type_ctor_name((type_ctor)::in, string::out) is det.
-code_gen__find_arg_type_ctor_name(Type, TypeName) :-
- ( type_to_ctor_and_args(Type, TypeCtor, _) ->
+code_gen__find_arg_type_ctor_name(TypeCtor, TypeName) :-
TypeCtor = TypeCtorSymName - TypeCtorArity,
prog_out__sym_name_to_string(TypeCtorSymName, TypeCtorName),
string__int_to_string(TypeCtorArity, ArityStr),
- string__append_list([TypeCtorName, "_", ArityStr], TypeName)
- ;
- TypeName = "unknown"
- ).
+ string__append_list([TypeCtorName, "_", ArityStr], TypeName).
%---------------------------------------------------------------------------%
Index: compiler/det_report.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_report.m,v
retrieving revision 1.79
diff -u -b -r1.79 det_report.m
--- compiler/det_report.m 21 Mar 2003 05:52:05 -0000 1.79
+++ compiler/det_report.m 13 May 2003 10:31:08 -0000
@@ -143,6 +143,7 @@
:- import_module hlds__hlds_data.
:- import_module hlds__hlds_out.
:- import_module hlds__passes_aux.
+:- import_module hlds__special_pred.
:- import_module libs__globals.
:- import_module libs__options.
:- import_module parse_tree__mercury_to_mercury.
@@ -886,14 +887,15 @@
{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
{ pred_info_name(PredInfo, PredName) },
{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
+ { pred_info_get_maybe_special_pred(PredInfo, MaybeSpecial) },
%
- % if the error was in a call to __Unify__ (i.e. in the unification
- % itself), then don't print out the predicate name, just print
- % out the context. If it wasn't, then print them both out.
- % (The latter can happen if there is a determinism error in a
- % function call inside some unification.)
+ % if the error was in a call to a type-specific unification predicate
+ % (i.e. in the unification itself), then don't print out the predicate
+ % name, just print out the context. If it wasn't, then print them
+ % both out. (The latter can happen if there is a determinism error
+ % in a function call inside some unification.)
%
- ( { PredName = "__Unify__" } ->
+ ( { MaybeSpecial = yes(unify - _) } ->
(
{ CallUnifyContext = yes(
call_unify_context(LT, RT, UC)) },
@@ -901,12 +903,13 @@
det_report_unify_context(First, Last,
Context, UC, DetInfo, LT, RT)
;
- % this shouldn't happen; every call to __Unify__
+ % this shouldn't happen; every call to a compiler
+ % generated type-specific unification predicate
% should have a unify_context
{ CallUnifyContext = no },
prog_out__write_context(Context),
io__write_string(
- " Some weird unification (or explicit call to `__Unify__'?)")
+ " Some weird unification (or explicit call to a type-specific unify predicate?)")
)
;
(
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.106
diff -u -b -r1.106 higher_order.m
--- compiler/higher_order.m 17 May 2003 04:31:51 -0000 1.106
+++ compiler/higher_order.m 19 May 2003 05:36:32 -0000
@@ -1876,8 +1876,8 @@
pred_info_module(CalledPredInfo, PublicBuiltin),
pred_info_name(CalledPredInfo, PredName),
pred_info_arity(CalledPredInfo, PredArity),
- special_pred_name_arity(SpecialId, PredName, _, PredArity),
- special_pred_get_type(PredName, Args, Var),
+ special_pred_name_arity(SpecialId, PredName, PredArity),
+ special_pred_get_type(SpecialId, Args, Var),
map__lookup(VarTypes, Var, SpecialPredType),
SpecialPredType \= term__variable(_),
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.308
diff -u -b -r1.308 hlds_out.m
--- compiler/hlds_out.m 19 May 2003 14:24:23 -0000 1.308
+++ compiler/hlds_out.m 20 May 2003 09:21:25 -0000
@@ -64,11 +64,11 @@
% hlds_out__write_pred_id/4 writes out a message such as
% predicate `foo:bar/3'
% or function `foo:myfoo/5'
- % unless the predicate name begins with a double underscore "__",
- % in which case mercury_output_term is used to print out the
- % predicate's (or function's) name and argument types (since for
- % `__Unify__' predicates, the module, name and arity are not
- % sufficient to indentify the predicate).
+ % unless the predicate is a special (unify, compare or index)
+ % predicate, in which case mercury_output_term is used to print out
+ % the predicate's name and argument types (since for such predicates,
+ % the module, name and arity are not sufficient to identify the
+ % predicate).
:- pred hlds_out__write_pred_id(module_info, pred_id, io__state, io__state).
:- mode hlds_out__write_pred_id(in, in, di, uo) is det.
@@ -371,19 +371,14 @@
{ pred_info_name(PredInfo, Name) },
{ pred_info_arity(PredInfo, Arity) },
{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
+ { pred_info_get_maybe_special_pred(PredInfo, MaybeSpecial) },
(
- { special_pred_name_arity(Kind, _, Name, Arity) }
+ { MaybeSpecial = yes(SpecialId - TypeCtor) }
->
- { special_pred_description(Kind, Descr) },
+ { special_pred_description(SpecialId, Descr) },
io__write_string(Descr),
- io__write_string(" for type "),
- { pred_info_arg_types(PredInfo, TVarSet, _ExistQVars,
- ArgTypes) },
- ( { special_pred_get_type(Name, ArgTypes, Type) } ->
- mercury_output_term(Type, TVarSet, no)
- ;
- { error("special_pred_get_type failed!") }
- )
+ io__write_string(" for type constructor "),
+ hlds_out__write_type_name(TypeCtor)
;
{ pred_info_get_markers(PredInfo, Markers) },
{ check_marker(Markers, class_instance_method) }
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.125
diff -u -b -r1.125 hlds_pred.m
--- compiler/hlds_pred.m 20 May 2003 16:20:41 -0000 1.125
+++ compiler/hlds_pred.m 23 May 2003 08:44:47 -0000
@@ -18,6 +18,7 @@
:- import_module hlds__hlds_goal.
:- import_module hlds__hlds_llds.
:- import_module hlds__hlds_module.
+:- import_module hlds__special_pred.
:- import_module hlds__instmap.
:- import_module libs__globals.
:- import_module parse_tree__prog_data.
@@ -835,6 +836,13 @@
:- pred pred_info_set_assertions(pred_info, set(assert_id), pred_info).
:- mode pred_info_set_assertions(in, in, out) is det.
+:- pred pred_info_get_maybe_special_pred(pred_info, maybe(special_pred)).
+:- mode pred_info_get_maybe_special_pred(in, out) is det.
+
+:- pred pred_info_set_maybe_special_pred(pred_info, maybe(special_pred),
+ pred_info).
+:- mode pred_info_set_maybe_special_pred(in, in, out) is det.
+
:- pred pred_info_get_maybe_instance_method_constraints(pred_info,
maybe(instance_method_constraints)).
:- mode pred_info_get_maybe_instance_method_constraints(in, out) is det.
@@ -1078,6 +1086,10 @@
assertions :: set(assert_id),
% List of assertions which
% mention this predicate.
+ maybe_special_pred :: maybe(special_pred),
+ % If the predicate is a unify, compare
+ % or index predicate, specify which
+ % one, and for which type constructor.
maybe_instance_method_constraints
:: maybe(instance_method_constraints)
% If this predicate is a class method
@@ -1101,13 +1113,14 @@
UnprovenBodyConstraints = [],
Indexes = [],
set__init(Assertions),
+ MaybeUCI = no,
MaybeInstanceConstraints = no,
PredInfo = predicate(TypeVarSet, Types, Cond, ClausesInfo, Procs,
Context, PredModuleName, PredName, Arity, Status, TypeVarSet,
GoalType, Markers, Attributes, PredOrFunc, ClassContext,
ClassProofs, ExistQVars, HeadTypeParams,
UnprovenBodyConstraints, User, Indexes, Assertions,
- MaybeInstanceConstraints).
+ MaybeUCI, MaybeInstanceConstraints).
pred_info_create(ModuleName, SymName, TypeVarSet, ExistQVars, Types, Cond,
Context, Status, Markers, PredOrFunc, ClassContext, User,
@@ -1136,13 +1149,14 @@
list__delete_elems(TVars, ExistQVars, HeadTypeParams),
UnprovenBodyConstraints = [],
Indexes = [],
+ MaybeUCI = no,
MaybeInstanceConstraints = no,
PredInfo = predicate(TypeVarSet, Types, Cond, ClausesInfo, Procs,
Context, ModuleName, PredName, Arity, Status, TypeVarSet,
clauses, Markers, Attributes, PredOrFunc, ClassContext,
ClassProofs, ExistQVars, HeadTypeParams,
UnprovenBodyConstraints, User, Indexes, Assertions,
- MaybeInstanceConstraints).
+ MaybeUCI, MaybeInstanceConstraints).
pred_info_all_procids(PredInfo, ProcIds) :-
ProcTable = PredInfo ^ procedures,
@@ -1422,6 +1436,12 @@
pred_info_set_assertions(PredInfo, X, PredInfo^assertions := X).
+pred_info_get_maybe_special_pred(PredInfo,
+ PredInfo^maybe_special_pred).
+
+pred_info_set_maybe_special_pred(PredInfo, X,
+ PredInfo^maybe_special_pred := X).
+
pred_info_get_maybe_instance_method_constraints(PredInfo,
PredInfo^maybe_instance_method_constraints).
@@ -2781,9 +2801,9 @@
% is_unify_or_compare_pred(PredInfo) succeeds iff
% the PredInfo is for a compiler generated instance of a
- % type-specific special_pred (i.e. one of the __Unify__,
- % __Index__, or __Compare__ predicates generated as a
- % type-specific instance of unify/2, index/2, or compare/3).
+ % type-specific special_pred (i.e. one of the unify, compare,
+ % or index predicates generated as a type-specific instance of
+ % unify/2, index/2, or compare/3).
:- pred is_unify_or_compare_pred(pred_info).
:- mode is_unify_or_compare_pred(in) is semidet.
@@ -2845,12 +2865,11 @@
builtin_ops__translate_builtin(ModuleName, PredName, ProcId, Args, _).
:- pred prog_varset_init(prog_varset::out) is det.
+
prog_varset_init(VarSet) :- varset__init(VarSet).
is_unify_or_compare_pred(PredInfo) :-
- pred_info_name(PredInfo, PredName),
- pred_info_arity(PredInfo, PredArity),
- special_pred_name_arity(_, _, PredName, PredArity).
+ pred_info_get_maybe_special_pred(PredInfo, yes(_)).
%-----------------------------------------------------------------------------%
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.140
diff -u -b -r1.140 intermod.m
--- compiler/intermod.m 19 May 2003 14:24:24 -0000 1.140
+++ compiler/intermod.m 20 May 2003 09:21:27 -0000
@@ -2150,8 +2150,9 @@
import_status_to_write(Status)
->
(
- pred_info_name(PredInfo0, "__Unify__"),
- pred_info_arity(PredInfo0, 2)
+ pred_info_get_maybe_special_pred(PredInfo0,
+ MaybeSpecial),
+ MaybeSpecial = yes(unify - _)
->
NewStatus = pseudo_exported
;
Index: compiler/layout_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/layout_out.m,v
retrieving revision 1.24
diff -u -b -r1.24 layout_out.m
--- compiler/layout_out.m 17 May 2003 03:25:40 -0000 1.24
+++ compiler/layout_out.m 24 May 2003 10:12:55 -0000
@@ -86,6 +86,7 @@
:- import_module backend_libs__rtti.
:- import_module hlds__hlds_goal.
:- import_module hlds__hlds_pred.
+:- import_module hlds__special_pred.
:- import_module libs__trace_params.
:- import_module ll_backend__code_util.
:- import_module parse_tree__prog_data.
@@ -380,10 +381,10 @@
{ BeingDefined = yes }
),
(
- { RttiProcLabel ^ is_unify_or_compare_pred = yes },
+ { RttiProcLabel ^ maybe_special_pred = yes(_) },
io__write_string("MR_Compiler_ProcStatic ")
;
- { RttiProcLabel ^ is_unify_or_compare_pred = no },
+ { RttiProcLabel ^ maybe_special_pred = no },
io__write_string("MR_User_ProcStatic ")
),
output_layout_name(proc_static(RttiProcLabel)).
@@ -920,7 +921,7 @@
io__write_int(ModeInt),
io__write_string("\n")
;
- { ProcLabel = special_proc(DefiningModule, PredName,
+ { ProcLabel = special_proc(DefiningModule, SpecialPredId,
TypeModule, TypeName, TypeArity, Mode) },
{ prog_out__sym_name_to_string(DefiningModule,
DefiningModuleStr) },
@@ -933,6 +934,8 @@
io__write_string(",\n\t"),
quote_and_write_string(DefiningModuleStr),
io__write_string(",\n\t"),
+ { TypeCtor = qualified(TypeModule, TypeName) - TypeArity },
+ { PredName = special_pred_name(SpecialPredId, TypeCtor) },
quote_and_write_string(PredName),
io__write_string(",\n\t"),
io__write_int(TypeArity),
Index: compiler/magic_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/magic_util.m,v
retrieving revision 1.27
diff -u -b -r1.27 magic_util.m
--- compiler/magic_util.m 15 Mar 2003 03:08:56 -0000 1.27
+++ compiler/magic_util.m 24 May 2003 10:11:27 -0000
@@ -654,11 +654,11 @@
% It had better be an in-in unification, since Aditi
% relations cannot have non-ground arguments. This is
% checked elsewhere.
- % XXX __Unify__/2 needs to be special cased in rl_exprn.m
- % because we don't add the type_info arguments.
+ % XXX unification predicates need to be special cased
+ % in rl_exprn.m because we don't add the type_info arguments.
hlds_pred__in_in_unification_proc_id(UniProcId),
- SymName = unqualified("__Unify__"),
+ XXX SymName = unqualified("__Unify__"),
ArgVars = [Var, OutputVar],
Test = call(UniPredId, UniProcId, ArgVars, not_builtin,
no, SymName) - GoalInfo
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.440
diff -u -b -r1.440 make_hlds.m
--- compiler/make_hlds.m 19 May 2003 14:24:24 -0000 1.440
+++ compiler/make_hlds.m 24 May 2003 10:05:09 -0000
@@ -3683,8 +3683,8 @@
% predicates to be defined only for the kinds of types which do not
% lead unify_proc__generate_index_clauses to abort.
-add_special_preds(Module0, TVarSet, Type, TypeCtor,
- Body, Context, Status, Module) :-
+add_special_preds(Module0, TVarSet, Type, TypeCtor, Body, Context, Status,
+ Module) :-
(
special_pred_is_generated_lazily(Module0,
TypeCtor, Body, Status)
@@ -3795,17 +3795,15 @@
)
).
-add_special_pred_for_real(SpecialPredId,
- Module0, TVarSet, Type, TypeCtor, TypeBody, Context, Status0,
- Module) :-
+add_special_pred_for_real(SpecialPredId, Module0, TVarSet, Type, TypeCtor,
+ TypeBody, Context, Status0, Module) :-
adjust_special_pred_status(Status0, SpecialPredId, Status),
module_info_get_special_pred_map(Module0, SpecialPredMap0),
( map__contains(SpecialPredMap0, SpecialPredId - TypeCtor) ->
Module1 = Module0
;
- add_special_pred_decl_for_real(SpecialPredId,
- Module0, TVarSet, Type, TypeCtor, Context, Status,
- Module1)
+ add_special_pred_decl_for_real(SpecialPredId, Module0,
+ TVarSet, Type, TypeCtor, Context, Status, Module1)
),
module_info_get_special_pred_map(Module1, SpecialPredMap1),
map__lookup(SpecialPredMap1, SpecialPredId - TypeCtor, PredId),
@@ -3828,9 +3826,9 @@
% Since the compiler did not then know that the type definition
% will specify a user-defined equality predicate, it set up
% the status as pseudo_imported in order to prevent the
- % generation of code for mode 0 of the __Unify__ predicate
+ % generation of code for mode 0 of the unify predicate
% for the type. However, for types with user-defined equality,
- % we *do* want to generate code for mode 0 of __Unify__,
+ % we *do* want to generate code for mode 0 of unify,
% so we fix the status.
pred_info_set_import_status(PredInfo0, Status, PredInfo1)
;
@@ -3841,13 +3839,15 @@
pred_info_set_clauses_info(PredInfo1, ClausesInfo, PredInfo2),
pred_info_get_markers(PredInfo2, Markers2),
add_marker(Markers2, calls_are_fully_qualified, Markers),
- pred_info_set_markers(PredInfo2, Markers, PredInfo),
+ pred_info_set_markers(PredInfo2, Markers, PredInfo3),
+ pred_info_set_maybe_special_pred(PredInfo3,
+ yes(SpecialPredId - TypeCtor), PredInfo),
map__det_update(Preds0, PredId, PredInfo, Preds),
module_info_set_preds(Module1, Preds, Module).
-:- pred add_special_pred_decl_list(list(special_pred_id),
- module_info, tvarset, type, type_ctor, hlds_type_body,
- prog_context, import_status, module_info).
+:- pred add_special_pred_decl_list(list(special_pred_id), module_info,
+ tvarset, type, type_ctor, hlds_type_body, prog_context,
+ import_status, module_info).
:- mode add_special_pred_decl_list(in, in, in, in, in, in, in, in, out) is det.
add_special_pred_decl_list([], Module, _, _, _, _, _, _, Module).
@@ -3858,9 +3858,8 @@
add_special_pred_decl_list(SpecialPredIds, Module1,
TVarSet, Type, TypeCtor, TypeBody, Context, Status, Module).
-:- pred add_special_pred_decl(special_pred_id,
- module_info, tvarset, type, type_ctor, hlds_type_body,
- prog_context, import_status, module_info).
+:- pred add_special_pred_decl(special_pred_id, module_info, tvarset, type,
+ type_ctor, hlds_type_body, prog_context, import_status, module_info).
:- mode add_special_pred_decl(in, in, in, in, in, in, in, in, out) is det.
add_special_pred_decl(SpecialPredId, Module0, TVarSet, Type, TypeCtor,
@@ -3878,13 +3877,13 @@
Module = Module0
).
-add_special_pred_decl_for_real(SpecialPredId,
- Module0, TVarSet, Type, TypeCtor, Context, Status0,
- Module) :-
+add_special_pred_decl_for_real(SpecialPredId, Module0, TVarSet, Type, TypeCtor,
+ Context, Status0, Module) :-
module_info_name(Module0, ModuleName),
+ special_pred_interface(SpecialPredId, Type, ArgTypes, ArgModes, Det),
+ Name = special_pred_name(SpecialPredId, TypeCtor),
PredName = unqualified(Name),
- special_pred_info(SpecialPredId, Type, Name, ArgTypes, ArgModes, Det),
- special_pred_name_arity(SpecialPredId, _, _, Arity),
+ special_pred_name_arity(SpecialPredId, _, Arity),
Cond `with_type` condition = true,
clauses_info_init(Arity, ClausesInfo0),
adjust_special_pred_status(Status0, SpecialPredId, Status),
@@ -3899,11 +3898,13 @@
pred_info_init(ModuleName, PredName, Arity, TVarSet, ExistQVars,
ArgTypes, Cond, Context, ClausesInfo0, Status, Markers,
none, predicate, ClassContext, Proofs, Owner, PredInfo0),
+ pred_info_set_maybe_special_pred(PredInfo0,
+ yes(SpecialPredId - TypeCtor), PredInfo1),
ArgLives = no,
varset__init(InstVarSet),
% Should not be any inst vars here so it's ok to use a
% fresh inst_varset.
- add_new_proc(PredInfo0, InstVarSet, Arity, ArgModes, yes(ArgModes),
+ add_new_proc(PredInfo1, InstVarSet, Arity, ArgModes, yes(ArgModes),
ArgLives, yes(Det), Context, address_is_not_taken, PredInfo,
_),
@@ -3923,7 +3924,7 @@
add_special_pred_unify_status(TypeBody, Status0, Status) :-
( TypeBody = du_type(_, _, _, yes(_), _, _) ->
% If the type has user-defined equality,
- % then we create a real __Unify__ predicate
+ % then we create a real unify predicate
% for it, whose body calls the user-specified
% predicate. The compiler's usual type checking
% algorithm will handle any necessary
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.71
diff -u -b -r1.71 ml_code_util.m
--- compiler/ml_code_util.m 14 May 2003 14:38:43 -0000 1.71
+++ compiler/ml_code_util.m 15 May 2003 02:14:57 -0000
@@ -1447,16 +1447,14 @@
ml_gen_pred_label_from_rtti(ModuleInfo, RttiProcLabel, MLDS_PredLabel,
MLDS_Module) :-
RttiProcLabel = rtti_proc_label(PredOrFunc, ThisModule, PredModule,
- PredName, PredArity, ArgTypes, PredId, ProcId,
+ PredName, PredArity, _ArgTypes, PredId, ProcId,
_HeadVarsWithNames, _ArgModes, CodeModel,
IsImported, _IsPseudoImported, _IsExported,
IsSpecialPredInstance),
(
- IsSpecialPredInstance = yes
+ IsSpecialPredInstance = yes(SpecialPred - TypeCtor)
->
(
- special_pred_get_type(PredName, ArgTypes, Type),
- type_to_ctor_and_args(Type, TypeCtor, _),
% All type_ctors other than tuples here should be
% module qualified, since builtin types are handled
% separately in polymorphism.m.
@@ -1471,7 +1469,7 @@
->
(
ThisModule \= TypeModule,
- PredName = "__Unify__",
+ SpecialPred = unify,
\+ hlds_pred__in_in_unification_proc_id(ProcId)
->
% This is a locally-defined instance
Index: compiler/mlds_to_java.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_java.m,v
retrieving revision 1.41
diff -u -b -r1.41 mlds_to_java.m
--- compiler/mlds_to_java.m 14 May 2003 18:49:50 -0000 1.41
+++ compiler/mlds_to_java.m 15 May 2003 02:14:58 -0000
@@ -125,22 +125,6 @@
qualified_name_is_stdlib(Module)
).
- % Succeeds iff this definition is a function definition which
- % defines the `unify' or `compare' special predicate.
- %
-:- pred defn_is_unify_or_compare(mlds__defn).
-:- mode defn_is_unify_or_compare(in) is semidet.
-
-defn_is_unify_or_compare(Defn) :-
- Defn = mlds__defn(Name, _Context, _Flags, _Body),
- Name = function(Label, _ProcID, _MaybeSeqNum, _PredID),
- Label = special_pred(PredName, _, _, _),
- (
- PredName = "__Compare__"
- ;
- PredName = "__Unify__"
- ).
-
% Succeeds iff this definition is a data definition which
% defines RTTI.
%
Index: compiler/name_mangle.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/name_mangle.m,v
retrieving revision 1.1
diff -u -b -r1.1 name_mangle.m
--- compiler/name_mangle.m 16 Mar 2003 09:24:58 -0000 1.1
+++ compiler/name_mangle.m 24 May 2003 10:05:35 -0000
@@ -93,6 +93,7 @@
:- implementation.
:- import_module hlds__hlds_pred.
+:- import_module hlds__special_pred.
:- import_module parse_tree__prog_util.
:- import_module char, int, list, std_util.
@@ -120,10 +121,12 @@
% For a special proc, output a label of the form:
% mercury____<PredName>___<TypeModule>__<TypeName>_<TypeArity>_<Mode>
-proc_label_to_c_string(special_proc(Module, PredName, TypeModule,
+proc_label_to_c_string(special_proc(Module, SpecialPredId, TypeModule,
TypeName, TypeArity, ModeNum0), AddPrefix) = ProcLabelString :-
% figure out the LabelName
DummyArity = -1, % not used by make_pred_or_func_name.
+ TypeCtor = 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.131
diff -u -b -r1.131 opt_debug.m
--- compiler/opt_debug.m 9 May 2003 05:51:51 -0000 1.131
+++ compiler/opt_debug.m 24 May 2003 10:17:53 -0000
@@ -129,11 +129,13 @@
:- import_module backend_libs__name_mangle.
:- import_module hlds__hlds_pred.
+:- import_module hlds__special_pred.
:- import_module libs__globals.
:- import_module libs__options.
:- import_module ll_backend__code_util.
:- import_module ll_backend__llds_out.
:- import_module ll_backend__opt_util.
+:- import_module parse_tree__prog_data.
:- import_module parse_tree__prog_out.
:- import_module int, set, map, string.
@@ -598,16 +600,18 @@
string__int_to_string(Mode, M_str),
string__append_list([ExtraModule, ModuleName, "_", PredName,
"_", A_str, "_", M_str], Str).
-opt_debug__dump_proclabel(special_proc(Module, Pred, TypeModule,
- Type, Arity, ProcId), Str) :-
+opt_debug__dump_proclabel(special_proc(Module, SpecialPredId, TypeModule,
+ TypeName, TypeArity, ProcId), Str) :-
ModuleName = sym_name_mangle(Module),
TypeModuleName = sym_name_mangle(TypeModule),
- TypeName = qualify_name(TypeModuleName, Type),
- string__int_to_string(Arity, A_str),
+ QualTypeName = qualify_name(TypeModuleName, TypeName),
+ string__int_to_string(TypeArity, A_str),
proc_id_to_int(ProcId, Mode),
string__int_to_string(Mode, M_str),
- string__append_list([ModuleName, "_", Pred, "_",
- TypeName, "_", A_str, "_", M_str], Str).
+ TypeCtor = qualified(TypeModule, TypeName) - TypeArity,
+ SpecialPredStr = special_pred_name(SpecialPredId, TypeCtor),
+ string__append_list([ModuleName, "_", SpecialPredStr, "_",
+ QualTypeName, "_", A_str, "_", M_str], Str).
opt_debug__dump_bool(yes, "yes").
opt_debug__dump_bool(no, "no").
Index: compiler/opt_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/opt_util.m,v
retrieving revision 1.120
diff -u -b -r1.120 opt_util.m
--- compiler/opt_util.m 9 May 2003 05:51:51 -0000 1.120
+++ compiler/opt_util.m 24 May 2003 10:14:09 -0000
@@ -326,8 +326,10 @@
:- import_module backend_libs__builtin_ops.
:- import_module backend_libs__proc_label.
:- import_module hlds__hlds_pred.
+:- import_module hlds__special_pred.
:- import_module ll_backend__exprn_aux.
:- import_module ll_backend__llds_out.
+:- import_module parse_tree__prog_data.
:- import_module int, string, set, require.
@@ -1492,13 +1494,15 @@
proc_id_to_int(ProcId, Mode),
string__int_to_string(Mode, ModeStr),
string__append_list([Name, "/", ArityStr, " mode ", ModeStr], Str).
-opt_util__format_proclabel(special_proc(_Module, Pred, _, Type, Arity, ProcId),
- Str) :-
- string__int_to_string(Arity, ArityStr),
+opt_util__format_proclabel(special_proc(_Module, SpecialPredId, TypeModule,
+ TypeName, TypeArity, ProcId), Str) :-
+ string__int_to_string(TypeArity, TypeArityStr),
proc_id_to_int(ProcId, Mode),
string__int_to_string(Mode, ModeStr),
- string__append_list(
- [Pred, "_", Type, "/", ArityStr, " mode ", ModeStr], Str).
+ TypeCtor = qualified(TypeModule, TypeName) - TypeArity,
+ PredName = special_pred_name(SpecialPredId, TypeCtor),
+ string__append_list([PredName, "_", TypeName, "/", TypeArityStr,
+ " mode ", ModeStr], Str).
opt_util__has_both_incr_decr_sp(Instrs) :-
opt_util__has_both_incr_decr_sp_2(Instrs, no, yes, no, yes).
Index: compiler/optimize.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/optimize.m,v
retrieving revision 1.38
diff -u -b -r1.38 optimize.m
--- compiler/optimize.m 10 May 2003 05:03:52 -0000 1.38
+++ compiler/optimize.m 24 May 2003 10:03:09 -0000
@@ -218,7 +218,7 @@
optimize__repeated(Instrs0, Final, LayoutLabelSet, ProcLabel, MayAlterRtti,
C0, C, OptDebugInfo0, OptDebugInfo, Instrs, Mod) -->
{ opt_util__find_first_label(Instrs0, Label) },
- { opt_util__format_label(Label, LabelStr) },
+ { proc_label_to_c_string(get_proc_label(Label), no) = LabelStr },
globals__io_lookup_bool_option(very_verbose, VeryVerbose),
globals__io_lookup_bool_option(optimize_jumps, Jumpopt),
globals__io_lookup_bool_option(optimize_fulljumps, FullJumpopt),
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.235
diff -u -b -r1.235 polymorphism.m
--- compiler/polymorphism.m 18 Mar 2003 02:43:41 -0000 1.235
+++ compiler/polymorphism.m 13 May 2003 10:31:19 -0000
@@ -2836,7 +2836,7 @@
proc_id_to_int(ProcId, ProcInt)
;
polymorphism__get_category_name(TypeCategory, CategoryName),
- special_pred_name_arity(SpecialPredId, SpecialName, _, Arity),
+ special_pred_name_arity(SpecialPredId, SpecialName, Arity),
string__append_list(
["builtin_", SpecialName, "_", CategoryName], Name),
lookup_builtin_pred_proc_id(ModuleInfo,
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.51
diff -u -b -r1.51 post_typecheck.m
--- compiler/post_typecheck.m 19 May 2003 14:24:26 -0000 1.51
+++ compiler/post_typecheck.m 20 May 2003 09:21:27 -0000
@@ -991,9 +991,8 @@
% but the polymorphic unify needs to be able to call
% the semidet mode.)
%
- { special_pred_name_arity(unify, _, PredName, PredArity) },
- { pred_info_name(PredInfo0, PredName) },
- { pred_info_arity(PredInfo0, PredArity) }
+ { pred_info_get_maybe_special_pred(PredInfo0, MaybeSpecial) },
+ { MaybeSpecial = yes(unify - _) }
->
{ PredInfo = PredInfo0 }
;
Index: compiler/proc_label.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/proc_label.m,v
retrieving revision 1.2
diff -u -b -r1.2 proc_label.m
--- compiler/proc_label.m 15 Mar 2003 03:09:06 -0000 1.2
+++ compiler/proc_label.m 24 May 2003 07:55:39 -0000
@@ -21,6 +21,7 @@
:- import_module backend_libs__rtti.
:- import_module hlds__hlds_module.
:- import_module hlds__hlds_pred.
+:- import_module hlds__special_pred.
:- import_module parse_tree__prog_data.
:- import_module bool.
@@ -45,7 +46,7 @@
)
; special_proc(
module_name, % defining module
- string, % pred name
+ special_pred_id,% indirectly defines pred name
module_name, % type module
string, % type name
int, % type arity
@@ -86,14 +87,12 @@
make_proc_label_from_rtti(RttiProcLabel) = ProcLabel :-
RttiProcLabel = rtti_proc_label(PredOrFunc, ThisModule,
- PredModule, PredName, PredArity, ArgTypes, _PredId, ProcId,
+ PredModule, PredName, PredArity, _ArgTypes, _PredId, ProcId,
_ProcHeadVarsWithNames, _ArgModes, _CodeModel,
IsImported, _IsPseudoImported, _IsExported,
IsSpecialPredInstance),
- ( IsSpecialPredInstance = yes ->
+ ( IsSpecialPredInstance = yes(SpecialPred - TypeCtor) ->
(
- special_pred_get_type(PredName, ArgTypes, Type),
- type_to_ctor_and_args(Type, TypeCtor, _),
% All type_ctors other than tuples here should be
% module qualified, since builtin types are
% handled separately in polymorphism.m.
@@ -108,14 +107,14 @@
TypeCtor = _ - TypeArity,
(
ThisModule \= TypeModule,
- PredName = "__Unify__",
+ SpecialPred = unify,
\+ hlds_pred__in_in_unification_proc_id(ProcId)
->
DefiningModule = ThisModule
;
DefiningModule = TypeModule
),
- ProcLabel = special_proc(DefiningModule, PredName,
+ ProcLabel = special_proc(DefiningModule, SpecialPred,
TypeModule, TypeName, TypeArity, ProcId)
;
string__append_list(["make_proc_label:\n",
@@ -157,7 +156,7 @@
;
Module = ModuleName
),
- ProcLabel = special_proc(Module, "__Unify__", TypeModule,
+ ProcLabel = special_proc(Module, unify, TypeModule,
TypeName, Arity, UniModeNum)
;
error("make_uni_label: unqualified type_ctor")
Index: compiler/rl_exprn.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rl_exprn.m,v
retrieving revision 1.29
diff -u -b -r1.29 rl_exprn.m
--- compiler/rl_exprn.m 21 Mar 2003 05:52:07 -0000 1.29
+++ compiler/rl_exprn.m 13 May 2003 10:06:40 -0000
@@ -140,6 +140,7 @@
:- import_module hlds__hlds_goal.
:- import_module hlds__hlds_pred.
:- import_module hlds__instmap.
+:- import_module hlds__special_pred.
:- import_module libs__tree.
:- import_module parse_tree__prog_out.
:- import_module parse_tree__prog_util.
@@ -996,8 +997,7 @@
rl_exprn_info::in, rl_exprn_info::out) is det.
rl_exprn__call_body(PredId, ProcId, PredInfo, ProcInfo, Fail, Args, Code) -->
- { pred_info_name(PredInfo, PredName) },
- { pred_info_arity(PredInfo, Arity) },
+ { pred_info_get_maybe_special_pred(PredInfo, MaybeSpecial) },
(
{ pred_info_is_builtin(PredInfo) }
->
@@ -1013,8 +1013,7 @@
% Handle unify/2 specially, since it is possibly recursive,
% which will cause the code below to fall over. Also, magic.m
% doesn't add type_info arguments yet.
- { PredName = "__Unify__" },
- { Arity = 2 },
+ { MaybeSpecial = yes(unify - _) },
{ list__reverse(Args, [Arg1, Arg2 | _]) },
{ hlds_pred__in_in_unification_proc_id(ProcId) }
->
@@ -1025,8 +1024,7 @@
;
% Handle compare/3 specially for the same reason
% as unify/2 above.
- { PredName = "__Compare__" },
- { Arity = 3 },
+ { MaybeSpecial = yes(compare - _) },
{ list__reverse(Args, [Arg2, Arg1, Res | _]) }
->
rl_exprn_info_lookup_var(Arg1, Arg1Loc),
Index: compiler/rl_key.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rl_key.m,v
retrieving revision 1.13
diff -u -b -r1.13 rl_key.m
--- compiler/rl_key.m 15 Mar 2003 03:09:09 -0000 1.13
+++ compiler/rl_key.m 13 May 2003 10:35:07 -0000
@@ -58,6 +58,7 @@
:- import_module check_hlds__type_util.
:- import_module hlds__hlds_data.
:- import_module hlds__hlds_pred.
+:- import_module hlds__special_pred.
:- import_module parse_tree__prog_util.
:- import_module assoc_list, bool, int, require, set, std_util.
@@ -679,20 +680,33 @@
{ pred_info_module(PredInfo, PredModule) },
{ pred_info_name(PredInfo, PredName) },
{ list__length(Args, Arity) },
+ { pred_info_get_maybe_special_pred(PredInfo, MaybeSpecial) },
(
{ hlds_pred__in_in_unification_proc_id(ProcId) },
- { is_builtin_unify_pred(PredModule, PredName, Arity) }
+ {
+ is_builtin_unify_pred(PredModule, PredName, Arity)
+ ;
+ MaybeSpecial = yes(unify - _)
+ }
->
% Find the last two arguments, the rest will be type_infos.
{ list__reverse(Args, RevArgs) },
( { RevArgs = [Arg1, Arg2 | _] } ->
rl_key__unify_var_var(Arg1, Arg2)
;
- { error("rl_key__extract_key_range_call: __Unify__") }
+ { error("rl_key__extract_key_range_call: unify") }
)
;
- { is_builtin_compare_pred(PredModule,
- PredName, Arity, CompareType) }
+ {
+ is_builtin_compare_pred(PredModule,
+ PredName, Arity, CompareTypePrime)
+ ->
+ CompareType = CompareTypePrime
+ ;
+ MaybeSpecial = yes(compare - _),
+ % We could do better here
+ CompareType = unknown
+ }
->
rl_key__update_compare_bounds(CompareType, Args)
;
@@ -756,7 +770,6 @@
:- pred is_builtin_compare_pred(sym_name::in, string::in,
int::in, compare_type::out) is semidet.
-is_builtin_compare_pred(_, "__Compare__", _, unknown).
is_builtin_compare_pred(Module, "compare", 4, unknown) :-
mercury_public_builtin_module(Module).
is_builtin_compare_pred(unqualified("int"), "<", 2, result(<)).
@@ -776,7 +789,6 @@
:- pred is_builtin_unify_pred(sym_name::in, string::in, int::in) is semidet.
-is_builtin_unify_pred(_, "__Unify__", _).
is_builtin_unify_pred(Module, "unify", 3) :-
mercury_public_builtin_module(Module).
is_builtin_unify_pred(Module, "builtin_unify_int", 2) :-
Index: compiler/rtti.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rtti.m,v
retrieving revision 1.31
diff -u -b -r1.31 rtti.m
--- compiler/rtti.m 14 May 2003 00:10:03 -0000 1.31
+++ compiler/rtti.m 14 May 2003 00:21:35 -0000
@@ -28,6 +28,7 @@
:- import_module hlds__hlds_data.
:- import_module hlds__hlds_module.
:- import_module hlds__hlds_pred.
+:- import_module hlds__special_pred.
:- import_module parse_tree__prog_data.
:- import_module assoc_list, bool, list, set, map, std_util.
@@ -429,8 +430,8 @@
% The rtti_proc_label type holds all the information about a procedure
% that we need to compute the entry label for that procedure
% in the target language (the llds__code_addr or mlds__code_addr).
-:- type rtti_proc_label
- ---> rtti_proc_label(
+:- type rtti_proc_label --->
+ rtti_proc_label(
pred_or_func :: pred_or_func,
this_module :: module_name,
pred_module :: module_name,
@@ -449,7 +450,7 @@
% pred_info_is_imported/1,
% pred_info_is_pseudo_imported/1,
% procedure_is_exported/2, and
- % is_unify_or_compare_pred/1
+ % pred_info_get_maybe_special_pred/1
% respectively.
% We store booleans here, rather than storing the
% pred_info, to avoid retaining a reference to the
@@ -463,7 +464,7 @@
is_imported :: bool,
is_pseudo_imported :: bool,
is_exported :: bool,
- is_unify_or_compare_pred :: bool
+ maybe_special_pred :: maybe(special_pred)
).
%-----------------------------------------------------------------------------%
@@ -807,15 +808,14 @@
IsImported = (pred_info_is_imported(PredInfo) -> yes ; no),
IsPseudoImp = (pred_info_is_pseudo_imported(PredInfo) -> yes ; no),
IsExported = (procedure_is_exported(PredInfo, ProcId) -> yes ; no),
- IsUnifyOrComparePred =
- (is_unify_or_compare_pred(PredInfo) -> yes ; no),
+ pred_info_get_maybe_special_pred(PredInfo, MaybeSpecial),
ProcHeadVarsWithNames = list__map((func(Var) = Var - Name :-
Name = varset__lookup_name(ProcVarSet, Var)
), ProcHeadVars),
ProcLabel = rtti_proc_label(PredOrFunc, ThisModule, PredModule,
PredName, Arity, ArgTypes, PredId, ProcId,
ProcHeadVarsWithNames, ProcArgModes, ProcCodeModel,
- IsImported, IsPseudoImp, IsExported, IsUnifyOrComparePred).
+ IsImported, IsPseudoImp, IsExported, MaybeSpecial).
rtti__proc_label_pred_proc_id(ProcLabel, PredId, ProcId) :-
ProcLabel = rtti_proc_label(_, _, _, _, _, _, PredId, ProcId,
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.116
diff -u -b -r1.116 simplify.m
--- compiler/simplify.m 21 Mar 2003 05:52:07 -0000 1.116
+++ compiler/simplify.m 13 May 2003 11:14:47 -0000
@@ -1476,7 +1476,10 @@
list__append(TypeInfoVars, [XVar, YVar], ArgVars),
module_info_get_special_pred_map(ModuleInfo, SpecialPredMap),
map__lookup(SpecialPredMap, unify - TypeCtor, PredId),
- SymName = unqualified("__Unify__"),
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_module(PredInfo, ModuleName),
+ pred_info_name(PredInfo, PredName),
+ SymName = qualified(ModuleName, PredName),
CallContext = call_unify_context(XVar, var(YVar), Context),
CallExpr = call(PredId, ProcId, ArgVars, not_builtin,
yes(CallContext), SymName),
Index: compiler/special_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/special_pred.m,v
retrieving revision 1.36
diff -u -b -r1.36 special_pred.m
--- compiler/special_pred.m 15 Mar 2003 03:09:10 -0000 1.36
+++ compiler/special_pred.m 24 May 2003 09:57:49 -0000
@@ -32,25 +32,25 @@
; index
; compare.
+ % Return the predicate name we should use for the given special_pred
+ % for the given type constructor.
+:- func special_pred_name(special_pred_id, type_ctor) = string.
+
% This predicate always returns determinism `semidet' for
% unification procedures. For types with only one value, the
% unification is actually `det', however we need to pretend it
% is `semidet' so that it can be called correctly from the
% polymorphic `unify' procedure.
-:- pred special_pred_info(special_pred_id, type, string, list(type),
+:- pred special_pred_interface(special_pred_id, type, list(type),
list(mode), determinism).
-:- mode special_pred_info(in, in, out, out, out, out) is det.
+:- mode special_pred_interface(in, in, out, out, out) is det.
- % special_pred_name_arity(SpecialPredType, GenericPredName,
- % TypeSpecificVersionPredName, Arity):
+ % special_pred_name_arity(SpecialPredType, GenericPredName, Arity):
% true iff there is a special predicate of category
- % SpecialPredType, called builtin:GenericPredName/Arity,
- % for which the type-specific versions will be called
- % TypeSpecificVersionPredName.
-:- pred special_pred_name_arity(special_pred_id, string, string, int).
-:- mode special_pred_name_arity(in, out, out, out) is det.
-:- mode special_pred_name_arity(out, in, out, in) is semidet.
-:- mode special_pred_name_arity(out, out, in, in) is semidet.
+ % SpecialPredType, called builtin:GenericPredName/Arity.
+:- pred special_pred_name_arity(special_pred_id, string, int).
+:- mode special_pred_name_arity(in, out, out) is det.
+:- mode special_pred_name_arity(out, in, out) is semidet.
:- pred special_pred_mode_num(special_pred_id, int).
:- mode special_pred_mode_num(in, out) is det.
@@ -58,8 +58,8 @@
:- pred special_pred_list(list(special_pred_id)).
:- mode special_pred_list(out) is det.
- % Given the mangled predicate name and the list of argument types,
- % work out which type this special predicate is for.
+ % Given a special pred id and the list of its arguments, work out
+ % which argument specifies the type that this special predicate is for.
% Note that this gets called after the polymorphism.m pass, so
% type_info arguments may have been inserted at the start; hence we
% find the type at a known position from the end of the list
@@ -69,10 +69,10 @@
% can be found in the last type argument, except for index, for
% which it is the second-last argument.
-:- pred special_pred_get_type(string, list(Type), Type).
+:- pred special_pred_get_type(special_pred_id, list(prog_var), prog_var).
:- mode special_pred_get_type(in, in, out) is semidet.
-:- pred special_pred_get_type_det(string, list(Type), Type).
+:- pred special_pred_get_type_det(special_pred_id, list(prog_var), prog_var).
:- mode special_pred_get_type_det(in, in, out) is det.
:- pred special_pred_description(special_pred_id, string).
@@ -119,42 +119,36 @@
special_pred_list([unify, index, compare]).
-special_pred_name_arity(unify, "unify", "__Unify__", 2).
-special_pred_name_arity(index, "index", "__Index__", 2).
-special_pred_name_arity(compare, "compare", "__Compare__", 3).
+special_pred_name_arity(unify, "unify", 2).
+special_pred_name_arity(index, "index", 2).
+special_pred_name_arity(compare, "compare", 3).
% mode num for special procs is always 0 (the first mode)
special_pred_mode_num(_, 0).
-special_pred_info(unify, Type, "__Unify__", [Type, Type], [In, In], semidet) :-
- in_mode(In).
+special_pred_name(unify, _TypeCtor) = "__Unify__".
+special_pred_name(index, _TypeCtor) = "__Index__".
+special_pred_name(compare, _TypeCtor) = "__Compare__".
-special_pred_info(index, Type, "__Index__", [Type, IntType], [In, Out], det) :-
- construct_type(unqualified("int") - 0, [], IntType),
+special_pred_interface(unify, Type, [Type, Type], [In, In], semidet) :-
+ in_mode(In).
+special_pred_interface(index, Type, [Type, int_type], [In, Out], det) :-
in_mode(In),
out_mode(Out).
-
-special_pred_info(compare, Type,
- "__Compare__", [ResType, Type, Type], [Uo, In, In], det) :-
- ResType = comparison_result_type,
+special_pred_interface(compare, Type, [comparison_result_type, Type, Type],
+ [Uo, In, In], det) :-
in_mode(In),
uo_mode(Uo).
-special_pred_get_type("__Unify__", Types, T) :-
+special_pred_get_type(unify, Types, T) :-
list__reverse(Types, [T | _]).
-special_pred_get_type("unify", Types, T) :-
- list__reverse(Types, [T | _]).
-special_pred_get_type("__Index__", Types, T) :-
- list__reverse(Types, [_, T | _]).
-special_pred_get_type("index", Types, T) :-
+special_pred_get_type(index, Types, T) :-
list__reverse(Types, [_, T | _]).
-special_pred_get_type("__Compare__", Types, T) :-
- list__reverse(Types, [T | _]).
-special_pred_get_type("compare", Types, T) :-
+special_pred_get_type(compare, Types, T) :-
list__reverse(Types, [T | _]).
-special_pred_get_type_det(Name, ArgTypes, Type) :-
- ( special_pred_get_type(Name, ArgTypes, TypePrime) ->
+special_pred_get_type_det(SpecialId, ArgTypes, Type) :-
+ ( special_pred_get_type(SpecialId, ArgTypes, TypePrime) ->
Type = TypePrime
;
error("special_pred_get_type_det: special_pred_get_type failed")
Index: compiler/termination.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/termination.m,v
retrieving revision 1.27
diff -u -b -r1.27 termination.m
--- compiler/termination.m 21 Mar 2003 05:52:08 -0000 1.27
+++ compiler/termination.m 13 May 2003 10:21:21 -0000
@@ -491,16 +491,18 @@
set_builtin_terminates(ProcIds, PredId, PredInfo, Module,
ProcTable0, ProcTable)
;
+ (
pred_info_name(PredInfo, Name),
pred_info_arity(PredInfo, Arity),
- (
- special_pred_name_arity(SpecPredId0, Name, _, Arity),
+ special_pred_name_arity(SpecPredId0, Name, Arity),
pred_info_module(PredInfo, ModuleName),
any_mercury_builtin_module(ModuleName)
->
SpecialPredId = SpecPredId0
;
- special_pred_name_arity(SpecialPredId, _, Name, Arity)
+ pred_info_get_maybe_special_pred(PredInfo,
+ MaybeSpecial),
+ MaybeSpecial = yes(SpecialPredId - _)
)
->
set_generated_terminates(ProcIds, SpecialPredId,
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.337
diff -u -b -r1.337 typecheck.m
--- compiler/typecheck.m 19 May 2003 14:24:27 -0000 1.337
+++ compiler/typecheck.m 20 May 2003 09:21:28 -0000
@@ -868,19 +868,14 @@
special_pred_needs_typecheck(PredInfo, ModuleInfo) :-
%
% check if the predicate is a compiler-generated special
- % predicate
+ % predicate, and if so, for which type
%
- pred_info_name(PredInfo, PredName),
- pred_info_arity(PredInfo, PredArity),
- special_pred_name_arity(_, _, PredName, PredArity),
+ pred_info_get_maybe_special_pred(PredInfo, MaybeSpecial),
+ MaybeSpecial = yes(_SpecialId - TypeCtor),
%
- % find out which type it is a special predicate for,
- % and check whether that type is a type for which there is
+ % check whether that type is a type for which there is
% a user-defined equality predicate, or which is existentially typed.
%
- pred_info_arg_types(PredInfo, ArgTypes),
- special_pred_get_type(PredName, ArgTypes, Type),
- type_to_ctor_and_args(Type, TypeCtor, _TypeArgs),
module_info_types(ModuleInfo, TypeTable),
map__lookup(TypeTable, TypeCtor, TypeDefn),
hlds_data__get_type_defn_body(TypeDefn, Body),
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.119
diff -u -b -r1.119 unify_proc.m
--- compiler/unify_proc.m 31 Mar 2003 09:25:06 -0000 1.119
+++ compiler/unify_proc.m 24 May 2003 10:09:06 -0000
@@ -695,8 +695,7 @@
unify_proc__generate_clause_info(SpecialPredId, Type, TypeBody, Context,
ModuleInfo, ClauseInfo) :-
- special_pred_info(SpecialPredId, Type,
- _PredName, ArgTypes, _Modes, _Det),
+ special_pred_interface(SpecialPredId, Type, ArgTypes, _Modes, _Det),
unify_proc__info_init(ModuleInfo, VarTypeInfo0),
unify_proc__make_fresh_named_vars_from_types(ArgTypes, "HeadVar__", 1,
Args, VarTypeInfo0, VarTypeInfo1),
@@ -1574,7 +1573,7 @@
% are the only public builtins called by code generated
% by this module.
%
- { special_pred_name_arity(_, Name, _, Arity) ->
+ { special_pred_name_arity(_, Name, Arity) ->
MercuryBuiltin = mercury_public_builtin_module
;
MercuryBuiltin = mercury_private_builtin_module
Index: compiler/unused_args.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unused_args.m,v
retrieving revision 1.84
diff -u -b -r1.84 unused_args.m
--- compiler/unused_args.m 21 Mar 2003 05:52:09 -0000 1.84
+++ compiler/unused_args.m 13 May 2003 10:11:56 -0000
@@ -1018,6 +1018,7 @@
pred_info_name(PredInfo0, Name0),
pred_info_get_is_pred_or_func(PredInfo0, PredOrFunc),
pred_info_arg_types(PredInfo0, Tvars, ExistQVars, ArgTypes0),
+ pred_info_get_maybe_special_pred(PredInfo0, MaybeSpecial),
% create a unique new pred name using the old proc_id
(
string__prefix(Name0, "__"),
@@ -1025,8 +1026,7 @@
->
(
% fix up special pred names
- special_pred_get_type(Name0, ArgTypes0, Type),
- type_to_ctor_and_args(Type, TypeCtor, _)
+ MaybeSpecial = yes(_SpecialId - TypeCtor)
->
type_util__type_ctor_module(ModuleInfo,
TypeCtor, TypeModule),
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/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/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/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing java
cvs diff: Diffing java/library
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
Index: tests/invalid/purity/purity.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/purity/purity.err_exp,v
retrieving revision 1.4
diff -u -b -r1.4 purity.err_exp
--- tests/invalid/purity/purity.err_exp 27 Jan 2003 09:21:03 -0000 1.4
+++ tests/invalid/purity/purity.err_exp 13 May 2003 12:30:47 -0000
@@ -31,10 +31,10 @@
purity.m:118: purity error: call must be preceded by `semipure' indicator.
purity.m:118: Purity error in closure: closure body is semipure,
purity.m:118: but closure was not declared `semipure.'
-purity.m:093: In unification predicate for type (purity.e8):
+purity.m:093: In unification predicate for type constructor purity.e8:
purity.m:093: purity error: predicate is impure.
purity.m:093: It must be pure.
-purity.m:101: In unification predicate for type (purity.e9):
+purity.m:101: In unification predicate for type constructor purity.e9:
purity.m:101: purity error: predicate is semipure.
purity.m:101: It must be pure.
purity.m:083: In clause for `e6':
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
post: 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