[m-rev.] for review: rtti_varmaps
Mark Brown
mark at cs.mu.OZ.AU
Sun Jul 17 22:05:25 AEST 2005
Estimated hours taken: 25
Branches: main
Package the type_info_varmap and typeclass_info_varmap types into an ADT
called rtti_varmaps. There are two main purposes for this:
- We wish to extend this set of maps with new maps. Doing this
will be a lot easier and less error prone if all of the maps are
packaged in a single data structure.
- Any new maps that we add may contain redundant information that
just makes searching the maps more efficient. Therefore they must
be kept consistent with the existing maps. Having all the maps
inside an ADT makes it easier to ensure this.
This change also includes two extensions to the maps. First, the
typeclass_info_map is made reversible so that it is possible to efficiently
look up the constraint for a given typeclass_info variable. Second, a new
map from prog_vars to types makes it possible to efficiently look up the
type that a given type_info variable is for. These two changes mean that
it is no longer necessary to consult the argument of type_info/1 or
typeclass_info/1 to find this information. (We still do put that information
there, though; changing the RTTI is left for a separate change.)
compiler/hlds_pred.m:
Move items relating to type_infos and typeclass_infos into a section
of their own.
Add a type `rtti_var_info' to hold information about the contents
of a type_info or typeclass_info variable.
Define the rtti_varmaps abstract data type. This data structure
consists of the type_info_varmap and the typeclass_info_varmap.
A new map, type_info_type_map, is added, which is like the inverse
to the type_info_varmap. The difference is that the latter can
point to locations that are inside a typeclass_info variable,
whereas the former only refers to type_info variables. Note that
the combined maps do not form a bijection, or even an injection,
since it is possible for two different type variables to point to
the same location (that is, if they are aliased).
Make the typeclass_info_varmap reversible, by using the new module
injection.m. Unlike the type_info_varmap, this map is always
injective since the same typeclass_info cannot be used for two
different constraints.
The predicates rtti_det_insert_type_info_locn and set_type_info_locn,
which update the type_info_varmap, contain sanity checks to ensure
that only type variables that have already been registered with
the type_info_type_map are used, and that the information in both
maps are consistent.
Use the rtti_varmaps structure in proc_info and clauses_info, in
place of type_info_varmap and typeclass_info_varmap.
compiler/polymorphism.m:
Remove polymorphism__type_info_or_ctor_type/2 and
polymorphism__typeclass_info_class_constraint/2, to ensure that
nobody tries to use the information in the type argument. Replace
them with two similar predicates that test if a type is type_info
or typeclass_info, but that don't return the argument.
Ensure that the new type_info_type_map in the rtti_varmaps is kept
up to date by threading the rtti_varmaps through a few more places.
Some of these places are exported, so this part of the change
affects other modules as well.
Fix a comment that referred to a non-existent predicate.
compiler/type_util.m:
Remove the predicates apply_substitutions_to_var_map/5 and
apply_substitutions_to_typeclass_var_map/5. The functionality
is now provided by the new ADT.
compiler/cse_detection.m:
Rewrite update_existential_data_structures/4 to use the interface
provided by rtti_varmaps. The algorithm for doing this has changed
in the following ways:
- The first pass, which builds a map from changed locations
in the first branch to the tvars concerned, is modified
slightly to traverse over the keys instead of over key-value
pairs.
- The second pass, which previously calculated the induced
type substitution and reconstructed the type_info_varmap
now only does the former.
- Applying the prog_var transformation and the induced type
substitution is done at the end, using the interface to
rtti_varmaps.
compiler/goal_util.m:
Rewrite goal_util__extra_nonlocal_typeinfos/6 to avoid the need
for using map__member/3 on the typeclass_info_varmap (about which
the existing comments say "this is probably not very efficient..."),
and to be more efficient in general.
Previously, we nondeterministically generated non-local type vars
and then tested each constraint to see if it had the type var in it.
Now, we go through each constraint one at a time and check if any of
the type variables in it are non-local. This is more efficient
because we only need to find one non-local type in order to include
the typeclass_info in the non-locals -- the remaining (duplicate)
solutions are pruned away.
compiler/higher_order.m:
Use the new maps instead of looking at the arguments of type_info/1
and typeclass_info/1 types. We plan to remove this information
from type_info and typeclass_info types in future.
Previously, this module used the type argument in order to update
the varmaps when the curried arguments of a higher order call are
added as arguments to the procedure in which the call occurs.
We now look up this information at the point where the curried arg
variables are known, and store this information in higher_order_arg
alongside the types where it used to be stored. This structure is
threaded through to the place where the information is needed.
Fix a cut and paste bug in higher_order_arg_depth/1. It was
previously calling higher_order_args_size/1 in the recursive
call, instead of calling higher_order_args_depth/1.
compiler/inlining.m:
In inlining__do_inline_call, apply the substitutions to the entire
rtti_varmaps structure, not just to the type_info_varmap. (XXX Is
there a good reason why the substitution should _not_ be applied
to the typeclass_info varmap?)
compiler/magic_util.m:
Avoid using polymorphism__type_info_or_ctor_type/2 and
polymorphism__typeclass_info_class_constraint/2, as these are
no longer supported.
compiler/*.m:
Straightforward changes to use the new ADT.
library/injection.m:
New library module. This provides an `injection' type which is
similar to the existing `bimap' type in that it implements
back-to-back maps, but doesn't have such stringent invariants
imposed. In particular, the reverse map is not required to be
innjective.
This type is used to model the relationship between prog_constraints
and program variables that hold typeclass_infos for them. Namely,
the typeclass_info for a constraint can be held in two different
variables, but one variable can never hold the typeclass_info for
two distinct constraints.
library/library.m:
Add the new library module.
library/list.m:
Add list__foldl_corresponding and list__foldl2_corresponding, which
traverse two lists in parallel, which one or two accumulators, and
abort if there is a length mismatch.
NEWS:
Mention the changes to the standard library.
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.379
diff -u -r1.379 NEWS
--- NEWS 11 Jul 2005 07:30:16 -0000 1.379
+++ NEWS 17 Jul 2005 12:00:30 -0000
@@ -7,6 +7,8 @@
details.
Changes to the Mercury standard library:
+* We have added an `injection' module, for reversible maps that are injective.
+* We have added list.foldl_corresponding/5 and list.foldl2_corresponding/7.
* We have added string.word_wrap/2.
Changes to the Mercury debugger:
Index: compiler/accumulator.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/accumulator.m,v
retrieving revision 1.37
diff -u -r1.37 accumulator.m
--- compiler/accumulator.m 24 Mar 2005 02:00:11 -0000 1.37
+++ compiler/accumulator.m 13 Jul 2005 08:36:31 -0000
@@ -1553,8 +1553,7 @@
proc_info_inferred_determinism(OrigProcInfo, Detism),
proc_info_goal(OrigProcInfo, Goal),
proc_info_context(OrigProcInfo, Context),
- proc_info_typeinfo_varmap(OrigProcInfo, TVarMap),
- proc_info_typeclass_info_varmap(OrigProcInfo, TCVarsMap),
+ proc_info_rtti_varmaps(OrigProcInfo, RttiVarMaps),
proc_info_is_address_taken(OrigProcInfo, IsAddressTaken),
Substs = substs(AccVarSubst, _RecCallSubst, _AssocCallSubst,
@@ -1579,9 +1578,9 @@
list__map(map__lookup(VarTypes), Accs, AccTypes),
- proc_info_create(Context, VarSet, VarTypes, HeadVars,
- InstVarSet, HeadModes, Detism, Goal, TVarMap, TCVarsMap,
- IsAddressTaken, AccProcInfo).
+ proc_info_create(Context, VarSet, VarTypes, HeadVars, InstVarSet,
+ HeadModes, Detism, Goal, RttiVarMaps, IsAddressTaken,
+ AccProcInfo).
%-----------------------------------------------------------------------------%
Index: compiler/clause_to_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/clause_to_proc.m,v
retrieving revision 1.47
diff -u -r1.47 clause_to_proc.m
--- compiler/clause_to_proc.m 23 May 2005 03:15:34 -0000 1.47
+++ compiler/clause_to_proc.m 11 Jul 2005 09:53:39 -0000
@@ -158,7 +158,7 @@
copy_clauses_to_proc(ProcId, ClausesInfo, !Proc) :-
ClausesInfo = clauses_info(VarSet0, _, _, VarTypes, HeadVars,
- ClausesRep, TI_VarMap, TCI_VarMap, _),
+ ClausesRep, RttiInfo, _),
get_clause_list(ClausesRep, Clauses),
select_matching_clauses(Clauses, ProcId, MatchingClauses),
get_clause_goals(MatchingClauses, GoalList),
@@ -220,8 +220,7 @@
Goal = disj(GoalList) - GoalInfo
),
- proc_info_set_body(VarSet, VarTypes, HeadVars, Goal,
- TI_VarMap, TCI_VarMap, !Proc).
+ proc_info_set_body(VarSet, VarTypes, HeadVars, Goal, RttiInfo, !Proc).
:- pred contains_nonpure_goal(list(hlds_goal)::in) is semidet.
Index: compiler/code_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_info.m,v
retrieving revision 1.300
diff -u -r1.300 code_info.m
--- compiler/code_info.m 10 Jun 2005 07:12:46 -0000 1.300
+++ compiler/code_info.m 13 Jul 2005 08:35:13 -0000
@@ -3532,9 +3532,9 @@
TypeInfoLiveness = code_info__body_typeinfo_liveness(CI),
code_info__get_proc_info(CI, ProcInfo),
proc_info_vartypes(ProcInfo, VarTypes),
- proc_info_typeinfo_varmap(ProcInfo, TVarMap),
+ proc_info_rtti_varmaps(ProcInfo, RttiVarMaps),
proc_info_maybe_complete_with_typeinfo_vars(Vars0, TypeInfoLiveness,
- VarTypes, TVarMap, Vars1),
+ VarTypes, RttiVarMaps, Vars1),
set__difference(Vars1, OutArgs, Vars),
set__to_sorted_list(Vars, Variables),
list__map(code_info__associate_stack_slot(CI), Variables, VarLocs).
Index: compiler/continuation_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/continuation_info.m,v
retrieving revision 1.59
diff -u -r1.59 continuation_info.m
--- compiler/continuation_info.m 1 Apr 2005 02:09:35 -0000 1.59
+++ compiler/continuation_info.m 13 Jul 2005 08:35:41 -0000
@@ -793,8 +793,9 @@
continuation_info__find_typeinfos_for_tvars(TypeVars, VarLocs, ProcInfo,
TypeInfoDataMap) :-
proc_info_varset(ProcInfo, VarSet),
- proc_info_typeinfo_varmap(ProcInfo, TypeInfoMap),
- map__apply_to_list(TypeVars, TypeInfoMap, TypeInfoLocns),
+ proc_info_rtti_varmaps(ProcInfo, RttiVarMaps),
+ list__map(rtti_lookup_type_info_locn(RttiVarMaps), TypeVars,
+ TypeInfoLocns),
FindLocn = (pred(TypeInfoLocn::in, Locns::out) is det :-
type_info_locn_var(TypeInfoLocn, TypeInfoVar),
(
@@ -863,8 +864,9 @@
continuation_info__find_typeinfos_for_tvars_table(TypeVars,
NumberedVars, ProcInfo, TypeInfoDataMap) :-
proc_info_varset(ProcInfo, VarSet),
- proc_info_typeinfo_varmap(ProcInfo, TypeInfoMap),
- map__apply_to_list(TypeVars, TypeInfoMap, TypeInfoLocns),
+ proc_info_rtti_varmaps(ProcInfo, RttiVarMaps),
+ list__map(rtti_lookup_type_info_locn(RttiVarMaps), TypeVars,
+ TypeInfoLocns),
FindLocn = (pred(TypeInfoLocn::in, Locn::out) is det :-
(
(
Index: compiler/cse_detection.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/cse_detection.m,v
retrieving revision 1.83
diff -u -r1.83 cse_detection.m
--- compiler/cse_detection.m 2 Apr 2005 17:10:01 -0000 1.83
+++ compiler/cse_detection.m 13 Jul 2005 07:27:06 -0000
@@ -61,6 +61,7 @@
:- import_module set.
:- import_module std_util.
:- import_module string.
+:- import_module svmap.
:- import_module term.
:- import_module varset.
@@ -146,8 +147,7 @@
---> cse_info(
varset :: prog_varset,
vartypes :: vartypes,
- type_info_varmap :: type_info_varmap,
- typeclass_info_varmap :: typeclass_info_varmap,
+ rtti_varmaps :: rtti_varmaps,
module_info :: module_info
).
@@ -168,10 +168,8 @@
proc_info_get_initial_instmap(ProcInfo0, ModuleInfo0, InstMap0),
proc_info_varset(ProcInfo0, Varset0),
proc_info_vartypes(ProcInfo0, VarTypes0),
- proc_info_typeinfo_varmap(ProcInfo0, TypeInfoVarMap0),
- proc_info_typeclass_info_varmap(ProcInfo0, TypeClassInfoVarMap0),
- CseInfo0 = cse_info(Varset0, VarTypes0,
- TypeInfoVarMap0, TypeClassInfoVarMap0, ModuleInfo0),
+ proc_info_rtti_varmaps(ProcInfo0, RttiVarMaps0),
+ CseInfo0 = cse_info(Varset0, VarTypes0, RttiVarMaps0, ModuleInfo0),
detect_cse_in_goal(Goal0, InstMap0, CseInfo0, CseInfo, Redo, Goal1),
(
@@ -181,8 +179,7 @@
Redo = yes,
% ModuleInfo should not be changed by detect_cse_in_goal
- CseInfo = cse_info(VarSet1, VarTypes1,
- TypeInfoVarMap, TypeClassInfoVarMap, _),
+ CseInfo = cse_info(VarSet1, VarTypes1, RttiVarMaps, _),
proc_info_headvars(ProcInfo0, HeadVars),
implicitly_quantify_clause_body(HeadVars, _Warnings,
@@ -191,10 +188,7 @@
proc_info_set_goal(Goal, ProcInfo0, ProcInfo1),
proc_info_set_varset(VarSet, ProcInfo1, ProcInfo2),
proc_info_set_vartypes(VarTypes, ProcInfo2, ProcInfo3),
- proc_info_set_typeinfo_varmap(TypeInfoVarMap,
- ProcInfo3, ProcInfo4),
- proc_info_set_typeclass_info_varmap(TypeClassInfoVarMap,
- ProcInfo4, ProcInfo),
+ proc_info_set_rtti_varmaps(RttiVarMaps, ProcInfo3, ProcInfo),
map__det_update(ProcTable0, ProcId, ProcInfo, ProcTable),
pred_info_set_procedures(ProcTable, PredInfo0, PredInfo),
@@ -772,99 +766,81 @@
update_existential_data_structures(FirstOldNew, LaterOldNews, !CseInfo) :-
list__condense(LaterOldNews, LaterOldNew),
- list__append(FirstOldNew, LaterOldNew, OldNew),
- map__from_assoc_list(OldNew, OldNewMap),
map__from_assoc_list(FirstOldNew, FirstOldNewMap),
+ map__from_assoc_list(LaterOldNew, LaterOldNewMap),
- TypeInfoVarMap0 = !.CseInfo ^ type_info_varmap,
- TypeClassInfoVarMap0 = !.CseInfo ^ typeclass_info_varmap,
+ RttiVarMaps0 = !.CseInfo ^ rtti_varmaps,
VarTypes0 = !.CseInfo ^ vartypes,
- map__to_assoc_list(TypeInfoVarMap0, TypeInfoVarList0),
- list__foldl(find_type_info_locn_tvar_map(FirstOldNewMap),
- TypeInfoVarList0, map__init, NewTvarMap),
-
- list__foldl2(reconstruct_type_info_varmap(OldNewMap, NewTvarMap),
- TypeInfoVarList0, map__init, TypeInfoVarMap1,
- map__init, TvarSub),
- map__keys(TvarSub, ElimTvars),
- map__delete_list(TypeInfoVarMap1, ElimTvars, TypeInfoVarMap),
-
- map__to_assoc_list(TypeClassInfoVarMap0, TypeClassInfoVarList0),
- list__foldl(reconstruct_typeclass_info_varmap(OldNewMap, TvarSub),
- TypeClassInfoVarList0, map__init, TypeClassInfoVarMap),
-
- map__map_values(apply_tvar_rename(TvarSub), VarTypes0, VarTypes),
+ % Build a map for all locations in the rtti_varmaps that are
+ % changed by the application of FirstOldNewMap. The keys
+ % of this map are the new locations, and the values are
+ % the tvars (from the first branch) that have had their
+ % locations moved.
+ %
+ rtti_varmaps_tvars(RttiVarMaps0, TvarsList),
+ list__foldl(find_type_info_locn_tvar_map(RttiVarMaps0, FirstOldNewMap),
+ TvarsList, map__init, NewTvarMap),
+
+ % Traverse TVarsList again, this time looking for locations
+ % in later branches that merge with locations in the first
+ % branch. When we find one, add a type substitution which
+ % represents the type variables that thus got merged.
+ %
+ list__foldl(find_merged_tvars(RttiVarMaps0, LaterOldNewMap, NewTvarMap),
+ TvarsList, map__init, TSubst),
+
+ % Apply the full old->new map and the type substitution
+ % to the rtti_varmaps, and apply the type substitution to the
+ % vartypes.
+ %
+ list__append(FirstOldNew, LaterOldNew, OldNew),
+ map__from_assoc_list(OldNew, OldNewMap),
+ apply_substitutions_to_rtti_varmaps(TSubst, map__init, OldNewMap,
+ RttiVarMaps0, RttiVarMaps),
+ map__map_values(apply_tvar_rename(TSubst), VarTypes0, VarTypes),
- !:CseInfo = !.CseInfo ^ type_info_varmap := TypeInfoVarMap,
- !:CseInfo = !.CseInfo ^ typeclass_info_varmap := TypeClassInfoVarMap,
+ !:CseInfo = !.CseInfo ^ rtti_varmaps := RttiVarMaps,
!:CseInfo = !.CseInfo ^ vartypes := VarTypes.
-:- pred apply_tvar_rename(map(tvar, tvar)::in, prog_var::in,
- (type)::in, (type)::out) is det.
+:- pred apply_tvar_rename(tsubst::in, prog_var::in, (type)::in, (type)::out)
+ is det.
-apply_tvar_rename(TvarSub, _Var, Type0, Type) :-
- Type = term__apply_variable_renaming(Type0, TvarSub).
+apply_tvar_rename(TSubst, _Var, Type0, Type) :-
+ Type = term__apply_substitution(Type0, TSubst).
-:- pred find_type_info_locn_tvar_map(map(prog_var, prog_var)::in,
- pair(tvar, type_info_locn)::in,
+:- pred find_type_info_locn_tvar_map(rtti_varmaps::in,
+ map(prog_var, prog_var)::in, tvar::in,
map(type_info_locn, tvar)::in, map(type_info_locn, tvar)::out) is det.
-find_type_info_locn_tvar_map(FirstOldNewMap, Tvar - TypeInfoLocn0,
- NewTvarMap0, NewTvarMap) :-
+find_type_info_locn_tvar_map(RttiVarMaps, FirstOldNewMap, Tvar, !NewTvarMap) :-
+ rtti_lookup_type_info_locn(RttiVarMaps, Tvar, TypeInfoLocn0),
type_info_locn_var(TypeInfoLocn0, Old),
( map__search(FirstOldNewMap, Old, New) ->
type_info_locn_set_var(New, TypeInfoLocn0, TypeInfoLocn),
- map__det_insert(NewTvarMap0, TypeInfoLocn, Tvar, NewTvarMap)
+ svmap__det_insert(TypeInfoLocn, Tvar, !NewTvarMap)
;
- NewTvarMap = NewTvarMap0
+ true
).
-:- pred reconstruct_type_info_varmap(map(prog_var, prog_var)::in,
- map(type_info_locn, tvar)::in, pair(tvar, type_info_locn)::in,
- map(tvar, type_info_locn)::in, map(tvar, type_info_locn)::out,
- map(tvar, tvar)::in, map(tvar, tvar)::out) is det.
+:- pred find_merged_tvars(rtti_varmaps::in, map(prog_var, prog_var)::in,
+ map(type_info_locn, tvar)::in, tvar::in, tsubst::in, tsubst::out)
+ is det.
-reconstruct_type_info_varmap(FirstOldNewMap, NewTvarMap, Tvar - TypeInfoLocn0,
- TypeInfoVarMap0, TypeInfoVarMap, TvarSub0, TvarSub) :-
+find_merged_tvars(RttiVarMaps, LaterOldNewMap, NewTvarMap, Tvar, !TSubst) :-
+ rtti_lookup_type_info_locn(RttiVarMaps, Tvar, TypeInfoLocn0),
type_info_locn_var(TypeInfoLocn0, Old),
- ( map__search(FirstOldNewMap, Old, New) ->
+ ( map__search(LaterOldNewMap, Old, New) ->
type_info_locn_set_var(New, TypeInfoLocn0, TypeInfoLocn),
- map__det_insert(TypeInfoVarMap0, Tvar, TypeInfoLocn,
- TypeInfoVarMap),
map__lookup(NewTvarMap, TypeInfoLocn, NewTvar),
- ( Tvar = NewTvar ->
- TvarSub = TvarSub0
+ ( NewTvar = Tvar ->
+ true
;
- map__det_insert(TvarSub0, Tvar, NewTvar, TvarSub)
+ svmap__det_insert(Tvar, term__variable(NewTvar),
+ !TSubst)
)
- ;
- map__det_insert(TypeInfoVarMap0, Tvar, TypeInfoLocn0,
- TypeInfoVarMap),
- TvarSub = TvarSub0
- ).
-
-:- pred reconstruct_typeclass_info_varmap(map(prog_var, 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) :-
- apply_variable_renaming_to_prog_constraint(TvarSub,
- Constraint0, Constraint),
- ( map__search(OldNewMap, TypeClassInfoVar0, TypeClassInfoVar1) ->
- TypeClassInfoVar = TypeClassInfoVar1
;
- TypeClassInfoVar = TypeClassInfoVar0
- ),
- ( map__search(TypeClassInfoVarMap0, Constraint, OldTypeClassInfoVar) ->
- require(unify(OldTypeClassInfoVar, TypeClassInfoVar),
- "reconstruct_typeclass_info_varmap: mismatch"),
- TypeClassInfoVarMap = TypeClassInfoVarMap0
- ;
- map__det_insert(TypeClassInfoVarMap0, Constraint,
- TypeClassInfoVar, TypeClassInfoVarMap)
+ true
).
%-----------------------------------------------------------------------------%
Index: compiler/deforest.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/deforest.m,v
retrieving revision 1.48
diff -u -r1.48 deforest.m
--- compiler/deforest.m 24 Mar 2005 05:34:00 -0000 1.48
+++ compiler/deforest.m 13 Jul 2005 08:37:05 -0000
@@ -1923,16 +1923,15 @@
pred_info_typevarset(PredInfo0, TypeVarSet0),
pred_info_get_univ_quant_tvars(PredInfo0, UnivQVars),
proc_info_vartypes(ProcInfo0, VarTypes0),
- proc_info_typeinfo_varmap(ProcInfo0, TypeInfoVarMap0),
+ proc_info_rtti_varmaps(ProcInfo0, RttiVarMaps0),
inlining__do_inline_call(UnivQVars, Args, CalledPredInfo,
CalledProcInfo, VarSet0, VarSet, VarTypes0, VarTypes,
- TypeVarSet0, TypeVarSet, TypeInfoVarMap0,
- TypeInfoVarMap, Goal1),
+ TypeVarSet0, TypeVarSet, RttiVarMaps0, RttiVarMaps,
+ Goal1),
pred_info_set_typevarset(TypeVarSet, PredInfo0, PredInfo),
proc_info_set_varset(VarSet, ProcInfo0, ProcInfo1),
proc_info_set_vartypes(VarTypes, ProcInfo1, ProcInfo2),
- proc_info_set_typeinfo_varmap(TypeInfoVarMap,
- ProcInfo2, ProcInfo),
+ proc_info_set_rtti_varmaps(RttiVarMaps, ProcInfo2, ProcInfo),
pd_info_set_pred_info(PredInfo, !PDInfo),
pd_info_set_proc_info(ProcInfo, !PDInfo),
Index: compiler/delay_construct.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/delay_construct.m,v
retrieving revision 1.10
diff -u -r1.10 delay_construct.m
--- compiler/delay_construct.m 24 Mar 2005 05:34:00 -0000 1.10
+++ compiler/delay_construct.m 13 Jul 2005 07:24:53 -0000
@@ -70,10 +70,10 @@
body_should_use_typeinfo_liveness(PredInfo, Globals,
BodyTypeinfoLiveness),
proc_info_vartypes(!.ProcInfo, VarTypes),
- proc_info_typeinfo_varmap(!.ProcInfo, TypeInfoVarMap),
+ proc_info_rtti_varmaps(!.ProcInfo, RttiVarMaps),
proc_info_get_initial_instmap(!.ProcInfo, ModuleInfo, InstMap0),
DelayInfo = delay_construct_info(ModuleInfo, BodyTypeinfoLiveness,
- VarTypes, TypeInfoVarMap),
+ VarTypes, RttiVarMaps),
proc_info_goal(!.ProcInfo, Goal0),
delay_construct_in_goal(Goal0, InstMap0, DelayInfo, Goal),
proc_info_set_goal(Goal, !ProcInfo).
@@ -83,7 +83,7 @@
module_info :: module_info,
body_typeinfo_liveness :: bool,
vartypes :: vartypes,
- type_info_varmap :: type_info_varmap
+ rtti_varmaps :: rtti_varmaps
).
%-----------------------------------------------------------------------------%
@@ -230,7 +230,7 @@
proc_info_maybe_complete_with_typeinfo_vars(NonLocals,
DelayInfo ^ body_typeinfo_liveness,
DelayInfo ^ vartypes,
- DelayInfo ^ type_info_varmap, CompletedNonLocals),
+ DelayInfo ^ rtti_varmaps, CompletedNonLocals),
set__intersect(CompletedNonLocals, ConstructedVars0,
Intersection),
set__empty(Intersection),
Index: compiler/dnf.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dnf.m,v
retrieving revision 1.59
diff -u -r1.59 dnf.m
--- compiler/dnf.m 1 Apr 2005 14:28:54 -0000 1.59
+++ compiler/dnf.m 13 Jul 2005 07:25:41 -0000
@@ -168,10 +168,9 @@
proc_info_varset(ProcInfo0, VarSet),
proc_info_inst_varset(ProcInfo0, InstVarSet),
proc_info_vartypes(ProcInfo0, VarTypes),
- proc_info_typeinfo_varmap(ProcInfo0, TVarMap),
- proc_info_typeclass_info_varmap(ProcInfo0, TCVarMap),
+ proc_info_rtti_varmaps(ProcInfo0, RttiVarMaps),
DnfInfo = dnf_info(PredId, Origin, PredName, TVarSet, VarTypes,
- ClassContext, VarSet, InstVarSet, Markers, TVarMap, TCVarMap,
+ ClassContext, VarSet, InstVarSet, Markers, RttiVarMaps,
Owner),
proc_info_get_initial_instmap(ProcInfo0, !.ModuleInfo, InstMap),
@@ -192,8 +191,7 @@
orig_varset :: prog_varset,
orig_instvarset :: inst_varset,
orig_markers :: pred_markers,
- orig_ti_locns :: map(tvar, type_info_locn),
- orig_tcis :: typeclass_info_varmap,
+ orig_rtti_varmaps :: rtti_varmaps,
orig_owner :: aditi_owner
).
@@ -390,7 +388,7 @@
dnf__define_new_pred(Origin, Goal0, Goal, InstMap0, PredName, DnfInfo,
!ModuleInfo, PredId) :-
DnfInfo = dnf_info(_, _, _, TVarSet, VarTypes, ClassContext, VarSet,
- InstVarSet, Markers, TVarMap, TCVarMap, Owner),
+ InstVarSet, Markers, RttiVarMaps, Owner),
Goal0 = _GoalExpr - GoalInfo,
goal_info_get_nonlocals(GoalInfo, NonLocals),
set__to_sorted_list(NonLocals, ArgVars),
@@ -398,7 +396,7 @@
% We could get rid of some constraints on variables
% that are not part of the goal.
hlds_pred__define_new_pred(Origin, Goal0, Goal, ArgVars, _, InstMap0,
- PredName, TVarSet, VarTypes, ClassContext, TVarMap, TCVarMap,
+ PredName, TVarSet, VarTypes, ClassContext, RttiVarMaps,
VarSet, InstVarSet, Markers, Owner, address_is_not_taken,
!ModuleInfo, PredProcId),
PredProcId = proc(PredId, _).
Index: compiler/equiv_type_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/equiv_type_hlds.m,v
retrieving revision 1.14
diff -u -r1.14 equiv_type_hlds.m
--- compiler/equiv_type_hlds.m 23 May 2005 02:16:44 -0000 1.14
+++ compiler/equiv_type_hlds.m 13 Jul 2005 08:37:37 -0000
@@ -47,6 +47,7 @@
:- import_module set.
:- import_module std_util.
:- import_module string.
+:- import_module svmap.
:- import_module term.
:- import_module varset.
@@ -348,16 +349,20 @@
VarTypes0, VarTypes, !TVarSet),
proc_info_set_vartypes(VarTypes, !ProcInfo),
- proc_info_typeclass_info_varmap(!.ProcInfo, TCVarMap0),
- map__to_assoc_list(TCVarMap0, TCVarAL0),
- list__map_foldl(
- (pred((Constraint0 - Locn)::in, (Constraint - Locn)::out,
+ proc_info_rtti_varmaps(!.ProcInfo, RttiVarMaps0),
+ rtti_varmaps_constraints(RttiVarMaps0, AllConstraints),
+ list__foldl2(
+ (pred(OldConstraint::in, !.CMap::in, !:CMap::out,
!.TVarSet::in, !:TVarSet::out) is det :-
equiv_type__replace_in_prog_constraint(EqvMap,
- Constraint0, Constraint, !TVarSet, no, _)
- ), TCVarAL0, TCVarAL, !TVarSet),
- map__from_assoc_list(TCVarAL, TCVarMap),
- proc_info_set_typeclass_info_varmap(TCVarMap, !ProcInfo),
+ OldConstraint, NewConstraint, !TVarSet, no, _),
+ svmap__set(OldConstraint, NewConstraint, !CMap)
+ ), AllConstraints, map__init, ConstraintMap, !TVarSet),
+ rtti_varmaps_transform_constraints(
+ (pred(!.Constraint::in, !:Constraint::out) is det :-
+ map__lookup(ConstraintMap, !Constraint)
+ ), RttiVarMaps0, RttiVarMaps),
+ proc_info_set_rtti_varmaps(RttiVarMaps, !ProcInfo),
proc_info_goal(!.ProcInfo, Goal0),
replace_in_goal(EqvMap, Goal0, Goal, Changed,
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.107
diff -u -r1.107 goal_util.m
--- compiler/goal_util.m 1 Jun 2005 04:02:17 -0000 1.107
+++ compiler/goal_util.m 13 Jul 2005 07:31:45 -0000
@@ -126,8 +126,8 @@
% i.e. a constraint which contrains an existentially quantified
% type variable.
%
-:- pred goal_util__extra_nonlocal_typeinfos(map(tvar, type_info_locn)::in,
- typeclass_info_varmap::in, map(prog_var, type)::in, existq_tvars::in,
+:- pred goal_util__extra_nonlocal_typeinfos(rtti_varmaps::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.
@@ -885,40 +885,49 @@
%-----------------------------------------------------------------------------%
-goal_util__extra_nonlocal_typeinfos(TypeVarMap, TypeClassVarMap, VarTypes,
- ExistQVars, NonLocals, NonLocalTypeInfos) :-
+goal_util__extra_nonlocal_typeinfos(RttiVarMaps, VarTypes, ExistQVars,
+ NonLocals, NonLocalTypeInfos) :-
+
+ % Find all non-local type vars. That is, type vars that are
+ % existentially quantified or type vars that appear in the
+ % type of a non-local prog_var.
+ %
set__to_sorted_list(NonLocals, NonLocalsList),
map__apply_to_list(NonLocalsList, VarTypes, NonLocalsTypes),
- term__vars_list(NonLocalsTypes, NonLocalTypeVars),
- % Find all the type-infos and typeclass-infos that are
- % non-local
+ term__vars_list(NonLocalsTypes, NonLocalTypeVarsList0),
+ list__append(ExistQVars, NonLocalTypeVarsList0, NonLocalTypeVarsList),
+ set__list_to_set(NonLocalTypeVarsList, NonLocalTypeVars),
+
+ % Find all the type_infos that are non-local, that is,
+ % type_infos for type vars that are non-local in the above
+ % sense.
+ %
+ TypeVarToProgVar = (func(TypeVar) = ProgVar :-
+ rtti_lookup_type_info_locn(RttiVarMaps, TypeVar, Locn),
+ type_info_locn_var(Locn, ProgVar)
+ ),
+ NonLocalTypeInfoVars = set__map(TypeVarToProgVar, NonLocalTypeVars),
+
+ % Find all the typeclass_infos that are non-local. These
+ % include all typeclass_infos that constrain a type variable
+ % that is non-local in the above sense.
+ %
solutions_set((pred(Var::out) is nondet :-
- %
- % if there is some TypeVar for which either
- % (a) the type of some non-local variable
- % depends on that type variable, or
- % (b) that type variable is existentially
- % quantified
- %
- ( list__member(TypeVar, NonLocalTypeVars)
- ; list__member(TypeVar, ExistQVars)
- ),
- %
- % then the type_info Var for that type,
- % and any type_class_info Vars which represent
- % constraints on types which include that type,
- % should be included in the NonLocalTypeInfos.
- %
- (
- map__search(TypeVarMap, TypeVar, Location),
- type_info_locn_var(Location, Var)
- ;
- % this is probably not very efficient...
- map__member(TypeClassVarMap, Constraint, Var),
- Constraint = constraint(_Name, ArgTypes),
- term__contains_var_list(ArgTypes, TypeVar)
- )
- ), NonLocalTypeInfos).
+ % Search through all arguments of all constraints.
+ rtti_varmaps_constraints(RttiVarMaps, Constraints),
+ list__member(Constraint, Constraints),
+ Constraint = constraint(_Name, ArgTypes),
+ term__contains_var_list(ArgTypes, TypeVar),
+ set__member(TypeVar, NonLocalTypeVars),
+
+ % We found a constraint that is non-local. Include
+ % the variable holding its typeclass_info.
+ rtti_lookup_typeclass_info_var(RttiVarMaps, Constraint,
+ Var)
+ ), NonLocalTypeClassInfoVars),
+
+ NonLocalTypeInfos = set__union(NonLocalTypeInfoVars,
+ NonLocalTypeClassInfoVars).
%-----------------------------------------------------------------------------%
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.128
diff -u -r1.128 higher_order.m
--- compiler/higher_order.m 23 May 2005 03:15:34 -0000 1.128
+++ compiler/higher_order.m 17 Jul 2005 08:55:17 -0000
@@ -273,6 +273,10 @@
% curried arguments in caller
hoa_curry_type_in_caller :: list(type),
% curried argument types in caller
+ hoa_curry_rtti_type :: list(rtti_var_info),
+ % types associated with type_infos
+ % and constraints associated with
+ % typeclass_infos in the arguments
hoa_known_curry_args :: list(higher_order_arg),
% higher-order curried arguments
% with known values
@@ -835,10 +839,9 @@
CallerProcInfo0 = !.Info ^ proc_info,
CallerPredInfo0 = !.Info ^ pred_info,
- proc_info_vartypes(CallerProcInfo0, VarTypes),
- map__lookup(VarTypes, PredVar, TypeClassInfoType),
- polymorphism__typeclass_info_class_constraint(
- TypeClassInfoType, ClassConstraint),
+ proc_info_rtti_varmaps(CallerProcInfo0, CallerRttiVarMaps),
+ rtti_varmaps_var_info(CallerRttiVarMaps, PredVar,
+ typeclass_info_var(ClassConstraint)),
ClassConstraint = constraint(ClassName, ClassArgs),
list__length(ClassArgs, ClassArity),
module_info_instances(ModuleInfo, InstanceTable),
@@ -1239,9 +1242,10 @@
CallerProcInfo0 = !.Info ^ proc_info,
proc_info_vartypes(CallerProcInfo0, VarTypes),
+ proc_info_rtti_varmaps(CallerProcInfo0, RttiVarMaps),
find_higher_order_args(ModuleInfo0, CalleeStatus, Args0,
- CalleeArgTypes, VarTypes, !.Info ^ pred_vars, 1, [],
- HigherOrderArgs0),
+ CalleeArgTypes, VarTypes, RttiVarMaps, !.Info ^ pred_vars, 1,
+ [], HigherOrderArgs0),
proc(CallerPredId, _) = !.Info ^ pred_proc_id,
module_info_type_spec_info(ModuleInfo0,
@@ -1331,15 +1335,15 @@
% a known value.
:- pred find_higher_order_args(module_info::in, import_status::in,
list(prog_var)::in, list(type)::in, map(prog_var, type)::in,
- pred_vars::in, int::in, list(higher_order_arg)::in,
+ rtti_varmaps::in, pred_vars::in, int::in, list(higher_order_arg)::in,
list(higher_order_arg)::out) is det.
-find_higher_order_args(_, _, [], _, _, _, _, !HOArgs).
-find_higher_order_args(_, _, [_|_], [], _, _, _, _, _) :-
+find_higher_order_args(_, _, [], _, _, _, _, _, !HOArgs).
+find_higher_order_args(_, _, [_|_], [], _, _, _, _, _, _) :-
error("find_higher_order_args: length mismatch").
find_higher_order_args(ModuleInfo, CalleeStatus, [Arg | Args],
- [CalleeArgType | CalleeArgTypes], VarTypes, PredVars, ArgNo,
- !HOArgs) :-
+ [CalleeArgType | CalleeArgTypes], VarTypes, RttiVarMaps,
+ PredVars, ArgNo, !HOArgs) :-
NextArg = ArgNo + 1,
(
% We don't specialize arguments whose declared type is
@@ -1368,6 +1372,8 @@
% Find any known higher-order arguments
% in the list of curried arguments.
map__apply_to_list(CurriedArgs, VarTypes, CurriedArgTypes),
+ list__map(rtti_varmaps_var_info(RttiVarMaps), CurriedArgs,
+ CurriedArgRttiInfo),
( ConsId = pred_const(ShroudedPredProcId, _) ->
proc(PredId, _) =
unshroud_pred_proc_id(ShroudedPredProcId),
@@ -1377,7 +1383,7 @@
CurriedCalleeArgTypes = CurriedArgTypes
),
find_higher_order_args(ModuleInfo, CalleeStatus, CurriedArgs,
- CurriedCalleeArgTypes, VarTypes,
+ CurriedCalleeArgTypes, VarTypes, RttiVarMaps,
PredVars, 1, [], HOCurriedArgs0),
list__reverse(HOCurriedArgs0, HOCurriedArgs),
list__length(CurriedArgs, NumArgs),
@@ -1385,8 +1391,7 @@
NumArgs = list__length(HOCurriedArgs),
\+ (
list__member(HOCurriedArg, HOCurriedArgs),
- HOCurriedArg = higher_order_arg(_, _, _,
- _, _, _, no)
+ HOCurriedArg ^ hoa_is_constant = no
)
->
IsConst = yes
@@ -1394,13 +1399,14 @@
IsConst = no
),
HOArg = higher_order_arg(ConsId, ArgNo, NumArgs,
- CurriedArgs, CurriedArgTypes, HOCurriedArgs, IsConst),
+ CurriedArgs, CurriedArgTypes, CurriedArgRttiInfo,
+ HOCurriedArgs, IsConst),
!:HOArgs = [HOArg | !.HOArgs]
;
true
),
find_higher_order_args(ModuleInfo, CalleeStatus, Args, CalleeArgTypes,
- VarTypes, PredVars, NextArg, !HOArgs).
+ VarTypes, RttiVarMaps, PredVars, NextArg, !HOArgs).
% Succeeds if the type substitution for a call makes any of
% the class constraints match an instance which was not matched
@@ -1554,7 +1560,7 @@
:- pred compute_extra_typeinfos(higher_order_info::in,
list(prog_var)::in, list(tvar)::out) is det.
-compute_extra_typeinfos(Info, Args1, ExtraTypeInfoTVars) :-
+compute_extra_typeinfos(Info, Args, ExtraTypeInfoTVars) :-
% Work out which type variables don't already have type-infos
% in the list of argument types.
% The list is in the order which the type variables occur
@@ -1566,43 +1572,48 @@
% sorted by variable number, which will vary between calls).
ProcInfo = Info ^ proc_info,
proc_info_vartypes(ProcInfo, VarTypes),
- map__apply_to_list(Args1, VarTypes, ArgTypes),
+ map__apply_to_list(Args, VarTypes, ArgTypes),
term__vars_list(ArgTypes, AllTVars),
(
AllTVars = [],
ExtraTypeInfoTVars = []
;
AllTVars = [_ | _],
- list__foldl(arg_type_contains_type_info_for_tvar, ArgTypes,
- [], TypeInfoTVars),
+ proc_info_rtti_varmaps(Info ^ proc_info, RttiVarMaps),
+ list__foldl(
+ arg_contains_type_info_for_tvar(RttiVarMaps),
+ Args, [], TypeInfoTVars),
list__delete_elems(AllTVars, TypeInfoTVars,
ExtraTypeInfoTVars0),
list__remove_dups(ExtraTypeInfoTVars0, ExtraTypeInfoTVars)
).
-:- pred arg_type_contains_type_info_for_tvar((type)::in,
+:- pred arg_contains_type_info_for_tvar(rtti_varmaps::in, prog_var::in,
list(tvar)::in, list(tvar)::out) is det.
-arg_type_contains_type_info_for_tvar(TypeInfoType, TVars0, TVars) :-
+arg_contains_type_info_for_tvar(RttiVarMaps, Var, !TVars) :-
+ rtti_varmaps_var_info(RttiVarMaps, Var, VarInfo),
(
- polymorphism__type_info_or_ctor_type(TypeInfoType, Type),
- Type = term__variable(TVar)
- ->
- TVars = [TVar | TVars0]
+ VarInfo = type_info_var(Type),
+ (
+ prog_type__var(Type, TVar)
+ ->
+ !:TVars = [TVar | !.TVars]
+ ;
+ true
+ )
;
- polymorphism__typeclass_info_class_constraint(TypeInfoType,
- Constraint),
- Constraint = constraint(_ClassName, ClassArgTypes)
- ->
+ VarInfo = typeclass_info_var(Constraint),
+ Constraint = constraint(_ClassName, ClassArgTypes),
% Find out which tvars the typeclass-info contains
% the type-infos for.
list__filter_map(
(pred(ClassArgType::in, ClassTVar::out) is semidet :-
- ClassArgType = term__variable(ClassTVar)
+ prog_type__var(ClassArgType, ClassTVar)
), ClassArgTypes, ClassTVars),
- list__append(ClassTVars, TVars0, TVars)
+ list__append(ClassTVars, !TVars)
;
- TVars = TVars0
+ VarInfo = non_rtti_var
).
:- pred construct_extra_type_infos(list(type)::in,
@@ -1726,28 +1737,29 @@
RequestArgs = [_ | _],
\+ (
list__member(RequestArg, RequestArgs),
- RequestArg = higher_order_arg(RequestConsId, _, _, _, _, _, _),
+ RequestConsId = RequestArg ^ hoa_cons_id,
RequestConsId = pred_const(_, _)
).
higher_order_args_match([RequestArg | Args1], [VersionArg | Args2],
Args, PartialMatch) :-
- RequestArg = higher_order_arg(ConsId1, ArgNo1, _, _, _, _,
+ RequestArg = higher_order_arg(ConsId1, ArgNo1, _, _, _, _, _,
RequestIsConst),
- VersionArg = higher_order_arg(ConsId2, ArgNo2, _, _, _, _,
+ VersionArg = higher_order_arg(ConsId2, ArgNo2, _, _, _, _, _,
VersionIsConst),
( ArgNo1 = ArgNo2 ->
ConsId1 = ConsId2,
RequestArg = higher_order_arg(_, _, NumArgs,
- CurriedArgs, CurriedArgTypes, HOCurriedArgs1, _),
+ CurriedArgs, CurriedArgTypes, CurriedArgRttiInfo,
+ HOCurriedArgs1, _),
VersionArg = higher_order_arg(_, _, NumArgs,
- _, _, HOCurriedArgs2, _),
+ _, _, _, HOCurriedArgs2, _),
higher_order_args_match(HOCurriedArgs1, HOCurriedArgs2,
NewHOCurriedArgs, PartialMatch),
higher_order_args_match(Args1, Args2, Args3, _),
NewRequestArg = higher_order_arg(ConsId1, ArgNo1, NumArgs,
- CurriedArgs, CurriedArgTypes, NewHOCurriedArgs,
- RequestIsConst `and` VersionIsConst),
+ CurriedArgs, CurriedArgTypes, CurriedArgRttiInfo,
+ NewHOCurriedArgs, RequestIsConst `and` VersionIsConst),
Args = [NewRequestArg | Args3]
;
% type-info arguments present in the request may be missing
@@ -1779,7 +1791,7 @@
get_extra_arguments_2([], []).
get_extra_arguments_2([HOArg | HOArgs], Args) :-
- HOArg = higher_order_arg(_, _, _, CurriedArgs0, _, HOCurriedArgs,
+ HOArg = higher_order_arg(_, _, _, CurriedArgs0, _, _, HOCurriedArgs,
IsConst),
(
IsConst = yes,
@@ -2519,15 +2531,14 @@
map__init(EmptyTVarNameMap),
map__init(EmptyProofs),
map__init(EmptyConstraintMap),
- map__init(EmptyTIMap),
- map__init(EmptyTCIMap),
+ rtti_varmaps_init(EmptyRttiVarMaps),
% This isn't looked at after here, and just clutters up
% hlds dumps if it's filled in.
set_clause_list([], ClausesRep),
ClausesInfo = clauses_info(EmptyVarSet, EmptyVarTypes,
EmptyTVarNameMap, EmptyVarTypes, [], ClausesRep,
- EmptyTIMap, EmptyTCIMap, no),
+ EmptyRttiVarMaps, no),
Origin = transformed(Transform, OrigOrigin, CallerPredId),
pred_info_init(PredModule, SymName, Arity, PredOrFunc, Context, Origin,
Status, GoalType, MarkerList, Types, ArgTVarSet, ExistQVars,
@@ -2593,8 +2604,8 @@
output_higher_order_args(_, _, _, [], !IO).
output_higher_order_args(ModuleInfo, NumToDrop, Indent, [HOArg | HOArgs],
!IO) :-
- HOArg = higher_order_arg(ConsId, ArgNo, NumArgs, _, _, CurriedHOArgs,
- IsConst),
+ HOArg = higher_order_arg(ConsId, ArgNo, NumArgs, _, _, _,
+ CurriedHOArgs, IsConst),
io__write_string("% ", !IO),
list__duplicate(Indent + 1, " ", Spaces),
list__foldl(io__write_string, Spaces, !IO),
@@ -2766,22 +2777,28 @@
% Add any extra type-infos or typeclass-infos we've added
% to the typeinfo_varmap and typeclass_info_varmap.
%
- proc_info_typeinfo_varmap(!.NewProcInfo, TypeInfoVarMap0),
+ proc_info_rtti_varmaps(!.NewProcInfo, RttiVarMaps0),
% The variable renaming doesn't rename variables in the callee.
map__init(EmptyVarRenaming),
- apply_substitutions_to_var_map(TypeInfoVarMap0, TypeRenaming,
- TypeSubn, EmptyVarRenaming, TypeInfoVarMap1),
+
+ apply_substitutions_to_rtti_varmaps(TypeRenaming, TypeSubn,
+ EmptyVarRenaming, RttiVarMaps0, RttiVarMaps1),
+
+ % XXX see below
% Add entries in the typeinfo_varmap for the extra type-infos.
- list__map(
- (pred(TypeInfoVar::in, type_info(TypeInfoVar)::out) is det),
- ExtraTypeInfoVars, ExtraTypeInfoLocns),
- map__from_corresponding_lists(ExtraTypeInfoTVars, ExtraTypeInfoLocns,
- ExtraTypeInfoMap),
- map__overlay(TypeInfoVarMap1, ExtraTypeInfoMap, TypeInfoVarMap),
+ list__foldl_corresponding(rtti_det_insert_type_info_type,
+ ExtraTypeInfoVars, ExtraTypeInfoTVarTypes,
+ RttiVarMaps1, RttiVarMaps2),
+ Pred = (pred(TVar::in, Var::in, !.R::in, !:R::out) is det :-
+ Locn = type_info(Var),
+ rtti_set_type_info_locn(TVar, Locn, !R)
+ ),
+ list__foldl_corresponding(Pred, ExtraTypeInfoTVars, ExtraTypeInfoVars,
+ RttiVarMaps2, RttiVarMaps),
- proc_info_set_typeinfo_varmap(TypeInfoVarMap, !NewProcInfo),
+ proc_info_set_rtti_varmaps(RttiVarMaps, !NewProcInfo),
map__from_corresponding_lists(CallArgs, HeadVars0, VarRenaming0),
@@ -2792,6 +2809,12 @@
ArgModes0, ExtraArgModes, HOArgs, !NewProcInfo,
VarRenaming0, _, PredVars0, PredVars, ConstGoals),
+ % XXX the substitutions used to be applied to the typeclass_info_varmap
+ % here rather than at the XXX above. Any new entries added in the code
+ % between these two points should therefore be transformed as well?
+ % The new entries come from HOArgs, which have already had TypeSubn
+ % applied, but not TypeRenaming. Perhaps this is enough?
+
%
% Record extra information about this version.
%
@@ -2890,20 +2913,14 @@
),
%
- % Apply the substitutions to the types in the original
- % typeclass_info_varmap.
- %
- proc_info_typeclass_info_varmap(!.NewProcInfo, TCVarMap0),
- apply_substitutions_to_typeclass_var_map(TCVarMap0, TypeRenaming,
- TypeSubn, EmptyVarRenaming, TCVarMap),
- proc_info_set_typeclass_info_varmap(TCVarMap, !NewProcInfo),
-
- %
% Find the new class context by searching the argument types
% for typeclass_infos (the corresponding constraint is encoded
% in the type of a typeclass_info).
%
- find_class_context(ModuleInfo, ArgTypes, ArgModes, [], [],
+ proc_info_headvars(!.NewProcInfo, ArgVars),
+ proc_info_rtti_varmaps(!.NewProcInfo, NewRttiVarMaps),
+ list__map(rtti_varmaps_var_info(NewRttiVarMaps), ArgVars, ArgVarInfos),
+ find_class_context(ModuleInfo, ArgVarInfos, ArgModes, [], [],
ClassContext),
pred_info_set_class_context(ClassContext, !NewPredInfo),
@@ -2950,7 +2967,8 @@
NewArgModes, [HOArg | HOArgs], !ProcInfo, !Renaming,
!PredVars, ConstGoals) :-
HOArg = higher_order_arg(ConsId, Index, NumArgs,
- CurriedArgs, CurriedArgTypes, CurriedHOArgs, IsConst),
+ CurriedArgs, CurriedArgTypes, CurriedArgRttiInfo,
+ CurriedHOArgs, IsConst),
list__index1_det(HeadVars0, Index, LVar),
( ConsId = pred_const(ShroudedPredProcId, _) ->
@@ -2981,10 +2999,11 @@
proc_info_create_vars_from_types(CurriedArgTypes, CurriedHeadVars1,
!ProcInfo),
- CurriedHeadVarsAndTypes = assoc_list__from_corresponding_lists(
- CurriedHeadVars1, CurriedArgTypes),
- list__foldl(add_rtti_info, CurriedHeadVarsAndTypes, !ProcInfo),
+ proc_info_rtti_varmaps(!.ProcInfo, RttiVarMaps0),
+ list__foldl_corresponding(add_rtti_info, CurriedHeadVars1,
+ CurriedArgRttiInfo, RttiVarMaps0, RttiVarMaps),
+ proc_info_set_rtti_varmaps(RttiVarMaps, !ProcInfo),
(
IsConst = no,
@@ -3054,53 +3073,65 @@
NewArgModes),
list__append(ConstGoals0, ConstGoals1, ConstGoals).
- % Add any new type-infos or typeclass-infos to the
- % typeinfo_varmap or typeclass_info_varmap.
-:- pred add_rtti_info(pair(prog_var, (type))::in,
- proc_info::in, proc_info::out) is det.
+ % Add any new type-infos or typeclass-infos to the rtti_varmaps.
+ %
+:- pred add_rtti_info(prog_var::in, rtti_var_info::in,
+ rtti_varmaps::in, rtti_varmaps::out) is det.
-add_rtti_info(Var - VarType, !ProcInfo) :-
+add_rtti_info(Var, VarInfo, !RttiVarMaps) :-
(
- polymorphism__type_info_or_ctor_type(VarType, Type),
- Type = term__variable(TVar)
- ->
- maybe_set_typeinfo_locn(TVar, type_info(Var), !ProcInfo)
+ VarInfo = type_info_var(TypeInfoType),
+ rtti_det_insert_type_info_type(Var, TypeInfoType,
+ !RttiVarMaps),
+ (
+ prog_type__var(TypeInfoType, TVar)
+ ->
+ maybe_set_typeinfo_locn(TVar, type_info(Var),
+ !RttiVarMaps)
+ ;
+ true
+ )
;
- polymorphism__typeclass_info_class_constraint(VarType,
- Constraint),
- proc_info_typeclass_info_varmap(!.ProcInfo, TCVarMap0),
- \+ map__contains(TCVarMap0, Constraint)
- ->
- map__det_insert(TCVarMap0, Constraint, Var, TCVarMap),
- proc_info_set_typeclass_info_varmap(TCVarMap, !ProcInfo),
- Constraint = constraint(_, ConstraintTypes),
- list__foldl2(update_type_info_locn(Var), ConstraintTypes,
- 1, _, !ProcInfo)
+ VarInfo = typeclass_info_var(Constraint),
+ (
+ \+ rtti_search_typeclass_info_var(!.RttiVarMaps,
+ Constraint, _)
+ ->
+ rtti_det_insert_typeclass_info_var(Constraint, Var,
+ !RttiVarMaps),
+ Constraint = constraint(_, ConstraintTypes),
+ list__foldl2(update_type_info_locn(Var),
+ ConstraintTypes, 1, _, !RttiVarMaps)
+ ;
+ true
+ )
;
- true
+ VarInfo = non_rtti_var
).
:- pred update_type_info_locn(prog_var::in, (type)::in, int::in, int::out,
- proc_info::in, proc_info::out) is det.
+ rtti_varmaps::in, rtti_varmaps::out) is det.
-update_type_info_locn(Var, ConstraintType, Index, Index + 1, !ProcInfo) :-
- ( ConstraintType = term__variable(ConstraintTVar) ->
+update_type_info_locn(Var, ConstraintType, Index, Index + 1, !RttiVarMaps) :-
+ (
+ prog_type__var(ConstraintType, ConstraintTVar)
+ ->
maybe_set_typeinfo_locn(ConstraintTVar,
- typeclass_info(Var, Index), !ProcInfo)
+ typeclass_info(Var, Index), !RttiVarMaps)
;
true
).
:- pred maybe_set_typeinfo_locn(tvar::in, type_info_locn::in,
- proc_info::in, proc_info::out) is det.
+ rtti_varmaps::in, rtti_varmaps::out) is det.
-maybe_set_typeinfo_locn(TVar, Locn, !ProcInfo) :-
- proc_info_typeinfo_varmap(!.ProcInfo, TVarMap0),
- ( map__contains(TVarMap0, TVar) ->
+maybe_set_typeinfo_locn(TVar, Locn, !RttiVarMaps) :-
+ (
+ rtti_search_type_info_locn(!.RttiVarMaps, TVar, _)
+ ->
true
;
- map__det_insert(TVarMap0, TVar, Locn, TVarMap),
- proc_info_set_typeinfo_varmap(TVarMap, !ProcInfo)
+ rtti_det_insert_type_info_locn(TVar, Locn, !RttiVarMaps)
).
:- pred remove_const_higher_order_args(int::in, list(T)::in,
@@ -3109,7 +3140,7 @@
remove_const_higher_order_args(_, [], _, []).
remove_const_higher_order_args(Index, [Arg | Args0], HOArgs0, Args) :-
( HOArgs0 = [HOArg | HOArgs] ->
- HOArg = higher_order_arg(_, HOIndex, _, _, _, _, IsConst),
+ HOArg = higher_order_arg(_, HOIndex, _, _, _, _, _, IsConst),
( HOIndex = Index ->
remove_const_higher_order_args(Index + 1, Args0,
HOArgs, Args1),
@@ -3141,14 +3172,28 @@
substitute_higher_order_arg(Subn, !HOArg) :-
CurriedArgTypes0 = !.HOArg ^ hoa_curry_type_in_caller,
+ CurriedRttiTypes0 = !.HOArg ^ hoa_curry_rtti_type,
CurriedHOArgs0 = !.HOArg ^ hoa_known_curry_args,
term__apply_rec_substitution_to_list(CurriedArgTypes0,
Subn, CurriedArgTypes),
+ list__map(substitute_rtti_var_info(Subn), CurriedRttiTypes0,
+ CurriedRttiTypes),
list__map(substitute_higher_order_arg(Subn),
CurriedHOArgs0, CurriedHOArgs),
- !:HOArg = (!.HOArg ^ hoa_curry_type_in_caller := CurriedArgTypes)
+ !:HOArg = ((!.HOArg ^ hoa_curry_type_in_caller := CurriedArgTypes)
+ ^ hoa_curry_rtti_type := CurriedRttiTypes)
^ hoa_known_curry_args := CurriedHOArgs.
+:- pred substitute_rtti_var_info(tsubst::in, rtti_var_info::in,
+ rtti_var_info::out) is det.
+
+substitute_rtti_var_info(Subn, type_info_var(Type0), type_info_var(Type)) :-
+ term__apply_rec_substitution(Type0, Subn, Type).
+substitute_rtti_var_info(Subn, typeclass_info_var(Constraint0),
+ typeclass_info_var(Constraint)) :-
+ apply_rec_subst_to_prog_constraint(Subn, Constraint0, Constraint).
+substitute_rtti_var_info(_, non_rtti_var, non_rtti_var).
+
%-----------------------------------------------------------------------------%
:- func higher_order_args_size(list(higher_order_arg)) = int.
@@ -3158,8 +3203,8 @@
:- func higher_order_arg_size(higher_order_arg) = int.
-higher_order_arg_size(higher_order_arg(_, _, _, _, _, CurriedArgs, _)) =
- 1 + higher_order_args_size(CurriedArgs).
+higher_order_arg_size(HOArg) =
+ 1 + higher_order_args_size(HOArg ^ hoa_known_curry_args).
:- func higher_order_args_depth(list(higher_order_arg)) = int.
@@ -3168,16 +3213,16 @@
:- func higher_order_arg_depth(higher_order_arg) = int.
-higher_order_arg_depth(higher_order_arg(_, _, _, _, _, CurriedArgs, _)) =
- 1 + higher_order_args_size(CurriedArgs).
+higher_order_arg_depth(HOArg) =
+ 1 + higher_order_args_depth(HOArg ^ hoa_known_curry_args).
%-----------------------------------------------------------------------------%
% 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(prog_constraint)::in, list(prog_constraint)::in,
+:- pred find_class_context(module_info::in, list(rtti_var_info)::in,
+ list(mode)::in, list(prog_constraint)::in, list(prog_constraint)::in,
prog_constraints::out) is det.
find_class_context(_, [], [], Univ0, Exist0, Constraints) :-
@@ -3188,9 +3233,11 @@
error("higher_order:find_class_context").
find_class_context(_, [_|_], [], _, _, _) :-
error("higher_order:find_class_context").
-find_class_context(ModuleInfo, [Type | Types], [Mode | Modes], !.Univ, !.Exist,
- Constraints) :-
- ( polymorphism__typeclass_info_class_constraint(Type, Constraint) ->
+find_class_context(ModuleInfo, [VarInfo | VarInfos], [Mode | Modes],
+ !.Univ, !.Exist, Constraints) :-
+ (
+ VarInfo = typeclass_info_var(Constraint)
+ ->
( mode_is_input(ModuleInfo, Mode) ->
maybe_add_constraint(Constraint, !Univ)
;
@@ -3199,7 +3246,7 @@
;
true
),
- find_class_context(ModuleInfo, Types, Modes, !.Univ, !.Exist,
+ find_class_context(ModuleInfo, VarInfos, Modes, !.Univ, !.Exist,
Constraints).
:- pred maybe_add_constraint(prog_constraint::in,
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.357
diff -u -r1.357 hlds_out.m
--- compiler/hlds_out.m 26 May 2005 00:17:01 -0000 1.357
+++ compiler/hlds_out.m 13 Jul 2005 08:32:50 -0000
@@ -953,7 +953,7 @@
true
),
ClausesInfo = clauses_info(VarSet, _, _, VarTypes, HeadVars,
- ClausesRep, TypeInfoMap, TypeClassInfoMap, _),
+ ClausesRep, RttiVarMaps, _),
( string__contains_char(Verbose, 'C') ->
hlds_out__write_indent(Indent, !IO),
io__write_string("% pred id: ", !IO),
@@ -976,10 +976,8 @@
hlds_out__write_marker_list(MarkerList, !IO),
io__write_string("\n", !IO)
),
- hlds_out__write_typeinfo_varmap(Indent, AppendVarNums,
- TypeInfoMap, VarSet, TVarSet, !IO),
- hlds_out__write_typeclass_info_varmap(Indent, AppendVarNums,
- TypeClassInfoMap, VarSet, TVarSet, !IO),
+ hlds_out__write_rtti_varmaps(Indent, AppendVarNums,
+ RttiVarMaps, VarSet, TVarSet, !IO),
( map__is_empty(Proofs) ->
true
;
@@ -3091,25 +3089,27 @@
hlds_out__write_var_types_2(Vars, Indent, VarSet, AppendVarNums,
VarTypes, TypeVarSet, !IO).
-:- pred hlds_out__write_typeinfo_varmap(int::in, bool::in,
- type_info_varmap::in, prog_varset::in, tvarset::in, io::di, io::uo)
- is det.
+:- pred hlds_out__write_rtti_varmaps(int::in, bool::in, rtti_varmaps::in,
+ prog_varset::in, tvarset::in, io::di, io::uo) is det.
-hlds_out__write_typeinfo_varmap(Indent, AppendVarNums, TypeInfoMap, VarSet,
- TVarSet, !IO) :-
+hlds_out__write_rtti_varmaps(Indent, AppendVarNums,
+ RttiVarMaps, VarSet, TVarSet, !IO) :-
hlds_out__write_indent(Indent, !IO),
io__write_string("% type_info varmap:\n", !IO),
- map__keys(TypeInfoMap, TypeVars),
- hlds_out__write_typeinfo_varmap_2(TypeVars, Indent, AppendVarNums,
- TypeInfoMap, VarSet, TVarSet, !IO).
+ rtti_varmaps_tvars(RttiVarMaps, TypeVars),
+ list__foldl(write_type_info_locn(Indent, AppendVarNums,
+ RttiVarMaps, VarSet, TVarSet), TypeVars, !IO),
+ hlds_out__write_indent(Indent, !IO),
+ io__write_string("% typeclass_info varmap:\n", !IO),
+ rtti_varmaps_constraints(RttiVarMaps, Constraints),
+ list__foldl(write_typeclass_info_var(Indent, AppendVarNums,
+ RttiVarMaps, VarSet, TVarSet), Constraints, !IO).
-:- pred hlds_out__write_typeinfo_varmap_2(list(tvar)::in, int::in, bool::in,
- type_info_varmap::in, prog_varset::in, tvarset::in,
- io::di, io::uo) is det.
+:- pred write_type_info_locn(int::in, bool::in, rtti_varmaps::in,
+ prog_varset::in, tvarset::in, tvar::in, io::di, io::uo) is det.
-hlds_out__write_typeinfo_varmap_2([], _, _, _, _, _, !IO).
-hlds_out__write_typeinfo_varmap_2([TVar | TVars], Indent, AppendVarNums,
- TypeInfoMap, VarSet, TVarSet, !IO) :-
+write_type_info_locn(Indent, AppendVarNums, RttiVarMaps, VarSet, TVarSet, TVar,
+ !IO) :-
hlds_out__write_indent(Indent, !IO),
io__write_string("% ", !IO),
@@ -3120,7 +3120,7 @@
io__write_string(")", !IO),
io__write_string(" -> ", !IO),
- map__lookup(TypeInfoMap, TVar, Locn),
+ rtti_lookup_type_info_locn(RttiVarMaps, TVar, Locn),
(
Locn = type_info(Var),
io__write_string("type_info(", !IO),
@@ -3138,32 +3138,19 @@
term__var_to_int(Var, VarNum),
io__write_int(VarNum, !IO),
io__write_string(")", !IO),
- io__write_string("\n", !IO),
-
- hlds_out__write_typeinfo_varmap_2(TVars, Indent, AppendVarNums,
- TypeInfoMap, VarSet, TVarSet, !IO).
-
-:- pred hlds_out__write_typeclass_info_varmap(int::in, bool::in,
- typeclass_info_varmap::in, prog_varset::in, tvarset::in,
- io::di, io::uo) is det.
-
-hlds_out__write_typeclass_info_varmap(Indent, AppendVarNums,
- TypeClassInfoVarMap, VarSet, TVarSet, !IO) :-
- hlds_out__write_indent(Indent, !IO),
- io__write_string("% typeclass_info varmap:\n", !IO),
- map__foldl(hlds_out__write_typeclass_info_varmap_2(Indent,
- AppendVarNums, VarSet, TVarSet), TypeClassInfoVarMap, !IO).
+ io__write_string("\n", !IO).
-:- pred hlds_out__write_typeclass_info_varmap_2(int::in, bool::in,
- prog_varset::in, tvarset::in, prog_constraint::in, prog_var::in,
- io::di, io::uo) is det.
+:- pred write_typeclass_info_var(int::in, bool::in, rtti_varmaps::in,
+ prog_varset::in, tvarset::in, prog_constraint::in, io::di, io::uo)
+ is det.
-hlds_out__write_typeclass_info_varmap_2(Indent, AppendVarNums, VarSet, TVarSet,
- Constraint, Var, !IO) :-
+write_typeclass_info_var(Indent, AppendVarNums, RttiVarMaps, VarSet, TVarSet,
+ Constraint, !IO) :-
hlds_out__write_indent(Indent, !IO),
io__write_string("% ", !IO),
mercury_output_constraint(TVarSet, AppendVarNums, Constraint, !IO),
io__write_string(" -> ", !IO),
+ rtti_lookup_typeclass_info_var(RttiVarMaps, Constraint, Var),
mercury_output_var(Var, VarSet, AppendVarNums, !IO),
io__nl(!IO).
@@ -3708,8 +3695,7 @@
proc_info_context(Proc, ModeContext),
proc_info_get_maybe_arg_size_info(Proc, MaybeArgSize),
proc_info_get_maybe_termination_info(Proc, MaybeTermination),
- proc_info_typeinfo_varmap(Proc, TypeInfoMap),
- proc_info_typeclass_info_varmap(Proc, TypeClassInfoMap),
+ proc_info_rtti_varmaps(Proc, RttiVarMaps),
proc_info_eval_method(Proc, EvalMethod),
proc_info_is_address_taken(Proc, IsAddressTaken),
proc_info_get_call_table_tip(Proc, MaybeCallTableTip),
@@ -3749,10 +3735,8 @@
hlds_out__write_indent(Indent, !IO),
hlds_out__write_var_types(Indent, VarSet, AppendVarNums,
VarTypes, TVarSet, !IO),
- hlds_out__write_typeinfo_varmap(Indent, AppendVarNums, TypeInfoMap,
+ hlds_out__write_rtti_varmaps(Indent, AppendVarNums, RttiVarMaps,
VarSet, TVarSet, !IO),
- hlds_out__write_typeclass_info_varmap(Indent, AppendVarNums,
- TypeClassInfoMap, VarSet, TVarSet, !IO),
(
IsAddressTaken = address_is_taken,
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.165
diff -u -r1.165 hlds_pred.m
--- compiler/hlds_pred.m 8 Jul 2005 04:22:02 -0000 1.165
+++ compiler/hlds_pred.m 13 Jul 2005 10:47:29 -0000
@@ -39,6 +39,7 @@
:- implementation.
% Parse tree modules.
+:- import_module parse_tree__prog_type.
:- import_module parse_tree__prog_util.
% HLDS modules.
@@ -53,9 +54,11 @@
:- import_module libs__options.
% Standard library modules.
+:- import_module injection.
:- import_module int.
:- import_module require.
:- import_module string.
+:- import_module svmap.
:- import_module term.
:- import_module varset.
@@ -189,6 +192,471 @@
%-----------------------------------------------------------------------------%
+ % Types and predicates to store information about RTTI.
+
+ % 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
+ % which they will be passed in by do_call_class_method.
+ %
+:- type instance_method_constraints
+ ---> instance_method_constraints(
+ class_id,
+ list(type), % The types in the head of the
+ % instance declaration.
+ list(prog_constraint), % The universal constraints
+ % on the instance declaration.
+ prog_constraints % The contraints on the method's
+ % type declaration in the
+ % `:- typeclass' declaration.
+ ).
+
+ % A type_info_locn specifies how to access a type_info.
+ %
+:- type type_info_locn
+ ---> type_info(prog_var)
+ % It is a normal type_info, i.e. the type
+ % is not constrained.
+
+ ; typeclass_info(prog_var, int).
+ % The type_info is packed inside a
+ % typeclass_info. If the int is N, it is
+ % the Nth type_info inside the typeclass_info,
+ % but there may be several superclass pointers
+ % before the block of type_infos, so it won't
+ % be the Nth word of the typeclass_info.
+ %
+ % To find the type_info inside the
+ % typeclass_info, use the predicate
+ % type_info_from_typeclass_info from Mercury
+ % code; from C code use the macro
+ % MR_typeclass_info_superclass_info.
+
+ % type_info_locn_var(TypeInfoLocn, Var):
+ %
+ % Var is the variable corresponding to the TypeInfoLocn. Note
+ % that this does *not* mean that Var is a type_info; it may be
+ % a typeclass_info in which the type_info is nested.
+ %
+:- pred type_info_locn_var(type_info_locn::in, prog_var::out) is det.
+
+:- pred type_info_locn_set_var(prog_var::in,
+ type_info_locn::in, type_info_locn::out) is det.
+
+ % This type describes the contents of a prog_var.
+ %
+:- type rtti_var_info
+ ---> type_info_var(type)
+ % The variable holds a type_info for the given type.
+
+ ; typeclass_info_var(prog_constraint)
+ % The variable holds a typeclass_info for the given
+ % constraint.
+
+ ; non_rtti_var.
+ % The variable does not directly hold any run time
+ % type information.
+
+ % This records information about how type_infos and typeclass_infos
+ % were introduced in the polymorphism transformation.
+ %
+:- type rtti_varmaps.
+
+ % Returns an empty rtti_varmaps structure.
+ %
+:- pred rtti_varmaps_init(rtti_varmaps::out) is det.
+
+ % Succeeds iff the rtti_varmaps contain no information about any
+ % type variables.
+ %
+:- pred rtti_varmaps_no_tvars(rtti_varmaps::in) is semidet.
+
+ % Find the location of a type_info.
+ %
+:- pred rtti_lookup_type_info_locn(rtti_varmaps::in, tvar::in,
+ type_info_locn::out) is det.
+
+ % Find the location of a type_info, if it is known.
+ %
+:- pred rtti_search_type_info_locn(rtti_varmaps::in, tvar::in,
+ type_info_locn::out) is semidet.
+
+ % Find the prog_var which contains the typeclass_info for a given
+ % constraint.
+ %
+:- pred rtti_lookup_typeclass_info_var(rtti_varmaps::in, prog_constraint::in,
+ prog_var::out) is det.
+
+ % Find the prog_var which contains the typeclass_info for a given
+ % constraint, if it is known.
+ %
+:- pred rtti_search_typeclass_info_var(rtti_varmaps::in, prog_constraint::in,
+ prog_var::out) is semidet.
+
+ % Find what RTTI, if any, is stored in a prog_var.
+ %
+:- pred rtti_varmaps_var_info(rtti_varmaps::in, prog_var::in,
+ rtti_var_info::out) is det.
+
+ % Insert the location of a type_info. Abort if such information
+ % already exists.
+ %
+:- pred rtti_det_insert_type_info_locn(tvar::in, type_info_locn::in,
+ rtti_varmaps::in, rtti_varmaps::out) is det.
+
+ % Set the location of a type_info, overwriting any previous
+ % information.
+ %
+:- pred rtti_set_type_info_locn(tvar::in, type_info_locn::in,
+ rtti_varmaps::in, rtti_varmaps::out) is det.
+
+ % Insert the prog_var which contains the typeclass_info for a
+ % given constraint. Abort if such information already exists.
+ %
+:- pred rtti_det_insert_typeclass_info_var(prog_constraint::in, prog_var::in,
+ rtti_varmaps::in, rtti_varmaps::out) is det.
+
+ % Set the prog_var which contains the typeclass_info for a given
+ % constraint, overwriting any previous information.
+ %
+:- pred rtti_set_typeclass_info_var(prog_constraint::in, prog_var::in,
+ rtti_varmaps::in, rtti_varmaps::out) is det.
+
+ % For a prog_var which holds a type_info, set the type that the
+ % type_info is for. Abort if such information already exists.
+ %
+:- pred rtti_det_insert_type_info_type(prog_var::in, (type)::in,
+ rtti_varmaps::in, rtti_varmaps::out) is det.
+
+ % Returns all of the tvars that we have information about in the
+ % rtti_varmaps structure.
+ %
+:- pred rtti_varmaps_tvars(rtti_varmaps::in, list(tvar)::out) is det.
+
+ % Returns all of the prog_constraints that we have information
+ % about in the rtti_varmaps structure.
+ %
+:- pred rtti_varmaps_constraints(rtti_varmaps::in, list(prog_constraint)::out)
+ is det.
+
+ % apply_substitutions_to_rtti_varmaps(TRenaming, TSubst, Subst,
+ % !RttiVarMaps)
+ %
+ % Apply substitutions to the rtti_varmaps data. TRenaming is applied
+ % to all types first, then TSubst is applied to all types. Subst
+ % is applied to all prog_vars.
+ %
+:- pred apply_substitutions_to_rtti_varmaps(tsubst::in, tsubst::in,
+ map(prog_var, prog_var)::in, rtti_varmaps::in, rtti_varmaps::out)
+ is det.
+
+ % rtti_varmaps_transform_constraints(Pred, !RttiVarMaps)
+ %
+ % Apply the transformation predicate to every constraint appearing
+ % in the rtti_varmaps structure.
+ %
+:- pred rtti_varmaps_transform_constraints(
+ pred(prog_constraint, prog_constraint)::in(pred(in, out) is det),
+ rtti_varmaps::in, rtti_varmaps::out) is det.
+
+ % rtti_varmaps_overlay(A, B, C)
+ %
+ % Merge the information in rtti_varmaps A and B to produce C. Where
+ % information conflicts, use the information in B rather than A.
+ %
+:- pred rtti_varmaps_overlay(rtti_varmaps::in, rtti_varmaps::in,
+ rtti_varmaps::out) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+type_info_locn_var(type_info(Var), Var).
+type_info_locn_var(typeclass_info(Var, _), Var).
+
+type_info_locn_set_var(Var, type_info(_), type_info(Var)).
+type_info_locn_set_var(Var, typeclass_info(_, Num), typeclass_info(Var, Num)).
+
+:- type rtti_varmaps
+ ---> rtti_varmaps(
+ tci_varmap :: typeclass_info_varmap,
+ ti_varmap :: type_info_varmap,
+ ti_type_map :: type_info_type_map
+ ).
+
+ % A typeclass_info_varmap is a map which for each type class constraint
+ % records which variable contains the typeclass_info for that
+ % constraint. The map is reversible in the sense that we can
+ % efficiently look up which constraint, if any, has its
+ % typeclass_info stored in a given prog_var.
+ %
+:- type typeclass_info_varmap == injection(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.
+ %
+ % XXX this doesn't record the information that we want. For a
+ % constraint such as foo(list(T)) we can't properly record the
+ % location of the type_info for T, since it does not occupy a slot
+ % in the typeclass_info directly, but is inside the type_info for
+ % list(T).
+ %
+:- type type_info_varmap == map(tvar, type_info_locn).
+
+ % Every program variable which holds a type_info is a key in this
+ % map. The value associated with a given key is the type that the
+ % type_info is for.
+ %
+:- type type_info_type_map == map(prog_var, type).
+
+rtti_varmaps_init(rtti_varmaps(TCIMap, TIMap, TypeMap)) :-
+ injection__init(TCIMap),
+ map__init(TIMap),
+ map__init(TypeMap).
+
+rtti_varmaps_no_tvars(VarMaps) :-
+ map__is_empty(VarMaps ^ ti_varmap).
+
+rtti_lookup_type_info_locn(VarMaps, TVar, Locn) :-
+ map__lookup(VarMaps ^ ti_varmap, TVar, Locn).
+
+rtti_search_type_info_locn(VarMaps, TVar, Locn) :-
+ map__search(VarMaps ^ ti_varmap, TVar, Locn).
+
+rtti_lookup_typeclass_info_var(VarMaps, Constraint, ProgVar) :-
+ injection__lookup(VarMaps ^ tci_varmap, Constraint, ProgVar).
+
+rtti_search_typeclass_info_var(VarMaps, Constraint, ProgVar) :-
+ injection__forward_search(VarMaps ^ tci_varmap, Constraint, ProgVar).
+
+rtti_varmaps_var_info(VarMaps, Var, VarInfo) :-
+ (
+ map__search(VarMaps ^ ti_type_map, Var, Type)
+ ->
+ VarInfo = type_info_var(Type)
+ ;
+ injection__reverse_search(VarMaps ^ tci_varmap, Constraint,
+ Var)
+ ->
+ VarInfo = typeclass_info_var(Constraint)
+ ;
+ VarInfo = non_rtti_var
+ ).
+
+rtti_det_insert_type_info_locn(TVar, Locn, !VarMaps) :-
+ Map0 = !.VarMaps ^ ti_varmap,
+ map__det_insert(Map0, TVar, Locn, Map),
+ !:VarMaps = !.VarMaps ^ ti_varmap := Map,
+ maybe_check_type_info_var(Locn, TVar, !VarMaps).
+
+rtti_set_type_info_locn(TVar, Locn, !VarMaps) :-
+ Map0 = !.VarMaps ^ ti_varmap,
+ map__set(Map0, TVar, Locn, Map),
+ !:VarMaps = !.VarMaps ^ ti_varmap := Map,
+ maybe_check_type_info_var(Locn, TVar, !VarMaps).
+
+:- pred maybe_check_type_info_var(type_info_locn::in, tvar::in,
+ rtti_varmaps::in, rtti_varmaps::out) is det.
+
+maybe_check_type_info_var(type_info(Var), TVar, !VarMaps) :-
+ (
+ map__search(!.VarMaps ^ ti_type_map, Var, Type)
+ ->
+ (
+ Type = term__variable(TVar)
+ ->
+ true
+ ;
+ error("maybe_check_type_info_var: inconsistent info")
+ )
+ ;
+ error("maybe_check_type_info_var: missing info")
+ ).
+maybe_check_type_info_var(typeclass_info(_, _), _, !VarMaps).
+
+rtti_det_insert_typeclass_info_var(Constraint, ProgVar, !VarMaps) :-
+ Map0 = !.VarMaps ^ tci_varmap,
+ injection__det_insert(Map0, Constraint, ProgVar, Map),
+ !:VarMaps = !.VarMaps ^ tci_varmap := Map.
+
+rtti_set_typeclass_info_var(Constraint, ProgVar, !VarMaps) :-
+ Map0 = !.VarMaps ^ tci_varmap,
+ injection__det_set(Map0, Constraint, ProgVar, Map),
+ !:VarMaps = !.VarMaps ^ tci_varmap := Map.
+
+rtti_det_insert_type_info_type(ProgVar, Type, !VarMaps) :-
+ Map0 = !.VarMaps ^ ti_type_map,
+ map__det_insert(Map0, ProgVar, Type, Map),
+ !:VarMaps = !.VarMaps ^ ti_type_map := Map.
+
+rtti_varmaps_tvars(VarMaps, TVars) :-
+ map__keys(VarMaps ^ ti_varmap, TVars).
+
+rtti_varmaps_constraints(VarMaps, Constraints) :-
+ injection__keys(VarMaps ^ tci_varmap, Constraints).
+
+apply_substitutions_to_rtti_varmaps(TRenaming, TSubst, Subst, !RttiVarMaps) :-
+ (
+ % Optimize the simple case.
+ map__is_empty(Subst),
+ map__is_empty(TSubst),
+ map__is_empty(TRenaming)
+ ->
+ true
+ ;
+ !.RttiVarMaps = rtti_varmaps(TCIMap0, TIMap0, TypeMap0),
+ apply_substitutions_to_typeclass_var_map(TRenaming, TSubst,
+ Subst, TCIMap0, TCIMap),
+ apply_substitutions_to_var_map(TRenaming, TSubst, Subst,
+ TIMap0, TIMap),
+ apply_substitutions_to_type_map(TRenaming, TSubst, Subst,
+ TypeMap0, TypeMap),
+ !:RttiVarMaps = rtti_varmaps(TCIMap, TIMap, TypeMap)
+ ).
+
+ % Update a map from prog_constraint to var, using the type renaming
+ % and substitution to rename tvars and a variable substition to
+ % rename vars. The type renaming is applied before the type
+ % substitution.
+ %
+:- pred apply_substitutions_to_typeclass_var_map(tsubst::in, tsubst::in,
+ map(prog_var, prog_var)::in,
+ typeclass_info_varmap::in, typeclass_info_varmap::out) is det.
+
+apply_substitutions_to_typeclass_var_map(TRenaming, TSubst, Subst, !VarMap) :-
+
+ % Note that the transformation on keys must be done before
+ % the transformation on values. If the values are transformed
+ % first then the invariants on the data structure may be
+ % violated.
+ %
+ injection.map_keys(
+ apply_substitutions_to_tc_varmap_keys(TRenaming, TSubst),
+ !VarMap),
+ injection.map_values(apply_renaming_to_tc_varmap_values(Subst),
+ !VarMap).
+
+:- pred apply_substitutions_to_tc_varmap_keys(tsubst::in, tsubst::in,
+ prog_var::in, prog_constraint::in, prog_constraint::out) is det.
+
+apply_substitutions_to_tc_varmap_keys(TRenaming, TSubst, _Var, !Constraint) :-
+ apply_subst_to_prog_constraint(TRenaming, !Constraint),
+ apply_rec_subst_to_prog_constraint(TSubst, !Constraint).
+
+:- pred apply_renaming_to_tc_varmap_values(map(prog_var, prog_var)::in,
+ prog_constraint::in, prog_var::in, prog_var::out) is det.
+
+apply_renaming_to_tc_varmap_values(Subst, _Constraint, Var0, Var) :-
+ ( map__search(Subst, Var0, Var1) ->
+ Var = Var1
+ ;
+ Var = Var0
+ ).
+
+ % Update a map from tvar to type_info_locn, using the type renaming
+ % and substitution to rename tvars and a variable substitution to
+ % rename vars. The type renaming is applied before the type
+ % substitution.
+ %
+ % If tvar maps to a another type variable, we keep the new
+ % variable, if it maps to a type, we remove it from the map.
+ %
+:- pred apply_substitutions_to_var_map(tsubst::in, tsubst::in,
+ map(prog_var, prog_var)::in,
+ type_info_varmap::in, type_info_varmap::out) is det.
+
+apply_substitutions_to_var_map(TRenaming, TSubst, Subst, VarMap0, VarMap) :-
+ map__foldl(apply_substitutions_to_var_map_2(TRenaming, TSubst, Subst),
+ VarMap0, map__init, VarMap).
+
+:- pred apply_substitutions_to_var_map_2(tsubst::in, tsubst::in,
+ map(prog_var, prog_var)::in, tvar::in, type_info_locn::in,
+ type_info_varmap::in, type_info_varmap::out) is det.
+
+apply_substitutions_to_var_map_2(TRenaming, TSubst, Subst, TVar, Locn,
+ !NewVarMap) :-
+ type_info_locn_var(Locn, Var),
+ (
+ % Find the new var, if there is one.
+ map__search(Subst, Var, NewVar0)
+ ->
+ NewVar = NewVar0
+ ;
+ NewVar = Var
+ ),
+ type_info_locn_set_var(NewVar, Locn, NewLocn),
+ (
+ % Find the new tvar, if there is one.
+ map__search(TRenaming, TVar, NewTVarType0)
+ ->
+ NewTVarType1 = NewTVarType0
+ ;
+ % The variable wasn't renamed.
+ NewTVarType1 = term__variable(TVar)
+ ),
+ term__apply_rec_substitution(NewTVarType1, TSubst, NewTVarType),
+
+ (
+ % If the tvar is still a variable, insert it into the
+ % map with the new var.
+ prog_type__var(NewTVarType, NewTVar)
+ ->
+ % Don't abort if two old type variables
+ % map to the same new type variable.
+ svmap__set(NewTVar, NewLocn, !NewVarMap)
+ ;
+ true
+ ).
+
+:- pred apply_substitutions_to_type_map(tsubst::in, tsubst::in,
+ map(prog_var, prog_var)::in,
+ type_info_type_map::in, type_info_type_map::out) is det.
+
+apply_substitutions_to_type_map(TRenaming, TSubst, Subst, TypeMap0, TypeMap) :-
+ map__foldl(apply_substitutions_to_type_map_2(TRenaming, TSubst, Subst),
+ TypeMap0, map__init, TypeMap).
+
+:- pred apply_substitutions_to_type_map_2(tsubst::in, tsubst::in,
+ map(prog_var, prog_var)::in, prog_var::in, (type)::in,
+ type_info_type_map::in, type_info_type_map::out) is det.
+
+apply_substitutions_to_type_map_2(TRenaming, TSubst, Subst, Var0, Type0,
+ !TypeMap) :-
+ term__apply_substitution(Type0, TRenaming, Type1),
+ term__apply_rec_substitution(Type1, TSubst, Type),
+ ( map__search(Subst, Var0, Var1) ->
+ Var = Var1
+ ;
+ Var = Var0
+ ),
+ svmap__set(Var, Type, !TypeMap).
+
+rtti_varmaps_transform_constraints(Pred, !RttiVarMaps) :-
+ Map0 = !.RttiVarMaps ^ tci_varmap,
+ Pred2 = (pred(_::in, !.C::in, !:C::out) is det :- Pred(!C)),
+ injection__map_keys(Pred2, Map0, Map),
+ !:RttiVarMaps = !.RttiVarMaps ^ tci_varmap := Map.
+
+rtti_varmaps_overlay(VarMapsA, VarMapsB, VarMaps) :-
+ VarMapsA = rtti_varmaps(TCImapA, TImapA, TypeMapA),
+ VarMapsB = rtti_varmaps(TCImapB, TImapB, TypeMapB),
+
+ % Prefer VarMapsB for this information.
+ %
+ injection__overlay(TCImapA, TCImapB, TCImap),
+ map__overlay(TImapA, TImapB, TImap),
+
+ % On the other hand, we insist that this information is
+ % consistent.
+ %
+ map__merge(TypeMapA, TypeMapB, TypeMap),
+
+ VarMaps = rtti_varmaps(TCImap, TImap, TypeMap).
+
+%-----------------------------------------------------------------------------%
+
+:- interface.
+
% The clauses_info structure contains the clauses for a predicate
% after conversion from the item_list by make_hlds.m.
% Typechecking is performed on the clauses info, then the clauses
@@ -220,11 +688,9 @@
headvars :: list(prog_var),
% head vars
clauses_rep :: clauses_rep,
- % the following two
- % fields are computed
- % by polymorphism.m
- clause_type_info_varmap :: type_info_varmap,
- clause_typeclass_info_varmap :: typeclass_info_varmap,
+ % the following field is
+ % computed by polymorphism.m
+ clauses_rtti_varmaps :: rtti_varmaps,
have_foreign_clauses :: bool
% do we have foreign
% language clauses?
@@ -270,11 +736,7 @@
%
:- pred clauses_info_vartypes(clauses_info::in, vartypes::out) is det.
-:- pred clauses_info_type_info_varmap(clauses_info::in, type_info_varmap::out)
- is det.
-
-:- pred clauses_info_typeclass_info_varmap(clauses_info::in,
- typeclass_info_varmap::out) is det.
+:- pred clauses_info_rtti_varmaps(clauses_info::in, rtti_varmaps::out) is det.
:- pred clauses_info_headvars(clauses_info::in, list(prog_var)::out) is det.
@@ -314,10 +776,7 @@
:- pred clauses_info_set_vartypes(vartypes::in,
clauses_info::in, clauses_info::out) is det.
-:- pred clauses_info_set_type_info_varmap(type_info_varmap::in,
- clauses_info::in, clauses_info::out) is det.
-
-:- pred clauses_info_set_typeclass_info_varmap(typeclass_info_varmap::in,
+:- pred clauses_info_set_rtti_varmaps(rtti_varmaps::in,
clauses_info::in, clauses_info::out) is det.
:- type clause --->
@@ -340,8 +799,7 @@
clauses_info_vartypes(CI, CI ^ vartypes).
clauses_info_headvars(CI, CI ^ headvars).
clauses_info_clauses_rep(CI, CI ^ clauses_rep).
-clauses_info_type_info_varmap(CI, CI ^ clause_type_info_varmap).
-clauses_info_typeclass_info_varmap(CI, CI ^ clause_typeclass_info_varmap).
+clauses_info_rtti_varmaps(CI, CI ^ clauses_rtti_varmaps).
clauses_info_set_varset(X, CI, CI ^ varset := X).
clauses_info_set_explicit_vartypes(X, CI, CI ^ explicit_vartypes := X).
@@ -349,9 +807,7 @@
clauses_info_set_headvars(X, CI, CI ^ headvars := X).
clauses_info_set_clauses(X, CI, CI ^ clauses_rep := forw(X)).
clauses_info_set_clauses_rep(X, CI, CI ^ clauses_rep := X).
-clauses_info_set_type_info_varmap(X, CI, CI ^ clause_type_info_varmap := X).
-clauses_info_set_typeclass_info_varmap(X, CI,
- CI ^ clause_typeclass_info_varmap := X).
+clauses_info_set_rtti_varmaps(X, CI, CI ^ clauses_rtti_varmaps := X).
:- type clauses_rep
---> rev(list(clause))
@@ -728,62 +1184,6 @@
% module, name and arity.
:- type aditi_owner == string.
- % 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
- % which they will be passed in by do_call_class_method.
-:- type instance_method_constraints
- ---> instance_method_constraints(
- class_id,
- list(type), % The types in the head of the
- % instance declaration.
- list(prog_constraint), % The universal constraints
- % on the instance declaration.
- prog_constraints % The contraints on the method's
- % type declaration in the
- % `:- typeclass' declaration.
- ).
-
- % 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(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.
-:- type type_info_varmap == map(tvar, type_info_locn).
-
- % A type_info_locn specifies how to access a type_info.
-:- type type_info_locn
- ---> type_info(prog_var)
- % It is a normal type_info, i.e. the type
- % is not constrained.
-
- ; typeclass_info(prog_var, int).
- % The type_info is packed inside a
- % typeclass_info. If the int is N, it is
- % the Nth type_info inside the typeclass_info,
- % but there may be several superclass pointers
- % before the block of type_infos, so it won't
- % be the Nth word of the typeclass_info.
- %
- % To find the type_info inside the
- % typeclass_info, use the predicate
- % type_info_from_typeclass_info from Mercury
- % code; from C code use the macro
- % MR_typeclass_info_superclass_info.
-
- % type_info_locn_var(TypeInfoLocn, Var):
- %
- % Var is the variable corresponding to the TypeInfoLocn. Note
- % that this does *not* mean that Var is a type_info; it may be
- % a typeclass_info in which the type_info is nested.
- %
-:- pred type_info_locn_var(type_info_locn::in, prog_var::out) is det.
-
-:- pred type_info_locn_set_var(prog_var::in,
- type_info_locn::in, type_info_locn::out) is det.
-
:- type pred_transformation
---> higher_order_specialization(
int % Sequence number among the higher order
@@ -913,8 +1313,8 @@
:- 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,
- prog_constraints::in, type_info_varmap::in, typeclass_info_varmap::in,
- prog_varset::in, inst_varset::in, pred_markers::in, aditi_owner::in,
+ prog_constraints::in, rtti_varmaps::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.
@@ -1385,12 +1785,10 @@
% The empty list of clauses is a little white lie.
Clauses = forw([]),
map__init(TVarNameMap),
- proc_info_typeinfo_varmap(ProcInfo, TypeInfoMap),
- proc_info_typeclass_info_varmap(ProcInfo, TypeClassInfoMap),
+ proc_info_rtti_varmaps(ProcInfo, RttiVarMaps),
HasForeignClauses = no,
- ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap,
- VarTypes, HeadVars, Clauses, TypeInfoMap, TypeClassInfoMap,
- HasForeignClauses),
+ ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap, VarTypes,
+ HeadVars, Clauses, RttiVarMaps, HasForeignClauses),
proc_info_declared_determinism(ProcInfo, MaybeDetism),
map__init(Procs0),
@@ -1406,7 +1804,7 @@
hlds_pred__define_new_pred(Origin, Goal0, Goal, ArgVars0, ExtraTypeInfos,
InstMap0, PredName, TVarSet, VarTypes0, ClassContext,
- TVarMap, TCVarMap, VarSet0, InstVarSet, Markers, Owner,
+ RttiVarMaps, VarSet0, InstVarSet, Markers, Owner,
IsAddressTaken, ModuleInfo0, ModuleInfo, PredProcId) :-
Goal0 = _GoalExpr - GoalInfo,
goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
@@ -1426,8 +1824,8 @@
IsAddressTaken, Globals, TypeInfoLiveness),
( TypeInfoLiveness = yes ->
goal_info_get_nonlocals(GoalInfo, NonLocals),
- goal_util__extra_nonlocal_typeinfos(TVarMap, TCVarMap,
- VarTypes0, ExistQVars, NonLocals, ExtraTypeInfos0),
+ goal_util__extra_nonlocal_typeinfos(RttiVarMaps, VarTypes0,
+ ExistQVars, NonLocals, ExtraTypeInfos0),
set__delete_list(ExtraTypeInfos0, ArgVars0, ExtraTypeInfos1),
set__to_sorted_list(ExtraTypeInfos1, ExtraTypeInfos),
list__append(ExtraTypeInfos, ArgVars0, ArgVars)
@@ -1461,7 +1859,7 @@
MaybeDeclaredDetism = no,
proc_info_create(Context, VarSet, VarTypes, ArgVars, InstVarSet,
ArgModes, MaybeDeclaredDetism, Detism, Goal0,
- TVarMap, TCVarMap, IsAddressTaken, ProcInfo0),
+ RttiVarMaps, IsAddressTaken, ProcInfo0),
proc_info_set_maybe_termination_info(TermInfo, ProcInfo0, ProcInfo),
set__init(Assertions),
@@ -1788,14 +2186,6 @@
%-----------------------------------------------------------------------------%
-type_info_locn_var(type_info(Var), Var).
-type_info_locn_var(typeclass_info(Var, _), Var).
-
-type_info_locn_set_var(Var, type_info(_), type_info(Var)).
-type_info_locn_set_var(Var, typeclass_info(_, Num), typeclass_info(Var, Num)).
-
-%-----------------------------------------------------------------------------%
-
:- type pred_markers == list(marker).
init_markers([]).
@@ -2017,27 +2407,24 @@
:- pred proc_info_set(prog_context::in, prog_varset::in, vartypes::in,
list(prog_var)::in, inst_varset::in, list(mode)::in,
maybe(list(is_live))::in, maybe(determinism)::in, determinism::in,
- hlds_goal::in, bool::in,
- type_info_varmap::in, typeclass_info_varmap::in,
+ hlds_goal::in, bool::in, rtti_varmaps::in,
maybe(arg_size_info)::in, maybe(termination_info)::in,
termination2_info::in, is_address_taken::in, stack_slots::in,
maybe(list(arg_info))::in, liveness_info::in, proc_info::out) is det.
:- pred proc_info_create(prog_context::in, prog_varset::in, vartypes::in,
list(prog_var)::in, inst_varset::in, list(mode)::in,
- determinism::in, hlds_goal::in,
- type_info_varmap::in, typeclass_info_varmap::in,
+ determinism::in, hlds_goal::in, rtti_varmaps::in,
is_address_taken::in, proc_info::out) is det.
:- pred proc_info_create(prog_context::in, prog_varset::in, vartypes::in,
list(prog_var)::in, inst_varset::in, list(mode)::in,
maybe(determinism)::in, determinism::in, hlds_goal::in,
- type_info_varmap::in, typeclass_info_varmap::in,
- is_address_taken::in, proc_info::out) is det.
+ rtti_varmaps::in, is_address_taken::in, proc_info::out) is det.
:- pred proc_info_set_body(prog_varset::in, vartypes::in,
- list(prog_var)::in, hlds_goal::in, type_info_varmap::in,
- typeclass_info_varmap::in, proc_info::in, proc_info::out) is det.
+ list(prog_var)::in, hlds_goal::in, rtti_varmaps::in,
+ proc_info::in, proc_info::out) is det.
% Predicates to get fields of proc_infos.
@@ -2056,9 +2443,7 @@
:- pred proc_info_inferred_determinism(proc_info::in, determinism::out) is det.
:- pred proc_info_goal(proc_info::in, hlds_goal::out) is det.
:- pred proc_info_can_process(proc_info::in, bool::out) is det.
-:- pred proc_info_typeinfo_varmap(proc_info::in, type_info_varmap::out) is det.
-:- pred proc_info_typeclass_info_varmap(proc_info::in,
- typeclass_info_varmap::out) is det.
+:- pred proc_info_rtti_varmaps(proc_info::in, rtti_varmaps::out) is det.
:- pred proc_info_eval_method(proc_info::in, eval_method::out) is det.
:- pred proc_info_get_maybe_arg_size_info(proc_info::in,
maybe(arg_size_info)::out) is det.
@@ -2102,9 +2487,7 @@
proc_info::in, proc_info::out) is det.
:- pred proc_info_set_can_process(bool::in,
proc_info::in, proc_info::out) is det.
-:- pred proc_info_set_typeinfo_varmap(type_info_varmap::in,
- proc_info::in, proc_info::out) is det.
-:- pred proc_info_set_typeclass_info_varmap(typeclass_info_varmap::in,
+:- pred proc_info_set_rtti_varmaps(rtti_varmaps::in,
proc_info::in, proc_info::out) is det.
:- pred proc_info_set_eval_method(eval_method::in,
proc_info::in, proc_info::out) is det.
@@ -2171,10 +2554,10 @@
% their typeinfos stay live too.
:- pred proc_info_get_typeinfo_vars(set(prog_var)::in, vartypes::in,
- type_info_varmap::in, set(prog_var)::out) is det.
+ rtti_varmaps::in, set(prog_var)::out) is det.
:- pred proc_info_maybe_complete_with_typeinfo_vars(set(prog_var)::in, bool::in,
- vartypes::in, type_info_varmap::in, set(prog_var)::out) is det.
+ vartypes::in, rtti_varmaps::in, set(prog_var)::out) is det.
:- pred proc_info_ensure_unique_names(proc_info::in, proc_info::out) is det.
@@ -2313,11 +2696,9 @@
% modes of unification procs until
% the end of the unique_modes pass.)
mode_errors :: list(mode_error_info),
- proc_type_info_varmap :: type_info_varmap,
- % typeinfo vars for type parameters
- proc_typeclass_info_varmap :: typeclass_info_varmap,
- % typeclass_info vars for class
- % constraints
+ proc_rtti_varmaps :: rtti_varmaps,
+ % Information about type_infos and
+ % typeclass_infos.
eval_method :: eval_method,
% how should the proc be evaluated
@@ -2452,39 +2833,38 @@
goal_info_init(GoalInfo),
ClauseBody = conj([]) - GoalInfo,
CanProcess = yes,
- map__init(TVarsMap),
- map__init(TCVarsMap),
+ rtti_varmaps_init(RttiVarMaps),
Term2Info = term_constr_main__term2_info_init,
NewProc = proc_info(MContext, BodyVarSet, BodyTypes, HeadVars,
InstVarSet, DeclaredModes, Modes, no, MaybeArgLives,
MaybeDet, InferredDet, ClauseBody, CanProcess, ModeErrors,
- TVarsMap, TCVarsMap, eval_normal,
+ RttiVarMaps, eval_normal,
proc_sub_info(no, no, Term2Info, IsAddressTaken, StackSlots,
ArgInfo, InitialLiveness, no, no, no, no, no)).
proc_info_set(Context, BodyVarSet, BodyTypes, HeadVars, InstVarSet, HeadModes,
HeadLives, DeclaredDetism, InferredDetism, Goal, CanProcess,
- TVarMap, TCVarsMap, ArgSizes, Termination, Termination2,
+ RttiVarMaps, ArgSizes, Termination, Termination2,
IsAddressTaken, StackSlots, ArgInfo, Liveness, ProcInfo) :-
ModeErrors = [],
ProcInfo = proc_info(Context, BodyVarSet, BodyTypes, HeadVars,
InstVarSet, no, HeadModes, no, HeadLives,
DeclaredDetism, InferredDetism, Goal, CanProcess, ModeErrors,
- TVarMap, TCVarsMap, eval_normal,
+ RttiVarMaps, eval_normal,
proc_sub_info(ArgSizes, Termination, Termination2,
IsAddressTaken, StackSlots, ArgInfo, Liveness, no, no, no,
no, no)).
proc_info_create(Context, VarSet, VarTypes, HeadVars, InstVarSet,
- HeadModes, Detism, Goal, TVarMap, TCVarsMap,
- IsAddressTaken, ProcInfo) :-
+ HeadModes, Detism, Goal, RttiVarMaps, IsAddressTaken,
+ ProcInfo) :-
proc_info_create(Context, VarSet, VarTypes, HeadVars, InstVarSet,
- HeadModes, yes(Detism), Detism, Goal, TVarMap, TCVarsMap,
+ HeadModes, yes(Detism), Detism, Goal, RttiVarMaps,
IsAddressTaken, ProcInfo).
proc_info_create(Context, VarSet, VarTypes, HeadVars, InstVarSet, HeadModes,
- MaybeDeclaredDetism, Detism, Goal, TVarMap, TCVarsMap,
- IsAddressTaken, ProcInfo) :-
+ MaybeDeclaredDetism, Detism, Goal, RttiVarMaps, IsAddressTaken,
+ ProcInfo) :-
map__init(StackSlots),
set__init(Liveness),
MaybeHeadLives = no,
@@ -2493,18 +2873,17 @@
ProcInfo = proc_info(Context, VarSet, VarTypes, HeadVars,
InstVarSet, no, HeadModes, no, MaybeHeadLives,
MaybeDeclaredDetism, Detism, Goal, yes, ModeErrors,
- TVarMap, TCVarsMap, eval_normal,
+ RttiVarMaps, eval_normal,
proc_sub_info(no, no, Term2Info, IsAddressTaken,
StackSlots, no, Liveness, no, no, no, no, no)).
-proc_info_set_body(VarSet, VarTypes, HeadVars, Goal, TI_VarMap, TCI_VarMap,
+proc_info_set_body(VarSet, VarTypes, HeadVars, Goal, RttiVarMaps,
ProcInfo0, ProcInfo) :-
- ProcInfo = ((((((ProcInfo0 ^ prog_varset := VarSet)
+ ProcInfo = (((((ProcInfo0 ^ prog_varset := VarSet)
^ var_types := VarTypes)
^ head_vars := HeadVars)
^ body := Goal)
- ^ proc_type_info_varmap := TI_VarMap)
- ^ proc_typeclass_info_varmap := TCI_VarMap).
+ ^ proc_rtti_varmaps := RttiVarMaps).
proc_info_context(PI, PI ^ proc_context).
proc_info_varset(PI, PI ^ prog_varset).
@@ -2518,8 +2897,7 @@
proc_info_inferred_determinism(PI, PI ^ inferred_detism).
proc_info_goal(PI, PI ^ body).
proc_info_can_process(PI, PI ^ can_process).
-proc_info_typeinfo_varmap(PI, PI ^ proc_type_info_varmap).
-proc_info_typeclass_info_varmap(PI, PI ^ proc_typeclass_info_varmap).
+proc_info_rtti_varmaps(PI, PI ^ proc_rtti_varmaps).
proc_info_eval_method(PI, PI ^ eval_method).
proc_info_get_maybe_arg_size_info(PI, PI ^ proc_sub_info ^ maybe_arg_sizes).
proc_info_get_maybe_termination_info(PI,
@@ -2547,9 +2925,7 @@
proc_info_set_inferred_determinism(ID, PI, PI ^ inferred_detism := ID).
proc_info_set_goal(G, PI, PI ^ body := G).
proc_info_set_can_process(CP, PI, PI ^ can_process := CP).
-proc_info_set_typeinfo_varmap(TI, PI, PI ^ proc_type_info_varmap := TI).
-proc_info_set_typeclass_info_varmap(TC, PI,
- PI ^ proc_typeclass_info_varmap := TC).
+proc_info_set_rtti_varmaps(RI, PI, PI ^ proc_rtti_varmaps := RI).
proc_info_set_eval_method(EM, PI, PI ^ eval_method := EM).
proc_info_set_maybe_arg_size_info(MAS, PI,
PI ^ proc_sub_info ^ maybe_arg_sizes := MAS).
@@ -2653,7 +3029,8 @@
!:ProcInfo = !.ProcInfo ^ proc_sub_info ^ termination2 :=
Termination2Info.
-proc_info_get_typeinfo_vars(Vars, VarTypes, TVarMap, TypeInfoVars) :-
+proc_info_get_typeinfo_vars(Vars, VarTypes, RttiVarMaps, TypeInfoVars) :-
+ TVarMap = RttiVarMaps ^ ti_varmap,
set__to_sorted_list(Vars, VarList),
proc_info_get_typeinfo_vars_2(VarList, VarTypes, TVarMap,
TypeInfoVarList),
@@ -2699,10 +3076,10 @@
).
proc_info_maybe_complete_with_typeinfo_vars(Vars0, TypeInfoLiveness,
- VarTypes, TVarMap, Vars) :-
+ VarTypes, RttiVarMaps, Vars) :-
(
TypeInfoLiveness = yes,
- proc_info_get_typeinfo_vars(Vars0, VarTypes, TVarMap,
+ proc_info_get_typeinfo_vars(Vars0, VarTypes, RttiVarMaps,
TypeInfoVars),
set__union(Vars0, TypeInfoVars, Vars)
;
Index: compiler/inlining.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/inlining.m,v
retrieving revision 1.122
diff -u -r1.122 inlining.m
--- compiler/inlining.m 24 Mar 2005 05:34:04 -0000 1.122
+++ compiler/inlining.m 15 Jul 2005 04:42:44 -0000
@@ -102,7 +102,7 @@
% inlining__do_inline_call(UnivQVars, Args,
% CalledPredInfo, CalledProcInfo,
% VarSet0, VarSet, VarTypes0, VarTypes, TVarSet0, TVarSet,
- % TypeInfoMap0, TypeInfoMap).
+ % RttiVarMaps0, RttiVarMaps).
%
% Given the universally quantified type variables in the caller's
% type, the arguments to the call, the pred_info and proc_info
@@ -112,8 +112,7 @@
:- pred inlining__do_inline_call(list(tvar)::in, list(prog_var)::in,
pred_info::in, proc_info::in, prog_varset::in, prog_varset::out,
vartypes::in, vartypes::out, tvarset::in, tvarset::out,
- map(tvar, type_info_locn)::in, map(tvar, type_info_locn)::out,
- hlds_goal::out) is det.
+ rtti_varmaps::in, rtti_varmaps::out, hlds_goal::out) is det.
% inlining__get_type_substitution(CalleeArgTypes, CallerArgTypes,
% HeadTypeParams, CalleeExistQTVars, TypeSubn).
@@ -422,10 +421,8 @@
prog_varset, % varset
vartypes, % variable types
tvarset, % type variables
- map(tvar, type_info_locn),% type_info varset, a mapping from
- % type variables to variables
- % where their type_info is
- % stored.
+ rtti_varmaps, % information about locations of
+ % type_infos and typeclass_infos
bool, % Did we do any inlining in the proc?
bool, % Does the goal need to be
% requantified?
@@ -458,7 +455,7 @@
proc_info_goal(ProcInfo0, Goal0),
proc_info_varset(ProcInfo0, VarSet0),
proc_info_vartypes(ProcInfo0, VarTypes0),
- proc_info_typeinfo_varmap(ProcInfo0, TypeInfoVarMap0),
+ proc_info_rtti_varmaps(ProcInfo0, RttiVarMaps0),
DidInlining0 = no,
Requantify0 = no,
@@ -467,20 +464,20 @@
InlineInfo0 = inline_info(VarThresh, HighLevelCode, AnyTracing,
InlinedProcs, !.ModuleInfo, UnivQTVars, Markers,
- VarSet0, VarTypes0, TypeVarSet0, TypeInfoVarMap0,
+ VarSet0, VarTypes0, TypeVarSet0, RttiVarMaps0,
DidInlining0, Requantify0, DetChanged0, PurityChanged0),
inlining__inlining_in_goal(Goal0, Goal, InlineInfo0, InlineInfo),
InlineInfo = inline_info(_, _, _, _, _, _, _, VarSet, VarTypes,
- TypeVarSet, TypeInfoVarMap, DidInlining, Requantify,
+ TypeVarSet, RttiVarMaps, DidInlining, Requantify,
DetChanged, PurityChanged),
pred_info_set_typevarset(TypeVarSet, PredInfo0, PredInfo1),
proc_info_set_varset(VarSet, ProcInfo0, ProcInfo1),
proc_info_set_vartypes(VarTypes, ProcInfo1, ProcInfo2),
- proc_info_set_typeinfo_varmap(TypeInfoVarMap, ProcInfo2, ProcInfo3),
+ proc_info_set_rtti_varmaps(RttiVarMaps, ProcInfo2, ProcInfo3),
proc_info_set_goal(Goal, ProcInfo3, ProcInfo4),
(
@@ -602,7 +599,7 @@
Context, Sym, Goal, GoalInfo0, GoalInfo, !Info) :-
!.Info = inline_info(VarThresh, HighLevelCode, AnyTracing,
InlinedProcs, ModuleInfo, HeadTypeParams, Markers,
- VarSet0, VarTypes0, TypeVarSet0, TypeInfoVarMap0,
+ VarSet0, VarTypes0, TypeVarSet0, RttiVarMaps0,
_DidInlining0, Requantify0, DetChanged0, PurityChanged0),
% should we inline this call?
@@ -626,8 +623,8 @@
->
inlining__do_inline_call(HeadTypeParams, ArgVars, PredInfo,
ProcInfo, VarSet0, VarSet, VarTypes0, VarTypes,
- TypeVarSet0, TypeVarSet, TypeInfoVarMap0,
- TypeInfoVarMap, Goal - GoalInfo),
+ TypeVarSet0, TypeVarSet, RttiVarMaps0, RttiVarMaps,
+ Goal - GoalInfo),
%
% If some of the output variables are not used in
@@ -663,7 +660,7 @@
),
!:Info = inline_info(VarThresh, HighLevelCode, AnyTracing,
InlinedProcs, ModuleInfo, HeadTypeParams, Markers,
- VarSet, VarTypes, TypeVarSet, TypeInfoVarMap,
+ VarSet, VarTypes, TypeVarSet, RttiVarMaps,
DidInlining, Requantify, DetChanged, PurityChanged)
;
Goal = call(PredId, ProcId, ArgVars, Builtin, Context, Sym),
@@ -674,7 +671,7 @@
inlining__do_inline_call(HeadTypeParams, ArgVars, PredInfo, ProcInfo,
VarSet0, VarSet, VarTypes0, VarTypes, TypeVarSet0, TypeVarSet,
- TypeInfoVarMap0, TypeInfoVarMap, Goal) :-
+ RttiVarMaps0, RttiVarMaps, Goal) :-
proc_info_goal(ProcInfo, CalledGoal),
@@ -684,7 +681,7 @@
proc_info_headvars(ProcInfo, HeadVars),
proc_info_vartypes(ProcInfo, CalleeVarTypes0),
proc_info_varset(ProcInfo, CalleeVarSet),
- proc_info_typeinfo_varmap(ProcInfo, CalleeTypeInfoVarMap0),
+ proc_info_rtti_varmaps(ProcInfo, CalleeRttiVarMaps0),
% Substitute the appropriate types into the type
% mapping of the called procedure. For example, if we
@@ -748,16 +745,15 @@
VarSet, VarTypes1, CalleeVarTypes, VarTypes, Subn,
CalledGoal, Goal),
- apply_substitutions_to_var_map(CalleeTypeInfoVarMap0,
- TypeRenaming, TypeSubn, Subn, CalleeTypeInfoVarMap1),
+ apply_substitutions_to_rtti_varmaps(TypeRenaming, TypeSubn, Subn,
+ CalleeRttiVarMaps0, CalleeRttiVarMaps1),
% Prefer the type_info_locn from the caller.
% The type_infos or typeclass_infos passed to the callee may
% have been produced by extracting type_infos or typeclass_infos
% from typeclass_infos in the caller, so they won't necessarily
% be the same.
- map__overlay(CalleeTypeInfoVarMap1, TypeInfoVarMap0,
- TypeInfoVarMap).
+ rtti_varmaps_overlay(CalleeRttiVarMaps1, RttiVarMaps0, RttiVarMaps).
inlining__get_type_substitution(HeadTypes, ArgTypes,
HeadTypeParams, CalleeExistQVars, TypeSubn) :-
Index: compiler/lambda.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lambda.m,v
retrieving revision 1.99
diff -u -r1.99 lambda.m
--- compiler/lambda.m 26 May 2005 00:17:02 -0000 1.99
+++ compiler/lambda.m 13 Jul 2005 07:24:13 -0000
@@ -121,11 +121,7 @@
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)
- typeclass_info_varmap, % from the proc_info
- % (typeclass_infos)
+ rtti_varmaps, % from the proc_info
pred_markers, % from the pred_info
pred_or_func,
string, % pred/func name
@@ -200,18 +196,17 @@
proc_info_varset(!.ProcInfo, VarSet0),
proc_info_vartypes(!.ProcInfo, VarTypes0),
proc_info_goal(!.ProcInfo, Goal0),
- proc_info_typeinfo_varmap(!.ProcInfo, TVarMap0),
- proc_info_typeclass_info_varmap(!.ProcInfo, TCVarMap0),
+ proc_info_rtti_varmaps(!.ProcInfo, RttiVarMaps0),
proc_info_inst_varset(!.ProcInfo, InstVarSet0),
MustRecomputeNonLocals0 = no,
% process the goal
Info0 = lambda_info(VarSet0, VarTypes0, Constraints0, TypeVarSet0,
- InstVarSet0, TVarMap0, TCVarMap0, Markers, PredOrFunc,
+ InstVarSet0, RttiVarMaps0, Markers, PredOrFunc,
PredName, Owner, !.ModuleInfo, MustRecomputeNonLocals0),
lambda__process_goal(Goal0, Goal1, Info0, Info1),
Info1 = lambda_info(VarSet1, VarTypes1, Constraints, TypeVarSet,
- _, TVarMap, TCVarMap, _, _, _, _, !:ModuleInfo,
+ _, RttiVarMaps, _, _, _, _, !:ModuleInfo,
MustRecomputeNonLocals),
% check if we need to requantify
@@ -228,8 +223,7 @@
proc_info_set_goal(Goal, !ProcInfo),
proc_info_set_varset(VarSet, !ProcInfo),
proc_info_set_vartypes(VarTypes, !ProcInfo),
- proc_info_set_typeinfo_varmap(TVarMap, !ProcInfo),
- proc_info_set_typeclass_info_varmap(TCVarMap, !ProcInfo),
+ proc_info_set_rtti_varmaps(RttiVarMaps, !ProcInfo),
pred_info_set_typevarset(TypeVarSet, !PredInfo),
pred_info_set_class_context(Constraints, !PredInfo).
@@ -323,14 +317,14 @@
OrigNonLocals0, LambdaGoal, Unification0, Functor,
Unification, LambdaInfo0, LambdaInfo) :-
LambdaInfo0 = lambda_info(VarSet, VarTypes, _PredConstraints, TVarSet,
- InstVarSet, TVarMap, TCVarMap, Markers, POF, OrigPredName,
+ InstVarSet, RttiVarMaps, Markers, POF, OrigPredName,
Owner, ModuleInfo0, MustRecomputeNonLocals0),
% Calculate the constraints which apply to this lambda
% expression.
% Note currently we only allow lambda expressions
% to have universally quantified constraints.
- map__keys(TCVarMap, AllConstraints),
+ rtti_varmaps_constraints(RttiVarMaps, AllConstraints),
map__apply_to_list(Vars, VarTypes, LambdaVarTypes),
list__map(prog_type__vars, LambdaVarTypes, LambdaTypeVarsList),
list__condense(LambdaTypeVarsList, LambdaTypeVars),
@@ -344,8 +338,8 @@
LambdaGoal = _ - LambdaGoalInfo,
goal_info_get_nonlocals(LambdaGoalInfo, LambdaGoalNonLocals),
set__insert_list(LambdaGoalNonLocals, Vars, LambdaNonLocals),
- goal_util__extra_nonlocal_typeinfos(TVarMap, TCVarMap, VarTypes,
- ExistQVars, LambdaNonLocals, ExtraTypeInfos),
+ goal_util__extra_nonlocal_typeinfos(RttiVarMaps, VarTypes, ExistQVars,
+ LambdaNonLocals, ExtraTypeInfos),
OrigVars = OrigNonLocals0,
(
@@ -553,8 +547,7 @@
proc_info_create(LambdaContext, VarSet, VarTypes,
AllArgVars, InstVarSet, AllArgModes, Detism,
- LambdaGoal, TVarMap, TCVarMap, address_is_taken,
- ProcInfo0),
+ LambdaGoal, RttiVarMaps, address_is_taken, ProcInfo0),
% The debugger ignores unnamed variables.
ensure_all_headvars_are_named(ProcInfo0, ProcInfo1),
@@ -593,8 +586,8 @@
Unification = construct(Var, ConsId, ArgVars, UniModes,
construct_dynamically, cell_is_unique, no),
LambdaInfo = lambda_info(VarSet, VarTypes, Constraints, TVarSet,
- InstVarSet, TVarMap, TCVarMap, Markers, POF, OrigPredName,
- Owner, ModuleInfo, MustRecomputeNonLocals).
+ InstVarSet, RttiVarMaps, Markers, POF, OrigPredName, Owner,
+ ModuleInfo, MustRecomputeNonLocals).
:- pred lambda__constraint_contains_vars(list(tvar)::in, prog_constraint::in)
is semidet.
Index: compiler/live_vars.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/live_vars.m,v
retrieving revision 1.108
diff -u -r1.108 live_vars.m
--- compiler/live_vars.m 24 Mar 2005 05:34:05 -0000 1.108
+++ compiler/live_vars.m 13 Jul 2005 08:36:06 -0000
@@ -552,10 +552,10 @@
LiveVars1, LiveVars) :-
( TypeInfoLiveness = yes ->
proc_info_vartypes(ProcInfo, VarTypes),
- proc_info_typeinfo_varmap(ProcInfo, TVarMap),
- proc_info_get_typeinfo_vars(LiveVars1, VarTypes, TVarMap,
+ proc_info_rtti_varmaps(ProcInfo, RttiVarMaps),
+ proc_info_get_typeinfo_vars(LiveVars1, VarTypes, RttiVarMaps,
TypeInfoVarsLive),
- proc_info_get_typeinfo_vars(OutVars, VarTypes, TVarMap,
+ proc_info_get_typeinfo_vars(OutVars, VarTypes, RttiVarMaps,
TypeInfoVarsOut),
set__union(LiveVars1, TypeInfoVarsOut, LiveVars2),
set__union(LiveVars2, TypeInfoVarsLive, LiveVars)
Index: compiler/liveness.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/liveness.m,v
retrieving revision 1.134
diff -u -r1.134 liveness.m
--- compiler/liveness.m 24 Mar 2005 05:34:06 -0000 1.134
+++ compiler/liveness.m 13 Jul 2005 07:27:55 -0000
@@ -222,12 +222,12 @@
proc_info_goal(!.ProcInfo, Goal0),
proc_info_varset(!.ProcInfo, VarSet),
proc_info_vartypes(!.ProcInfo, VarTypes),
- proc_info_typeinfo_varmap(!.ProcInfo, TVarMap),
+ proc_info_rtti_varmaps(!.ProcInfo, RttiVarMaps),
module_info_globals(ModuleInfo, Globals),
module_info_pred_info(ModuleInfo, PredId, PredInfo),
body_should_use_typeinfo_liveness(PredInfo, Globals, TypeInfoLiveness),
- live_info_init(ModuleInfo, TypeInfoLiveness, VarTypes, TVarMap, VarSet,
- LiveInfo),
+ live_info_init(ModuleInfo, TypeInfoLiveness, VarTypes, RttiVarMaps,
+ VarSet, LiveInfo),
globals__lookup_int_option(Globals, debug_liveness, DebugLiveness),
pred_id_to_int(PredId, PredIdInt),
@@ -1580,10 +1580,10 @@
proc_info_goal(ProcInfo, _Goal - GoalInfo),
goal_info_get_code_gen_nonlocals(GoalInfo, NonLocals0),
module_info_pred_info(ModuleInfo, PredId, PredInfo),
- proc_info_typeinfo_varmap(ProcInfo, TVarMap),
+ proc_info_rtti_varmaps(ProcInfo, RttiVarMaps),
body_should_use_typeinfo_liveness(PredInfo, Globals, TypeinfoLiveness),
proc_info_maybe_complete_with_typeinfo_vars(NonLocals0,
- TypeinfoLiveness, VarTypes, TVarMap, NonLocals),
+ TypeinfoLiveness, VarTypes, RttiVarMaps, NonLocals),
set__intersect(Liveness2, NonLocals, Liveness).
:- pred initial_liveness_2(list(prog_var)::in, list(mode)::in, list(type)::in,
@@ -1615,9 +1615,9 @@
% If doing typeinfo liveness, the corresponding
% typeinfos need to be added to these.
proc_info_vartypes(ProcInfo, VarTypes),
- proc_info_typeinfo_varmap(ProcInfo, TVarMap),
+ proc_info_rtti_varmaps(ProcInfo, RttiVarMaps),
proc_info_maybe_complete_with_typeinfo_vars(Deadness0,
- LiveInfo ^ typeinfo_liveness, VarTypes, TVarMap, Deadness).
+ LiveInfo ^ typeinfo_liveness, VarTypes, RttiVarMaps, Deadness).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -1697,7 +1697,7 @@
liveness__maybe_complete_with_typeinfos(LiveInfo, Vars0, Vars) :-
proc_info_maybe_complete_with_typeinfo_vars(Vars0,
LiveInfo ^ typeinfo_liveness, LiveInfo ^ vartypes,
- LiveInfo ^ type_info_varmap, Vars).
+ LiveInfo ^ rtti_varmaps, Vars).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -1707,14 +1707,14 @@
module_info :: module_info,
typeinfo_liveness :: bool,
vartypes :: vartypes,
- type_info_varmap :: type_info_varmap,
+ rtti_varmaps :: rtti_varmaps,
varset :: prog_varset
).
:- pred live_info_init(module_info::in, bool::in, vartypes::in,
- type_info_varmap::in, prog_varset::in, live_info::out) is det.
+ rtti_varmaps::in, prog_varset::in, live_info::out) is det.
-live_info_init(ModuleInfo, ProcInfo, TypeInfoLiveness, VarTypes, VarSet,
- live_info(ModuleInfo, ProcInfo, TypeInfoLiveness, VarTypes, VarSet)).
+live_info_init(ModuleInfo, TypeInfoLiveness, VarTypes, RttiVarMaps, VarSet,
+ live_info(ModuleInfo, TypeInfoLiveness, VarTypes, RttiVarMaps, VarSet)).
%-----------------------------------------------------------------------------%
Index: compiler/loop_inv.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/loop_inv.m,v
retrieving revision 1.20
diff -u -r1.20 loop_inv.m
--- compiler/loop_inv.m 8 Apr 2005 03:15:18 -0000 1.20
+++ compiler/loop_inv.m 13 Jul 2005 08:42:25 -0000
@@ -758,8 +758,7 @@
hlds_pred__pred_info_typevarset(PredInfo, TVarSet),
hlds_pred__proc_info_vartypes(ProcInfo, VarTypes),
hlds_pred__pred_info_get_class_context(PredInfo, ClassContext),
- hlds_pred__proc_info_typeinfo_varmap(ProcInfo, TVarMap),
- hlds_pred__proc_info_typeclass_info_varmap(ProcInfo, TCVarMap),
+ hlds_pred__proc_info_rtti_varmaps(ProcInfo, RttiVarMaps),
hlds_pred__proc_info_varset(ProcInfo, VarSet),
hlds_pred__proc_info_inst_varset(ProcInfo, InstVarSet),
hlds_pred__pred_info_get_markers(PredInfo, Markers),
@@ -796,9 +795,7 @@
TVarSet, % in - ???
VarTypes, % in - The var -> type mapping for the new aux proc.
ClassContext, % in - Typeclass constraints on the new aux proc.
- TVarMap, % in - The tvar -> type_info_locn map for this proc.
- TCVarMap, % in - The class_constraint -> var map for
- % locating the type class typeclass_info.
+ RttiVarMaps, % in - type_info and typeclass_info locations.
VarSet, % in - ???
InstVarSet, % in - ???
Markers, % in - Markers for the new aux proc.
@@ -954,11 +951,10 @@
hlds_pred__proc_info_varset(ProcInfo0, VarSet),
hlds_pred__proc_info_vartypes(ProcInfo0, VarTypes),
hlds_pred__proc_info_headvars(ProcInfo0, HeadVars),
- hlds_pred__proc_info_typeinfo_varmap(ProcInfo0, TVarMap),
- hlds_pred__proc_info_typeclass_info_varmap(ProcInfo0, TCVarMap),
+ hlds_pred__proc_info_rtti_varmaps(ProcInfo0, RttiVarMaps),
hlds_pred__proc_info_set_body(VarSet, VarTypes, HeadVars, Body,
- TVarMap, TCVarMap, ProcInfo0, ProcInfo1),
+ RttiVarMaps, ProcInfo0, ProcInfo1),
quantification__requantify_proc(ProcInfo1, ProcInfo2),
mode_util__recompute_instmap_delta_proc(no, ProcInfo2, ProcInfo,
Index: compiler/magic.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic.m,v
retrieving revision 1.52
diff -u -r1.52 magic.m
--- compiler/magic.m 24 Mar 2005 05:34:06 -0000 1.52
+++ compiler/magic.m 13 Jul 2005 08:23:51 -0000
@@ -889,12 +889,11 @@
{ pred_info_get_aditi_owner(ExportedPredInfo0, Owner) },
{ ClassContext = constraints([], []) },
- { map__init(TVarMap) },
- { map__init(TCVarMap) },
+ { rtti_varmaps_init(RttiVarMaps) },
{ varset__init(TVarSet) },
{ hlds_pred__define_new_pred(created(aditi_magic_interface),
Goal, CallGoal, HeadVars, ExtraArgs, InstMap, PredName,
- TVarSet, VarTypes, ClassContext, TVarMap, TCVarMap,
+ TVarSet, VarTypes, ClassContext, RttiVarMaps,
VarSet, InstVarSet, Markers, Owner, address_is_not_taken,
ModuleInfo1, ModuleInfo2, LocalPredProcId) },
{ ExtraArgs = [] ->
@@ -1285,12 +1284,11 @@
{ term__context_init(Context) },
% types must all be ground.
- { map__init(TVarMap) },
- { map__init(TCVarMap) },
+ { rtti_varmaps_init(RttiVarMaps) },
{ proc_info_create(Context, VarSet, VarTypes, AllArgs, InstVarSet,
- AllArgModes, nondet, Goal, TVarMap, TCVarMap,
- address_is_not_taken, ProcInfo) },
+ AllArgModes, nondet, Goal, RttiVarMaps, address_is_not_taken,
+ ProcInfo) },
%
% Fill in the pred_info.
Index: compiler/magic_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic_util.m,v
retrieving revision 1.47
diff -u -r1.47 magic_util.m
--- compiler/magic_util.m 24 Mar 2005 05:34:06 -0000 1.47
+++ compiler/magic_util.m 15 Jul 2005 06:53:02 -0000
@@ -1116,15 +1116,14 @@
{ conj_list_to_goal(Goals, GoalInfo, SuppGoal) },
{ varset__init(TVarSet) },
{ ClassConstraints = constraints([], []) },
- { map__init(TVarMap) },
- { map__init(TCVarMap) },
+ { rtti_varmaps_init(RttiVarMaps) },
{ proc_info_varset(ProcInfo, VarSet) },
{ unqualify_name(NewName, NewPredName) },
{ hlds_pred__define_new_pred(created(aditi_magic_supp), SuppGoal,
SuppCall, SuppArgs, ExtraArgs, InstMap, NewPredName, TVarSet,
- VarTypes, ClassConstraints, TVarMap, TCVarMap, VarSet,
- InstVarSet, Markers, Owner, address_is_not_taken,
- ModuleInfo0, ModuleInfo, _) },
+ VarTypes, ClassConstraints, RttiVarMaps, VarSet, InstVarSet,
+ Markers, Owner, address_is_not_taken, ModuleInfo0, ModuleInfo,
+ _) },
{ ExtraArgs = [] ->
true
;
@@ -1305,10 +1304,10 @@
% Polymorphic types are not allowed.
% Errors for type_infos and typeclass_infos are only reported
% if there are no other polymorphic arguments.
- ( { polymorphism__type_info_or_ctor_type(ArgType, _) } ->
+ ( { polymorphism__type_is_type_info_or_ctor_type(ArgType) } ->
{ set__init(Errors) },
{ MaybeRtti = yes(type_info) }
- ; { polymorphism__typeclass_info_class_constraint(ArgType, _) } ->
+ ; { polymorphism__type_is_typeclass_info(ArgType) } ->
{ set__init(Errors) },
{ MaybeRtti = yes(typeclass_info) }
;
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.515
diff -u -r1.515 make_hlds.m
--- compiler/make_hlds.m 13 Jul 2005 11:41:42 -0000 1.515
+++ compiler/make_hlds.m 13 Jul 2005 12:33:47 -0000
@@ -1698,14 +1698,12 @@
do_construct_pred_or_func_call(PredId, PredOrFunc,
SymName, Args, GoalInfo, Goal),
Clause = clause(ProcIds, Goal, mercury, Context),
- map__init(TI_VarMap),
- map__init(TCI_VarMap),
+ rtti_varmaps_init(RttiVarMaps),
map__init(TVarNameMap),
HasForeignClauses = no,
set_clause_list([Clause], ClausesRep),
- Clauses = clauses_info(ArgVarSet, VarTypes0,
- TVarNameMap, VarTypes0, Args, ClausesRep,
- TI_VarMap, TCI_VarMap, HasForeignClauses),
+ Clauses = clauses_info(ArgVarSet, VarTypes0, TVarNameMap,
+ VarTypes0, Args, ClausesRep, RttiVarMaps, HasForeignClauses),
pred_info_get_markers(PredInfo0, Markers0),
add_marker(calls_are_fully_qualified, Markers0, Markers),
map__init(Proofs),
@@ -4016,12 +4014,11 @@
%
map__from_corresponding_lists(HeadVars, Types, VarTypes),
map__init(TVarNameMap),
- map__init(TI_VarMap),
- map__init(TCI_VarMap),
+ rtti_varmaps_init(RttiVarMaps),
HasForeignClauses = no,
set_clause_list([Clause], ClausesRep),
ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap, VarTypes,
- HeadVars, ClausesRep, TI_VarMap, TCI_VarMap, HasForeignClauses),
+ HeadVars, ClausesRep, RttiVarMaps, HasForeignClauses),
pred_info_set_clauses_info(ClausesInfo, !PredInfo),
%
@@ -4953,12 +4950,11 @@
map__from_corresponding_lists(HeadVars, ArgTypes, VarTypes),
map__init(TVarNameMap),
- map__init(TI_VarMap),
- map__init(TCI_VarMap),
+ rtti_varmaps_init(RttiVarMaps),
HasForeignClauses = no,
set_clause_list([IntroducedClause], ClausesRep),
ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap, VarTypes,
- HeadVars, ClausesRep, TI_VarMap, TCI_VarMap, HasForeignClauses).
+ HeadVars, ClausesRep, RttiVarMaps, HasForeignClauses).
% handle the arbitrary clauses syntax
produce_instance_method_clauses(clauses(InstanceClauses), PredOrFunc,
@@ -6317,12 +6313,11 @@
map__init(VarTypes),
map__init(TVarNameMap),
varset__init(VarSet),
- map__init(TI_VarMap),
- map__init(TCI_VarMap),
+ rtti_varmaps_init(RttiVarMaps),
HasForeignClauses = no,
set_clause_list([], ClausesRep),
ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap, VarTypes,
- HeadVars, ClausesRep, TI_VarMap, TCI_VarMap, HasForeignClauses).
+ HeadVars, ClausesRep, RttiVarMaps, HasForeignClauses).
:- pred clauses_info_init(int::in, clauses_info::out) is det.
@@ -6331,12 +6326,11 @@
map__init(TVarNameMap),
varset__init(VarSet0),
make_n_fresh_vars("HeadVar__", Arity, HeadVars, VarSet0, VarSet),
- map__init(TI_VarMap),
- map__init(TCI_VarMap),
+ rtti_varmaps_init(RttiVarMaps),
HasForeignClauses = no,
set_clause_list([], ClausesRep),
ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap, VarTypes,
- HeadVars, ClausesRep, TI_VarMap, TCI_VarMap, HasForeignClauses).
+ HeadVars, ClausesRep, RttiVarMaps, HasForeignClauses).
:- pred clauses_info_add_clause(list(proc_id)::in,
prog_varset::in, tvarset::in, list(prog_term)::in, goal::in,
@@ -6351,7 +6345,7 @@
!ClausesInfo, Warnings, !ModuleInfo, !QualInfo, !IO) :-
!.ClausesInfo = clauses_info(VarSet0, ExplicitVarTypes0,
TVarNameMap0, InferredVarTypes, HeadVars, ClausesRep0,
- TI_VarMap, TCI_VarMap, HasForeignClauses),
+ RttiVarMaps, HasForeignClauses),
IsEmpty = clause_list_is_empty(ClausesRep0),
(
IsEmpty = yes,
@@ -6415,7 +6409,7 @@
),
qual_info_get_var_types(!.QualInfo, ExplicitVarTypes),
!:ClausesInfo = clauses_info(VarSet, ExplicitVarTypes, TVarNameMap,
- InferredVarTypes, HeadVars, ClausesRep, TI_VarMap, TCI_VarMap,
+ InferredVarTypes, HeadVars, ClausesRep, RttiVarMaps,
HasForeignClauses)
).
@@ -6438,7 +6432,7 @@
PredName, Arity, !ClausesInfo, !ModuleInfo, !IO) :-
!.ClausesInfo = clauses_info(VarSet0, ExplicitVarTypes, TVarNameMap,
- InferredVarTypes, HeadVars, ClauseRep, TI_VarMap, TCI_VarMap,
+ InferredVarTypes, HeadVars, ClauseRep, RttiVarMaps,
_HasForeignClauses),
get_clause_list(ClauseRep, ClauseList),
@@ -6534,8 +6528,8 @@
HasForeignClauses = yes,
set_clause_list(NewClauseList, NewClauseRep),
!:ClausesInfo = clauses_info(VarSet, ExplicitVarTypes, TVarNameMap,
- InferredVarTypes, HeadVars, NewClauseRep,
- TI_VarMap, TCI_VarMap, HasForeignClauses)
+ InferredVarTypes, HeadVars, NewClauseRep, RttiVarMaps,
+ HasForeignClauses)
).
:- func is_applicable_for_current_backend(backend,
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.80
diff -u -r1.80 modecheck_unify.m
--- compiler/modecheck_unify.m 23 May 2005 03:15:38 -0000 1.80
+++ compiler/modecheck_unify.m 13 Jul 2005 08:26:14 -0000
@@ -850,7 +850,7 @@
mode_info_get_procid(ModeInfo, ProcId),
module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
_PredInfo, ProcInfo),
- proc_info_typeinfo_varmap(ProcInfo, TypeInfoVarMap),
+ proc_info_rtti_varmaps(ProcInfo, RttiVarMaps),
%
% Call polymorphism__unification_typeinfos to add the appropriate
@@ -860,7 +860,7 @@
(
Goal0 = unify(X, Y, Mode, Unification0, FinalUnifyContext)
->
- polymorphism__unification_typeinfos(Type, TypeInfoVarMap,
+ polymorphism__unification_typeinfos(Type, RttiVarMaps,
Unification0, Unification, GoalInfo2, GoalInfo),
Goal = unify(X, Y, Mode, Unification, FinalUnifyContext)
;
Index: compiler/pd_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pd_info.m,v
retrieving revision 1.18
diff -u -r1.18 pd_info.m
--- compiler/pd_info.m 22 Mar 2005 06:40:17 -0000 1.18
+++ compiler/pd_info.m 13 Jul 2005 08:59:00 -0000
@@ -628,15 +628,14 @@
pred_info_get_aditi_owner(PredInfo, Owner),
proc_info_varset(ProcInfo, VarSet),
proc_info_vartypes(ProcInfo, VarTypes),
- proc_info_typeinfo_varmap(ProcInfo, TVarMap),
- proc_info_typeclass_info_varmap(ProcInfo, TCVarMap),
+ proc_info_rtti_varmaps(ProcInfo, RttiVarMaps),
proc_info_inst_varset(ProcInfo, InstVarSet),
% XXX handle the extra typeinfo arguments for
% --typeinfo-liveness properly.
hlds_pred__define_new_pred(Origin, Goal, CallGoal, Args, _ExtraArgs,
- InstMap, Name, TVarSet, VarTypes, ClassContext,
- TVarMap, TCVarMap, VarSet, InstVarSet, Markers, Owner,
- address_is_not_taken, ModuleInfo0, ModuleInfo, PredProcId),
+ InstMap, Name, TVarSet, VarTypes, ClassContext, RttiVarMaps,
+ VarSet, InstVarSet, Markers, Owner, address_is_not_taken,
+ ModuleInfo0, ModuleInfo, PredProcId),
pd_info_set_module_info(ModuleInfo, !PDInfo).
%-----------------------------------------------------------------------------%
Index: compiler/pd_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pd_util.m,v
retrieving revision 1.36
diff -u -r1.36 pd_util.m
--- compiler/pd_util.m 18 May 2005 05:49:11 -0000 1.36
+++ compiler/pd_util.m 13 Jul 2005 08:43:01 -0000
@@ -256,13 +256,11 @@
simplify_info_get_varset(SimplifyInfo, VarSet),
simplify_info_get_var_types(SimplifyInfo, VarTypes),
simplify_info_get_cost_delta(SimplifyInfo, CostDelta),
- simplify_info_get_type_info_varmap(SimplifyInfo, TVarMap),
- simplify_info_get_typeclass_info_varmap(SimplifyInfo, TCVarMap),
+ simplify_info_get_rtti_varmaps(SimplifyInfo, RttiVarMaps),
pd_info_get_proc_info(!.PDInfo, ProcInfo1),
proc_info_set_varset(VarSet, ProcInfo1, ProcInfo2),
proc_info_set_vartypes(VarTypes, ProcInfo2, ProcInfo3),
- proc_info_set_typeinfo_varmap(TVarMap, ProcInfo3, ProcInfo4),
- proc_info_set_typeclass_info_varmap(TCVarMap, ProcInfo4, ProcInfo),
+ proc_info_set_rtti_varmaps(RttiVarMaps, ProcInfo3, ProcInfo),
pd_info_set_proc_info(ProcInfo, !PDInfo),
pd_info_incr_cost_delta(CostDelta, !PDInfo),
pd_info_set_module_info(ModuleInfo, !PDInfo).
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.265
diff -u -r1.265 polymorphism.m
--- compiler/polymorphism.m 23 May 2005 03:15:39 -0000 1.265
+++ compiler/polymorphism.m 17 Jul 2005 02:45:21 -0000
@@ -198,7 +198,7 @@
% the appropriate fields in the unification and the goal_info.
:- pred polymorphism__unification_typeinfos((type)::in,
- map(tvar, type_info_locn)::in, unification::in, unification::out,
+ rtti_varmaps::in, unification::in, unification::out,
hlds_goal_info::in, hlds_goal_info::out) is det.
% Add the type_info variables for a new call goal. This predicate assumes
@@ -244,7 +244,8 @@
:- pred polymorphism__gen_extract_type_info(tvar::in, prog_var::in, int::in,
module_info::in, list(hlds_goal)::out, prog_var::out,
prog_varset::in, prog_varset::out,
- map(prog_var, type)::in, map(prog_var, type)::out) is det.
+ map(prog_var, type)::in, map(prog_var, type)::out,
+ rtti_varmaps::in, rtti_varmaps::out) is det.
:- type poly_info.
@@ -270,17 +271,13 @@
:- pred polymorphism__build_typeclass_info_type(prog_constraint::in,
(type)::out) is det.
- % From the type of a typeclass_info variable find the prog_constraint
- % about which the variable carries information, failing if the
- % type is not a valid typeclass_info type.
-:- pred polymorphism__typeclass_info_class_constraint((type)::in,
- prog_constraint::out) is semidet.
-
- % From the type of a type_info variable find the type about which
- % the type_info or type_ctor_info carries information, failing if the
- % type is not a valid type_info or type_ctor_info type.
-:- pred polymorphism__type_info_or_ctor_type((type)::in, (type)::out)
- is semidet.
+ % Check if a type is the `typeclass_info' type introduced by
+ % this pass.
+:- pred polymorphism__type_is_typeclass_info((type)::in) is semidet.
+
+ % Check if a type is either the `type_info' type or the
+ % `type_ctor_info' type introduced by this pass.
+:- pred polymorphism__type_is_type_info_or_ctor_type((type)::in) is semidet.
% Construct the type of the type_info for the given type.
:- pred polymorphism__build_type_info_type((type)::in, (type)::out) is det.
@@ -328,7 +325,8 @@
:- pred polymorphism__init_type_info_var((type)::in, list(prog_var)::in,
maybe(prog_var)::in, prog_var::out, hlds_goal::out,
prog_varset::in, prog_varset::out,
- map(prog_var, type)::in, map(prog_var, type)::out) is det.
+ map(prog_var, type)::in, map(prog_var, type)::out,
+ rtti_varmaps::in, rtti_varmaps::out) is det.
% init_const_type_ctor_info_var(Type, TypeCtor,
% TypeCtorInfoVar, TypeCtorInfoGoal, ModuleInfo,
@@ -350,7 +348,8 @@
:- pred polymorphism__init_const_type_ctor_info_var((type)::in, type_ctor::in,
prog_var::out, hlds_goal::out, module_info::in,
prog_varset::in, prog_varset::out,
- map(prog_var, type)::in, map(prog_var, type)::out) is det.
+ map(prog_var, type)::in, map(prog_var, type)::out,
+ rtti_varmaps::in, rtti_varmaps::out) is det.
:- type type_info_kind
---> type_info
@@ -358,7 +357,8 @@
:- pred polymorphism__new_type_info_var_raw((type)::in, type_info_kind::in,
prog_var::out, prog_varset::in, prog_varset::out,
- map(prog_var, type)::in, map(prog_var, type)::out) is det.
+ map(prog_var, type)::in, map(prog_var, type)::out,
+ rtti_varmaps::in, rtti_varmaps::out) is det.
:- implementation.
@@ -600,13 +600,12 @@
%
poly_info_get_varset(!.Info, VarSet),
poly_info_get_var_types(!.Info, VarTypes),
- poly_info_get_type_info_map(!.Info, TypeInfoMap),
- poly_info_get_typeclass_info_map(!.Info, TypeClassInfoMap),
+ poly_info_get_rtti_varmaps(!.Info, RttiVarMaps),
clauses_info_explicit_vartypes(!.ClausesInfo, ExplicitVarTypes),
set_clause_list(Clauses, ClausesRep),
map__init(TVarNameMap), % This is only used while adding the clauses.
!:ClausesInfo = clauses_info(VarSet, ExplicitVarTypes, TVarNameMap,
- VarTypes, HeadVars, ClausesRep, TypeInfoMap, TypeClassInfoMap,
+ VarTypes, HeadVars, ClausesRep, RttiVarMaps,
!.ClausesInfo ^ have_foreign_clauses).
:- pred polymorphism__process_clause(pred_info::in, list(prog_var)::in,
@@ -672,15 +671,11 @@
% these fields being valid even for imported procedures.
%
clauses_info_headvars(ClausesInfo, HeadVars),
- clauses_info_typeclass_info_varmap(ClausesInfo,
- TypeClassInfoVarMap),
- clauses_info_type_info_varmap(ClausesInfo, TypeInfoVarMap),
+ clauses_info_rtti_varmaps(ClausesInfo, RttiVarMaps),
clauses_info_varset(ClausesInfo, VarSet),
clauses_info_vartypes(ClausesInfo, VarTypes),
proc_info_set_headvars(HeadVars, !ProcInfo),
- proc_info_set_typeclass_info_varmap(TypeClassInfoVarMap,
- !ProcInfo),
- proc_info_set_typeinfo_varmap(TypeInfoVarMap, !ProcInfo),
+ proc_info_set_rtti_varmaps(RttiVarMaps, !ProcInfo),
proc_info_set_varset(VarSet, !ProcInfo),
proc_info_set_vartypes(VarTypes, !ProcInfo)
;
@@ -756,10 +751,11 @@
ArgTypeVarSet, UnconstrainedInstanceTypeInfoVars, !Info),
polymorphism__make_typeclass_info_head_vars(InstanceConstraints,
InstanceHeadTypeClassInfoVars, !Info),
- poly_info_get_typeclass_info_map(!.Info, TCVarMap0),
- map__det_insert_from_corresponding_lists(TCVarMap0,
- InstanceConstraints, InstanceHeadTypeClassInfoVars, TCVarMap),
- poly_info_set_typeclass_info_map(TCVarMap, !Info),
+ poly_info_get_rtti_varmaps(!.Info, RttiVarMaps0),
+ list__foldl_corresponding(rtti_det_insert_typeclass_info_var,
+ InstanceConstraints, InstanceHeadTypeClassInfoVars,
+ RttiVarMaps0, RttiVarMaps),
+ poly_info_set_rtti_varmaps(RttiVarMaps, !Info),
list__append(UnconstrainedInstanceTypeInfoVars,
InstanceHeadTypeClassInfoVars, ExtraHeadVars0),
in_mode(InMode),
@@ -802,13 +798,11 @@
ClassContext = constraints(UnivConstraints, ExistConstraints),
polymorphism__make_typeclass_info_head_vars(ExistConstraints,
ExistHeadTypeClassInfoVars, !Info),
- poly_info_get_type_info_map(!.Info, TypeInfoMap1),
- map__keys(TypeInfoMap1, ExistConstrainedTVars),
+ rtti_varmaps_tvars(!.Info ^ rtti_varmaps, ExistConstrainedTVars),
polymorphism__make_typeclass_info_head_vars(UnivConstraints,
UnivHeadTypeClassInfoVars, !Info),
- poly_info_get_type_info_map(!.Info, TypeInfoMap3),
- map__keys(TypeInfoMap3, UnivConstrainedTVars),
+ rtti_varmaps_tvars(!.Info ^ rtti_varmaps, UnivConstrainedTVars),
list__append(UnivHeadTypeClassInfoVars, ExistHeadTypeClassInfoVars,
ExtraHeadTypeClassInfoVars),
@@ -877,34 +871,36 @@
ExtraArgModes),
%
- % Add the locations of the typeinfos
- % for unconstrained, universally quantified type variables.
- % to the initial tvar->type_info_var mapping
- %
- ToLocn = (pred(TheVar::in, TheLocn::out) is det :-
- TheLocn = type_info(TheVar)),
-
- list__map(ToLocn, UnivHeadTypeInfoVars, UnivTypeLocns),
- map__det_insert_from_corresponding_lists(TypeInfoMap3,
- UnconstrainedUnivTVars, UnivTypeLocns, TypeInfoMap4),
-
- list__map(ToLocn, ExistHeadTypeInfoVars, ExistTypeLocns),
- map__det_insert_from_corresponding_lists(TypeInfoMap4,
- UnconstrainedExistTVars, ExistTypeLocns, TypeInfoMap5),
-
- list__map(ToLocn, UnconstrainedInstanceTypeInfoVars,
- UnconstrainedInstanceTypeLocns),
- map__det_insert_from_corresponding_lists(TypeInfoMap5,
- UnconstrainedInstanceTVars, UnconstrainedInstanceTypeLocns,
- TypeInfoMap6),
-
- poly_info_set_type_info_map(TypeInfoMap6, !Info),
-
- % Make a map of the locations of the typeclass_infos
- poly_info_get_typeclass_info_map(!.Info, TypeClassInfoMap0),
- map__set_from_corresponding_lists(TypeClassInfoMap0,
- UnivConstraints, UnivHeadTypeClassInfoVars, TypeClassInfoMap),
- poly_info_set_typeclass_info_map(TypeClassInfoMap, !Info).
+ % Add the locations of the typeinfos for unconstrained, universally
+ % quantified type variables to the initial rtti_varmaps. Also add the
+ % locations of typeclass_infos.
+ %
+ some [!RttiVarMaps] (
+ poly_info_get_rtti_varmaps(!.Info, !:RttiVarMaps),
+
+ ToLocn = (pred(TheVar::in, TheLocn::out) is det :-
+ TheLocn = type_info(TheVar)),
+
+ list__map(ToLocn, UnivHeadTypeInfoVars, UnivTypeLocns),
+ list__foldl_corresponding(rtti_det_insert_type_info_locn,
+ UnconstrainedUnivTVars, UnivTypeLocns, !RttiVarMaps),
+
+ list__map(ToLocn, ExistHeadTypeInfoVars, ExistTypeLocns),
+ list__foldl_corresponding(rtti_det_insert_type_info_locn,
+ UnconstrainedExistTVars, ExistTypeLocns, !RttiVarMaps),
+
+ list__map(ToLocn, UnconstrainedInstanceTypeInfoVars,
+ UnconstrainedInstanceTypeLocns),
+ list__foldl_corresponding(rtti_det_insert_type_info_locn,
+ UnconstrainedInstanceTVars,
+ UnconstrainedInstanceTypeLocns, !RttiVarMaps),
+
+ list__foldl_corresponding(rtti_set_typeclass_info_var,
+ UnivConstraints, UnivHeadTypeClassInfoVars,
+ !RttiVarMaps),
+
+ poly_info_set_rtti_varmaps(!.RttiVarMaps, !Info)
+ ).
% XXX the following code ought to be rewritten to handle
% existential/universal type_infos and type_class_infos
@@ -1200,16 +1196,17 @@
% This variant is for use by modecheck_unify.m.
% During mode-checking all the type-infos should appear in
% the type_info_varmap.
-polymorphism__unification_typeinfos(Type, TypeInfoMap, !Unification,
+polymorphism__unification_typeinfos(Type, RttiVarMaps, !Unification,
!GoalInfo) :-
%
% Compute the type_info/type_class_info variables that would be
% used if this unification ends up being a complicated_unify.
%
prog_type__vars(Type, TypeVars),
- map__apply_to_list(TypeVars, TypeInfoMap, TypeInfoLocns),
- polymorphism__add_unification_typeinfos(TypeInfoLocns,
- !Unification, !GoalInfo).
+ list__map(rtti_lookup_type_info_locn(RttiVarMaps), TypeVars,
+ TypeInfoLocns),
+ polymorphism__add_unification_typeinfos(TypeInfoLocns, !Unification,
+ !GoalInfo).
:- pred polymorphism__add_unification_typeinfos(list(type_info_locn)::in,
unification::in, unification::out,
@@ -2005,19 +2002,18 @@
list(prog_var)::in, poly_info::in, poly_info::out) is det.
polymorphism__update_typeclass_infos(Constraints, Vars, !Info) :-
- poly_info_get_typeclass_info_map(!.Info, TypeClassInfoMap0),
- insert_typeclass_info_locns(Constraints, Vars,
- TypeClassInfoMap0, TypeClassInfoMap),
- poly_info_set_typeclass_info_map(TypeClassInfoMap, !Info).
+ poly_info_get_rtti_varmaps(!.Info, RttiVarMaps0),
+ insert_typeclass_info_locns(Constraints, Vars, RttiVarMaps0,
+ RttiVarMaps),
+ poly_info_set_rtti_varmaps(RttiVarMaps, !Info).
:- pred insert_typeclass_info_locns(list(prog_constraint)::in,
- list(prog_var)::in,
- typeclass_info_varmap::in, typeclass_info_varmap::out) is det.
+ list(prog_var)::in, rtti_varmaps::in, rtti_varmaps::out) is det.
-insert_typeclass_info_locns([], [], !TypeClassInfoMap).
-insert_typeclass_info_locns([C | Cs], [V | Vs], !TypeClassInfoMap) :-
- map__set(!.TypeClassInfoMap, C, V, !:TypeClassInfoMap),
- insert_typeclass_info_locns(Cs, Vs, !TypeClassInfoMap).
+insert_typeclass_info_locns([], [], !RttiVarMaps).
+insert_typeclass_info_locns([C | Cs], [V | Vs], !RttiVarMaps) :-
+ rtti_set_typeclass_info_var(C, V, !RttiVarMaps),
+ insert_typeclass_info_locns(Cs, Vs, !RttiVarMaps).
insert_typeclass_info_locns([], [_ | _], _, _) :-
error("polymorphism:insert_typeclass_info_locns").
insert_typeclass_info_locns([_ | _], [], _, _) :-
@@ -2050,8 +2046,7 @@
(
% optimize common case
ExistQVars = [],
- poly_info_get_type_info_map(!.Info, TypeVarMap),
- map__is_empty(TypeVarMap)
+ rtti_varmaps_no_tvars(!.Info ^ rtti_varmaps)
->
Goal = Goal0
;
@@ -2082,9 +2077,8 @@
polymorphism__fixup_lambda_quantification(ArgVars, LambdaVars, ExistQVars,
!Goal, NewOutsideVars, !Info) :-
- poly_info_get_type_info_map(!.Info, TypeVarMap),
- poly_info_get_typeclass_info_map(!.Info, TypeClassVarMap),
- ( map__is_empty(TypeVarMap) ->
+ poly_info_get_rtti_varmaps(!.Info, RttiVarMaps),
+ ( rtti_varmaps_no_tvars(RttiVarMaps) ->
set__init(NewOutsideVars)
;
poly_info_get_varset(!.Info, VarSet0),
@@ -2094,9 +2088,8 @@
set__insert_list(NonLocals, ArgVars, NonLocalsPlusArgs0),
set__insert_list(NonLocalsPlusArgs0, LambdaVars,
NonLocalsPlusArgs),
- goal_util__extra_nonlocal_typeinfos(TypeVarMap,
- TypeClassVarMap, VarTypes0, ExistQVars,
- NonLocalsPlusArgs, NewOutsideVars),
+ goal_util__extra_nonlocal_typeinfos(RttiVarMaps, VarTypes0,
+ ExistQVars, NonLocalsPlusArgs, NewOutsideVars),
set__union(NonLocals, NewOutsideVars, OutsideVars),
implicitly_quantify_goal(OutsideVars, _Warnings, !Goal,
VarSet0, VarSet, VarTypes0, VarTypes),
@@ -2112,9 +2105,9 @@
%
% Constraints should be renamed-apart and actual-to-formal substituted constraints.
%
-% Constraints which are already in the TypeClassInfoMap are assumed to
+% Constraints which are already in the rtti_varmaps are assumed to
% have already had their typeclass_infos initialized; for them, we
-% just return the variable in the TypeClassInfoMap.
+% just return the variable in the rtti_varmaps.
:- pred polymorphism__make_typeclass_info_vars(list(prog_constraint)::in,
existq_tvars::in, prog_context::in,
@@ -2162,7 +2155,8 @@
polymorphism__make_typeclass_info_var(Constraint, Seen, ExistQVars,
Context, !ExtraGoals, !Info, MaybeVar) :-
(
- map__search(!.Info ^ typeclass_info_map, Constraint, Var)
+ rtti_search_typeclass_info_var(!.Info ^ rtti_varmaps,
+ Constraint, Var)
->
% We already have a typeclass_info for this constraint,
% either from a parameter to the pred or from an
@@ -2184,9 +2178,10 @@
;
polymorphism__make_typeclass_info_head_var(Constraint,
NewVar, !Info),
- map__det_insert(!.Info ^ typeclass_info_map, Constraint,
- NewVar, NewTypeClassInfoMap),
- !:Info = (!.Info ^ typeclass_info_map := NewTypeClassInfoMap),
+ poly_info_get_rtti_varmaps(!.Info, RttiVarMaps0),
+ rtti_det_insert_typeclass_info_var(Constraint, NewVar,
+ RttiVarMaps0, RttiVarMaps),
+ poly_info_set_rtti_varmaps(RttiVarMaps, !Info),
MaybeVar = yes(NewVar)
).
@@ -2228,9 +2223,8 @@
ClassId, InstanceNum, ExistQVars, Context, MaybeVar,
!ExtraGoals, !Info) :-
Constraint = constraint(_ClassName, ConstrainedTypes),
- !.Info = poly_info(_VarSet0, _VarTypes0, TypeVarSet, _TypeInfoMap0,
- _TypeClassInfoMap0, Proofs, _ConstraintMap, _PredName,
- ModuleInfo),
+ !.Info = poly_info(_VarSet0, _VarTypes0, TypeVarSet, _RttiVarMaps0,
+ Proofs, _ConstraintMap, _PredName, ModuleInfo),
module_info_instances(ModuleInfo, InstanceTable),
map__lookup(InstanceTable, ClassId, InstanceList),
@@ -2323,9 +2317,8 @@
polymorphism__make_typeclass_info_from_subclass(Constraint,
Seen, ClassId, SubClassConstraint, ExistQVars, Context,
MaybeVar, !ExtraGoals, !Info) :-
- !.Info = poly_info(VarSet0, VarTypes0, TypeVarSet, TypeInfoMap0,
- TypeClassInfoMap0, Proofs, ConstraintMap, PredName,
- ModuleInfo),
+ !.Info = poly_info(VarSet0, VarTypes0, TypeVarSet, RttiVarMaps,
+ Proofs, ConstraintMap, PredName, ModuleInfo),
ClassId = class_id(ClassName, _ClassArity),
% First create a variable to hold the new typeclass_info.
unqualify_name(ClassName, ClassNameString),
@@ -2336,9 +2329,8 @@
SubClassConstraint = constraint(SubClassName, SubClassTypes),
list__length(SubClassTypes, SubClassArity),
SubClassId = class_id(SubClassName, SubClassArity),
- !:Info = poly_info(VarSet1, VarTypes1, TypeVarSet, TypeInfoMap0,
- TypeClassInfoMap0, Proofs, ConstraintMap, PredName,
- ModuleInfo),
+ !:Info = poly_info(VarSet1, VarTypes1, TypeVarSet, RttiVarMaps,
+ Proofs, ConstraintMap, PredName, ModuleInfo),
% Make the typeclass_info for the subclass
polymorphism__make_typeclass_info_var(SubClassConstraint, Seen,
@@ -2559,7 +2551,7 @@
polymorphism__make_existq_typeclass_info_vars(ExistentialConstraints,
ExtraTypeClassVars, ExtraGoals, !Info) :-
- poly_info_get_type_info_map(!.Info, OldTypeInfoMap),
+ poly_info_get_rtti_varmaps(!.Info, OldRttiVarMaps),
polymorphism__make_typeclass_info_head_vars(ExistentialConstraints,
ExtraTypeClassVars, !Info),
polymorphism__update_typeclass_infos(ExistentialConstraints,
@@ -2567,7 +2559,7 @@
constraint_list_get_tvars(ExistentialConstraints, TVars0),
list__sort_and_remove_dups(TVars0, TVars),
- list__foldl2(polymorphism__maybe_extract_type_info(OldTypeInfoMap),
+ list__foldl2(polymorphism__maybe_extract_type_info(OldRttiVarMaps),
TVars, [], ExtraGoals, !Info).
% For code which requires mode reordering, we may have already
@@ -2576,16 +2568,17 @@
% before, we assume that it is unconstrained. If it turns out that
% the type variable is constrained, and the type_info is contained
% in a typeclass_info, we need to generate code to extract it here.
-:- pred polymorphism__maybe_extract_type_info(type_info_varmap::in,
+:- pred polymorphism__maybe_extract_type_info(rtti_varmaps::in,
tvar::in, list(hlds_goal)::in, list(hlds_goal)::out,
poly_info::in, poly_info::out) is det.
-polymorphism__maybe_extract_type_info(OldTypeInfoMap, TVar, !ExtraGoals,
+polymorphism__maybe_extract_type_info(OldRttiVarMaps, TVar, !ExtraGoals,
!Info) :-
- poly_info_get_type_info_map(!.Info, TypeInfoMap),
+ poly_info_get_rtti_varmaps(!.Info, RttiVarMaps),
(
- map__search(OldTypeInfoMap, TVar, type_info(TypeInfoVar0)),
- map__search(TypeInfoMap, TVar,
+ rtti_search_type_info_locn(OldRttiVarMaps, TVar,
+ type_info(TypeInfoVar0)),
+ rtti_search_type_info_locn(RttiVarMaps, TVar,
typeclass_info(TypeClassInfoVar, Index))
->
extract_type_info(TVar, TypeClassInfoVar,
@@ -2666,8 +2659,10 @@
% then all we need to do is to extract the type_info variable
% from its location.
%
- poly_info_get_type_info_map(!.Info, TypeInfoMap0),
- ( map__search(TypeInfoMap0, TypeVar, TypeInfoLocn0) ->
+ (
+ rtti_search_type_info_locn(!.Info ^ rtti_varmaps, TypeVar,
+ TypeInfoLocn0)
+ ->
TypeInfoLocn = TypeInfoLocn0
;
%
@@ -2680,15 +2675,16 @@
% and the variable occurs in an existential type-class
% constraint. In that case the type-info will be stored
% in the typeclass_info variable produced by the predicate,
- % not in a type_info variable. make_typeclass_info_headvar
+ % not in a type_info variable. maybe_extract_type_info
% will fix this up when the typeclass_info is created.
%
prog_type__var(Type, TypeVar),
polymorphism__new_type_info_var(Type, type_info, Var, !Info),
TypeInfoLocn = type_info(Var),
- map__det_insert(TypeInfoMap0, TypeVar, TypeInfoLocn,
- TypeInfoMap),
- poly_info_set_type_info_map(TypeInfoMap, !Info)
+ poly_info_get_rtti_varmaps(!.Info, RttiVarMaps0),
+ rtti_det_insert_type_info_locn(TypeVar, TypeInfoLocn,
+ RttiVarMaps0, RttiVarMaps),
+ poly_info_set_rtti_varmaps(RttiVarMaps, !Info)
).
:- pred polymorphism__construct_type_info((type)::in, type_ctor::in,
@@ -2704,16 +2700,20 @@
poly_info_get_varset(!.Info, VarSet1),
poly_info_get_var_types(!.Info, VarTypes1),
poly_info_get_module_info(!.Info, ModuleInfo),
+ poly_info_get_rtti_varmaps(!.Info, RttiVarMaps1),
polymorphism__init_const_type_ctor_info_var(Type, TypeCtor,
TypeCtorVar, TypeCtorGoal, ModuleInfo,
- VarSet1, VarSet2, VarTypes1, VarTypes2),
+ VarSet1, VarSet2, VarTypes1, VarTypes2,
+ RttiVarMaps1, RttiVarMaps2),
polymorphism__maybe_init_second_cell(Type, TypeCtorVar,
TypeCtorIsVarArity, ArgTypeInfoVars, Context, Var,
VarSet2, VarSet, VarTypes2, VarTypes,
+ RttiVarMaps2, RttiVarMaps,
ArgTypeInfoGoals, [TypeCtorGoal], ExtraGoals),
- poly_info_set_varset_and_types(VarSet, VarTypes, !Info).
+ poly_info_set_varset_and_types(VarSet, VarTypes, !Info),
+ poly_info_set_rtti_varmaps(RttiVarMaps, !Info).
% maybe_init_second_cell(Type, TypeCtorVar, TypeCtorIsVarArity,
% ArgTypeInfoVars, Context, Var, VarSet0, VarSet,
@@ -2745,11 +2745,12 @@
bool::in, list(prog_var)::in, prog_context::in, prog_var::out,
prog_varset::in, prog_varset::out,
map(prog_var, type)::in, map(prog_var, type)::out,
+ rtti_varmaps::in, rtti_varmaps::out,
list(hlds_goal)::in, list(hlds_goal)::in, list(hlds_goal)::out) is det.
polymorphism__maybe_init_second_cell(Type, TypeCtorVar, TypeCtorIsVarArity,
ArgTypeInfoVars, _Context, Var, !VarSet, !VarTypes,
- ArgTypeInfoGoals, ExtraGoals0, ExtraGoals) :-
+ !RttiVarMaps, ArgTypeInfoGoals, ExtraGoals0, ExtraGoals) :-
(
TypeCtorIsVarArity = yes,
% Unfortunately, if the type's type constructor has variable
@@ -2759,7 +2760,8 @@
ArityGoal, ArityVar, !VarTypes, !VarSet),
polymorphism__init_type_info_var(Type,
[TypeCtorVar, ArityVar | ArgTypeInfoVars],
- no, Var, TypeInfoGoal, !VarSet, !VarTypes),
+ no, Var, TypeInfoGoal, !VarSet, !VarTypes,
+ !RttiVarMaps),
list__append([ArityGoal | ArgTypeInfoGoals], [TypeInfoGoal],
ExtraGoals1),
list__append(ExtraGoals0, ExtraGoals1, ExtraGoals)
@@ -2769,7 +2771,8 @@
ArgTypeInfoVars = [_ | _],
polymorphism__init_type_info_var(Type,
[TypeCtorVar | ArgTypeInfoVars], no, Var,
- TypeInfoGoal, !VarSet, !VarTypes),
+ TypeInfoGoal, !VarSet, !VarTypes,
+ !RttiVarMaps),
list__append(ArgTypeInfoGoals, [TypeInfoGoal],
ExtraGoals1),
list__append(ExtraGoals0, ExtraGoals1, ExtraGoals)
@@ -2857,7 +2860,7 @@
polymorphism__get_category_name(base_typeclass_info_type) = no.
polymorphism__init_type_info_var(Type, ArgVars, MaybePreferredVar, TypeInfoVar,
- TypeInfoGoal, !VarSet, !VarTypes) :-
+ TypeInfoGoal, !VarSet, !VarTypes, !RttiVarMaps) :-
( type_to_ctor_and_args(Type, Ctor, _) ->
Cell = type_info_cell(Ctor)
;
@@ -2873,7 +2876,7 @@
;
MaybePreferredVar = no,
polymorphism__new_type_info_var_raw(Type, type_info,
- TypeInfoVar, !VarSet, !VarTypes)
+ TypeInfoVar, !VarSet, !VarTypes, !RttiVarMaps)
),
% create the construction unification to initialize the variable
@@ -2905,7 +2908,8 @@
TypeInfoGoal = Unify - GoalInfo.
polymorphism__init_const_type_ctor_info_var(Type, TypeCtor, TypeCtorInfoVar,
- TypeCtorInfoGoal, ModuleInfo, !VarSet, !VarTypes) :-
+ TypeCtorInfoGoal, ModuleInfo, !VarSet, !VarTypes,
+ !RttiVarMaps) :-
type_util__type_ctor_module(ModuleInfo, TypeCtor, ModuleName),
type_util__type_ctor_name(ModuleInfo, TypeCtor, TypeName),
TypeCtor = _ - Arity,
@@ -2914,7 +2918,7 @@
% introduce a new variable
polymorphism__new_type_info_var_raw(Type, type_ctor_info,
- TypeCtorInfoVar, !VarSet, !VarTypes),
+ TypeCtorInfoVar, !VarSet, !VarTypes, !RttiVarMaps),
% create the construction unification to initialize the variable
Unification = construct(TypeCtorInfoVar, ConsId, [], [],
@@ -2962,21 +2966,29 @@
polymorphism__new_type_info_var(Type, Kind, Var, !Info) :-
poly_info_get_varset(!.Info, VarSet0),
poly_info_get_var_types(!.Info, VarTypes0),
+ poly_info_get_rtti_varmaps(!.Info, RttiVarMaps0),
polymorphism__new_type_info_var_raw(Type, Kind, Var,
- VarSet0, VarSet, VarTypes0, VarTypes),
- poly_info_set_varset_and_types(VarSet, VarTypes, !Info).
+ VarSet0, VarSet, VarTypes0, VarTypes,
+ RttiVarMaps0, RttiVarMaps),
+ poly_info_set_varset_and_types(VarSet, VarTypes, !Info),
+ poly_info_set_rtti_varmaps(RttiVarMaps, !Info).
-polymorphism__new_type_info_var_raw(Type, Kind, Var, !VarSet, !VarTypes) :-
+polymorphism__new_type_info_var_raw(Type, Kind, Var, !VarSet, !VarTypes,
+ !RttiVarMaps) :-
% introduce new variable
varset__new_var(!.VarSet, Var, !:VarSet),
term__var_to_int(Var, VarNum),
string__int_to_string(VarNum, VarNumStr),
(
Kind = type_info,
- Prefix = typeinfo_prefix
+ Prefix = typeinfo_prefix,
+ rtti_det_insert_type_info_type(Var, Type, !RttiVarMaps)
;
Kind = type_ctor_info,
Prefix = typectorinfo_prefix
+
+ % XXX perhaps we should record the variables holding
+ % type_ctor_infos in the rtti_varmaps somewhere.
),
string__append(Prefix, VarNumStr, Name),
varset__name_var(!.VarSet, Var, Name, !:VarSet),
@@ -3021,18 +3033,21 @@
!Info) :-
poly_info_get_varset(!.Info, VarSet0),
poly_info_get_var_types(!.Info, VarTypes0),
+ poly_info_get_rtti_varmaps(!.Info, RttiVarMaps0),
poly_info_get_module_info(!.Info, ModuleInfo),
polymorphism__gen_extract_type_info(TypeVar, TypeClassInfoVar, Index,
- ModuleInfo, Goals, TypeInfoVar,
- VarSet0, VarSet, VarTypes0, VarTypes),
- poly_info_set_varset_and_types(VarSet, VarTypes, !Info).
+ ModuleInfo, Goals, TypeInfoVar, VarSet0, VarSet,
+ VarTypes0, VarTypes, RttiVarMaps0, RttiVarMaps),
+ poly_info_set_varset_and_types(VarSet, VarTypes, !Info),
+ poly_info_set_rtti_varmaps(RttiVarMaps, !Info).
polymorphism__gen_extract_type_info(TypeVar, TypeClassInfoVar, Index,
- ModuleInfo, Goals, TypeInfoVar, !VarSet, !VarTypes) :-
+ ModuleInfo, Goals, TypeInfoVar, !VarSet, !VarTypes,
+ !RttiVarMaps) :-
make_int_const_construction(Index, yes("TypeInfoIndex"),
IndexGoal, IndexVar, !VarTypes, !VarSet),
polymorphism__new_type_info_var_raw(term__variable(TypeVar), type_info,
- TypeInfoVar, !VarSet, !VarTypes),
+ TypeInfoVar, !VarSet, !VarTypes, !RttiVarMaps),
goal_util__generate_simple_call(mercury_private_builtin_module,
"type_info_from_typeclass_info", predicate, only_mode, det,
[TypeClassInfoVar, IndexVar, TypeInfoVar], [],
@@ -3057,13 +3072,15 @@
prog_var::out, poly_info::in, poly_info::out) is det.
polymorphism__make_typeclass_info_head_var(Constraint, ExtraHeadVar, !Info) :-
- poly_info_get_typeclass_info_map(!.Info, TypeClassInfoMap),
- ( map__search(TypeClassInfoMap, Constraint, ExistingVar) ->
+ poly_info_get_rtti_varmaps(!.Info, RttiVarMaps0),
+ (
+ rtti_search_typeclass_info_var(RttiVarMaps0, Constraint,
+ ExistingVar)
+ ->
ExtraHeadVar = ExistingVar
;
poly_info_get_varset(!.Info, VarSet0),
poly_info_get_var_types(!.Info, VarTypes0),
- poly_info_get_type_info_map(!.Info, TypeInfoMap0),
poly_info_get_module_info(!.Info, ModuleInfo),
Constraint = constraint(ClassName0, ClassTypes),
@@ -3112,7 +3129,7 @@
IsNew = (pred(TypeVar0::in) is semidet :-
TypeVar0 = TypeVar - _Index,
(
- map__search(TypeInfoMap0,
+ rtti_search_type_info_locn(RttiVarMaps0,
TypeVar, TypeInfoLocn)
->
TypeInfoLocn = type_info(_)
@@ -3126,18 +3143,17 @@
% new type variable. The type variable can be found at
% the previously calculated offset with the new
% typeclass_info
- MakeEntry = (pred(IndexedTypeVar::in,
- LocnMap0::in, LocnMap::out) is det :-
- IndexedTypeVar = TheTypeVar - Location,
- map__set(LocnMap0, TheTypeVar,
- typeclass_info(ExtraHeadVar, Location),
- LocnMap)
+ MakeEntry = (pred(IndexedTypeVar::in, R0::in, R::out) is det :-
+ IndexedTypeVar = TheTypeVar - Index,
+ Location = typeclass_info(ExtraHeadVar, Index),
+ rtti_set_type_info_locn(TheTypeVar, Location,
+ R0, R)
),
- list__foldl(MakeEntry, NewClassTypeVars, TypeInfoMap0,
- TypeInfoMap1),
+ list__foldl(MakeEntry, NewClassTypeVars, RttiVarMaps0,
+ RttiVarMaps),
poly_info_set_varset_and_types(VarSet1, VarTypes1, !Info),
- poly_info_set_type_info_map(TypeInfoMap1, !Info)
+ poly_info_set_rtti_varmaps(RttiVarMaps, !Info)
).
:- pred is_pair(pair(_, _)::in) is det.
@@ -3172,24 +3188,16 @@
%---------------------------------------------------------------------------%
-polymorphism__typeclass_info_class_constraint(TypeClassInfoType, Constraint) :-
+polymorphism__type_is_typeclass_info(TypeClassInfoType) :-
PrivateBuiltin = mercury_private_builtin_module,
type_to_ctor_and_args(TypeClassInfoType,
qualified(PrivateBuiltin, "typeclass_info") - 1,
- [ConstraintTerm]),
-
- % type_to_ctor_and_args fails on `constraint/n', so we use
- % `sym_name_and_args' instead.
- sym_name_and_args(ConstraintTerm,
- qualified(PrivateBuiltin, "constraint"),
- [ClassNameTerm | ArgTypes]),
- sym_name_and_args(ClassNameTerm, ClassName, []),
- Constraint = constraint(ClassName, ArgTypes).
+ [_ConstraintTerm]).
-polymorphism__type_info_or_ctor_type(TypeInfoType, Type) :-
+polymorphism__type_is_type_info_or_ctor_type(TypeInfoType) :-
type_to_ctor_and_args(TypeInfoType,
qualified(mercury_private_builtin_module, TypeName) - 1,
- [Type]),
+ [_Type]),
( TypeName = "type_info" ; TypeName = "type_ctor_info" ).
polymorphism__build_type_info_type(Type, TypeInfoType) :-
@@ -3309,8 +3317,9 @@
error("expand_one_body: class method is not constrained")
),
- proc_info_typeclass_info_varmap(ProcInfo0, VarMap),
- map__lookup(VarMap, InstanceConstraint, TypeClassInfoVar),
+ proc_info_rtti_varmaps(ProcInfo0, RttiVarMaps),
+ rtti_lookup_typeclass_info_var(RttiVarMaps, InstanceConstraint,
+ TypeClassInfoVar),
proc_info_headvars(ProcInfo0, HeadVars0),
proc_info_argmodes(ProcInfo0, Modes0),
@@ -3402,18 +3411,9 @@
varset :: prog_varset,
vartypes :: vartypes,
typevarset :: tvarset,
-
- type_info_varmap :: type_info_varmap,
- % specifies the location of
- % the type_info var
- % for each of the pred's type
- % parameters
-
- typeclass_info_map :: typeclass_info_varmap,
- % specifies the location of
- % the typeclass_info var
- % for each of the pred's class
- % constraints
+ rtti_varmaps :: rtti_varmaps,
+ % Gives information about the locations
+ % of type_infos and typeclass_infos.
proof_map :: constraint_proof_map,
% specifies why each constraint
% that was eliminated from the
@@ -3450,10 +3450,9 @@
pred_info_typevarset(PredInfo, TypeVarSet),
pred_info_get_constraint_proofs(PredInfo, Proofs),
pred_info_get_constraint_map(PredInfo, ConstraintMap),
- map__init(TypeInfoMap),
- map__init(TypeClassInfoMap),
- PolyInfo = poly_info(VarSet, VarTypes, TypeVarSet, TypeInfoMap,
- TypeClassInfoMap, Proofs, ConstraintMap, PredInfo, ModuleInfo).
+ rtti_varmaps_init(RttiVarMaps),
+ PolyInfo = poly_info(VarSet, VarTypes, TypeVarSet, RttiVarMaps,
+ Proofs, ConstraintMap, PredInfo, ModuleInfo).
% create_poly_info creates a poly_info for an existing procedure.
% (See also init_poly_info.)
@@ -3463,10 +3462,9 @@
pred_info_get_constraint_map(PredInfo, ConstraintMap),
proc_info_varset(ProcInfo, VarSet),
proc_info_vartypes(ProcInfo, VarTypes),
- proc_info_typeinfo_varmap(ProcInfo, TypeInfoMap),
- proc_info_typeclass_info_varmap(ProcInfo, TypeClassInfoMap),
- PolyInfo = poly_info(VarSet, VarTypes, TypeVarSet, TypeInfoMap,
- TypeClassInfoMap, Proofs, ConstraintMap, PredInfo, ModuleInfo).
+ proc_info_rtti_varmaps(ProcInfo, RttiVarMaps),
+ PolyInfo = poly_info(VarSet, VarTypes, TypeVarSet, RttiVarMaps,
+ Proofs, ConstraintMap, PredInfo, ModuleInfo).
% create_poly_info creates a poly_info for a call.
% (See also init_poly_info.)
@@ -3475,21 +3473,18 @@
pred_info_typevarset(PredInfo, TypeVarSet),
pred_info_get_constraint_proofs(PredInfo, Proofs),
pred_info_get_constraint_map(PredInfo, ConstraintMap),
- proc_info_typeinfo_varmap(ProcInfo, TypeInfoMap),
- proc_info_typeclass_info_varmap(ProcInfo, TypeClassInfoMap),
- PolyInfo = poly_info(VarSet, VarTypes, TypeVarSet, TypeInfoMap,
- TypeClassInfoMap, Proofs, ConstraintMap, PredInfo, ModuleInfo).
+ proc_info_rtti_varmaps(ProcInfo, RttiVarMaps),
+ PolyInfo = poly_info(VarSet, VarTypes, TypeVarSet, RttiVarMaps,
+ Proofs, ConstraintMap, PredInfo, ModuleInfo).
poly_info_extract(Info, !PredInfo, !ProcInfo, ModuleInfo) :-
- Info = poly_info(VarSet, VarTypes, TypeVarSet, TypeInfoMap,
- TypeclassInfoLocations, _Proofs, _ConstraintMap, _OldPredInfo,
- ModuleInfo),
+ Info = poly_info(VarSet, VarTypes, TypeVarSet, RttiVarMaps, _Proofs,
+ _ConstraintMap, _OldPredInfo, ModuleInfo),
% set the new values of the fields in proc_info and pred_info
proc_info_set_varset(VarSet, !ProcInfo),
proc_info_set_vartypes(VarTypes, !ProcInfo),
- proc_info_set_typeinfo_varmap(TypeInfoMap, !ProcInfo),
- proc_info_set_typeclass_info_varmap(TypeclassInfoLocations, !ProcInfo),
+ proc_info_set_rtti_varmaps(RttiVarMaps, !ProcInfo),
pred_info_set_typevarset(TypeVarSet, !PredInfo).
%---------------------------------------------------------------------------%
@@ -3497,10 +3492,7 @@
:- pred poly_info_get_varset(poly_info::in, prog_varset::out) is det.
:- pred poly_info_get_var_types(poly_info::in, vartypes::out) is det.
:- pred poly_info_get_typevarset(poly_info::in, tvarset::out) is det.
-:- pred poly_info_get_type_info_map(poly_info::in, type_info_varmap::out)
- is det.
-:- pred poly_info_get_typeclass_info_map(poly_info::in,
- typeclass_info_varmap::out) is det.
+:- pred poly_info_get_rtti_varmaps(poly_info::in, rtti_varmaps::out) is det.
:- pred poly_info_get_proofs(poly_info::in, constraint_proof_map::out) is det.
:- pred poly_info_get_constraint_map(poly_info::in, constraint_map::out)
is det.
@@ -3510,8 +3502,7 @@
poly_info_get_varset(PolyInfo, PolyInfo ^ varset).
poly_info_get_var_types(PolyInfo, PolyInfo ^ vartypes).
poly_info_get_typevarset(PolyInfo, PolyInfo ^ typevarset).
-poly_info_get_type_info_map(PolyInfo, PolyInfo ^ type_info_varmap).
-poly_info_get_typeclass_info_map(PolyInfo, PolyInfo ^ typeclass_info_map).
+poly_info_get_rtti_varmaps(PolyInfo, PolyInfo ^ rtti_varmaps).
poly_info_get_proofs(PolyInfo, PolyInfo ^ proof_map).
poly_info_get_constraint_map(PolyInfo, PolyInfo ^ constraint_map).
poly_info_get_pred_info(PolyInfo, PolyInfo ^ pred_info).
@@ -3523,9 +3514,7 @@
poly_info::in, poly_info::out) is det.
:- pred poly_info_set_typevarset(tvarset::in, poly_info::in,
poly_info::out) is det.
-:- pred poly_info_set_type_info_map(type_info_varmap::in,
- poly_info::in, poly_info::out) is det.
-:- pred poly_info_set_typeclass_info_map(typeclass_info_varmap::in,
+:- pred poly_info_set_rtti_varmaps(rtti_varmaps::in,
poly_info::in, poly_info::out) is det.
:- pred poly_info_set_proofs(constraint_proof_map::in,
poly_info::in, poly_info::out) is det.
@@ -3538,9 +3527,7 @@
poly_info_set_varset_and_types(VarSet, VarTypes, PI,
(PI ^ varset := VarSet) ^ vartypes := VarTypes).
poly_info_set_typevarset(TVarSet, PI, PI ^ typevarset := TVarSet).
-poly_info_set_type_info_map(TVarMap, PI, PI ^ type_info_varmap := TVarMap).
-poly_info_set_typeclass_info_map(TypeClassInfoMap, PI,
- PI ^ typeclass_info_map := TypeClassInfoMap).
+poly_info_set_rtti_varmaps(RttiVarMaps, PI, PI ^ rtti_varmaps := RttiVarMaps).
poly_info_set_proofs(Proofs, PI, PI ^ proof_map := Proofs).
poly_info_set_constraint_map(ConstraintMap, PI,
PI ^ constraint_map := ConstraintMap).
Index: compiler/rl_exprn.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_exprn.m,v
retrieving revision 1.51
diff -u -r1.51 rl_exprn.m
--- compiler/rl_exprn.m 24 Mar 2005 05:34:14 -0000 1.51
+++ compiler/rl_exprn.m 13 Jul 2005 08:25:00 -0000
@@ -1045,8 +1045,7 @@
% type variables.
{ varset__init(TVarSet) },
{ varset__init(InstVarSet) },
- { map__init(TVarMap) },
- { map__init(TCVarMap) },
+ { rtti_varmaps_init(RttiVarMaps) },
rl_exprn_info_get_varset(VarSet0),
rl_exprn_info_get_vartypes(VarTypes0),
rl_exprn_info_get_instmap(InstMap),
@@ -1103,7 +1102,7 @@
{ PredArgs = [InputTupleVar, OutputTupleVar] },
{ hlds_pred__define_new_pred(created(aditi_rl_exprn), Goal, _CallGoal,
PredArgs, _ExtraArgs, InitialInstMap, ProcName, TVarSet,
- VarTypes, ClassContext, TVarMap, TCVarMap, VarSet, InstVarSet,
+ VarTypes, ClassContext, RttiVarMaps, VarSet, InstVarSet,
Markers, Owner, IsAddressTaken, ModuleInfo0, ModuleInfo1,
PredProcId) },
@@ -1702,10 +1701,10 @@
rl_exprn_info_get_varset(VarSet0),
rl_exprn_info_get_vartypes(VarTypes0),
{ varset__init(TVarSet0) },
- { map__init(TVarMap0) },
+ { rtti_varmaps_init(RttiVarMaps0) },
{ inlining__do_inline_call([], Args, CalledPredInfo, CalledProcInfo,
- VarSet0, VarSet, VarTypes0, VarTypes, TVarSet0, _, TVarMap0, _,
- Goal) },
+ VarSet0, VarSet, VarTypes0, VarTypes, TVarSet0, _,
+ RttiVarMaps0, _, Goal) },
rl_exprn_info_set_varset(VarSet),
rl_exprn_info_set_vartypes(VarTypes).
Index: compiler/rl_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_gen.m,v
retrieving revision 1.21
diff -u -r1.21 rl_gen.m
--- compiler/rl_gen.m 22 Mar 2005 06:40:23 -0000 1.21
+++ compiler/rl_gen.m 13 Jul 2005 08:25:37 -0000
@@ -1717,13 +1717,13 @@
{ pred_info_typevarset(PredInfo0, TypeVarSet0) },
{ proc_info_varset(ProcInfo0, VarSet0) },
{ proc_info_vartypes(ProcInfo0, VarTypes0) },
- { proc_info_typeinfo_varmap(ProcInfo0, TVarMap0) },
+ { proc_info_rtti_varmaps(ProcInfo0, RttiVarMaps0) },
{ inlining__do_inline_call(UnivQTVars, Args, CalledPredInfo,
CalledProcInfo, VarSet0, VarSet, VarTypes0, VarTypes,
- TypeVarSet0, TypeVarSet, TVarMap0, TVarMap, Goal) },
+ TypeVarSet0, TypeVarSet, RttiVarMaps0, RttiVarMaps, Goal) },
{ proc_info_set_varset(VarSet, ProcInfo0, ProcInfo1) },
{ proc_info_set_vartypes(VarTypes, ProcInfo1, ProcInfo2) },
- { proc_info_set_typeinfo_varmap(TVarMap, ProcInfo2, ProcInfo) },
+ { proc_info_set_rtti_varmaps(RttiVarMaps, ProcInfo2, ProcInfo) },
{ pred_info_set_typevarset(TypeVarSet, PredInfo0, PredInfo) },
rl_info_set_pred_info(PredInfo),
rl_info_set_proc_info(ProcInfo).
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.142
diff -u -r1.142 simplify.m
--- compiler/simplify.m 14 Jun 2005 08:15:04 -0000 1.142
+++ compiler/simplify.m 13 Jul 2005 08:58:26 -0000
@@ -215,13 +215,11 @@
simplify_info_get_varset(Info, VarSet),
simplify_info_get_var_types(Info, VarTypes),
- simplify_info_get_type_info_varmap(Info, TVarMap),
- simplify_info_get_typeclass_info_varmap(Info, TCVarMap),
+ simplify_info_get_rtti_varmaps(Info, RttiVarMaps),
proc_info_set_varset(VarSet, !ProcInfo),
proc_info_set_vartypes(VarTypes, !ProcInfo),
proc_info_set_goal(Goal, !ProcInfo),
- proc_info_set_typeinfo_varmap(TVarMap, !ProcInfo),
- proc_info_set_typeclass_info_varmap(TCVarMap, !ProcInfo),
+ proc_info_set_rtti_varmaps(RttiVarMaps, !ProcInfo),
simplify_info_get_module_info(Info, !:ModuleInfo),
simplify_info_get_msgs(Info, Msgs).
@@ -1575,8 +1573,8 @@
simplify_info::in, simplify_info::out) is det.
simplify__type_info_locn(TypeVar, TypeInfoVar, Goals, !Info) :-
- simplify_info_get_type_info_varmap(!.Info, TypeInfoMap),
- map__lookup(TypeInfoMap, TypeVar, TypeInfoLocn),
+ simplify_info_get_rtti_varmaps(!.Info, RttiVarMaps),
+ rtti_lookup_type_info_locn(RttiVarMaps, TypeVar, TypeInfoLocn),
(
% If the typeinfo is available in a variable,
% just use it
@@ -1599,12 +1597,15 @@
simplify_info_get_module_info(!.Info, ModuleInfo),
simplify_info_get_varset(!.Info, VarSet0),
simplify_info_get_var_types(!.Info, VarTypes0),
+ simplify_info_get_rtti_varmaps(!.Info, RttiVarMaps0),
polymorphism__gen_extract_type_info(TypeVar, TypeClassInfoVar, Index,
- ModuleInfo, Goals, TypeInfoVar, VarSet0, VarSet, VarTypes0, VarTypes),
+ ModuleInfo, Goals, TypeInfoVar, VarSet0, VarSet, VarTypes0, VarTypes,
+ RttiVarMaps0, RttiVarMaps),
simplify_info_set_var_types(VarTypes, !Info),
- simplify_info_set_varset(VarSet, !Info).
+ simplify_info_set_varset(VarSet, !Info),
+ simplify_info_set_rtti_varmaps(RttiVarMaps, !Info).
%-----------------------------------------------------------------------------%
@@ -1852,15 +1853,10 @@
map__keys(Subn0, RemovedVars),
varset__delete_vars(VarSet0, RemovedVars, VarSet),
simplify_info_set_varset(VarSet, !Info),
- simplify_info_get_type_info_varmap(!.Info, TVarMap0),
- apply_substitutions_to_var_map(TVarMap0,
- map__init, map__init, Subn, TVarMap),
- simplify_info_set_type_info_varmap(TVarMap, !Info),
- simplify_info_get_typeclass_info_varmap(!.Info, TCVarMap0),
- apply_substitutions_to_typeclass_var_map(TCVarMap0,
- map__init, map__init, Subn, TCVarMap),
- simplify_info_set_typeclass_info_varmap(TCVarMap,
- !Info)
+ simplify_info_get_rtti_varmaps(!.Info, RttiVarMaps0),
+ apply_substitutions_to_rtti_varmaps(map__init, map__init, Subn,
+ RttiVarMaps0, RttiVarMaps),
+ simplify_info_set_rtti_varmaps(RttiVarMaps, !Info)
)
;
Goals = Goals0
@@ -2268,20 +2264,20 @@
lambdas :: int,
% Count of the number of lambdas
% which enclose the current goal.
- type_info_varmap :: type_info_varmap,
- typeclass_info_varmap :: typeclass_info_varmap
+ rtti_varmaps :: rtti_varmaps
+ % Information about type_infos and
+ % typeclass_infos.
).
simplify_info_init(DetInfo, Simplifications, InstMap, ProcInfo, Info) :-
proc_info_varset(ProcInfo, VarSet),
proc_info_inst_varset(ProcInfo, InstVarSet),
- proc_info_typeinfo_varmap(ProcInfo, TVarMap),
- proc_info_typeclass_info_varmap(ProcInfo, TCVarMap),
+ proc_info_rtti_varmaps(ProcInfo, RttiVarMaps),
set__init(Msgs),
set__list_to_set(Simplifications, SimplificationsSet),
Info = simplify_info(DetInfo, Msgs, SimplificationsSet,
common_info_init, InstMap, VarSet, InstVarSet,
- no, no, no, 0, 0, TVarMap, TCVarMap).
+ no, no, no, 0, 0, RttiVarMaps).
% Reinitialise the simplify_info before reprocessing a goal.
:- pred simplify_info_reinit(set(simplification)::in, instmap::in,
@@ -2318,10 +2314,8 @@
:- pred simplify_info_recompute_atomic(simplify_info::in) is semidet.
:- pred simplify_info_rerun_det(simplify_info::in) is semidet.
:- pred simplify_info_get_cost_delta(simplify_info::in, int::out) is det.
-:- pred simplify_info_get_type_info_varmap(simplify_info::in,
- type_info_varmap::out) is det.
-:- pred simplify_info_get_typeclass_info_varmap(simplify_info::in,
- typeclass_info_varmap::out) is det.
+:- pred simplify_info_get_rtti_varmaps(simplify_info::in, rtti_varmaps::out)
+ is det.
:- pred simplify_info_get_module_info(simplify_info::in, module_info::out)
is det.
@@ -2344,8 +2338,7 @@
simplify_info_rerun_det(Info) :-
Info ^ rerun_det = yes.
simplify_info_get_cost_delta(Info, Info ^ cost_delta).
-simplify_info_get_type_info_varmap(Info, Info ^ type_info_varmap).
-simplify_info_get_typeclass_info_varmap(Info, Info ^ typeclass_info_varmap).
+simplify_info_get_rtti_varmaps(Info, Info ^ rtti_varmaps).
simplify_info_get_module_info(Info, ModuleInfo) :-
simplify_info_get_det_info(Info, DetInfo),
@@ -2379,9 +2372,7 @@
simplify_info::in, simplify_info::out) is det.
:- pred simplify_info_set_rerun_det(
simplify_info::in, simplify_info::out) is det.
-:- pred simplify_info_set_type_info_varmap(type_info_varmap::in,
- simplify_info::in, simplify_info::out) is det.
-:- pred simplify_info_set_typeclass_info_varmap(typeclass_info_varmap::in,
+:- pred simplify_info_set_rtti_varmaps(rtti_varmaps::in,
simplify_info::in, simplify_info::out) is det.
:- pred simplify_info_add_msg(det_msg::in,
@@ -2416,9 +2407,7 @@
simplify_info_set_recompute_atomic(Info, Info ^ recompute_atomic := yes).
simplify_info_set_rerun_det(Info, Info ^ rerun_det := yes).
simplify_info_set_cost_delta(Delta, Info, Info ^ cost_delta := Delta).
-simplify_info_set_type_info_varmap(Map, Info, Info ^ type_info_varmap := Map).
-simplify_info_set_typeclass_info_varmap(Map, Info,
- Info ^ typeclass_info_varmap := Map).
+simplify_info_set_rtti_varmaps(Rtti, Info, Info ^ rtti_varmaps := Rtti).
simplify_info_incr_cost_delta(Incr, Info,
Info ^ cost_delta := Info ^ cost_delta + Incr).
Index: compiler/size_prof.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/size_prof.m,v
retrieving revision 1.18
diff -u -r1.18 size_prof.m
--- compiler/size_prof.m 8 Apr 2005 06:50:49 -0000 1.18
+++ compiler/size_prof.m 17 Jul 2005 08:32:27 -0000
@@ -181,7 +181,7 @@
%
% The construct_transform field specifies how term sizes are to be measured.
%
-% The type_info_varmap specifies which program variables hold the type_infos
+% The rtti_varmaps specifies which program variables hold the type_infos
% of which type variables.
%
% The module_info is needed by some utility predicates called by the
@@ -204,7 +204,7 @@
varset :: prog_varset,
vartypes :: vartypes,
transform_op :: construct_transform,
- type_info_varmap :: type_info_varmap,
+ rtti_varmaps :: rtti_varmaps,
module_info :: module_info
).
@@ -237,7 +237,7 @@
proc_info_varset(!.ProcInfo, VarSet0),
proc_info_vartypes(!.ProcInfo, VarTypes0),
proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo, InstMap0),
- proc_info_typeinfo_varmap(!.ProcInfo, TypeInfoVarmap),
+ proc_info_rtti_varmaps(!.ProcInfo, RttiVarMaps),
% The with_types are needed to avoid a combinatorial explosion
% of ambiguity in the type checker.
TypeCtorMap0 = map__init `with_type` type_ctor_map,
@@ -248,10 +248,10 @@
KnownSizeMap0 = map__init `with_type` known_size_map,
Info0 = size_prof_info(TypeCtorMap0, TypeInfoMap0,
RevTypeCtorMap0, RevTypeInfoMap0, TargetTypeInfoMap0,
- KnownSizeMap0, VarSet0, VarTypes0, Transform, TypeInfoVarmap,
+ KnownSizeMap0, VarSet0, VarTypes0, Transform, RttiVarMaps,
!.ModuleInfo),
- map__to_assoc_list(TypeInfoVarmap, TypeInfoVarAssocList),
- list__foldl(record_typeinfo_in_type_info_varmap, TypeInfoVarAssocList,
+ rtti_varmaps_tvars(RttiVarMaps, TVars),
+ list__foldl(record_typeinfo_in_type_info_varmap(RttiVarMaps), TVars,
Info0, Info1),
process_goal(Goal0, Goal1, Info1, Info),
@@ -630,14 +630,16 @@
% with a type substitution such as K=int, it
% leaves the type of TypeInfo_for_K as
% type_info, not type_ctor_info.
- record_known_type_ctor_info(Var, M, N, A, !Info)
+ record_known_type_ctor_info(Var, M, N, A,
+ !Info)
;
error("size_prof__process_construct: "
++ "bad type_info")
)
; VarTypeCtorName = "type_ctor_info" ->
( ConsId = type_ctor_info_const(M, N, A) ->
- record_known_type_ctor_info(Var, M, N, A, !Info)
+ record_known_type_ctor_info(Var, M, N, A,
+ !Info)
;
error("size_prof__process_construct: "
++ "bad type_ctor_info")
@@ -872,7 +874,8 @@
no, TypeInfoVar, TypeInfoGoals, !Info)
)
; Type = term__variable(TVar) ->
- map__lookup(!.Info ^ type_info_varmap, TVar, TVarLocn),
+ rtti_lookup_type_info_locn(!.Info ^ rtti_varmaps, TVar,
+ TVarLocn),
(
TVarLocn = type_info(TypeInfoVar),
TypeInfoGoals = []
@@ -886,9 +889,12 @@
VarSet1 = VarSet0,
VarTypes1 = VarTypes0
;
+ RttiVarMaps0 = !.Info ^ rtti_varmaps,
polymorphism__new_type_info_var_raw(Type,
type_info, TypeInfoVar,
- VarSet0, VarSet1, VarTypes0, VarTypes1)
+ VarSet0, VarSet1, VarTypes0, VarTypes1,
+ RttiVarMaps0, RttiVarMaps),
+ !:Info = !.Info ^ rtti_varmaps := RttiVarMaps
),
make_int_const_construction(Slot,
yes("TypeClassInfoSlot"), SlotGoal, SlotVar,
@@ -947,6 +953,7 @@
),
VarSet2 = !.Info ^ varset,
VarTypes2 = !.Info ^ vartypes,
+ RttiVarMaps0 = !.Info ^ rtti_varmaps,
TargetTypeInfoMap = !.Info ^ target_type_info_map,
( map__search(TargetTypeInfoMap, Type, PrefTIVar) ->
MaybePreferredVar = yes(PrefTIVar)
@@ -955,9 +962,11 @@
),
polymorphism__init_type_info_var(Type, ArgVars,
MaybePreferredVar, TypeInfoVar, TypeInfoGoal,
- VarSet2, VarSet, VarTypes2, VarTypes),
+ VarSet2, VarSet, VarTypes2, VarTypes,
+ RttiVarMaps0, RttiVarMaps),
!:Info = !.Info ^ varset := VarSet,
!:Info = !.Info ^ vartypes := VarTypes,
+ !:Info = !.Info ^ rtti_varmaps := RttiVarMaps,
TypeInfoGoals = list__condense([ArgTypeInfoGoals, FrontGoals,
[TypeInfoGoal]]).
@@ -985,12 +994,15 @@
),
VarSet0 = !.Info ^ varset,
VarTypes0 = !.Info ^ vartypes,
+ RttiVarMaps0 = !.Info ^ rtti_varmaps,
polymorphism__init_const_type_ctor_info_var(Type, TypeCtor,
TypeCtorVar, TypeCtorGoal, !.Info ^ module_info,
- VarSet0, VarSet, VarTypes0, VarTypes),
+ VarSet0, VarSet, VarTypes0, VarTypes,
+ RttiVarMaps0, RttiVarMaps),
TypeCtorGoals = [TypeCtorGoal],
!:Info = !.Info ^ varset := VarSet,
- !:Info = !.Info ^ vartypes := VarTypes
+ !:Info = !.Info ^ vartypes := VarTypes,
+ !:Info = !.Info ^ rtti_varmaps := RttiVarMaps
).
%-----------------------------------------------------------------------------%
@@ -1086,8 +1098,8 @@
( map__search(RevTypeCtorMap0, TypeCtorInfoVar, TypeCtor0) ->
RevTypeInfoMap0 = !.Info ^ rev_type_info_map,
(
- list__map(map__search(RevTypeInfoMap0), ArgTypeInfoVars,
- ArgTypes)
+ list__map(map__search(RevTypeInfoMap0),
+ ArgTypeInfoVars, ArgTypes)
->
list__length(ArgTypes, Arity),
% Just in case TypeCtorInfo0 has fake arity,
@@ -1134,10 +1146,11 @@
map__det_insert(KnownSizeMap0, Var, KnownSize, KnownSizeMap),
!:Info = !.Info ^ known_size_map := KnownSizeMap.
-:- pred record_typeinfo_in_type_info_varmap(pair(tvar, type_info_locn)::in,
+:- pred record_typeinfo_in_type_info_varmap(rtti_varmaps::in, tvar::in,
info::in, info::out) is det.
-record_typeinfo_in_type_info_varmap(TVar - TypeInfoLocn, !Info) :-
+record_typeinfo_in_type_info_varmap(RttiVarMaps, TVar, !Info) :-
+ rtti_lookup_type_info_locn(RttiVarMaps, TVar, TypeInfoLocn),
Type = term__variable(TVar),
(
TypeInfoLocn = type_info(TypeInfoVar),
Index: compiler/tupling.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/tupling.m,v
retrieving revision 1.6
diff -u -r1.6 tupling.m
--- compiler/tupling.m 29 Apr 2005 01:03:09 -0000 1.6
+++ compiler/tupling.m 13 Jul 2005 08:46:31 -0000
@@ -766,8 +766,7 @@
pred_info_typevarset(PredInfo, TVarSet),
proc_info_vartypes(ProcInfo, VarTypes),
pred_info_get_class_context(PredInfo, ClassContext),
- proc_info_typeinfo_varmap(ProcInfo, TVarMap),
- proc_info_typeclass_info_varmap(ProcInfo, TCVarMap),
+ proc_info_rtti_varmaps(ProcInfo, RttiVarMaps),
proc_info_varset(ProcInfo, VarSet),
proc_info_inst_varset(ProcInfo, InstVarSet),
pred_info_get_markers(PredInfo, Markers),
@@ -800,8 +799,7 @@
TVarSet, % in
VarTypes, % in
ClassContext, % in
- TVarMap, % in
- TCVarMap, % in
+ RttiVarMaps, % in
VarSet, % in
InstVarSet, % in
Markers, % in
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.150
diff -u -r1.150 type_util.m
--- compiler/type_util.m 20 Apr 2005 12:57:16 -0000 1.150
+++ compiler/type_util.m 12 Jul 2005 13:25:32 -0000
@@ -382,28 +382,6 @@
:- pred apply_rec_substitution_to_type_map(map(prog_var, type)::in, tsubst::in,
map(prog_var, type)::out) is det.
- % Update a map from tvar to type_info_locn, using the type renaming
- % and substitution to rename tvars and a variable substitution to
- % rename vars. The type renaming is applied before the type
- % substitution.
- %
- % If tvar maps to a another type variable, we keep the new
- % variable, if it maps to a type, we remove it from the map.
- %
-:- pred apply_substitutions_to_var_map(map(tvar, type_info_locn)::in,
- tsubst::in, map(tvar, type)::in, map(prog_var, prog_var)::in,
- map(tvar, type_info_locn)::out) is det.
-
- % Update a map from prog_constraint to var, using the type renaming
- % and substitution to rename tvars and a variable substition to
- % rename vars. The type renaming is applied before the type
- % substitution.
- %
-:- pred apply_substitutions_to_typeclass_var_map(
- typeclass_info_varmap::in, tsubst::in, map(tvar, type)::in,
- map(prog_var, prog_var)::in, typeclass_info_varmap::out)
- is det.
-
:- pred apply_rec_subst_to_constraints(tsubst::in, hlds_constraints::in,
hlds_constraints::out) is det.
@@ -1583,99 +1561,6 @@
%-----------------------------------------------------------------------------%
-apply_substitutions_to_var_map(VarMap0, TRenaming, TSubst, Subst, VarMap) :-
- % optimize the common case of empty substitutions
- (
- map__is_empty(Subst),
- map__is_empty(TSubst),
- map__is_empty(TRenaming)
- ->
- VarMap = VarMap0
- ;
- map__keys(VarMap0, TVars),
- map__init(NewVarMap),
- apply_substitutions_to_var_map_2(TVars, VarMap0,
- TRenaming, TSubst, Subst, NewVarMap, VarMap)
- ).
-
-:- pred apply_substitutions_to_var_map_2(list(tvar)::in, map(tvar,
- type_info_locn)::in, tsubst::in, map(tvar, type)::in,
- map(prog_var, prog_var)::in, map(tvar, type_info_locn)::in,
- map(tvar, type_info_locn)::out) is det.
-
-apply_substitutions_to_var_map_2([], _VarMap0, _, _, _, !NewVarMap).
-apply_substitutions_to_var_map_2([TVar | TVars], VarMap0, TRenaming,
- TSubst, VarSubst, !NewVarMap) :-
- map__lookup(VarMap0, TVar, Locn),
- type_info_locn_var(Locn, Var),
-
- % find the new var, if there is one
- ( map__search(VarSubst, Var, NewVar0) ->
- NewVar = NewVar0
- ;
- NewVar = Var
- ),
- type_info_locn_set_var(NewVar, Locn, NewLocn),
-
- % find the new tvar, if there is one, otherwise just
- % create the old var as a type variable.
- (
- map__search(TRenaming, TVar, NewTVar0)
- ->
- ( NewTVar0 = term__variable(NewTVar1) ->
- NewTVar2 = NewTVar1
- ;
- % varset__merge_subst only returns var->var mappings,
- % never var->term.
- error(
- "apply_substitution_to_var_map_2: weird type renaming")
- )
- ;
- % The variable wasn't renamed.
- NewTVar2 = TVar
- ),
-
- term__apply_rec_substitution(term__variable(NewTVar2),
- TSubst, NewType),
-
- % if the tvar is still a variable, insert it into the
- % map with the new var.
- ( prog_type__var(NewType, NewTVar) ->
- % Don't abort if two old type variables
- % map to the same new type variable.
- map__set(!.NewVarMap, NewTVar, NewLocn, !:NewVarMap)
- ;
- true
- ),
- apply_substitutions_to_var_map_2(TVars, VarMap0, TRenaming,
- TSubst, VarSubst, !NewVarMap).
-
-%-----------------------------------------------------------------------------%
-
-apply_substitutions_to_typeclass_var_map(VarMap0, TRenaming, TSubst, Subst,
- VarMap) :-
- map__to_assoc_list(VarMap0, VarAL0),
- list__map(apply_substitutions_to_typeclass_var_map_2(TRenaming,
- TSubst, Subst), VarAL0, VarAL),
- map__from_assoc_list(VarAL, VarMap).
-
-:- pred apply_substitutions_to_typeclass_var_map_2(tsubst::in,
- map(tvar, type)::in, map(prog_var, prog_var)::in,
- pair(prog_constraint, prog_var)::in,
- pair(prog_constraint, prog_var)::out) is det.
-
-apply_substitutions_to_typeclass_var_map_2(TRenaming, TSubst, VarRenaming,
- Constraint0 - Var0, Constraint - Var) :-
- apply_subst_to_prog_constraint(TRenaming, Constraint0, Constraint1),
- apply_rec_subst_to_prog_constraint(TSubst, Constraint1, Constraint),
- ( map__search(VarRenaming, Var0, Var1) ->
- Var = Var1
- ;
- Var = Var0
- ).
-
-%-----------------------------------------------------------------------------%
-
apply_rec_subst_to_constraints(Subst, !Constraints) :-
!.Constraints = constraints(Unproven0, Assumed0, Redundant0),
apply_rec_subst_to_constraint_list(Subst, Unproven0, Unproven),
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.145
diff -u -r1.145 unify_proc.m
--- compiler/unify_proc.m 23 May 2005 03:15:42 -0000 1.145
+++ compiler/unify_proc.m 14 Jul 2005 04:47:53 -0000
@@ -713,12 +713,11 @@
),
unify_proc__info_extract(Info, VarSet, Types),
map__init(TVarNameMap),
- map__init(TI_VarMap),
- map__init(TCI_VarMap),
+ rtti_varmaps_init(RttiVarMaps),
set_clause_list(Clauses, ClausesRep),
HasForeignClauses = yes,
ClauseInfo = clauses_info(VarSet, Types, TVarNameMap, Types, Args,
- ClausesRep, TI_VarMap, TCI_VarMap, HasForeignClauses).
+ ClausesRep, RttiVarMaps, HasForeignClauses).
:- pred unify_proc__generate_initialise_clauses(module_info::in, (type)::in,
@@ -2088,7 +2087,7 @@
unify_proc_info::in, unify_proc_info::out) is det.
:- pred unify_proc__info_set_types(vartypes::in,
unify_proc_info::in, unify_proc_info::out) is det.
-:- pred unify_proc__info_get_type_info_varmap(type_info_varmap::out,
+:- pred unify_proc__info_get_rtti_varmaps(rtti_varmaps::out,
unify_proc_info::in, unify_proc_info::out) is det.
:- pred unify_proc__info_get_module_info(module_info::out,
unify_proc_info::in, unify_proc_info::out) is det.
@@ -2101,15 +2100,15 @@
---> unify_proc_info(
varset :: prog_varset,
vartypes :: vartypes,
- type_info_varmap :: type_info_varmap,
+ rtti_varmaps :: rtti_varmaps,
module_info :: module_info
).
unify_proc__info_init(ModuleInfo, UPI) :-
varset__init(VarSet),
map__init(Types),
- map__init(TVarMap),
- UPI = unify_proc_info(VarSet, Types, TVarMap, ModuleInfo).
+ rtti_varmaps_init(RttiVarMaps),
+ UPI = unify_proc_info(VarSet, Types, RttiVarMaps, ModuleInfo).
unify_proc__info_new_var(Type, Var, UPI,
(UPI^varset := VarSet) ^vartypes := Types) :-
@@ -2125,7 +2124,7 @@
unify_proc__info_get_varset(UPI^varset, UPI, UPI).
unify_proc__info_get_types(UPI^vartypes, UPI, UPI).
-unify_proc__info_get_type_info_varmap(UPI^type_info_varmap, UPI, UPI).
+unify_proc__info_get_rtti_varmaps(UPI^rtti_varmaps, UPI, UPI).
unify_proc__info_get_module_info(UPI^module_info, UPI, UPI).
unify_proc__info_set_varset(VarSet, UPI, UPI^varset := VarSet).
Index: compiler/untupling.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/untupling.m,v
retrieving revision 1.5
diff -u -r1.5 untupling.m
--- compiler/untupling.m 24 Mar 2005 05:34:17 -0000 1.5
+++ compiler/untupling.m 13 Jul 2005 08:47:04 -0000
@@ -424,8 +424,7 @@
pred_info_typevarset(PredInfo, TVarSet),
proc_info_vartypes(ProcInfo, VarTypes),
pred_info_get_class_context(PredInfo, ClassContext),
- proc_info_typeinfo_varmap(ProcInfo, TVarMap),
- proc_info_typeclass_info_varmap(ProcInfo, TCVarMap),
+ proc_info_rtti_varmaps(ProcInfo, RttiVarMaps),
proc_info_varset(ProcInfo, VarSet),
proc_info_inst_varset(ProcInfo, InstVarSet),
pred_info_get_markers(PredInfo, Markers),
@@ -458,8 +457,7 @@
TVarSet, % in
VarTypes, % in
ClassContext, % in
- TVarMap, % in
- TCVarMap, % in
+ RttiVarMaps, % in
VarSet, % in
InstVarSet, % in
Markers, % in
Index: compiler/unused_args.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unused_args.m,v
retrieving revision 1.104
diff -u -r1.104 unused_args.m
--- compiler/unused_args.m 1 Apr 2005 14:29:04 -0000 1.104
+++ compiler/unused_args.m 13 Jul 2005 08:48:01 -0000
@@ -385,9 +385,9 @@
proc_interface_should_use_typeinfo_liveness(PredInfo, ProcId,
Globals, TypeInfoLiveness),
( TypeInfoLiveness = yes ->
- proc_info_typeinfo_varmap(ProcInfo, TVarMap),
+ proc_info_rtti_varmaps(ProcInfo, RttiVarMaps),
setup_typeinfo_deps(Vars, VarTypes,
- proc(PredId, ProcId), TVarMap, VarDep2,
+ proc(PredId, ProcId), RttiVarMaps, VarDep2,
VarDep3)
;
VarDep2 = VarDep3
@@ -422,15 +422,15 @@
% For example, if HeadVar1 has type list(T), then TypeInfo_for_T
% is used if HeadVar1 is used.
:- pred setup_typeinfo_deps(list(prog_var)::in, map(prog_var, type)::in,
- pred_proc_id::in, map(tvar, type_info_locn)::in,
- var_dep::in, var_dep::out) is det.
+ pred_proc_id::in, rtti_varmaps::in, var_dep::in, var_dep::out) is det.
setup_typeinfo_deps([], _, _, _, !VarDep).
-setup_typeinfo_deps([Var | Vars], VarTypeMap, PredProcId, TVarMap, !VarDep) :-
+setup_typeinfo_deps([Var | Vars], VarTypeMap, PredProcId, RttiVarMaps,
+ !VarDep) :-
map__lookup(VarTypeMap, Var, Type),
prog_type__vars(Type, TVars),
list__map((pred(TVar::in, TypeInfoVar::out) is det :-
- map__lookup(TVarMap, TVar, Locn),
+ rtti_lookup_type_info_locn(RttiVarMaps, TVar, Locn),
type_info_locn_var(Locn, TypeInfoVar)
), TVars, TypeInfoVars),
AddArgDependency =
@@ -438,7 +438,8 @@
add_arg_dep(TVar, PredProcId, Var, VarDepA, VarDepB)
),
list__foldl(AddArgDependency, TypeInfoVars, !VarDep),
- setup_typeinfo_deps(Vars, VarTypeMap, PredProcId, TVarMap, !VarDep).
+ setup_typeinfo_deps(Vars, VarTypeMap, PredProcId, RttiVarMaps,
+ !VarDep).
% Get output arguments for a procedure given the headvars and the
% argument modes, and set them as used.
Index: library/injection.m
===================================================================
RCS file: library/injection.m
diff -N library/injection.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ library/injection.m 12 Jul 2005 13:26:42 -0000
@@ -0,0 +1,682 @@
+%---------------------------------------------------------------------------%
+% Copyright (C) 2005 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% File: injection.m
+% Author: mark
+%
+% This module provides the `injection' ADT. An injection is like a `map'
+% (see map.m) but it allows efficient reverse lookups, similarly to `bimap'.
+% The difference between an injection and a bimap is that there can be
+% values in the range of the injection that are not returned for any key.
+%
+% The invariants on this data structure, which are enforced by this module,
+% are as follows:
+%
+% 1) For any key K, if a forward lookup succeeds with value V then a reverse
+% lookup of value V will succeed with key K.
+%
+% 2) For any value V, if a reverse lookup succeeds with key K then a forward
+% lookup of key K will succeed with some value (not necessarily V).
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- module injection.
+:- interface.
+
+:- import_module assoc_list.
+:- import_module list.
+:- import_module map.
+
+%-----------------------------------------------------------------------------%
+
+:- type injection(K, V).
+
+%-----------------------------------------------------------------------------%
+
+ % Initialize an empty injection.
+ %
+:- func injection.init = injection(K, V).
+:- pred injection.init(injection(K, V)::out) is det.
+
+ % Check whether an injection is empty.
+ %
+:- pred injection.is_empty(injection(K, V)::in) is semidet.
+
+ % Search the injection for the value corresponding to a given key.
+ %
+:- func injection.forward_search(injection(K, V), K) = V is semidet.
+:- pred injection.forward_search(injection(K, V)::in, K::in, V::out)
+ is semidet.
+
+ % Search the injection for the key corresponding to a given value.
+ %
+:- func injection.reverse_search(injection(K, V), V) = K is semidet.
+:- pred injection.reverse_search(injection(K, V)::in, K::out, V::in)
+ is semidet.
+
+ % Combined forward/reverse search. (Declaratively equivalent to
+ % reverse_search.)
+ %
+:- pred injection.search(injection(K, V), K, V).
+:- mode injection.search(in, in, out) is cc_nondet.
+:- mode injection.search(in, out, in) is semidet.
+
+ % Look up the value for a given key, but throw an exception if it
+ % is not present.
+ %
+:- func injection.lookup(injection(K, V), K) = V.
+:- pred injection.lookup(injection(K, V)::in, K::in, V::out) is det.
+
+ % Look up the key for a given value, but throw an exception if it
+ % is not present.
+ %
+:- func injection.reverse_lookup(injection(K, V), V) = K.
+:- pred injection.reverse_lookup(injection(K, V)::in, K::out, V::in) is det.
+
+ % Return the list of all keys in the injection.
+ %
+:- func injection.keys(injection(K, V)) = list(K).
+:- pred injection.keys(injection(K, V)::in, list(K)::out) is det.
+
+ % Return the list of all values in the injection.
+ %
+:- func injection.values(injection(K, V)) = list(V).
+:- pred injection.values(injection(K, V)::in, list(V)::out) is det.
+
+ % Succeeds if the injection contains the given key.
+ %
+:- pred injection.contains_key(injection(K, V), K).
+:- mode injection.contains_key(in, in) is semidet.
+
+ % Succeeds if the injection contains the given value.
+ %
+:- pred injection.contains_value(injection(K, V), V).
+:- mode injection.contains_value(in, in) is semidet.
+
+ % Insert a new key-value pair into the injection. Fails if either
+ % the key or value already exists.
+ %
+:- func injection.insert(injection(K, V), K, V) = injection(K, V) is semidet.
+:- pred injection.insert(injection(K, V)::in, K::in, V::in,
+ injection(K, V)::out) is semidet.
+
+ % As above but throws an exception if the key or the value already
+ % exists.
+ %
+:- func injection.det_insert(injection(K, V), K, V) = injection(K, V).
+:- pred injection.det_insert(injection(K, V)::in, K::in, V::in,
+ injection(K, V)::out) is det.
+
+ % Update the value associated with a given key. Fails if the key
+ % does not already exist, or if the value is already associated
+ % with a key.
+ %
+:- func injection.update(injection(K, V), K, V) = injection(K, V) is semidet.
+:- pred injection.update(injection(K, V)::in, K::in, V::in,
+ injection(K, V)::out) is semidet.
+
+ % As above, but throws an exception if the key does not already
+ % exist, or if the value is already associated with a key.
+ %
+:- func injection.det_update(injection(K, V), K, V) = injection(K, V).
+:- pred injection.det_update(injection(K, V)::in, K::in, V::in,
+ injection(K, V)::out) is det.
+
+ % Sets the value associated with a given key, regardless of whether
+ % the key exists already or not. Fails if the value is already
+ % associated with a key that is different from the given key.
+ %
+:- func injection.set(injection(K, V), K, V) = injection(K, V) is semidet.
+:- pred injection.set(injection(K, V)::in, K::in, V::in,
+ injection(K, V)::out) is semidet.
+
+ % As above, but throws an exception if the value is already associated
+ % with a key that is different from the given key.
+ %
+:- func injection.det_set(injection(K, V), K, V) = injection(K, V).
+:- pred injection.det_set(injection(K, V)::in, K::in, V::in,
+ injection(K, V)::out) is det.
+
+ % Insert key-value pairs from an assoc_list into the given injection.
+ % Fails if any of the individual inserts would fail.
+ %
+:- func injection.insert_from_assoc_list(assoc_list(K, V), injection(K, V)) =
+ injection(K, V) is semidet.
+:- pred injection.insert_from_assoc_list(assoc_list(K, V)::in,
+ injection(K, V)::in, injection(K, V)::out) is semidet.
+
+ % As above, but throws an exception if any of the individual
+ % inserts would fail.
+ %
+:- func injection.det_insert_from_assoc_list(assoc_list(K, V),
+ injection(K, V)) = injection(K, V).
+:- pred injection.det_insert_from_assoc_list(assoc_list(K, V)::in,
+ injection(K, V)::in, injection(K, V)::out) is det.
+
+ % Set key-value pairs from an assoc_list into the given injection.
+ % Fails of any of the individual sets would fail.
+ %
+:- func injection.set_from_assoc_list(assoc_list(K, V), injection(K, V)) =
+ injection(K, V) is semidet.
+:- pred injection.set_from_assoc_list(assoc_list(K, V)::in,
+ injection(K, V)::in, injection(K, V)::out) is semidet.
+
+ % As above, but throws an exception if any of the individual sets
+ % would fail.
+ %
+:- func injection.det_set_from_assoc_list(assoc_list(K, V), injection(K, V)) =
+ injection(K, V).
+:- pred injection.det_set_from_assoc_list(assoc_list(K, V)::in,
+ injection(K, V)::in, injection(K, V)::out) is det.
+
+ % Insert key-value pairs from corresponding lists into the given
+ % injection. Fails if any of the individual inserts would fail.
+ % Throws an exception if the lists are not of equal length.
+ %
+:- func injection.insert_from_corresponding_lists(list(K), list(V),
+ injection(K, V)) = injection(K, V) is semidet.
+:- pred injection.insert_from_corresponding_lists(list(K)::in, list(V)::in,
+ injection(K, V)::in, injection(K, V)::out) is semidet.
+
+ % As above, but throws an exception if any of the individual
+ % inserts would fail.
+ %
+:- func injection.det_insert_from_corresponding_lists(list(K), list(V),
+ injection(K, V)) = injection(K, V).
+:- pred injection.det_insert_from_corresponding_lists(list(K)::in, list(V)::in,
+ injection(K, V)::in, injection(K, V)::out) is det.
+
+ % Set key-value pairs from corresponding lists into the given
+ % injection. Fails of any of the individual sets would fail.
+ % Throws an exception if the lists are not of equal length.
+ %
+:- func injection.set_from_corresponding_lists(list(K), list(V),
+ injection(K, V)) = injection(K, V) is semidet.
+:- pred injection.set_from_corresponding_lists(list(K)::in, list(V)::in,
+ injection(K, V)::in, injection(K, V)::out) is semidet.
+
+ % As above, but throws an exception if any of the individual sets
+ % would fail.
+ %
+:- func injection.det_set_from_corresponding_lists(list(K), list(V),
+ injection(K, V)) = injection(K, V).
+:- pred injection.det_set_from_corresponding_lists(list(K)::in, list(V)::in,
+ injection(K, V)::in, injection(K, V)::out) is det.
+
+ % Delete a key from an injection. Also deletes any values that
+ % correspond to that key. If the key is not present, leave the
+ % injection unchanged.
+ %
+:- func injection.delete_key(injection(K, V), K) = injection(K, V).
+:- pred injection.delete_key(K::in, injection(K, V)::in, injection(K, V)::out)
+ is det.
+
+ % Delete a value from an injection. Throws an exception if there is
+ % a key that maps to this value. If the value is not present, leave
+ % the injection unchanged.
+ %
+:- func injection.delete_value(injection(K, V), V) = injection(K, V).
+:- pred injection.delete_value(V::in, injection(K, V)::in,
+ injection(K, V)::out) is det.
+
+ % Apply injection.delete_key to a list of keys.
+ %
+:- func injection.delete_keys(injection(K, V), list(K)) = injection(K, V).
+:- pred injection.delete_keys(list(K)::in, injection(K, V)::in,
+ injection(K, V)::out) is det.
+
+ % Apply injection.delete_value to a list of values.
+ %
+:- func injection.delete_values(injection(K, V), list(V)) = injection(K, V).
+:- pred injection.delete_values(list(V)::in, injection(K, V)::in,
+ injection(K, V)::out) is det.
+
+ % Merge the contents of the two injections. Both sets of keys must
+ % be disjoint, and both sets of values must be disjoint. Throws an
+ % exception if this condition is not satisfied.
+ %
+:- func injection.merge(injection(K, V), injection(K, V)) = injection(K, V).
+:- pred injection.merge(injection(K, V)::in, injection(K, V)::in,
+ injection(K, V)::out) is det.
+
+ % Merge the contents of the two injections. For keys that occur in
+ % both injections, map them to the value in the second argument.
+ % Both sets of values must be disjoint. Throws an exception if this
+ % condition is not satisfied.
+ %
+:- func injection.overlay(injection(K, V), injection(K, V)) = injection(K, V).
+:- pred injection.overlay(injection(K, V)::in, injection(K, V)::in,
+ injection(K, V)::out) is det.
+
+ % Apply an injection to a list of keys. Throws an exception if any
+ % of the keys are not present.
+ %
+:- func injection.apply_forward_map_to_list(injection(K, V), list(K)) =
+ list(V).
+:- pred injection.apply_forward_map_to_list(injection(K, V)::in, list(K)::in,
+ list(V)::out) is det.
+
+ % Apply the inverse of an injection to a list of values. Throws an
+ % exception if any of the values are not present.
+ %
+:- func injection.apply_reverse_map_to_list(injection(K, V), list(V)) =
+ list(K).
+:- pred injection.apply_reverse_map_to_list(injection(K, V)::in, list(V)::in,
+ list(K)::out) is det.
+
+ % Apply a transformation to all the keys in the injection. If two
+ % distinct keys become equal under this transformation then the
+ % value associated with the greater of these two keys is used in the
+ % result.
+ %
+:- func injection.map_keys(func(V, K) = L, injection(K, V)) = injection(L, V).
+:- pred injection.map_keys(pred(V, K, L)::in(pred(in, in, out) is det),
+ injection(K, V)::in, injection(L, V)::out) is det.
+
+ % Same as injection.map_keys, but deletes any keys for which the
+ % transformation fails.
+ %
+:- pred injection.filter_map_keys(
+ pred(V, K, L)::in(pred(in, in, out) is semidet),
+ injection(K, V)::in, injection(L, V)::out) is det.
+
+ % Apply a transformation to all the values in the injection. If two
+ % distinct values become equal under this transformation then the
+ % reverse search of these two values in the original map must lead
+ % to the same key. If it doesn't, then throw an exception.
+ %
+:- func injection.map_values(func(K, V) = W, injection(K, V)) =
+ injection(K, W).
+:- pred injection.map_values(pred(K, V, W)::in(pred(in, in, out) is det),
+ injection(K, V)::in, injection(K, W)::out) is det.
+
+ % Extract the forward map from an injection.
+ %
+:- func injection.forward_map(injection(K, V)) = map(K, V).
+:- pred injection.forward_map(injection(K, V)::in, map(K, V)::out) is det.
+
+ % Extract the reverse map from an injection.
+ %
+:- func injection.reverse_map(injection(K, V)) = map(V, K).
+:- pred injection.reverse_map(injection(K, V)::in, map(V, K)::out) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module require.
+:- import_module std_util.
+:- import_module string.
+:- import_module svmap.
+
+:- type injection(K, V)
+ ---> injection(map(K, V), map(V, K)).
+
+%-----------------------------------------------------------------------------%
+
+injection.init = injection(F, R) :-
+ map.init(F),
+ map.init(R).
+
+injection.init(injection.init).
+
+injection.is_empty(injection(F, _)) :-
+ map.is_empty(F).
+
+injection.forward_search(injection(F, _), K) = map.search(F, K).
+
+injection.forward_search(I, K, injection.forward_search(I, K)).
+
+injection.reverse_search(injection(_, R), V) = map.search(R, V).
+
+injection.reverse_search(I, injection.reverse_search(I, V), V).
+
+:- pragma promise_pure(injection.search/3).
+
+injection.search(injection(F, _)::in, K::in, V::out) :-
+ map.search(F, K, V0),
+ cc_multi_equal(V0, V).
+injection.search(injection(_, R)::in, K::out, V::in) :-
+ map.search(R, V, K).
+
+injection.lookup(injection(F, _), K) = map.lookup(F, K).
+
+injection.lookup(I, K, injection.lookup(I, K)).
+
+injection.reverse_lookup(injection(_, R), V) = map.lookup(R, V).
+
+injection.reverse_lookup(I, injection.reverse_lookup(I, V), V).
+
+injection.keys(injection(F, _)) = map.keys(F).
+
+injection.keys(I, injection.keys(I)).
+
+injection.values(injection(_, R)) = map.keys(R).
+
+injection.values(I, injection.values(I)).
+
+injection.contains_key(injection(F, _), K) :-
+ map.contains(F, K).
+
+injection.contains_value(injection(_, R), V) :-
+ map.contains(R, V).
+
+injection.insert(injection(F0, R0), K, V) = injection(F, R) :-
+ map.insert(F0, K, V, F),
+ map.insert(R0, V, K, R).
+
+injection.insert(I, K, V, injection.insert(I, K, V)).
+
+injection.det_insert(injection(F0, R0), K, V) = injection(F, R) :-
+ map.det_insert(F0, K, V, F),
+ map.det_insert(R0, V, K, R).
+
+injection.det_insert(I, K, V, injection.det_insert(I, K, V)).
+
+injection.update(injection(F0, R0), K, V) = injection(F, R) :-
+ map.update(F0, K, V, F),
+ map.insert(R0, V, K, R).
+
+injection.update(I, K, V, injection.update(I, K, V)).
+
+injection.det_update(injection(F0, R0), K, V) = injection(F, R) :-
+ map.det_update(F0, K, V, F),
+ map.det_insert(R0, V, K, R).
+
+injection.det_update(I, K, V, injection.det_update(I, K, V)).
+
+injection.set(injection(F0, R0), K, V) = injection(F, R) :-
+ injection.set_2(K, V, F0, F, R0, R).
+
+injection.set(I, K, V, injection.set(I, K, V)).
+
+:- pred injection.set_2(K::in, V::in, map(K, V)::in, map(K, V)::out,
+ map(V, K)::in, map(V, K)::out) is semidet.
+
+injection.set_2(K, V, F0, F, R0, R) :-
+ map.set(F0, K, V, F),
+ (
+ map.search(R0, V, OrigK)
+ ->
+ % Fail if the existing key is not the same as the
+ % given key.
+ K = OrigK,
+ R = R0
+ ;
+ map.det_insert(R0, V, K, R)
+ ).
+
+injection.det_set(injection(F0, R0), K, V) = injection(F, R) :-
+ injection.det_set_2(K, V, F0, F, R0, R).
+
+injection.det_set(I, K, V, injection.det_set(I, K, V)).
+
+:- pred injection.det_set_2(K::in, V::in, map(K, V)::in, map(K, V)::out,
+ map(V, K)::in, map(V, K)::out) is det.
+
+injection.det_set_2(K, V, F0, F, R0, R) :-
+ map.set(F0, K, V, F),
+ (
+ map.search(R0, V, OrigK)
+ ->
+ % Abort if the existing key is not the same as the
+ % given key.
+ (
+ K = OrigK
+ ->
+ R = R0
+ ;
+ error("injection.det_set: " ++
+ "value is already associated with another key")
+ )
+ ;
+ map.det_insert(R0, V, K, R)
+ ).
+
+injection.insert_from_assoc_list(A, injection(F0, R0)) = injection(F, R) :-
+ P = (pred(KV::in, F1::in, F2::out, R1::in, R2::out) is semidet :-
+ KV = K - V,
+ map.insert(F1, K, V, F2),
+ map.insert(R1, V, K, R2)
+ ),
+ list.foldl2(P, A, F0, F, R0, R).
+
+injection.insert_from_assoc_list(A, I, injection.insert_from_assoc_list(A, I)).
+
+injection.det_insert_from_assoc_list(A, injection(F0, R0)) = injection(F, R) :-
+ P = (pred(KV::in, F1::in, F2::out, R1::in, R2::out) is det :-
+ KV = K - V,
+ map.det_insert(F1, K, V, F2),
+ map.det_insert(R1, V, K, R2)
+ ),
+ list.foldl2(P, A, F0, F, R0, R).
+
+injection.det_insert_from_assoc_list(A, I,
+ injection.det_insert_from_assoc_list(A, I)).
+
+injection.set_from_assoc_list(A, injection(F0, R0)) = injection(F, R) :-
+ P = (pred(KV::in, F1::in, F2::out, R1::in, R2::out) is semidet :-
+ KV = K - V,
+ injection.set_2(K, V, F1, F2, R1, R2)
+ ),
+ list.foldl2(P, A, F0, F, R0, R).
+
+injection.set_from_assoc_list(A, I, injection.set_from_assoc_list(A, I)).
+
+injection.det_set_from_assoc_list(A, injection(F0, R0)) = injection(F, R) :-
+ P = (pred(KV::in, F1::in, F2::out, R1::in, R2::out) is det :-
+ KV = K - V,
+ injection.det_set_2(K, V, F1, F2, R1, R2)
+ ),
+ list.foldl2(P, A, F0, F, R0, R).
+
+injection.det_set_from_assoc_list(A, I,
+ injection.det_set_from_assoc_list(A, I)).
+
+injection.insert_from_corresponding_lists(As, Bs, injection(F0, R0)) =
+ injection(F, R) :-
+ P = (pred(K::in, V::in, F1::in, F2::out, R1::in, R2::out) is semidet :-
+ map.insert(F1, K, V, F2),
+ map.insert(R1, V, K, R2)
+ ),
+ list.foldl2_corresponding(P, As, Bs, F0, F, R0, R).
+
+injection.insert_from_corresponding_lists(As, Bs, I,
+ injection.insert_from_corresponding_lists(As, Bs, I)).
+
+injection.det_insert_from_corresponding_lists(As, Bs, injection(F0, R0)) =
+ injection(F, R) :-
+ P = (pred(K::in, V::in, F1::in, F2::out, R1::in, R2::out) is det :-
+ map.det_insert(F1, K, V, F2),
+ map.det_insert(R1, V, K, R2)
+ ),
+ list.foldl2_corresponding(P, As, Bs, F0, F, R0, R).
+
+injection.det_insert_from_corresponding_lists(As, Bs, I,
+ injection.det_insert_from_corresponding_lists(As, Bs, I)).
+
+injection.set_from_corresponding_lists(As, Bs, injection(F0, R0)) =
+ injection(F, R) :-
+ list.foldl2_corresponding(injection.set_2, As, Bs, F0, F, R0, R).
+
+injection.set_from_corresponding_lists(As, Bs, I,
+ injection.set_from_corresponding_lists(As, Bs, I)).
+
+injection.det_set_from_corresponding_lists(As, Bs, injection(F0, R0)) =
+ injection(F, R) :-
+ list.foldl2_corresponding(injection.det_set_2, As, Bs, F0, F, R0, R).
+
+injection.det_set_from_corresponding_lists(As, Bs, I,
+ injection.det_set_from_corresponding_lists(As, Bs, I)).
+
+injection.delete_key(injection(F0, R0), K) = injection(F, R) :-
+ (
+ map.remove(F0, K, _, F1)
+ ->
+ F = F1,
+ map.foldl(filter_values_with_key(K), R0, map.init, R)
+ ;
+ F = F0,
+ R = R0
+ ).
+
+injection.delete_key(K, I, injection.delete_key(I, K)).
+
+:- pred filter_values_with_key(K::in, V::in, K::in, map(V, K)::in,
+ map(V, K)::out) is det.
+
+filter_values_with_key(FilterKey, V, K, !Map) :-
+ (
+ K = FilterKey
+ ->
+ true
+ ;
+ svmap.det_insert(V, K, !Map)
+ ).
+
+injection.delete_value(injection(F0, R0), V) = injection(F, R) :-
+ (
+ map.remove(R0, V, K, R1)
+ ->
+ % Only K could possibly be associated with V. If it is,
+ % then we throw an exception.
+ (
+ map.lookup(F0, K, V)
+ ->
+ error("injection.delete_value: " ++
+ "value is associated with a key")
+ ;
+ F = F0
+ ),
+ R = R1
+ ;
+ F = F0,
+ R = R0
+ ).
+
+injection.delete_value(V, I, injection.delete_value(I, V)).
+
+injection.delete_keys(Ks, !I) :-
+ list.foldl(injection.delete_key, Ks, !I).
+
+injection.delete_keys(I0, Ks) = I :-
+ injection.delete_keys(Ks, I0, I).
+
+injection.delete_values(Vs, !I) :-
+ list.foldl(injection.delete_value, Vs, !I).
+
+injection.delete_values(I0, Vs) = I :-
+ injection.delete_values(Vs, I0, I).
+
+injection.merge(injection(FA, RA), injection(FB, RB)) = injection(F, R) :-
+ map.merge(FA, FB, F),
+ map.merge(RA, RB, R).
+
+injection.merge(A, B, injection.merge(A, B)).
+
+injection.overlay(injection(FA, RA), injection(FB, RB)) = injection(F, R) :-
+ map.overlay(FA, FB, F),
+ map.merge(RA, RB, R).
+
+injection.overlay(A, B, injection.overlay(A, B)).
+
+injection.apply_forward_map_to_list(injection(F, _), Ks) =
+ map.apply_to_list(Ks, F).
+
+injection.apply_forward_map_to_list(I, Ks,
+ injection.apply_forward_map_to_list(I, Ks)).
+
+injection.apply_reverse_map_to_list(injection(_, R), Vs) =
+ map.apply_to_list(Vs, R).
+
+injection.apply_reverse_map_to_list(I, Vs,
+ injection.apply_reverse_map_to_list(I, Vs)).
+
+injection.map_keys(Func, injection(F0, R0)) = injection(F, R) :-
+ F = map.foldl(insert_transformed_key_f(Func), F0, map.init),
+ R = map.map_values(Func, R0).
+
+:- func insert_transformed_key_f(func(V, K) = L, K, V, map(L, V)) = map(L, V).
+
+insert_transformed_key_f(Func, K, V, Map0) = Map :-
+ map.set(Map0, Func(V, K), V, Map).
+
+injection.map_keys(Pred, injection(F0, R0), injection(F, R)) :-
+ map.foldl(insert_transformed_key_p(Pred), F0, map.init, F),
+ map.map_values(Pred, R0, R).
+
+:- pred insert_transformed_key_p(pred(V, K, L)::in(pred(in, in, out) is det),
+ K::in, V::in, map(L, V)::in, map(L, V)::out) is det.
+
+insert_transformed_key_p(Pred, K, V, Map0, Map) :-
+ Pred(V, K, L),
+ map.set(Map0, L, V, Map).
+
+injection.filter_map_keys(Pred, injection(F0, R0), injection(F, R)) :-
+ F = map.foldl(maybe_set_transformed_key(Pred), F0, map.init),
+ map.to_assoc_list(R0, AL0),
+ list.filter_map(maybe_transform_key(Pred), AL0, AL),
+ map.from_assoc_list(AL, R).
+
+:- func maybe_set_transformed_key(pred(V, K, L), K, V, map(L, V)) = map(L, V).
+:- mode maybe_set_transformed_key(in(pred(in, in, out) is semidet), in, in, in)
+ = out is det.
+
+maybe_set_transformed_key(Pred, K, V, Map0) = Map :-
+ (
+ Pred(V, K, L)
+ ->
+ map.set(Map0, L, V, Map)
+ ;
+ Map = Map0
+ ).
+
+:- pred maybe_transform_key(pred(V, K, L)::in(pred(in, in, out) is semidet),
+ pair(V, K)::in, pair(V, L)::out) is semidet.
+
+maybe_transform_key(Pred, V - K, V - L) :-
+ Pred(V, K, L).
+
+injection.map_values(Func, injection(F0, R0)) = injection(F, R) :-
+ F = map.map_values(Func, F0),
+ R = map.foldl(insert_transformed_value_f(Func), R0, map.init).
+
+:- func insert_transformed_value_f(func(K, V) = W, V, K, map(W, K)) =
+ map(W, K).
+
+insert_transformed_value_f(Func, V, K, Map0) = Map :-
+ W = Func(K, V),
+ (
+ map.insert(Map0, W, K, Map1)
+ ->
+ Map = Map1
+ ;
+ % Another value in the original was already mapped to this
+ % value. We ensure that it had the same key.
+ (
+ map.lookup(Map0, W, K)
+ ->
+ Map = Map0
+ ;
+ error("injection.map_values: " ++
+ "merged two values with different keys")
+ )
+ ).
+
+injection.map_values(Pred, I0, I) :-
+ Func = (func(K, V) = W :- Pred(K, V, W)),
+ I = injection.map_values(Func, I0).
+
+injection.forward_map(injection(F, _)) = F.
+injection.forward_map(injection(F, _), F).
+
+injection.reverse_map(injection(_, R)) = R.
+injection.reverse_map(injection(_, R), R).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: library/library.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/library.m,v
retrieving revision 1.88
diff -u -r1.88 library.m
--- library/library.m 16 Jun 2005 04:08:02 -0000 1.88
+++ library/library.m 12 Jul 2005 08:02:25 -0000
@@ -70,6 +70,7 @@
:- import_module graph.
:- import_module group.
:- import_module hash_table.
+:- import_module injection.
:- import_module int.
:- import_module integer.
:- import_module io.
@@ -203,6 +204,7 @@
mercury_std_library_module("graph").
mercury_std_library_module("group").
mercury_std_library_module("hash_table").
+mercury_std_library_module("injection").
mercury_std_library_module("int").
mercury_std_library_module("integer").
mercury_std_library_module("io").
Index: library/list.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/list.m,v
retrieving revision 1.139
diff -u -r1.139 list.m
--- library/list.m 16 Jun 2005 04:08:02 -0000 1.139
+++ library/list.m 12 Jul 2005 13:26:21 -0000
@@ -728,6 +728,44 @@
di, uo) is cc_multi,
in, in, out, in, out, in, out, in, out, in, out, di, uo) is cc_multi.
+ % list__foldl_corresponding(F, As, Bs, !Acc)
+ % Does the same job as list__foldl, but works on two lists in
+ % parallel. An exception is raised if the list arguments differ
+ % in length.
+ %
+:- pred list__foldl_corresponding(pred(A, B, C, C), list(A), list(B), C, C).
+:- mode list__foldl_corresponding(pred(in, in, in, out) is det,
+ in, in, in, out) is det.
+:- mode list__foldl_corresponding(pred(in, in, in, out) is cc_multi,
+ in, in, in, out) is cc_multi.
+:- mode list__foldl_corresponding(pred(in, in, in, out) is semidet,
+ in, in, in, out) is semidet.
+:- mode list__foldl_corresponding(pred(in, in, in, out) is nondet,
+ in, in, in, out) is nondet.
+:- mode list__foldl_corresponding(pred(in, in, di, uo) is det,
+ in, in, di, uo) is det.
+:- mode list__foldl_corresponding(pred(in, in, di, uo) is cc_multi,
+ in, in, di, uo) is cc_multi.
+
+ % list__foldl2_corresponding(F, As, Bs, !Acc1, !Acc2)
+ % Does the same job as list__foldl_corresponding, but has two
+ % accumulators.
+ %
+:- pred list__foldl2_corresponding(pred(A, B, C, C, D, D), list(A), list(B),
+ C, C, D, D).
+:- mode list__foldl2_corresponding(pred(in, in, in, out, in, out) is det,
+ in, in, in, out, in, out) is det.
+:- mode list__foldl2_corresponding(pred(in, in, in, out, in, out) is cc_multi,
+ in, in, in, out, in, out) is cc_multi.
+:- mode list__foldl2_corresponding(pred(in, in, in, out, in, out) is semidet,
+ in, in, in, out, in, out) is semidet.
+:- mode list__foldl2_corresponding(pred(in, in, in, out, in, out) is nondet,
+ in, in, in, out, in, out) is nondet.
+:- mode list__foldl2_corresponding(pred(in, in, in, out, di, uo) is det,
+ in, in, in, out, di, uo) is det.
+:- mode list__foldl2_corresponding(pred(in, in, in, out, di, uo) is cc_multi,
+ in, in, in, out, di, uo) is cc_multi.
+
% list__map_foldl(Pred, InList, OutList, Start, End) calls Pred
% with an accumulator (with the initial value of Start) on
% each element of InList (working left-to-right) to transform
@@ -1687,6 +1725,24 @@
call(P, H, !A, !B, !C, !D, !E, !F),
list__foldl6(P, T, !A, !B, !C, !D, !E, !F).
+list__foldl_corresponding(_, [], [], !Acc).
+list__foldl_corresponding(_, [], [_ | _], _, _) :-
+ error("list__foldl_corresponding/5: mismatched list arguments").
+list__foldl_corresponding(_, [_ | _], [], _, _) :-
+ error("list__foldl_corresponding/5: mismatched list arguments").
+list__foldl_corresponding(P, [A | As], [B | Bs], !Acc) :-
+ P(A, B, !Acc),
+ list__foldl_corresponding(P, As, Bs, !Acc).
+
+list__foldl2_corresponding(_, [], [], !Acc1, !Acc2).
+list__foldl2_corresponding(_, [], [_ | _], _, _, _, _) :-
+ error("list__foldl2_corresponding/7: mismatched list arguments").
+list__foldl2_corresponding(_, [_ | _], [], _, _, _, _) :-
+ error("list__foldl2_corresponding/7: mismatched list arguments").
+list__foldl2_corresponding(P, [A | As], [B | Bs], !Acc1, !Acc2) :-
+ P(A, B, !Acc1, !Acc2),
+ list__foldl2_corresponding(P, As, Bs, !Acc1, !Acc2).
+
list__map_foldl(_, [], [], !A).
list__map_foldl(P, [H0 | T0], [H | T], !A) :-
call(P, H0, H, !A),
--------------------------------------------------------------------------
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