[m-rev.] diff: bug fixes for fundeps and existential types
Mark Brown
mark at cs.mu.OZ.AU
Tue Nov 22 18:56:14 AEDT 2005
Hi,
I'm going to commit this as soon as the bootchecks finish, since I need these
fixes in order to continue working on the G12 solvers.
Cheers,
Mark.
Estimated hours taken: 20
Branches: main
Fix a couple of bugs relating to the use of functional dependencies and
existential types.
compiler/check_typeclass.m:
Include type variables occurring in instance constraints and method
constraints in the tvarset created for instance methods. Previously
only type variables occurring in the arguments were included, but
with functional dependencies it is possible that some type variables
appear in the constraints but not in the arguments.
Rename a variable to be more accurate.
compiler/polymorphism.m:
When producing typeclass_infos for existential constraints use the
constraints from the constraint map (if available), which may have
been improved during typechecking.
Use the constraints and known instance tvars to calculate the
unconstrained tvars, rather than trying to figure them out from the
contents of the rtti_varmaps.
compiler/clause_to_proc.m:
When introducing exists_cast goals, use the constraints from the
head instead of the constraints already in the rtti_varmaps. The
constraints in the head represent the external view, which is what
we want for the introduced variables.
Ensure that all type variables in the external view have locations
recorded in the rtti_varmaps.
Update a comment.
compiler/prog_type.m:
Export a predicate for getting all the type variables occurring in
prog_constraints.
tests/valid/Mmakefile:
tests/valid/exists_fundeps.m:
tests/valid/exists_fundeps_2.m:
tests/valid/exists_fundeps_3.m:
New test cases.
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.83
diff -u -r1.83 check_typeclass.m
--- compiler/check_typeclass.m 4 Nov 2005 03:40:42 -0000 1.83
+++ compiler/check_typeclass.m 22 Nov 2005 06:19:08 -0000
@@ -665,11 +665,10 @@
Info0 = instance_method_info(ModuleInfo0, QualInfo0, PredName,
Arity, ExistQVars0, ArgTypes0, ClassMethodClassContext0,
- ArgModes, Errors, ArgTypeVars0, Status0, PredOrFunc),
+ ArgModes, Errors, TVarSet0, Status0, PredOrFunc),
% Rename the instance variables apart from the class variables.
- tvarset_merge_renaming(ArgTypeVars0, InstanceVarSet, ArgTypeVars1,
- Renaming),
+ tvarset_merge_renaming(TVarSet0, InstanceVarSet, TVarSet1, Renaming),
apply_variable_renaming_to_type_list(Renaming, InstanceTypes0,
InstanceTypes1),
apply_variable_renaming_to_prog_constraint_list(Renaming,
@@ -682,10 +681,19 @@
apply_subst_to_prog_constraints(TypeSubst, ClassMethodClassContext0,
ClassMethodClassContext1),
- % Get rid of any unwanted type variables.
- prog_type__vars_list(ArgTypes1, VarsToKeep0),
+ % Calculate which type variables we need to keep. This includes all
+ % type variables appearing in the arguments, the class method context and
+ % the instance constraints. (Type variables in the existq_tvars must
+ % occur either in the argument types or in the class method context;
+ % type variables in the instance types must appear in the arguments.)
+ prog_type__vars_list(ArgTypes1, ArgTVars),
+ prog_constraints_get_tvars(ClassMethodClassContext1, MethodContextTVars),
+ constraint_list_get_tvars(InstanceConstraints1, InstanceTVars),
+ list__condense([ArgTVars, MethodContextTVars, InstanceTVars], VarsToKeep0),
list__sort_and_remove_dups(VarsToKeep0, VarsToKeep),
- varset__squash(ArgTypeVars1, VarsToKeep, ArgTypeVars, SquashSubst),
+
+ % Project away the unwanted type variables.
+ varset__squash(TVarSet1, VarsToKeep, TVarSet, SquashSubst),
apply_variable_renaming_to_type_list(SquashSubst, ArgTypes1, ArgTypes),
apply_variable_renaming_to_prog_constraints(SquashSubst,
ClassMethodClassContext1, ClassMethodClassContext),
@@ -737,7 +745,7 @@
InstanceTypes, InstanceConstraints, ClassMethodClassContext),
pred_info_init(InstanceModuleName, PredName, PredArity, PredOrFunc,
Context, instance_method(MethodConstraints), Status, none,
- Markers, ArgTypes, ArgTypeVars, ExistQVars, ClassContext,
+ Markers, ArgTypes, TVarSet, ExistQVars, ClassContext,
Proofs, ConstraintMap, User, ClausesInfo, PredInfo0),
pred_info_set_clauses_info(ClausesInfo, PredInfo0, PredInfo1),
@@ -761,7 +769,7 @@
Info = instance_method_info(ModuleInfo, QualInfo, PredName, Arity,
ExistQVars, ArgTypes, ClassContext, ArgModes, Errors,
- ArgTypeVars, Status, PredOrFunc).
+ TVarSet, Status, PredOrFunc).
%---------------------------------------------------------------------------%
Index: compiler/clause_to_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/clause_to_proc.m,v
retrieving revision 1.58
diff -u -r1.58 clause_to_proc.m
--- compiler/clause_to_proc.m 4 Nov 2005 03:40:42 -0000 1.58
+++ compiler/clause_to_proc.m 21 Nov 2005 11:11:44 -0000
@@ -345,6 +345,7 @@
introduce_exists_casts_proc(ModuleInfo, PredInfo, !ProcInfo) :-
pred_info_arg_types(PredInfo, ArgTypes),
pred_info_get_existq_tvar_binding(PredInfo, Subn),
+ pred_info_get_class_context(PredInfo, PredConstraints),
OrigArity = pred_info_orig_arity(PredInfo),
NumExtraHeadVars = list__length(ArgTypes) - OrigArity,
@@ -383,15 +384,19 @@
% Add exists_casts for any existential type_infos or typeclass_infos.
% We determine which of these are existential by looking at the mode.
%
- % Currently we pass in PredTypesMap so that the external type of type_infos
- % and typeclass_infos can be looked up. When the arguments of these two
- % types are removed, we will no longer need to do this.
+ % Currently we pass in ExternalTypes so that the external type of
+ % type_infos and typeclass_infos can be looked up. When the arguments
+ % of these two types are removed, we will no longer need to do this.
%
map__from_corresponding_lists(ExtraHeadVars1, ExtraArgTypes,
ExternalTypes),
+ ExistConstraints = PredConstraints ^ exist_constraints,
+ assoc_list__from_corresponding_lists(ExtraArgModes, ExtraHeadVars1,
+ ExtraModesAndVars),
introduce_exists_casts_extra(ModuleInfo, ExternalTypes, Subn,
- ExtraArgModes, ExtraHeadVars1, ExtraHeadVars, VarSet1, VarSet,
- VarTypes1, VarTypes, RttiVarMaps0, RttiVarMaps, ExistsCastExtraGoals),
+ ExistConstraints, ExtraModesAndVars, ExtraHeadVars, VarSet1, VarSet,
+ VarTypes1, VarTypes, RttiVarMaps0, RttiVarMaps,
+ [], ExistsCastExtraGoals),
Body0 = _ - GoalInfo0,
goal_to_conj_list(Body0, Goals0),
@@ -460,22 +465,24 @@
).
:- pred introduce_exists_casts_extra(module_info::in, vartypes::in, tsubst::in,
- list(mer_mode)::in, list(prog_var)::in, list(prog_var)::out,
- prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
- rtti_varmaps::in, rtti_varmaps::out, list(hlds_goal)::out) is det.
+ list(prog_constraint)::in, assoc_list(mer_mode, prog_var)::in,
+ list(prog_var)::out, prog_varset::in, prog_varset::out,
+ vartypes::in, vartypes::out, rtti_varmaps::in, rtti_varmaps::out,
+ list(hlds_goal)::in, list(hlds_goal)::out) is det.
-introduce_exists_casts_extra(_, _, _, [], [], [], !VarSet, !VarTypes,
- !RttiVarMaps, []).
-introduce_exists_casts_extra(_, _, _, [], [_ | _], _, _, _, _, _, _, _, _) :-
- unexpected(this_file, "introduce_exists_casts_extra: length mismatch").
-introduce_exists_casts_extra(_, _, _, [_ | _], [], _, _, _, _, _, _, _, _) :-
- unexpected(this_file, "introduce_exists_casts_extra: length mismatch").
-introduce_exists_casts_extra(ModuleInfo, ExternalTypes, Subn,
- [ArgMode | ArgModes], [Var0 | Vars0], [Var | Vars], !VarSet, !VarTypes,
- !RttiVarMaps, ExtraGoals) :-
- introduce_exists_casts_extra(ModuleInfo, ExternalTypes, Subn, ArgModes,
- Vars0, Vars, !VarSet, !VarTypes, !RttiVarMaps, ExtraGoals0),
+introduce_exists_casts_extra(_, _, _, ExistConstraints, [], [], !VarSet,
+ !VarTypes, !RttiVarMaps, !ExtraGoals) :-
+ (
+ ExistConstraints = []
+ ;
+ ExistConstraints = [_ | _],
+ unexpected(this_file, "introduce_exists_casts_extra: length mismatch")
+ ).
+introduce_exists_casts_extra(ModuleInfo, ExternalTypes, Subn,
+ ExistConstraints0, [ModeAndVar | ModesAndVars], [Var | Vars],
+ !VarSet, !VarTypes, !RttiVarMaps, !ExtraGoals) :-
+ ModeAndVar = ArgMode - Var0,
(
mode_is_output(ModuleInfo, ArgMode)
->
@@ -493,7 +500,7 @@
make_new_exist_cast_var(Var0, Var, !VarSet),
svmap__det_insert(Var, ExternalType, !VarTypes),
generate_cast(exists_cast, Var0, Var, Context, ExtraGoal),
- ExtraGoals = [ExtraGoal | ExtraGoals0],
+ !:ExtraGoals = [ExtraGoal | !.ExtraGoals],
% Update the rtti_varmaps. The old variable needs to have the
% substitution applied to its type/constraint. The new variable
@@ -502,14 +509,34 @@
rtti_varmaps_var_info(!.RttiVarMaps, Var0, VarInfo),
(
VarInfo = type_info_var(TypeInfoType0),
+ % For type_infos, the old variable needs to have the substitution
+ % applied to its type, and the new variable needs to be associated
+ % with the unsubstituted type.
apply_rec_subst_to_type(Subn, TypeInfoType0, TypeInfoType),
rtti_set_type_info_type(Var0, TypeInfoType, !RttiVarMaps),
- rtti_det_insert_type_info_type(Var, TypeInfoType0, !RttiVarMaps)
+ rtti_det_insert_type_info_type(Var, TypeInfoType0, !RttiVarMaps),
+ ExistConstraints = ExistConstraints0
;
- VarInfo = typeclass_info_var(Constraint0),
- apply_rec_subst_to_prog_constraint(Subn, Constraint0, Constraint),
- rtti_set_typeclass_info_var(Constraint, Var0, !RttiVarMaps),
- rtti_det_insert_typeclass_info_var(Constraint0, Var, !RttiVarMaps)
+ VarInfo = typeclass_info_var(_),
+ % For typeclass_infos, the constraint associated with the old
+ % variable was derived from the constraint map, so all binding
+ % and improvement has been applied. The new variable needs to
+ % be associated with the corresponding existential head constraint,
+ % so we pop one off the front of the list.
+ (
+ ExistConstraints0 = [ExistConstraint | ExistConstraints]
+ ;
+ ExistConstraints0 = [],
+ unexpected(this_file, "introduce_exists_casts_extra: " ++
+ "missing constraint")
+ ),
+ rtti_det_insert_typeclass_info_var(ExistConstraint, Var,
+ !RttiVarMaps),
+ % We also need to ensure that all type variables in the constraint
+ % have a location recorded, so we insert a location now if there
+ % is not already one.
+ ExistConstraint = constraint(_, ConstraintArgs),
+ maybe_add_type_info_locns(ConstraintArgs, Var, 1, !RttiVarMaps)
;
VarInfo = non_rtti_var,
unexpected(this_file, "introduce_exists_casts_extra: " ++
@@ -517,8 +544,27 @@
)
;
Var = Var0,
- ExtraGoals = ExtraGoals0
- ).
+ ExistConstraints = ExistConstraints0
+ ),
+ introduce_exists_casts_extra(ModuleInfo, ExternalTypes, Subn,
+ ExistConstraints, ModesAndVars, Vars, !VarSet, !VarTypes,
+ !RttiVarMaps, !ExtraGoals).
+
+:- pred maybe_add_type_info_locns(list(mer_type)::in, prog_var::in, int::in,
+ rtti_varmaps::in, rtti_varmaps::out) is det.
+
+maybe_add_type_info_locns([], _, _, !RttiVarMaps).
+maybe_add_type_info_locns([Arg | Args], Var, Num, !RttiVarMaps) :-
+ (
+ Arg = variable(TVar, _),
+ \+ rtti_search_type_info_locn(!.RttiVarMaps, TVar, _)
+ ->
+ Locn = typeclass_info(Var, Num),
+ rtti_det_insert_type_info_locn(TVar, Locn, !RttiVarMaps)
+ ;
+ true
+ ),
+ maybe_add_type_info_locns(Args, Var, Num + 1, !RttiVarMaps).
:- pred make_new_exist_cast_var(prog_var::in, prog_var::out,
prog_varset::in, prog_varset::out) is det.
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.285
diff -u -r1.285 polymorphism.m
--- compiler/polymorphism.m 17 Nov 2005 15:57:27 -0000 1.285
+++ compiler/polymorphism.m 21 Nov 2005 06:02:09 -0000
@@ -719,11 +719,12 @@
pred_info_get_class_context(PredInfo, ClassContext),
ExtraHeadVars0 = [],
ExtraArgModes0 = [],
+ InstanceTVars = [],
InstanceUnconstrainedTVars = [],
InstanceUnconstrainedTypeInfoVars = [],
setup_headvars_2(PredInfo, ClassContext,
ExtraHeadVars0, ExtraArgModes0,
- InstanceUnconstrainedTVars,
+ InstanceTVars, InstanceUnconstrainedTVars,
InstanceUnconstrainedTypeInfoVars, HeadVars0, HeadVars,
ExtraArgModes, HeadTypeVars, UnconstrainedTVars,
ExtraHeadTypeInfoVars, ExistHeadTypeClassInfoVars, !Info)
@@ -764,21 +765,21 @@
in_mode(InMode),
list__duplicate(list__length(ExtraHeadVars0), InMode, ExtraArgModes0),
setup_headvars_2(PredInfo, ClassContext,
- ExtraHeadVars0, ExtraArgModes0, UnconstrainedInstanceTVars,
- UnconstrainedInstanceTypeInfoVars, HeadVars0, HeadVars,
- ExtraArgModes, HeadTypeVars,
+ ExtraHeadVars0, ExtraArgModes0, InstanceTVars,
+ UnconstrainedInstanceTVars, UnconstrainedInstanceTypeInfoVars,
+ HeadVars0, HeadVars, ExtraArgModes, HeadTypeVars,
UnconstrainedTVars, ExtraHeadTypeInfoVars,
ExistHeadTypeClassInfoVars, !Info).
:- pred setup_headvars_2(pred_info::in, prog_constraints::in,
- list(prog_var)::in, list(mer_mode)::in, list(tvar)::in,
+ list(prog_var)::in, list(mer_mode)::in, list(tvar)::in, list(tvar)::in,
list(prog_var)::in, list(prog_var)::in, list(prog_var)::out,
list(mer_mode)::out, list(tvar)::out, list(tvar)::out,
list(prog_var)::out, list(prog_var)::out,
poly_info::in, poly_info::out) is det.
setup_headvars_2(PredInfo, ClassContext, ExtraHeadVars0,
- ExtraArgModes0, UnconstrainedInstanceTVars,
+ ExtraArgModes0, InstanceTVars, UnconstrainedInstanceTVars,
UnconstrainedInstanceTypeInfoVars, HeadVars0,
HeadVars, ExtraArgModes, HeadTypeVars, AllUnconstrainedTVars,
AllExtraHeadTypeInfoVars, ExistHeadTypeClassInfoVars, !Info) :-
@@ -794,17 +795,26 @@
% The order of these variables is important, and must match the order
% specified at the top of this file.
- % Make a fresh variable for each class constraint, returning
- % a list of variables that appear in the constraints, along
- % with the location of the type infos for them.
+ % Make a fresh variable for each class constraint, returning a list of
+ % variables that appear in the constraints, along with the location of
+ % the type infos for them. For the existential constraints, we want
+ % the rtti_varmaps to contain the internal view of the types (that is,
+ % with type variables bound) so we may need to look up the actual
+ % constraints in the constraint map. For the universal constraints there
+ % is no distinction between the internal views and the external view, so
+ % we just use the constraints from the class context.
ClassContext = constraints(UnivConstraints, ExistConstraints),
- make_typeclass_info_head_vars(ExistConstraints, ExistHeadTypeClassInfoVars,
- !Info),
- rtti_varmaps_tvars(!.Info ^ rtti_varmaps, ExistConstrainedTVars),
-
+ prog_type__constraint_list_get_tvars(UnivConstraints,
+ UnivConstrainedTVars),
+ prog_type__constraint_list_get_tvars(ExistConstraints,
+ ExistConstrainedTVars),
+ poly_info_get_constraint_map(!.Info, ConstraintMap),
+ get_improved_exists_head_constraints(ConstraintMap, ExistConstraints,
+ ActualExistConstraints),
+ make_typeclass_info_head_vars(ActualExistConstraints,
+ ExistHeadTypeClassInfoVars, !Info),
make_typeclass_info_head_vars(UnivConstraints, UnivHeadTypeClassInfoVars,
!Info),
- rtti_varmaps_tvars(!.Info ^ rtti_varmaps, UnivConstrainedTVars),
list__append(UnivHeadTypeClassInfoVars, ExistHeadTypeClassInfoVars,
ExtraHeadTypeClassInfoVars),
@@ -815,9 +825,9 @@
list__delete_elems(UnconstrainedTVars0, ExistConstrainedTVars,
UnconstrainedTVars1),
- % Typeinfos for the unconstrained instance tvars have already
- % been introduced by setup_headvars_instance_method.
- list__delete_elems(UnconstrainedTVars1, UnconstrainedInstanceTVars,
+ % Typeinfos for the instance tvars have already been introduced by
+ % setup_headvars_instance_method.
+ list__delete_elems(UnconstrainedTVars1, InstanceTVars,
UnconstrainedTVars2),
list__remove_dups(UnconstrainedTVars2, UnconstrainedTVars),
@@ -909,36 +919,20 @@
produce_existq_tvars(PredInfo, HeadVars0, UnconstrainedTVars,
TypeInfoHeadVars, ExistTypeClassInfoHeadVars, Goal0, Goal, !Info) :-
poly_info_get_var_types(!.Info, VarTypes0),
+ poly_info_get_constraint_map(!.Info, ConstraintMap),
pred_info_arg_types(PredInfo, ArgTypes),
pred_info_tvar_kinds(PredInfo, KindMap),
pred_info_get_class_context(PredInfo, PredClassContext),
- % Figure out the bindings for any existentially quantified
- % type variables in the head.
-
- PredExistConstraints = PredClassContext ^ exist_constraints,
- ( map__is_empty(VarTypes0) ->
- % This can happen for compiler generated procedures.
- map__init(PredToActualTypeSubst)
- ;
- map__apply_to_list(HeadVars0, VarTypes0, ActualArgTypes),
- type_list_subsumes(ArgTypes, ActualArgTypes, ArgTypeSubst)
- ->
- PredToActualTypeSubst = ArgTypeSubst
- ;
- % This can happen for unification procedures of equivalence types
- % error("polymorphism.m: type_list_subsumes failed")
- map__init(PredToActualTypeSubst)
- ),
-
% Generate code to produce values for any existentially quantified
% typeclass_info variables in the head.
+ PredExistConstraints = PredClassContext ^ exist_constraints,
+ get_improved_exists_head_constraints(ConstraintMap, PredExistConstraints,
+ ActualExistConstraints),
ExistQVarsForCall = [],
Goal0 = _ - GoalInfo,
goal_info_get_context(GoalInfo, Context),
- apply_rec_subst_to_prog_constraint_list(PredToActualTypeSubst,
- PredExistConstraints, ActualExistConstraints),
make_typeclass_info_vars(ActualExistConstraints,
ExistQVarsForCall, Context, ExistTypeClassVars,
ExtraTypeClassGoals, !Info),
@@ -949,6 +943,23 @@
assign_var_list(ExistTypeClassInfoHeadVars,
ExistTypeClassVars, ExtraTypeClassUnifyGoals),
+ % Figure out the bindings for any unconstrained existentially quantified
+ % type variables in the head.
+
+ ( map__is_empty(VarTypes0) ->
+ % This can happen for compiler generated procedures.
+ map__init(PredToActualTypeSubst)
+ ;
+ map__apply_to_list(HeadVars0, VarTypes0, ActualArgTypes),
+ type_list_subsumes(ArgTypes, ActualArgTypes, ArgTypeSubst)
+ ->
+ PredToActualTypeSubst = ArgTypeSubst
+ ;
+ % This can happen for unification procedures of equivalence types
+ % error("polymorphism.m: type_list_subsumes failed")
+ map__init(PredToActualTypeSubst)
+ ),
+
% Apply the type bindings to the unconstrained type variables to give
% the actual types, and then generate code to initialize the type_infos
% for those types.
@@ -987,6 +998,26 @@
explicit, [], Goal)
).
+:- pred get_improved_exists_head_constraints(constraint_map::in,
+ list(prog_constraint)::in, list(prog_constraint)::out) is det.
+
+get_improved_exists_head_constraints(ConstraintMap, ExistConstraints,
+ ActualExistConstraints) :-
+ list__length(ExistConstraints, NumExistConstraints),
+ (
+ search_hlds_constraint_list(ConstraintMap, unproven, [],
+ NumExistConstraints, ActualExistConstraints0)
+ ->
+ ActualExistConstraints = ActualExistConstraints0
+ ;
+ % Some predicates, for example typeclass methods and predicates for
+ % which we inferred the type, don't have constraint map entries for
+ % the head constraints. In these cases we can just use the external
+ % constraints, since there can't be any difference between them and
+ % the internal ones.
+ ActualExistConstraints = ExistConstraints
+ ).
+
%-----------------------------------------------------------------------------%
:- pred process_goal(hlds_goal::in, hlds_goal::out,
Index: compiler/prog_type.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_type.m,v
retrieving revision 1.13
diff -u -r1.13 prog_type.m
--- compiler/prog_type.m 17 Nov 2005 15:57:29 -0000 1.13
+++ compiler/prog_type.m 22 Nov 2005 06:10:52 -0000
@@ -167,6 +167,11 @@
% Return the list of type variables contained in a list of constraints.
%
+:- pred prog_constraints_get_tvars(prog_constraints::in, list(tvar)::out)
+ is det.
+
+ % Return the list of type variables contained in a list of constraints.
+ %
:- pred constraint_list_get_tvars(list(prog_constraint)::in, list(tvar)::out)
is det.
@@ -702,6 +707,11 @@
%-----------------------------------------------------------------------------%
+prog_constraints_get_tvars(constraints(Univ, Exist), TVars) :-
+ constraint_list_get_tvars(Univ, UnivTVars),
+ constraint_list_get_tvars(Exist, ExistTVars),
+ list.append(UnivTVars, ExistTVars, TVars).
+
constraint_list_get_tvars(Constraints, TVars) :-
list.map(constraint_get_tvars, Constraints, TVarsList),
list.condense(TVarsList, TVars).
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.160
diff -u -r1.160 Mmakefile
--- tests/valid/Mmakefile 14 Nov 2005 05:14:13 -0000 1.160
+++ tests/valid/Mmakefile 22 Nov 2005 00:37:19 -0000
@@ -21,6 +21,9 @@
abstract_typeclass \
complex_constraint \
constraint_proof_bug \
+ exists_fundeps \
+ exists_fundeps_2 \
+ exists_fundeps_3 \
flatten_conj_bug \
func_method \
fundeps \
Index: tests/valid/exists_fundeps.m
===================================================================
RCS file: tests/valid/exists_fundeps.m
diff -N tests/valid/exists_fundeps.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/valid/exists_fundeps.m 18 Nov 2005 14:19:13 -0000
@@ -0,0 +1,25 @@
+:- module exists_fundeps.
+:- interface.
+:- import_module list.
+
+:- typeclass solver_var(V) where [
+ some [P, W] func var_propagators(V::ia) = (list(P)::oa) is det
+ => propagator_info(P, W)
+].
+
+:- typeclass propagator_info(P, V) <= ((P -> V), solver_var(V)) where [].
+
+:- type no_info
+ ---> no_info.
+
+:- instance solver_var(no_info).
+:- instance propagator_info(no_info, no_info).
+
+:- implementation.
+
+:- instance solver_var(no_info) where [
+ (var_propagators(_) = [] `with_type` list(no_info))
+].
+
+:- instance propagator_info(no_info, no_info) where [].
+
Index: tests/valid/exists_fundeps_2.m
===================================================================
RCS file: tests/valid/exists_fundeps_2.m
diff -N tests/valid/exists_fundeps_2.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/valid/exists_fundeps_2.m 20 Nov 2005 12:55:04 -0000
@@ -0,0 +1,18 @@
+:- module exists_fundeps_2.
+:- interface.
+
+:- typeclass foo1(S, T) <= (S -> T) where [].
+:- typeclass foo2(T) where [].
+:- typeclass foo3(T) where [].
+
+:- some [S, T] (pred p(R, S) => (foo1(S, T), foo2(S))) <= foo3(R).
+:- mode p(in, out) is det.
+
+:- implementation.
+
+:- type bar ---> bar.
+:- instance foo1(bar, bar) where [].
+:- instance foo2(bar) where [].
+
+p(_, bar).
+
Index: tests/valid/exists_fundeps_3.m
===================================================================
RCS file: tests/valid/exists_fundeps_3.m
diff -N tests/valid/exists_fundeps_3.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/valid/exists_fundeps_3.m 22 Nov 2005 00:37:56 -0000
@@ -0,0 +1,23 @@
+:- module exists_fundeps_3.
+:- interface.
+
+:- import_module list.
+
+:- typeclass solver_var(V) where [
+ some [P, W] func var_propagators(V::ia) = (list(P)::oa) is det
+ => propagator_info(P, W)
+ ].
+
+:- typeclass propagator_info(P, V) <= ((P -> V), solver_var(V)) where [].
+
+:- type gen_solver_var
+ ---> some [V] gen_solver_var(V) => solver_var(V).
+
+:- instance solver_var(gen_solver_var).
+
+:- implementation.
+
+:- instance solver_var(gen_solver_var) where [
+ (var_propagators(gen_solver_var(V)) = var_propagators(V))
+ ].
+
--------------------------------------------------------------------------
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