[m-rev.] for review: fix a bug in untupling transformation

[Peter Wang]

On Friday 11 February 2005 02:02 pm, Ralph Becket wrote:
> Peter Wang, Friday, 11 February 2005:
> > Ralph, I don't know if the fix below is necessary for loop_inv.m, but
> > it looks like it wouldn't hurt.
> 
> No, that looks good!  Ta.

Great.  The previous diff wasn't quite enough for the untupling transformation
though.


Estimated hours taken: 2
Branches: main

Predicates generated by the untupling transformation were being given the
same forms of names, no matter if the original procedure being transformed
was a predicate or a function.  If a module had a predicate and a function
with the same name and arity, and tracing was enabled, and a low enough
optimisation level was being used, this would result in an exception being
thrown.

A similar nameclash happened when two procedures of the same name but
different arities were expanded into procedures of the same arity.

compiler/untupling.m:
	Give generated procedures different names depending on whether the
	proc being transformed was a predicate or function.

	Keep more goal context information when transforming procedures;
	the line number becomes part of the generated procedure's name.

	Use a counter for generating procedure names to catch the
	pathological case where the name, pred-or-func, arity and line
	numbers of two generated procs are all the same.

compiler/loop_inv.m:
	Give generated procedures different names depending on whether the
	proc being transformed was a predicate or function.

tests/valid/Mercury.options:
tests/valid/Mmakefile:
tests/valid/untuple_bug.m:
	Add a test case.

Index: compiler/loop_inv.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/loop_inv.m,v
retrieving revision 1.16
diff -u -r1.16 loop_inv.m
--- compiler/loop_inv.m	28 Jan 2005 01:03:18 -0000	1.16
+++ compiler/loop_inv.m	10 Feb 2005 06:43:00 -0000
@@ -769,12 +769,13 @@
     hlds_pred__pred_info_get_origin(PredInfo, OrigOrigin),
 
     PredName = hlds_pred__pred_info_name(PredInfo),
+    PredOrFunc = hlds_pred__pred_info_is_pred_or_func(PredInfo),
     hlds_goal__goal_info_get_context(GoalInfo, Context),
     term__context_line(Context, Line),
     hlds_pred__proc_id_to_int(ProcId, ProcNo),
     AuxNamePrefix = string__format("loop_inv_%d", [i(ProcNo)]),
     prog_util__make_pred_name_with_context(ModuleName, AuxNamePrefix,
-            predicate, PredName, Line, 1, AuxPredSymName),
+            PredOrFunc, PredName, Line, 1, AuxPredSymName),
     (
         AuxPredSymName = unqualified(AuxPredName)
     ;
Index: compiler/untupling.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/untupling.m,v
retrieving revision 1.1
diff -u -r1.1 untupling.m
--- compiler/untupling.m	2 Feb 2005 02:58:43 -0000	1.1
+++ compiler/untupling.m	11 Feb 2005 03:37:57 -0000
@@ -114,7 +114,7 @@
 :- import_module parse_tree__prog_type.
 :- import_module parse_tree__prog_util.
 
-:- import_module bool, list, map, require, std_util, string, svmap.
+:- import_module bool, counter, list, map, require, std_util, string, svmap.
 :- import_module svvarset, term, varset.
 
 	% The transform_map structure records which procedures were
@@ -152,13 +152,14 @@
 
 expand_args_in_module(!ModuleInfo, TransformMap) :-
 	module_info_predids(!.ModuleInfo, PredIds),
-	list__foldl2(expand_args_in_pred, PredIds,
-		!ModuleInfo, map__init, TransformMap).
+	list__foldl3(expand_args_in_pred, PredIds,
+		!ModuleInfo, map__init, TransformMap, counter__init(0), _).
 
 :- pred expand_args_in_pred(pred_id::in, module_info::in, module_info::out,
-	transform_map::in, transform_map::out) is det.
+	transform_map::in, transform_map::out, counter::in, counter::out)
+	is det.
 
