[m-dev.] for review: generate special preds lazily
Simon Taylor
stayl at cs.mu.OZ.AU
Sat Sep 9 12:48:35 AEDT 2000
Estimated hours taken: 10
Generate declarations and clauses for the compiler-generated
unification and comparison procedures only when they are needed.
The vast majority of these procedures are never used.
This change speeds up `mmc -C make_hlds' by about 5%.
compiler/make_hlds.m:
Export add_special_pred_for_real and add_special_pred_decl_for_real
for use by unify_proc.m.
Don't generate declarations or clauses for unification or
comparison predicates for imported types immediately
unless the predicate needs to be typechecked.
Don't generate clauses for comparison predicates for
imported types -- they will never be used because the
predicate has import_status `imported'.
compiler/special_pred.m:
compiler/typecheck.m:
Add predicate special_pred_for_type_needs_typecheck,
which succeeds for types with user-defined equality
and types with existentially typed constructors.
compiler/unify_proc.m:
Make sure the declarations and clauses for the unification
predicate for a type have been generated before processing a
unify_request for that type.
Add predicates for use by higher_order.m to force generation
of a special predicate when required for specialization
of a call to unify/2 or compare/3.
Simplify the code for unification predicates for enumeration
types. The code that was being generated cast the arguments
to int, then called unify/2 on the ints. The simpler version
just creates a unify goal. Enumerations are atomic types, so
modecheck_unify.m will treat the unification as a simple_test.
compiler/polymorphism.m:
Add a predicate polymorphism__process_generated_pred to
be used by unify_proc.m to process the bodies of the
generated unification predicates.
compiler/post_typecheck.m:
Add versions of post_typecheck__finish_pred and
post_typecheck__finish_imported_pred which don't require
an io__state, for use by unify_proc.m. Errors should never
be reported in post_typecheck.m for unification or
comparison predicates.
compiler/simplify.m:
Don't generate calls to the type-specific predicate
for an in-in complicated unification if the predicate is
generated lazily. higher_order.m will handle the
specialization in that case.
compiler/higher_order.m:
Call unify_proc.m to generate the declarations for a
special pred when there is a call to that special pred
which could be specialized.
Add field labels to the higher_order_info type.
compiler/type_util.m:
Add predicates type_id_is_atomic and classify_type_id,
which are similar to type_is_atomic and classify_type,
for use by special_pred.m.
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.71
diff -u -u -r1.71 higher_order.m
--- compiler/higher_order.m 2000/09/08 12:20:29 1.71
+++ compiler/higher_order.m 2000/09/09 01:22:01
@@ -39,7 +39,7 @@
:- import_module code_util, globals, mode_util, goal_util.
:- import_module type_util, options, prog_data, prog_out, quantification.
:- import_module mercury_to_mercury, inlining, polymorphism, prog_util.
-:- import_module special_pred, passes_aux.
+:- import_module special_pred, unify_proc, passes_aux.
:- import_module assoc_list, bool, char, int, list, map, require, set.
:- import_module std_util, string, varset, term.
@@ -228,17 +228,21 @@
% used while traversing goals
:- type higher_order_info
---> info(
- pred_vars, % higher_order variables
- set(request), % requested versions
- new_preds, % versions created in
+ pred_vars :: pred_vars, % higher_order variables
+ requests :: set(request), % requested versions
+ new_preds :: new_preds,
+ % versions created in
% previous iterations
% not changed by traverse_goal
- pred_proc_id, % pred_proc_id of goal being traversed
- pred_info, % pred_info of goal being traversed
- proc_info, % proc_info of goal being traversed
- module_info, % not changed by traverse_goal
- ho_params,
- changed
+ pred_proc_id :: pred_proc_id,
+ % pred_proc_id of goal being traversed
+ pred_info :: pred_info,
+ % pred_info of goal being traversed
+ proc_info :: proc_info,
+ % proc_info of goal being traversed
+ module_info :: module_info,
+ params :: ho_params,
+ changed :: changed
).
:- type ho_params
@@ -1662,12 +1666,13 @@
Index = Index0
),
list__index1_det(OtherVars, Index, TypeInfoArg),
- maybe_add_alias(TypeInfoVar, TypeInfoArg, Info0, Info),
+ maybe_add_alias(TypeInfoVar, TypeInfoArg, Info0, Info1),
Uni = assign(TypeInfoVar, TypeInfoArg),
in_mode(In),
out_mode(Out),
Goal = unify(TypeInfoVar, var(TypeInfoArg), Out - In,
- Uni, unify_context(explicit, []))
+ Uni, unify_context(explicit, [])),
+ higher_order_info_update_changed_status(changed, Info1, Info)
;
Goal = Goal0,
Info = Info0
@@ -1683,7 +1688,9 @@
specialize_special_pred(CalledPred, CalledProc, Args,
MaybeContext, HaveSpecialPreds, Goal, Info0, Info) :-
- Info0 = info(PredVars, B, C, D, E, ProcInfo0, ModuleInfo, H, I),
+ ModuleInfo = Info0 ^ module_info,
+ ProcInfo0 = Info0 ^ proc_info,
+ PredVars = Info0 ^ pred_vars,
proc_info_vartypes(ProcInfo0, VarTypes),
module_info_pred_info(ModuleInfo, CalledPred, CalledPredInfo),
mercury_public_builtin_module(PublicBuiltin),
@@ -1773,8 +1780,7 @@
Detism, GoalInfo),
Goal = conj([CastGoal1, CastGoal2,
Call - GoalInfo]),
- Info = info(PredVars, B, C, D, E, ProcInfo,
- ModuleInfo, H, I)
+ Info = Info0 ^ proc_info := ProcInfo
)
)
;
@@ -1826,8 +1832,7 @@
GoalInfo),
Goal = conj([ExtractGoal1, ExtractGoal2,
SpecialGoal - GoalInfo]),
- Info = info(PredVars, B, C, D, E, ProcInfo2,
- ModuleInfo, H, I)
+ Info = Info0 ^ proc_info := ProcInfo2
;
SpecialId = compare,
SpecialPredArgs = [ComparisonResult, _, _],
@@ -1854,8 +1859,7 @@
GoalInfo),
Goal = conj([ExtractGoal1, ExtractGoal2,
SpecialGoal - GoalInfo]),
- Info = info(PredVars, B, C, D, E, ProcInfo2,
- ModuleInfo, H, I)
+ Info = Info0 ^ proc_info := ProcInfo2
;
NeedIntCast = yes,
generate_unsafe_type_cast(ModuleInfo,
@@ -1874,8 +1878,7 @@
Goal = conj([ExtractGoal1, CastGoal1,
ExtractGoal2, CastGoal2,
SpecialGoal - GoalInfo]),
- Info = info(PredVars, B, C, D, E, ProcInfo4,
- ModuleInfo, H, I)
+ Info = Info0 ^ proc_info := ProcInfo4
)
)
;
@@ -1883,8 +1886,8 @@
% to call the type-specific unify or compare predicate
% if we are generating such predicates.
HaveSpecialPreds = yes,
- polymorphism__get_special_proc(SpecialPredType, SpecialId,
- ModuleInfo, SymName, SpecialPredId, SpecialProcId),
+ find_special_proc(SpecialPredType, SpecialId,
+ SymName, SpecialPredId, SpecialProcId, Info0, Info),
( type_is_higher_order(SpecialPredType, _, _, _) ->
% builtin_*_pred are special cases which
% doesn't need the type-info arguments.
@@ -1893,8 +1896,59 @@
list__append(TypeInfoArgs, SpecialPredArgs, CallArgs)
),
Goal = call(SpecialPredId, SpecialProcId, CallArgs,
- not_builtin, MaybeContext, SymName),
- Info = Info0
+ not_builtin, MaybeContext, SymName)
+ ).
+
+:- pred find_special_proc((type)::in, special_pred_id::in, sym_name::out,
+ pred_id::out, proc_id::out, higher_order_info::in,
+ higher_order_info::out) is semidet.
+
+find_special_proc(Type, SpecialId, SymName, PredId, ProcId, Info0, Info) :-
+ ModuleInfo0 = Info0 ^ module_info,
+ (
+ polymorphism__get_special_proc(Type, SpecialId,
+ ModuleInfo0, SymName0, PredId0, ProcId0)
+ ->
+ SymName = SymName0,
+ PredId = PredId0,
+ ProcId = ProcId0,
+ Info = Info0
+ ;
+ type_to_type_id(Type, TypeId, _),
+ special_pred_is_generated_lazily(ModuleInfo, TypeId),
+ (
+ SpecialId = compare,
+ unify_proc__add_lazily_generated_compare_pred_decl(TypeId,
+ PredId, ModuleInfo0, ModuleInfo),
+ hlds_pred__initial_proc_id(ProcId)
+ ;
+ SpecialId = index,
+ % This shouldn't happen. The index predicate should
+ % only be called from the compare predicate. If it
+ % is called, it shouldn't be generated lazily.
+ fail
+ ;
+ SpecialId = unify,
+
+ %
+ % XXX We should only add the declaration, not the body,
+ % for the unify pred, but that complicates things
+ % if mode analysis is rerun after higher_order.m and
+ % requests more unification procedures. In particular,
+ % it's difficult to run polymorphism on the new clauses
+ % if the predicate's arguments have already had type-infos
+ % added. This case shouldn't come up unless an optimization
+ % does reordering which requires rescheduling a conjunction.
+ %
+ unify_proc__add_lazily_generated_unify_pred(TypeId,
+ PredId, ModuleInfo0, ModuleInfo),
+ hlds_pred__in_in_unification_proc_id(ProcId)
+ ),
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_module(PredInfo, ModuleName),
+ pred_info_name(PredInfo, Name),
+ SymName = qualified(ModuleName, Name),
+ Info = Info0 ^ module_info := ModuleInfo
).
:- pred find_builtin_type_with_equivalent_compare(module_info::in,
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.347
diff -u -u -r1.347 make_hlds.m
--- compiler/make_hlds.m 2000/09/08 06:01:54 1.347
+++ compiler/make_hlds.m 2000/09/09 00:21:06
@@ -22,8 +22,8 @@
:- module make_hlds.
:- interface.
-:- import_module prog_data, hlds_module, hlds_pred.
-:- import_module equiv_type, module_qual.
+:- import_module prog_data, hlds_data, hlds_module, hlds_pred.
+:- import_module equiv_type, module_qual, special_pred.
:- import_module io, std_util, list, bool.
@@ -47,6 +47,31 @@
:- pred clauses_info_init(int::in, clauses_info::out) is det.
+ % add_special_pred_for_real(SpecialPredId, ModuleInfo0, TVarSet,
+ % Type, TypeId, TypeBody, TypeContext, TypeStatus, ModuleInfo).
+ %
+ % Add declarations and clauses for a special predicate.
+ % This is used by unify_proc.m to add a unification predicate
+ % for an imported type for which special predicates are being
+ % generated only when a unification procedure is requested
+ % during mode analysis.
+:- pred add_special_pred_for_real(special_pred_id,
+ module_info, tvarset, type, type_id, hlds_type_body,
+ prog_context, import_status, module_info).
+:- mode add_special_pred_for_real(in, in, in, in, in, in, in, in, out) is det.
+
+ % add_special_pred_decl_for_real(SpecialPredId, ModuleInfo0, TVarSet,
+ % Type, TypeId, TypeContext, TypeStatus, ModuleInfo).
+ %
+ % Add declarations for a special predicate.
+ % This is used by higher_order.m when specializing an in-in
+ % unification for an imported type for which unification procedures
+ % are generated lazily.
+:- pred add_special_pred_decl_for_real(special_pred_id,
+ module_info, tvarset, type, type_id, prog_context,
+ import_status, module_info).
+:- mode add_special_pred_decl_for_real(in, in, in, in, in, in, in, out) is det.
+
:- type qual_info.
% Given the definition for a predicate or function from a
@@ -67,11 +92,11 @@
:- implementation.
-:- import_module hlds_data, hlds_goal.
+:- import_module hlds_goal.
:- import_module prog_io, prog_io_goal, prog_io_dcg, prog_io_util, prog_out.
-:- import_module modules, module_qual, prog_util, options, hlds_out.
+:- import_module modules, module_qual, prog_util, options, hlds_out, typecheck.
:- import_module make_tags, quantification, (inst), globals.
-:- import_module code_util, unify_proc, special_pred, type_util, mode_util.
+:- import_module code_util, unify_proc, type_util, mode_util.
:- import_module mercury_to_mercury, passes_aux, clause_to_proc, inst_match.
:- import_module fact_table, purity, goal_util, term_util, export, llds.
:- import_module error_util.
@@ -2884,29 +2909,48 @@
add_special_preds(Module0, TVarSet, Type, TypeId,
Body, Context, Status, Module) :-
(
- (
- Body = abstract_type
- ;
- Body = uu_type(_)
- ;
- type_id_has_hand_defined_rtti(TypeId)
- )
+ special_pred_is_generated_lazily(Module0,
+ TypeId, Body, Status)
->
- SpecialPredIds = [unify, compare],
- add_special_pred_decl_list(SpecialPredIds, Module0, TVarSet,
- Type, TypeId, Body, Context, Status, Module)
+ Module = Module0
;
+ can_generate_special_pred_clauses_for_type(TypeId, Body)
+ ->
+ add_special_pred(unify, Module0, TVarSet, Type, TypeId,
+ Body, Context, Status, Module1),
(
- Body = du_type(Ctors, _, IsEnum, UserDefinedEquality),
- IsEnum = no,
- UserDefinedEquality = no,
- Ctors = [_, _|_]
+ status_defined_in_this_module(Status, yes)
->
- SpecialPredIds = [unify, index, compare]
- ;
- SpecialPredIds = [unify, compare]
- ),
- add_special_pred_list(SpecialPredIds, Module0, TVarSet,
+ (
+ Body = du_type(Ctors, _, IsEnum,
+ UserDefinedEquality),
+ IsEnum = no,
+ UserDefinedEquality = no,
+ Ctors = [_, _|_]
+ ->
+ SpecialPredIds = [index, compare]
+ ;
+ SpecialPredIds = [compare]
+ ),
+ add_special_pred_list(SpecialPredIds,
+ Module1, TVarSet, Type, TypeId,
+ Body, Context, Status, Module)
+ ;
+ % Never add clauses for comparison predicates
+ % for imported types -- they will never be used.
+ module_info_get_special_pred_map(Module1,
+ SpecialPreds),
+ ( map__contains(SpecialPreds, compare - TypeId) ->
+ Module = Module1
+ ;
+ add_special_pred_decl(compare, Module1,
+ TVarSet, Type, TypeId, Body,
+ Context, Status, Module)
+ )
+ )
+ ;
+ SpecialPredIds = [unify, compare],
+ add_special_pred_decl_list(SpecialPredIds, Module0, TVarSet,
Type, TypeId, Body, Context, Status, Module)
).
@@ -2970,11 +3014,6 @@
)
).
-:- pred add_special_pred_for_real(special_pred_id,
- module_info, tvarset, type, type_id, hlds_type_body,
- prog_context, import_status, module_info).
-:- mode add_special_pred_for_real(in, in, in, in, in, in, in, in, out) is det.
-
add_special_pred_for_real(SpecialPredId,
Module0, TVarSet, Type, TypeId, TypeBody, Context, Status0,
Module) :-
@@ -3054,11 +3093,6 @@
;
Module = Module0
).
-
-:- pred add_special_pred_decl_for_real(special_pred_id,
- module_info, tvarset, type, type_id, prog_context,
- import_status, module_info).
-:- mode add_special_pred_decl_for_real(in, in, in, in, in, in, in, out) is det.
add_special_pred_decl_for_real(SpecialPredId,
Module0, TVarSet, Type, TypeId, Context, Status0,
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.197
diff -u -u -r1.197 polymorphism.m
--- compiler/polymorphism.m 2000/09/07 01:46:45 1.197
+++ compiler/polymorphism.m 2000/09/09 01:20:53
@@ -190,6 +190,23 @@
io__state, io__state).
:- mode polymorphism__process_module(in, out, di, uo) is det.
+% Run the polymorphism pass over a single pred.
+% This is used to transform clauses introduced by unify_proc.m
+% for complicated unification predicates for types
+% for which unification predicates are generated lazily.
+%
+% This predicate should be used with caution. polymorphism.m
+% expects that the argument types of called predicates have not
+% been transformed yet. This predicate will not work correctly
+% after the original pass of polymorphism has been run if the
+% predicate to be processed calls any polymorphic predicates
+% which require type_infos or typeclass_infos to be added to
+% the argument list.
+
+:- pred polymorphism__process_generated_pred(pred_id,
+ module_info, module_info).
+:- mode polymorphism__process_generated_pred(in, in, out) is det.
+
% Add the type_info variables for a complicated unification to
% the appropriate fields in the unification and the goal_info.
@@ -370,9 +387,16 @@
:- pred polymorphism__fixup_preds(list(pred_id), module_info, module_info).
:- mode polymorphism__fixup_preds(in, in, out) is det.
+
+polymorphism__fixup_preds(PredIds, ModuleInfo0, ModuleInfo) :-
+ list__foldl(polymorphism__fixup_pred,
+ PredIds, ModuleInfo0, ModuleInfo).
+
+:- pred polymorphism__fixup_pred(pred_id, module_info, module_info).
+:- mode polymorphism__fixup_pred(in, in, out) is det.
-polymorphism__fixup_preds([], ModuleInfo, ModuleInfo).
-polymorphism__fixup_preds([PredId | PredIds], ModuleInfo0, ModuleInfo) :-
+polymorphism__fixup_pred(PredId, ModuleInfo0, ModuleInfo) :-
+
%
% Recompute the arg types by finding the headvars and
% the var->type mapping (from the clauses_info) and
@@ -448,9 +472,7 @@
),
map__det_update(PredTable0, PredId, PredInfo, PredTable),
- module_info_set_preds(ModuleInfo0, PredTable, ModuleInfo1),
-
- polymorphism__fixup_preds(PredIds, ModuleInfo1, ModuleInfo).
+ module_info_set_preds(ModuleInfo0, PredTable, ModuleInfo).
%---------------------------------------------------------------------------%
@@ -459,38 +481,46 @@
:- mode polymorphism__process_pred(in, in, out, di, uo) is det.
polymorphism__process_pred(PredId, ModuleInfo0, ModuleInfo) -->
- { module_info_pred_info(ModuleInfo0, PredId, PredInfo0) },
-
write_pred_progress_message("% Transforming polymorphism for ",
PredId, ModuleInfo0),
+ { polymorphism__process_pred(PredId, ModuleInfo0, ModuleInfo) }.
+
+polymorphism__process_generated_pred(PredId, ModuleInfo0, ModuleInfo) :-
+ polymorphism__process_pred(PredId, ModuleInfo0, ModuleInfo1),
+ polymorphism__fixup_pred(PredId, ModuleInfo1, ModuleInfo).
+:- pred polymorphism__process_pred(pred_id, module_info, module_info).
+:- mode polymorphism__process_pred(in, in, out) is det.
+
+polymorphism__process_pred(PredId, ModuleInfo0, ModuleInfo) :-
+ module_info_pred_info(ModuleInfo0, PredId, PredInfo0),
%
% run the polymorphism pass over the clauses_info,
% updating the headvars, goals, varsets, types, etc.,
% and computing some information in the poly_info.
%
- { pred_info_clauses_info(PredInfo0, ClausesInfo0) },
- { polymorphism__process_clause_info(
+ pred_info_clauses_info(PredInfo0, ClausesInfo0),
+ polymorphism__process_clause_info(
ClausesInfo0, PredInfo0, ModuleInfo0,
- ClausesInfo, PolyInfo, ExtraArgModes) },
- { poly_info_get_module_info(PolyInfo, ModuleInfo1) },
- { poly_info_get_typevarset(PolyInfo, TypeVarSet) },
- { pred_info_set_typevarset(PredInfo0, TypeVarSet, PredInfo1) },
- { pred_info_set_clauses_info(PredInfo1, ClausesInfo, PredInfo2) },
+ ClausesInfo, PolyInfo, ExtraArgModes),
+ poly_info_get_module_info(PolyInfo, ModuleInfo1),
+ poly_info_get_typevarset(PolyInfo, TypeVarSet),
+ pred_info_set_typevarset(PredInfo0, TypeVarSet, PredInfo1),
+ pred_info_set_clauses_info(PredInfo1, ClausesInfo, PredInfo2),
%
% do a pass over the proc_infos, copying the relevant information
% from the clauses_info and the poly_info, and updating all
% the argmodes with modes for the extra arguments.
%
- { pred_info_procids(PredInfo2, ProcIds) },
- { pred_info_procedures(PredInfo2, Procs0) },
- { polymorphism__process_procs(ProcIds, Procs0, PredInfo2, ClausesInfo,
- ExtraArgModes, Procs) },
- { pred_info_set_procedures(PredInfo2, Procs, PredInfo) },
+ pred_info_procids(PredInfo2, ProcIds),
+ pred_info_procedures(PredInfo2, Procs0),
+ polymorphism__process_procs(ProcIds, Procs0, PredInfo2, ClausesInfo,
+ ExtraArgModes, Procs),
+ pred_info_set_procedures(PredInfo2, Procs, PredInfo),
- { module_info_set_pred_info(ModuleInfo1, PredId, PredInfo,
- ModuleInfo) }.
+ module_info_set_pred_info(ModuleInfo1, PredId, PredInfo,
+ ModuleInfo).
:- pred polymorphism__process_clause_info(clauses_info, pred_info, module_info,
clauses_info, poly_info, list(mode)).
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.27
diff -u -u -r1.27 post_typecheck.m
--- compiler/post_typecheck.m 2000/09/08 12:20:37 1.27
+++ compiler/post_typecheck.m 2000/09/08 12:21:37
@@ -87,7 +87,7 @@
% so that a pred is ready for running polymorphism and then
% mode checking.
% Also check that all predicates with an `aditi' marker have
- % an `aditi:state' argument.
+ % an `aditi__state' argument.
%
:- pred post_typecheck__finish_pred(module_info, pred_id, pred_info, pred_info,
io__state, io__state).
@@ -97,6 +97,18 @@
pred_info, pred_info, io__state, io__state).
:- mode post_typecheck__finish_imported_pred(in, in, in, out, di, uo) is det.
+ % As above, but don't check for `aditi__state's and return
+ % the list of procedures containing unbound inst variables
+ % instead of reporting the errors directly.
+ %
+:- pred post_typecheck__finish_pred_no_io(module_info, list(proc_id),
+ pred_info, pred_info).
+:- mode post_typecheck__finish_pred_no_io(in, out, in, out) is det.
+
+:- pred post_typecheck__finish_imported_pred_no_io(module_info,
+ list(proc_id), pred_info, pred_info).
+:- mode post_typecheck__finish_imported_pred_no_io(in, out, in, out) is det.
+
:- pred post_typecheck__finish_ill_typed_pred(module_info, pred_id,
pred_info, pred_info, io__state, io__state).
:- mode post_typecheck__finish_ill_typed_pred(in, in, in, out, di, uo) is det.
@@ -600,9 +612,15 @@
% declarations are module qualified.
%
post_typecheck__finish_pred(ModuleInfo, PredId, PredInfo0, PredInfo) -->
- post_typecheck__propagate_types_into_modes(ModuleInfo, PredId,
- PredInfo0, PredInfo).
-
+ { post_typecheck__finish_pred_no_io(ModuleInfo,
+ ErrorProcs, PredInfo0, PredInfo1) },
+ report_unbound_inst_vars(ModuleInfo, PredId,
+ ErrorProcs, PredInfo1, PredInfo).
+
+post_typecheck__finish_pred_no_io(ModuleInfo, ErrorProcs,
+ PredInfo0, PredInfo) :-
+ post_typecheck__propagate_types_into_modes(ModuleInfo,
+ ErrorProcs, PredInfo0, PredInfo).
%
% For ill-typed preds, we just need to set the modes up correctly
@@ -611,8 +629,10 @@
%
post_typecheck__finish_ill_typed_pred(ModuleInfo, PredId,
PredInfo0, PredInfo) -->
- post_typecheck__propagate_types_into_modes(ModuleInfo, PredId,
- PredInfo0, PredInfo).
+ { post_typecheck__propagate_types_into_modes(ModuleInfo,
+ ErrorProcs, PredInfo0, PredInfo1) },
+ report_unbound_inst_vars(ModuleInfo, PredId,
+ ErrorProcs, PredInfo1, PredInfo).
%
% For imported preds, we just need to ensure that all
@@ -631,12 +651,18 @@
;
[]
),
+ { post_typecheck__finish_imported_pred_no_io(ModuleInfo, ErrorProcs,
+ PredInfo0, PredInfo1) },
+ report_unbound_inst_vars(ModuleInfo, PredId,
+ ErrorProcs, PredInfo1, PredInfo).
+post_typecheck__finish_imported_pred_no_io(ModuleInfo, Errors,
+ PredInfo0, PredInfo) :-
% Make sure the var-types field in the clauses_info is
% valid for imported predicates.
% Unification procedures have clauses generated, so
% they already have valid var-types.
- { pred_info_is_pseudo_imported(PredInfo0) ->
+ ( pred_info_is_pseudo_imported(PredInfo0) ->
PredInfo1 = PredInfo0
;
pred_info_clauses_info(PredInfo0, ClausesInfo0),
@@ -645,9 +671,9 @@
map__from_corresponding_lists(HeadVars, ArgTypes, VarTypes),
clauses_info_set_vartypes(ClausesInfo0, VarTypes, ClausesInfo),
pred_info_set_clauses_info(PredInfo0, ClausesInfo, PredInfo1)
- },
- post_typecheck__propagate_types_into_modes(ModuleInfo, PredId,
- PredInfo1, PredInfo).
+ ),
+ post_typecheck__propagate_types_into_modes(ModuleInfo,
+ Errors, PredInfo1, PredInfo).
%
% Now that the assertion has finished being typechecked,
@@ -729,51 +755,69 @@
% Ensure that all constructors occurring in predicate mode
% declarations are module qualified.
%
-:- pred post_typecheck__propagate_types_into_modes(module_info, pred_id,
- pred_info, pred_info, io__state, io__state).
-:- mode post_typecheck__propagate_types_into_modes(in, in, in, out, di, uo)
+:- pred post_typecheck__propagate_types_into_modes(module_info,
+ list(proc_id), pred_info, pred_info).
+:- mode post_typecheck__propagate_types_into_modes(in, out, in, out)
is det.
-post_typecheck__propagate_types_into_modes(ModuleInfo, PredId, PredInfo0,
- PredInfo) -->
- { pred_info_arg_types(PredInfo0, ArgTypes) },
- { pred_info_procedures(PredInfo0, Procs0) },
- { pred_info_procids(PredInfo0, ProcIds) },
-
- propagate_types_into_proc_modes(ModuleInfo, PredId, ProcIds, ArgTypes,
- Procs0, Procs),
- { pred_info_set_procedures(PredInfo0, Procs, PredInfo) }.
+post_typecheck__propagate_types_into_modes(ModuleInfo, ErrorProcs,
+ PredInfo0, PredInfo) :-
+ pred_info_arg_types(PredInfo0, ArgTypes),
+ pred_info_procedures(PredInfo0, Procs0),
+ pred_info_procids(PredInfo0, ProcIds),
+ propagate_types_into_proc_modes(ModuleInfo, ProcIds, ArgTypes,
+ [], ErrorProcs, Procs0, Procs),
+ pred_info_set_procedures(PredInfo0, Procs, PredInfo).
%-----------------------------------------------------------------------------%
-:- pred propagate_types_into_proc_modes(module_info,
- pred_id, list(proc_id), list(type), proc_table, proc_table,
- io__state, io__state).
-:- mode propagate_types_into_proc_modes(in,
- in, in, in, in, out, di, uo) is det.
+:- pred propagate_types_into_proc_modes(module_info, list(proc_id),
+ list(type), list(proc_id), list(proc_id), proc_table, proc_table).
+:- mode propagate_types_into_proc_modes(in, in, in, in, out, in, out) is det.
+propagate_types_into_proc_modes(_, [], _,
+ ErrorProcs, list__reverse(ErrorProcs), Procs, Procs).
+propagate_types_into_proc_modes(ModuleInfo, [ProcId | ProcIds],
+ ArgTypes, ErrorProcs0, ErrorProcs, Procs0, Procs) :-
+ map__lookup(Procs0, ProcId, ProcInfo0),
+ proc_info_argmodes(ProcInfo0, ArgModes0),
+ propagate_types_into_mode_list(ArgTypes, ModuleInfo,
+ ArgModes0, ArgModes),
-propagate_types_into_proc_modes(_, _, [], _, Procs, Procs) --> [].
-propagate_types_into_proc_modes(ModuleInfo, PredId,
- [ProcId | ProcIds], ArgTypes, Procs0, Procs) -->
- { map__lookup(Procs0, ProcId, ProcInfo0) },
- { proc_info_argmodes(ProcInfo0, ArgModes0) },
- { propagate_types_into_mode_list(ArgTypes, ModuleInfo,
- ArgModes0, ArgModes) },
%
% check for unbound inst vars
% (this needs to be done after propagate_types_into_mode_list,
% because we need the insts to be module-qualified; and it
% needs to be done before mode analysis, to avoid internal errors)
%
- ( { mode_list_contains_inst_var(ArgModes, ModuleInfo, _InstVar) } ->
- unbound_inst_var_error(PredId, ProcInfo0, ModuleInfo),
- % delete this mode, to avoid internal errors
- { map__det_remove(Procs0, ProcId, _, Procs1) }
- ;
- { proc_info_set_argmodes(ProcInfo0, ArgModes, ProcInfo) },
- { map__det_update(Procs0, ProcId, ProcInfo, Procs1) }
+ ( mode_list_contains_inst_var(ArgModes, ModuleInfo, _InstVar) ->
+ ErrorProcs1 = [ProcId | ErrorProcs0],
+ Procs1 = Procs0
+ ;
+ ErrorProcs1 = ErrorProcs0,
+ proc_info_set_argmodes(ProcInfo0, ArgModes, ProcInfo),
+ map__det_update(Procs0, ProcId, ProcInfo, Procs1)
),
- propagate_types_into_proc_modes(ModuleInfo, PredId, ProcIds,
- ArgTypes, Procs1, Procs).
+ propagate_types_into_proc_modes(ModuleInfo, ProcIds,
+ ArgTypes, ErrorProcs1, ErrorProcs, Procs1, Procs).
+
+:- pred report_unbound_inst_vars(module_info, pred_id, list(proc_id),
+ pred_info, pred_info, io__state, io__state).
+:- mode report_unbound_inst_vars(in, in, in, in, out, di, uo) is det.
+
+report_unbound_inst_vars(ModuleInfo, PredId, ErrorProcs,
+ PredInfo0, PredInfo) -->
+ ( { ErrorProcs = [] } ->
+ { PredInfo = PredInfo0 }
+ ;
+ { pred_info_procedures(PredInfo0, ProcTable0) },
+ list__foldl2(
+ (pred(ProcId::in, Procs0::in, Procs::out, di, uo) is det -->
+ { map__lookup(Procs0, ProcId, ProcInfo) },
+ unbound_inst_var_error(PredId, ProcInfo, ModuleInfo),
+ % delete this mode, to avoid internal errors
+ { map__det_remove(Procs0, ProcId, _, Procs) }
+ ), ErrorProcs, ProcTable0, ProcTable),
+ { pred_info_set_procedures(PredInfo0, ProcTable, PredInfo) }
+ ).
:- pred unbound_inst_var_error(pred_id, proc_info, module_info,
io__state, io__state).
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.84
diff -u -u -r1.84 simplify.m
--- compiler/simplify.m 2000/09/07 01:46:52 1.84
+++ compiler/simplify.m 2000/09/09 01:34:47
@@ -1209,9 +1209,23 @@
{ globals__lookup_bool_option(Globals, special_preds,
SpecialPreds) },
(
- { SpecialPreds = no },
- { proc_id_to_int(ProcId, ProcIdInt) },
- { ProcIdInt = 0 }
+ { hlds_pred__in_in_unification_proc_id(ProcId) },
+ {
+ SpecialPreds = no
+ ;
+ SpecialPreds = yes,
+
+ %
+ % For most imported types we only generate
+ % unification predicate declarations if they
+ % are needed for complicated unifications
+ % other than proc_id 0.
+ % higher_order.m will specialize these cases
+ % if possible.
+ %
+ special_pred_is_generated_lazily(ModuleInfo,
+ TypeId)
+ }
->
simplify__make_type_info_vars([Type], TypeInfoVars,
ExtraGoals),
Index: compiler/special_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/special_pred.m,v
retrieving revision 1.23
diff -u -u -r1.23 special_pred.m
--- compiler/special_pred.m 1998/09/10 06:51:38 1.23
+++ compiler/special_pred.m 2000/09/07 14:56:11
@@ -15,7 +15,7 @@
:- module special_pred.
:- interface.
-:- import_module prog_data, hlds_data, hlds_pred.
+:- import_module prog_data, hlds_data, hlds_module, hlds_pred.
:- import_module list, map, std_util.
:- type special_pred_map == map(special_pred, pred_id).
@@ -54,9 +54,39 @@
:- pred special_pred_description(special_pred_id, string).
:- mode special_pred_description(in, out) is det.
+ %
+ % Succeeds if the declarations and clauses for the special predicates
+ % for the given type generated only when required.
+ % This will succeed for imported types for which the special
+ % predicates do not need typechecking.
+ %
+:- pred special_pred_is_generated_lazily(module_info, type_id).
+:- mode special_pred_is_generated_lazily(in, in) is semidet.
+
+:- pred special_pred_is_generated_lazily(module_info, type_id,
+ hlds_type_body, import_status).
+:- mode special_pred_is_generated_lazily(in, in, in, in) is semidet.
+
+ %
+ % A compiler-generated predicate only needs type checking if
+ % (a) it is a user-defined equality pred
+ % or (b) it is the unification or comparison predicate for an
+ % existially quantified type.
+ %
+:- pred special_pred_for_type_needs_typecheck(hlds_type_body).
+:- mode special_pred_for_type_needs_typecheck(in) is semidet.
+
+ % Succeed if the type can have clauses generated for
+ % its special predicates. This will fail for abstract
+ % types and types for which the RTTI information is
+ % defined by hand. This predicate
+:- pred can_generate_special_pred_clauses_for_type(type_id, hlds_type_body).
+:- mode can_generate_special_pred_clauses_for_type(in, in) is semidet.
+
:- implementation.
-:- import_module type_util, mode_util, prog_util.
+:- import_module globals, options, type_util, mode_util, prog_util.
+:- import_module bool.
special_pred_list([unify, index, compare]).
@@ -110,5 +140,53 @@
special_pred_description(unify, "unification predicate").
special_pred_description(compare, "comparison predicate").
special_pred_description(index, "indexing predicate").
+
+special_pred_is_generated_lazily(ModuleInfo, TypeId) :-
+ classify_type_id(ModuleInfo, TypeId, Class),
+ ( Class = user_type ; Class = enum_type ),
+ module_info_types(ModuleInfo, Types),
+ map__search(Types, TypeId, TypeDefn),
+ hlds_data__get_type_defn_body(TypeDefn, Body),
+ hlds_data__get_type_defn_status(TypeDefn, Status),
+ special_pred_is_generated_lazily_2(ModuleInfo,
+ TypeId, Body, Status).
+
+special_pred_is_generated_lazily(ModuleInfo, TypeId, Body, Status) :-
+ classify_type_id(ModuleInfo, TypeId, Class),
+ ( Class = user_type ; Class = enum_type ),
+ special_pred_is_generated_lazily_2(ModuleInfo,
+ TypeId, Body, Status).
+
+:- pred special_pred_is_generated_lazily_2(module_info,
+ type_id, hlds_type_body, import_status).
+:- mode special_pred_is_generated_lazily_2(in, in, in, in) is semidet.
+
+special_pred_is_generated_lazily_2(ModuleInfo, _TypeId, Body, Status) :-
+ (
+ status_defined_in_this_module(Status, no)
+ ;
+ module_info_globals(ModuleInfo, Globals),
+ globals__lookup_bool_option(Globals, special_preds, no)
+ ),
+
+ % The special predicates for types with user-defined
+ % equality or existentially typed constructors are always
+ % generated immediately by make_hlds.m.
+ \+ special_pred_for_type_needs_typecheck(Body).
+
+special_pred_for_type_needs_typecheck(Body) :-
+ Body = du_type(Ctors, _, _, MaybeEqualityPred),
+ (
+ MaybeEqualityPred = yes(_)
+ ;
+ list__member(Ctor, Ctors),
+ Ctor = ctor(ExistQTVars, _, _, _),
+ ExistQTVars \= []
+ ).
+
+can_generate_special_pred_clauses_for_type(TypeId, Body) :-
+ Body \= abstract_type,
+ Body \= uu_type(_),
+ \+ type_id_has_hand_defined_rtti(TypeId).
%-----------------------------------------------------------------------------%
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.87
diff -u -u -r1.87 type_util.m
--- compiler/type_util.m 2000/08/24 06:08:17 1.87
+++ compiler/type_util.m 2000/09/04 04:15:53
@@ -30,6 +30,9 @@
:- pred type_is_atomic(type, module_info).
:- mode type_is_atomic(in, in) is semidet.
+:- pred type_id_is_atomic(type_id, module_info).
+:- mode type_id_is_atomic(in, in) is semidet.
+
% type_is_higher_order(Type, PredOrFunc, ArgTypes) succeeds iff
% Type is a higher-order predicate or function type with the specified
% argument types (for functions, the return type is appended to the
@@ -96,10 +99,13 @@
:- mode remove_new_prefix(out, in) is det.
% Given a type, determine what sort of type it is.
-
:- pred classify_type(type, module_info, builtin_type).
:- mode classify_type(in, in, out) is det.
+ % Given a type_id, determine what sort of type it is.
+:- pred classify_type_id(module_info, type_id, builtin_type).
+:- mode classify_type_id(in, in, out) is det.
+
:- type builtin_type ---> int_type
; char_type
; str_type
@@ -411,7 +417,11 @@
type_util__type_id_arity(_ModuleInfo, _Name - Arity, Arity).
type_is_atomic(Type, ModuleInfo) :-
- classify_type(Type, ModuleInfo, BuiltinType),
+ type_to_type_id(Type, TypeId, _),
+ type_id_is_atomic(TypeId, ModuleInfo).
+
+type_id_is_atomic(TypeId, ModuleInfo) :-
+ classify_type_id(ModuleInfo, TypeId, BuiltinType),
BuiltinType \= polymorphic_type,
BuiltinType \= pred_type,
BuiltinType \= user_type.
@@ -448,23 +458,26 @@
classify_type(VarType, ModuleInfo, Type) :-
( type_to_type_id(VarType, TypeId, _) ->
- ( TypeId = unqualified("character") - 0 ->
- Type = char_type
- ; TypeId = unqualified("int") - 0 ->
- Type = int_type
- ; TypeId = unqualified("float") - 0 ->
- Type = float_type
- ; TypeId = unqualified("string") - 0 ->
- Type = str_type
- ; type_id_is_higher_order(TypeId, _, _) ->
- Type = pred_type
- ; type_id_is_enumeration(TypeId, ModuleInfo) ->
- Type = enum_type
- ;
- Type = user_type
- )
+ classify_type_id(ModuleInfo, TypeId, Type)
;
Type = polymorphic_type
+ ).
+
+classify_type_id(ModuleInfo, TypeId, Type) :-
+ ( TypeId = unqualified("character") - 0 ->
+ Type = char_type
+ ; TypeId = unqualified("int") - 0 ->
+ Type = int_type
+ ; TypeId = unqualified("float") - 0 ->
+ Type = float_type
+ ; TypeId = unqualified("string") - 0 ->
+ Type = str_type
+ ; type_id_is_higher_order(TypeId, _, _) ->
+ Type = pred_type
+ ; type_id_is_enumeration(TypeId, ModuleInfo) ->
+ Type = enum_type
+ ;
+ Type = user_type
).
type_is_higher_order(Type, PredOrFunc, EvalMethod, PredArgTypes) :-
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.281
diff -u -u -r1.281 typecheck.m
--- compiler/typecheck.m 2000/09/08 12:20:37 1.281
+++ compiler/typecheck.m 2000/09/08 12:21:42
@@ -733,12 +733,7 @@
module_info_types(ModuleInfo, TypeTable),
map__lookup(TypeTable, TypeId, TypeDefn),
hlds_data__get_type_defn_body(TypeDefn, Body),
- Body = du_type(Ctors, _, _, MaybeEqualityPred),
- ( MaybeEqualityPred = yes(_)
- ; list__member(Ctor, Ctors),
- Ctor = ctor(ExistQTVars, _, _, _),
- ExistQTVars \= []
- ).
+ special_pred_for_type_needs_typecheck(Body).
%-----------------------------------------------------------------------------%
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.86
diff -u -u -r1.86 unify_proc.m
--- compiler/unify_proc.m 2000/09/07 01:46:56 1.86
+++ compiler/unify_proc.m 2000/09/09 01:41:47
@@ -75,6 +75,29 @@
module_info, proc_id, module_info).
:- mode unify_proc__request_proc(in, in, in, in, in, in, out, out) is det.
+ % unify_proc__add_lazily_generated_unify_pred(TypeId,
+ % UnifyPredId_for_Type, ModuleInfo0, ModuleInfo).
+ %
+ % For most imported unification procedures, we delay
+ % generating declarations and clauses until we know
+ % whether they are actually needed because there
+ % is a complicated unification involving the type.
+ % This predicate is exported for use by higher_order.m
+ % when it is specializing calls to unify/2.
+:- pred unify_proc__add_lazily_generated_unify_pred(type_id,
+ pred_id, module_info, module_info).
+:- mode unify_proc__add_lazily_generated_unify_pred(in,
+ out, in, out) is det.
+
+ % unify_proc__add_lazily_generated_compare_pred_decl(TypeId,
+ % ComparePredId_for_Type, ModuleInfo0, ModuleInfo).
+ %
+ % Add declarations, but not clauses, for a compare or index predicate.
+:- pred unify_proc__add_lazily_generated_compare_pred_decl(type_id,
+ pred_id, module_info, module_info).
+:- mode unify_proc__add_lazily_generated_compare_pred_decl(in,
+ out, in, out) is det.
+
% Do mode analysis of the queued procedures.
% If the first argument is `unique_mode_check',
% then also go on and do full determinism analysis and unique mode
@@ -110,7 +133,7 @@
:- import_module globals, options.
:- import_module code_util, code_info, type_util.
:- import_module mercury_to_mercury, hlds_out.
-:- import_module make_hlds, polymorphism, prog_util, prog_out.
+:- import_module make_hlds, polymorphism, post_typecheck, prog_util, prog_out.
:- import_module quantification, clause_to_proc, term, varset.
:- import_module modes, mode_util, inst_match, instmap, (inst).
:- import_module switch_detection, cse_detection, det_analysis, unique_modes.
@@ -231,7 +254,7 @@
module_info_name(ModuleInfo0, ModuleName),
ModuleName = TypeModuleName,
module_info_types(ModuleInfo0, TypeTable),
- map__lookup(TypeTable, TypeId, TypeDefn),
+ map__search(TypeTable, TypeId, TypeDefn),
hlds_data__get_type_defn_body(TypeDefn, TypeBody),
TypeBody = abstract_type
;
@@ -245,32 +268,41 @@
% that we are going to generate
%
module_info_get_special_pred_map(ModuleInfo0, SpecialPredMap),
- map__lookup(SpecialPredMap, unify - TypeId, PredId),
+ ( map__search(SpecialPredMap, unify - TypeId, PredId0) ->
+ PredId = PredId0,
+ ModuleInfo1 = ModuleInfo0
+ ;
+ % We generate unification predicates for most
+ % imported types lazily, so add the declarations
+ % and clauses now.
+ unify_proc__add_lazily_generated_unify_pred(TypeId,
+ PredId, ModuleInfo0, ModuleInfo1)
+ ),
% convert from `uni_mode' to `list(mode)'
UnifyMode = ((X_Initial - Y_Initial) -> (X_Final - Y_Final)),
ArgModes0 = [(X_Initial -> X_Final), (Y_Initial -> Y_Final)],
% for polymorphic types, add extra modes for the type_infos
- TypeId = _TypeName - TypeArity,
in_mode(InMode),
+ TypeId = _ - TypeArity,
list__duplicate(TypeArity, InMode, TypeInfoModes),
list__append(TypeInfoModes, ArgModes0, ArgModes),
ArgLives = no, % XXX ArgLives should be part of the UnifyId
unify_proc__request_proc(PredId, ArgModes, ArgLives,
- yes(Determinism), Context, ModuleInfo0,
- ProcId, ModuleInfo1),
+ yes(Determinism), Context, ModuleInfo1,
+ ProcId, ModuleInfo2),
%
% save the proc_id for this unify_proc_id
%
- module_info_get_proc_requests(ModuleInfo1, Requests0),
+ module_info_get_proc_requests(ModuleInfo2, Requests0),
unify_proc__get_unify_req_map(Requests0, UnifyReqMap0),
map__set(UnifyReqMap0, UnifyId, ProcId, UnifyReqMap),
unify_proc__set_unify_req_map(Requests0, UnifyReqMap, Requests),
- module_info_set_proc_requests(ModuleInfo1, Requests,
+ module_info_set_proc_requests(ModuleInfo2, Requests,
ModuleInfo)
).
@@ -467,6 +499,125 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
+unify_proc__add_lazily_generated_unify_pred(TypeId,
+ PredId, ModuleInfo0, ModuleInfo) :-
+ unify_proc__collect_type_defn(ModuleInfo0, TypeId,
+ Type, TVarSet, TypeBody, Context),
+
+ % Call make_hlds.m to construct the unification predicate.
+ ( can_generate_special_pred_clauses_for_type(TypeId, TypeBody) ->
+ % If the unification predicate has another status it should
+ % already have been generated.
+ UnifyPredStatus = pseudo_imported,
+ Item = clauses
+ ;
+ UnifyPredStatus = imported(implementation),
+ Item = declaration
+ ),
+
+ unify_proc__add_lazily_generated_special_pred(unify, Item,
+ TVarSet, Type, TypeId, TypeBody, Context, UnifyPredStatus,
+ PredId, ModuleInfo0, ModuleInfo).
+
+unify_proc__add_lazily_generated_compare_pred_decl(TypeId,
+ PredId, ModuleInfo0, ModuleInfo) :-
+ unify_proc__collect_type_defn(ModuleInfo0, TypeId, Type,
+ TVarSet, TypeBody, Context),
+
+ % If the compare predicate has another status it should
+ % already have been generated.
+ ImportStatus = imported(implementation),
+
+ unify_proc__add_lazily_generated_special_pred(compare, declaration,
+ TVarSet, Type, TypeId, TypeBody, Context, ImportStatus,
+ PredId, ModuleInfo0, ModuleInfo).
+
+:- pred unify_proc__add_lazily_generated_special_pred(special_pred_id,
+ unify_pred_item, tvarset, type, type_id, hlds_type_body,
+ context, import_status, pred_id, module_info, module_info).
+:- mode unify_proc__add_lazily_generated_special_pred(in, in, in, in, in, in,
+ in, in, out, in, out) is det.
+
+unify_proc__add_lazily_generated_special_pred(SpecialId, Item,
+ TVarSet, Type, TypeId, TypeBody, Context, PredStatus,
+ PredId, ModuleInfo0, ModuleInfo) :-
+ %
+ % Add the declaration and maybe clauses.
+ %
+ (
+ Item = clauses,
+ make_hlds__add_special_pred_for_real(SpecialId, ModuleInfo0,
+ TVarSet, Type, TypeId, TypeBody, Context,
+ PredStatus, ModuleInfo1)
+ ;
+ Item = declaration,
+ make_hlds__add_special_pred_decl_for_real(SpecialId,
+ ModuleInfo0, TVarSet, Type, TypeId,
+ Context, PredStatus, ModuleInfo1)
+ ),
+
+ module_info_get_special_pred_map(ModuleInfo1, SpecialPredMap),
+ map__lookup(SpecialPredMap, SpecialId - TypeId, PredId),
+ module_info_pred_info(ModuleInfo1, PredId, PredInfo0),
+
+ %
+ % The clauses are generated with all type information computed,
+ % so just go on to post_typecheck.
+ %
+ (
+ Item = clauses,
+ post_typecheck__finish_pred_no_io(ModuleInfo1,
+ ErrorProcs, PredInfo0, PredInfo)
+ ;
+ Item = declaration,
+ post_typecheck__finish_imported_pred_no_io(ModuleInfo1,
+ ErrorProcs, PredInfo0, PredInfo)
+ ),
+ require(unify(ErrorProcs, []),
+"unify_proc__add_lazily_generated_special_pred: error in post_typecheck"),
+
+ %
+ % Call polymorphism to introduce type_info arguments
+ % for polymorphic types.
+ %
+ module_info_set_pred_info(ModuleInfo1, PredId, PredInfo, ModuleInfo2),
+
+ %
+ % Note that this will not work if the generated clauses call
+ % a polymorphic predicate which requires type_infos to be added.
+ % Such calls can be generated by unify_proc__generate_clause_info,
+ % but unification predicates which contain such calls are never
+ % generated lazily.
+ %
+ polymorphism__process_generated_pred(PredId, ModuleInfo2, ModuleInfo).
+
+:- type unify_pred_item
+ ---> declaration
+ ; clauses
+ .
+
+:- pred unify_proc__collect_type_defn(module_info,
+ type_id, type, tvarset, hlds_type_body, prog_context).
+:- mode unify_proc__collect_type_defn(in, in, out, out, out, out) is det.
+
+unify_proc__collect_type_defn(ModuleInfo0, TypeId, Type,
+ TVarSet, TypeBody, Context) :-
+ module_info_types(ModuleInfo0, Types),
+ map__lookup(Types, TypeId, TypeDefn),
+ hlds_data__get_type_defn_tvarset(TypeDefn, TVarSet),
+ hlds_data__get_type_defn_tparams(TypeDefn, TypeParams),
+ hlds_data__get_type_defn_body(TypeDefn, TypeBody),
+ hlds_data__get_type_defn_status(TypeDefn, TypeStatus),
+ hlds_data__get_type_defn_context(TypeDefn, Context),
+
+ require(special_pred_is_generated_lazily(ModuleInfo0,
+ TypeId, TypeBody, TypeStatus),
+ "unify_proc__add_lazily_generated_unify_pred"),
+
+ construct_type(TypeId, TypeParams, Type).
+
+%-----------------------------------------------------------------------------%
+
unify_proc__generate_clause_info(SpecialPredId, Type, TypeBody, Context,
ModuleInfo, ClauseInfo) :-
( TypeBody = eqv_type(EqvType) ->
@@ -524,25 +675,14 @@
unify_proc__quantify_clauses_body([H1, H2], Goal,
Context, Clauses)
; { IsEnum = yes } ->
- { IntType = int_type },
- unify_proc__info_new_var(IntType, TC1),
- unify_proc__info_new_var(IntType, TC2),
- { TC1ArgVars = [H1, TC1] },
- unify_proc__build_call("unsafe_type_cast",
- TC1ArgVars, Context, TC1Goal),
- { TC2ArgVars = [H2, TC2] },
- unify_proc__build_call("unsafe_type_cast",
- TC2ArgVars, Context, TC2Goal),
- { UnifyArgVars = [TC1, TC2] },
- unify_proc__build_call("unify",
- UnifyArgVars, Context, UnifyGoal),
- { goal_info_init(GoalInfo0) },
- { goal_info_set_context(GoalInfo0, Context,
- GoalInfo) },
- { conj_list_to_goal([TC1Goal, TC2Goal, UnifyGoal],
- GoalInfo, Goal) },
- { ArgVars = [H1, H2] },
- unify_proc__quantify_clauses_body(ArgVars, Goal,
+ %
+ % Enumerations are atomic types, so modecheck_unify.m
+ % will treat this unification as a simple_test, not
+ % a complicated_unify.
+ %
+ { create_atomic_unification(H1, var(H2),
+ Context, explicit, [], Goal) },
+ unify_proc__quantify_clauses_body([H1, H2], Goal,
Context, Clauses)
;
unify_proc__generate_du_unify_clauses(Ctors,
--------------------------------------------------------------------------
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