[m-rev.] for review: fix equivalence type performance problems

[Simon Taylor]

On 12-Dec-2003, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> On 12-Dec-2003, Simon Taylor <stayl at cs.mu.OZ.AU> wrote:
> > 
> > Fix excessive memory usage caused by the equiv_type_hlds pass.
> > 
> > compiler/equiv_type_hlds.m:
> > compiler/equiv_type.m:
> > 	Maintain sharing in insts in the equiv_type_hlds pass.
> > 
> > 	Avoid duplicating types and insts which do not contain
> > 	equivalence types to expand.  (It should be possible
> > 	and may be worthwhile to implement a source to source
> > 	transformation to do this sort of thing automatically.
> > 	There are plenty of other instances of this in the
> > 	compiler and library).
> > 
> > compiler/make_hlds.m:
> > 	Change required by the above.
> 
> Those parts are fine.
> 
> > compiler/mercury_compile.m:
> > 	Re-enable equiv_type_hlds.m.
> > 
> > tests/hard_coded/Mmakefile:
> > 	Re-enable testing of equiv_type_hlds.m.
> 
> I would like to see some performance figures for how much
> it costs to run this extra pass before we re-enable it.

With the extra change below, the equiv_type_hlds pass adds about
5% to compile time, much of that in equiv_type.replace_in_type.
I don't think we can do much better without changing the
representation of types in the compiler.

time mmc -C -I ../library -I ../browser -I ../analysis libs.options
With equiv_type_hlds: 27.1s (user time)
Without equiv_type_hlds: 26.1s

time mmc -C -I ../library -I ../browser -I ../analysis hlds.make_hlds
With equiv_type_hlds: 12.7s
Without equiv_type_hlds: 12.0s

Simon.

--- equiv_type_hlds.m	2003/12/15 11:31:25	1.2
+++ equiv_type_hlds.m	2003/12/15 12:12:58
@@ -318,12 +318,14 @@
 	proc_info_set_typeclass_info_varmap(TCVarMap, !ProcInfo),
 
 	proc_info_goal(!.ProcInfo, Goal0),
