[m-rev.] diff: fix ctgc.util.get_type_substitution
Peter Wang
novalazy at gmail.com
Mon Jan 21 16:24:18 AEDT 2008
Branches: main
`ctgc.util.get_type_substitution' is supposed to return a type substitution
which maps a callee's types into the caller's types. However, it didn't
rename apart type variables from the caller and callee type varsets
before calling `type_list_subsumes', which would then fail unexpectedly.
This caused `get_type_substitution' to return an empty substitution.
compiler/ctgc.util.m:
Fix `get_type_substitution', based on code from `inlining.m'.
compiler/structure_reuse.domain.m:
compiler/structure_reuse.indirect.m:
compiler/structure_sharing.analysis.m:
Conform to the change above.
compiler/structure_sharing.domain.m:
Conform to the change above.
Fix a comment.
Index: compiler/ctgc.util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ctgc.util.m,v
retrieving revision 1.14
diff -u -r1.14 ctgc.util.m
--- compiler/ctgc.util.m 10 Jan 2008 04:29:51 -0000 1.14
+++ compiler/ctgc.util.m 21 Jan 2008 04:29:12 -0000
@@ -43,22 +43,28 @@
:- func get_variable_renaming(module_info, pred_proc_id, prog_vars) =
prog_var_renaming.
- % Same as above, but then in the context of the types of the called
- % procedures.
+ % get_type_substitution(ModuleInfo, PPId, ActualTypes,
+ % CallerTypeVarSet, CallerHeadTypeParams) = TypeSubst
%
-:- func get_type_substitution(module_info, pred_proc_id,
- list(mer_type), tvarset) = tsubst.
+ % Work out a type substitution to map the callee's argument types into the
+ % caller's.
+ %
+:- func get_type_substitution(module_info, pred_proc_id, list(mer_type),
+ tvarset, head_type_params) = tsubst.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
+:- import_module libs.compiler_util.
:- import_module parse_tree.prog_type.
+:- import_module parse_tree.prog_type_subst.
:- import_module bool.
:- import_module list.
:- import_module map.
+:- import_module svmap.
%-----------------------------------------------------------------------------%
@@ -95,30 +101,72 @@
proc_info_get_headvars(ProcInfo, FormalVars),
map.from_corresponding_lists(FormalVars, ActualArgs, VariableRenaming).
-get_type_substitution(ModuleInfo, PPId, ActualTypes, _TVarSet) =
- TypeSubstitution :-
- module_info_pred_proc_info(ModuleInfo, PPId, PredInfo, _ProcInfo),
-
- % types of the head variables.
- pred_info_get_arg_types(PredInfo, FormalTypes),
+get_type_substitution(ModuleInfo, PPId, ActualTypes, CallerTypeVarSet,
+ CallerHeadTypeParams) = TypeSubst :-
+ PPId = proc(PredId, _),
+ module_info_pred_info(ModuleInfo, PredId, CalleePredInfo),
+ pred_info_get_typevarset(CalleePredInfo, CalleeTypeVarSet),
+ pred_info_get_arg_types(CalleePredInfo, CalleeArgTypes0),
+ pred_info_get_exist_quant_tvars(CalleePredInfo, CalleeExistQVars),
+
+ % Rename apart the type variables. We don't care about the merged
+ % typevarset.
+ tvarset_merge_renaming(CallerTypeVarSet, CalleeTypeVarSet, _TypeVarSet,
+ CalleeTypeVarRenaming),
+ apply_variable_renaming_to_type_list(CalleeTypeVarRenaming,
+ CalleeArgTypes0, CalleeArgTypes),
(
- type_list_subsumes(FormalTypes, ActualTypes, TypeSubstitution0)
- ->
- TypeSubstitution = TypeSubstitution0
+ CalleeExistQVars = [],
+ ( type_list_subsumes(CalleeArgTypes, ActualTypes, TypeSubst0) ->
+ TypeSubst1 = TypeSubst0
+ ;
+ unexpected(this_file,
+ "ctgc.util.get_type_substitution: type unification failed")
+ )
;
- % XXX Sharing analysis of compiler generated procedures fails due
- % to the fact that type_list_subsumes fails; I assume that the
- % same reasoning as in inlining.get_type_substitution/5 is applicable
- % here: "The head types should always be unifiable with the actual
- % argument types, otherwise it is a type error that should have
- % been detected by typechecking. [...]"
- TypeSubstitution = map.init
- ).
+ CalleeExistQVars = [_ | _],
+ % XXX from inlining.m:
+ % "For calls to existentially type preds, we may need to bind
+ % type variables in the caller, not just those in the callee."
+ % We don't do that (yet?).
+ (
+ map.init(TypeSubstPrime),
+ type_unify_list(CalleeArgTypes, ActualTypes,
+ CallerHeadTypeParams, TypeSubstPrime, TypeSubst0)
+ ->
+ TypeSubst1 = TypeSubst0
+ ;
+ unexpected(this_file,
+ "ctgc.util.get_type_substitution: type unification failed")
+ )
+ ),
+
+ % TypeSubst1 is a substitition for the merged typevarset. We apply the
+ % reverse of CalleeTypeVarRenaming to get TypeSubst, a substitition for
+ % the callee typevarset.
+ % XXX preferably, we wouldn't need to do this reverse renaming
+ map.keys(CalleeTypeVarRenaming, CalleeTypeVarRenamingKeys),
+ map.values(CalleeTypeVarRenaming, CalleeTypeVarRenamingValues),
+ map.from_corresponding_lists(CalleeTypeVarRenamingValues,
+ CalleeTypeVarRenamingKeys, RevCalleeTypeVarRenaming),
+ map.foldl(reverse_renaming(RevCalleeTypeVarRenaming), TypeSubst1,
+ map.init, TypeSubst).
+
+:- pred reverse_renaming(tvar_renaming::in, tvar::in, mer_type::in,
+ tsubst::in, tsubst::out) is det.
+
+reverse_renaming(RevSubst, K0, V0, !Acc) :-
+ apply_variable_renaming_to_tvar(RevSubst, K0, K),
+ apply_variable_renaming_to_type(RevSubst, V0, V),
+ svmap.det_insert(K, V, !Acc).
%-----------------------------------------------------------------------------%
:- func this_file = string.
+
this_file = "ctgc.util.m".
+%-----------------------------------------------------------------------------%
:- end_module transform_hlds.ctgc.util.
+%-----------------------------------------------------------------------------%
Index: compiler/structure_reuse.domain.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.domain.m,v
retrieving revision 1.10
diff -u -r1.10 structure_reuse.domain.m
--- compiler/structure_reuse.domain.m 10 Jan 2008 04:29:53 -0000 1.10
+++ compiler/structure_reuse.domain.m 21 Jan 2008 04:29:12 -0000
@@ -105,7 +105,8 @@
:- pred reuse_as_conditional_reuses(reuse_as::in) is semidet.
% reuse_as_rename_using_module_info(ModuleInfo, PPId,
- % ActualVars, ActualTypes, ActualTVarset, FormalReuse, ActualReuse):
+ % ActualVars, ActualTypes, CallerTypeVarSet, CallerHeadTypeParams,
+ % FormalReuse, ActualReuse):
%
% Renaming of the formal description of structure reuse conditions to the
% actual description of these conditions. The information about the formal
@@ -115,7 +116,7 @@
%
:- pred reuse_as_rename_using_module_info(module_info::in,
pred_proc_id::in, prog_vars::in, list(mer_type)::in, tvarset::in,
- reuse_as::in, reuse_as::out) is det.
+ head_type_params::in, reuse_as::in, reuse_as::out) is det.
% Given a variable and type variable mapping, rename the reuses
% conditions accordingly.
@@ -390,12 +391,12 @@
reuse_as_conditional_reuses(conditional(_)).
reuse_as_rename_using_module_info(ModuleInfo, PPId, ActualArgs, ActualTypes,
- ActualTVarset, FormalReuse, ActualReuse) :-
- reuse_as_rename(
- get_variable_renaming(ModuleInfo, PPId, ActualArgs),
- get_type_substitution(ModuleInfo, PPId, ActualTypes, ActualTVarset),
- FormalReuse, ActualReuse).
-
+ CallerTypeVarSet, CallerHeadTypeParams, FormalReuse, ActualReuse) :-
+ VarRenaming = get_variable_renaming(ModuleInfo, PPId, ActualArgs),
+ TypeSubst = get_type_substitution(ModuleInfo, PPId, ActualTypes,
+ CallerTypeVarSet, CallerHeadTypeParams),
+ reuse_as_rename(VarRenaming, TypeSubst, FormalReuse, ActualReuse).
+
reuse_as_rename(MapVar, TypeSubst, ReuseAs, RenamedReuseAs) :-
(
ReuseAs = no_reuse,
Index: compiler/structure_reuse.indirect.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.indirect.m,v
retrieving revision 1.14
diff -u -r1.14 structure_reuse.indirect.m
--- compiler/structure_reuse.indirect.m 10 Jan 2008 04:29:53 -0000 1.14
+++ compiler/structure_reuse.indirect.m 21 Jan 2008 04:29:12 -0000
@@ -527,10 +527,12 @@
ProcInfo = BaseInfo ^ proc_info,
SharingAs = AnalysisInfo ^ sharing_as,
proc_info_get_vartypes(ProcInfo, ActualVarTypes),
- pred_info_get_typevarset(PredInfo, ActualTVarset),
+ pred_info_get_typevarset(PredInfo, CallerTypeVarSet),
+ pred_info_get_univ_quant_tvars(PredInfo, CallerHeadTypeParams),
map.apply_to_list(CalleeArgs, ActualVarTypes, CalleeTypes),
reuse_as_rename_using_module_info(ModuleInfo, CalleePPId,
- CalleeArgs, CalleeTypes, ActualTVarset, FormalReuseAs, ActualReuseAs),
+ CalleeArgs, CalleeTypes, CallerTypeVarSet, CallerHeadTypeParams,
+ FormalReuseAs, ActualReuseAs),
LiveData = livedata_init_at_goal(ModuleInfo, ProcInfo, GoalInfo,
SharingAs),
ProjectedLiveData = livedata_project(CalleeArgs, LiveData),
Index: compiler/structure_sharing.analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_sharing.analysis.m,v
retrieving revision 1.25
diff -u -r1.25 structure_sharing.analysis.m
--- compiler/structure_sharing.analysis.m 10 Jan 2008 04:29:54 -0000 1.25
+++ compiler/structure_sharing.analysis.m 21 Jan 2008 04:29:12 -0000
@@ -55,6 +55,7 @@
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_type.
+:- import_module parse_tree.prog_type_subst.
:- import_module transform_hlds.ctgc.fixpoint_table.
:- import_module transform_hlds.ctgc.structure_sharing.domain.
:- import_module transform_hlds.ctgc.util.
@@ -350,10 +351,11 @@
% Rename
proc_info_get_vartypes(ProcInfo, CallerVarTypes),
map.apply_to_list(CallArgs, CallerVarTypes, ActualTypes),
- pred_info_get_typevarset(PredInfo, ActualTVarset),
-
+ pred_info_get_typevarset(PredInfo, CallerTypeVarSet),
+ pred_info_get_univ_quant_tvars(PredInfo, CallerHeadParams),
sharing_as_rename_using_module_info(ModuleInfo, CalleePPId, CallArgs,
- ActualTypes, ActualTVarset, CalleeSharing, RenamedSharing),
+ ActualTypes, CallerTypeVarSet, CallerHeadParams,
+ CalleeSharing, RenamedSharing),
% Combine
!:SharingAs = sharing_as_comb(ModuleInfo, ProcInfo,
Index: compiler/structure_sharing.domain.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_sharing.domain.m,v
retrieving revision 1.22
diff -u -r1.22 structure_sharing.domain.m
--- compiler/structure_sharing.domain.m 21 Jan 2008 02:02:04 -0000 1.22
+++ compiler/structure_sharing.domain.m 21 Jan 2008 04:29:12 -0000
@@ -111,18 +111,18 @@
sharing_as::in, sharing_as::out) is det.
% sharing_as_rename_using_module_info(ModuleInfo, PPId,
- % ActualVars, ActualTypes, ActualTVarset, FormalSharing, ActualSharing):
+ % ActualVars, ActualTypes, CallerTVarset, CallerHeadVarParams,
+ % FormalSharing, ActualSharing):
%
% Renaming of the formal description of data structure sharing to the
% actual description of the sharing. The information about the formal
% variables needs to be extracted from the module information.
% A list of variables and types is used as the actual variables and types.
% The type variables set in the actual context must also be specified.
- %
%
:- pred sharing_as_rename_using_module_info(module_info::in,
pred_proc_id::in, prog_vars::in, list(mer_type)::in, tvarset::in,
- sharing_as::in, sharing_as::out) is det.
+ head_type_params::in, sharing_as::in, sharing_as::out) is det.
% One of the cornerstone operations of using the program analysis system
% is to provide a "comb" (combination) operation that combines new
@@ -379,11 +379,12 @@
).
sharing_as_rename_using_module_info(ModuleInfo, PPId, ActualVars, ActualTypes,
- ActualTVarset, FormalSharing, ActualSharing):-
+ CallerTypeVarSet, CallerHeadTypeParams,
+ FormalSharing, ActualSharing) :-
VarRenaming = get_variable_renaming(ModuleInfo, PPId, ActualVars),
- TypeRenaming = get_type_substitution(ModuleInfo, PPId, ActualTypes,
- ActualTVarset),
- sharing_as_rename(VarRenaming, TypeRenaming, FormalSharing, ActualSharing).
+ TypeSubst = get_type_substitution(ModuleInfo, PPId, ActualTypes,
+ CallerTypeVarSet, CallerHeadTypeParams),
+ sharing_as_rename(VarRenaming, TypeSubst, FormalSharing, ActualSharing).
sharing_as_comb(ModuleInfo, ProcInfo, NewSharing, OldSharing) = ResultSharing :-
(
@@ -772,12 +773,13 @@
lookup_sharing_or_predict(ModuleInfo, SharingTable, PPId, FormalSharing),
proc_info_get_vartypes(ProcInfo, VarTypes),
- list.map(map.lookup(VarTypes), ActualVars, ActualTypes),
+ map.apply_to_list(ActualVars, VarTypes, ActualTypes),
- pred_info_get_typevarset(PredInfo, ActualTVarset),
+ pred_info_get_typevarset(PredInfo, CallerTypeVarSet),
+ pred_info_get_univ_quant_tvars(PredInfo, CallerHeadTypeParams),
sharing_as_rename_using_module_info(ModuleInfo, PPId,
- ActualVars, ActualTypes, ActualTVarset, FormalSharing,
- ActualSharing),
+ ActualVars, ActualTypes, CallerTypeVarSet, CallerHeadTypeParams,
+ FormalSharing, ActualSharing),
!:Sharing = sharing_as_comb(ModuleInfo, ProcInfo,
ActualSharing, !.Sharing).
@@ -1788,24 +1790,19 @@
selector_sharing_set_extend_datastruct(ModuleInfo, VarType, Selector,
SelectorSharingSet) = Datastructures :-
SelectorSharingSet = selector_sharing_set(_, SelectorMap),
- Datastructures =
- list.condense(
- map.values(
- map.map_values(
- selector_sharing_set_extend_datastruct_2(ModuleInfo,
- VarType, Selector),
- SelectorMap)
- )
- ).
+ DoExtend = selector_sharing_set_extend_datastruct_2(ModuleInfo, VarType,
+ Selector),
+ Datastructures0 = map.map_values(DoExtend, SelectorMap),
+ Datastructures = list.condense(map.values(Datastructures0)).
:- func selector_sharing_set_extend_datastruct_2(module_info,
mer_type, selector, selector, data_set) = list(datastruct).
selector_sharing_set_extend_datastruct_2(ModuleInfo, VarType, BaseSelector,
Selector, Dataset0) = Datastructures :-
- % If Sel is more general than Selector, i.e.
- % Selector = Sel.Extension, apply this extension
- % to all the datastructs associated with Sel, and add them
+ % If Selector is more general than BaseSelector, i.e.
+ % BaseSelector = Selector.Extension, apply this extension
+ % to all the datastructs associated with Selector, and add them
% to the set of datastructs collected.
(
ctgc.selector.subsumed_by(ModuleInfo, BaseSelector,
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list