[m-dev.] for review: polymorphic ground insts

David Overton dmo at cs.mu.OZ.AU
Fri Sep 29 14:55:22 AEDT 2000


On Fri, Mar 17, 2000 at 06:45:54PM +1100, Fergus Henderson wrote:
> On 17-Mar-2000, David Overton <dmo at ender.cs.mu.oz.au> wrote:
> > 
> > Here is one more relative diff.  Some of the test cases fail due to
> > `type_util__get_cons_id_arg_types' not supporting existentially typed
> > cons_ids.  I have disabled these test cases.  Is that the best thing
> > to do for now?
> 
> Ah, no, that would not be a good thing to do.
> 

It's been a long time, but I've finally got back to this and got it
working.  I've fixed the problem with existential types and also fixed
a few efficiency problems.  Below is a diff relative to the last diff
that was reviewed back in March.  A full diff is available from
/home/mercury1/dmo/ws/poly/diff.new

There is one problem with this change though, and that is efficiency.
As one of my test cases, I tried changing tree234.m to use an inst
`tree234(K, V)' instead of ground for all the trees.  This increased
compilation time for that module from about 17s to about 1m45s.  The
problem is that lots of insts that were previously `ground(shared, no)'
have now become complicated, user-defined insts.
Profiling shows that much of the slowdown comes from `inst_lookup' and
`inst_contains_inst_name' which are used by many of the operations on
insts when dealing with recursive insts.  (The problem occurs even
with the current compiler if you happen to use lots of insts like
`tree234(ground, ground)' instead of ground.)

The main motivation for this change was to increase the flexibility of
library predicates by giving them polymorphic modes.  It looks like
the required changes to the library are going to increase its
compilation time quite dramatically so I'm not sure if this is
actually going to be feasible with the current mode system.

Options are:
	1.  Commit this change, change the library to make use of it,
	and live with the extra compilation time every time we
	bootstrap the library.

	2.  Commit this change, but don't make use of it in the
	library.

	3.  Wait for the rewrite of the mode system which will
	hopefully handle these sorts of things more efficiently.

What do people think about this?

----------------------

Estimated hours taken: 80

Allow polymorphic ground insts.  This change assumes that all inst
parameters in the mode declaration for a predicate or function are
constrained to be ground-shared.  This is a temporary measure until we
work out a nice syntax to allow the programmer to tell the compiler that
certain inst parameters may be treated as ground insts.  Since we don't
currently support unconstrained inst parameters anyway, this shouldn't
cause a problem.

	TODO:
		- Add syntax, something like `:- mode p(in(I)) <= ground(I).',
		  to specify that an inst parameter represents a ground inst.
		- Allow abstract ground insts that are treated in a similar
		  way to what we've done here with ground inst parameters.

compiler/inst.m:
	Add a new alternative for ground insts:
		`constrained_inst_var(inst_var)'.
	Define the type `inst_var_sub'.

compiler/inst_match.m:
	Change inst_matches_initial so that it:
		- handles constrained_inst_vars correctly;
		- returns the inst_var substitutions necessary for the call;
		- handles inst_matches_initial(ground(...), bound(...), ...)
		  properly (this requires knowing the type of the variable).

	  The last change has also been made for inst_matches_final
	  and inst_matches_binding.  However, the check is disabled for
	  now because, without alias tracking, the mode checker
	  becomes too conservative.

compiler/hlds_pred.m:
compiler/mode_info.m:
compiler/simplify.m:
compiler/det_util.m:
	Include the inst_varset in the proc_info, mode_info and simplify_info.
	Add a vartypes field to the det_info.
	Remove the vartypes field from the simplify_info since it is
	now in the det_info.
	Use record syntax for these data structures and their access predicates
	to make future changes easier.

compiler/prog_io.m:
	When processing pred and func mode declarations, convert all inst_var(V)
	insts to ground(shared, constrained_inst_var(V)).

compiler/prog_data.m:
compiler/hlds_data.m:
compiler/make_hlds.m:
compiler/mode_util.m:
	Use inst_vars instead of inst_params.

compiler/modes.m:
compiler/modecheck_call.m:
compiler/unique_modes.m:
compiler/mode_util.m:
	When checking or recomputing initial insts of a call, build up 
	an inst_var substitution (using the modified
	inst_matches_initial) and apply this to the final insts of the
	called procedure before checking/recomputing them.

compiler/mode_util.m:
	Make sure that recompute_instmap_delta recomputes the
	instmap_deltas for lambda_goals even when RecomputeAtomic = no.

compiler/type_util.m:
	Add a new predicate, type_util__cons_id_arg_types which
	nondeterministically returns the cons_ids and argument types for a
	given type.

compiler/accumulator.m:
compiler/check_typeclass.m:
compiler/clause_to_proc.m:
compiler/common.m:
compiler/continuation_info.m:
compiler/deforest.m:
compiler/det_analysis.m:
compiler/det_report.m:
compiler/det_util.m:
compiler/dnf.m:
compiler/follow_code.m:
compiler/goal_store.m:
compiler/goal_util.m:
compiler/higher_order.m:
compiler/inst_util.m:
compiler/instmap.m:
compiler/lambda.m:
compiler/magic.m:
compiler/magic_util.m:
compiler/mercury_to_mercury.m:
compiler/modecheck_unify.m:
compiler/module_qual.m:
compiler/pd_info.m:
compiler/pd_util.m:
compiler/polymorphism.m:
compiler/post_typecheck.m:
compiler/prog_io_util.m:
compiler/prog_rep.m:
compiler/saved_vars.m:
compiler/stack_layout.m:
compiler/table_gen.m:
compiler/unify_proc.m:
compiler/unneeded_code.m:
compiler/unused_args.m:
	Pass inst_varsets and types where needed.
	Changes to reflect change in definition of the inst data type.

compiler/inlining.m:
	Recompute the instmap deltas for a procedure after inlining.
	This bug showed up compiling tests/hard_coded/lp.m with
	inlining and deforestation turned on: deforestation was
	getting incorrect instmap deltas from inlining, causing
	the transformation to break mode-correctness.  It has only
	just shown up because of the added call to
	`inst_matches_initial' from within `recompute_instmap_delta'.

tests/invalid/Mmakefile:
tests/invalid/unbound_inst_var.m:
tests/invalid/unbound_inst_var.err_exp:
tests/valid/Mmakefile:
tests/valid/unbound_inst_var.m:
	Move the `unbound_inst_var' test case from `invalid' to `valid'
	and extend its coverage a bit.

