for review: fix for inlining of polymorphic procedures

Simon Taylor stayl at cs.mu.OZ.AU
Mon Feb 23 09:36:39 AEDT 1998


> > compiler/common.m
> > 	Don't do common structure elimination on structures
> > 	which are of different types, since that could cause
> > 	similar bugs.
> 
> That change would be a pity.
> 
> A much nicer fix would be to still perform the common structure
> elimination even if the structures have different types, but to
> preserve type correctness by inserting calls to an `unsafe_type_cast'
> predicate:

Thanks Fergus, that's a good idea. Here's the new diff.


Estimated hours taken: 5

Fix a bug in the optimization where polymorphism.m passes a
base_type_info in place of a type_info for non-polymorphic types.
The type of the variable was `base_type_info' not `type_info'.
This caused inlining.m to be unable to compute a type substitution,
and code_util__cons_id_to_tag aborted on an unsubstituted type
variable.

compiler/mercury_builtin.m
compiler/code_util.m
	Add a new builtin, unsafe_type_cast/2, used by common.m
	to preserve type correctness.
	Make unsafe_promise_unique/2 a builtin, since it is basically
	the same as unsafe_type_cast/2.

compiler/polymorphism.m
	Set the type of a `base_type_info' passed where a `type_info'
	is expected to `type_info'.
	Don't add the type_info argument for unsafe_type_cast, since it is
	not needed and would make the code in common.m more complicated.

compiler/common.m
	Generate a call to unsafe_type_cast rather than an assignment
	unification when the assignment would not be type correct.

tests/valid/inlining_bug.m
	Regression test.

tests/general/common_type_cast.m
tests/general/common_type_cast.exp
	Test of type casts.



Index: compiler/code_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/code_util.m,v
retrieving revision 1.93
diff -u -r1.93 code_util.m
--- code_util.m	1998/01/24 05:44:13	1.93
+++ code_util.m	1998/02/20 01:01:31
@@ -351,6 +351,11 @@
 	maybe(rval), maybe(pair(var, rval))).
 :- mode code_util__translate_builtin_2(in, in, in, in, out, out) is semidet.
 
+code_util__translate_builtin_2("mercury_builtin", "unsafe_type_cast", 0,
+		[X, Y], no, yes(Y - var(X))).
+code_util__translate_builtin_2("mercury_builtin", "unsafe_promise_unique", 0,
+		[X, Y], no, yes(Y - var(X))).
+
 code_util__translate_builtin_2("mercury_builtin", "builtin_int_gt", 0, [X, Y],
 	yes(binop((>), var(X), var(Y))), no).
 code_util__translate_builtin_2("mercury_builtin", "builtin_int_lt", 0, [X, Y],
Index: compiler/common.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/common.m,v
retrieving revision 1.47
diff -u -r1.47 common.m
--- common.m	1998/01/23 12:56:21	1.47
+++ common.m	1998/02/21 11:05:41
@@ -118,7 +118,7 @@
 		
 %---------------------------------------------------------------------------%
 
-common__optimise_unification(Unification0, Left0, _Right0, Mode, Context,
+common__optimise_unification(Unification0, _Left0, _Right0, Mode, _Context,
 		Goal0, GoalInfo0, Goal, GoalInfo, Info0, Info) :-
 	(
 		Unification0 = construct(Var, ConsId, ArgVars, _),
@@ -127,13 +127,9 @@
 				construction, Info0, OldStruct)
 		->
 			OldStruct = structure(OldVar, _, _, _),
-			Unification = assign(Var, OldVar),
-			Right = var(OldVar),
-			Goal = unify(Left0, Right, Mode, Unification, Context), 
-			common__record_equivalence(Var, OldVar, Info0, Info1),
-			simplify_info_set_requantify(Info1, Info),
-			set__list_to_set([OldVar, Var], NonLocals),
-			goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo)
+			common__generate_assign(Var, OldVar, GoalInfo0,
+				Goal - GoalInfo, Info0, Info1),
+			simplify_info_set_requantify(Info1, Info)
 		;
 			Goal = Goal0,
 			GoalInfo = GoalInfo0,
@@ -152,21 +148,10 @@
 				deconstruction, Info0, OldStruct)
 		->
 			OldStruct = structure(_, _, _, OldArgVars),
-			goal_info_get_nonlocals(GoalInfo0, NonLocals),
-			simplify_info_get_instmap(Info0, InstMap),
-			goal_info_get_instmap_delta(GoalInfo0, InstMapDelta),
-			common__create_output_unifications(NonLocals, InstMap,
-				InstMapDelta, ArgVars, OldArgVars, Goals,
-				no, RecomputeAtomic),
-			Goal = conj(Goals),
-			common__record_equivalences(ArgVars,
-				OldArgVars, Info0, Info1),
-			simplify_info_set_requantify(Info1, Info2),
-			( RecomputeAtomic = yes ->
-				simplify_info_set_recompute_atomic(Info2, Info)
-			;
-				Info = Info2
-			)
+			common__create_output_unifications(GoalInfo0, ArgVars,
+				OldArgVars, Goals, Info0, Info1),
+			simplify_info_set_requantify(Info1, Info),
+			Goal = conj(Goals)
 		;
 			Goal = Goal0,
 			common__record_cell(Var, ConsId, ArgVars, Info0, Info)
@@ -355,31 +340,6 @@
 
 %---------------------------------------------------------------------------%
 
-:- pred common__record_equivalences(list(var), list(var),
-		simplify_info, simplify_info) is det.
-:- mode common__record_equivalences(in, in, in, out) is det.
-
-common__record_equivalences(Vars0, Vars, Info0, Info) :-
-	simplify_info_get_common_info(Info0, CommonInfo0),
-	CommonInfo0 = common(VarEqv0, StructMap0, StructMap1, SeenCalls),
-	common__record_equivalences_2(Vars0, Vars, VarEqv0, VarEqv),
-	CommonInfo = common(VarEqv, StructMap0, StructMap1, SeenCalls),
-	simplify_info_set_common_info(Info0, CommonInfo, Info).
-
-:- pred common__record_equivalences_2(list(var), list(var),
-		eqvclass(var), eqvclass(var)) is det.
-:- mode common__record_equivalences_2(in, in, in, out) is det.
-
-common__record_equivalences_2([], [_ | _], _, _) :-
-	error("common__record_equivalences").
-common__record_equivalences_2([_ | _], [], _, _) :-
-	error("common__record_equivalences").
-common__record_equivalences_2([], [], VarEqv, VarEqv).
-common__record_equivalences_2([Var1 | Vars1], [Var2 | Vars2],
-		VarEqv0, VarEqv) :-
-	eqvclass__ensure_equivalence(VarEqv0, Var1, Var2, VarEqv1),
-	common__record_equivalences_2(Vars1, Vars2, VarEqv1, VarEqv).
-
 :- pred common__record_equivalence(var, var, simplify_info, simplify_info).
 :- mode common__record_equivalence(in, in, in, out) is det.
 
@@ -458,40 +418,33 @@
 		( common__find_previous_call(SeenCallsList0, InputArgs,
 			Eqv0, OutputArgs2, PrevContext)
 		->
-			simplify_info_get_instmap(Info0, InstMap0),
-			goal_info_get_nonlocals(GoalInfo, NonLocals),
-			goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
-			common__create_output_unifications(NonLocals, InstMap0,
-			    InstMapDelta, OutputArgs, OutputArgs2, Goals,
-			    no, RecomputeAtomic),
+			common__create_output_unifications(GoalInfo,
+			    OutputArgs, OutputArgs2, Goals, Info0, Info1),
 			Goal = conj(Goals),
 			simplify_info_get_var_types(Info0, VarTypes),
 			(
-			    simplify_do_warn_calls(Info0),
+			    simplify_do_warn_calls(Info1),
 				% Don't warn for cases such as:
 				% set__init(Set1 : set(int)),
 				% set__init(Set2 : set(float)).
 			    map__apply_to_list(OutputArgs, VarTypes,
-					OutputArgTypes),
+					OutputArgTypes1),
 			    map__apply_to_list(OutputArgs2, VarTypes,
-					OutputArgTypes)
+					OutputArgTypes2),
+			    common__types_match_exactly_list(OutputArgTypes1,
+			    	OutputArgTypes2)
 			->
 			    goal_info_get_context(GoalInfo, Context),
-			    simplify_info_add_msg(Info0,
+			    simplify_info_add_msg(Info1,
 			    	duplicate_call(SeenCall, PrevContext,
 					Context),
-			        Info1)
+			        Info2)
 			;
-			    Info1 = Info0
+			    Info2 = Info1
 			),
 			CommonInfo = common(Eqv0, Structs0,
 				Structs1, SeenCalls0),
-			simplify_info_set_requantify(Info1, Info2),
-			( RecomputeAtomic = yes ->
-				simplify_info_set_recompute_atomic(Info2, Info3)
-			;
-				Info3 = Info2
-			)
+			simplify_info_set_requantify(Info2, Info3)
 		;
 			goal_info_get_context(GoalInfo, Context),
 			ThisCall = call_args(Context, InputArgs, OutputArgs),
@@ -571,59 +524,120 @@
 
 %---------------------------------------------------------------------------%
 
-:- pred common__create_output_unifications(set(var)::in, instmap::in,
-		instmap_delta::in, list(var)::in, list(var)::in,
-		list(hlds_goal)::out, bool::in, bool::out) is det.
+:- pred common__create_output_unifications(hlds_goal_info::in, 
+		list(var)::in, list(var)::in, list(hlds_goal)::out,
+		simplify_info::in, simplify_info::out) is det.
 
 	% Create unifications to assign the non-local vars in OutputArgs from 
 	% the corresponding var in OutputArgs2.
-common__create_output_unifications(_, _, _, [], [], [],
-		RecomputeAtomic, RecomputeAtomic).
-common__create_output_unifications(_, _, _, [_ | _], [], _, _, _) :-
+common__create_output_unifications(_, [], [], [], Info, Info).
+common__create_output_unifications(_, [_ | _], [], _, _, _) :-
 	error("common__create_output_unifications").
-common__create_output_unifications(_, _, _, [], [_ | _], _, _, _) :-
+common__create_output_unifications(_, [], [_ | _], _, _, _) :-
 	error("common__create_output_unifications").
-common__create_output_unifications(NonLocals, InstMap, InstMapDelta, 
-		[OutputArg | OutputArgs], [OutputArg2 | OutputArgs2],
-		Goals, RecomputeAtomic0, RecomputeAtomic) :-
+common__create_output_unifications(GoalInfo, [OutputArg | OutputArgs],
+		[OutputArg2 | OutputArgs2], Goals, Info0, Info) :-
+	goal_info_get_nonlocals(GoalInfo, NonLocals),
 	( 
 		set__member(OutputArg, NonLocals),
-		% This can happen if the first cell was created with a
-		% partially instantiated deconstruction.
+		% This can happen if the first cell was created
+		% with a partially instantiated deconstruction.
 		OutputArg \= OutputArg2	
 	->
-		Unification = assign(OutputArg, OutputArg2),
-		instmap__lookup_var(InstMap, OutputArg2, Inst0),
-		% Check if OutputArg2 was local to the call or deconstruction
-		% that produced it. If it was, recompute_instmap_delta must 
-		% recompute the instmap_deltas for atomic goals.
-		( Inst0 = free ->
-			Inst = ground(shared, no),
-			RecomputeAtomic1 = yes
-		;	
-			Inst = Inst0,
-			RecomputeAtomic1 = RecomputeAtomic0
-		),	
-		% This will be fixed up in recompute_instmap_delta
-		UniMode = (free -> Inst) - (Inst -> Inst),
-		UnifyContext = unify_context(explicit, []),
-		Goal = unify(OutputArg, var(OutputArg2),
-			UniMode, Unification, UnifyContext),
-		set__list_to_set([OutputArg, OutputArg2], GoalNonLocals),
-		set__list_to_set([OutputArg], OutputSet),
-		instmap_delta_restrict(InstMapDelta, OutputSet,
-			GoalInstMapDelta),
-		goal_info_init(GoalNonLocals, GoalInstMapDelta, det, GoalInfo),
-		common__create_output_unifications(NonLocals, InstMap,
-			InstMapDelta, OutputArgs, OutputArgs2, Goals1,
-			RecomputeAtomic1, RecomputeAtomic),
-		Goals = [Goal - GoalInfo | Goals1]
-	;
-		common__create_output_unifications(NonLocals, InstMap,
-			InstMapDelta, OutputArgs, OutputArgs2, Goals1,
-			RecomputeAtomic0, RecomputeAtomic),
-		Goals = Goals1
+		common__generate_assign(OutputArg, OutputArg2,
+			GoalInfo, Goal, Info0, Info1),
+		common__create_output_unifications(GoalInfo,
+			OutputArgs, OutputArgs2, Goals1, Info1, Info),
+		Goals = [Goal | Goals1]
+	;
+		common__create_output_unifications(GoalInfo,
+			OutputArgs, OutputArgs2, Goals, Info0, Info)
 	).
+
+%---------------------------------------------------------------------------%
+
+:- pred common__generate_assign(var, var, hlds_goal_info, hlds_goal,
+		simplify_info, simplify_info).
+:- mode common__generate_assign(in, in, in, out, in, out) is det.
+	
+common__generate_assign(ToVar, FromVar, GoalInfo0, Goal, Info0, Info) :-
+	simplify_info_get_instmap(Info0, InstMap),
+	instmap__lookup_var(InstMap, FromVar, FromVarInst0),
+
+	( FromVarInst0 = free ->
+		% This may mean that the variable was local 
+		% to the first unification or call. In that
+		% case we need to recompute the instmap_deltas
+		% for atomic goals.
+		simplify_info_set_recompute_atomic(Info0, Info1)
+	;
+		Info1 = Info0
+	),
+
+	goal_info_get_instmap_delta(GoalInfo0, InstMapDelta0),
+	simplify_info_get_var_types(Info0, VarTypes),
+	map__lookup(VarTypes, ToVar, ToVarType),
+	map__lookup(VarTypes, FromVar, FromVarType),
+
+	( common__types_match_exactly(ToVarType, FromVarType) ->
+		instmap__lookup_var(InstMap, ToVar, ToVarInst0),
+		( instmap_delta_search_var(InstMapDelta0, ToVar, ToVarInst1) ->
+			ToVarInst = ToVarInst1
+		;
+			error("common__generate_assign: assigned var \
+				not in instmap_delta")
+		),
+	
+		UnifyContext = unify_context(explicit, []),
+		UniMode = (ToVarInst0 -> ToVarInst) - (ToVarInst -> ToVarInst),
+		GoalExpr = unify(ToVar, var(FromVar), UniMode,
+			assign(ToVar, FromVar), UnifyContext)
+	;	
+		% If the cells we are optimizing don't have exactly the same
+		% type, we insert explicit type casts to ensure type
+		% correctness. This avoids problems with HLDS optimizations
+		% such as inlining which expect the HLDS to be well-typed.
+		% Unfortunately this loses information for other optimizations,
+		% since the call to the type cast hides the equivalence of
+		% the input and output.
+		simplify_info_get_module_info(Info0, ModuleInfo),
+		module_info_get_predicate_table(ModuleInfo, PredTable),
+		TypeCast = qualified("mercury_builtin", "unsafe_type_cast"),
+		(
+			predicate_table_search_pred_sym_arity(
+				PredTable, TypeCast, 2, [PredId])
+		->
+			hlds_pred__initial_proc_id(ProcId),
+			GoalExpr = call(PredId, ProcId, [FromVar, ToVar],
+				inline_builtin, no, TypeCast)
+		;
+			error("common__generate_assign: \
+				can't find unsafe_type_cast")
+		)
+	),
+	set__list_to_set([ToVar, FromVar], NonLocals),
+	instmap_delta_restrict(InstMapDelta0, NonLocals, InstMapDelta),
+	goal_info_init(NonLocals, InstMapDelta, det, GoalInfo),
+	Goal = GoalExpr - GoalInfo,	
+	common__record_equivalence(ToVar, FromVar, Info1, Info).
+
+:- pred common__types_match_exactly((type), (type)).
+:- mode common__types_match_exactly(in, in) is semidet.
+
+common__types_match_exactly(term__variable(Var), term__variable(Var)).
+common__types_match_exactly(Type1, Type2) :-
+	type_to_type_id(Type1, TypeId1, Args1),
+	type_to_type_id(Type2, TypeId2, Args2),
+	TypeId1 = TypeId2,
+	common__types_match_exactly_list(Args1, Args2).
+
+:- pred common__types_match_exactly_list(list(type), list(type)).
+:- mode common__types_match_exactly_list(in, in) is semidet.
+
+common__types_match_exactly_list([], []).
+common__types_match_exactly_list([Type1 | Types1], [Type2 | Types2]) :-
+	common__types_match_exactly(Type1, Type2),
+	common__types_match_exactly_list(Types1, Types2).
 
 %---------------------------------------------------------------------------%
 %---------------------------------------------------------------------------%
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/polymorphism.m,v
retrieving revision 1.128
diff -u -r1.128 polymorphism.m
--- polymorphism.m	1998/02/15 06:48:35	1.128
+++ polymorphism.m	1998/02/21 13:01:35
@@ -330,8 +330,19 @@
 
 polymorphism__process_pred(PredId, ModuleInfo0, ModuleInfo) :-
 	module_info_pred_info(ModuleInfo0, PredId, PredInfo),
-	pred_info_procids(PredInfo, ProcIds),
-	polymorphism__process_procs(PredId, ProcIds, ModuleInfo0, ModuleInfo).
+	pred_info_module(PredInfo, PredModule),
+	pred_info_name(PredInfo, PredName),
+	pred_info_arity(PredInfo, PredArity),
+	(
+		polymorphism__no_type_info_builtin(PredModule,
+			PredName, PredArity) 
+	->
+		ModuleInfo = ModuleInfo0
+	;
+		pred_info_procids(PredInfo, ProcIds),
+		polymorphism__process_procs(PredId, ProcIds,
+			ModuleInfo0, ModuleInfo)
+	).
 
 :- pred polymorphism__process_procs(pred_id, list(proc_id),
 					module_info, module_info).
@@ -357,6 +368,19 @@
 
 	polymorphism__process_procs(PredId, ProcIds, ModuleInfo2, ModuleInfo).
 
+	% unsafe_type_cast and unsafe_promise_unique are polymorphic
+	% builtins which do not need their type_infos. unsafe_type_cast
+	% can be introduced by common.m after polymorphism is run, so it
+	% is much simpler to avoid introducing type_info arguments for it.
+	% Since both of these are really just assignment unifications, it
+	% is desirable to generate them inline.
+:- pred polymorphism__no_type_info_builtin(string, string, int).
+:- mode polymorphism__no_type_info_builtin(in, in, out) is semidet.
+
+polymorphism__no_type_info_builtin("mercury_builtin", "unsafe_type_cast", 2).
+polymorphism__no_type_info_builtin("mercury_builtin",
+		"unsafe_promise_unique", 2).
+
 %---------------------------------------------------------------------------%
 
 :- pred polymorphism__fixup_preds(list(pred_id), module_info, module_info).
@@ -853,8 +877,20 @@
 	term__apply_substitution_to_list(PredArgTypes0, Subst,
 		PredArgTypes),
 	term__vars_list(PredArgTypes, PredTypeVars0),
-	( PredTypeVars0 = [] ->
-		% optimize for common case of non-polymorphic call
+
+	pred_info_module(PredInfo, PredModule),
+	pred_info_name(PredInfo, PredName),
+	pred_info_arity(PredInfo, PredArity),
+	( 
+		(
+			% optimize for common case of non-polymorphic call
+			PredTypeVars0 = []
+		;
+			% some builtins don't need the type_info
+			polymorphism__no_type_info_builtin(PredModule,
+				PredName, PredArity)
+		)
+	->
 		PredId = PredId0,
 		ProcId = ProcId0,
 		ArgVars = ArgVars0,
@@ -1731,8 +1767,16 @@
 		IsHigherOrder = no
 	->
 		Var = BaseVar,
+
+		% Since this base_type_info is pretending to be
+		% a type_info, we need to adjust its type.
+		% Since base_type_info_const cons_ids are handled
+		% specially, this should not cause problems.
+		construct_type(qualified("mercury_builtin", "type_info") - 1,
+			[Type], NewBaseVarType),
+		map__det_update(VarTypes0, BaseVar, NewBaseVarType, VarTypes),
+
 		VarSet = VarSet0,
-		VarTypes = VarTypes0,
 		ExtraGoals = ExtraGoals0
 	;
 		% Unfortunately, if we have higher order terms, we
Index: library/mercury_builtin.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/mercury_builtin.m,v
retrieving revision 1.92
diff -u -r1.92 mercury_builtin.m
--- mercury_builtin.m	1998/02/12 01:25:48	1.92
+++ mercury_builtin.m	1998/02/20 01:04:36
@@ -175,6 +175,14 @@
 
 :- interface.
 
+	% unsafe_type_cast/2 is used internally by the compiler. Bad things
+	% will happen if this is used in programs. This is generated inline
+	% by the compiler.
+
+:- pred unsafe_type_cast(T1, T2).
+:- mode unsafe_type_cast(in, out) is det.
+:- external(unsafe_type_cast/2).
+
 % The following are used by the compiler, to implement polymorphism.
 % They should not be used in programs.
 
@@ -685,6 +693,10 @@
 
 %-----------------------------------------------------------------------------%
 
+:- external(unsafe_promise_unique/2).
+
+% XXX This is now a compiler builtin. Once the changes
+% have been installed, remove this code.
 /* unsafe_promise_unique/2
 	:- pred unsafe_promise_unique(T, T).
 	:- mode unsafe_promise_unique(in, uo) is det.
@@ -695,7 +707,6 @@
 		"Y = X;").
 */
 
-:- external(unsafe_promise_unique/2).
 :- pragma c_code("
 Define_extern_entry(mercury__unsafe_promise_unique_2_0);
 MR_MAKE_STACK_LAYOUT_ENTRY(mercury__unsafe_promise_unique_2_0);
@@ -705,7 +716,7 @@
 BEGIN_CODE
 
 Define_entry(mercury__unsafe_promise_unique_2_0);
-#ifdef	COMPACT_ARGS
+#ifdef COMPACT_ARGS
 	r1 = r2;
 #else
 	r3 = r2;
@@ -726,6 +737,8 @@
 }
 
 ").
+
+
 
 %-----------------------------------------------------------------------------%
 
Index: tests/general/Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/tests/general/Mmakefile,v
retrieving revision 1.5
diff -u -r1.5 Mmakefile
--- Mmakefile	1998/02/18 23:42:21	1.5
+++ Mmakefile	1998/02/20 01:15:32
@@ -16,6 +16,7 @@
 PROGS=		array_test \
 		commit_bug \
 		commit_bug_2 \
+		common_type_cast \
 		disj_disj \
 		dnf \
 		hello_again \


tests/general/common_type_cast.m
===================================================================
% Test for the case where common.m must insert a type cast
% because two equivalent cells have different types.
:- module common_type_cast.

:- interface.

:- import_module io.

:- pred main(io__state, io__state).
:- mode main(di, uo) is det.

:- type foo(T)
	--->	ok(T)
	;	error(string).


:- implementation.

:- import_module int, float.

main -->
	{ Pred = lambda([Int::in, Float::out] is det, Float = float(Int)) },
	{ test(Pred, error("error"), Output1) },
	{ test(Pred, ok(1), Output2) },
	io__write(Output1),
	io__nl,
	io__write(Output2),
	io__nl.

:- pred test(pred(T, U), foo(T), foo(U)).
:- mode test(pred(in, out) is det, in, out) is det.

test(P, ok(T), ok(U)) :-
	call(P, T, U).
test(_, error(Err), error(Err)).



tests/general/common_type_cast.exp
===================================================================
error("error")
ok(1.00000000000000)


Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/tests/valid/Mmakefile,v
retrieving revision 1.10
diff -u -r1.10 Mmakefile
--- Mmakefile	1998/02/09 00:44:42	1.10
+++ Mmakefile	1998/02/22 22:32:33
@@ -38,11 +38,12 @@
 	higher_order2.m \
 	higher_order3.m \
 	higher_order_implied_mode.m \
-	ho_inst.m \
 	ho_func_call.m \
-	inhibit_warn_test.m \
+	ho_inst.m \
 	implied_mode.m \
 	indexing.m \
+	inhibit_warn_test.m \
+	inlining_bug.m \
 	intermod_lambda.m \
 	intermod_test.m \
 	lambda_inference.m\

%
% Regression test for an abort in code generation.
% When the actual type for a polymorphic argument is non-polymorphic,
% only the base_type_info is passed, avoiding the construction of
% a type_info. The problem was that the type of the type_info argument
% was being set to `mercury_builtin:base_type_info' rather than
% `type_info'. In the code to compute the type substitution in inlining,
% type_list_subsumes failed on the argument types, and no substitution
% was produced. code_util__cons_id_to_tag then aborted when asked to
% find the tag for a constructor of a variable type.
%
:- module inlining_bug.

:- interface.

:- pred calling_pred(int::in) is semidet.

:- implementation.

:- import_module int, list.

:- type my_pair(A) ---> pair(A, A).

calling_pred(_) :-
	Plus1 = lambda([Int0::in, IntPair::out] is det,
			IntPair = pair(Int0, Int0)),
	called_pred(Plus1, [1,2,3], [X | Ys]),
	X = pair(2, 2),
	Ys = [pair(3, 3), pair(4, 4)].

:- pred called_pred(pred(T, U), list(T), list(U)) is det.
:- mode called_pred(pred(in, out) is det, in, out) is semidet.
:- pragma inline(called_pred/3).

called_pred(P, [A | As], [B | Bs]) :-
	call(P, A, B),
	list__map(P, As, Bs).



More information about the developers mailing list