[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