diff -u ./accumulator.m ../../../mercury/compiler/accumulator.m
--- ./accumulator.m	Fri Sep 29 14:23:29 2000
+++ ../../../mercury/compiler/accumulator.m	Tue Sep 26 17:13:19 2000
@@ -376,12 +376,12 @@
 		DoLCO, FullyStrict, PredInfo, ProcInfo0, ModuleInfo0,
 		Warnings, ProcInfo, ModuleInfo) :-
 	(
-		proc_info_vartypes(ProcInfo0, VarTypes),
+		proc_info_vartypes(ProcInfo0, VarTypes0),
 		identify_out_and_out_prime(Id, Rec, HeadVars,
-				InitialInstMap, VarTypes, ModuleInfo0, Out,
+				InitialInstMap, VarTypes0, ModuleInfo0, Out,
 				OutPrime, HeadToCallSubst, CallToHeadSubst),
 
-		stage1(Id, M, C, DoLCO, FullyStrict, VarTypes, ModuleInfo0,
+		stage1(Id, M, C, DoLCO, FullyStrict, VarTypes0, ModuleInfo0,
 			Sets),
 
 		stage2(Id, C, Sets, OutPrime, Out, ModuleInfo0, ProcInfo0,
diff -u ./clause_to_proc.m ../../../mercury/compiler/clause_to_proc.m
--- ./clause_to_proc.m	Mon Sep 25 15:22:32 2000
+++ ../../../mercury/compiler/clause_to_proc.m	Tue Sep 26 13:02:34 2000
@@ -50,7 +50,7 @@
 
 :- import_module hlds_goal, hlds_data, prog_data, mode_util, make_hlds, purity.
 :- import_module globals.
-:- import_module bool, int, set, map.
+:- import_module bool, int, set, map, varset.
 
 maybe_add_default_func_modes([], Preds, Preds).
 maybe_add_default_func_modes([PredId | PredIds], Preds0, Preds) :-
@@ -87,7 +87,9 @@
 		Determinism = det,
 		pred_info_context(PredInfo0, Context),
 		MaybePredArgLives = no,
-		add_new_proc(PredInfo0, PredArity, PredArgModes, 
+		varset__init(InstVarSet),
+			% No inst_vars in default func mode.
+		add_new_proc(PredInfo0, InstVarSet, PredArity, PredArgModes, 
 			yes(PredArgModes), MaybePredArgLives, yes(Determinism),
 			Context, address_is_not_taken, PredInfo, ProcId),
 		MaybeProcId = yes(ProcId)
diff -u ./code_gen.m ../../../mercury/compiler/code_gen.m
--- ./code_gen.m	Wed Sep 27 16:21:56 2000
+++ ../../../mercury/compiler/code_gen.m	Fri Sep 29 12:36:45 2000
@@ -284,10 +284,11 @@
 			no, EntryLabel),
 		proc_info_get_initial_instmap(ProcInfo, ModuleInfo, InstMap0),
 		proc_info_varset(ProcInfo, VarSet),
+		proc_info_vartypes(ProcInfo, VarTypes),
 		ProcLayout = proc_layout_info(EntryLabel, Detism, TotalSlots,
 			MaybeSuccipSlot, MaybeTraceCallLabel, MaxTraceReg,
 			Goal, InstMap0, TraceSlotInfo, ForceProcId,
-			VarSet, InternalMap),
+			VarSet, VarTypes, InternalMap),
 		global_data_add_new_proc_layout(GlobalData0,
 			proc(PredId, ProcId), ProcLayout, GlobalData1)
 	;
diff -u ./continuation_info.m ../../../mercury/compiler/continuation_info.m
--- ./continuation_info.m	Mon Sep 25 15:37:08 2000
+++ ../../../mercury/compiler/continuation_info.m	Tue Sep 26 15:58:18 2000
@@ -97,6 +97,7 @@
 			varset		:: prog_varset,
 					% Info for each internal label,
 					% needed for basic_stack_layouts.
+			vartypes	:: vartypes,
 			internal_map	:: proc_label_layout_info
 		).
 
diff -u ./inst_match.m ../../../mercury/compiler/inst_match.m
--- ./inst_match.m	Fri Sep 29 14:23:44 2000
+++ ../../../mercury/compiler/inst_match.m	Fri Sep 29 14:32:15 2000
@@ -263,14 +263,28 @@
 :- import_module list, set, map, term, std_util, require, bool.
 
 inst_matches_initial(InstA, InstB, Type, ModuleInfo) :-
-	map__init(Sub0),
-	inst_matches_initial(InstA, InstB, Type, ModuleInfo, _, Sub0, _).
+	inst_matches_initial_1(InstA, InstB, Type, ModuleInfo, _, no, _).
 
 inst_matches_initial(InstA, InstB, Type, ModuleInfo0, ModuleInfo, Sub0, Sub) :-
-	Info0 = init_inst_match_info(ModuleInfo0)^sub := Sub0,
+	inst_matches_initial_1(InstA, InstB, Type, ModuleInfo0, ModuleInfo,
+		yes(Sub0), MaybeSub),
+	(
+		MaybeSub = yes(Sub)
+	;
+		MaybeSub = no,
+		error("inst_matches_initial: missing inst_var_sub")
+	).
+
+:- pred inst_matches_initial_1(inst, inst, type, module_info, module_info,
+		maybe(inst_var_sub), maybe(inst_var_sub)).
+:- mode inst_matches_initial_1(in, in, in, in, out, in, out) is semidet.
+
+inst_matches_initial_1(InstA, InstB, Type, ModuleInfo0, ModuleInfo,
+		MaybeSub0, MaybeSub) :-
+	Info0 = init_inst_match_info(ModuleInfo0)^sub := MaybeSub0,
 	inst_matches_initial_2(InstA, InstB, yes(Type), Info0, Info),
 	ModuleInfo = Info^module_info,
-	Sub = Info^sub.
+	MaybeSub = Info^sub.
 
 :- type expansions == set(pair(inst)).
 
@@ -278,14 +292,13 @@
 	--->	inst_match_info(
 			module_info	:: module_info,
 			expansions	:: expansions,
-			sub		:: inst_var_sub
+			sub		:: maybe(inst_var_sub)
 		).
 
 :- func init_inst_match_info(module_info) = inst_match_info.
 
-init_inst_match_info(ModuleInfo) = inst_match_info(ModuleInfo, Exp, Sub) :-
-	set__init(Exp),
-	map__init(Sub).
+init_inst_match_info(ModuleInfo) = inst_match_info(ModuleInfo, Exp, no) :-
+	set__init(Exp).
 
 :- pred inst_matches_initial_2(inst, inst, maybe(type), 
 		inst_match_info, inst_match_info).
@@ -401,7 +414,7 @@
 		MaybeType) -->
 	ModuleInfo0 =^ module_info,
 	{ maybe_get_cons_id_arg_types(ModuleInfo0, MaybeType, ConsId,
-		MaybeTypes) },
+		list__length(Args), MaybeTypes) },
 	ground_matches_initial_inst_list(Uniq, Args, MaybeTypes),
 	ground_matches_initial_bound_inst_list(Uniq, List, MaybeType).
 
