[m-rev.] diff: fix --optimize-higher-order bug
Simon Taylor
stayl at cs.mu.OZ.AU
Wed Jan 15 00:49:00 AEDT 2003
Estimated hours taken: 5
Branches: main, release
compiler/higher_order.m:
Fix a bug in `--optimize-higher-order' which caused compilation of
analysis/analysis.file.m to fail with inter-module optimization.
The problem was that type-infos for curried arguments of a higher-order
term were not being added to the typeinfo_varmap for the specialized
procedure.
tests/valid/Mmakefile:
tests/valid/Mercury.options:
tests/valid/higher_order4.m:
Test case.
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.97
diff -u -u -r1.97 higher_order.m
--- compiler/higher_order.m 22 Jul 2002 06:29:29 -0000 1.97
+++ compiler/higher_order.m 14 Jan 2003 13:43:38 -0000
@@ -2683,12 +2683,10 @@
pred_info_typevarset(NewPredInfo0, TypeVarSet0),
pred_info_arg_types(NewPredInfo0, OriginalArgTypes0),
- CallerPredProcId = proc(CallerPredId, CallerProcId),
- module_info_pred_proc_info(ModuleInfo, CallerPredId, CallerProcId,
- CallerPredInfo, CallerProcInfo),
+ CallerPredProcId = proc(CallerPredId, _),
+ module_info_pred_info(ModuleInfo, CallerPredId, CallerPredInfo),
pred_info_typevarset(CallerPredInfo, CallerTypeVarSet),
pred_info_get_univ_quant_tvars(CallerPredInfo, CallerHeadParams),
- proc_info_typeinfo_varmap(CallerProcInfo, CallerTypeInfoVarMap0),
%
% Specialize the types of the called procedure as for inlining.
@@ -2749,14 +2747,36 @@
proc_info_create_vars_from_types(NewProcInfo1, ExtraTypeInfoTypes,
ExtraTypeInfoVars, NewProcInfo2),
+ %
+ % Add any extra type-infos or typeclass-infos we've added
+ % to the typeinfo_varmap and typeclass_info_varmap.
+ %
+ proc_info_typeinfo_varmap(NewProcInfo2, TypeInfoVarMap0),
+
+ % The variable renaming doesn't rename variables in the callee.
+ map__init(EmptyVarRenaming),
+ apply_substitutions_to_var_map(TypeInfoVarMap0, TypeRenaming,
+ TypeSubn, EmptyVarRenaming, TypeInfoVarMap1),
+
+ % 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),
+
+ proc_info_set_typeinfo_varmap(NewProcInfo2,
+ TypeInfoVarMap, NewProcInfo3),
+
map__from_corresponding_lists(CallArgs, HeadVars0, VarRenaming0),
% Construct the constant input closures within the goal
% for the called procedure.
map__init(PredVars0),
construct_higher_order_terms(ModuleInfo, HeadVars0, ExtraHeadVars,
- ArgModes0, ExtraArgModes, HOArgs, NewProcInfo2, NewProcInfo3,
- VarRenaming0, VarRenaming, PredVars0, PredVars, ConstGoals),
+ ArgModes0, ExtraArgModes, HOArgs, NewProcInfo3, NewProcInfo4,
+ VarRenaming0, _, PredVars0, PredVars, ConstGoals),
%
% Record extra information about this version.
@@ -2786,45 +2806,6 @@
Info = Info0 ^ version_info := VersionInfoMap,
%
- % Fix up the typeinfo_varmap.
- %
- proc_info_typeinfo_varmap(NewProcInfo3, TypeInfoVarMap0),
-
- % Restrict the caller's typeinfo_varmap
- % down onto the arguments of the call.
- map__to_assoc_list(CallerTypeInfoVarMap0, TypeInfoAL0),
- list__filter(
- (pred(TVarAndLocn::in) is semidet :-
- TVarAndLocn = _ - Locn,
- type_info_locn_var(Locn, LocnVar),
- map__contains(VarRenaming, LocnVar)
- ), TypeInfoAL0, TypeInfoAL),
- map__from_assoc_list(TypeInfoAL, CallerTypeInfoVarMap1),
-
- % The type renaming doesn't rename type variables in the caller.
- map__init(EmptyTypeRenaming),
- apply_substitutions_to_var_map(CallerTypeInfoVarMap1,
- EmptyTypeRenaming, TypeSubn, VarRenaming,
- CallerTypeInfoVarMap),
- % The variable renaming doesn't rename variables in the callee.
- map__init(EmptyVarRenaming),
- apply_substitutions_to_var_map(TypeInfoVarMap0, TypeRenaming,
- TypeSubn, EmptyVarRenaming, TypeInfoVarMap1),
- map__merge(TypeInfoVarMap1, CallerTypeInfoVarMap,
- TypeInfoVarMap2),
-
- % 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(TypeInfoVarMap2, ExtraTypeInfoMap, TypeInfoVarMap),
-
- proc_info_set_typeinfo_varmap(NewProcInfo3,
- TypeInfoVarMap, NewProcInfo4),
-
- %
% Fix up the argument vars, types and modes.
%
@@ -2952,11 +2933,11 @@
map(prog_var, prog_var)::in, map(prog_var, prog_var)::out,
pred_vars::in, pred_vars::out, list(hlds_goal)::out) is det.
-construct_higher_order_terms(_, _, [], _, [], [], ProcInfo, ProcInfo,
- Renaming, Renaming, PredVars, PredVars, []).
+construct_higher_order_terms(_, _, [], _, [], [], !ProcInfo,
+ !Renaming, !PredVars, []).
construct_higher_order_terms(ModuleInfo, HeadVars0, NewHeadVars, ArgModes0,
- NewArgModes, [HOArg | HOArgs], ProcInfo0, ProcInfo,
- Renaming0, Renaming, PredVars0, PredVars, ConstGoals) :-
+ NewArgModes, [HOArg | HOArgs], !ProcInfo, !Renaming,
+ !PredVars, ConstGoals) :-
HOArg = higher_order_arg(ConsId, Index, NumArgs,
CurriedArgs, CurriedArgTypes, CurriedHOArgs, IsConst),
@@ -2986,17 +2967,21 @@
list__duplicate(NumArgs, InMode, CurriedArgModes1)
),
- proc_info_create_vars_from_types(ProcInfo0, CurriedArgTypes,
- CurriedHeadVars1, ProcInfo1),
-
+ proc_info_create_vars_from_types(!.ProcInfo, CurriedArgTypes,
+ CurriedHeadVars1, !:ProcInfo),
+ CurriedHeadVarsAndTypes = assoc_list__from_corresponding_lists(
+ CurriedHeadVars1, CurriedArgTypes),
+
+ list__foldl(add_rtti_info, CurriedHeadVarsAndTypes, !ProcInfo),
+
( IsConst = no ->
% Make traverse_goal pretend that the input higher-order
% argument is built using the new arguments as its curried
% arguments.
- map__det_insert(PredVars0, LVar,
- constant(ConsId, CurriedHeadVars1), PredVars1)
+ map__det_insert(!.PredVars, LVar,
+ constant(ConsId, CurriedHeadVars1), !:PredVars)
;
- PredVars1 = PredVars0
+ true
),
assoc_list__from_corresponding_lists(CurriedArgs,
@@ -3005,18 +2990,18 @@
(pred(VarPair::in, Map0::in, Map::out) is det :-
VarPair = Var1 - Var2,
map__set(Map0, Var1, Var2, Map)
- ), CurriedRenaming, Renaming0, Renaming1),
+ ), CurriedRenaming, !Renaming),
% Recursively construct the curried higher-order arguments.
construct_higher_order_terms(ModuleInfo, CurriedHeadVars1,
ExtraCurriedHeadVars, CurriedArgModes1, ExtraCurriedArgModes,
- CurriedHOArgs, ProcInfo1, ProcInfo2, Renaming1, Renaming2,
- PredVars1, PredVars2, CurriedConstGoals),
+ CurriedHOArgs, !ProcInfo, !Renaming, !PredVars,
+ CurriedConstGoals),
% Construct the rest of the higher-order arguments.
construct_higher_order_terms(ModuleInfo, HeadVars0, NewHeadVars1,
- ArgModes0, NewArgModes1, HOArgs, ProcInfo2, ProcInfo,
- Renaming2, Renaming, PredVars2, PredVars, ConstGoals1),
+ ArgModes0, NewArgModes1, HOArgs, !ProcInfo,
+ !Renaming, !PredVars, ConstGoals1),
( IsConst = yes ->
%
@@ -3053,6 +3038,53 @@
list__condense([CurriedArgModes, ExtraCurriedArgModes, NewArgModes1],
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_rtti_info(Var - VarType, !ProcInfo) :-
+ (
+ polymorphism__type_info_type(VarType, Type),
+ Type = term__variable(TVar)
+ ->
+ maybe_set_typeinfo_locn(TVar, type_info(Var), !ProcInfo)
+ ;
+ 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(!.ProcInfo,
+ TCVarMap, !:ProcInfo),
+ Constraint = constraint(_, ConstraintTypes),
+ list__foldl2(
+ (pred(ConstraintType::in, Index::in, (Index + 1)::out,
+ !.ProcInfo::in, !:ProcInfo::out) is det :-
+ ( ConstraintType = term__variable(ConstraintTVar) ->
+ maybe_set_typeinfo_locn(ConstraintTVar,
+ typeclass_info(Var, Index), !ProcInfo)
+ ;
+ true
+ )
+ ), ConstraintTypes, 1, _, !ProcInfo)
+ ;
+ true
+ ).
+
+:- pred maybe_set_typeinfo_locn(tvar::in, type_info_locn::in,
+ proc_info::in, proc_info::out) is det.
+
+maybe_set_typeinfo_locn(TVar, Locn, !ProcInfo) :-
+ proc_info_typeinfo_varmap(!.ProcInfo, TVarMap0),
+ ( map__contains(TVarMap0, TVar) ->
+ true
+ ;
+ map__det_insert(TVarMap0, TVar, Locn, TVarMap),
+ proc_info_set_typeinfo_varmap(!.ProcInfo, TVarMap, !:ProcInfo)
+ ).
:- pred remove_const_higher_order_args(int::in, list(T)::in,
list(higher_order_arg)::in, list(T)::out) is det.
Index: tests/valid/Mercury.options
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mercury.options,v
retrieving revision 1.3
diff -u -u -r1.3 Mercury.options
--- tests/valid/Mercury.options 22 Nov 2002 08:50:43 -0000 1.3
+++ tests/valid/Mercury.options 14 Jan 2003 07:39:20 -0000
@@ -37,6 +37,7 @@
MCFLAGS-double_vn = -O4
MCFLAGS-explicit_quant = --halt-at-warn
MCFLAGS-foreign_underscore_var = --halt-at-warn
+MCFLAGS-higher_order4 = -O3
MCFLAGS-higher_order_implied_mode = -O-1
MCFLAGS-inhibit_warn_test = --inhibit-warnings --halt-at-warn
MCFLAGS-intermod_dcg_bug = --intermodule-optimization
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.120
diff -u -u -r1.120 Mmakefile
--- tests/valid/Mmakefile 12 Jan 2003 22:33:33 -0000 1.120
+++ tests/valid/Mmakefile 14 Jan 2003 13:24:03 -0000
@@ -82,6 +82,7 @@
higher_order \
higher_order2 \
higher_order3 \
+ higher_order4 \
higher_order_implied_mode \
ho_func_call \
ho_inst \
Index: tests/valid/higher_order4.m
===================================================================
RCS file: tests/valid/higher_order4.m
diff -N tests/valid/higher_order4.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/valid/higher_order4.m 14 Jan 2003 07:38:42 -0000
@@ -0,0 +1,63 @@
+:- module higher_order4.
+
+:- interface.
+
+:- import_module io, list, std_util.
+
+:- type analysis_request
+ ---> some [FuncInfo, Call] analysis_request(unit(FuncInfo), Call)
+ => call_pattern(FuncInfo, Call).
+:- type module_analysis_map(T) == mymap(analysis_name, func_analysis_map(T)).
+:- type func_analysis_map(T) == mymap(func_id, list(T)).
+:- type analysis_name == string.
+:- type func_id == string.
+:- typeclass call_pattern(T, U) where [].
+:- typeclass compiler(T) where [].
+
+:- pred write_module_analysis_requests(Compiler::in,
+ module_analysis_map(analysis_request)::in,
+ io__state::di, io__state::uo) is det <= compiler(Compiler).
+
+:- implementation.
+
+write_module_analysis_requests(Compiler, ModuleRequests, !IO) :-
+ write_analysis_entries(write_request_entry(Compiler),
+ ModuleRequests, !IO).
+
+:- pred write_request_entry(Compiler::in)
+ `with_type` write_entry(analysis_request)
+ `with_inst` write_entry <= compiler(Compiler).
+
+write_request_entry(_, _, _, analysis_request(_, _), !IO).
+
+:- type write_entry(T) == pred(analysis_name, func_id, T, io__state, io__state).
+:- inst write_entry == (pred(in, in, in, di, uo) is det).
+
+:- pred write_analysis_entries(write_entry(T)::in(write_entry),
+ module_analysis_map(T)::in, io__state::di, io__state::uo) is det.
+
+write_analysis_entries(WriteEntry, ModuleResults, !IO) :-
+ mymap_foldl(
+ (pred(AnalysisName::in, FuncResults::in, di, uo) is det -->
+ mymap_foldl(
+ (pred(FuncId::in, FuncResultList::in, di, uo) is det -->
+ list__foldl(
+ (pred(FuncResult::in, di, uo) is det -->
+ WriteEntry(AnalysisName, FuncId, FuncResult)
+ ), FuncResultList)
+ ), FuncResults)
+ ), ModuleResults, !IO).
+
+:- type mymap(K, V) --->
+ empty
+ ; two(K, V, mymap(K, V), mymap(K, V)).
+
+:- pred mymap_foldl(pred(K, V, T, T), mymap(K, V), T, T).
+:- mode mymap_foldl(pred(in, in, di, uo) is det, in, di, uo) is det.
+
+mymap_foldl(_Pred, empty, Acc, Acc).
+mymap_foldl(Pred, two(K, V, T0, T1), Acc0, Acc) :-
+ mymap_foldl(Pred, T0, Acc0, Acc1),
+ call(Pred, K, V, Acc1, Acc2),
+ mymap_foldl(Pred, T1, Acc2, Acc).
+
--------------------------------------------------------------------------
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