[m-rev.] diff: hlds_constraints
Zoltan Somogyi
zs at unimelb.edu.au
Wed Apr 18 12:24:26 AEST 2012
compiler/hlds_data.m:
Give the functors of the types hlds_constraint and hlds_constraints
a prefix that identifies them as HLDS level constructs. We have similar
constructs at the parse tree level, and their function symbols used
to be identical.
Give their field names a similarly distinguishing prefix.
compiler/check_typeclass.m:
compiler/type_util.m:
compiler/typecheck.m:
compiler/typecheck_errors.m:
compiler/typecheck_info.m:
compiler/typeclasses.m:
Conform to the change above.
Zoltan.
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.139
diff -u -b -r1.139 check_typeclass.m
--- compiler/check_typeclass.m 13 Feb 2012 00:11:34 -0000 1.139
+++ compiler/check_typeclass.m 17 Apr 2012 13:43:49 -0000
@@ -823,7 +823,7 @@
typeclasses.reduce_context_by_rule_application(ClassTable, InstanceTable,
ClassVars, TypeSubst, _, InstanceVarSet1, InstanceVarSet2,
Proofs0, Proofs1, ConstraintMap0, _, Constraints0, Constraints),
- UnprovenConstraints = Constraints ^ unproven,
+ UnprovenConstraints = Constraints ^ hcs_unproven,
(
UnprovenConstraints = [],
Index: compiler/hlds_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.142
diff -u -b -r1.142 hlds_data.m
--- compiler/hlds_data.m 5 Apr 2012 05:57:42 -0000 1.142
+++ compiler/hlds_data.m 17 Apr 2012 13:45:01 -0000
@@ -1402,23 +1402,23 @@
% together in order to not have to prove the same constraint twice.
%
:- type hlds_constraint
- ---> constraint(
+ ---> hlds_constraint(
list(constraint_id),
class_name,
list(mer_type)
).
:- type hlds_constraints
- ---> constraints(
+ ---> hlds_constraints(
% Unproven constraints. These are the constraints that we must
% prove (that is, universal constraints from the goal being
% checked, or existential constraints on the head).
- unproven :: list(hlds_constraint),
+ hcs_unproven :: list(hlds_constraint),
% Assumed constraints. These are constraints we can use in
% proofs (that is, existential constraints from the goal being
% checked, or universal constraints on the head).
- assumed :: list(hlds_constraint),
+ hcs_assumed :: list(hlds_constraint),
% Constraints that are known to be redundant. This includes
% constraints that have already been proved as well as
@@ -1426,10 +1426,10 @@
% or redundant constraints. Not all such constraints are
% included, only those which may be used for the purposes
% of improvement.
- redundant :: redundant_constraints,
+ hcs_redundant :: redundant_constraints,
% Ancestors of assumed constraints.
- ancestors :: ancestor_constraints
+ hcs_ancestors :: ancestor_constraints
).
% Redundant constraints are partitioned by class, which helps us
@@ -1544,14 +1544,15 @@
:- implementation.
empty_hlds_constraints(Constraints) :-
- Constraints = constraints([], [], map.init, map.init).
+ Constraints = hlds_constraints([], [], map.init, map.init).
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)).
+init_hlds_constraint(constraint(Name, Types),
+ hlds_constraint([], Name, Types)).
make_head_hlds_constraints(ClassTable, TVarSet, ProgConstraints,
Constraints) :-
@@ -1581,7 +1582,7 @@
Assumed, Redundant0, Redundant),
list.foldl(update_ancestor_constraints(ClassTable, TVarSet),
Assumed, map.init, Ancestors),
- Constraints = constraints(Unproven, Assumed, Redundant, Ancestors).
+ Constraints = hlds_constraints(Unproven, Assumed, Redundant, Ancestors).
make_hlds_constraint_list(ProgConstraints, ConstraintType, GoalId,
Constraints) :-
@@ -1597,18 +1598,20 @@
GoalId, N, [HLDSConstraint | HLDSConstraints]) :-
ProgConstraint = constraint(Name, Types),
Id = constraint_id(ConstraintType, GoalId, N),
- HLDSConstraint = constraint([Id], Name, Types),
+ HLDSConstraint = hlds_constraint([Id], Name, Types),
make_hlds_constraint_list_2(ProgConstraints, ConstraintType, GoalId,
N + 1, HLDSConstraints).
merge_hlds_constraints(ConstraintsA, ConstraintsB, Constraints) :-
- ConstraintsA = constraints(UnprovenA, AssumedA, RedundantA, AncestorsA),
- ConstraintsB = constraints(UnprovenB, AssumedB, RedundantB, AncestorsB),
+ ConstraintsA = hlds_constraints(UnprovenA, AssumedA,
+ RedundantA, AncestorsA),
+ ConstraintsB = hlds_constraints(UnprovenB, AssumedB,
+ RedundantB, AncestorsB),
list.append(UnprovenA, UnprovenB, Unproven),
list.append(AssumedA, AssumedB, Assumed),
map.union(set.union, RedundantA, RedundantB, Redundant),
map.union(shortest_list, AncestorsA, AncestorsB, Ancestors),
- Constraints = constraints(Unproven, Assumed, Redundant, Ancestors).
+ Constraints = hlds_constraints(Unproven, Assumed, Redundant, Ancestors).
:- pred shortest_list(list(T)::in, list(T)::in, list(T)::out) is det.
@@ -1626,7 +1629,7 @@
is_shorter(As, Bs).
retrieve_prog_constraints(Constraints, ProgConstraints) :-
- Constraints = constraints(Unproven, Assumed, _, _),
+ Constraints = hlds_constraints(Unproven, Assumed, _, _),
retrieve_prog_constraint_list(Unproven, UnivProgConstraints),
retrieve_prog_constraint_list(Assumed, ExistProgConstraints),
ProgConstraints = constraints(UnivProgConstraints, ExistProgConstraints).
@@ -1635,12 +1638,16 @@
list.map(retrieve_prog_constraint, Constraints, ProgConstraints).
retrieve_prog_constraint(Constraint, ProgConstraint) :-
- Constraint = constraint(_, Name, Types),
+ Constraint = hlds_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) :-
+matching_constraints(ConstraintA, ConstraintB) :-
+ ConstraintA = hlds_constraint(_, Name, Types),
+ ConstraintB = hlds_constraint(_, Name, Types).
+
+compare_hlds_constraints(ConstraintA, ConstraintB, R) :-
+ ConstraintA = hlds_constraint(_, NA, TA),
+ ConstraintB = hlds_constraint(_, NB, TB),
compare(R0, NA, NB),
(
R0 = (=),
@@ -1653,7 +1660,7 @@
).
update_constraint_map(Constraint, !ConstraintMap) :-
- Constraint = constraint(Ids, Name, Types),
+ Constraint = hlds_constraint(Ids, Name, Types),
ProgConstraint = constraint(Name, Types),
list.foldl(update_constraint_map_2(ProgConstraint), Ids, !ConstraintMap).
@@ -1672,7 +1679,7 @@
redundant_constraints::out) is det.
update_redundant_constraints_2(ClassTable, TVarSet, Constraint, !Redundant) :-
- Constraint = constraint(_, Name, Args),
+ Constraint = hlds_constraint(_, Name, Args),
list.length(Args, Arity),
ClassId = class_id(Name, Arity),
map.lookup(ClassTable, ClassId, ClassDefn),
@@ -1705,7 +1712,7 @@
redundant_constraints::in, redundant_constraints::out) is det.
add_redundant_constraint(Constraint, !Redundant) :-
- Constraint = constraint(_, Name, Args),
+ Constraint = hlds_constraint(_, Name, Args),
list.length(Args, Arity),
ClassId = class_id(Name, Arity),
( map.search(!.Redundant, ClassId, Constraints0) ->
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.214
diff -u -b -r1.214 type_util.m
--- compiler/type_util.m 11 Apr 2012 04:52:35 -0000 1.214
+++ compiler/type_util.m 17 Apr 2012 13:35:14 -0000
@@ -1196,20 +1196,20 @@
%-----------------------------------------------------------------------------%
apply_variable_renaming_to_constraint(Renaming, !Constraint) :-
- !.Constraint = constraint(Ids, ClassName, ClassArgTypes0),
+ !.Constraint = hlds_constraint(Ids, ClassName, ClassArgTypes0),
apply_variable_renaming_to_type_list(Renaming, ClassArgTypes0,
ClassArgTypes),
- !:Constraint = constraint(Ids, ClassName, ClassArgTypes).
+ !:Constraint = hlds_constraint(Ids, ClassName, ClassArgTypes).
apply_subst_to_constraint(Subst, !Constraint) :-
- !.Constraint = constraint(Ids, ClassName, Types0),
+ !.Constraint = hlds_constraint(Ids, ClassName, Types0),
apply_subst_to_type_list(Subst, Types0, Types),
- !:Constraint = constraint(Ids, ClassName, Types).
+ !:Constraint = hlds_constraint(Ids, ClassName, Types).
apply_rec_subst_to_constraint(Subst, !Constraint) :-
- !.Constraint = constraint(Ids, Name, Types0),
+ !.Constraint = hlds_constraint(Ids, Name, Types0),
apply_rec_subst_to_type_list(Subst, Types0, Types),
- !:Constraint = constraint(Ids, Name, Types).
+ !:Constraint = hlds_constraint(Ids, Name, Types).
%-----------------------------------------------------------------------------%
@@ -1225,7 +1225,8 @@
%-----------------------------------------------------------------------------%
apply_variable_renaming_to_constraints(Renaming, !Constraints) :-
- !.Constraints = constraints(Unproven0, Assumed0, Redundant0, Ancestors0),
+ !.Constraints = hlds_constraints(Unproven0, Assumed0,
+ Redundant0, Ancestors0),
apply_variable_renaming_to_constraint_list(Renaming, Unproven0, Unproven),
apply_variable_renaming_to_constraint_list(Renaming, Assumed0, Assumed),
Pred = (pred(C0::in, C::out) is det :-
@@ -1241,10 +1242,11 @@
list.map(apply_variable_renaming_to_prog_constraint_list(Renaming),
AncestorsValues0, AncestorsValues),
map.from_corresponding_lists(AncestorsKeys, AncestorsValues, Ancestors),
- !:Constraints = constraints(Unproven, Assumed, Redundant, Ancestors).
+ !:Constraints = hlds_constraints(Unproven, Assumed, Redundant, Ancestors).
apply_subst_to_constraints(Subst, !Constraints) :-
- !.Constraints = constraints(Unproven0, Assumed0, Redundant0, Ancestors0),
+ !.Constraints = hlds_constraints(Unproven0, Assumed0,
+ Redundant0, Ancestors0),
apply_subst_to_constraint_list(Subst, Unproven0, Unproven),
apply_subst_to_constraint_list(Subst, Assumed0, Assumed),
Pred = (pred(C0::in, C::out) is det :-
@@ -1259,10 +1261,11 @@
list.map(apply_subst_to_prog_constraint_list(Subst),
AncestorsValues0, AncestorsValues),
map.from_corresponding_lists(AncestorsKeys, AncestorsValues, Ancestors),
- !:Constraints = constraints(Unproven, Assumed, Redundant, Ancestors).
+ !:Constraints = hlds_constraints(Unproven, Assumed, Redundant, Ancestors).
apply_rec_subst_to_constraints(Subst, !Constraints) :-
- !.Constraints = constraints(Unproven0, Assumed0, Redundant0, Ancestors0),
+ !.Constraints = hlds_constraints(Unproven0, Assumed0,
+ Redundant0, Ancestors0),
apply_rec_subst_to_constraint_list(Subst, Unproven0, Unproven),
apply_rec_subst_to_constraint_list(Subst, Assumed0, Assumed),
Pred = (pred(C0::in, C::out) is det :-
@@ -1278,7 +1281,7 @@
list.map(apply_rec_subst_to_prog_constraint_list(Subst),
AncestorsValues0, AncestorsValues),
map.from_corresponding_lists(AncestorsKeys, AncestorsValues, Ancestors),
- !:Constraints = constraints(Unproven, Assumed, Redundant, Ancestors).
+ !:Constraints = hlds_constraints(Unproven, Assumed, Redundant, Ancestors).
%-----------------------------------------------------------------------------%
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.466
diff -u -b -r1.466 typecheck.m
--- compiler/typecheck.m 13 Feb 2012 00:11:50 -0000 1.466
+++ compiler/typecheck.m 17 Apr 2012 13:39:02 -0000
@@ -2948,7 +2948,8 @@
project_and_rename_constraints(ClassTable, TVarSet, CallTVars, TVarRenaming,
!Constraints) :-
- !.Constraints = constraints(Unproven0, Assumed, Redundant0, Ancestors),
+ !.Constraints = hlds_constraints(Unproven0, Assumed,
+ Redundant0, Ancestors),
% Project the constraints down onto the list of tvars in the call.
list.filter(project_constraint(CallTVars), Unproven0, NewUnproven0),
@@ -2957,12 +2958,12 @@
update_redundant_constraints(ClassTable, TVarSet, NewUnproven,
Redundant0, Redundant),
list.append(NewUnproven, Unproven0, Unproven),
- !:Constraints = constraints(Unproven, Assumed, Redundant, Ancestors).
+ !:Constraints = hlds_constraints(Unproven, Assumed, Redundant, Ancestors).
:- pred project_constraint(set(tvar)::in, hlds_constraint::in) is semidet.
project_constraint(CallTVars, Constraint) :-
- Constraint = constraint(_, _, TypesToCheck),
+ Constraint = hlds_constraint(_, _, TypesToCheck),
type_vars_list(TypesToCheck, TVarsToCheck0),
set.list_to_set(TVarsToCheck0, TVarsToCheck),
set.intersect(TVarsToCheck, CallTVars, RelevantTVars),
@@ -2972,13 +2973,13 @@
hlds_constraint::out) is semidet.
rename_constraint(TVarRenaming, Constraint0, Constraint) :-
- Constraint0 = constraint(Ids, Name, Types0),
+ Constraint0 = hlds_constraint(Ids, Name, Types0),
some [Var] (
type_list_contains_var(Types0, Var),
map.contains(TVarRenaming, Var)
),
apply_variable_renaming_to_type_list(TVarRenaming, Types0, Types),
- Constraint = constraint(Ids, Name, Types).
+ Constraint = hlds_constraint(Ids, Name, Types).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/typecheck_errors.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck_errors.m,v
retrieving revision 1.54
diff -u -b -r1.54 typecheck_errors.m
--- compiler/typecheck_errors.m 6 Jan 2012 06:23:47 -0000 1.54
+++ compiler/typecheck_errors.m 17 Apr 2012 13:44:07 -0000
@@ -1394,7 +1394,7 @@
constraints_to_pieces(TypeAssign, Pieces, !NumUnsatisfied) :-
type_assign_get_typeclass_constraints(TypeAssign, Constraints),
- UnprovenConstraints = Constraints ^ unproven,
+ UnprovenConstraints = Constraints ^ hcs_unproven,
retrieve_prog_constraint_list(UnprovenConstraints,
UnprovenProgConstraints0),
Index: compiler/typecheck_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck_info.m,v
retrieving revision 1.36
diff -u -b -r1.36 typecheck_info.m
--- compiler/typecheck_info.m 23 May 2011 05:08:14 -0000 1.36
+++ compiler/typecheck_info.m 17 Apr 2012 13:39:51 -0000
@@ -454,7 +454,7 @@
% eliminated during context reduction, so they need to be put in the
% constraint map now.
- HLDSTypeConstraints = constraints(HLDSUnivConstraints,
+ HLDSTypeConstraints = hlds_constraints(HLDSUnivConstraints,
HLDSExistConstraints, _, _),
list.foldl(update_constraint_map, HLDSUnivConstraints,
ConstraintMap1, ConstraintMap2),
@@ -894,7 +894,8 @@
write_type_assign_hlds_constraints(Constraints, TypeBindings, TypeVarSet,
!IO) :-
- Constraints = constraints(ConstraintsToProve, AssumedConstraints, _, _),
+ Constraints =
+ hlds_constraints(ConstraintsToProve, AssumedConstraints, _, _),
write_type_assign_constraints("&", AssumedConstraints,
TypeBindings, TypeVarSet, no, !IO),
write_type_assign_constraints("<=", ConstraintsToProve,
@@ -905,7 +906,8 @@
type_assign_hlds_constraints_to_pieces(Constraints, TypeBindings, TypeVarSet)
= Pieces1 ++ Pieces2 :-
- Constraints = constraints(ConstraintsToProve, AssumedConstraints, _, _),
+ Constraints =
+ hlds_constraints(ConstraintsToProve, AssumedConstraints, _, _),
PiecesList1 = type_assign_constraints_to_pieces_list("&",
AssumedConstraints, TypeBindings, TypeVarSet, no),
PiecesList2 = type_assign_constraints_to_pieces_list("<=",
Index: compiler/typeclasses.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typeclasses.m,v
retrieving revision 1.29
diff -u -b -r1.29 typeclasses.m
--- compiler/typeclasses.m 5 May 2011 07:11:51 -0000 1.29
+++ compiler/typeclasses.m 17 Apr 2012 14:42:23 -0000
@@ -125,7 +125,7 @@
type_assign_get_typeclass_constraints(TA0, Constraints0),
type_assign_get_typevarset(TA0, TVarSet),
make_hlds_constraints(ClassTable, TVarSet, [],
- Constraints0 ^ assumed, Constraints),
+ Constraints0 ^ hcs_assumed, Constraints),
type_assign_set_typeclass_constraints(Constraints, TA0, TA)
),
list.map(DeleteConstraints, TypeAssignSet0, TypeAssignSet)
@@ -158,7 +158,7 @@
type_assign_set_constraint_proofs(Proofs, !TypeAssign),
type_assign_set_constraint_map(ConstraintMap, !TypeAssign),
- ( check_satisfiability(Constraints ^ unproven, HeadTypeParams) ->
+ ( check_satisfiability(Constraints ^ hcs_unproven, HeadTypeParams) ->
!:TypeAssignSet = !.TypeAssignSet ++ [!.TypeAssign]
;
% Remember the unsatisfiable type_assign_set so we can produce more
@@ -170,7 +170,7 @@
!Bindings, !TVarSet, !Proofs, !ConstraintMap, !Constraints) :-
reduce_context_by_rule_application_2(ClassTable, InstanceTable,
HeadTypeParams, !Bindings, !TVarSet, !Proofs, !ConstraintMap,
- !Constraints, !.Constraints ^ unproven, _).
+ !Constraints, !.Constraints ^ hcs_unproven, _).
:- pred reduce_context_by_rule_application_2(class_table::in,
instance_table::in, head_type_params::in,
@@ -222,10 +222,10 @@
sort_and_merge_dups(!Constraints) :-
% Should we also sort and merge the other fields?
- Unproven0 = !.Constraints ^ unproven,
+ Unproven0 = !.Constraints ^ hcs_unproven,
list.sort(compare_hlds_constraints, Unproven0, Unproven1),
merge_adjacent_constraints(Unproven1, Unproven),
- !Constraints ^ unproven := Unproven.
+ !Constraints ^ hcs_unproven := Unproven.
:- pred merge_adjacent_constraints(list(hlds_constraint)::in,
list(hlds_constraint)::out) is det.
@@ -253,10 +253,12 @@
:- pred merge_constraints(hlds_constraint::in, hlds_constraint::in,
hlds_constraint::out) is semidet.
-merge_constraints(constraint(IdsA, Name, Types), constraint(IdsB, Name, Types),
- constraint(Ids, Name, Types)) :-
+merge_constraints(ConstraintA, ConstraintB, Constraint) :-
+ ConstraintA = hlds_constraint(IdsA, Name, Types),
+ ConstraintB = hlds_constraint(IdsB, Name, Types),
list.append(IdsA, IdsB, Ids0),
- list.sort_and_remove_dups(Ids0, Ids).
+ list.sort_and_remove_dups(Ids0, Ids),
+ Constraint = hlds_constraint(Ids, Name, Types).
:- pred apply_improvement_rules(class_table::in, instance_table::in,
head_type_params::in, hlds_constraints::in, tvarset::in, tvarset::out,
@@ -278,7 +280,7 @@
do_class_improvement(ClassTable, HeadTypeParams, Constraints, !Bindings,
Changed) :-
- Redundant = Constraints ^ redundant,
+ Redundant = Constraints ^ hcs_redundant,
map.keys(Redundant, ClassIds),
list.foldl2(
do_class_improvement_2(ClassTable, HeadTypeParams, Redundant),
@@ -299,7 +301,7 @@
:- pred has_class_id(class_id::in, hlds_constraint::in) is semidet.
-has_class_id(class_id(Name, Arity), constraint(_, Name, Args)) :-
+has_class_id(class_id(Name, Arity), hlds_constraint(_, Name, Args)) :-
list.length(Args, Arity).
% Try to find an opportunity for improvement for each (unordered)
@@ -350,8 +352,8 @@
do_class_improvement_fundep(ConstraintA, ConstraintB, FunDep, HeadTypeParams,
!Bindings, !Changed) :-
- ConstraintA = constraint(_, _, TypesA),
- ConstraintB = constraint(_, _, TypesB),
+ ConstraintA = hlds_constraint(_, _, TypesA),
+ ConstraintB = hlds_constraint(_, _, TypesB),
FunDep = fundep(Domain, Range),
(
% We already know that the name/arity of the constraints match,
@@ -376,7 +378,7 @@
do_instance_improvement(ClassTable, InstanceTable, HeadTypeParams, Constraints,
!TVarSet, !Bindings, Changed) :-
- RedundantConstraints = Constraints ^ redundant,
+ RedundantConstraints = Constraints ^ hcs_redundant,
map.keys(RedundantConstraints, ClassIds),
list.foldl3(
do_instance_improvement_2(ClassTable, InstanceTable,
@@ -439,7 +441,7 @@
do_instance_improvement_fundep(Constraint, InstanceTypes0, HeadTypeParams,
FunDep, !Bindings, !Changed) :-
- Constraint = constraint(_, _, ConstraintTypes),
+ Constraint = hlds_constraint(_, _, ConstraintTypes),
FunDep = fundep(Domain, Range),
(
% We already know that the name/arity of the constraints match,
@@ -504,10 +506,10 @@
hlds_constraints::in, hlds_constraints::out, bool::out) is det.
eliminate_assumed_constraints(!ConstraintMap, !Constraints, Changed) :-
- !.Constraints = constraints(Unproven0, Assumed, Redundant, Ancestors),
+ !.Constraints = hlds_constraints(Unproven0, Assumed, Redundant, Ancestors),
eliminate_assumed_constraints_2(Assumed, !ConstraintMap,
Unproven0, Unproven, Changed),
- !:Constraints = constraints(Unproven, Assumed, Redundant, Ancestors).
+ !:Constraints = hlds_constraints(Unproven, Assumed, Redundant, Ancestors).
:- pred eliminate_assumed_constraints_2(list(hlds_constraint)::in,
constraint_map::in, constraint_map::out,
@@ -542,11 +544,12 @@
apply_instance_rules(ClassTable, InstanceTable, !TVarSet, !Proofs,
!ConstraintMap, !Seen, !Constraints, Changed) :-
- !.Constraints = constraints(Unproven0, Assumed, Redundant0, Ancestors),
+ !.Constraints = hlds_constraints(Unproven0, Assumed,
+ Redundant0, Ancestors),
apply_instance_rules_2(ClassTable, InstanceTable, !TVarSet, !Proofs,
!ConstraintMap, Redundant0, Redundant, !Seen,
Unproven0, Unproven, Changed),
- !:Constraints = constraints(Unproven, Assumed, Redundant, Ancestors).
+ !:Constraints = hlds_constraints(Unproven, Assumed, Redundant, Ancestors).
:- pred apply_instance_rules_2(class_table::in, instance_table::in,
tvarset::in, tvarset::out,
@@ -560,7 +563,7 @@
!Seen, [], [], no).
apply_instance_rules_2(ClassTable, InstanceTable, !TVarSet, !Proofs,
!ConstraintMap, !Redundant, !Seen, [C | Cs], Constraints, Changed) :-
- C = constraint(_, ClassName, Types),
+ C = hlds_constraint(_, ClassName, Types),
list.length(Types, Arity),
map.lookup(InstanceTable, class_id(ClassName, Arity), Instances),
InitialTVarSet = !.TVarSet,
@@ -626,7 +629,7 @@
find_matching_instance_rule_2([Instance | Instances], InstanceNum0, Constraint,
!TVarSet, !Proofs, NewConstraints) :-
- Constraint = constraint(_Ids, _Name, Types),
+ Constraint = hlds_constraint(_Ids, _Name, Types),
ProgConstraints0 = Instance ^ instance_constraints,
InstanceTypes0 = Instance ^ instance_types,
InstanceTVarSet = Instance ^ instance_tvarset,
@@ -661,10 +664,10 @@
hlds_constraints::in, hlds_constraints::out, bool::out) is det.
apply_class_rules(!Proofs, !ConstraintMap, !Constraints, Changed) :-
- !.Constraints = constraints(Unproven0, _, _, Ancestors),
+ !.Constraints = hlds_constraints(Unproven0, _, _, Ancestors),
apply_class_rules_2(Ancestors, !Proofs, !ConstraintMap,
Unproven0, Unproven, Changed),
- !Constraints ^ unproven := Unproven.
+ !Constraints ^ hcs_unproven := Unproven.
:- pred apply_class_rules_2(ancestor_constraints::in,
constraint_proof_map::in, constraint_proof_map::out,
@@ -733,7 +736,7 @@
list.member(Constraint, Constraints)
=>
(
- Constraint = constraint(_Ids, _ClassName, Types),
+ Constraint = hlds_constraint(_Ids, _ClassName, Types),
type_list_contains_var(Types, TVar),
not list.member(TVar, HeadTypeParams)
)
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list