-expand_args_in_pred(PredId, !ModuleInfo, !TransformMap) :-
+expand_args_in_pred(PredId, !ModuleInfo, !TransformMap, !Counter) :-
 	module_info_types(!.ModuleInfo, TypeTable),
 	module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
 	(
@@ -180,8 +181,8 @@
 		at_least_one_expandable_type(ArgTypes, TypeTable)
 	->
 		ProcIds = pred_info_non_imported_procids(PredInfo),
-		list__foldl2(expand_args_in_proc(PredId), ProcIds,
-			!ModuleInfo, !TransformMap)
+		list__foldl3(expand_args_in_proc(PredId), ProcIds,
+			!ModuleInfo, !TransformMap, !Counter)
 	;
 		true
 	).
@@ -205,9 +206,10 @@
 :- type untuple_map == map(prog_var, prog_vars).
 
 :- pred expand_args_in_proc(pred_id::in, proc_id::in, module_info::in,
-	module_info::out, transform_map::in, transform_map::out) is det.
+	module_info::out, transform_map::in, transform_map::out,
+	counter::in, counter::out) is det.
 
-expand_args_in_proc(PredId, ProcId, !ModuleInfo, !TransformMap) :-
+expand_args_in_proc(PredId, ProcId, !ModuleInfo, !TransformMap, !Counter) :-
 	some [!ProcInfo] (
 		module_info_types(!.ModuleInfo, TypeTable),
 		module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
@@ -231,7 +233,8 @@
 		requantify_proc(!ProcInfo),
 		recompute_instmap_delta_proc(yes, !ProcInfo, !ModuleInfo),
 
-		create_aux_pred(PredId, ProcId, PredInfo0, !.ProcInfo,
+		counter__allocate(Num, !Counter),
+		create_aux_pred(PredId, ProcId, PredInfo0, !.ProcInfo, Num,
 			AuxPredId, AuxProcId, CallAux,
 			AuxPredInfo, AuxProcInfo0, !ModuleInfo),
 		proc_info_set_maybe_untuple_info(
@@ -250,9 +253,13 @@
 	type_table::in, untuple_map::out) is det.
 
 expand_args_in_proc_2(HeadVars0, ArgModes0, HeadVars, ArgModes,
-		!Goal, !VarSet, !VarTypes, TypeTable, UntupleMap) :-
+		Goal0, Goal - GoalInfo, !VarSet, !VarTypes, TypeTable,
+		UntupleMap) :-
 	expand_args_in_proc_3(HeadVars0, ArgModes0, ListOfHeadVars,
-		ListOfArgModes, !Goal, !VarSet, !VarTypes, [], TypeTable),
+		ListOfArgModes, Goal0, Goal - GoalInfo1, !VarSet,
+		!VarTypes, [], TypeTable),
+	goal_info_get_context(snd(Goal0), Context),
+	goal_info_set_context(GoalInfo1, Context, GoalInfo),
 	list__condense(ListOfHeadVars, HeadVars),
 	list__condense(ListOfArgModes, ArgModes),
 	build_untuple_map(HeadVars0, ListOfHeadVars, map__init, UntupleMap).
@@ -379,11 +386,11 @@
 	% See also create_aux_pred in loop_inv.m.
 	%
 :- pred create_aux_pred(pred_id::in, proc_id::in, pred_info::in,
-	proc_info::in, pred_id::out, proc_id::out, hlds_goal::out,
+	proc_info::in, int::in, pred_id::out, proc_id::out, hlds_goal::out,
 	pred_info::out, proc_info::out, module_info::in, module_info::out)
 	is det.
 