@@ -494,13 +507,15 @@
 	% The inst_var_sub records what inst should be substituted for each
 	% inst_var that occurs in the called procedure's argument modes.
 :- pred update_inst_var_sub(inst_var, inst, module_info, module_info,
-		inst_var_sub, inst_var_sub).
+		maybe(inst_var_sub), maybe(inst_var_sub)).
 :- mode update_inst_var_sub(in, in, in, out, in, out) is semidet.
 
-update_inst_var_sub(InstVar, InstA, ModuleInfo0, ModuleInfo, Sub0, Sub) :-
+update_inst_var_sub(_, _, ModuleInfo, ModuleInfo, no, no).
+update_inst_var_sub(InstVar, InstA, ModuleInfo0, ModuleInfo,
+		yes(Sub0), yes(Sub)) :-
 	( map__search(Sub0, InstVar, InstB) ->
 		% If InstVar already has an inst associated with it,
-		% merge the old inst and the new inst.  Fail is this merge
+		% merge the old inst and the new inst.  Fail if this merge
 		% is not possible.
 		inst_merge(InstA, InstB, ModuleInfo0, Inst, ModuleInfo),
 		map__det_update(Sub0, InstVar, Inst, Sub)
@@ -540,19 +555,18 @@
 	{ maybe_get_higher_order_arg_types(MaybeType, length(ModesA),
 		MaybeTypes) },
 	pred_inst_argmodes_matches_initial(ModesA, ModesB, MaybeTypes),
-	Sub =^ sub,
-	{ mode_list_apply_substitution(ModesA, Sub, ModesASub) },
-	{ mode_list_apply_substitution(ModesB, Sub, ModesBSub) },
+	MaybeSub =^ sub,
+	{ 
+		MaybeSub = yes(Sub)
+	->
+		mode_list_apply_substitution(ModesA, Sub, ModesASub),
+		mode_list_apply_substitution(ModesB, Sub, ModesBSub)
+	;
+		ModesASub = ModesA,
+		ModesBSub = ModesB
+	},
 	pred_inst_argmodes_matches(ModesASub, ModesBSub, MaybeTypes).
 
-	% pred_inst_matches_argmodes(ModesA, ModesB, ModuleInfo, Expansions):
-	% succeeds if the initial insts of ModesB specify at least as
-	% much information as, and the same binding as, the initial
-	% insts of ModesA; and the final insts of ModesA specify at
-	% least as much information as, and the same binding as, the
-	% final insts of ModesB.  Any inst pairs in Expansions are assumed
-	% to match_final each other.
-	%
 :- pred pred_inst_argmodes_matches_initial(list(mode), list(mode),
 	list(maybe(type)), inst_match_info, inst_match_info).
 :- mode pred_inst_argmodes_matches_initial(in, in, in, in, out) is semidet.
@@ -684,7 +698,7 @@
 	( { ConsIdX = ConsIdY } ->
 		ModuleInfo =^ module_info,
 		{ maybe_get_cons_id_arg_types(ModuleInfo, MaybeType, ConsIdX,
-			MaybeTypes) },
+			list__length(ArgsX), MaybeTypes) },
 		inst_list_matches_initial(ArgsX, ArgsY, MaybeTypes),
 		bound_inst_list_matches_initial(Xs, Ys, MaybeType)
 	;
@@ -706,14 +720,20 @@
 	inst_matches_initial_2(X, Y, Type),
 	inst_list_matches_initial(Xs, Ys, Types).
 
+	% If possible, get the argument types for the cons_id.
+	% We need to pass in the arity rather than using the arity
+	% from the cons_id because the arity in the cons_id will not
+	% include any extra type_info arguments for existentially
+	% quantified types.
 :- pred maybe_get_cons_id_arg_types(module_info, maybe(type), cons_id,
-		list(maybe(type))).
-:- mode maybe_get_cons_id_arg_types(in, in, in, out) is det.
+		arity, list(maybe(type))).
+:- mode maybe_get_cons_id_arg_types(in, in, in, in, out) is det.
 
