[m-rev.] first step towards functional dependencies (1/3)
Mark Brown
mark at cs.mu.OZ.AU
Wed Mar 23 23:19:20 AEDT 2005
Hi,
This is for review by anyone.
After this change, my work on implementing functional dependencies will
be able to progress. Note, however, that while this change removes some
assumptions in polymorphism, there remain some other assumptions that have
not yet been dealt with. The effect of this is that, for the moment,
FDs will be slightly more restricted than they otherwise would be.
In particular, we will retain the restriction that all type variables
appearing in constraints on the head of an instance declaration must
also appear in the arguments of the instance declaration. Overcoming
this would require using a similar technique to that used here to
record superclass constraints during typechecking and look them up in
polymorphism. But the details are quite tricky for various reasons, so
I'm going to leave that for a separate change.
The restriction is probably not that serious. In fact, I'm only aware of
one example that would need this feature. I'll post a description of that
separately, in case anyone is curious.
Cheers,
Mark.
Estimated hours taken: 240
Branches: main
Remove the assumption made by polymorphism.m that all type variables
appearing in class constraints also appear in the type being constrained.
This is a first step towards adding functional dependencies, since in the
presence of functional dependencies (or "improvement" in general) this
assumption no longer holds.
The assumption made by polymorphism manifests itself in the fact that
constraints on atomic goals are reconstructed by unifying the types of
formal parameters with the types of actual arguments, and then applying
the resulting substitution to the constraints. Any type variables in
constraints that don't appear in the formal parameters will therefore
remain unbound.
This change overcomes the assumption by building up a map from constraint
identifiers to constraints during typechecking, and then looking up this
map in order to reconstruct the constraint during the polymorphism
transformation.
To support this, the type 'class_constraint' has been removed and replaced
by two distinct types, 'prog_constraint' and 'hlds_constraint'. The former
is part of the parse tree and holds the same information as the old
class_constraint. The latter is part of the HLDS, and is used during
typechecking; in addition to the information in prog_constraints, it also
stores a set of identifiers that represent where the constraint came from.
These identifiers are used as the keys in the aforementioned map.
At this stage the constraint identifiers are only used by typechecking to
build the constraint map. Other passes use either prog_constraints or
hlds_constraints with an empty set of identifiers.
compiler/hlds_data.m:
Define the constraint_id type, which is used to uniquely identify
class constraints. A better scheme than this one has been suggested,
but that will be left to a later change. An XXX comment to that
effect has been added.
Define the hlds_constraint type, which is like prog_constraint but
it also includes a set of constraint_ids. Define a set of predicates
to initialise and manipulate these.
Define the constraint_map type here. Move the definition of
constraint_proof_map to here, where it more sensibly belongs.
Update the comments in hlds_instance_defn slightly, with information
that I found I needed to know when making this change.
compiler/hlds_pred.m:
Add a field to the pred_info to store the constraint_map.
Move the definition of constraint_proof_map from here.
compiler/hlds_out.m:
Print out a representation of the constraint map if it isn't empty.
compiler/type_util.m:
Change the predicates that used to operate on class_constraints so
that they now operate on hlds_constraints. The old versions of these
predicates have now moved to prog_util.
Add some utility predicates to manipulate constraint_maps.
Add a predicate to apply a variable renaming to constraint_proof_maps.
compiler/prog_data.m:
Rename class_constraint(s) to prog_constraint(s).
compiler/prog_util.m:
Provide a set of predicates for manipulating prog_constraints.
compiler/typecheck.m:
Ensure that goal_paths are filled in before the first iteration
of typechecking.
Pass the hlds_goal_info down through typecheck_goal_2 so that the
goal_path can be retrieved when needed to assign identifiers to
constraints. Thread the goal_path through to wherever it is needed.
Store hlds_constraints in the args_type_assign rather than
prog_constraints, so that the required information is available
when creating the new set of type_assigns. Do likewise for the
cons_type_info type. Don't pass the module_info through
make_pred_cons_info*, since it isn't used. Do pass the goal_path,
though, so that constraints in cons_type_infos can be given the
correct identifier.
Add a constraint_map field to the typecheck_info, initialised to empty.
When retrieving the final information from a typecheck_info, return
the resulting constraint_map, after applying any type bindings.
Ensure that any constraints that may not have been entered into the
constraint_map are put there now. Call the new predicate in type_util
to rename the constraint_proof_map, rather than doing it longhand
here.
Make the following changes to context reduction:
- Thread the constraint_map through, so that it can be updated
as constraints are eliminated.
- Instead of simply calling sort_and_remove_dups on the
set of constraints remaining after one iteration, merge the
constraints in such a way that the complete set of
constraint_ids is retained.
- Disregard the constraint_ids when deleting newly introduced
constraints that are equivalent to constraints that have
already been seen.
- Simplify the code of find_matching_instance_rule_2 by
moving the deterministic code out of the condition of the
if-then-else.
Move find_first_map into the library.
compiler/polymorphism.m:
Ensure that the goal_path is set when constructing lambda goals.
In process_call, look up the constraints in the constraint_map
using the goal_path as part of the key, rather than calculating
the constraints by applying the ParentToActual type substitution.
Rearrange this code so that it is divided into easier to understand
blocks.
Add a field to the poly_info to store the constraint_map, and
initialise it from the pred_info.
compiler/goal_path.m:
Fill slots in lambda_goals, since constraints inside these will
otherwise not be identified properly. The goal_paths inside here
do not entirely make sense, since there is no goal_path_step for
the lambda_goal itself. However, there is enough information
retained to distinguish these goal_paths from any other possible
goal_path, which is all that we require to identify constraints.
Add a warning not to fill in the goal slots between the typechecking
and polymorphism passes, since doing so could potentially render the
constraint_maps incorrect.
compiler/make_hlds.m:
Initialise the constraint_map to empty in pred_infos.
Move the code for updating the superclass_table into a separate
predicate. Initially this change was made because, in an earlier
version of the change, the superclass_table had some extra
information that needed to be filled in. That part of the change
is not needed in this diff, but the new predicate simplifies the
code a bit so I've left it there.
compiler/check_typeclass.m:
Convert the prog_constraints into hlds_constraints before passing
them to typecheck.reduce_context_by_rule_application. They are
assigned no identifiers, since these constraints are not required
to be put into the constraint map.
Change the name of the function get_constraint_id to
get_constraint_class_id, since it would now be ambiguous otherwise.
compiler/cse_detection.m:
Import parse_tree__prog_util, since that is where renamings of
prog_constraints are now defined.
compiler/higher_order.m:
Initialise pred_infos here with an empty constraint_map.
compiler/post_typecheck.m:
When binding type vars to void, apply the void substitution to the
constraint_map.
compiler/table_gen.m:
Pass the constraint_map when creating a new pred_info.
compiler/unused_args.m:
Create the pred_info with an empty constraint_map. The constraint_map
won't be used by this stage anyway.
compiler/*.m:
Update to use the new type names. Also update to use the existing
type synonyms typeclass_info_varmap and constraint_proof_map.
Change names of predicates and functions to use prog_constraint
instead of class_constraint, where applicable.
library/list.m:
Add find_first_map from typecheck. Also add find_first_map{2,3},
since at one stage during development I needed find_first_map3, and,
although it's not used in the current diff, there is little point
removing it now.
Index: compiler/base_typeclass_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/base_typeclass_info.m,v
retrieving revision 1.32
diff -u -r1.32 base_typeclass_info.m
--- compiler/base_typeclass_info.m 21 Jan 2005 03:27:34 -0000 1.32
+++ compiler/base_typeclass_info.m 22 Mar 2005 12:23:48 -0000
@@ -107,7 +107,7 @@
%----------------------------------------------------------------------------%
:- pred base_typeclass_info__gen_body(maybe(list(hlds_class_proc)),
- list(type), list(class_constraint), module_info, class_id,
+ list(type), list(prog_constraint), module_info, class_id,
base_typeclass_info).
:- mode base_typeclass_info__gen_body(in, in, in, in, in, out) is det.
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.63
diff -u -r1.63 check_typeclass.m
--- compiler/check_typeclass.m 1 Feb 2005 07:11:27 -0000 1.63
+++ compiler/check_typeclass.m 23 Mar 2005 06:14:53 -0000
@@ -176,7 +176,7 @@
).
% check one instance of one class
-:- pred check_class_instance(class_id::in, list(class_constraint)::in,
+:- pred check_class_instance(class_id::in, list(prog_constraint)::in,
list(tvar)::in, hlds_class_interface::in, class_interface::in,
tvarset::in, list(pred_id)::in,
hlds_instance_defn::in, hlds_instance_defn::out,
@@ -378,7 +378,7 @@
% type variables
list(type), % Expected types of
% arguments.
- class_constraints, % Constraints from
+ prog_constraints, % Constraints from
% class method.
list(modes_and_detism), % Modes and
% determinisms of the
@@ -647,7 +647,7 @@
pred_or_func_to_string(function, "function").
:- pred produce_auxiliary_procs(class_id::in, list(tvar)::in, pred_markers::in,
- list(type)::in, list(class_constraint)::in, tvarset::in,
+ list(type)::in, list(prog_constraint)::in, tvarset::in,
module_name::in, instance_proc_def::in, prog_context::in,
pred_id::out, list(proc_id)::out,
instance_method_info::in, instance_method_info::out,
@@ -667,14 +667,14 @@
RenameSubst),
term__apply_substitution_to_list(InstanceTypes0, RenameSubst,
InstanceTypes1),
- apply_subst_to_constraint_list(RenameSubst, InstanceConstraints0,
+ apply_subst_to_prog_constraint_list(RenameSubst, InstanceConstraints0,
InstanceConstraints1),
% Work out what the type variables are bound to for this
% instance, and update the class types appropriately.
map__from_corresponding_lists(ClassVars, InstanceTypes1, TypeSubst),
term__apply_substitution_to_list(ArgTypes0, TypeSubst, ArgTypes1),
- apply_subst_to_constraints(TypeSubst, ClassMethodClassContext0,
+ apply_subst_to_prog_constraints(TypeSubst, ClassMethodClassContext0,
ClassMethodClassContext1),
% Get rid of any unwanted type variables
@@ -683,12 +683,12 @@
varset__squash(ArgTypeVars1, VarsToKeep, ArgTypeVars, SquashSubst),
term__apply_variable_renaming_to_list(ArgTypes1, SquashSubst,
ArgTypes),
- apply_variable_renaming_to_constraints(SquashSubst,
+ apply_variable_renaming_to_prog_constraints(SquashSubst,
ClassMethodClassContext1, ClassMethodClassContext),
apply_partial_map_to_list(ExistQVars0, SquashSubst, ExistQVars),
apply_variable_renaming_to_list(InstanceTypes1, SquashSubst,
InstanceTypes),
- apply_variable_renaming_to_constraint_list(SquashSubst,
+ apply_variable_renaming_to_prog_constraint_list(SquashSubst,
InstanceConstraints1, InstanceConstraints),
% Add the constraints from the instance declaration to the
@@ -703,6 +703,7 @@
% Introduce a new predicate which calls the implementation
% given in the instance declaration.
map__init(Proofs),
+ map__init(ConstraintMap),
add_marker(class_instance_method, Markers0, Markers1),
( InstancePredDefn = name(_) ->
% For instance methods which are defined using the named
@@ -736,7 +737,7 @@
pred_info_init(InstanceModuleName, PredName, PredArity, PredOrFunc,
Context, instance_method(MethodConstraints), Status, none,
Markers, ArgTypes, ArgTypeVars, ExistQVars, ClassContext,
- Proofs, User, ClausesInfo, PredInfo0),
+ Proofs, ConstraintMap, User, ClausesInfo, PredInfo0),
pred_info_set_clauses_info(ClausesInfo, PredInfo0, PredInfo1),
% Add procs with the expected modes and determinisms
@@ -812,21 +813,24 @@
% Check that the superclass constraints are satisfied for the
% types in this instance declaration.
-:- pred check_superclass_conformance(class_id::in, list(class_constraint)::in,
+:- pred check_superclass_conformance(class_id::in, list(prog_constraint)::in,
list(tvar)::in, tvarset::in, module_info::in,
hlds_instance_defn::in, hlds_instance_defn::out,
error_messages::in, error_messages::out) is det.
-check_superclass_conformance(ClassId, SuperClasses0, ClassVars0, ClassVarSet,
- ModuleInfo, InstanceDefn0, InstanceDefn, Errors0, Errors) :-
-
- InstanceDefn0 = hlds_instance_defn(A, B, Context, InstanceConstraints,
- InstanceTypes, F, G, InstanceVarSet0, Proofs0),
+check_superclass_conformance(ClassId, ProgSuperClasses0, ClassVars0,
+ ClassVarSet, ModuleInfo, InstanceDefn0, InstanceDefn,
+ Errors0, Errors) :-
+
+ InstanceDefn0 = hlds_instance_defn(A, B, Context,
+ InstanceProgConstraints, InstanceTypes, F, G, InstanceVarSet0,
+ Proofs0),
varset__merge_subst(InstanceVarSet0, ClassVarSet, InstanceVarSet1,
Subst),
% Make the constraints in terms of the instance variables
- apply_subst_to_constraint_list(Subst, SuperClasses0, SuperClasses),
+ apply_subst_to_prog_constraint_list(Subst, ProgSuperClasses0,
+ ProgSuperClasses),
% Now handle the class variables
map__apply_to_list(ClassVars0, Subst, ClassVarTerms),
@@ -842,19 +846,29 @@
module_info_instances(ModuleInfo, InstanceTable),
module_info_superclasses(ModuleInfo, SuperClassTable),
+ % These constraints are not required to be put into the
+ % final constraint_map, so we initialise them with no
+ % constraint_id and throw away the constraint_map that
+ % results.
+ map__init(ConstraintMap0),
+ init_hlds_constraint_list(InstanceProgConstraints,
+ InstanceConstraints),
+ init_hlds_constraint_list(ProgSuperClasses, SuperClasses),
+
% Try to reduce the superclass constraints,
% using the declared instance constraints
% and the usual context reduction rules.
typecheck__reduce_context_by_rule_application(InstanceTable,
SuperClassTable, InstanceConstraints, TypeSubst,
InstanceVarSet1, InstanceVarSet2, Proofs0, Proofs1,
+ ConstraintMap0, _,
SuperClasses, UnprovenConstraints),
(
UnprovenConstraints = [],
Errors = Errors0,
InstanceDefn = hlds_instance_defn(A, B, Context,
- InstanceConstraints, InstanceTypes, F, G,
+ InstanceProgConstraints, InstanceTypes, F, G,
InstanceVarSet2, Proofs1)
;
UnprovenConstraints = [_ | _],
@@ -875,21 +889,23 @@
InstanceDefn = InstanceDefn0
).
-:- pred constraint_list_to_string(tvarset::in, list(class_constraint)::in,
+:- pred constraint_list_to_string(tvarset::in, list(hlds_constraint)::in,
string::out) is det.
constraint_list_to_string(_, [], "").
constraint_list_to_string(VarSet, [C | Cs], String) :-
- String0 = mercury_constraint_to_string(VarSet, C),
+ retrieve_prog_constraint(C, P),
+ String0 = mercury_constraint_to_string(VarSet, P),
constraint_list_to_string_2(VarSet, Cs, String1),
string__append_list(["`", String0, "'", String1], String).
-:- pred constraint_list_to_string_2(tvarset::in, list(class_constraint)::in,
+:- pred constraint_list_to_string_2(tvarset::in, list(hlds_constraint)::in,
string::out) is det.
constraint_list_to_string_2(_VarSet, [], "").
constraint_list_to_string_2(VarSet, [C | Cs], String) :-
- String0 = mercury_constraint_to_string(VarSet, C),
+ retrieve_prog_constraint(C, P),
+ String0 = mercury_constraint_to_string(VarSet, P),
constraint_list_to_string_2(VarSet, Cs, String1),
string__append_list([", `", String0, "'", String1], String).
@@ -965,11 +981,12 @@
get_superclass_ids(ClassTable, ClassId) = SuperclassIds :-
ClassDefn = map.lookup(ClassTable, ClassId),
- SuperclassIds = list.map(get_constraint_id, ClassDefn ^ class_supers).
+ SuperclassIds = list.map(get_constraint_class_id,
+ ClassDefn ^ class_supers).
-:- func get_constraint_id(class_constraint) = class_id.
+:- func get_constraint_class_id(prog_constraint) = class_id.
-get_constraint_id(constraint(Name, Args)) = class_id(Name, length(Args)).
+get_constraint_class_id(constraint(Name, Args)) = class_id(Name, length(Args)).
% Report an error using the format
%
Index: compiler/cse_detection.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/cse_detection.m,v
retrieving revision 1.79
diff -u -r1.79 cse_detection.m
--- compiler/cse_detection.m 14 Jun 2004 04:15:59 -0000 1.79
+++ compiler/cse_detection.m 22 Mar 2005 12:23:48 -0000
@@ -49,6 +49,7 @@
:- import_module libs__globals.
:- import_module libs__options.
:- import_module parse_tree__prog_data.
+:- import_module parse_tree__prog_util.
:- import_module term, varset.
:- import_module int, string, bool, list, assoc_list, map, multi_map.
@@ -832,13 +833,13 @@
).
:- pred reconstruct_typeclass_info_varmap(map(prog_var, prog_var)::in,
- map(tvar, tvar)::in, pair(class_constraint, prog_var)::in,
+ map(tvar, tvar)::in, pair(prog_constraint, prog_var)::in,
typeclass_info_varmap::in, typeclass_info_varmap::out) is det.
reconstruct_typeclass_info_varmap(OldNewMap, TvarSub,
Constraint0 - TypeClassInfoVar0,
TypeClassInfoVarMap0, TypeClassInfoVarMap) :-
- type_util__apply_variable_renaming_to_constraint(TvarSub,
+ apply_variable_renaming_to_prog_constraint(TvarSub,
Constraint0, Constraint),
( map__search(OldNewMap, TypeClassInfoVar0, TypeClassInfoVar1) ->
TypeClassInfoVar = TypeClassInfoVar1
Index: compiler/dnf.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dnf.m,v
retrieving revision 1.56
diff -u -r1.56 dnf.m
--- compiler/dnf.m 21 Jan 2005 06:20:37 -0000 1.56
+++ compiler/dnf.m 22 Mar 2005 12:23:48 -0000
@@ -177,12 +177,12 @@
orig_pred_name :: string,
orig_tvarset :: tvarset,
orig_vartypes :: vartypes,
- orig_classes :: class_constraints,
+ orig_classes :: prog_constraints,
orig_varset :: prog_varset,
orig_instvarset :: inst_varset,
orig_markers :: pred_markers,
orig_ti_locns :: map(tvar, type_info_locn),
- orig_tcis :: map(class_constraint, prog_var),
+ orig_tcis :: typeclass_info_varmap,
orig_owner :: aditi_owner
).
Index: compiler/equiv_type.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/equiv_type.m,v
retrieving revision 1.43
diff -u -r1.43 equiv_type.m
--- compiler/equiv_type.m 10 Mar 2005 02:35:57 -0000 1.43
+++ compiler/equiv_type.m 22 Mar 2005 12:23:48 -0000
@@ -54,15 +54,14 @@
list(type)::in, list(type)::out, bool::out, tvarset::in, tvarset::out,
equiv_type_info::in, equiv_type_info::out) is det.
-:- pred equiv_type__replace_in_class_constraints(eqv_map::in,
- class_constraints::in, class_constraints::out,
+:- pred equiv_type__replace_in_prog_constraints(eqv_map::in,
+ prog_constraints::in, prog_constraints::out,
tvarset::in, tvarset::out, equiv_type_info::in, equiv_type_info::out)
is det.
-:- pred equiv_type__replace_in_class_constraint(eqv_map::in,
- class_constraint::in, class_constraint::out,
- tvarset::in, tvarset::out, equiv_type_info::in, equiv_type_info::out)
- is det.
+:- pred equiv_type__replace_in_prog_constraint(eqv_map::in,
+ prog_constraint::in, prog_constraint::out, tvarset::in, tvarset::out,
+ equiv_type_info::in, equiv_type_info::out) is det.
:- pred equiv_type__replace_in_ctors(eqv_map::in,
list(constructor)::in, list(constructor)::out,
@@ -327,7 +326,7 @@
list__length(Vars, Arity),
equiv_type__maybe_record_expanded_items(ModuleName, ClassName,
!.Info, ExpandedItems0),
- equiv_type__replace_in_class_constraint_list(EqvMap,
+ equiv_type__replace_in_prog_constraint_list(EqvMap,
Constraints0, Constraints, VarSet0, VarSet,
ExpandedItems0, ExpandedItems1),
(
@@ -358,7 +357,7 @@
;
UsedTypeCtors0 = yes(ModuleName - set__init)
),
- equiv_type__replace_in_class_constraint_list(EqvMap,
+ equiv_type__replace_in_prog_constraint_list(EqvMap,
Constraints0, Constraints, VarSet0, VarSet1,
UsedTypeCtors0, UsedTypeCtors1),
equiv_type__replace_in_type_list(EqvMap, Ts0, Ts, _, _,
@@ -417,24 +416,24 @@
%-----------------------------------------------------------------------------%
-equiv_type__replace_in_class_constraints(EqvMap, Cs0, Cs, !VarSet, !Info) :-
+equiv_type__replace_in_prog_constraints(EqvMap, Cs0, Cs, !VarSet, !Info) :-
Cs0 = constraints(UnivCs0, ExistCs0),
Cs = constraints(UnivCs, ExistCs),
- equiv_type__replace_in_class_constraint_list(EqvMap, UnivCs0, UnivCs,
+ equiv_type__replace_in_prog_constraint_list(EqvMap, UnivCs0, UnivCs,
!VarSet, !Info),
- equiv_type__replace_in_class_constraint_list(EqvMap, ExistCs0, ExistCs,
+ equiv_type__replace_in_prog_constraint_list(EqvMap, ExistCs0, ExistCs,
!VarSet, !Info).
-:- pred equiv_type__replace_in_class_constraint_list(eqv_map::in,
- list(class_constraint)::in, list(class_constraint)::out,
+:- pred equiv_type__replace_in_prog_constraint_list(eqv_map::in,
+ list(prog_constraint)::in, list(prog_constraint)::out,
tvarset::in, tvarset::out, equiv_type_info::in, equiv_type_info::out)
is det.
-equiv_type__replace_in_class_constraint_list(EqvMap, !Cs, !VarSet, !Info) :-
- list__map_foldl2(equiv_type__replace_in_class_constraint(EqvMap),
+equiv_type__replace_in_prog_constraint_list(EqvMap, !Cs, !VarSet, !Info) :-
+ list__map_foldl2(equiv_type__replace_in_prog_constraint(EqvMap),
!Cs, !VarSet, !Info).
-equiv_type__replace_in_class_constraint(EqvMap, Constraint0, Constraint,
+equiv_type__replace_in_prog_constraint(EqvMap, Constraint0, Constraint,
!VarSet, !Info) :-
Constraint0 = constraint(ClassName, Ts0),
equiv_type__replace_in_type_list(EqvMap, Ts0, Ts,
@@ -519,7 +518,7 @@
ctor(ExistQVars, Constraints, TName, Targs), !VarSet, !Info) :-
equiv_type__replace_in_ctor_arg_list(EqvMap, Targs0, Targs, _,
!VarSet, !Info),
- equiv_type__replace_in_class_constraint_list(EqvMap,
+ equiv_type__replace_in_prog_constraint_list(EqvMap,
Constraints0, Constraints, !VarSet, !Info).
%-----------------------------------------------------------------------------%
@@ -705,7 +704,7 @@
:- pred equiv_type__replace_in_pred_type(sym_name::in, pred_or_func::in,
prog_context::in, eqv_map::in, eqv_inst_map::in,
- class_constraints::in, class_constraints::out,
+ prog_constraints::in, prog_constraints::out,
list(type_and_mode)::in, list(type_and_mode)::out,
tvarset::in, tvarset::out,
maybe(type)::in, maybe(type)::out, maybe(inst)::in, maybe(inst)::out,
@@ -718,7 +717,7 @@
TypesAndModes0, TypesAndModes, !TypeVarSet,
MaybeWithType0, MaybeWithType, MaybeWithInst0, MaybeWithInst,
Det0, Det, !Info, Errors) :-
- equiv_type__replace_in_class_constraints(EqvMap,
+ equiv_type__replace_in_prog_constraints(EqvMap,
ClassContext0, ClassContext, !TypeVarSet, !Info),
equiv_type__replace_in_tms(EqvMap, TypesAndModes0,
TypesAndModes1, !TypeVarSet, !Info),
Index: compiler/equiv_type_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/equiv_type_hlds.m,v
retrieving revision 1.10
diff -u -r1.10 equiv_type_hlds.m
--- compiler/equiv_type_hlds.m 21 Jan 2005 06:20:37 -0000 1.10
+++ compiler/equiv_type_hlds.m 22 Mar 2005 12:23:48 -0000
@@ -290,7 +290,7 @@
% The constraint_proofs aren't used after polymorphism,
% so they don't need to be processed.
pred_info_get_class_context(!.PredInfo, ClassContext0),
- equiv_type__replace_in_class_constraints(EqvMap, ClassContext0,
+ equiv_type__replace_in_prog_constraints(EqvMap, ClassContext0,
ClassContext, ArgTVarSet1, ArgTVarSet, !EquivTypeInfo),
pred_info_set_class_context(ClassContext, !PredInfo),
pred_info_set_arg_types(ArgTVarSet, ExistQVars, ArgTypes, !PredInfo),
@@ -353,7 +353,7 @@
list__map_foldl(
(pred((Constraint0 - Locn)::in, (Constraint - Locn)::out,
!.TVarSet::in, !:TVarSet::out) is det :-
- equiv_type__replace_in_class_constraint(EqvMap,
+ equiv_type__replace_in_prog_constraint(EqvMap,
Constraint0, Constraint, !TVarSet, no, _)
), TCVarAL0, TCVarAL, !TVarSet),
map__from_assoc_list(TCVarAL, TCVarMap),
Index: compiler/goal_path.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/goal_path.m,v
retrieving revision 1.21
diff -u -r1.21 goal_path.m
--- compiler/goal_path.m 20 Dec 2004 01:15:37 -0000 1.21
+++ compiler/goal_path.m 23 Mar 2005 04:19:28 -0000
@@ -19,6 +19,12 @@
:- import_module bool.
+ % IMPORTANT: the type constraint_id in hlds_data.m makes use of
+ % goal_paths to identify constraints between the typechecking pass
+ % and the polymorphism pass. For this reason, goal paths should not
+ % be recalculated anywhere between these two passes. See the XXX
+ % comment near the declaration of constraint_id.
+
:- pred goal_path__fill_slots(module_info::in, proc_info::in, proc_info::out)
is det.
@@ -147,9 +153,18 @@
fill_goal_slots(Cond0, [ite_cond | Path0], SlotInfo, Cond),
fill_goal_slots(Then0, [ite_then | Path0], SlotInfo, Then),
fill_goal_slots(Else0, [ite_else | Path0], SlotInfo, Else).
+fill_expr_slots(unify(LHS, RHS0, Mode, Kind, Context), _, Path0, SlotInfo,
+ unify(LHS, RHS, Mode, Kind, Context)) :-
+ (
+ RHS0 = lambda_goal(A, B, C, D, E, F, G, H, LambdaGoal0)
+ ->
+ fill_goal_slots(LambdaGoal0, Path0, SlotInfo, LambdaGoal),
+ RHS = lambda_goal(A, B, C, D, E, F, G, H, LambdaGoal)
+ ;
+ RHS = RHS0
+ ).
fill_expr_slots(Goal @ call(_, _, _, _, _, _), _, _, _, Goal).
fill_expr_slots(Goal @ generic_call(_, _, _, _), _, _, _, Goal).
-fill_expr_slots(Goal @ unify(_, _, _, _, _), _, _, _, Goal).
fill_expr_slots(Goal @ foreign_proc(_, _, _, _, _, _), _, _, _, Goal).
fill_expr_slots(shorthand(_), _, _, _, _) :-
% these should have been expanded out by now
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.103
diff -u -r1.103 goal_util.m
--- compiler/goal_util.m 15 Feb 2005 05:22:16 -0000 1.103
+++ compiler/goal_util.m 22 Mar 2005 12:23:48 -0000
@@ -122,8 +122,8 @@
% type variable.
%
:- pred goal_util__extra_nonlocal_typeinfos(map(tvar, type_info_locn)::in,
- map(class_constraint, prog_var)::in, map(prog_var, type)::in,
- existq_tvars::in, set(prog_var)::in, set(prog_var)::out) is det.
+ typeclass_info_varmap::in, map(prog_var, type)::in, existq_tvars::in,
+ set(prog_var)::in, set(prog_var)::out) is det.
% See whether the goal is a branched structure.
:- pred goal_util__goal_is_branched(hlds_goal_expr::in) is semidet.
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.125
diff -u -r1.125 higher_order.m
--- compiler/higher_order.m 22 Mar 2005 06:39:58 -0000 1.125
+++ compiler/higher_order.m 22 Mar 2005 12:23:48 -0000
@@ -888,7 +888,7 @@
:- pred find_matching_instance_method(list(hlds_instance_defn)::in, int::in,
list(type)::in, pred_id::out, proc_id::out,
- list(class_constraint)::out, list(type)::out,
+ list(prog_constraint)::out, list(type)::out,
tvarset::in, tvarset::out) is semidet.
find_matching_instance_method([Instance | Instances], MethodNum, ClassTypes,
@@ -910,7 +910,7 @@
).
:- pred instance_matches(list(type)::in, hlds_instance_defn::in,
- list(class_constraint)::out, list(type)::out,
+ list(prog_constraint)::out, list(type)::out,
tvarset::in, tvarset::out) is semidet.
instance_matches(ClassTypes, Instance, Constraints, UnconstrainedTVarTypes,
@@ -921,14 +921,14 @@
RenameSubst),
term__apply_substitution_to_list(InstanceTypes0,
RenameSubst, InstanceTypes),
- apply_subst_to_constraint_list(RenameSubst,
+ apply_subst_to_prog_constraint_list(RenameSubst,
Constraints0, Constraints1),
term__vars_list(InstanceTypes, InstanceTVars),
get_unconstrained_tvars(InstanceTVars, Constraints1,
UnconstrainedTVars0),
type_list_subsumes(InstanceTypes, ClassTypes, Subst),
- apply_rec_subst_to_constraint_list(Subst,
+ apply_rec_subst_to_prog_constraint_list(Subst,
Constraints1, Constraints),
term__var_list_to_term_list(UnconstrainedTVars0,
@@ -942,7 +942,7 @@
% This simulates the action of `do_call_class_method' in
% runtime/mercury_ho_call.c.
:- pred get_arg_typeclass_infos(module_info::in, prog_var::in,
- list(class_constraint)::in, int::in, list(hlds_goal)::out,
+ list(prog_constraint)::in, int::in, list(hlds_goal)::out,
list(prog_var)::out, proc_info::in, proc_info::out) is det.
get_arg_typeclass_infos(ModuleInfo, TypeClassInfoVar, InstanceConstraints,
@@ -1406,7 +1406,7 @@
% the class constraints match an instance which was not matched
% before.
:- pred type_subst_makes_instance_known(module_info::in,
- list(class_constraint)::in, tvarset::in, list(tvar)::in,
+ list(prog_constraint)::in, tvarset::in, list(tvar)::in,
list(type)::in, tvarset::in, existq_tvars::in, list(type)::in)
is semidet.
@@ -1422,9 +1422,9 @@
% Substitute the types in the callee's class constraints.
inlining__get_type_substitution(CalleeArgTypes1, ArgTypes,
CallerHeadTypeParams, CalleeExistQVars, TypeSubn),
- apply_subst_to_constraint_list(TypeRenaming,
+ apply_subst_to_prog_constraint_list(TypeRenaming,
CalleeUnivConstraints0, CalleeUnivConstraints1),
- apply_rec_subst_to_constraint_list(TypeSubn,
+ apply_rec_subst_to_prog_constraint_list(TypeSubn,
CalleeUnivConstraints1, CalleeUnivConstraints),
assoc_list__from_corresponding_lists(CalleeUnivConstraints0,
CalleeUnivConstraints, CalleeUnivConstraintAL),
@@ -2518,6 +2518,7 @@
map__init(EmptyVarTypes),
map__init(EmptyTVarNameMap),
map__init(EmptyProofs),
+ map__init(EmptyConstraintMap),
map__init(EmptyTIMap),
map__init(EmptyTCIMap),
@@ -2529,7 +2530,8 @@
Origin = transformed(Transform, OrigOrigin, CallerPredId),
pred_info_init(PredModule, SymName, Arity, PredOrFunc, Context, Origin,
Status, GoalType, MarkerList, Types, ArgTVarSet, ExistQVars,
- ClassContext, EmptyProofs, Owner, ClausesInfo, NewPredInfo0),
+ ClassContext, EmptyProofs, EmptyConstraintMap, Owner,
+ ClausesInfo, NewPredInfo0),
pred_info_set_typevarset(TypeVarSet, NewPredInfo0, NewPredInfo1),
module_info_get_predicate_table(ModuleInfo0, PredTable0),
@@ -3170,12 +3172,12 @@
%-----------------------------------------------------------------------------%
- % Collect the list of class_constraints from the list of argument
+ % Collect the list of prog_constraints from the list of argument
% types. The typeclass_info for universal constraints is input,
% output for existential constraints.
:- pred find_class_context(module_info::in, list(type)::in, list(mode)::in,
- list(class_constraint)::in, list(class_constraint)::in,
- class_constraints::out) is det.
+ list(prog_constraint)::in, list(prog_constraint)::in,
+ prog_constraints::out) is det.
find_class_context(_, [], [], Univ0, Exist0, Constraints) :-
list__reverse(Univ0, Univ),
@@ -3199,8 +3201,8 @@
find_class_context(ModuleInfo, Types, Modes, !.Univ, !.Exist,
Constraints).
-:- pred maybe_add_constraint(class_constraint::in,
- list(class_constraint)::in, list(class_constraint)::out) is det.
+:- pred maybe_add_constraint(prog_constraint::in,
+ list(prog_constraint)::in, list(prog_constraint)::out) is det.
maybe_add_constraint(Constraint, !Constraints) :-
(
Index: compiler/hlds_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.90
diff -u -r1.90 hlds_data.m
--- compiler/hlds_data.m 22 Mar 2005 06:39:58 -0000 1.90
+++ compiler/hlds_data.m 23 Mar 2005 09:08:39 -0000
@@ -14,6 +14,7 @@
:- interface.
:- import_module hlds__hlds_pred.
+:- import_module hlds__hlds_goal.
:- import_module mdbcomp__prim_data.
:- import_module parse_tree__prog_data.
@@ -47,7 +48,7 @@
% you can get the tvarset from the hlds__type_defn.
cons_exist_tvars :: existq_tvars,
% existential type vars
- cons_constraints :: list(class_constraint),
+ cons_constraints :: list(prog_constraint),
% existential class constraints
cons_args :: list(constructor_arg),
% The field names and types of
@@ -791,7 +792,7 @@
:- type hlds_class_defn --->
hlds_class_defn(
class_status :: import_status,
- class_supers :: list(class_constraint),
+ class_supers :: list(prog_constraint),
% SuperClasses
class_vars :: list(tvar),
% ClassVars
@@ -831,8 +832,9 @@
% declaration
instance_context :: prog_context,
% context of declaration
- instance_constraints :: list(class_constraint),
- % Constraints
+ instance_constraints :: list(prog_constraint),
+ % Constraints on the instance
+ % declaration.
instance_types :: list(type),
% ClassTypes
instance_body :: instance_body,
@@ -843,14 +845,66 @@
% proc_ids of all the methods
instance_tvarset :: tvarset,
% VarNames
- instance_proofs :: map(class_constraint,
- constraint_proof)
+ instance_proofs :: constraint_proof_map
% "Proofs" of how to build the
% typeclass_infos for the
- % superclasses of this class,
- % for this instance
+ % superclasses of this class (that is,
+ % the constraints on the class
+ % declaration), for this instance.
).
+ % Identifiers for constraints which are unique across a given
+ % type_assign. Integers in these values refer to the position in
+ % the list of constraints at that location, beginning from 1.
+ %
+ % Only identifiers for constraints appearing directly on a goal are
+ % needed at the moment, so there is no way to represent the
+ % appropriate identifier for the superclass of such a constraint.
+ %
+ % XXX a more robust and efficient solution would be to allocate
+ % unique integers to the constraints as they are encountered, and
+ % store the allocated integer in the relevant hlds_goal_expr.
+ %
+:- type constraint_id
+ ---> constraint_id(
+ constraint_type,
+ % Existential or universal.
+
+ goal_path,
+ % The location of the atomic goal which is
+ % constrained.
+
+ int % The position of the constraint.
+ ).
+
+:- type constraint_type
+ ---> existential
+ ; universal.
+
+ % THe identifier of a constraint is stored along with the constraint.
+ % Each value of this type may have more than one identifier because
+ % if two constraints in a context are equivalent then we merge them
+ % together in order to not have to prove the same constraint twice.
+ %
+:- type hlds_constraint
+ ---> constraint(
+ list(constraint_id),
+ class_name,
+ list(type)
+ ).
+
+:- type hlds_constraints
+ ---> constraints(
+ list(hlds_constraint), % Universal constraints.
+ list(hlds_constraint) % Existential constraints.
+ ).
+
+ % During type checking we fill in a constraint_map which gives
+ % the constraint that corresponds to each identifier. This is used
+ % by the polymorphism translation to retrieve details of constraints.
+ %
+:- type constraint_map == map(constraint_id, prog_constraint).
+
% `Proof' of why a constraint is redundant
:- type constraint_proof
% Apply the instance decl with the given number.
@@ -871,9 +925,135 @@
% The constraint is redundant because of the
% following class's superclass declaration
- ; superclass(class_constraint).
+ ; superclass(prog_constraint).
+
+:- type constraint_proof_map == map(prog_constraint, constraint_proof).
+
+:- pred init_hlds_constraint_list(list(prog_constraint)::in,
+ list(hlds_constraint)::out) is det.
+
+:- pred make_hlds_constraints(prog_constraints::in, goal_path::in,
+ hlds_constraints::out) is det.
+
+:- pred make_hlds_constraint_list(list(prog_constraint)::in,
+ constraint_type::in, goal_path::in, list(hlds_constraint)::out) is det.
+
+:- pred retrieve_prog_constraints(hlds_constraints::in, prog_constraints::out)
+ is det.
+
+:- pred retrieve_prog_constraint_list(list(hlds_constraint)::in,
+ list(prog_constraint)::out) is det.
+
+:- pred retrieve_prog_constraint(hlds_constraint::in, prog_constraint::out)
+ is det.
+
+:- pred matching_constraints(hlds_constraint::in, hlds_constraint::in)
+ is semidet.
+
+:- pred compare_hlds_constraints(hlds_constraint::in, hlds_constraint::in,
+ comparison_result::out) is det.
+
+:- pred update_constraint_map(hlds_constraint::in, constraint_map::in,
+ constraint_map::out) is det.
+
+:- pred lookup_hlds_constraint_list(constraint_map::in, constraint_type::in,
+ goal_path::in, int::in, list(prog_constraint)::out) is det.
+
+:- implementation.
+
+init_hlds_constraint_list(ProgConstraints, Constraints) :-
+ list.map(init_hlds_constraint, ProgConstraints, Constraints).
+
+:- pred init_hlds_constraint(prog_constraint::in, hlds_constraint::out) is det.
+
+init_hlds_constraint(constraint(Name, Types), constraint([], Name, Types)).
+
+make_hlds_constraints(ProgConstraints, GoalPath, Constraints) :-
+ ProgConstraints = constraints(UnivProgConstraints,
+ ExistProgConstraints),
+ make_hlds_constraint_list(UnivProgConstraints, universal, GoalPath,
+ UnivConstraints),
+ make_hlds_constraint_list(ExistProgConstraints, existential, GoalPath,
+ ExistConstraints),
+ Constraints = constraints(UnivConstraints, ExistConstraints).
+
+make_hlds_constraint_list(ProgConstraints, ConstraintType, GoalPath,
+ Constraints) :-
+ make_hlds_constraint_list_2(ProgConstraints, ConstraintType, GoalPath,
+ 1, Constraints).
+
+:- pred make_hlds_constraint_list_2(list(prog_constraint)::in,
+ constraint_type::in, goal_path::in, int::in,
+ list(hlds_constraint)::out) is det.
+
+make_hlds_constraint_list_2([], _, _, _, []).
+make_hlds_constraint_list_2([P | Ps], T, G, N, [H | Hs]) :-
+ P = constraint(Name, Types),
+ Id = constraint_id(T, G, N),
+ H = constraint([Id], Name, Types),
+ make_hlds_constraint_list_2(Ps, T, G, N + 1, Hs).
+
+retrieve_prog_constraints(Constraints, ProgConstraints) :-
+ Constraints = constraints(UnivConstraints, ExistConstraints),
+ retrieve_prog_constraint_list(UnivConstraints, UnivProgConstraints),
+ retrieve_prog_constraint_list(ExistConstraints, ExistProgConstraints),
+ ProgConstraints = constraints(UnivProgConstraints,
+ ExistProgConstraints).
+
+retrieve_prog_constraint_list(Constraints, ProgConstraints) :-
+ list.map(retrieve_prog_constraint, Constraints, ProgConstraints).
+
+retrieve_prog_constraint(Constraint, ProgConstraint) :-
+ Constraint = constraint(_, Name, Types),
+ ProgConstraint = constraint(Name, Types).
+
+matching_constraints(constraint(_, Name, Types), constraint(_, Name, Types)).
+
+compare_hlds_constraints(constraint(_, NA, TA), constraint(_, NB, TB), R) :-
+ compare(R0, NA, NB),
+ ( R0 = (=) ->
+ compare(R, TA, TB)
+ ;
+ R = R0
+ ).
+
+update_constraint_map(Constraint, !ConstraintMap) :-
+ Constraint = constraint(Ids, Name, Types),
+ ProgConstraint = constraint(Name, Types),
+ list.foldl(update_constraint_map_2(ProgConstraint), Ids,
+ !ConstraintMap).
+
+:- pred update_constraint_map_2(prog_constraint::in, constraint_id::in,
+ constraint_map::in, constraint_map::out) is det.
+
+update_constraint_map_2(ProgConstraint, ConstraintId, ConstraintMap0,
+ ConstraintMap) :-
+ map.set(ConstraintMap0, ConstraintId, ProgConstraint, ConstraintMap).
+
+lookup_hlds_constraint_list(ConstraintMap, ConstraintType, GoalPath, Count,
+ Constraints) :-
+ lookup_hlds_constraint_list_2(ConstraintMap, ConstraintType, GoalPath,
+ Count, [], Constraints).
+
+:- pred lookup_hlds_constraint_list_2(constraint_map::in, constraint_type::in,
+ goal_path::in, int::in, list(prog_constraint)::in,
+ list(prog_constraint)::out) is det.
+
+lookup_hlds_constraint_list_2(ConstraintMap, ConstraintType, GoalPath, Count,
+ !Constraints) :-
+ ( Count = 0 ->
+ true
+ ;
+ ConstraintId = constraint_id(ConstraintType, GoalPath, Count),
+ map.lookup(ConstraintMap, ConstraintId, Constraint),
+ !:Constraints = [Constraint | !.Constraints],
+ lookup_hlds_constraint_list_2(ConstraintMap, ConstraintType,
+ GoalPath, Count - 1, !Constraints)
+ ).
%-----------------------------------------------------------------------------%
+
+:- interface.
:- type subclass_details --->
subclass_details(
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.350
diff -u -r1.350 hlds_out.m
--- compiler/hlds_out.m 22 Mar 2005 06:39:59 -0000 1.350
+++ compiler/hlds_out.m 23 Mar 2005 10:58:54 -0000
@@ -915,6 +915,7 @@
pred_info_get_markers(PredInfo, Markers),
pred_info_get_class_context(PredInfo, ClassContext),
pred_info_get_constraint_proofs(PredInfo, Proofs),
+ pred_info_get_constraint_map(PredInfo, ConstraintMap),
pred_info_get_purity(PredInfo, Purity),
pred_info_get_head_type_params(PredInfo, HeadTypeParams),
pred_info_get_indexes(PredInfo, Indexes),
@@ -980,6 +981,12 @@
Proofs, AppendVarNums, !IO),
io__write_string("\n", !IO)
),
+ ( map__is_empty(ConstraintMap) ->
+ true
+ ;
+ hlds_out__write_constraint_map(Indent, TVarSet,
+ ConstraintMap, AppendVarNums, !IO)
+ ),
% XXX The indexes are not part of the clauses_info,
% so why is this code inside this if-then-else
@@ -3091,7 +3098,7 @@
AppendVarNums, VarSet, TVarSet), TypeClassInfoVarMap, !IO).
:- pred hlds_out__write_typeclass_info_varmap_2(int::in, bool::in,
- prog_varset::in, tvarset::in, class_constraint::in, prog_var::in,
+ prog_varset::in, tvarset::in, prog_constraint::in, prog_var::in,
io::di, io::uo) is det.
hlds_out__write_typeclass_info_varmap_2(Indent, AppendVarNums, VarSet, TVarSet,
@@ -3880,8 +3887,7 @@
%-----------------------------------------------------------------------------%
:- pred hlds_out__write_constraint_proofs(int::in, tvarset::in,
- map(class_constraint, constraint_proof)::in, bool::in,
- io::di, io::uo) is det.
+ constraint_proof_map::in, bool::in, io::di, io::uo) is det.
hlds_out__write_constraint_proofs(Indent, VarSet, Proofs, AppendVarNums,
!IO) :-
@@ -3893,7 +3899,7 @@
VarSet, AppendVarNums), !IO).
:- pred hlds_out__write_constraint_proof(int::in, tvarset::in, bool::in,
- pair(class_constraint, constraint_proof)::in, io::di, io::uo) is det.
+ pair(prog_constraint, constraint_proof)::in, io::di, io::uo) is det.
hlds_out__write_constraint_proof(Indent, VarSet, AppendVarNums,
Constraint - Proof, !IO) :-
@@ -3910,6 +3916,45 @@
io__write_string("super class of ", !IO),
mercury_output_constraint(VarSet, AppendVarNums, Super, !IO)
).
+
+:- pred hlds_out__write_constraint_map(int::in, tvarset::in,
+ constraint_map::in, bool::in, io::di, io::uo) is det.
+
+hlds_out__write_constraint_map(Indent, VarSet, ConstraintMap, AppendVarNums,
+ !IO) :-
+ hlds_out__write_indent(Indent, !IO),
+ io__write_string("% Constraint Map:\n", !IO),
+ map__foldl(write_constraint_map_2(Indent, VarSet, AppendVarNums),
+ ConstraintMap, !IO).
+
+:- pred write_constraint_map_2(int::in, tvarset::in, bool::in,
+ constraint_id::in, prog_constraint::in, io::di, io::uo) is det.
+
+write_constraint_map_2(Indent, VarSet, AppendVarNums, ConstraintId,
+ ProgConstraint, !IO) :-
+ hlds_out__write_indent(Indent, !IO),
+ io__write_string("% ", !IO),
+ hlds_out__write_constraint_id(ConstraintId, !IO),
+ io__write_string(": ", !IO),
+ mercury_output_constraint(VarSet, AppendVarNums, ProgConstraint, !IO),
+ io__nl(!IO).
+
+:- pred hlds_out__write_constraint_id(constraint_id::in, io::di, io::uo)
+ is det.
+
+hlds_out__write_constraint_id(ConstraintId, !IO) :-
+ ConstraintId = constraint_id(ConstraintType, GoalPath, N),
+ (
+ ConstraintType = existential,
+ io__write_string("(E, ", !IO)
+ ;
+ ConstraintType = universal,
+ io__write_string("(A, ", !IO)
+ ),
+ goal_path_to_string(GoalPath, GoalPathStr),
+ io__write_strings(["""", GoalPathStr, """, "], !IO),
+ io__write_int(N, !IO),
+ io__write_char(')', !IO).
%-----------------------------------------------------------------------------%
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.159
diff -u -r1.159 hlds_pred.m
--- compiler/hlds_pred.m 22 Mar 2005 06:40:00 -0000 1.159
+++ compiler/hlds_pred.m 22 Mar 2005 12:23:48 -0000
@@ -575,12 +575,6 @@
% module, name and arity.
:- type aditi_owner == string.
- % The constraint_proof_map is a map which for each type class
- % constraint records how/why that constraint was satisfied.
- % This information is used to determine how to construct the
- % typeclass_info for that constraint.
-:- type constraint_proof_map == map(class_constraint, constraint_proof).
-
% Describes the class constraints on an instance method implementation.
% This information is used by polymorphism.m to ensure that the
% type_info and typeclass_info arguments are added in the order in
@@ -590,9 +584,9 @@
class_id,
list(type), % The types in the head of the
% instance declaration.
- list(class_constraint), % The universal constraints
+ list(prog_constraint), % The universal constraints
% on the instance declaration.
- class_constraints % The contraints on the method's
+ prog_constraints % The contraints on the method's
% type declaration in the
% `:- typeclass' declaration.
).
@@ -600,7 +594,7 @@
% A typeclass_info_varmap is a map which for each type class constraint
% records which variable contains the typeclass_info for that
% constraint.
-:- type typeclass_info_varmap == map(class_constraint, prog_var).
+:- type typeclass_info_varmap == map(prog_constraint, prog_var).
% A type_info_varmap is a map which for each type variable
% records where the type_info for that type variable is stored.
@@ -721,8 +715,8 @@
% pred_info_init(ModuleName, SymName, Arity, PredOrFunc, Context,
% Origin, Status, GoalType, Markers, ArgTypes, TypeVarSet,
- % ExistQVars, ClassContext, ClassProofs, User, ClausesInfo,
- % PredInfo)
+ % ExistQVars, ClassContext, ClassProofs, ClassConstraintMap,
+ % User, ClausesInfo, PredInfo)
%
% Return a pred_info whose fields are filled in from the information
% (direct and indirect) in the arguments, and from defaults.
@@ -730,8 +724,9 @@
:- pred pred_info_init(module_name::in, sym_name::in, arity::in,
pred_or_func::in, prog_context::in, pred_origin::in, import_status::in,
goal_type::in, pred_markers::in, list(type)::in, tvarset::in,
- existq_tvars::in, class_constraints::in, constraint_proof_map::in,
- aditi_owner::in, clauses_info::in, pred_info::out) is det.
+ existq_tvars::in, prog_constraints::in, constraint_proof_map::in,
+ constraint_map::in, aditi_owner::in, clauses_info::in,
+ pred_info::out) is det.
% pred_info_create(ModuleName, SymName, PredOrFunc, Context, Origin,
% Status, Markers, TypeVarSet, ExistQVars, ArgTypes,
@@ -744,7 +739,7 @@
:- pred pred_info_create(module_name::in, sym_name::in, pred_or_func::in,
prog_context::in, pred_origin::in, import_status::in, pred_markers::in,
- list(type)::in, tvarset::in, existq_tvars::in, class_constraints::in,
+ list(type)::in, tvarset::in, existq_tvars::in, prog_constraints::in,
set(assert_id)::in, aditi_owner::in, proc_info::in, proc_id::out,
pred_info::out) is det.
@@ -761,7 +756,7 @@
:- pred hlds_pred__define_new_pred(pred_origin::in,
hlds_goal::in, hlds_goal::out, list(prog_var)::in, list(prog_var)::out,
instmap::in, string::in, tvarset::in, vartypes::in,
- class_constraints::in, type_info_varmap::in, typeclass_info_varmap::in,
+ prog_constraints::in, type_info_varmap::in, typeclass_info_varmap::in,
prog_varset::in, inst_varset::in, pred_markers::in, aditi_owner::in,
is_address_taken::in, module_info::in, module_info::out,
pred_proc_id::out) is det.
@@ -799,12 +794,14 @@
is det.
:- pred pred_info_get_head_type_params(pred_info::in, head_type_params::out)
is det.
-:- pred pred_info_get_class_context(pred_info::in, class_constraints::out)
+:- pred pred_info_get_class_context(pred_info::in, prog_constraints::out)
is det.
:- pred pred_info_get_constraint_proofs(pred_info::in,
constraint_proof_map::out) is det.
+:- pred pred_info_get_constraint_map(pred_info::in,
+ constraint_map::out) is det.
:- pred pred_info_get_unproven_body_constraints(pred_info::in,
- list(class_constraint)::out) is det.
+ list(prog_constraint)::out) is det.
:- pred pred_info_get_assertions(pred_info::in, set(assert_id)::out) is det.
:- pred pred_info_get_aditi_owner(pred_info::in, string::out) is det.
:- pred pred_info_get_indexes(pred_info::in, list(index_spec)::out) is det.
@@ -825,11 +822,13 @@
pred_info::in, pred_info::out) is det.
:- pred pred_info_set_head_type_params(head_type_params::in,
pred_info::in, pred_info::out) is det.
-:- pred pred_info_set_class_context(class_constraints::in,
+:- pred pred_info_set_class_context(prog_constraints::in,
pred_info::in, pred_info::out) is det.
:- pred pred_info_set_constraint_proofs(constraint_proof_map::in,
pred_info::in, pred_info::out) is det.
-:- pred pred_info_set_unproven_body_constraints(list(class_constraint)::in,
+:- pred pred_info_set_constraint_map(constraint_map::in,
+ pred_info::in, pred_info::out) is det.
+:- pred pred_info_set_unproven_body_constraints(list(prog_constraint)::in,
pred_info::in, pred_info::out) is det.
:- pred pred_info_set_assertions(set(assert_id)::in,
pred_info::in, pred_info::out) is det.
@@ -1140,7 +1139,7 @@
% the called preds).
% Computed during type checking.
- class_context :: class_constraints,
+ class_context :: prog_constraints,
% the class constraints on the
% type variables in the predicate's
% type declaration
@@ -1151,7 +1150,11 @@
% work out where to get the
% typeclass_infos from.
% Computed during type checking.
- unproven_body_constraints :: list(class_constraint),
+ constraint_map :: constraint_map,
+ % maps constraint identifiers to the actual
+ % constraints.
+ % Computed during type checking.
+ unproven_body_constraints :: list(prog_constraint),
% unproven class constraints on type
% variables in the predicate's body,
% if any (if this remains non-empty
@@ -1186,7 +1189,8 @@
pred_info_init(ModuleName, SymName, Arity, PredOrFunc, Context, Origin,
Status, GoalType, Markers, ArgTypes, TypeVarSet, ExistQVars,
- ClassContext, ClassProofs, User, ClausesInfo, PredInfo) :-
+ ClassContext, ClassProofs, ClassConstraintMap, User,
+ ClausesInfo, PredInfo) :-
unqualify_name(SymName, PredName),
sym_name_get_module_name(SymName, ModuleName, PredModuleName),
term__vars_list(ArgTypes, TVars),
@@ -1199,9 +1203,9 @@
PredInfo = pred_info(PredModuleName, PredName, Arity, PredOrFunc,
Context, Origin, Status, GoalType, Markers, Attributes,
ArgTypes, TypeVarSet, TypeVarSet, ExistQVars, HeadTypeParams,
- ClassContext, ClassProofs, UnprovenBodyConstraints,
- inst_graph_info_init, [], Assertions, User, Indexes,
- ClausesInfo, Procs).
+ ClassContext, ClassProofs, ClassConstraintMap,
+ UnprovenBodyConstraints, inst_graph_info_init, [], Assertions,
+ User, Indexes, ClausesInfo, Procs).
pred_info_create(ModuleName, SymName, PredOrFunc, Context, Origin, Status,
Markers, ArgTypes, TypeVarSet, ExistQVars, ClassContext,
@@ -1213,6 +1217,7 @@
unqualify_name(SymName, PredName),
Attributes = [],
map__init(ClassProofs),
+ map__init(ClassConstraintMap),
term__vars_list(ArgTypes, TVars),
list__delete_elems(TVars, ExistQVars, HeadTypeParams),
UnprovenBodyConstraints = [],
@@ -1236,9 +1241,9 @@
PredInfo = pred_info(ModuleName, PredName, Arity, PredOrFunc,
Context, Origin, Status, clauses, Markers, Attributes,
ArgTypes, TypeVarSet, TypeVarSet, ExistQVars, HeadTypeParams,
- ClassContext, ClassProofs, UnprovenBodyConstraints,
- inst_graph_info_init, [], Assertions, User, Indexes,
- ClausesInfo, Procs).
+ ClassContext, ClassProofs, ClassConstraintMap,
+ UnprovenBodyConstraints, inst_graph_info_init, [], Assertions,
+ User, Indexes, ClausesInfo, Procs).
hlds_pred__define_new_pred(Origin, Goal0, Goal, ArgVars0, ExtraTypeInfos,
InstMap0, PredName, TVarSet, VarTypes0, ClassContext,
@@ -1348,6 +1353,7 @@
pred_info_get_head_type_params(PI, PI ^ head_type_params).
pred_info_get_class_context(PI, PI ^ class_context).
pred_info_get_constraint_proofs(PI, PI ^ constraint_proofs).
+pred_info_get_constraint_map(PI, PI ^ constraint_map).
pred_info_get_unproven_body_constraints(PI, PI ^ unproven_body_constraints).
pred_info_get_assertions(PI, PI ^ assertions).
pred_info_get_aditi_owner(PI, PI ^ aditi_owner).
@@ -1364,6 +1370,7 @@
pred_info_set_head_type_params(X, PI, PI ^ head_type_params := X).
pred_info_set_class_context(X, PI, PI ^ class_context := X).
pred_info_set_constraint_proofs(X, PI, PI ^ constraint_proofs := X).
+pred_info_set_constraint_map(X, PI, PI ^ constraint_map := X).
pred_info_set_unproven_body_constraints(X, PI,
PI ^ unproven_body_constraints := X).
pred_info_set_assertions(X, PI, PI ^ assertions := X).
Index: compiler/lambda.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lambda.m,v
retrieving revision 1.96
diff -u -r1.96 lambda.m
--- compiler/lambda.m 22 Mar 2005 06:40:02 -0000 1.96
+++ compiler/lambda.m 22 Mar 2005 12:23:48 -0000
@@ -118,14 +118,13 @@
lambda_info(
prog_varset, % from the proc_info
map(prog_var, type), % from the proc_info
- class_constraints, % from the pred_info
+ prog_constraints, % from the pred_info
tvarset, % from the proc_info
inst_varset, % from the proc_info
map(tvar, type_info_locn),
% from the proc_info
% (typeinfos)
- map(class_constraint, prog_var),
- % from the proc_info
+ typeclass_info_varmap, % from the proc_info
% (typeclass_infos)
pred_markers, % from the pred_info
pred_or_func,
@@ -597,7 +596,7 @@
InstVarSet, TVarMap, TCVarMap, Markers, POF, OrigPredName,
Owner, ModuleInfo, MustRecomputeNonLocals).
-:- pred lambda__constraint_contains_vars(list(tvar)::in, class_constraint::in)
+:- pred lambda__constraint_contains_vars(list(tvar)::in, prog_constraint::in)
is semidet.
lambda__constraint_contains_vars(LambdaVars, ClassConstraint) :-
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.506
diff -u -r1.506 make_hlds.m
--- compiler/make_hlds.m 22 Mar 2005 06:40:06 -0000 1.506
+++ compiler/make_hlds.m 23 Mar 2005 07:42:44 -0000
@@ -1681,6 +1681,7 @@
pred_info_get_markers(PredInfo0, Markers0),
add_marker(calls_are_fully_qualified, Markers0, Markers),
map__init(Proofs),
+ map__init(ConstraintMap),
( pred_info_is_imported(PredInfo0) ->
Status = opt_imported
@@ -1696,8 +1697,8 @@
OrigOrigin, PredId),
pred_info_init(ModuleName, SpecName, PredArity, PredOrFunc,
Context, Origin, Status, none, Markers, Types, TVarSet,
- ExistQVars, ClassContext, Proofs, Owner, Clauses,
- NewPredInfo0),
+ ExistQVars, ClassContext, Proofs, ConstraintMap, Owner,
+ Clauses, NewPredInfo0),
pred_info_set_procedures(Procs, NewPredInfo0, NewPredInfo),
module_info_get_predicate_table(!.ModuleInfo, PredTable0),
predicate_table_insert(NewPredInfo, NewPredId,
@@ -1769,7 +1770,7 @@
% of the current implementation, so it only results in a warning.
:- pred handle_pragma_type_spec_subst(prog_context::in,
assoc_list(tvar, type)::in, pred_info::in, tvarset::in, tvarset::out,
- list(type)::out, existq_tvars::out, class_constraints::out,
+ list(type)::out, existq_tvars::out, prog_constraints::out,
maybe(tsubst)::out, module_info::in, module_info::out,
io::di, io::uo) is det.
@@ -1843,8 +1844,8 @@
pred_info_get_class_context(PredInfo0, ClassContext0),
term__apply_rec_substitution_to_list(Types0, TypeSubst,
Types),
- apply_rec_subst_to_constraints(TypeSubst, ClassContext0,
- ClassContext),
+ apply_rec_subst_to_prog_constraints(TypeSubst,
+ ClassContext0, ClassContext),
SubstOk = yes(TypeSubst)
;
SubExistQVars = [_ | _],
@@ -3270,7 +3271,7 @@
:- pred module_add_pred_or_func(tvarset::in, inst_varset::in, existq_tvars::in,
pred_or_func::in, sym_name::in, list(type_and_mode)::in,
maybe(determinism)::in, purity::in,
- class_constraints::in, pred_markers::in, prog_context::in,
+ prog_constraints::in, pred_markers::in, prog_context::in,
item_status::in, maybe(pair(pred_id, proc_id))::out,
module_info::in, module_info::out, io::di, io::uo) is det.
@@ -3325,7 +3326,7 @@
MaybePredProcId = no
).
-:- pred module_add_class_defn(list(class_constraint)::in, sym_name::in,
+:- pred module_add_class_defn(list(prog_constraint)::in, sym_name::in,
list(tvar)::in, class_interface::in, tvarset::in, prog_context::in,
item_status::in, module_info::in, module_info::out,
io::di, io::uo) is det.
@@ -3421,17 +3422,8 @@
module_info_set_classes(Classes, !ModuleInfo),
( IsNewDefn = yes ->
- % insert an entry into the super class table
- % for each super class of this class
- AddSuper = (pred(Super::in, Ss0::in, Ss::out) is det :-
- Super = constraint(SuperName, SuperTypes),
- list__length(SuperTypes, SuperClassArity),
- SuperClassId = class_id(SuperName, SuperClassArity),
- SubClassDetails = subclass_details(SuperTypes, ClassId,
- Vars, VarSet),
- multi_map__set(Ss0, SuperClassId, SubClassDetails, Ss)
- ),
- list__foldl(AddSuper, Constraints, SuperClasses0, SuperClasses),
+ update_superclass_table(ClassId, Vars, VarSet, Constraints,
+ SuperClasses0, SuperClasses),
module_info_set_superclasses(SuperClasses, !ModuleInfo),
@@ -3448,17 +3440,18 @@
).
:- pred superclass_constraints_are_identical(list(tvar)::in, tvarset::in,
- list(class_constraint)::in, list(tvar)::in, tvarset::in,
- list(class_constraint)::in) is semidet.
+ list(prog_constraint)::in, list(tvar)::in, tvarset::in,
+ list(prog_constraint)::in) is semidet.
superclass_constraints_are_identical(OldVars0, OldVarSet, OldConstraints0,
Vars, VarSet, Constraints) :-
varset__merge_subst(VarSet, OldVarSet, _, Subst),
- apply_subst_to_constraint_list(Subst, OldConstraints0, OldConstraints1),
+ apply_subst_to_prog_constraint_list(Subst, OldConstraints0,
+ OldConstraints1),
OldVars = term__term_list_to_var_list(map__apply_to_list(OldVars0, Subst)),
map__from_corresponding_lists(OldVars, Vars, VarRenaming),
- apply_variable_renaming_to_constraint_list(VarRenaming,
+ apply_variable_renaming_to_prog_constraint_list(VarRenaming,
OldConstraints1, OldConstraints),
OldConstraints = Constraints.
@@ -3524,6 +3517,26 @@
)
).
+ % insert an entry into the super class table
+ % for each super class of this class
+:- pred update_superclass_table(class_id::in, list(tvar)::in, tvarset::in,
+ list(prog_constraint)::in, superclass_table::in, superclass_table::out)
+ is det.
+
+update_superclass_table(ClassId, Vars, VarSet, Constraints, !Supers) :-
+ list.foldl(update_superclass_table_2(ClassId, Vars, VarSet), Constraints,
+ !Supers).
+
+:- pred update_superclass_table_2(class_id::in, list(tvar)::in, tvarset::in,
+ prog_constraint::in, superclass_table::in, superclass_table::out) is det.
+
+update_superclass_table_2(ClassId, Vars, VarSet, Constraint, !Supers) :-
+ Constraint = constraint(SuperName, SuperTypes),
+ list__length(SuperTypes, SuperClassArity),
+ SuperClassId = class_id(SuperName, SuperClassArity),
+ SubClassDetails = subclass_details(SuperTypes, ClassId, Vars, VarSet),
+ multi_map__set(!.Supers, SuperClassId, SubClassDetails, !:Supers).
+
% Go through the list of class methods, looking for
% - functions without mode declarations: add a default mode
% - predicates without mode declarations: report an error
@@ -3584,7 +3597,7 @@
),
check_method_modes(Methods, !PredProcIds, !ModuleInfo, !IO).
-:- pred module_add_instance_defn(module_name::in, list(class_constraint)::in,
+:- pred module_add_instance_defn(module_name::in, list(prog_constraint)::in,
sym_name::in, list(type)::in, instance_body::in, tvarset::in,
import_status::in, prog_context::in,
module_info::in, module_info::out, io::di, io::uo) is det.
@@ -3651,7 +3664,7 @@
%-----------------------------------------------------------------------------%
:- pred add_new_pred(tvarset::in, existq_tvars::in, sym_name::in,
- list(type)::in, purity::in, class_constraints::in,
+ list(type)::in, purity::in, prog_constraints::in,
pred_markers::in, prog_context::in, import_status::in,
need_qualifier::in, pred_or_func::in,
module_info::in, module_info::out, io::di, io::uo) is det.
@@ -3661,7 +3674,8 @@
% to be reflected there too.
add_new_pred(TVarSet, ExistQVars, PredName, Types, Purity, ClassContext,
- Markers0, Context, ItemStatus, NeedQual, PredOrFunc, !ModuleInfo, !IO) :-
+ Markers0, Context, ItemStatus, NeedQual, PredOrFunc, !ModuleInfo,
+ !IO) :-
% Only preds with opt_imported clauses are tagged as opt_imported, so
% that the compiler doesn't look for clauses for other preds read in
% from optimization interfaces.
@@ -3685,13 +3699,15 @@
module_info_get_predicate_table(!.ModuleInfo, PredTable0),
clauses_info_init(Arity, ClausesInfo),
map__init(Proofs),
+ map__init(ConstraintMap),
purity_to_markers(Purity, PurityMarkers),
markers_to_marker_list(PurityMarkers, MarkersList),
list__foldl(add_marker, MarkersList, Markers0, Markers),
globals__io_lookup_string_option(aditi_user, Owner, !IO),
pred_info_init(ModuleName, PredName, Arity, PredOrFunc, Context,
user(PredName), Status, none, Markers, Types, TVarSet, ExistQVars,
- ClassContext, Proofs, Owner, ClausesInfo, PredInfo0),
+ ClassContext, Proofs, ConstraintMap, Owner, ClausesInfo,
+ PredInfo0),
(
predicate_table_search_pf_m_n_a(PredTable0,
is_fully_qualified, PredOrFunc, MNameOfPred,
@@ -3731,7 +3747,7 @@
% check for type variables which occur in the the class constraints,
% but which don't occur in the predicate argument types
%
-:- pred check_tvars_in_constraints(class_constraints::in, list(type)::in,
+:- pred check_tvars_in_constraints(prog_constraints::in, list(type)::in,
tvarset::in, pred_or_func::in, sym_name::in, prog_context::in,
module_info::in, module_info::out, io::di, io::uo) is det.
@@ -3748,8 +3764,8 @@
TVarSet, PredOrFunc, PredName, Context, !IO)
).
-:- pred constrained_tvar_not_in_arg_types(class_constraints::in,
- list(type)::in, tvar::out) is nondet.
+:- pred constrained_tvar_not_in_arg_types(prog_constraints::in, list(type)::in,
+ tvar::out) is nondet.
constrained_tvar_not_in_arg_types(ClassContext, ArgTypes, TVar) :-
ClassContext = constraints(UnivCs, ExistCs),
@@ -4219,6 +4235,7 @@
Origin = special_pred(SpecialPredId - TypeCtor),
adjust_special_pred_status(SpecialPredId, Status0, Status),
map__init(Proofs),
+ map__init(ConstraintMap),
init_markers(Markers),
% XXX If/when we have "comparable" or "unifiable" typeclasses,
% XXX this context might not be empty
@@ -4228,7 +4245,7 @@
globals__lookup_string_option(Globals, aditi_user, Owner),
pred_info_init(ModuleName, PredName, Arity, predicate, Context,
Origin, Status, none, Markers, ArgTypes, TVarSet, ExistQVars,
- ClassContext, Proofs, Owner, ClausesInfo0, PredInfo0),
+ ClassContext, Proofs, ConstraintMap, Owner, ClausesInfo0, PredInfo0),
ArgLives = no,
varset__init(InstVarSet),
% Should not be any inst vars here so it's ok to use a
@@ -4452,6 +4469,7 @@
make_n_fresh_vars("T", Arity, TypeVars, TVarSet0, TVarSet),
term__var_list_to_term_list(TypeVars, Types),
map__init(Proofs),
+ map__init(ConstraintMap),
% The class context is empty since this is an implicit
% definition. Inference will fill it in.
ClassContext = constraints([], []),
@@ -4463,7 +4481,7 @@
globals__lookup_string_option(Globals, aditi_user, Owner),
pred_info_init(ModuleName, PredName, Arity, PredOrFunc, Context,
Origin, Status, none, Markers0, Types, TVarSet, ExistQVars,
- ClassContext, Proofs, Owner, ClausesInfo, PredInfo0),
+ ClassContext, Proofs, ConstraintMap, Owner, ClausesInfo, PredInfo0),
add_marker(infer_type, Markers0, Markers),
pred_info_set_markers(Markers, PredInfo0, PredInfo),
(
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.252
diff -u -r1.252 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 22 Mar 2005 06:40:08 -0000 1.252
+++ compiler/mercury_to_mercury.m 22 Mar 2005 12:23:48 -0000
@@ -76,10 +76,10 @@
% is set to `yes'.
:- pred mercury_output_pred_type(tvarset::in, existq_tvars::in, sym_name::in,
list(type)::in, maybe(determinism)::in, purity::in,
- class_constraints::in, prog_context::in, bool::in, io::di, io::uo)
+ prog_constraints::in, prog_context::in, bool::in, io::di, io::uo)
is det.
:- func mercury_pred_type_to_string(tvarset, existq_tvars, sym_name,
- list(type), maybe(determinism), purity, class_constraints,
+ list(type), maybe(determinism), purity, prog_constraints,
prog_context, bool) = string.
% Output a `:- func' declaration, making sure that the variable
@@ -87,10 +87,10 @@
% is set to `yes'.
:- pred mercury_output_func_type(tvarset::in, existq_tvars::in, sym_name::in,
list(type)::in, (type)::in, maybe(determinism)::in, purity::in,
- class_constraints::in, prog_context::in, bool::in, io::di, io::uo)
+ prog_constraints::in, prog_context::in, bool::in, io::di, io::uo)
is det.
:- func mercury_func_type_to_string(tvarset, existq_tvars, sym_name,
- list(type), type, maybe(determinism), purity, class_constraints,
+ list(type), type, maybe(determinism), purity, prog_constraints,
prog_context, bool) = string.
:- pred mercury_output_pred_mode_decl(inst_varset::in, sym_name::in,
@@ -275,9 +275,9 @@
% Output a constraint, making sure that the variable number appears
% in variable names if the boolean argument is set to `yes'.
-:- pred mercury_output_constraint(tvarset::in, bool::in, class_constraint::in,
+:- pred mercury_output_constraint(tvarset::in, bool::in, prog_constraint::in,
io::di, io::uo) is det.
-:- func mercury_constraint_to_string(tvarset, class_constraint) = string.
+:- func mercury_constraint_to_string(tvarset, prog_constraint) = string.
% Output an existential quantifier, making sure that the variable
% number appears in variable names if the boolean argument
@@ -723,7 +723,7 @@
io__write_char(')'),
{ AppendVarnums = no },
- mercury_format_class_constraint_list(Constraints, VarSet, "<=",
+ mercury_format_prog_constraint_list(Constraints, VarSet, "<=",
AppendVarnums),
(
@@ -749,7 +749,7 @@
io__write_char(')'),
{ AppendVarnums = no },
- mercury_format_class_constraint_list(Constraints, VarSet, "<=",
+ mercury_format_prog_constraint_list(Constraints, VarSet, "<=",
AppendVarnums),
(
@@ -1837,7 +1837,7 @@
),
{ AppendVarnums = no },
- mercury_format_class_constraint_list(Constraints, VarSet, "=>",
+ mercury_format_prog_constraint_list(Constraints, VarSet, "=>",
AppendVarnums),
(
{ ExistQVars = [] }
@@ -1875,7 +1875,7 @@
:- pred mercury_format_pred_or_func_decl(pred_or_func::in, tvarset::in,
inst_varset::in, existq_tvars::in, sym_name::in,
list(type_and_mode)::in, maybe(type)::in, maybe(inst)::in,
- maybe(determinism)::in, purity::in, class_constraints::in,
+ maybe(determinism)::in, purity::in, prog_constraints::in,
prog_context::in, string::in, string::in,
string::in, U::di, U::uo) is det <= output(U).
@@ -1919,7 +1919,7 @@
:- pred mercury_format_pred_type(tvarset::in, existq_tvars::in, sym_name::in,
list(type)::in, maybe(type)::in, maybe(determinism)::in, purity::in,
- class_constraints::in, prog_context::in, bool::in, U::di, U::uo)
+ prog_constraints::in, prog_context::in, bool::in, U::di, U::uo)
is det <= output(U).
mercury_format_pred_type(VarSet, ExistQVars, PredName, Types, WithType,
@@ -1930,7 +1930,7 @@
:- pred mercury_format_pred_or_func_type_2(pred_or_func::in, tvarset::in,
existq_tvars::in, sym_name::in, list(type)::in, maybe(type)::in,
- maybe(determinism)::in, purity::in, class_constraints::in,
+ maybe(determinism)::in, purity::in, prog_constraints::in,
prog_context::in, bool::in, string::in, string::in,
U::di, U::uo) is det <= output(U).
@@ -2005,7 +2005,7 @@
:- pred mercury_format_func_decl(tvarset::in, inst_varset::in,
existq_tvars::in, sym_name::in, list(type_and_mode)::in,
type_and_mode::in, maybe(determinism)::in, purity::in,
- class_constraints::in, prog_context::in, string::in, string::in,
+ prog_constraints::in, prog_context::in, string::in, string::in,
string::in, U::di, U::uo) is det <= output(U).
mercury_format_func_decl(TypeVarSet, InstVarSet, ExistQVars, FuncName,
@@ -2047,7 +2047,7 @@
:- pred mercury_format_func_type(tvarset::in, existq_tvars::in, sym_name::in,
list(type)::in, (type)::in, maybe(determinism)::in, purity::in,
- class_constraints::in, prog_context::in, bool::in, U::di, U::uo)
+ prog_constraints::in, prog_context::in, bool::in, U::di, U::uo)
is det <= output(U).
mercury_format_func_type(VarSet, ExistQVars, FuncName, Types, RetType,
@@ -2058,7 +2058,7 @@
:- pred mercury_format_func_type_2(tvarset::in, existq_tvars::in, sym_name::in,
list(type)::in, (type)::in, maybe(determinism)::in,
- purity::in, class_constraints::in, prog_context::in, bool::in,
+ purity::in, prog_constraints::in, prog_context::in, bool::in,
string::in, string::in, U::di, U::uo) is det <= output(U).
mercury_format_func_type_2(VarSet, ExistQVars, FuncName, Types, RetType,
@@ -2115,7 +2115,7 @@
%-----------------------------------------------------------------------------%
-:- pred mercury_output_class_context(class_constraints, existq_tvars, tvarset,
+:- pred mercury_output_class_context(prog_constraints, existq_tvars, tvarset,
bool, io__state, io__state).
:- mode mercury_output_class_context(in, in, in, in, di, uo) is det.
@@ -2124,26 +2124,26 @@
mercury_format_class_context(ClassContext, ExistQVars, VarSet,
AppendVarnums).
-:- pred mercury_format_class_context(class_constraints::in, existq_tvars::in,
+:- pred mercury_format_class_context(prog_constraints::in, existq_tvars::in,
tvarset::in, bool::in, U::di, U::uo) is det <= output(U).
mercury_format_class_context(ClassContext, ExistQVars, VarSet,
AppendVarnums) -->
{ ClassContext = constraints(UnivCs, ExistCs) },
- mercury_format_class_constraint_list(ExistCs, VarSet, "=>",
+ mercury_format_prog_constraint_list(ExistCs, VarSet, "=>",
AppendVarnums),
( { ExistQVars = [], ExistCs = [] } ->
[]
;
add_string(")")
),
- mercury_format_class_constraint_list(UnivCs, VarSet, "<=",
+ mercury_format_prog_constraint_list(UnivCs, VarSet, "<=",
AppendVarnums).
-:- pred mercury_format_class_constraint_list(list(class_constraint)::in,
+:- pred mercury_format_prog_constraint_list(list(prog_constraint)::in,
tvarset::in, string::in, bool::in, U::di, U::uo) is det <= output(U).
-mercury_format_class_constraint_list(Constraints, VarSet, Operator,
+mercury_format_prog_constraint_list(Constraints, VarSet, Operator,
AppendVarnums) -->
(
{ Constraints = [] }
@@ -2163,7 +2163,7 @@
mercury_format_constraint(VarSet, no, constraint(Name, Types),
"", String).
-:- pred mercury_format_constraint(tvarset::in, bool::in, class_constraint::in,
+:- pred mercury_format_constraint(tvarset::in, bool::in, prog_constraint::in,
U::di, U::uo) is det <= output(U).
mercury_format_constraint(VarSet, AppendVarnums, constraint(Name, Types)) -->
Index: compiler/ml_type_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_type_gen.m,v
retrieving revision 1.41
diff -u -r1.41 ml_type_gen.m
--- compiler/ml_type_gen.m 22 Mar 2005 06:40:10 -0000 1.41
+++ compiler/ml_type_gen.m 22 Mar 2005 12:23:48 -0000
@@ -897,7 +897,7 @@
Statement = mlds__statement(atomic(assign(Field, Val)), Context).
:- pred ml_gen_typeclass_info_member(module_info::in, prog_context::in,
- class_constraint::in, mlds__defn::out, int::in, int::out) is det.
+ prog_constraint::in, mlds__defn::out, int::in, int::out) is det.
ml_gen_typeclass_info_member(ModuleInfo, Context, Constraint, MLDS_Defn,
ArgNum0, ArgNum) :-
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.98
diff -u -r1.98 module_qual.m
--- compiler/module_qual.m 20 Mar 2005 02:24:35 -0000 1.98
+++ compiler/module_qual.m 22 Mar 2005 12:23:48 -0000
@@ -621,7 +621,7 @@
mq_info_set_error_context(
pred_or_func(PredOrFunc, SymName - Arity) - Context, !Info),
qualify_types_and_modes(TypesAndModes0, TypesAndModes, !Info, !IO),
- qualify_class_constraints(Constraints0, Constraints, !Info, !IO),
+ qualify_prog_constraints(Constraints0, Constraints, !Info, !IO),
map_fold2_maybe(qualify_type, WithType0, WithType, !Info, !IO),
map_fold2_maybe(qualify_inst, WithInst0, WithInst, !Info, !IO).
@@ -653,7 +653,7 @@
!Info, yes, !IO) :-
list.length(Vars, Arity),
mq_info_set_error_context(class(Name - Arity) - Context, !Info),
- qualify_class_constraint_list(Constraints0, Constraints, !Info, !IO),
+ qualify_prog_constraint_list(Constraints0, Constraints, !Info, !IO),
(
Interface0 = abstract,
Interface = abstract
@@ -674,7 +674,7 @@
mq_info_set_error_context(instance(Id) - Context, !Info),
% We don't qualify the implementation yet, since that requires
% us to resolve overloading.
- qualify_class_constraint_list(Constraints0, Constraints, !Info, !IO),
+ qualify_prog_constraint_list(Constraints0, Constraints, !Info, !IO),
qualify_class_name(Id, Name - _, !Info, !IO),
qualify_type_list(Types0, Types, !Info, !IO),
qualify_instance_body(Name, Body0, Body).
@@ -745,7 +745,7 @@
Ctor0 = ctor(ExistQVars, Constraints0, SymName, Args0),
qualify_constructor_arg_list(Args0, Args, !Info, !IO),
qualify_constructors(Ctors0, Ctors, !Info, !IO),
- qualify_class_constraint_list(Constraints0, Constraints, !Info, !IO),
+ qualify_prog_constraint_list(Constraints0, Constraints, !Info, !IO),
Ctor = ctor(ExistQVars, Constraints, SymName, Args).
% Qualify the inst parameters of an inst definition.
@@ -1048,28 +1048,28 @@
qualify_type(Type0, Type, !Info, !IO),
qualify_type_spec_subst(Subst0, Subst, !Info, !IO).
-:- pred qualify_class_constraints(class_constraints::in,
- class_constraints::out, mq_info::in, mq_info::out,
+:- pred qualify_prog_constraints(prog_constraints::in,
+ prog_constraints::out, mq_info::in, mq_info::out,
io::di, io::uo) is det.
-qualify_class_constraints(constraints(UnivCs0, ExistCs0),
+qualify_prog_constraints(constraints(UnivCs0, ExistCs0),
constraints(UnivCs, ExistCs), !Info, !IO) :-
- qualify_class_constraint_list(UnivCs0, UnivCs, !Info, !IO),
- qualify_class_constraint_list(ExistCs0, ExistCs, !Info, !IO).
+ qualify_prog_constraint_list(UnivCs0, UnivCs, !Info, !IO),
+ qualify_prog_constraint_list(ExistCs0, ExistCs, !Info, !IO).
-:- pred qualify_class_constraint_list(list(class_constraint)::in,
- list(class_constraint)::out, mq_info::in, mq_info::out,
+:- pred qualify_prog_constraint_list(list(prog_constraint)::in,
+ list(prog_constraint)::out, mq_info::in, mq_info::out,
io::di, io::uo) is det.
-qualify_class_constraint_list([], [], !Info, !IO).
-qualify_class_constraint_list([C0|C0s], [C|Cs], !Info, !IO) :-
- qualify_class_constraint(C0, C, !Info, !IO),
- qualify_class_constraint_list(C0s, Cs, !Info, !IO).
+qualify_prog_constraint_list([], [], !Info, !IO).
+qualify_prog_constraint_list([C0|C0s], [C|Cs], !Info, !IO) :-
+ qualify_prog_constraint(C0, C, !Info, !IO),
+ qualify_prog_constraint_list(C0s, Cs, !Info, !IO).
-:- pred qualify_class_constraint(class_constraint::in, class_constraint::out,
+:- pred qualify_prog_constraint(prog_constraint::in, prog_constraint::out,
mq_info::in, mq_info::out, io::di, io::uo) is det.
-qualify_class_constraint(constraint(ClassName0, Types0),
+qualify_prog_constraint(constraint(ClassName0, Types0),
constraint(ClassName, Types), !Info, !IO) :-
list.length(Types0, Arity),
qualify_class_name(ClassName0 - Arity, ClassName - _, !Info, !IO),
@@ -1106,7 +1106,7 @@
Cond, Purity, ClassContext, Context),
!Info, !IO) :-
qualify_types_and_modes(TypesAndModes0, TypesAndModes, !Info, !IO),
- qualify_class_constraints(ClassContext0, ClassContext, !Info, !IO),
+ qualify_prog_constraints(ClassContext0, ClassContext, !Info, !IO),
map_fold2_maybe(qualify_type, WithType0, WithType, !Info, !IO),
map_fold2_maybe(qualify_inst, WithInst0, WithInst, !Info, !IO).
qualify_class_method(
--------------------------------------------------------------------------
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