-	replace_in_goal(EqvMap, Goal0, Goal,
+	replace_in_goal(EqvMap, Goal0, Goal, Changed,
 		replace_info(!.ModuleInfo, !.PredInfo,
 				!.ProcInfo, !.TVarSet, !.Cache, no),
 		replace_info(!:ModuleInfo, !:PredInfo,
 				!:ProcInfo, !:TVarSet, _XXX, Recompute)),
-	proc_info_set_goal(Goal, !ProcInfo),
+	( Changed = yes, proc_info_set_goal(Goal, !ProcInfo)
+	; Changed = no
+	),
 
 	( Recompute = yes ->
 		requantify_proc(!ProcInfo),
@@ -578,71 +580,122 @@
 		recompute :: bool
 	).
 
-:- pred replace_in_goal(eqv_map::in, hlds_goal::in, hlds_goal::out,
-		replace_info::in, replace_info::out) is det.
-
-replace_in_goal(EqvMap, GoalExpr0 - GoalInfo0,
-		GoalExpr - GoalInfo, !Info) :-
-	replace_in_goal_expr(EqvMap, GoalExpr0, GoalExpr, !Info),
+:- pred replace_in_goal(eqv_map::in)
+		`with_type` replacer(hlds_goal, replace_info)
+		`with_inst` replacer.
+
+replace_in_goal(EqvMap, Goal0 @ (GoalExpr0 - GoalInfo0), Goal,
+		Changed, !Info) :-
+	replace_in_goal_expr(EqvMap, GoalExpr0, GoalExpr, Changed0, !Info),
 
 	goal_info_get_instmap_delta(GoalInfo0, InstMapDelta0),
 	TVarSet0 = !.Info ^ tvarset,
 	Cache0 = !.Info ^ inst_cache,
 	instmap_delta_map_foldl(
 		(pred(_::in, Inst0::in, Inst::out,
-				{TVarSet1, Cache1}::in,
-				{TVarSet2, Cache2}::out) is det :-
-			replace_in_inst(EqvMap, Inst0, Inst, _,
+				{Changed1, TVarSet1, Cache1}::in,
+				{Changed1 `or` InstChanged,
+					TVarSet2, Cache2}::out) is det :-
+			replace_in_inst(EqvMap, Inst0, Inst, InstChanged,
 				TVarSet1, TVarSet2, Cache1, Cache2)
 		), InstMapDelta0, InstMapDelta,
-		{TVarSet0, Cache0}, {TVarSet, Cache}),
-	!:Info = (!.Info ^ tvarset := TVarSet)
-			^ inst_cache := Cache,
-	goal_info_set_instmap_delta(GoalInfo0, InstMapDelta, GoalInfo).
-
-:- pred replace_in_goal_expr(eqv_map::in,
-		hlds_goal_expr::in, hlds_goal_expr::out,
-		replace_info::in, replace_info::out) is det.
-
-replace_in_goal_expr(EqvMap, conj(Goals0), conj(Goals), !Info) :-
-	list__map_foldl(replace_in_goal(EqvMap), Goals0, Goals, !Info).
-replace_in_goal_expr(EqvMap, par_conj(Goals0), par_conj(Goals), !Info) :-
-	list__map_foldl(replace_in_goal(EqvMap), Goals0, Goals, !Info).
-replace_in_goal_expr(EqvMap, disj(Goals0), disj(Goals), !Info) :-
-	list__map_foldl(replace_in_goal(EqvMap), Goals0, Goals, !Info).
-replace_in_goal_expr(EqvMap, switch(A, B, Cases0),
-		switch(A, B, Cases), !Info) :-
-	list__map_foldl(
-		(pred(case(ConsId, Goal0)::in, case(ConsId, Goal)::out,
+		{Changed0, TVarSet0, Cache0}, {Changed, TVarSet, Cache}),
+	( Changed = yes,
+		!:Info = (!.Info ^ tvarset := TVarSet)
+				^ inst_cache := Cache,
+		goal_info_set_instmap_delta(GoalInfo0, InstMapDelta, GoalInfo),
+		Goal = GoalExpr - GoalInfo
+	; Changed = no,
+		Goal = Goal0
+	).
+
+:- pred replace_in_goal_expr(eqv_map::in)
+		`with_type` replacer(hlds_goal_expr, replace_info)
+		`with_inst` replacer.
+
+replace_in_goal_expr(EqvMap, Goal0 @ conj(Goals0), Goal,
+		Changed, !Info) :-
+	replace_in_list(replace_in_goal(EqvMap), Goals0, Goals,
+		Changed, !Info),
+	( Changed = yes, Goal = conj(Goals)
+	; Changed = no, Goal = Goal0
+	).
+replace_in_goal_expr(EqvMap, Goal0 @ par_conj(Goals0), Goal,
+		Changed, !Info) :-
+	replace_in_list(replace_in_goal(EqvMap), Goals0, Goals,
+		Changed, !Info),
+	( Changed = yes, Goal = par_conj(Goals)
+	; Changed = no, Goal = Goal0
+	).
+replace_in_goal_expr(EqvMap, Goal0 @ disj(Goals0), Goal,
+		Changed, !Info) :-
+	replace_in_list(replace_in_goal(EqvMap), Goals0, Goals,
+		Changed, !Info),
+	( Changed = yes, Goal = disj(Goals)
+	; Changed = no, Goal = Goal0
+	).
+replace_in_goal_expr(EqvMap, Goal0 @ switch(A, B, Cases0), Goal,
+		Changed, !Info) :-
+	replace_in_list(
+		(pred((Case0 @ case(ConsId, CaseGoal0))::in, Case::out,
+				CaseChanged::out,
 				!.Info::in, !:Info::out) is det :-
-			replace_in_goal(EqvMap, Goal0, Goal, !Info)
-		), Cases0, Cases, !Info).
-replace_in_goal_expr(EqvMap, not(Goal0), not(Goal), !Info) :-
-	replace_in_goal(EqvMap, Goal0, Goal, !Info).
-replace_in_goal_expr(EqvMap, some(A, B, Goal0), some(A, B, Goal), !Info) :-
-	replace_in_goal(EqvMap, Goal0, Goal, !Info).
-replace_in_goal_expr(EqvMap, if_then_else(Vars, Cond0, Then0, Else0),
-		if_then_else(Vars, Cond, Then, Else), !Info) :-
-	replace_in_goal(EqvMap, Cond0, Cond, !Info),
-	replace_in_goal(EqvMap, Then0, Then, !Info),
-	replace_in_goal(EqvMap, Else0, Else, !Info).
-replace_in_goal_expr(_, call(_, _, _, _, _, _) @ Goal, Goal, !Info).
-replace_in_goal_expr(EqvMap, foreign_proc(_, _, _, _, _, _, _) @ Goal0, Goal,
-			!Info) :-
+			replace_in_goal(EqvMap, CaseGoal0, CaseGoal,
+				CaseChanged, !Info),
+			( CaseChanged = yes, Case = case(ConsId, CaseGoal)
+			; CaseChanged = no, Case = Case0
+			)
+		), Cases0, Cases, Changed, !Info),
+	( Changed = yes, Goal = switch(A, B, Cases)
+	; Changed = no, Goal = Goal0
+	).
+replace_in_goal_expr(EqvMap, Goal0 @ not(NegGoal0), Goal, Changed, !Info) :-
+	replace_in_goal(EqvMap, NegGoal0, NegGoal, Changed, !Info),
+	( Changed = yes, Goal = not(NegGoal)
+	; Changed = no, Goal = Goal0
+	).
+replace_in_goal_expr(EqvMap, Goal0 @ some(A, B, SomeGoal0), Goal,
+		Changed, !Info) :-
+	replace_in_goal(EqvMap, SomeGoal0, SomeGoal, Changed, !Info),
+	( Changed = yes, Goal = some(A, B, SomeGoal)
+	; Changed = no, Goal = Goal0
+	).
+replace_in_goal_expr(EqvMap, Goal0 @ if_then_else(Vars, Cond0, Then0, Else0),
+		Goal, Changed, !Info) :-
+	replace_in_goal(EqvMap, Cond0, Cond, Changed1, !Info),
+	replace_in_goal(EqvMap, Then0, Then, Changed2, !Info),
+	replace_in_goal(EqvMap, Else0, Else, Changed3, !Info),
+	Changed = Changed1 `or` Changed2 `or` Changed3,
+	( Changed = yes, Goal = if_then_else(Vars, Cond, Then, Else)
+	; Changed = no, Goal = Goal0
+	).
+replace_in_goal_expr(_, Goal @ call(_, _, _, _, _, _), Goal, no, !Info).
+replace_in_goal_expr(EqvMap, Goal0 @ foreign_proc(_, _, _, _, _, _, _), Goal,
+			Changed, !Info) :-
 	TVarSet0 = !.Info ^ tvarset,
 	replace_in_type_list(EqvMap, Goal0 ^ foreign_types, Types,
-		_, TVarSet0, TVarSet, no, _),
-	!:Info = !.Info ^ tvarset := TVarSet,
-	Goal = Goal0 ^ foreign_types := Types.	
-replace_in_goal_expr(EqvMap, generic_call(A, B, Modes0, D),
-		generic_call(A, B, Modes, D), !Info) :-
+		Changed, TVarSet0, TVarSet, no, _),
+	( Changed = yes,
+		!:Info = !.Info ^ tvarset := TVarSet,
+		Goal = Goal0 ^ foreign_types := Types
+	; Changed = no,
+		Goal = Goal0
+	).
+replace_in_goal_expr(EqvMap, Goal0 @ generic_call(A, B, Modes0, D), Goal,
+		Changed, !Info) :-
 	TVarSet0 = !.Info ^ tvarset,
 	Cache0 = !.Info ^ inst_cache,