-maybe_get_cons_id_arg_types(ModuleInfo, MaybeType, ConsId0, MaybeTypes) :-
-	( ConsId0 = cons(SymName, Arity) ->
+maybe_get_cons_id_arg_types(ModuleInfo, MaybeType, ConsId0, Arity, MaybeTypes)
+		:-
+	( ConsId0 = cons(SymName, _) ->
 		( SymName = qualified(_, Name) ->
-			% type_util__get_cons_id_arg_types expects an 
+			% type_util__maybe_get_cons_id_arg_types expects an 
 			% unqualified cons_id.
 			ConsId = cons(unqualified(Name), Arity)
 		;
@@ -721,7 +741,7 @@
 		),
 		(
 			MaybeType = yes(Type),
-			type_util__get_cons_id_arg_types(ModuleInfo, Type,
+			type_util__maybe_get_cons_id_arg_types(ModuleInfo, Type,
 				ConsId, Types),
 			list__length(Types, Arity)
 		->
@@ -882,7 +902,7 @@
 	( { ConsIdX = ConsIdY } ->
 		ModuleInfo =^ module_info,
 		{ maybe_get_cons_id_arg_types(ModuleInfo, MaybeType, ConsIdX,
-			MaybeTypes) },
+			list__length(ArgsX), MaybeTypes) },
 		inst_list_matches_final(ArgsX, ArgsY, MaybeTypes),
 		bound_inst_list_matches_final(Xs, Ys, MaybeType)
 	;
@@ -997,7 +1017,7 @@
 	( { ConsIdX = ConsIdY } ->
 		ModuleInfo =^ module_info,
 		{ maybe_get_cons_id_arg_types(ModuleInfo, MaybeType, ConsIdX,
-			MaybeTypes) },
+			list__length(ArgsX), MaybeTypes) },
 		inst_list_matches_binding(ArgsX, ArgsY, MaybeTypes),
 		bound_inst_list_matches_binding(Xs, Ys, MaybeType)
 	;
@@ -1527,8 +1547,10 @@
 	inst_contains_instname_2(Inst, ModuleInfo, InstName,
 		yes, Expansions0, _Expansions).
 
+:- type inst_names == set(inst_name).
+
 :- pred inst_contains_instname_2(inst, module_info, inst_name, bool,
-		set(inst_name), set(inst_name)).
+		inst_names, inst_names).
 :- mode inst_contains_instname_2(in, in, in, out, in, out) is det.
 
 inst_contains_instname_2(abstract_inst(_, _), _, _, no, Expns, Expns).
@@ -1560,7 +1582,7 @@
 		InstName, Result, Expansions0, Expansions).
 
 :- pred bound_inst_list_contains_instname(list(bound_inst), module_info,
-		inst_name, bool, set(inst_name), set(inst_name)).
+		inst_name, bool, inst_names, inst_names).
 :- mode bound_inst_list_contains_instname(in, in, in, out, in, out) is det.
 
 bound_inst_list_contains_instname([], _ModuleInfo,
@@ -1579,7 +1601,7 @@
 	).
 
 :- pred inst_list_contains_instname(list(inst), module_info, inst_name, bool,
-		set(inst_name), set(inst_name)).
+		inst_names, inst_names).
 :- mode inst_list_contains_instname(in, in, in, out, in, out) is det.
 
 inst_list_contains_instname([], _ModuleInfo, _InstName, no,
diff -u ./mode_util.m ../../../mercury/compiler/mode_util.m
--- ./mode_util.m	Fri Sep 29 14:23:44 2000
+++ ../../../mercury/compiler/mode_util.m	Wed Sep 27 23:03:32 2000
@@ -1020,15 +1020,25 @@
 	inst_apply_substitution(F0, Subst, F).
 mode_apply_substitution(user_defined_mode(Name, Args0), Subst,
 		    user_defined_mode(Name, Args)) :-
-	inst_list_apply_substitution(Args0, Subst, Args).
+	inst_list_apply_substitution_2(Args0, Subst, Args).
 
 	% inst_list_apply_substitution(Insts0, Subst, Insts) is true
 	% iff Inst is the inst that results from applying Subst to Insts0.
 
-inst_list_apply_substitution([], _, []).
-inst_list_apply_substitution([A0 | As0], Subst, [A | As]) :-
+inst_list_apply_substitution(Insts0, Subst, Insts) :-
+	( map__is_empty(Subst) ->
+		Insts = Insts0
+	;
+		inst_list_apply_substitution_2(Insts0, Subst, Insts)
+	).
+		
+:- pred inst_list_apply_substitution_2(list(inst), inst_var_sub, list(inst)).
+:- mode inst_list_apply_substitution_2(in, in, out) is det.
+
+inst_list_apply_substitution_2([], _, []).
+inst_list_apply_substitution_2([A0 | As0], Subst, [A | As]) :-
 	inst_apply_substitution(A0, Subst, A),
-	inst_list_apply_substitution(As0, Subst, As).
+	inst_list_apply_substitution_2(As0, Subst, As).
 
 	% inst_substitute_arg(Inst0, Subst, Inst) is true
 	% iff Inst is the inst that results from substituting all
@@ -1062,7 +1072,7 @@
 	).
 inst_apply_substitution(abstract_inst(Name, Args0), Subst,
 		    abstract_inst(Name, Args)) :-
-	inst_list_apply_substitution(Args0, Subst, Args).
+	inst_list_apply_substitution_2(Args0, Subst, Args).
 
 	% This predicate fails if the inst_name is not one of user_inst,
 	% typed_inst or typed_ground.  The other types of inst_names are just
@@ -1073,7 +1083,7 @@
 
 inst_name_apply_substitution(user_inst(Name, Args0), Subst,
 		user_inst(Name, Args)) :-
-	inst_list_apply_substitution(Args0, Subst, Args).
+	inst_list_apply_substitution_2(Args0, Subst, Args).
 inst_name_apply_substitution(typed_inst(T, Inst0), Subst,
 		typed_inst(T, Inst)) :-
 	inst_name_apply_substitution(Inst0, Subst, Inst).
@@ -1086,7 +1096,7 @@
 alt_list_apply_substitution([], _, []).
 alt_list_apply_substitution([Alt0|Alts0], Subst, [Alt|Alts]) :-
 	Alt0 = functor(Name, Args0),
-	inst_list_apply_substitution(Args0, Subst, Args),
+	inst_list_apply_substitution_2(Args0, Subst, Args),
 	Alt = functor(Name, Args),
 	alt_list_apply_substitution(Alts0, Subst, Alts).
 
@@ -1112,10 +1122,20 @@
 	% mode_list_apply_substitution(Modes0, Subst, Modes) is true
 	% iff Mode is the mode that results from applying Subst to Modes0.
 
-mode_list_apply_substitution([], _, []).
-mode_list_apply_substitution([A0 | As0], Subst, [A | As]) :-
+mode_list_apply_substitution(Modes0, Subst, Modes) :-
+	( map__is_empty(Subst) ->
+		Modes = Modes0
+	;
+		mode_list_apply_substitution_2(Modes0, Subst, Modes)
+	).
+
+:- pred mode_list_apply_substitution_2(list(mode), inst_var_sub, list(mode)).
+:- mode mode_list_apply_substitution_2(in, in, out) is det.
+
+mode_list_apply_substitution_2([], _, []).
+mode_list_apply_substitution_2([A0 | As0], Subst, [A | As]) :-
 	mode_apply_substitution(A0, Subst, A),
-	mode_list_apply_substitution(As0, Subst, As).
+	mode_list_apply_substitution_2(As0, Subst, As).
 
 %-----------------------------------------------------------------------------%
 
Common subdirectories: ./notes and ../../../mercury/compiler/notes
diff -u ./pd_util.m ../../../mercury/compiler/pd_util.m
--- ./pd_util.m	Fri Sep 29 14:23:44 2000
+++ ../../../mercury/compiler/pd_util.m	Thu Sep 21 14:25:55 2000
@@ -160,7 +160,7 @@
 	{ proc_info_inst_varset(ProcInfo0, InstVarSet0) },
 	{ proc_info_typeinfo_varmap(ProcInfo0, TVarMap) },
 	{ simplify_info_init(DetInfo0, Simplifications, InstMap0,
-		VarSet0, InstVarSet0, VarTypes0, TVarMap, SimplifyInfo0) },
+		VarSet0, InstVarSet0, TVarMap, SimplifyInfo0) },
 
 	{ simplify__process_goal(Goal0, Goal, SimplifyInfo0, SimplifyInfo) },
 
diff -u ./prog_rep.m ../../../mercury/compiler/prog_rep.m
--- ./prog_rep.m	Mon Sep 25 15:37:12 2000
+++ ../../../mercury/compiler/prog_rep.m	Tue Sep 26 15:49:28 2000
@@ -18,26 +18,38 @@
 
 :- interface.
 
