[m-dev.] diff: fix aborts during deforestation

[Simon Taylor]

Estimated hours taken: 2

Fix bugs which caused compilation of Tom Conway's XML parser
to fail during deforestation.

compiler/inlining.m:
	If some of the output variables of an inlined call are not
	used by the caller, run quantification on the goal
	to push that information into the inlined goal.

compiler/modes.m:
compiler/unique_modes.m:
	When a unification with a dead variable is replaced with
	`true', make sure the instmap_delta of the goal is empty.

tests/valid/Mmakefile:
tests/valid/deforest_bug.m:
	Test case.


Index: compiler/inlining.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/inlining.m,v
retrieving revision 1.87
diff -u -u -r1.87 inlining.m
--- compiler/inlining.m	2000/08/09 07:46:45	1.87
+++ compiler/inlining.m	2000/08/26 07:48:01
@@ -388,6 +388,8 @@
 					% type variables to variables
 					% where their type_info is
 					% stored.
+		bool,			% Does the goal need to be
+					% requantified?
 		bool			% Did we change the determinism
 					% of any subgoal?
 	).
@@ -417,24 +419,37 @@
 	proc_info_vartypes(ProcInfo0, VarTypes0),
 	proc_info_typeinfo_varmap(ProcInfo0, TypeInfoVarMap0),
 
+	Requantify0 = no,
 	DetChanged0 = no,
 
 	InlineInfo0 = inline_info(VarThresh, HighLevelCode,
 		InlinedProcs, ModuleInfo0, UnivQTVars, Markers,
-		VarSet0, VarTypes0, TypeVarSet0, TypeInfoVarMap0, DetChanged0),
+		VarSet0, VarTypes0, TypeVarSet0, TypeInfoVarMap0,
+		Requantify0, DetChanged0),
 
 	inlining__inlining_in_goal(Goal0, Goal, InlineInfo0, InlineInfo),
 
-	InlineInfo = inline_info(_, _, _, _, _, _, VarSet, VarTypes, TypeVarSet, 
-		TypeInfoVarMap, DetChanged),
+	InlineInfo = inline_info(_, _, _, _, _, _, VarSet, VarTypes,
+		TypeVarSet, TypeInfoVarMap, Requantify, DetChanged),
 
 	pred_info_set_typevarset(PredInfo0, TypeVarSet, PredInfo1),
 
 	proc_info_set_varset(ProcInfo0, VarSet, ProcInfo1),
 	proc_info_set_vartypes(ProcInfo1, VarTypes, ProcInfo2),
 	proc_info_set_typeinfo_varmap(ProcInfo2, TypeInfoVarMap, ProcInfo3),
-	proc_info_set_goal(ProcInfo3, Goal, ProcInfo),
+	proc_info_set_goal(ProcInfo3, Goal, ProcInfo4),
 
+	globals__io_get_globals(Globals, IoState0, IoState),
+	(
+		Requantify = yes,
+		body_should_use_typeinfo_liveness(PredInfo1, Globals,
+			TypeInfoLiveness),
+		requantify_proc(TypeInfoLiveness, ProcInfo4, ProcInfo)
+	;
+		Requantify = no,
+		ProcInfo = ProcInfo4
+	),
+
 	map__det_update(ProcTable0, ProcId, ProcInfo, ProcTable),
 	pred_info_set_procedures(PredInfo1, ProcTable, PredInfo),
 	map__det_update(PredTable0, PredId, PredInfo, PredTable),
@@ -444,13 +459,13 @@
 		% then we re-run determinism analysis, because
 		% propagating the determinism information through
 		% the procedure may lead to more efficient code.
-	( DetChanged = yes,	
-		globals__io_get_globals(Globals, IoState0, IoState),
+	(
+		DetChanged = yes,	
 		det_infer_proc(PredId, ProcId, ModuleInfo1, ModuleInfo,
 			Globals, _, _, _)
-	; DetChanged = no,
-		ModuleInfo = ModuleInfo1,
-		IoState = IoState0
+	;
+		DetChanged = no,
+		ModuleInfo = ModuleInfo1
 	).
 
 %-----------------------------------------------------------------------------%
@@ -493,7 +508,8 @@
 
 	InlineInfo0 = inline_info(VarThresh, HighLevelCode,
 		InlinedProcs, ModuleInfo, HeadTypeParams, Markers,
-		VarSet0, VarTypes0, TypeVarSet0, TypeInfoVarMap0, DetChanged0),
+		VarSet0, VarTypes0, TypeVarSet0, TypeInfoVarMap0,
+		Requantify0, DetChanged0),
 
 	% should we inline this call?
 	(
@@ -518,6 +534,17 @@
 			TypeVarSet0, TypeVarSet, TypeInfoVarMap0, 
 			TypeInfoVarMap, Goal - GoalInfo),
 
+			%
+			% If some of the output variables are not used in
+			% the calling procedure, requantify the procedure.
+			%
+		goal_info_get_nonlocals(GoalInfo0, NonLocals),
+		( set__list_to_set(ArgVars) = NonLocals ->
+			Requantify = Requantify0
+		;
+			Requantify = yes
+		),
+
 			% If the inferred determinism of the called
 			% goal differs from the declared determinism,
 			% flag that we should re-run determinism analysis
@@ -536,11 +563,13 @@
 		VarTypes = VarTypes0,
 		TypeVarSet = TypeVarSet0,
 		TypeInfoVarMap = TypeInfoVarMap0,
+		Requantify = Requantify0,
 		DetChanged = DetChanged0
 	),
 	InlineInfo = inline_info(VarThresh, HighLevelCode,
 		InlinedProcs, ModuleInfo, HeadTypeParams, Markers,
-		VarSet, VarTypes, TypeVarSet, TypeInfoVarMap, DetChanged).
+		VarSet, VarTypes, TypeVarSet, TypeInfoVarMap,
+		Requantify, DetChanged).
 
 inlining__inlining_in_goal(generic_call(A, B, C, D) - GoalInfo,
 		generic_call(A, B, C, D) - GoalInfo) --> [].
@@ -558,7 +587,7 @@
 
 %-----------------------------------------------------------------------------%
 
-inlining__do_inline_call(HeadTypeParams, ArgVars, PredInfo, ProcInfo, 
+inlining__do_inline_call(_, ArgVars, PredInfo, ProcInfo, 
 		VarSet0, VarSet, VarTypes0, VarTypes, TypeVarSet0, TypeVarSet, 
 		TypeInfoVarMap0, TypeInfoVarMap, Goal) :-
 
@@ -610,6 +639,12 @@
 	map__apply_to_list(ArgVars, VarTypes0, ArgTypes),
 
 	pred_info_get_exist_quant_tvars(PredInfo, CalleeExistQVars),
+
+	% Typechecking has already succeeded, so we don't need
+	% to check for binding of head type parameters.
+	% Also, existentially-typed head type parameters
+	% may be bound by inlining.
+	HeadTypeParams = [],
 	inlining__get_type_substitution(HeadTypes, ArgTypes, HeadTypeParams,
 		CalleeExistQVars, TypeSubn),
 
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.244
diff -u -u -r1.244 modes.m
--- compiler/modes.m	2000/08/09 07:47:22	1.244
+++ compiler/modes.m	2000/08/26 07:50:54
@@ -253,6 +253,16 @@
 :- pred modecheck_functor_test(prog_var, cons_id, mode_info, mode_info).
 :- mode modecheck_functor_test(in, in, mode_info_di, mode_info_uo) is det.
 
+	% compute_goal_instmap_delta(InstMap0, Goal,
+	%	GoalInfo0, GoalInfo, ModeInfo0, ModeInfo).
+	%
+	% Work out the instmap_delta for a goal from
+	% the instmaps before and after the goal.
+:- pred compute_goal_instmap_delta(instmap, hlds_goal_expr,
+		hlds_goal_info, hlds_goal_info, mode_info, mode_info).
+:- mode compute_goal_instmap_delta(in, in, in, out,
+		mode_info_di, mode_info_uo) is det.
+
 %-----------------------------------------------------------------------------%
 
 % The following predicates are used by modecheck_unify.m.
@@ -972,11 +982,22 @@
 	mode_info_get_instmap(ModeInfo1, InstMap0),
 
 	modecheck_goal_expr(Goal0, GoalInfo0, Goal, ModeInfo1, ModeInfo2),
+
+	compute_goal_instmap_delta(InstMap0, Goal, GoalInfo0, GoalInfo,
+		ModeInfo2, ModeInfo).
 
-	mode_info_get_instmap(ModeInfo, InstMap),
-	mode_info_get_completed_nonlocals(GoalInfo0, NonLocals,
-		ModeInfo2, ModeInfo),
-	compute_instmap_delta(InstMap0, InstMap, NonLocals, DeltaInstMap),
+compute_goal_instmap_delta(InstMap0, Goal,
+		GoalInfo0, GoalInfo, ModeInfo0, ModeInfo) :-
+	( Goal = conj([]) ->
+		instmap_delta_init_reachable(DeltaInstMap),
+		mode_info_set_instmap(InstMap0, ModeInfo0, ModeInfo)
+	;
+		mode_info_get_completed_nonlocals(GoalInfo0, NonLocals,
+			ModeInfo0, ModeInfo),
+		mode_info_get_instmap(ModeInfo, InstMap),
+		compute_instmap_delta(InstMap0, InstMap,
+			NonLocals, DeltaInstMap)
+	),
 	goal_info_set_instmap_delta(GoalInfo0, DeltaInstMap, GoalInfo).
 
 modecheck_goal_expr(conj(List0), GoalInfo0, Goal) -->
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unique_modes.m,v
retrieving revision 1.63
diff -u -u -r1.63 unique_modes.m
--- compiler/unique_modes.m	2000/08/09 07:48:03	1.63
+++ compiler/unique_modes.m	2000/08/26 07:32:18
@@ -134,11 +134,8 @@
 	% Grab the final instmap, compute the change in insts
 	% over this goal, and save that instmap_delta in the goal_info.
 	%
-	mode_info_get_instmap(ModeInfo, InstMap),
-	mode_info_get_completed_nonlocals(GoalInfo0, NonLocals,
-		ModeInfo4, ModeInfo),
-	compute_instmap_delta(InstMap0, InstMap, NonLocals, DeltaInstMap),
-	goal_info_set_instmap_delta(GoalInfo0, DeltaInstMap, GoalInfo),
+	compute_goal_instmap_delta(InstMap0, GoalExpr,
+		GoalInfo0, GoalInfo, ModeInfo4, ModeInfo),
 
 	Goal = GoalExpr - GoalInfo.
 
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.72
diff -u -u -r1.72 Mmakefile
--- tests/valid/Mmakefile	2000/09/01 09:51:40	1.72
+++ tests/valid/Mmakefile	2000/09/01 09:54:11
@@ -44,6 +44,7 @@
 	complicated_unify.m \
 	constructor_arg_names.m \
 	dcg_test.m \
+	deforest_bug.m \
 	deforest_loop.m \
 	deforest_rerun_det.m \
 	det_condition.m \
@@ -214,6 +215,7 @@
 MCFLAGS-base_relation2		= --aditi
 MCFLAGS-compl_unify_bug		= -O3
 MCFLAGS-context_anc		= --aditi
+MCFLAGS-deforest_bug		= -O3
 MCFLAGS-deforest_loop		= -O3 --intermodule-optimization
 MCFLAGS-deforest_rerun_det	= -O3 --check-termination
 MCFLAGS-double_vn		= -O4
Index: tests/valid/deforest_bug.m
===================================================================
RCS file: deforest_bug.m
diff -N deforest_bug.m
--- /dev/null	Fri Sep  1 21:05:00 2000
+++ deforest_bug.m	Fri Sep  1 21:09:55 2000
@@ -0,0 +1,90 @@
+:- module deforest_bug.
+
+:- interface.
+
+:- type catalog  ---> catalog(publicId -> systemId).
+
+:- type [] ---> [].
+:- type [T1|T2] == list(T1).
+:- type (A -> B) == map(A, B).
+
+:- type dirs     == [path].
+
+:- type publicId == string.
+
+:- type systemId == string.
+
+:- type path     == string.
+
+:- type catRes(T)
+        --->    ok(T)
+        ;       error(string)
+        .
+
+:- pred deforest_load([(int, [char])], [string], catalog).
+:- mode deforest_load(in, out, out) is det.
+
+:- implementation.
+
+:- import_module char, int, list, map, std_util, string.
+
+:- type entry
+        --->    dtd(publicId, systemId)
+        ;       none
+        .
+
+:- pragma no_inline(deforest_load/3).
+deforest_load(CatLines, Errors, Cat) :-
+        parse(Entries, Errors, CatLines),
+        init(Cat0),
+        my_foldl(addEntry, Entries, catalog(Cat0), Cat).
+
+:- type (A, B) ---> (A, B).
+
+:- pred parse([entry], [string], [(int, [char])]).
+:- mode parse(out, out, in) is det.
+
+parse([], [], []).
+parse(Entries, Errors, [Line|Lines]) :-
+    Line = (N, Cs),
+    ( parseEntry(Entry, Cs, _) ->
+        Entries = [Entry|Entries0],
+        parse(Entries0, Errors, Lines)
+    ;
+        format("%d: syntax error", [i(N)], Msg),
+        Errors = [Msg|Errors0],
+        parse(Entries, Errors0, Lines)
+    ).
+
+:- pred addEntry(entry, catalog, catalog).
+:- mode addEntry(in, in, out) is det.
+
+addEntry(none, Cat, Cat).
+addEntry(dtd(PublicId, SystemId), catalog(Cat0), catalog(Cat)) :-
+    det_insert(Cat0, PublicId, SystemId, Cat).
+
+:- pred parseEntry(entry, [char], [char]).
+:- mode parseEntry(out, in, out) is semidet.
+
+parseEntry(Entry) -->
+    ( ['P'], string(PublicId), string(SystemId) ->
+        { Entry = dtd(PublicId, SystemId) }
+    ; =([]) ->
+        { Entry = none }
+    ;
+        { fail }
+    ).
+
+:- pred string(string, [char], [char]).
+:- mode string(out, in, out) is semidet.
+:- pragma no_inline(string/3).
+
+string("") --> { semidet_succeed }.
+
+:- pred my_foldl(pred(T, U, U), list(T), U, U).
+:- mode my_foldl(pred(in, in, out) is det, in, in, out) is det.
+
+my_foldl(_, [], A, A).
+my_foldl(P, [Head | Tail], A0, A) :-
+        P(Head, A0, A1),
+        my_foldl(P, Tail, A1, A).
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------