-	replace_in_modes(EqvMap, Modes0, Modes, _,
+	replace_in_modes(EqvMap, Modes0, Modes, Changed,
 		TVarSet0, TVarSet, Cache0, Cache),
-	!:Info = (!.Info ^ tvarset := TVarSet)
-			^ inst_cache := Cache.
-replace_in_goal_expr(EqvMap, unify(Var, _, _, _, _) @ Goal0, Goal, !Info) :-
+	( Changed = yes,
+		!:Info = (!.Info ^ tvarset := TVarSet)
+				^ inst_cache := Cache,
+		Goal = generic_call(A, B, Modes, D)
+	; Changed = no,
+		Goal = Goal0
+	).
+replace_in_goal_expr(EqvMap, Goal0 @ unify(Var, _, _, _, _), Goal,
+		Changed, !Info) :-
 	module_info_types(!.Info ^ module_info, Types),
 	proc_info_vartypes(!.Info ^ proc_info, VarTypes),
 	map__lookup(VarTypes, Var, VarType),
@@ -663,6 +716,7 @@
 		type_to_ctor_and_args(VarType, _TypeInfoCtor,
 				[TypeInfoArgType])
 	->
+		Changed = yes,
 		pred_info_set_typevarset(!.Info ^ tvarset,
 			!.Info ^ pred_info, PredInfo0),
 		create_poly_info(!.Info ^ module_info,
@@ -701,57 +755,96 @@
 		hlds_data__get_type_defn_body(TypeDefn, Body),
 		Body = eqv_type(_)
 	->
+		Changed = yes,
 		Goal = conj([]),
 		!:Info = !.Info ^ recompute := yes
 	;
 		Goal0 ^ unify_mode = LMode0 - RMode0,
 		TVarSet0 = !.Info ^ tvarset,
 		Cache0 = !.Info ^ inst_cache,
-		replace_in_mode(EqvMap, LMode0, LMode, _, TVarSet0, TVarSet1,
-			Cache0, Cache1),
-		replace_in_mode(EqvMap, RMode0, RMode, _, TVarSet1, TVarSet,
-			Cache1, Cache),
+		replace_in_mode(EqvMap, LMode0, LMode, Changed1,
+			TVarSet0, TVarSet1, Cache0, Cache1),
+		replace_in_mode(EqvMap, RMode0, RMode, Changed2,
+			TVarSet1, TVarSet, Cache1, Cache),
 		!:Info = (!.Info ^ tvarset := TVarSet)
 				^ inst_cache := Cache,
 		replace_in_unification(EqvMap, Goal0 ^ unify_kind, Unification,
-			!Info),
-		Goal = (Goal0 ^ unify_mode := LMode - RMode)
-				^ unify_kind := Unification
+			Changed3, !Info),
+		Changed = Changed1 `or` Changed2 `or` Changed3,
+		( Changed = yes,
+			Goal = (Goal0 ^ unify_mode := LMode - RMode)
+					^ unify_kind := Unification
+		; Changed = no,
+			Goal = Goal0
+		)	
 	).