-:- import_module hlds_goal, hlds_module, instmap.
+:- import_module hlds_pred, hlds_goal, hlds_module, instmap.
 :- import_module mdb, mdb__program_representation.
 
-:- pred prog_rep__represent_goal(hlds_goal::in, instmap::in, module_info::in,
-	goal_rep::out) is det.
+:- pred prog_rep__represent_goal(hlds_goal::in, instmap::in, vartypes::in,
+	module_info::in, goal_rep::out) is det.
 
 :- implementation.
 
-:- import_module hlds_pred, hlds_data, prog_data.
+:- import_module hlds_data, prog_data.
 :- import_module string, list, set, std_util, require, term.
 
-prog_rep__represent_goal(GoalExpr - GoalInfo, InstMap0, ModuleInfo, Rep) :-
-	prog_rep__represent_goal_expr(GoalExpr, GoalInfo, InstMap0, ModuleInfo,
+:- type prog_rep__info
+	--->	info(
+			vartypes    :: vartypes,
+			module_info :: module_info
+		).
+
+prog_rep__represent_goal(Goal, InstMap0, VarTypes, ModuleInfo, Rep) :-
+	prog_rep__represent_goal(Goal, InstMap0, info(VarTypes, ModuleInfo),
 		Rep).
 
+:- pred prog_rep__represent_goal(hlds_goal::in, instmap::in,
+	prog_rep__info::in, goal_rep::out) is det.
+
+prog_rep__represent_goal(GoalExpr - GoalInfo, InstMap0, Info, Rep) :-
+	prog_rep__represent_goal_expr(GoalExpr, GoalInfo, InstMap0, Info, Rep).
+
 :- pred prog_rep__represent_atomic_goal(hlds_goal_info::in,
-	instmap::in, module_info::in, detism_rep::out,
+	instmap::in, prog_rep__info::in, detism_rep::out,
 	string::out, int::out, list(var_rep)::out) is det.
 
-prog_rep__represent_atomic_goal(GoalInfo, InstMap0, ModuleInfo,
+prog_rep__represent_atomic_goal(GoalInfo, InstMap0, Info,
 		DetismRep, FilenameRep, LinenoRep, ChangedVarsRep) :-
 	goal_info_get_determinism(GoalInfo, Detism),
 	prog_rep__represent_detism(Detism, DetismRep),
@@ -46,7 +58,8 @@
 	term__context_line(Context, LinenoRep),
 	goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
 	instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMap),
-	instmap_changed_vars(InstMap0, InstMap, ModuleInfo, ChangedVars),
+	instmap_changed_vars(InstMap0, InstMap, Info^vartypes, Info^module_info,
+		ChangedVars),
 	set__to_sorted_list(ChangedVars, ChangedVarsList),
 	list__map(term__var_to_int, ChangedVarsList, ChangedVarsRep).
 
@@ -92,10 +105,10 @@
 %---------------------------------------------------------------------------%
 
 :- pred prog_rep__represent_goal_expr(hlds_goal_expr::in, hlds_goal_info::in,
-	instmap::in, module_info::in, goal_rep::out) is det.
+	instmap::in, prog_rep__info::in, goal_rep::out) is det.
 
 prog_rep__represent_goal_expr(unify(_, _, _, Uni, _), GoalInfo, InstMap0,
-		ModuleInfo, Rep) :-
+		Info, Rep) :-
 	(
 		Uni = assign(Target, Source),
 		term__var_to_int(Target, TargetRep),
@@ -123,44 +136,44 @@
 		Uni = complicated_unify(_, _, _),
 		error("prog_rep__represent_goal_expr: complicated_unify")
 	),
-	prog_rep__represent_atomic_goal(GoalInfo, InstMap0, ModuleInfo,
+	prog_rep__represent_atomic_goal(GoalInfo, InstMap0, Info,
 		DetismRep, FilenameRep, LinenoRep, ChangedVarsRep),
 	Rep = atomic_goal_rep(DetismRep, FilenameRep, LinenoRep, ChangedVarsRep,
 		AtomicGoalRep).
-prog_rep__represent_goal_expr(conj(Goals), _, InstMap0, ModuleInfo, Rep) :-
-	prog_rep__represent_conj(Goals, InstMap0, ModuleInfo, Reps),
+prog_rep__represent_goal_expr(conj(Goals), _, InstMap0, Info, Rep) :-
+	prog_rep__represent_conj(Goals, InstMap0, Info, Reps),
 	list__reverse(Reps, ReverseReps),
 	Rep = conj_rep(ReverseReps).
 prog_rep__represent_goal_expr(par_conj(_, _), _, _, _, _) :-
 	error("Sorry, not yet implemented:\n\
 	parallel conjunctions and declarative debugging").
-prog_rep__represent_goal_expr(disj(Goals, _SM), _, InstMap0, ModuleInfo, Rep)
+prog_rep__represent_goal_expr(disj(Goals, _SM), _, InstMap0, Info, Rep)
 		:-
-	prog_rep__represent_disj(Goals, InstMap0, ModuleInfo, DisjReps),
+	prog_rep__represent_disj(Goals, InstMap0, Info, DisjReps),
 	Rep = disj_rep(DisjReps).
-prog_rep__represent_goal_expr(not(Goal), _GoalInfo, InstMap0, ModuleInfo, Rep)
+prog_rep__represent_goal_expr(not(Goal), _GoalInfo, InstMap0, Info, Rep)
 		:-
-	prog_rep__represent_goal(Goal, InstMap0, ModuleInfo, InnerRep),
+	prog_rep__represent_goal(Goal, InstMap0, Info, InnerRep),
 	Rep = negation_rep(InnerRep).
 prog_rep__represent_goal_expr(if_then_else(_, Cond, Then, Else, _SM),
-		_, InstMap0, ModuleInfo, Rep) :-
-	prog_rep__represent_goal(Cond, InstMap0, ModuleInfo, CondRep),
+		_, InstMap0, Info, Rep) :-
+	prog_rep__represent_goal(Cond, InstMap0, Info, CondRep),
 	Cond = _ - CondGoalInfo,
 	goal_info_get_instmap_delta(CondGoalInfo, InstMapDelta),
 	instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMap1),