-create_aux_pred(PredId, ProcId, PredInfo, ProcInfo,
+create_aux_pred(PredId, ProcId, PredInfo, ProcInfo, Counter,
 		AuxPredId, AuxProcId, CallAux, AuxPredInfo, AuxProcInfo,
 		ModuleInfo0, ModuleInfo) :-
 	module_info_name(ModuleInfo0, ModuleName),
@@ -404,12 +411,13 @@
 	pred_info_get_origin(PredInfo, OrigOrigin),
 
 	PredName = pred_info_name(PredInfo),
+	PredOrFunc = pred_info_is_pred_or_func(PredInfo),
 	goal_info_get_context(GoalInfo, Context),
 	term__context_line(Context, Line),
 	proc_id_to_int(ProcId, ProcNo),
 	AuxNamePrefix = string__format("untupling_%d", [i(ProcNo)]),
 	make_pred_name_with_context(ModuleName, AuxNamePrefix,
-		predicate, PredName, Line, 1, AuxPredSymName),
+		PredOrFunc, PredName, Line, Counter, AuxPredSymName),
 	(
 		AuxPredSymName = unqualified(AuxPredName)
 	;
Index: tests/valid/Mercury.options
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mercury.options,v
retrieving revision 1.15
diff -u -r1.15 Mercury.options
--- tests/valid/Mercury.options	7 Feb 2005 07:56:53 -0000	1.15
+++ tests/valid/Mercury.options	10 Feb 2005 12:50:46 -0000
@@ -94,6 +94,7 @@
 MCFLAGS-type_inf_ambig_test	= --infer-all
 MCFLAGS-unify_typeinfo_bug	= -O3 --no-special-preds
 MCFLAGS-uniq_mode_inf_bug	= --infer-all
+MCFLAGS-untuple_bug		= -O0 --untuple --trace deep --trace-optimized
 MCFLAGS-vn_float		= -O5
 MCFLAGS-zero_arity		= --infer-modes
 MGNUCFLAGS-reg_bug		= --no-ansi
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.147
diff -u -r1.147 Mmakefile
--- tests/valid/Mmakefile	7 Feb 2005 07:56:54 -0000	1.147
+++ tests/valid/Mmakefile	10 Feb 2005 12:43:38 -0000
@@ -194,6 +194,7 @@
 	uniq_mode_inf_bug \
 	uniq_unify \
 	unreachable_code \
+	untuple_bug \
 	unused_args_test2 \
 	vn_float \
 	zero_arity
Index: tests/valid/untuple_bug.m
===================================================================
RCS file: tests/valid/untuple_bug.m
diff -N tests/valid/untuple_bug.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/valid/untuple_bug.m	11 Feb 2005 03:41:56 -0000
@@ -0,0 +1,51 @@
+% Predicates generated by the untupling transformation were being given the
+% same forms of names, no matter if the original procedure being transformed
+% was a predicate or a function.  If a module had a predicate and a function
+% with the same name and arity, and tracing was enabled, and a low enough
+% optimisation level was being used, this would result in an exception being
+% thrown.
+%
+% mmc -C -O0 --untuple --trace deep --trace-optimized untuple_bug.m
+%
+% Uncaught Mercury exception:
+% Software Error: map__det_insert: key already present
+%         Key Type: ll_backend.llds.label
+%         Key Value: internal(2, proc(unqualified("untuple_bug"), predicate,
+%		unqualified("untuple_bug"), "untupling_0__pred__f__0__1", 1, 0))
+%         Value Type: ll_backend.llds.data_addr
+%
+% A similar nameclash happened when two procedures of the same name but
+% different arities were expanded into procedures of the same arity.
+%
+
+:- module untuple_bug.
+
+:- interface.
+
+:- type t	---> t(int).
+:- type tt	---> tt(int, int).
+
+% A function and predicate of the same name and arity.
+
+:- func f = t.
+:- pred f(t::out) is det.
+
+% Two predicates that expand into the same name and arity.
+
+:- pred g(t::in, t::in) is semidet.
+:- pred g(tt::in) is semidet.
+
+:- pred h(t::in, t::in) is semidet.
+:- pred h(tt::in) is semidet.
+
+:- implementation.
+
+f = t(0).
+f(t(0)).
+
+g(t(T), t(T)).
+g(tt(T, T)).
+
+% These are on the same line to make sure that a counter is being used
+% properly when generating names.
+h(t(T), t(T)).  h(tt(T, T)).


--------------------------------------------------------------------------
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
--------------------------------------------------------------------------