-replace_in_goal_expr(_, shorthand(_), _, !Info) :-
+replace_in_goal_expr(_, shorthand(_), _, _, !Info) :-
 	error("replace_in_goal_expr: shorthand").
 
-:- pred replace_in_unification(eqv_map::in, unification::in, unification::out,
-		replace_info::in, replace_info::out) is det.
-
-replace_in_unification(_, assign(_, _) @ Uni, Uni, !Info).
-replace_in_unification(_, simple_test(_, _) @ Uni, Uni, !Info).
-replace_in_unification(EqvMap, complicated_unify(UniMode0, B, C),
-		complicated_unify(UniMode, B, C), !Info) :-
-	replace_in_uni_mode(EqvMap, UniMode0, UniMode, !Info).
+:- pred replace_in_unification(eqv_map::in)
+		`with_type` replacer(unification, replace_info)
+		`with_inst` replacer.
+
+replace_in_unification(_, assign(_, _) @ Uni, Uni, no, !Info).
+replace_in_unification(_, simple_test(_, _) @ Uni, Uni, no, !Info).
+replace_in_unification(EqvMap, Uni0 @ complicated_unify(UniMode0, B, C), Uni,
+		Changed, !Info) :-
+	replace_in_uni_mode(EqvMap, UniMode0, UniMode, Changed, !Info),
+	( Changed = yes, Uni = complicated_unify(UniMode, B, C)
+	; Changed = no, Uni = Uni0
+	).
 replace_in_unification(EqvMap, construct(_, _, _, _, _, _, _) @ Uni0, Uni,
-		!Info) :-
-	list__map_foldl(replace_in_uni_mode(EqvMap),
-		Uni0 ^ construct_arg_modes, UniModes, !Info),
-	Uni = Uni0 ^ construct_arg_modes := UniModes.
+		Changed, !Info) :-
+	replace_in_list(replace_in_uni_mode(EqvMap),
+		Uni0 ^ construct_arg_modes, UniModes, Changed, !Info),
+	( Changed = yes, Uni = Uni0 ^ construct_arg_modes := UniModes
+	; Changed = no, Uni = Uni0
+	).
 replace_in_unification(EqvMap, deconstruct(_, _, _, _, _, _) @ Uni0, Uni,
-		!Info) :-
-	list__map_foldl(replace_in_uni_mode(EqvMap),
-		Uni0 ^ deconstruct_arg_modes, UniModes, !Info),
-	Uni = Uni0 ^ deconstruct_arg_modes := UniModes.
+		Changed, !Info) :-
+	replace_in_list(replace_in_uni_mode(EqvMap),
+		Uni0 ^ deconstruct_arg_modes, UniModes, Changed, !Info),
+	( Changed = yes, Uni = Uni0 ^ deconstruct_arg_modes := UniModes
+	; Changed = no, Uni = Uni0
+	).
 