-	prog_rep__represent_goal(Then, InstMap1, ModuleInfo, ThenRep),
-	prog_rep__represent_goal(Else, InstMap0, ModuleInfo, ElseRep),
+	prog_rep__represent_goal(Then, InstMap1, Info, ThenRep),
+	prog_rep__represent_goal(Else, InstMap0, Info, ElseRep),
 	Rep = ite_rep(CondRep, ThenRep, ElseRep).
 prog_rep__represent_goal_expr(switch(_, _, Cases, _SM), _,
-		InstMap0, ModuleInfo, Rep) :-
-	prog_rep__represent_cases(Cases, InstMap0, ModuleInfo, CaseReps),
+		InstMap0, Info, Rep) :-
+	prog_rep__represent_cases(Cases, InstMap0, Info, CaseReps),
 	Rep = switch_rep(CaseReps).
-prog_rep__represent_goal_expr(some(_, _, Goal), _, InstMap0, ModuleInfo, Rep)
+prog_rep__represent_goal_expr(some(_, _, Goal), _, InstMap0, Info, Rep)
 		:-
-	prog_rep__represent_goal(Goal, InstMap0, ModuleInfo, InnerRep),
+	prog_rep__represent_goal(Goal, InstMap0, Info, InnerRep),
 	Rep = some_rep(InnerRep).
 prog_rep__represent_goal_expr(generic_call(GenericCall, Args, _, _),
-		GoalInfo, InstMap0, ModuleInfo, Rep) :-
+		GoalInfo, InstMap0, Info, Rep) :-
 	list__map(term__var_to_int, Args, ArgsRep),
 	(
 		GenericCall = higher_order(PredVar, _, _),
@@ -175,26 +188,26 @@
 		error("Sorry, not yet implemented\n\
 		Aditi and declarative debugging")
 	),
-	prog_rep__represent_atomic_goal(GoalInfo, InstMap0, ModuleInfo,
+	prog_rep__represent_atomic_goal(GoalInfo, InstMap0, Info,
 		DetismRep, FilenameRep, LinenoRep, ChangedVarsRep),
 	Rep = atomic_goal_rep(DetismRep, FilenameRep, LinenoRep,
 		ChangedVarsRep, AtomicGoalRep).
 prog_rep__represent_goal_expr(call(PredId, _, Args, _, _, _),
-		GoalInfo, InstMap0, ModuleInfo, Rep) :-
-	module_info_pred_info(ModuleInfo, PredId, PredInfo),
+		GoalInfo, InstMap0, Info, Rep) :-
+	module_info_pred_info(Info^module_info, PredId, PredInfo),
 	pred_info_name(PredInfo, PredName),
 	list__map(term__var_to_int, Args, ArgsRep),
 	AtomicGoalRep = plain_call_rep(PredName, ArgsRep),
-	prog_rep__represent_atomic_goal(GoalInfo, InstMap0, ModuleInfo,
+	prog_rep__represent_atomic_goal(GoalInfo, InstMap0, Info,
 		DetismRep, FilenameRep, LinenoRep, ChangedVarsRep),
 	Rep = atomic_goal_rep(DetismRep, FilenameRep, LinenoRep,
 		ChangedVarsRep, AtomicGoalRep).
 prog_rep__represent_goal_expr(pragma_foreign_code(_, _,
 		_PredId, _, Args, _, _, _),
-		GoalInfo, InstMap0, ModuleInfo, Rep) :-
+		GoalInfo, InstMap0, Info, Rep) :-
 	list__map(term__var_to_int, Args, ArgsRep),
 	AtomicGoalRep = pragma_foreign_code_rep(ArgsRep),
-	prog_rep__represent_atomic_goal(GoalInfo, InstMap0, ModuleInfo,
+	prog_rep__represent_atomic_goal(GoalInfo, InstMap0, Info,
 		DetismRep, FilenameRep, LinenoRep, ChangedVarsRep),
 	Rep = atomic_goal_rep(DetismRep, FilenameRep, LinenoRep,
 		ChangedVarsRep, AtomicGoalRep).
@@ -204,36 +217,36 @@
 
 %---------------------------------------------------------------------------%
 
-:- pred prog_rep__represent_conj(hlds_goals::in, instmap::in, module_info::in,
-	list(goal_rep)::out) is det.
+:- pred prog_rep__represent_conj(hlds_goals::in, instmap::in,
+	prog_rep__info::in, list(goal_rep)::out) is det.
 
 prog_rep__represent_conj([], _, _, []).
-prog_rep__represent_conj([Goal | Goals], InstMap0, ModuleInfo, [Rep | Reps]) :-
-	prog_rep__represent_goal(Goal, InstMap0, ModuleInfo, Rep),
+prog_rep__represent_conj([Goal | Goals], InstMap0, Info, [Rep | Reps]) :-
+	prog_rep__represent_goal(Goal, InstMap0, Info, Rep),
 	Goal = _ - GoalInfo,
 	goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
 	instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMap1),
-	prog_rep__represent_conj(Goals, InstMap1, ModuleInfo, Reps).
+	prog_rep__represent_conj(Goals, InstMap1, Info, Reps).
 
 %---------------------------------------------------------------------------%
 
-:- pred prog_rep__represent_disj(hlds_goals::in, instmap::in, module_info::in,
-	list(goal_rep)::out) is det.
+:- pred prog_rep__represent_disj(hlds_goals::in, instmap::in,
+	prog_rep__info::in, list(goal_rep)::out) is det.
 
 prog_rep__represent_disj([], _, _, []).
-prog_rep__represent_disj([Goal | Goals], InstMap0, ModuleInfo, [Rep | Reps]) :-
-	prog_rep__represent_goal(Goal, InstMap0, ModuleInfo, Rep),
-	prog_rep__represent_disj(Goals, InstMap0, ModuleInfo, Reps).
+prog_rep__represent_disj([Goal | Goals], InstMap0, Info, [Rep | Reps]) :-
+	prog_rep__represent_goal(Goal, InstMap0, Info, Rep),
+	prog_rep__represent_disj(Goals, InstMap0, Info, Reps).
 
 %---------------------------------------------------------------------------%
 
-:- pred prog_rep__represent_cases(list(case)::in, instmap::in, module_info::in,
-	list(goal_rep)::out) is det.
+:- pred prog_rep__represent_cases(list(case)::in, instmap::in,
+	prog_rep__info::in, list(goal_rep)::out) is det.
 
 prog_rep__represent_cases([], _, _, []).
