[m-dev.] for review: removing the general index predicate
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Apr 10 12:11:01 AEST 2000
For anyone to review.
Estimated hours taken: 4
Remove the need for and the definition of the general index predicate.
Instead, always call the type-specific index predicate from the type-specific
compare predicate.
The declaration of the general index predicate, and the declarations and
implementations of the index predicates on builtin types such as ints
will be deleted once the changes to the compiler have been bootstrapped
on all platforms.
compiler/unify_proc.m:
Always call the type-specific index predicate from the type-specific
compare predicate.
Do not generate bodies for type-specific index predicates for
equivalence types, since the compare predicate for such a type
does not call the index predicate.
compiler/make_hlds.m:
Do not generate type-specific index predicates for equivalence types,
since the compare predicate for such a type does not call the index
predicate.
compiler/hlds_module.m:
compiler/rtti.m:
compiler/rtti_out.m:
compiler/dead_proc_elim.m:
Do not record the identity of type-specific index predicates, since
type_ctor_infos no longer need to know about these predicates.
compiler/type_ctor_info.m:
For the time being, fill the index_pred slot in type_ctor_infos
with a redundant reference to the unify predicate. The unify predicate
slot will later move this slot, to allow us to put the version number
as close to the start of the type_ctor_info as possible and to avoid
wasting full words on fields that need only small numbers of bits
(version number, type_ctor_rep, number of ptags used).
compiler/higher_order.m:
Update a comment.
runtime/mercury_type_info.h:
Rename the index_pred slot.
Update the definitions of the macros for filling in the special pred
slots to not take the entry label of the index pred as an argument,
since it is no longer needed.
runtime/mercury_ho_call.c:
Remove the code for the generic index predicate. At the default
optimization level, the compiler specializes away all references to
this predicate in the library, compiler etc, so this is safe to do,
and we can't keep the old implementation, since it depends on a slot
in the type_ctor_info that is no longer there.
library/array.m:
library/builtin.m:
library/private_builtin.m:
When invoking the macros for creating type_ctor_infos for builtin
and special types, do not pass the entry label of the index pred.
Zoltan.
cvs diff: Diffing .
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/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.54
diff -u -b -r1.54 dead_proc_elim.m
--- compiler/dead_proc_elim.m 2000/03/13 04:04:51 1.54
+++ compiler/dead_proc_elim.m 2000/04/08 05:40:52
@@ -177,7 +177,7 @@
dead_proc_elim__initialize_base_gen_infos([TypeCtorGenInfo | TypeCtorGenInfos],
Queue0, Queue, Needed0, Needed) :-
TypeCtorGenInfo = type_ctor_gen_info(_TypeId, ModuleName, TypeName,
- Arity, _Status, _HldsDefn, _Unify, _Compare, _Index,
+ Arity, _Status, _HldsDefn, _Unify, _Compare,
_Solver, _Init, _Pretty),
(
% XXX: We'd like to do this, but there are problems.
@@ -333,17 +333,16 @@
(
TypeCtorGenInfo = type_ctor_gen_info(_TypeId, ModuleName,
TypeName, TypeArity, _Status, _HldsDefn,
- MaybeUnify, MaybeIndex, MaybeCompare,
+ MaybeUnify, MaybeCompare,
MaybeSolver, MaybeInit, MaybePretty)
->
Refs0 = [],
dead_proc_elim__maybe_add_ref(MaybeUnify, Refs0, Refs1),
- dead_proc_elim__maybe_add_ref(MaybeIndex, Refs1, Refs2),
- dead_proc_elim__maybe_add_ref(MaybeCompare, Refs2, Refs3),
- dead_proc_elim__maybe_add_ref(MaybeSolver, Refs3, Refs4),
- dead_proc_elim__maybe_add_ref(MaybeInit, Refs4, Refs5),
- dead_proc_elim__maybe_add_ref(MaybePretty, Refs5, Refs6),
- Refs = Refs6
+ dead_proc_elim__maybe_add_ref(MaybeCompare, Refs1, Refs2),
+ dead_proc_elim__maybe_add_ref(MaybeSolver, Refs2, Refs3),
+ dead_proc_elim__maybe_add_ref(MaybeInit, Refs3, Refs4),
+ dead_proc_elim__maybe_add_ref(MaybePretty, Refs4, Refs5),
+ Refs = Refs5
;
dead_proc_elim__find_base_gen_info(ModuleName, TypeName,
TypeArity, TypeCtorGenInfos, Refs)
@@ -674,7 +673,7 @@
TypeCtorGenInfos1),
TypeCtorGenInfo0 = type_ctor_gen_info(TypeId, ModuleName,
TypeName, Arity, Status, HldsDefn,
- _MaybeUnify, _MaybeIndex, _MaybeCompare,
+ _MaybeUnify, _MaybeCompare,
_MaybeSolver, _MaybeInit, _MaybePretty),
(
Entity = base_gen_info(ModuleName, TypeName, Arity),
@@ -684,7 +683,7 @@
;
NeuteredTypeCtorGenInfo = type_ctor_gen_info(TypeId,
ModuleName, TypeName, Arity, Status, HldsDefn,
- no, no, no, no, no, no),
+ no, no, no, no, no),
TypeCtorGenInfos = [NeuteredTypeCtorGenInfo |
TypeCtorGenInfos1]
).
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.63
diff -u -b -r1.63 higher_order.m
--- compiler/higher_order.m 2000/04/05 06:28:13 1.63
+++ compiler/higher_order.m 2000/04/08 08:27:18
@@ -1596,7 +1596,7 @@
%-------------------------------------------------------------------------------
- % Succeed if the called pred is "unify", "compare" or "index" and
+ % Succeed if the called pred is "unify" or "compare" and
% is specializable, returning a specialized goal.
:- pred specialize_special_pred(pred_id::in, proc_id::in, list(prog_var)::in,
maybe(call_unify_context)::in, bool::in, hlds_goal_expr::out,
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.51
diff -u -b -r1.51 hlds_module.m
--- compiler/hlds_module.m 2000/03/10 13:37:41 1.51
+++ compiler/hlds_module.m 2000/04/08 05:17:50
@@ -63,7 +63,6 @@
import_status, % of the type
hlds_type_defn, % defn of type
maybe(pred_proc_id), % unify, if not eliminated
- maybe(pred_proc_id), % index, if not eliminated
maybe(pred_proc_id), % compare, if not eliminated
maybe(pred_proc_id), % solver, if relevant
maybe(pred_proc_id), % init, if relevant
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.330
diff -u -b -r1.330 make_hlds.m
--- compiler/make_hlds.m 2000/04/06 05:33:05 1.330
+++ compiler/make_hlds.m 2000/04/10 01:53:46
@@ -2727,9 +2727,27 @@
hlds_type_body, prog_context, import_status, module_info).
:- mode add_special_preds(in, in, in, in, in, in, in, out) is det.
+ % The only place that the index predicate for a type can ever
+ % be called from is the compare predicate for that type.
+ % However, the compare predicate for an equivalence type
+ % never calls the index predicate for that type; it calls
+ % the compare predicate of the expanded type instead.
+ % We therefore do not generate index predicates for equivalence types.
+ %
+ % When we see an abstract type declaration, we do not declare an index
+ % predicate for that type, since the type definition may later define
+ % the type as an equivalence type. If the type does turn out to need
+ % an index predicate, its declaration will be generated together with
+ % its implementation.
+ %
+ % We also do not declare index predicates for types with hand defined
+ % RTTI, since such types do not have index predicates.
+ %
+ % What we do here for uu types does not matter much, since such types
+ % are not yet supported.
+
add_special_preds(Module0, TVarSet, Type, TypeId,
Body, Context, Status, Module) :-
- special_pred_list(SpecialPredIds),
(
(
Body = abstract_type
@@ -2739,9 +2757,15 @@
type_id_has_hand_defined_rtti(TypeId)
)
->
+ SpecialPredIds = [unify, compare],
add_special_pred_decl_list(SpecialPredIds, Module0, TVarSet,
Type, TypeId, Body, Context, Status, Module)
;
+ ( Body = eqv_type(_) ->
+ SpecialPredIds = [unify, compare]
+ ;
+ SpecialPredIds = [unify, index, compare]
+ ),
add_special_pred_list(SpecialPredIds, Module0, TVarSet,
Type, TypeId, Body, Context, Status, Module)
).
Index: compiler/rtti.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti.m,v
retrieving revision 1.2
diff -u -b -r1.2 rtti.m
--- compiler/rtti.m 2000/04/02 08:09:23 1.2
+++ compiler/rtti.m 2000/04/08 05:41:08
@@ -282,7 +282,6 @@
rtti_type_id, % identifies the type ctor
maybe(code_addr), % unify
- maybe(code_addr), % index
maybe(code_addr), % compare
type_ctor_rep,
maybe(code_addr), % solver
Index: compiler/rtti_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_out.m,v
retrieving revision 1.6
diff -u -b -r1.6 rtti_out.m
--- compiler/rtti_out.m 2000/04/02 08:09:23 1.6
+++ compiler/rtti_out.m 2000/04/08 05:43:41
@@ -237,11 +237,11 @@
io__write_string(" = {\n"),
output_ptag_layout_defns(PtagLayouts, RttiTypeId),
io__write_string("\n};\n").
-output_rtti_data_defn(type_ctor_info(RttiTypeId, Unify, Index, Compare,
+output_rtti_data_defn(type_ctor_info(RttiTypeId, Unify, Compare,
CtorRep, Solver, Init, Version, NumPtags, NumFunctors,
FunctorsInfo, LayoutInfo, _MaybeHashCons, _Prettyprinter),
DeclSet0, DeclSet) -->
- { MaybeCodeAddrs = [Unify, Index, Compare, Solver, Init] },
+ { MaybeCodeAddrs = [Unify, Compare, Solver, Init] },
{ list__filter_map(pred(yes(CA)::in, CA::out) is semidet,
MaybeCodeAddrs, CodeAddrs) },
output_code_addrs_decls(CodeAddrs, "", "", 0, _, DeclSet0, DeclSet1),
@@ -256,7 +256,7 @@
io__write_string(",\n\t"),
output_maybe_static_code_addr(Unify),
io__write_string(",\n\t"),
- output_maybe_static_code_addr(Index),
+ output_maybe_static_code_addr(Unify),
io__write_string(",\n\t"),
output_maybe_static_code_addr(Compare),
io__write_string(",\n\t"),
@@ -482,7 +482,7 @@
RttiTypeId, du_stag_ordered_table(Ptag)).
rtti_data_to_name(du_ptag_ordered_table(RttiTypeId, _),
RttiTypeId, du_ptag_ordered_table).
-rtti_data_to_name(type_ctor_info(RttiTypeId, _,_,_,_,_,_,_,_,_,_,_,_,_),
+rtti_data_to_name(type_ctor_info(RttiTypeId, _,_,_,_,_,_,_,_,_,_,_,_),
RttiTypeId, type_ctor_info).
rtti_data_to_name(pseudo_type_info(PseudoTypeInfo), RttiTypeId,
pseudo_type_info(PseudoTypeInfo)) :-
@@ -575,7 +575,7 @@
rtti_out__init_rtti_data_if_nec(Data) -->
(
{ Data = type_ctor_info(RttiTypeId,
- _,_,_,_,_,_,_,_,_,_,_,_,_) }
+ _,_,_,_,_,_,_,_,_,_,_,_) }
->
io__write_string("\t\tMR_INIT_TYPE_CTOR_INFO(\n\t\t"),
output_rtti_addr(RttiTypeId, type_ctor_info),
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.4
diff -u -b -r1.4 type_ctor_info.m
--- compiler/type_ctor_info.m 2000/04/05 06:28:30 1.4
+++ compiler/type_ctor_info.m 2000/04/08 05:40:11
@@ -119,47 +119,30 @@
module_info_get_special_pred_map(ModuleInfo, SpecMap),
globals__lookup_bool_option(Globals, special_preds, SpecialPreds),
(
- SpecialPreds = yes,
-
- map__lookup(SpecMap, unify - TypeId, UnifyPredId),
- special_pred_mode_num(unify, UnifyProcInt),
- proc_id_to_int(UnifyProcId, UnifyProcInt),
- MaybeUnify = yes(proc(UnifyPredId, UnifyProcId)),
-
- map__lookup(SpecMap, index - TypeId, IndexPredId),
- special_pred_mode_num(index, IndexProcInt),
- proc_id_to_int(IndexProcId, IndexProcInt),
- MaybeIndex = yes(proc(IndexPredId, IndexProcId)),
-
- map__lookup(SpecMap, compare - TypeId, ComparePredId),
- special_pred_mode_num(compare, CompareProcInt),
- proc_id_to_int(CompareProcId, CompareProcInt),
- MaybeCompare = yes(proc(ComparePredId, CompareProcId))
+ (
+ SpecialPreds = yes
;
SpecialPreds = no,
hlds_data__get_type_defn_body(TypeDefn, Body),
- ( Body = du_type(_, _, _, yes(_UserDefinedEquality)) ->
+ Body = du_type(_, _, _, yes(_UserDefinedEquality))
+ )
+ ->
map__lookup(SpecMap, unify - TypeId, UnifyPredId),
special_pred_mode_num(unify, UnifyProcInt),
proc_id_to_int(UnifyProcId, UnifyProcInt),
MaybeUnify = yes(proc(UnifyPredId, UnifyProcId)),
- MaybeIndex = no,
-
map__lookup(SpecMap, compare - TypeId, ComparePredId),
special_pred_mode_num(compare, CompareProcInt),
proc_id_to_int(CompareProcId, CompareProcInt),
MaybeCompare = yes(proc(ComparePredId, CompareProcId))
;
MaybeUnify = no,
- MaybeIndex = no,
MaybeCompare = no
- )
),
TypeCtorGenInfo = type_ctor_gen_info(TypeId, ModuleName,
TypeName, TypeArity, Status, TypeDefn,
- MaybeUnify, MaybeIndex, MaybeCompare,
- no, no, no).
+ MaybeUnify, MaybeCompare, no, no, no).
%---------------------------------------------------------------------------%
@@ -197,10 +180,9 @@
ModuleInfo, TypeCtorData, TypeCtorTables) :-
TypeCtorGenInfo = type_ctor_gen_info(_TypeId, ModuleName, TypeName,
TypeArity, _Status, HldsDefn,
- MaybeUnify, MaybeIndex, MaybeCompare,
+ MaybeUnify, MaybeCompare,
MaybeSolver, MaybeInit, MaybePretty),
type_ctor_info__make_pred_addr(MaybeUnify, ModuleInfo, Unify),
- type_ctor_info__make_pred_addr(MaybeIndex, ModuleInfo, Index),
type_ctor_info__make_pred_addr(MaybeCompare, ModuleInfo, Compare),
type_ctor_info__make_pred_addr(MaybeSolver, ModuleInfo, Solver),
type_ctor_info__make_pred_addr(MaybeInit, ModuleInfo, Init),
@@ -226,7 +208,7 @@
),
Version = type_ctor_info_rtti_version,
RttiTypeId = rtti_type_id(ModuleName, TypeName, TypeArity),
- TypeCtorData = type_ctor_info(RttiTypeId, Unify, Index, Compare,
+ TypeCtorData = type_ctor_info(RttiTypeId, Unify, Compare,
TypeCtorRep, Solver, Init, Version, NumPtags, NumFunctors,
MaybeFunctors, MaybeLayout, no, Pretty).
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.81
diff -u -b -r1.81 unify_proc.m
--- compiler/unify_proc.m 2000/03/24 02:16:20 1.81
+++ compiler/unify_proc.m 2000/04/10 01:59:15
@@ -99,23 +99,24 @@
% special predicates (compare/3, index/3, unify, etc.)
:- pred unify_proc__generate_clause_info(special_pred_id, type,
- hlds_type_body, prog_context, module_info,
- clauses_info).
+ hlds_type_body, prog_context, module_info, clauses_info).
:- mode unify_proc__generate_clause_info(in, in, in, in, in, out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module tree, map, queue, int, string, require, assoc_list.
+:- import_module globals, options.
:- import_module code_util, code_info, type_util.
:- import_module mercury_to_mercury, hlds_out.
-:- import_module make_hlds, prog_util, prog_out, inst_match.
+:- import_module make_hlds, polymorphism, prog_util, prog_out.
:- import_module quantification, clause_to_proc, term, varset.
-:- import_module globals, options, modes, mode_util, (inst).
+:- import_module modes, mode_util, inst_match, instmap, (inst).
:- import_module switch_detection, cse_detection, det_analysis, unique_modes.
+:- import_module tree, map, set, queue, int, string, require, assoc_list.
+
% We keep track of all the complicated unification procs we need
% by storing them in the proc_requests structure.
% For each unify_proc_id (i.e. type & mode), we store the proc_id
@@ -483,12 +484,10 @@
Context, Clauses, VarTypeInfo1, VarTypeInfo)
; SpecialPredId = index, Args = [X, Index] ->
unify_proc__generate_index_clauses(TypeBody,
- X, Index, Context, Clauses, VarTypeInfo1,
- VarTypeInfo)
+ X, Index, Context, Clauses, VarTypeInfo1, VarTypeInfo)
; SpecialPredId = compare, Args = [Res, X, Y] ->
- unify_proc__generate_compare_clauses(TypeBody, Res,
- X, Y, Context, Clauses, VarTypeInfo1,
- VarTypeInfo)
+ unify_proc__generate_compare_clauses(Type, TypeBody,
+ Res, X, Y, Context, Clauses, VarTypeInfo1, VarTypeInfo)
;
error("unknown special pred")
),
@@ -605,20 +604,15 @@
)
;
{ TypeBody = eqv_type(_Type) },
- % We should check whether _Type is a type variable,
- % an abstract type or a concrete type.
- % If it is type variable, then we should generate the same code
- % we generate now. If it is an abstract type, we should call
- % its index procedure directly; if it is a concrete type,
- % we should generate the body of its index procedure
- % inline here.
- %
- % XXX Somebody should document here what the later stages
- % of the compiler do to prevent an infinite recursion here.
- { ArgVars = [X, Index] },
- unify_proc__build_call("index", ArgVars, Context, Goal),
- unify_proc__quantify_clause_body(ArgVars, Goal, Context,
- Clauses)
+ % The only place that the index predicate for a type can ever
+ % be called from is the compare predicate for that type.
+ % However, the compare predicate for an equivalence type
+ % never calls the index predicate for that type; it calls
+ % the compare predicate of the expanded type instead.
+ %
+ % Therefore the clause body we are generating should never be
+ % invoked.
+ { error("trying to create index proc for eqv type") }
;
{ TypeBody = uu_type(_) },
{ error("trying to create index proc for uu type") }
@@ -627,13 +621,12 @@
{ error("trying to create index proc for abstract type") }
).
-:- pred unify_proc__generate_compare_clauses(hlds_type_body, prog_var, prog_var,
- prog_var, prog_context, list(clause), unify_proc_info, unify_proc_info).
-:- mode unify_proc__generate_compare_clauses(in, in, in, in, in, out, in, out)
- is det.
+:- pred unify_proc__generate_compare_clauses((type)::in, hlds_type_body::in,
+ prog_var::in, prog_var::in, prog_var::in, prog_context::in,
+ list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det.
-unify_proc__generate_compare_clauses(TypeBody, Res, H1, H2, Context, Clauses)
- -->
+unify_proc__generate_compare_clauses(Type, TypeBody, Res, H1, H2, Context,
+ Clauses) -->
(
{ TypeBody = du_type(Ctors, _, IsEnum, MaybeEqPred) },
( { MaybeEqPred = yes(_) } ->
@@ -668,7 +661,7 @@
unify_proc__quantify_clause_body(ArgVars, Goal,
Context, Clauses)
;
- unify_proc__generate_du_compare_clauses(Ctors,
+ unify_proc__generate_du_compare_clauses(Type, Ctors,
Res, H1, H2, Context, Clauses)
)
;
@@ -840,8 +833,8 @@
we want to generate code
compare(Res, X, Y) :-
- index(X, X_Index), % Call_X_Index
- index(Y, Y_Index), % Call_Y_Index
+ __Index__(X, X_Index), % Call_X_Index
+ __Index__(Y, Y_Index), % Call_Y_Index
( X_Index < Y_Index -> % Call_Less_Than
Res = (<) % Return_Less_Than
; X_Index > Y_Index -> % Call_Greater_Than
@@ -870,19 +863,19 @@
).
*/
-:- pred unify_proc__generate_du_compare_clauses(
- list(constructor), prog_var, prog_var, prog_var, prog_context,
- list(clause), unify_proc_info, unify_proc_info).
-:- mode unify_proc__generate_du_compare_clauses(in, in, in, in, in,
- out, in, out) is det.
+:- pred unify_proc__generate_du_compare_clauses((type)::in,
+ list(constructor)::in, prog_var::in, prog_var::in, prog_var::in,
+ prog_context::in, list(clause)::out,
+ unify_proc_info::in, unify_proc_info::out) is det.
-unify_proc__generate_du_compare_clauses(Ctors, Res, X, Y, Context, [Clause]) -->
+unify_proc__generate_du_compare_clauses(Type, Ctors, Res, X, Y, Context,
+ [Clause]) -->
( { Ctors = [SingleCtor] } ->
unify_proc__generate_compare_case(SingleCtor, Res, X, Y,
Context, Goal)
;
- unify_proc__generate_du_compare_clauses_2(Ctors, Res, X, Y,
- Context, Goal)
+ unify_proc__generate_du_compare_clauses_2(Type, Ctors, Res,
+ X, Y, Context, Goal)
),
{ ArgVars = [Res, X, Y] },
unify_proc__info_get_varset(Varset0),
@@ -893,13 +886,13 @@
unify_proc__info_set_types(Types),
{ Clause = clause([], Body, Context) }.
-:- pred unify_proc__generate_du_compare_clauses_2(
- list(constructor), prog_var, prog_var, prog_var, prog_context,
- hlds_goal, unify_proc_info, unify_proc_info).
-:- mode unify_proc__generate_du_compare_clauses_2(in, in, in, in, in,
- out, in, out) is det.
+:- pred unify_proc__generate_du_compare_clauses_2((type)::in,
+ list(constructor)::in, prog_var::in, prog_var::in, prog_var::in,
+ prog_context::in, hlds_goal::out,
+ unify_proc_info::in, unify_proc_info::out) is det.
-unify_proc__generate_du_compare_clauses_2(Ctors, Res, X, Y, Context, Goal) -->
+unify_proc__generate_du_compare_clauses_2(Type, Ctors, Res, X, Y, Context,
+ Goal) -->
{ IntType = int_type },
{ mercury_public_builtin_module(MercuryBuiltin) },
{ construct_type(qualified(MercuryBuiltin, "comparison_result") - 0,
@@ -909,16 +902,19 @@
unify_proc__info_new_var(ResType, R),
{ goal_info_init(GoalInfo0) },
- { goal_info_set_context(GoalInfo0, Context,
- GoalInfo) },
-
- unify_proc__build_call("index", [X, X_Index], Context, Call_X_Index),
+ { goal_info_set_context(GoalInfo0, Context, GoalInfo) },
- unify_proc__build_call("index", [Y, Y_Index], Context, Call_Y_Index),
+ { instmap_delta_from_assoc_list([X_Index - ground(shared, no)],
+ X_InstmapDelta) },
+ unify_proc__build_specific_call(Type, index, [X, X_Index],
+ X_InstmapDelta, det, Context, Call_X_Index),
+ { instmap_delta_from_assoc_list([Y_Index - ground(shared, no)],
+ Y_InstmapDelta) },
+ unify_proc__build_specific_call(Type, index, [Y, Y_Index],
+ Y_InstmapDelta, det, Context, Call_Y_Index),
unify_proc__build_call("builtin_int_lt", [X_Index, Y_Index], Context,
Call_Less_Than),
-
unify_proc__build_call("builtin_int_gt", [X_Index, Y_Index], Context,
Call_Greater_Than),
@@ -1137,9 +1133,9 @@
},
{
predicate_table_search_pred_m_n_a(PredicateTable,
- MercuryBuiltin, Name, Arity, [PredId])
+ MercuryBuiltin, Name, Arity, [PredIdPrime])
->
- IndexPredId = PredId
+ PredId = PredIdPrime
;
prog_out__sym_name_to_string(qualified(MercuryBuiltin, Name),
QualName),
@@ -1150,12 +1146,40 @@
ErrorMessage),
error(ErrorMessage)
},
- { hlds_pred__initial_proc_id(ModeId) },
- { Call = call(IndexPredId, ModeId, ArgVars, not_builtin,
+ { hlds_pred__initial_proc_id(ProcId) },
+ { Call = call(PredId, ProcId, ArgVars, not_builtin,
no, qualified(MercuryBuiltin, Name)) },
{ goal_info_init(GoalInfo0) },
{ goal_info_set_context(GoalInfo0, Context, GoalInfo) },
{ Goal = Call - GoalInfo }.
+
+:- pred unify_proc__build_specific_call((type)::in, special_pred_id::in,
+ list(prog_var)::in, instmap_delta::in, determinism::in,
+ prog_context::in, hlds_goal::out,
+ unify_proc_info::in, unify_proc_info::out) is det.
+
+unify_proc__build_specific_call(Type, SpecialPredId, ArgVars, InstmapDelta,
+ Detism, Context, Goal) -->
+ unify_proc__info_get_module_info(ModuleInfo),
+ {
+ polymorphism__get_special_proc(Type, SpecialPredId, ModuleInfo,
+ PredName, PredId, ProcId)
+ ->
+ GoalExpr = call(PredId, ProcId, ArgVars, not_builtin, no,
+ PredName),
+ set__list_to_set(ArgVars, NonLocals),
+ goal_info_init(NonLocals, InstmapDelta, Detism, GoalInfo0),
+ goal_info_set_context(GoalInfo0, Context, GoalInfo),
+ Goal = GoalExpr - GoalInfo
+ ;
+ % unify_proc__build_specific_call is only ever used
+ % to build calls to special preds for a type in the
+ % bodies of other special preds for that same type.
+ % If the special preds for a type are built in the
+ % right order (index before compare), the lookup
+ % should never fail.
+ error("unify_proc__build_specific_call: lookup failed")
+ }.
%-----------------------------------------------------------------------------%
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
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/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
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/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/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing library
Index: library/array.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/array.m,v
retrieving revision 1.68
diff -u -b -r1.68 array.m
--- library/array.m 2000/03/10 01:21:29 1.68
+++ library/array.m 2000/04/08 08:52:25
@@ -280,7 +280,6 @@
BEGIN_MODULE(array_module_builtins)
init_entry(mercury____Unify___array__array_1_0);
- init_entry(mercury____Index___array__array_1_0);
init_entry(mercury____Compare___array__array_1_0);
BEGIN_CODE
@@ -288,10 +287,6 @@
/* this is implemented in Mercury, not hand-coded low-level C */
tailcall(ENTRY(mercury__array__array_equal_2_0),
ENTRY(mercury____Unify___array__array_1_0));
-
-Define_entry(mercury____Index___array__array_1_0);
- r1 = -1;
- proceed();
Define_entry(mercury____Compare___array__array_1_0);
/* this is implemented in Mercury, not hand-coded low-level C */
Index: library/builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/builtin.m,v
retrieving revision 1.29
diff -u -b -r1.29 builtin.m
--- library/builtin.m 2000/03/24 10:27:37 1.29
+++ library/builtin.m 2000/04/08 08:59:56
@@ -175,10 +175,9 @@
:- mode compare(uo, in, ui) is det.
:- mode compare(uo, in, in) is det.
- % index(X, N): if X is a discriminated union type, this is
- % true iff the top-level functor of X is the (N-1)th functor in its
- % type. If X is of type int, then it is true iff N = X.
- % Otherwise, it is true iff N = -1.
+ % This predicate is obsolete. It is required only while bootstrapping
+ % the change that deletes references to it by compiler-generated
+ % compare and index predicates.
:- pred index(T::in, int::out) is det.
% In addition, the following predicate-like constructs are builtin:
@@ -244,25 +243,21 @@
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL(builtin, , int, 0,
MR_TYPECTOR_REP_INT,
mercury__builtin_unify_int_2_0,
- mercury__builtin_index_int_2_0,
mercury__builtin_compare_int_3_0);
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL(builtin, , character, 0,
MR_TYPECTOR_REP_CHAR,
mercury__builtin_unify_character_2_0,
- mercury__builtin_index_character_2_0,
mercury__builtin_compare_character_3_0);
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL(builtin, , string, 0,
MR_TYPECTOR_REP_STRING,
mercury__builtin_unify_string_2_0,
- mercury__builtin_index_string_2_0,
mercury__builtin_compare_string_3_0);
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL(builtin, , float, 0,
MR_TYPECTOR_REP_FLOAT,
mercury__builtin_unify_float_2_0,
- mercury__builtin_index_float_2_0,
mercury__builtin_compare_float_3_0);
/*
@@ -273,12 +268,10 @@
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL(builtin, , func, 0,
MR_TYPECTOR_REP_PRED,
mercury__builtin_unify_pred_2_0,
- mercury__builtin_index_pred_2_0,
mercury__builtin_compare_pred_3_0);
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL(builtin, , pred, 0,
MR_TYPECTOR_REP_PRED,
mercury__builtin_unify_pred_2_0,
- mercury__builtin_index_pred_2_0,
mercury__builtin_compare_pred_3_0);
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_UNUSED(void, 0, MR_TYPECTOR_REP_VOID);
@@ -475,7 +468,6 @@
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_PRED(builtin, c_pointer, 0,
MR_TYPECTOR_REP_C_POINTER,
mercury____Unify___builtin__c_pointer_0_0,
- mercury____Index___builtin__c_pointer_0_0,
mercury____Compare___builtin__c_pointer_0_0);
BEGIN_MODULE(unify_c_pointer_module)
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.44
diff -u -b -r1.44 private_builtin.m
--- library/private_builtin.m 2000/04/03 16:23:01 1.44
+++ library/private_builtin.m 2000/04/08 09:16:26
@@ -291,7 +291,6 @@
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_PRED(private_builtin, type_ctor_info, 1,
MR_TYPECTOR_REP_TYPEINFO,
mercury____Unify___private_builtin__type_info_1_0,
- mercury____Index___private_builtin__type_info_1_0,
mercury____Compare___private_builtin__type_info_1_0);
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(private_builtin, type_info, 1,
MR_TYPECTOR_REP_TYPEINFO);
@@ -299,7 +298,6 @@
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_PRED(private_builtin, base_typeclass_info, 1,
MR_TYPECTOR_REP_TYPECLASSINFO,
mercury____Unify___private_builtin__typeclass_info_1_0,
- mercury____Index___private_builtin__typeclass_info_1_0,
mercury____Compare___private_builtin__typeclass_info_1_0);
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(private_builtin, typeclass_info, 1,
MR_TYPECTOR_REP_TYPECLASSINFO);
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/mercury_ho_call.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ho_call.c,v
retrieving revision 1.32
diff -u -b -r1.32 mercury_ho_call.c
--- runtime/mercury_ho_call.c 2000/04/05 06:28:57 1.32
+++ runtime/mercury_ho_call.c 2000/04/08 08:24:13
@@ -66,12 +66,10 @@
Define_extern_entry(mercury__do_call_class_method);
/*
-** These are the real implementations of unify, index and compare.
+** These are the real implementations of unify and compare.
*/
Define_extern_entry(mercury__unify_2_0);
-Define_extern_entry(mercury__index_2_0);
-Declare_label(mercury__index_2_0_i1);
Define_extern_entry(mercury__compare_3_0);
Define_extern_entry(mercury__compare_3_1);
Define_extern_entry(mercury__compare_3_2);
@@ -82,7 +80,6 @@
init_entry_ai(mercury__do_call_closure);
init_entry_ai(mercury__do_call_class_method);
init_entry_ai(mercury__unify_2_0);
- init_entry_ai(mercury__index_2_0);
init_entry_ai(mercury__compare_3_0);
init_entry_ai(mercury__compare_3_1);
init_entry_ai(mercury__compare_3_2);
@@ -220,153 +217,6 @@
#undef type_stat_struct
#undef attempt_msg
-}
-
-/*
-** mercury__index_2_0 is called as `index(TypeInfo, X, Index)'
-** in the mode `index(in, in, out) is det'.
-**
-** We call the type-specific index routine as
-** `IndexPred(...ArgTypeInfos..., X, Index)' is det.
-** The ArgTypeInfo and X arguments are input, while the Index argument
-** is output.
-*/
-
-Define_entry(mercury__index_2_0);
-{
- MR_TypeInfo type_info;
- MR_TypeCtorInfo type_ctor_info;
- Word x;
-
- type_info = (MR_TypeInfo) r1;
- x = r2;
-
- type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
-
-#ifdef MR_TYPE_CTOR_STATS
- MR_register_type_ctor_stat(&MR_type_stat_mer_index, type_ctor_info);
-#endif
-
- switch (type_ctor_info->type_ctor_rep) {
-
- /*
- ** For notag and equiv types, we should probably
- ** set type_info to refer to the appropriate type
- ** and then goto start. However, the code that we
- ** have here now works, even though it could be
- ** improved.
- */
-
- case MR_TYPECTOR_REP_ENUM_USEREQ:
- case MR_TYPECTOR_REP_DU:
- case MR_TYPECTOR_REP_DU_USEREQ:
- case MR_TYPECTOR_REP_NOTAG:
- case MR_TYPECTOR_REP_NOTAG_USEREQ:
- case MR_TYPECTOR_REP_NOTAG_GROUND:
- case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
- case MR_TYPECTOR_REP_EQUIV:
- case MR_TYPECTOR_REP_EQUIV_GROUND:
- case MR_TYPECTOR_REP_EQUIV_VAR:
- case MR_TYPECTOR_REP_ARRAY:
-
- /*
- ** We call the type-specific unify routine as
- ** `IndexPred(...ArgTypeInfos..., X, Index)' is det.
- ** The ArgTypeInfo arguments are input, and are passed
- ** in r1, r2, ... rN. The X argument is also input
- ** and is passed in rN+1. The index is output in r1.
- **
- ** We specialize the case where the type_ctor arity
- ** is zero, since in this case we don't need the loop.
- ** We could also specialize other arities; 1 and 2
- ** may be worthwhile.
- */
-
- if (type_ctor_info->arity == 0) {
- r1 = x;
- }
-#ifdef MR_UNIFY_COMPARE_BY_CTOR_REP_SPEC_1
- else if (type_ctor_info->arity == 1) {
- Word *args_base;
-
- args_base = (Word *)
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info);
- r1 = args_base[1];
- r2 = x;
- }
-#endif
-#ifdef MR_UNIFY_COMPARE_BY_CTOR_REP_SPEC_2
- else if (type_ctor_info->arity == 2) {
- Word *args_base;
-
- args_base = (Word *)
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info);
- r1 = args_base[1];
- r2 = args_base[2];
- r3 = x;
- }
-#endif
- else {
- int i;
- int type_arity;
- Word *args_base;
-
- type_arity = type_ctor_info->arity;
- args_base = (Word *)
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info);
- save_registers();
-
- /* IndexPred(...ArgTypeInfos..., X, Index) */
- for (i = 1; i <= type_arity; i++) {
- virtual_reg(i) = args_base[i];
- }
- virtual_reg(type_arity + 1) = x;
-
- restore_registers();
- }
-
- tailcall(type_ctor_info->index_pred,
- LABEL(mercury__index_2_0));
-
- case MR_TYPECTOR_REP_ENUM:
- case MR_TYPECTOR_REP_INT:
- case MR_TYPECTOR_REP_CHAR:
- r1 = x;
- proceed();
-
- case MR_TYPECTOR_REP_FLOAT:
- fatal_error("attempt to index a float");
-
- case MR_TYPECTOR_REP_STRING:
- fatal_error("attempt to index a string");
- proceed();
-
- case MR_TYPECTOR_REP_UNIV:
- fatal_error("attempt to index a term of type `univ'");
-
- case MR_TYPECTOR_REP_C_POINTER:
- r1 = x;
- proceed();
-
- case MR_TYPECTOR_REP_TYPEINFO:
- fatal_error("attempt to index a type_info");
-
- case MR_TYPECTOR_REP_VOID:
- fatal_error("attempt to index a term of type `void'");
-
- case MR_TYPECTOR_REP_PRED:
- fatal_error("attempt to index a higher-order term");
-
- case MR_TYPECTOR_REP_TYPECLASSINFO:
- fatal_error("attempt to index a typeclass_info");
-
- case MR_TYPECTOR_REP_UNKNOWN:
- fatal_error("attempt to index a term of unknown type");
-
- default:
- fatal_error("attempt to index a term "
- "of unknown representation");
- }
}
/*
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.45
diff -u -b -r1.45 mercury_type_info.h
--- runtime/mercury_type_info.h 2000/04/05 06:28:59 1.45
+++ runtime/mercury_type_info.h 2000/04/08 08:54:12
@@ -748,7 +748,7 @@
struct MR_TypeCtorInfo_Struct {
Integer arity;
Code *unify_pred;
- Code *index_pred;
+ Code *new_unify_pred;
Code *compare_pred;
MR_TypeCtorRep type_ctor_rep;
Code *solver_pred;
@@ -775,7 +775,7 @@
** structures for builtin and special types.
*/
-#define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL(m, cm, n, a, cr, u, i, c) \
+#define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL(m, cm, n, a, cr, u, c) \
Declare_entry(u); \
Declare_entry(i); \
Declare_entry(c); \
@@ -783,7 +783,7 @@
MR_PASTE6(mercury_data_, cm, __type_ctor_info_, n, _, a) = { \
a, \
MR_MAYBE_STATIC_CODE(ENTRY(u)), \
- MR_MAYBE_STATIC_CODE(ENTRY(i)), \
+ MR_MAYBE_STATIC_CODE(ENTRY(u)), \
MR_MAYBE_STATIC_CODE(ENTRY(c)), \
cr, \
NULL, \
@@ -797,19 +797,17 @@
-1 \
}
-#define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_PRED(m, n, a, cr, u, i, c) \
- MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL(m, m, n, a, cr, u, i, c)
+#define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_PRED(m, n, a, cr, u, c) \
+ MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL(m, m, n, a, cr, u, c)
#define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(m, n, a, cr) \
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL(m, m, n, a, cr, \
MR_PASTE7(mercury____Unify___, m, __, n, _, a, _0), \
- MR_PASTE7(mercury____Index___, m, __, n, _, a, _0), \
MR_PASTE7(mercury____Compare___, m, __, n, _, a, _0))
#define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_UNUSED(n, a, cr) \
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL(builtin, , n, a, cr, \
mercury__unused_0_0, \
- mercury__unused_0_0, \
mercury__unused_0_0)
/*---------------------------------------------------------------------------*/
@@ -856,21 +854,21 @@
#define MR_INIT_BUILTIN_TYPE_CTOR_INFO(B, T) \
do { \
(B).unify_pred = ENTRY(mercury__builtin_unify##T##2_0); \
- (B).index_pred = ENTRY(mercury__builtin_index##T##2_0); \
+ (B).new_unify_pred = ENTRY(mercury__builtin_unify##T##2_0); \
(B).compare_pred = ENTRY(mercury__builtin_compare##T##3_0); \
} while (0)
#define MR_INIT_TYPE_CTOR_INFO_WITH_PRED(B, P) \
do { \
(B).unify_pred = ENTRY(P); \
- (B).index_pred = ENTRY(P); \
+ (B).new_unify_pred = ENTRY(P); \
(B).compare_pred = ENTRY(P); \
} while (0)
#define MR_INIT_TYPE_CTOR_INFO(B, T) \
do { \
(B).unify_pred = ENTRY(mercury____##Unify##___##T); \
- (B).index_pred = ENTRY(mercury____##Index##___##T); \
+ (B).new_unify_pred = ENTRY(mercury____##Unify##___##T); \
(B).compare_pred = ENTRY(mercury____##Compare##___##T); \
} while (0)
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/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/misc_tests
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 trial
cvs diff: Diffing util
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list