-:- pred replace_in_uni_mode(eqv_map::in, uni_mode::in, uni_mode::out,
-		replace_info::in, replace_info::out) is det.
+:- pred replace_in_uni_mode(eqv_map::in)
+		`with_type` replacer(uni_mode, replace_info)
+		`with_inst` replacer.
 
 replace_in_uni_mode(EqvMap, ((InstA0 - InstB0) -> (InstC0 - InstD0)),
-		((InstA - InstB) -> (InstC - InstD)), !Info) :-
+		((InstA - InstB) -> (InstC - InstD)), Changed, !Info) :-
 	some [!TVarSet, !Cache] (
 		!:TVarSet = !.Info ^ tvarset,
 		!:Cache = !.Info ^ inst_cache,
-		replace_in_inst(EqvMap, InstA0, InstA, _, !TVarSet, !Cache),
-		replace_in_inst(EqvMap, InstB0, InstB, _, !TVarSet, !Cache),
-		replace_in_inst(EqvMap, InstC0, InstC, _, !TVarSet, !Cache),
-		replace_in_inst(EqvMap, InstD0, InstD, _, !TVarSet, !Cache),
-		!:Info = (!.Info ^ tvarset := !.TVarSet)
-				^ inst_cache := !.Cache
+		replace_in_inst(EqvMap, InstA0, InstA,
+			Changed1, !TVarSet, !Cache),
+		replace_in_inst(EqvMap, InstB0, InstB,
+			Changed2, !TVarSet, !Cache),
+		replace_in_inst(EqvMap, InstC0, InstC,
+			Changed3, !TVarSet, !Cache),
+		replace_in_inst(EqvMap, InstD0, InstD,
+			Changed4, !TVarSet, !Cache),
+		Changed = Changed1 `or` Changed2 `or` Changed3 `or` Changed4,
+		( Changed = yes,
+			!:Info = (!.Info ^ tvarset := !.TVarSet)
+					^ inst_cache := !.Cache
+		; Changed = no
+		)	
+	).
+
+:- type replacer(T, Acc) == pred(T, T, bool, Acc, Acc).
+:- inst replacer == (pred(in, out, out, in, out) is det).
+
+:- pred replace_in_list(replacer(T, Acc)::in(replacer))
+		`with_type` replacer(list(T), Acc) `with_inst` replacer.
+	
+replace_in_list(_, [], [], no, !Acc).
+replace_in_list(Repl, List0 @ [H0 | T0], List, Changed, !Acc) :-
+	replace_in_list(Repl, T0, T, Changed0, !Acc),
+	Repl(H0, H, Changed1, !Acc),
+	Changed = Changed0 `or` Changed1,
+	( Changed = yes, List = [H | T]
+	; Changed = no, List = List0
 	).
+
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------