-prog_rep__represent_cases([case(_, Goal) | Cases], InstMap0, ModuleInfo,
+prog_rep__represent_cases([case(_, Goal) | Cases], InstMap0, Info,
 		[Rep | Reps]) :-
-	prog_rep__represent_goal(Goal, InstMap0, ModuleInfo, Rep),
-	prog_rep__represent_cases(Cases, InstMap0, ModuleInfo, Reps).
+	prog_rep__represent_goal(Goal, InstMap0, Info, Rep),
+	prog_rep__represent_cases(Cases, InstMap0, Info, Reps).
 
 %---------------------------------------------------------------------------%
diff -u ./simplify.m ../../../mercury/compiler/simplify.m
--- ./simplify.m	Fri Sep 29 14:23:44 2000
+++ ../../../mercury/compiler/simplify.m	Thu Sep 21 14:24:15 2000
@@ -160,7 +160,7 @@
 	proc_info_goal(ProcInfo0, Goal0),
 
 	simplify_info_init(DetInfo0, Simplifications, InstMap0,
-		VarSet0, InstVarSet0, VarTypes0, TVarMap, Info0),
+		VarSet0, InstVarSet0, TVarMap, Info0),
 	simplify__process_goal(Goal0, Goal, Info0, Info),
 	
 	simplify_info_get_varset(Info, VarSet),
@@ -1940,7 +1940,6 @@
 			instmap		::	instmap,
 			varset		::	prog_varset,
 			inst_varset	::	inst_varset,
-			var_types	::	map(prog_var, type),
 			requantify	::	bool,
 					% Does the goal need requantification.
 			recompute_atomic ::	bool,
@@ -1959,13 +1958,12 @@
 		).
 
 simplify_info_init(DetInfo, Simplifications0, InstMap,
-		VarSet, InstVarSet, VarTypes, TVarMap, Info) :-
+		VarSet, InstVarSet, TVarMap, Info) :-
 	common_info_init(CommonInfo),
 	set__init(Msgs),
 	set__list_to_set(Simplifications0, Simplifications),
 	Info = simplify_info(DetInfo, Msgs, Simplifications, CommonInfo,
-		InstMap, VarSet, InstVarSet, VarTypes, no, no, no, 0, 0,
-		TVarMap). 
+		InstMap, VarSet, InstVarSet, no, no, no, 0, 0, TVarMap). 
 
 	% Reinitialise the simplify_info before reprocessing a goal.
 :- pred simplify_info_reinit(set(simplification)::in, instmap::in,
@@ -1988,7 +1986,7 @@
 :- import_module set.
 
 :- pred simplify_info_init(det_info::in, list(simplification)::in, instmap::in,
-		prog_varset::in, inst_varset::in, vartypes::in,
+		prog_varset::in, inst_varset::in, 
 		type_info_varmap::in, simplify_info::out) is det.
 
 :- pred simplify_info_get_det_info(simplify_info::in, det_info::out) is det.
@@ -2021,7 +2019,7 @@
 simplify_info_get_common_info(SI, SI^common_info).
 simplify_info_get_instmap(SI, SI^instmap).
 simplify_info_get_varset(SI, SI^varset).
-simplify_info_get_var_types(SI, SI^var_types).
+simplify_info_get_var_types(SI, SI^det_info^vartypes).
 simplify_info_requantify(SI) :-
 	SI^requantify = yes.
 simplify_info_recompute_atomic(SI) :-
@@ -2089,7 +2087,7 @@
 simplify_info_set_instmap(SI, InstMap, SI^instmap := InstMap). 
 simplify_info_set_common_info(SI, Common, SI^common_info := Common). 
 simplify_info_set_varset(SI, VarSet, SI^varset := VarSet). 
-simplify_info_set_var_types(SI, VarTypes, SI^var_types := VarTypes).
+simplify_info_set_var_types(SI, VarTypes, SI^det_info^vartypes := VarTypes).
 simplify_info_set_requantify(SI, SI^requantify := yes).
 simplify_info_set_recompute_atomic(SI, SI^recompute_atomic := yes).
 simplify_info_set_rerun_det(SI, SI^rerun_det := yes).
diff -u ./stack_layout.m ../../../mercury/compiler/stack_layout.m
--- ./stack_layout.m	Wed Sep 27 16:22:36 2000
+++ ../../../mercury/compiler/stack_layout.m	Fri Sep 29 12:38:49 2000
@@ -550,7 +550,7 @@
 	{ ProcLayoutInfo = proc_layout_info(EntryLabel, Detism,
 		StackSlots, SuccipLoc, MaybeCallLabel, MaxTraceReg,
 		Goal, InstMap, TraceSlotInfo, ForceProcIdLayout,
-		VarSet, InternalMap) },
+		VarSet, VarTypes, InternalMap) },
 	{ map__to_assoc_list(InternalMap, Internals) },
 	stack_layout__set_cur_proc_named_vars(map__init),
 	list__foldl(stack_layout__construct_internal_layout(EntryLabel),
@@ -563,7 +563,7 @@
 	stack_layout__construct_proc_layout(EntryLabel, Detism,
 		StackSlots, SuccipLoc, MaybeCallLabel, MaxTraceReg,
 		Goal, InstMap, TraceSlotInfo, ForceProcIdLayout,
-		VarSet, NamedVars).
+		VarSet, VarTypes, NamedVars).
 
 %---------------------------------------------------------------------------%
 
@@ -659,12 +659,13 @@
 :- pred stack_layout__construct_proc_layout(label::in, determinism::in,
 	int::in, maybe(int)::in, maybe(label)::in, int::in,
 	hlds_goal::in, instmap::in, trace_slot_info::in, bool::in,
-	prog_varset::in, map(int, string)::in,
+	prog_varset::in, vartypes::in, map(int, string)::in,
 	stack_layout_info::in, stack_layout_info::out) is det.
 
 stack_layout__construct_proc_layout(EntryLabel, Detism, StackSlots,
 		MaybeSuccipLoc, MaybeCallLabel, MaxTraceReg, Goal, InstMap,
-		TraceSlotInfo, ForceProcIdLayout, VarSet, UsedVarNames) -->
+		TraceSlotInfo, ForceProcIdLayout, VarSet, VarTypes,
+		UsedVarNames) -->
 	{
 		MaybeSuccipLoc = yes(Location0)
 	->
@@ -727,8 +728,8 @@
 		{ stack_layout__construct_procid_rvals(ProcLabel, IdRvals,
 			IdArgTypes) },
 		stack_layout__construct_trace_layout(MaybeCallLabel,
-			MaxTraceReg, Goal, InstMap, TraceSlotInfo,
-			VarSet, UsedVarNames, TraceRvals, TraceArgTypes),
+			MaxTraceReg, Goal, InstMap, TraceSlotInfo, VarSet,
+			VarTypes, UsedVarNames, TraceRvals, TraceArgTypes),
 		{ list__append(IdRvals, TraceRvals, IdTraceRvals) },
 		{ IdTraceArgTypes = initial(IdArgTypes, TraceArgTypes) }
 	;
