[m-dev.] for review: fix bugs in explicit type qualification
Simon Taylor
stayl at cs.mu.OZ.AU
Sun Sep 24 03:24:59 AEDT 2000
Estimated hours taken: 4
Fix bugs in explicit type qualification.
compiler/make_hlds.m:
Make the code to handle type qualification expressions match
the documentation. Variables occurring in type qualifications
but not in the predicate's argument types are local to the
clause in which they occur.
Don't export clauses_info_init -- it's not used anywhere else.
Add field labels to the qual_info type.
compiler/hlds_pred.m:
compiler/*.m:
Add a field to the clauses_info to contain the mapping from
type variable names to type variables for the head types.
This needs to be maintained because type variables added
while processing type qualifications in a clause should
not be added to the map used for other clauses.
compiler/typecheck.m:
Apply substitutions to the explicit vartypes at the end
of each pass of typechecking to keep them in sync with
the type variables in the argument types.
compiler/type_util.m:
Add a predicate type_util__apply_variable_renaming_to_type_map
for use by typecheck.m.
doc/reference_manual.texi:
Add some more comments about the handling of explicit type
qualifications to the documentation about valid type assignments.
Change references to existential type _qualifiers_ to consistently
refer to existential type _quantifiers_.
tests/hard_coded/type_qual.{m,exp}:
Add some more tests.
tests/hard_coded/Mmakefile:
Pass `--infer-all' to mmc when compiling type_qual.m.
Index: compiler/clause_to_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/clause_to_proc.m,v
retrieving revision 1.26
diff -u -u -r1.26 clause_to_proc.m
--- compiler/clause_to_proc.m 1999/08/31 05:25:29 1.26
+++ compiler/clause_to_proc.m 2000/09/22 14:42:42
@@ -140,7 +140,7 @@
copy_clauses_to_procs_2(ProcIds, ClausesInfo, Procs1, Procs).
copy_clauses_to_proc(ProcId, ClausesInfo, Proc0, Proc) :-
- ClausesInfo = clauses_info(VarSet, _, VarTypes, HeadVars, Clauses,
+ ClausesInfo = clauses_info(VarSet, _, _, VarTypes, HeadVars, Clauses,
TI_VarMap, TCI_VarMap),
select_matching_clauses(Clauses, ProcId, MatchingClauses),
get_clause_goals(MatchingClauses, GoalList),
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.73
diff -u -u -r1.73 higher_order.m
--- compiler/higher_order.m 2000/09/18 11:51:20 1.73
+++ compiler/higher_order.m 2000/09/22 15:24:08
@@ -2248,6 +2248,7 @@
pred_info_get_aditi_owner(PredInfo0, Owner),
varset__init(EmptyVarSet),
map__init(EmptyVarTypes),
+ map__init(EmptyTVarNameMap),
map__init(EmptyProofs),
map__init(EmptyTIMap),
map__init(EmptyTCIMap),
@@ -2255,7 +2256,8 @@
% This isn't looked at after here, and just clutters up
% hlds dumps if it's filled in.
ClausesInfo = clauses_info(EmptyVarSet, EmptyVarTypes,
- EmptyVarTypes, [], [], EmptyTIMap, EmptyTCIMap),
+ EmptyTVarNameMap, EmptyVarTypes, [], [],
+ EmptyTIMap, EmptyTCIMap),
pred_info_init(PredModule, SymName, Arity, ArgTVarSet, ExistQVars,
Types, true, Context, ClausesInfo, Status, MarkerList, GoalType,
PredOrFunc, ClassContext, EmptyProofs, Owner, NewPredInfo0),
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.244
diff -u -u -r1.244 hlds_out.m
--- compiler/hlds_out.m 2000/09/21 09:43:44 1.244
+++ compiler/hlds_out.m 2000/09/23 16:04:56
@@ -740,7 +740,7 @@
;
[]
),
- { ClausesInfo = clauses_info(VarSet, _, VarTypes, HeadVars, Clauses,
+ { ClausesInfo = clauses_info(VarSet, _, _, VarTypes, HeadVars, Clauses,
TypeInfoMap, TypeClassInfoMap) },
( { string__contains_char(Verbose, 'C') } ->
hlds_out__write_indent(Indent),
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.82
diff -u -u -r1.82 hlds_pred.m
--- compiler/hlds_pred.m 2000/09/20 12:11:56 1.82
+++ compiler/hlds_pred.m 2000/09/23 15:27:26
@@ -118,6 +118,15 @@
% variable types from
% explicit
% qualifications
+ tvar_name_map :: tvar_name_map,
+ % map from variable
+ % name to type variable
+ % for the type
+ % variables occurring
+ % in the argument
+ % types. This is used
+ % to process explicit
+ % type qualifications.
vartypes :: vartypes,
% variable types
% inferred by
@@ -134,6 +143,8 @@
:- type vartypes == map(prog_var, type).
+:- type tvar_name_map == map(string, tvar).
+
:- pred clauses_info_varset(clauses_info, prog_varset).
:- mode clauses_info_varset(in, out) is det.
@@ -864,8 +875,9 @@
unqualify_name(SymName, PredName),
% The empty list of clauses is a little white lie.
Clauses = [],
- ClausesInfo = clauses_info(VarSet, VarTypes, VarTypes, HeadVars,
- Clauses, TypeInfoMap, TypeClassInfoMap),
+ map__init(TVarNameMap),
+ ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap,
+ VarTypes, HeadVars, Clauses, TypeInfoMap, TypeClassInfoMap),
map__init(ClassProofs),
term__vars_list(Types, TVars),
list__delete_elems(TVars, ExistQVars, HeadTypeParams),
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.351
diff -u -u -r1.351 make_hlds.m
--- compiler/make_hlds.m 2000/09/21 09:43:47 1.351
+++ compiler/make_hlds.m 2000/09/22 15:13:26
@@ -45,8 +45,6 @@
prog_context, is_address_taken, pred_info, proc_id).
:- mode add_new_proc(in, in, in, in, in, in, in, in, out, out) is det.
-:- pred clauses_info_init(int::in, clauses_info::out) is det.
-
% add_special_pred_for_real(SpecialPredId, ModuleInfo0, TVarSet,
% Type, TypeId, TypeBody, TypeContext, TypeStatus, ModuleInfo).
%
@@ -965,7 +963,8 @@
Clause = clause(ProcIds, Goal, Context),
map__init(TI_VarMap),
map__init(TCI_VarMap),
- Clauses = clauses_info(ArgVarSet, VarTypes0,
+ map__init(TVarNameMap),
+ Clauses = clauses_info(ArgVarSet, VarTypes0, TVarNameMap,
VarTypes0, Args, [Clause], TI_VarMap, TCI_VarMap),
pred_info_get_markers(PredInfo0, Markers),
map__init(Proofs),
@@ -2859,9 +2858,10 @@
%
ClauseList = [Clause],
map__from_corresponding_lists(HeadVars, Types, VarTypes),
+ map__init(TVarNameMap),
map__init(TI_VarMap),
map__init(TCI_VarMap),
- ClausesInfo = clauses_info(VarSet, VarTypes, VarTypes,
+ ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap, VarTypes,
HeadVars, ClauseList, TI_VarMap, TCI_VarMap),
pred_info_set_clauses_info(PredInfo0, ClausesInfo, PredInfo).
@@ -3581,7 +3581,7 @@
{ maybe_add_default_func_mode(PredInfo1, PredInfo2, _) },
{ pred_info_procedures(PredInfo2, Procs) },
{ map__keys(Procs, ModeIds) },
- clauses_info_add_clause(Clauses0, PredId, ModeIds,
+ clauses_info_add_clause(Clauses0, ModeIds,
ClauseVarSet, TVarSet0, Args, Body, Context,
PredOrFunc, Arity, IsAssertion, Goal,
VarSet, TVarSet, Clauses, Warnings,
@@ -3669,10 +3669,11 @@
IntroducedClause = clause([], IntroducedGoal, Context),
map__from_corresponding_lists(HeadVars, ArgTypes, VarTypes),
+ map__init(TVarNameMap),
map__init(TI_VarMap),
map__init(TCI_VarMap),
- ClausesInfo = clauses_info(VarSet, VarTypes, VarTypes, HeadVars,
- [IntroducedClause], TI_VarMap, TCI_VarMap).
+ ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap, VarTypes,
+ HeadVars, [IntroducedClause], TI_VarMap, TCI_VarMap).
% handle the arbitrary clauses syntax
produce_instance_method_clauses(clauses(InstanceClauses), PredOrFunc,
@@ -3705,16 +3706,15 @@
Arity = list__length(ArgTerms)
}
->
- % currently these two arguments are not used
- % in any important way, I think, so I think
- % we can safely set them to dummy values
- { invalid_pred_id(PredId) },
+ % The tvarset argument is only used for explicit type
+ % qualifications, of which there are none in this clause,
+ % so it is set to a dummy value.
{ varset__init(TVarSet0) },
{ ModeIds = [] }, % means this clause applies to _every_
% mode of the procedure
{ IsAssertion = no },
- clauses_info_add_clause(ClausesInfo0, PredId, ModeIds,
+ clauses_info_add_clause(ClausesInfo0, ModeIds,
CVarSet, TVarSet0, HeadTerms, Body, Context,
PredOrFunc, Arity, IsAssertion, Goal,
VarSet, _TVarSet, ClausesInfo, Warnings,
@@ -5099,22 +5099,26 @@
clauses_info_init_for_assertion(HeadVars, ClausesInfo) :-
map__init(VarTypes),
+ map__init(TVarNameMap),
varset__init(VarSet),
map__init(TI_VarMap),
map__init(TCI_VarMap),
- ClausesInfo = clauses_info(VarSet, VarTypes, VarTypes, HeadVars, [],
- TI_VarMap, TCI_VarMap).
+ ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap, VarTypes,
+ HeadVars, [], TI_VarMap, TCI_VarMap).
+:- pred clauses_info_init(int::in, clauses_info::out) is det.
+
clauses_info_init(Arity, ClausesInfo) :-
map__init(VarTypes),
+ map__init(TVarNameMap),
varset__init(VarSet0),
make_n_fresh_vars("HeadVar__", Arity, VarSet0, HeadVars, VarSet),
map__init(TI_VarMap),
map__init(TCI_VarMap),
- ClausesInfo = clauses_info(VarSet, VarTypes, VarTypes, HeadVars, [],
- TI_VarMap, TCI_VarMap).
+ ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap,
+ VarTypes, HeadVars, [], TI_VarMap, TCI_VarMap).
-:- pred clauses_info_add_clause(clauses_info::in, pred_id::in,
+:- pred clauses_info_add_clause(clauses_info::in,
list(proc_id)::in, prog_varset::in, tvarset::in,
list(prog_term)::in, goal::in, prog_context::in,
pred_or_func::in, arity::in, bool::in,
@@ -5123,19 +5127,33 @@
module_info::in, module_info::out, qual_info::in,
qual_info::out, io__state::di, io__state::uo) is det.
-clauses_info_add_clause(ClausesInfo0, PredId, ModeIds, CVarSet, TVarSet0,
+clauses_info_add_clause(ClausesInfo0, ModeIds, CVarSet, TVarSet0,
Args, Body, Context, PredOrFunc, Arity, IsAssertion, Goal,
- VarSet, TVarSet0, ClausesInfo, Warnings, Module0, Module,
+ VarSet, TVarSet, ClausesInfo, Warnings, Module0, Module,
Info0, Info) -->
- { ClausesInfo0 = clauses_info(VarSet0, VarTypes0, VarTypes1,
- HeadVars, ClauseList0,
- TI_VarMap, TCI_VarMap) },
- { update_qual_info(Info0, TVarSet0, VarTypes0, PredId, Info1) },
+ { ClausesInfo0 = clauses_info(VarSet0, ExplicitVarTypes0, TVarNameMap0,
+ InferredVarTypes, HeadVars, ClauseList0,
+ TI_VarMap, TCI_VarMap) },
+ { ClauseList0 = [] ->
+ % Create the mapping from type variable name, used to
+ % rename type variables occurring in explicit type
+ % qualifications. The version of this mapping stored
+ % in the clauses_info should only contain type variables
+ % which occur in the argument types of the predicate.
+ % Type variables which only occur in explicit type
+ % qualifications are local to the clause in which they appear.
+ varset__create_name_var_map(TVarSet0, TVarNameMap)
+ ;
+ TVarNameMap = TVarNameMap0
+ },
+ { update_qual_info(Info0, TVarNameMap, TVarSet0,
+ ExplicitVarTypes0, Info1) },
{ varset__merge_subst(VarSet0, CVarSet, VarSet1, Subst) },
transform(Subst, HeadVars, Args, Body, VarSet1, Context, PredOrFunc,
Arity, IsAssertion, Goal0, VarSet, Warnings,
transform_info(Module0, Info1),
transform_info(Module, Info2)),
+ { TVarSet = Info2 ^ tvarset },
{ qual_info_get_found_syntax_error(Info2, FoundError) },
{ qual_info_set_found_syntax_error(no, Info2, Info) },
(
@@ -5154,10 +5172,10 @@
% XXX we should avoid append - this gives O(N*N)
{ list__append(ClauseList0, [clause(ModeIds, Goal, Context)],
ClauseList) },
- { qual_info_get_var_types(Info, VarTypes) },
- { ClausesInfo = clauses_info(VarSet, VarTypes, VarTypes1,
- HeadVars, ClauseList,
- TI_VarMap, TCI_VarMap) }
+ { qual_info_get_var_types(Info, ExplicitVarTypes) },
+ { ClausesInfo = clauses_info(VarSet, ExplicitVarTypes,
+ TVarNameMap, InferredVarTypes, HeadVars,
+ ClauseList, TI_VarMap, TCI_VarMap) }
).
%-----------------------------------------------------------------------------
@@ -5180,7 +5198,7 @@
PredOrFunc, PredName, Arity, ClausesInfo, ModuleInfo0,
ModuleInfo, Info0, Info) -->
{
- ClausesInfo0 = clauses_info(VarSet0, VarTypes, VarTypes1,
+ ClausesInfo0 = clauses_info(VarSet0, VarTypes, TVarNameMap, VarTypes1,
HeadVars, ClauseList, TI_VarMap, TCI_VarMap),
pragma_get_vars(PVars, Args0),
pragma_get_var_infos(PVars, ArgInfo),
@@ -5258,8 +5276,8 @@
HldsGoal1, VarSet2, EmptyVarTypes,
HldsGoal, VarSet, _, _Warnings),
NewClause = clause([ModeId], HldsGoal, Context),
- ClausesInfo = clauses_info(VarSet, VarTypes, VarTypes1,
- HeadVars, [NewClause|ClauseList],
+ ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap,
+ VarTypes1, HeadVars, [NewClause|ClauseList],
TI_VarMap, TCI_VarMap)
}
).
@@ -7234,8 +7252,8 @@
:- mode process_type_qualification(in, in, in, in, in, out, di, uo) is det.
process_type_qualification(Var, Type0, VarSet, Context, Info0, Info) -->
- { Info0 ^ qual_info = qual_info(EqvMap, TVarSet0, TVarRenaming0, Index0,
- VarTypes0, PredId, MQInfo0, FoundError) },
+ { Info0 ^ qual_info = qual_info(EqvMap, TVarSet0, TVarRenaming0,
+ TVarNameMap0, VarTypes0, MQInfo0, FoundError) },
module_qual__qualify_type_qualification(Type0, Type1,
Context, MQInfo0, MQInfo),
@@ -7244,7 +7262,7 @@
% add them to the var-name index and the variable renaming.
term__vars(Type1, TVars),
get_new_tvars(TVars, VarSet, TVarSet0, TVarSet1,
- Index0, Index, TVarRenaming0, TVarRenaming),
+ TVarNameMap0, TVarNameMap, TVarRenaming0, TVarRenaming),
% Apply the updated renaming to convert type variables in
% the clause to type variables in the tvarset.
@@ -7255,7 +7273,7 @@
},
update_var_types(VarTypes0, Var, Type, Context, VarTypes),
{ Info = Info0 ^ qual_info := qual_info(EqvMap, TVarSet, TVarRenaming,
- Index, VarTypes, PredId, MQInfo, FoundError) }.
+ TVarNameMap, VarTypes, MQInfo, FoundError) }.
:- pred update_var_types(map(prog_var, type), prog_var, type, prog_context,
map(prog_var, type), io__state, io__state).
@@ -7279,34 +7297,35 @@
% Add new type variables for those introduced by a type qualification.
:- pred get_new_tvars(list(tvar), tvarset, tvarset, tvarset,
- map(string, tvar), map(string, tvar), map(tvar, tvar), map(tvar, tvar)).
+ tvar_name_map, tvar_name_map, map(tvar, tvar), map(tvar, tvar)).
:- mode get_new_tvars(in, in, in, out, in, out, in, out) is det.
-get_new_tvars([], _, T, T, I, I, R, R).
+get_new_tvars([], _, T, T, M, M, R, R).
get_new_tvars([TVar | TVars], VarSet, TVarSet0, TVarSet,
- Index0, Index, TVarRenaming0, TVarRenaming) :-
+ TVarNameMap0, TVarNameMap, TVarRenaming0, TVarRenaming) :-
( map__contains(TVarRenaming0, TVar) ->
TVarRenaming1 = TVarRenaming0,
TVarSet2 = TVarSet0,
- Index1 = Index0
+ TVarNameMap1 = TVarNameMap0
;
varset__lookup_name(VarSet, TVar, TVarName),
- ( map__search(Index0, TVarName, TVarSetVar) ->
+ ( map__search(TVarNameMap0, TVarName, TVarSetVar) ->
map__det_insert(TVarRenaming0, TVar, TVarSetVar,
TVarRenaming1),
TVarSet2 = TVarSet0,
- Index1 = Index0
+ TVarNameMap1 = TVarNameMap0
;
varset__new_var(TVarSet0, NewTVar, TVarSet1),
varset__name_var(TVarSet1, NewTVar,
TVarName, TVarSet2),
- map__det_insert(Index0, TVarName, NewTVar, Index1),
+ map__det_insert(TVarNameMap0, TVarName, NewTVar,
+ TVarNameMap1),
map__det_insert(TVarRenaming0, TVar, NewTVar,
TVarRenaming1)
)
),
get_new_tvars(TVars, VarSet, TVarSet2, TVarSet,
- Index1, Index, TVarRenaming1, TVarRenaming).
+ TVarNameMap1, TVarNameMap, TVarRenaming1, TVarRenaming).
%-----------------------------------------------------------------------------%
@@ -7402,18 +7421,20 @@
% Information used to process explicit type qualifications.
:- type qual_info
- ---> qual_info(
- eqv_map, % Used to expand equivalence types.
- tvarset, % All type variables for predicate.
- map(tvar, tvar),
+ ---> qual_info(
+ eqv_map :: eqv_map, % Used to expand equivalence types.
+ tvarset :: tvarset, % All type variables for predicate.
+ tvar_renaming :: map(tvar, tvar),
% Map from clause type variable to
% actual type variable in tvarset.
- map(string, tvar),
- % Type variables in tvarset indexed by name.
- map(prog_var, type), % Var types
- pred_id, % Last pred processed.
- mq_info, % Module qualification info.
- bool % Was there a syntax error
+ tvar_name_map :: tvar_name_map,
+ % Type variables in tvarset occurring
+ % in the predicate's argument types
+ % indexed by name.
+ vartypes :: map(prog_var, type), % Var types
+ mq_info :: mq_info, % Module qualification info.
+ found_syntax_error :: bool
+ % Was there a syntax error
% in an Aditi update.
).
@@ -7426,61 +7447,48 @@
map__init(Renaming),
map__init(Index),
map__init(VarTypes),
- invalid_pred_id(PredId),
FoundSyntaxError = no,
QualInfo = qual_info(EqvMap, TVarSet, Renaming,
- Index, VarTypes, PredId, MQInfo, FoundSyntaxError).
+ Index, VarTypes, MQInfo, FoundSyntaxError).
% Update the qual_info when processing a new clause.
-:- pred update_qual_info(qual_info, tvarset, map(prog_var, type),
- pred_id, qual_info).
+:- pred update_qual_info(qual_info, tvar_name_map, tvarset,
+ map(prog_var, type), qual_info).
:- mode update_qual_info(in, in, in, in, out) is det.
-update_qual_info(QualInfo0, TVarSet, VarTypes, PredId, QualInfo) :-
- QualInfo0 = qual_info(EqvMap, TVarSet0, _Renaming0, Index0,
- VarTypes0, PredId0, MQInfo, FoundError),
- ( PredId = PredId0 ->
- % The renaming for one clause is useless in the others.
- map__init(Renaming),
- QualInfo = qual_info(EqvMap, TVarSet0, Renaming,
- Index0, VarTypes0, PredId0, MQInfo, FoundError)
- ;
- varset__create_name_var_map(TVarSet, Index),
- map__init(Renaming),
- QualInfo = qual_info(EqvMap, TVarSet, Renaming,
- Index, VarTypes, PredId, MQInfo, FoundError)
- ).
-
- % All the other items are needed all at once in one or two places,
- % so access predicates for them would be a waste of time.
+update_qual_info(QualInfo0, TVarNameMap, TVarSet, VarTypes, QualInfo) :-
+ QualInfo0 = qual_info(EqvMap, _TVarSet0, _Renaming0, _TVarNameMap0,
+ _VarTypes0, MQInfo, _FoundError),
+ % The renaming for one clause is useless in the others.
+ map__init(Renaming),
+ QualInfo = qual_info(EqvMap, TVarSet, Renaming, TVarNameMap,
+ VarTypes, MQInfo, no).
:- pred qual_info_get_mq_info(qual_info, mq_info).
:- mode qual_info_get_mq_info(in, out) is det.
-qual_info_get_mq_info(qual_info(_,_,_,_,_,_,MQInfo, _), MQInfo).
+qual_info_get_mq_info(Info, Info ^ mq_info).
:- pred qual_info_set_mq_info(qual_info, mq_info, qual_info).
:- mode qual_info_set_mq_info(in, in, out) is det.
-qual_info_set_mq_info(qual_info(A,B,C,D,E,F,_,H), MQInfo,
- qual_info(A,B,C,D,E,F, MQInfo,H)).
+qual_info_set_mq_info(Info0, MQInfo, Info0 ^ mq_info := MQInfo).
:- pred qual_info_get_var_types(qual_info, map(prog_var, type)).
:- mode qual_info_get_var_types(in, out) is det.
-qual_info_get_var_types(qual_info(_,_,_,_,VarTypes,_,_,_), VarTypes).
+qual_info_get_var_types(Info, Info ^ vartypes).
:- pred qual_info_get_found_syntax_error(qual_info, bool).
:- mode qual_info_get_found_syntax_error(in, out) is det.
-qual_info_get_found_syntax_error(qual_info(_,_,_,_,_,_,_,FoundError),
- FoundError).
+qual_info_get_found_syntax_error(Info, Info ^ found_syntax_error).
:- pred qual_info_set_found_syntax_error(bool, qual_info, qual_info).
:- mode qual_info_set_found_syntax_error(in, in, out) is det.
-qual_info_set_found_syntax_error(FoundError, qual_info(A,B,C,D,E,F,G,_),
- qual_info(A,B,C,D,E,F,G,FoundError)).
+qual_info_set_found_syntax_error(FoundError, Info,
+ Info ^ found_syntax_error := FoundError).
%-----------------------------------------------------------------------------%
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.199
diff -u -u -r1.199 polymorphism.m
--- compiler/polymorphism.m 2000/09/18 11:51:36 1.199
+++ compiler/polymorphism.m 2000/09/22 14:42:47
@@ -553,8 +553,9 @@
poly_info_get_type_info_map(PolyInfo, TypeInfoMap),
poly_info_get_typeclass_info_map(PolyInfo, TypeClassInfoMap),
clauses_info_explicit_vartypes(ClausesInfo0, ExplicitVarTypes),
- ClausesInfo = clauses_info(VarSet, ExplicitVarTypes, VarTypes,
- HeadVars, Clauses,
+ map__init(TVarNameMap), % This is only used while adding the clauses.
+ ClausesInfo = clauses_info(VarSet, ExplicitVarTypes, TVarNameMap,
+ VarTypes, HeadVars, Clauses,
TypeInfoMap, TypeClassInfoMap).
:- pred polymorphism__process_clause(pred_info, list(prog_var), list(prog_var),
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.89
diff -u -u -r1.89 type_util.m
--- compiler/type_util.m 2000/09/18 11:51:48 1.89
+++ compiler/type_util.m 2000/09/22 14:42:48
@@ -362,6 +362,10 @@
map(class_constraint, constraint_proof)).
:- mode apply_rec_subst_to_constraint_proofs(in, in, out) is det.
+:- pred apply_variable_renaming_to_type_map(map(tvar, tvar),
+ vartypes, vartypes).
+:- mode apply_variable_renaming_to_type_map(in, in, out) is det.
+
:- pred apply_variable_renaming_to_constraints(map(tvar, tvar),
class_constraints, class_constraints).
:- mode apply_variable_renaming_to_constraints(in, in, out) is det.
@@ -1401,6 +1405,12 @@
map__set(Map0, Constraint, Proof, Map)
)),
Proofs0, Empty, Proofs).
+
+apply_variable_renaming_to_type_map(Renaming, Map0, Map) :-
+ map__map_values(
+ (pred(_::in, Type0::in, Type::out) is det :-
+ term__apply_variable_renaming(Type0, Renaming, Type)
+ ), Map0, Map).
apply_variable_renaming_to_constraints(Renaming,
constraints(UniversalCs0, ExistentialCs0),
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.284
diff -u -u -r1.284 typecheck.m
--- compiler/typecheck.m 2000/09/18 16:38:08 1.284
+++ compiler/typecheck.m 2000/09/23 15:02:52
@@ -345,7 +345,7 @@
clauses_info_clauses(ClausesInfo0, Clauses0),
clauses_info_headvars(ClausesInfo0, HeadVars),
clauses_info_varset(ClausesInfo0, VarSet),
- clauses_info_explicit_vartypes(ClausesInfo0, ExplicitVarTypes),
+ clauses_info_explicit_vartypes(ClausesInfo0, ExplicitVarTypes0),
(
Clauses0 = []
->
@@ -417,7 +417,7 @@
dual_constraints(PredConstraints, Constraints),
typecheck_info_init(IOState1, ModuleInfo, PredId,
- TypeVarSet0, VarSet, ExplicitVarTypes,
+ TypeVarSet0, VarSet, ExplicitVarTypes0,
HeadTypeParams1, Constraints, Status,
TypeCheckInfo1),
typecheck_info_get_type_assign_set(TypeCheckInfo1,
@@ -431,14 +431,29 @@
typecheck_check_for_ambiguity(whole_pred, HeadVars,
TypeCheckInfo3, TypeCheckInfo4),
typecheck_info_get_final_info(TypeCheckInfo4, HeadTypeParams1,
- ExistQVars0, TypeVarSet, HeadTypeParams2,
- InferredVarTypes0, InferredTypeConstraints0,
- ConstraintProofs, TVarRenaming,
- ExistTypeRenaming),
+ ExistQVars0, ExplicitVarTypes0, TypeVarSet,
+ HeadTypeParams2, InferredVarTypes0,
+ InferredTypeConstraints0, ConstraintProofs,
+ TVarRenaming, ExistTypeRenaming),
map__optimize(InferredVarTypes0, InferredVarTypes),
clauses_info_set_vartypes(ClausesInfo0, InferredVarTypes,
ClausesInfo1),
- clauses_info_set_clauses(ClausesInfo1, Clauses, ClausesInfo),
+
+ %
+ % Apply substitutions to the explicit vartypes.
+ %
+ ( ExistQVars0 = [] ->
+ ExplicitVarTypes1 = ExplicitVarTypes0
+ ;
+ apply_variable_renaming_to_type_map(ExistTypeRenaming,
+ ExplicitVarTypes0, ExplicitVarTypes1)
+ ),
+ apply_variable_renaming_to_type_map(TVarRenaming,
+ ExplicitVarTypes1, ExplicitVarTypes),
+
+ clauses_info_set_explicit_vartypes(ClausesInfo1,
+ ExplicitVarTypes, ClausesInfo2),
+ clauses_info_set_clauses(ClausesInfo2, Clauses, ClausesInfo),
pred_info_set_clauses_info(PredInfo1, ClausesInfo, PredInfo2),
pred_info_set_typevarset(PredInfo2, TypeVarSet, PredInfo3),
pred_info_set_constraint_proofs(PredInfo3, ConstraintProofs,
@@ -3349,7 +3364,7 @@
%-----------------------------------------------------------------------------%
% typecheck_info_get_final_info(TypeCheckInfo,
-% OldHeadTypeParams, OldExistQVars,
+% OldHeadTypeParams, OldExistQVars, OldExplicitVarTypes,
% NewTypeVarSet, New* ..., TypeRenaming, ExistTypeRenaming):
% extracts the final inferred types from TypeCheckInfo.
%
@@ -3357,6 +3372,8 @@
% predicate.
% OldExistQVars should be the declared existentially quantified
% type variables (if any).
+% OldExplicitVarTypes is the vartypes map containing the explicit
+% type qualifications.
% New* is the newly inferred types, in NewTypeVarSet.
% TypeRenaming is a map to rename things from the old TypeVarSet
% to the NewTypeVarSet.
@@ -3365,15 +3382,15 @@
% in OldExistQVars.
:- pred typecheck_info_get_final_info(typecheck_info, list(tvar), existq_tvars,
- tvarset, existq_tvars, map(prog_var, type),
+ vartypes, tvarset, existq_tvars, map(prog_var, type),
class_constraints, map(class_constraint, constraint_proof),
map(tvar, tvar), map(tvar, tvar)).
-:- mode typecheck_info_get_final_info(in, in, in,
+:- mode typecheck_info_get_final_info(in, in, in, in,
out, out, out, out, out, out, out) is det.
typecheck_info_get_final_info(TypeCheckInfo, OldHeadTypeParams, OldExistQVars,
- NewTypeVarSet, NewHeadTypeParams, NewVarTypes,
- NewTypeConstraints, NewConstraintProofs, TSubst,
+ OldExplicitVarTypes, NewTypeVarSet, NewHeadTypeParams,
+ NewVarTypes, NewTypeConstraints, NewConstraintProofs, TSubst,
ExistTypeRenaming) :-
typecheck_info_get_type_assign_set(TypeCheckInfo, TypeAssignSet),
( TypeAssignSet = [TypeAssign | _] ->
@@ -3413,8 +3430,9 @@
%
% First, find the set (sorted list) of type variables
% that we need. This must include any type variables
- % in the inferred types, plus any existentially typed
- % variables that will remain in the declaration.
+ % in the inferred types, the explicit type qualifications,
+ % and any existentially typed variables that will remain
+ % in the declaration.
%
% There may also be some type variables in the HeadTypeParams
% which do not occur in the type of any variable (e.g. this
@@ -3426,11 +3444,13 @@
%
map__values(VarTypes, Types),
term__vars_list(Types, TypeVars0),
+ map__values(OldExplicitVarTypes, ExplicitTypes),
+ term__vars_list(ExplicitTypes, ExplicitTypeVars0),
map__keys(ExistTypeRenaming, ExistQVarsToBeRenamed),
list__delete_elems(OldExistQVars, ExistQVarsToBeRenamed,
ExistQVarsToRemain),
- list__condense([ExistQVarsToRemain, HeadTypeParams, TypeVars0],
- TypeVars1),
+ list__condense([ExistQVarsToRemain, HeadTypeParams,
+ TypeVars0, ExplicitTypeVars0], TypeVars1),
list__sort_and_remove_dups(TypeVars1, TypeVars),
%
% Next, create a new typevarset with the same number of
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.88
diff -u -u -r1.88 unify_proc.m
--- compiler/unify_proc.m 2000/09/18 11:51:53 1.88
+++ compiler/unify_proc.m 2000/09/22 14:42:51
@@ -679,10 +679,11 @@
error("unknown special pred")
),
unify_proc__info_extract(VarTypeInfo, VarSet, Types),
+ map__init(TVarNameMap),
map__init(TI_VarMap),
map__init(TCI_VarMap),
- ClauseInfo = clauses_info(VarSet, Types, Types, Args, Clauses,
- TI_VarMap, TCI_VarMap).
+ ClauseInfo = clauses_info(VarSet, Types, TVarNameMap,
+ Types, Args, Clauses, TI_VarMap, TCI_VarMap).
:- pred unify_proc__generate_unify_clauses(hlds_type_body, prog_var, prog_var,
prog_context, list(clause), unify_proc_info, unify_proc_info).
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.191
diff -u -u -r1.191 reference_manual.texi
--- doc/reference_manual.texi 2000/09/21 09:43:58 1.191
+++ doc/reference_manual.texi 2000/09/22 14:42:59
@@ -1511,6 +1511,15 @@
and the type assigned to the result term in a function clause must exactly
match the result type specified in the corresponding @samp{:- func} declaration.
+The type assigned to each data-term with an explicit type qualification
+(@pxref{Explicit type qualification}) must match the type specified
+by the type qualification expression at footnote{The type of an explicitly
+type qualified term may be an instance of the type specified by the
+qualifier. This allows explicit type qualifications to constrain the
+types of two data-terms to be identical, without knowing the exact types
+of the data-terms. It also allows type qualifications to refer to the
+types of the results of existentially typed predicates or functions.}.
+
(Here ``match'' means to be an instance of,
i.e. to be identical to for some substitution of the type parameters,
and ``exactly match'' means to be identical up to renaming of type parameters.)
@@ -3981,14 +3990,14 @@
@section Existentially typed predicates and functions
@menu
-* Syntax for explicit type qualifiers::
-* Semantics of type qualifiers::
+* Syntax for explicit type quantifiers::
+* Semantics of type quantifiers::
* Examples of correct code using type quantifiers::
* Examples of incorrect code using type quantifiers::
@end menu
- at node Syntax for explicit type qualifiers
- at subsection Syntax for explicit type qualifiers
+ at node Syntax for explicit type quantifiers
+ at subsection Syntax for explicit type quantifiers
Type variables in type declarations for polymorphic predicates or functions
are normally universally quantified.
@@ -4024,8 +4033,8 @@
:- all [T3] some [T2] pred foo(T1, T2, T3).
@end example
- at node Semantics of type qualifiers
- at subsection Semantics of type qualifiers
+ at node Semantics of type quantifiers
+ at subsection Semantics of type quantifiers
If a type variable in the type declaration for a polymorphic predicate
or function is universally quantified, this means the caller will
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.89
diff -u -u -r1.89 Mmakefile
--- tests/hard_coded/Mmakefile 2000/09/18 11:52:39 1.89
+++ tests/hard_coded/Mmakefile 2000/09/23 15:15:53
@@ -136,6 +136,7 @@
MCFLAGS-redoip_clobber = --no-inlining
MCFLAGS-rnd = -O6
MCFLAGS-split_c_files = --trace deep
+MCFLAGS-type_qual = --infer-all
MCFLAGS-type_spec = --user-guided-type-specialization
MCFLAGS-existential_types_test = --infer-all
MCFLAGS-existential_float = --infer-all
Index: tests/hard_coded/type_qual.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/type_qual.exp,v
retrieving revision 1.1
diff -u -u -r1.1 type_qual.exp
--- tests/hard_coded/type_qual.exp 2000/09/21 09:44:04 1.1
+++ tests/hard_coded/type_qual.exp 2000/09/23 15:56:14
@@ -1,3 +1,15 @@
ok(42)
list:list(io:state)
list:list(list:list(io:state))
+[]
+list:list(int)
+[]
+list:list(int)
+list:list(string)
+["a", "b", "c"]
+list:list(string)
+[]
+list:list(int)
+[]
+list:list(string)
+[]
Index: tests/hard_coded/type_qual.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/type_qual.m,v
retrieving revision 1.1
diff -u -u -r1.1 type_qual.m
--- tests/hard_coded/type_qual.m 2000/09/21 09:44:05 1.1
+++ tests/hard_coded/type_qual.m 2000/09/23 15:54:18
@@ -6,13 +6,17 @@
:- pred main(io__state::di, io__state::uo) is det.
+
:- implementation.
-:- import_module list, std_util.
+:- import_module bool, list, map, std_util.
main -->
test1,
test2([] `with_type` list(io__state)),
- test3.
+ test3,
+ test4,
+ test5(yes),
+ test5(no).
:- pred test1(io__state::di, io__state::uo) is det.
@@ -38,7 +42,42 @@
io__write(X), nl,
io__write(type_of(X)), nl.
+:- pred test4(io__state::di, io__state::uo) is det.
+
+test4 -->
+ { List = build_list `with_type` TypeOfList },
+ io__write(type_of(List)), nl,
+ io__write(List), nl,
+ { EmptyList = [] `with_type` TypeOfList },
+ io__write(type_of(EmptyList)), nl,
+ io__write(EmptyList), nl.
+
+:- pred test5(bool::in, io__state::di, io__state::uo) is det.
+
+ % Test use of same type variable in different clauses.
+test5(yes) -->
+ { _ = [1, 2, 3] `with_type` T },
+ { Y = [] `with_type` T },
+ io__write(type_of(Y)), nl,
+ io__write(Y), nl.
+test5(no) -->
+ { _ = ["1", "2", "3"] `with_type` T },
+ { Y = [] `with_type` T },
+ io__write(type_of(Y)), nl,
+ io__write(Y), nl.
+
empty_list = [] `with_type` list(int).
empty([] `with_type` list(int)).
+:- some [T] func build_list = list(T).
+
+build_list = ["a", "b", "c"].
+
+:- type my_map(_K, V) == map(int, V).
+
+:- pred map_search(my_map(K, V)::in, int::in, V::out) is semidet.
+
+map_search(Map `with_type` map(int, V), Key `with_type` int,
+ Value `with_type` V) :-
+ map__search(Map, Key, Value).
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list