@@ -752,12 +753,12 @@
 
 :- pred stack_layout__construct_trace_layout(maybe(label)::in, int::in,
 	hlds_goal::in, instmap::in, trace_slot_info::in,
-	prog_varset::in, map(int, string)::in,
+	prog_varset::in, vartypes::in, map(int, string)::in,
 	list(maybe(rval))::out, create_arg_types::out,
 	stack_layout_info::in, stack_layout_info::out) is det.
 
 stack_layout__construct_trace_layout(MaybeCallLabel, MaxTraceReg,
-		Goal, InstMap, TraceSlotInfo, VarSet, UsedVarNameMap,
+		Goal, InstMap, TraceSlotInfo, VarSet, VarTypes, UsedVarNameMap,
 		Rvals, ArgTypes) -->
 	stack_layout__get_trace_stack_layout(TraceLayout),
 	( { TraceLayout = yes } ->
@@ -771,8 +772,8 @@
 		;
 			{ BodyReps = yes },
 			stack_layout__get_module_info(ModuleInfo0),
-			{ prog_rep__represent_goal(Goal, InstMap, ModuleInfo0,
-				GoalRep) },
+			{ prog_rep__represent_goal(Goal, InstMap, VarTypes,
+				ModuleInfo0, GoalRep) },
 			{ type_to_univ(GoalRep, GoalRepUniv) },
 			stack_layout__get_cell_counter(CellCounter0),
 			{ static_term__term_to_rval(GoalRepUniv, GoalRepRval,
diff -u ./type_util.m ../../../mercury/compiler/type_util.m
--- ./type_util.m	Fri Sep 29 14:23:44 2000
+++ ../../../mercury/compiler/type_util.m	Wed Sep 27 12:32:38 2000
@@ -200,6 +200,13 @@
 :- pred type_util__get_cons_id_arg_types(module_info::in, (type)::in,
 		cons_id::in, list(type)::out) is det.
 
+	% The same as type_util__get_cons_id_arg_types except that it
+	% fails rather than aborting if the functor is existentially
+	% typed.
+	% The cons_id is expected to be un-module-qualified.
+:- pred type_util__maybe_get_cons_id_arg_types(module_info::in, (type)::in,
+		cons_id::in, list(type)::out) is semidet.
+
 	% The same as type_util__get_cons_id_arg_types except that the
 	% cons_id is output non-deterministically.
 	% The cons_id is not module-qualified.
@@ -784,7 +791,27 @@
 
 %-----------------------------------------------------------------------------%
 
-type_util__get_cons_id_arg_types(ModuleInfo, VarType, ConsId, ArgTypes) :-
+type_util__get_cons_id_arg_types(ModuleInfo, Type, ConsId, ArgTypes) :-
+	type_util__get_cons_id_arg_types_2(abort_on_exist_qvar,
+		ModuleInfo, Type, ConsId, ArgTypes).
+
+type_util__maybe_get_cons_id_arg_types(ModuleInfo, Type, ConsId, ArgTypes) :-
+	type_util__get_cons_id_arg_types_2(fail_on_exist_qvar,
+		ModuleInfo, Type, ConsId, ArgTypes).
+
+:- type exist_qvar_action
+	--->	fail_on_exist_qvar
+	;	abort_on_exist_qvar.
+
+:- pred type_util__get_cons_id_arg_types_2(exist_qvar_action,
+	module_info, (type), cons_id, list(type)).
+:- mode type_util__get_cons_id_arg_types_2(in(bound(fail_on_exist_qvar)),
+		in, in, in, out) is semidet.
+:- mode type_util__get_cons_id_arg_types_2(in(bound(abort_on_exist_qvar)),
+		in, in, in, out) is det.
+
+type_util__get_cons_id_arg_types_2(EQVarAction, ModuleInfo, VarType, ConsId,
+		ArgTypes) :-
 	(
 		% The argument types of a tuple cons_id are the
 		% arguments of the tuple type.
@@ -803,8 +830,17 @@
 		term__term_list_to_var_list(TypeDefnParams, TypeDefnVars),
 
 		% XXX handle ExistQVars
-		require(unify(ExistQVars0, []),
-	"type_util__get_cons_id_arg_types: existentially typed cons_id"),
+		( ExistQVars0 = [] ->
+			true
+		; 
+			(
+				EQVarAction = abort_on_exist_qvar,
+				error("type_util__get_cons_id_arg_types: existentially typed cons_id")
+			;
+				EQVarAction = fail_on_exist_qvar,
+				fail
+			)
+		),
 
 		map__from_corresponding_lists(TypeDefnVars, TypeArgs, TSubst),
 		assoc_list__values(Args, ArgTypes0),
@@ -814,20 +850,24 @@
 	).
 
 type_util__cons_id_arg_types(ModuleInfo, VarType, ConsId, ArgTypes) :-
+	type_to_type_id(VarType, TypeId, TypeArgs),
+	module_info_types(ModuleInfo, Types),
+	map__lookup(Types, TypeId, TypeDefn),
+	hlds_data__get_type_defn_body(TypeDefn, TypeDefnBody),
+	TypeDefnBody = du_type(_, ConsTags, _, _),
+	map__member(ConsTags, ConsId, _),
+	
 	module_info_ctors(ModuleInfo, Ctors),
-
-	map__member(Ctors, ConsId, ConsDefns),
+	map__lookup(Ctors, ConsId, ConsDefns),
 	list__member(ConsDefn, ConsDefns),
 	
-	type_to_type_id(VarType, TypeId, TypeArgs),
 	ConsDefn = hlds_cons_defn(ExistQVars0, _, Args, TypeId, _),
-	module_info_types(ModuleInfo, Types),
-	map__lookup(Types, TypeId, TypeDefn),
-	hlds_data__get_type_defn_tparams(TypeDefn, TypeDefnParams),
-	term__term_list_to_var_list(TypeDefnParams, TypeDefnVars),
 
 	% XXX handle ExistQVars
 	ExistQVars0 = [],
+
+	hlds_data__get_type_defn_tparams(TypeDefn, TypeDefnParams),
+	term__term_list_to_var_list(TypeDefnParams, TypeDefnVars),
 
 	map__from_corresponding_lists(TypeDefnVars, TypeArgs, TSubst),
 	assoc_list__values(Args, ArgTypes0),

-- 
David Overton      Department of Computer Science & Software Engineering
PhD Student        The University of Melbourne, Victoria 3010, Australia
+61 3 8344 9159    http://www.cs.mu.oz.au/~dmo
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------



More information about the developers mailing list