[m-rev.] diff: qualify_cons_id

[Zoltan Somogyi]

compiler/type_util.m:
compiler/modecheck_unify.m:
	Take a piece of code in modecheck_unify and make it a predicate in
	type_util, without any logic changes. In an upcoming diff, another
	module will need the same code.

Zoltan.

cvs diff: Diffing .
Index: modecheck_unify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.57
diff -u -b -r1.57 modecheck_unify.m
--- modecheck_unify.m	13 May 2003 23:56:17 -0000	1.57
+++ modecheck_unify.m	30 May 2003 08:46:02 -0000
@@ -425,37 +425,8 @@
 	% Fully module qualify all cons_ids
 	% (except for builtins such as ints and characters).
 	%
-	(
-		ConsId0 = cons(Name0, OrigArity),
-		type_to_ctor_and_args(TypeOfX, TypeCtor, _),
-		TypeCtor = qualified(TypeModule, _) - _
-	->
-		unqualify_name(Name0, UnqualName),
-		Name = qualified(TypeModule, UnqualName),
-		ConsId = cons(Name, OrigArity),
-		%
-		% Fix up the cons_id arity for type(class)_info constructions.
-		% The cons_id for type(class)_info constructions always has
-		% arity 1, to match the arity in the declaration in
-		% library/private_builtin.m,
-		% but for the inst we need the arity of the cons_id
-		% to match the number of arguments.
-		%
-		(
-			mercury_private_builtin_module(TypeModule),
-			( UnqualName = "typeclass_info"
-			; UnqualName = "type_info"
-			)
-		->
-			list__length(ArgVars0, InstArity),
-			InstConsId = cons(Name, InstArity)
-		;
-			InstConsId = ConsId
-		)
-	;
-		ConsId = ConsId0,
-		InstConsId = ConsId
-	),
+	qualify_cons_id(TypeOfX, ArgVars0, ConsId0, ConsId, InstConsId),
+
 	mode_info_get_instmap(ModeInfo0, InstMap0),
 	instmap__lookup_var(InstMap0, X0, InstOfX0),
 	instmap__lookup_vars(ArgVars0, InstMap0, InstArgs),
Index: type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.118
diff -u -b -r1.118 type_util.m
--- type_util.m	29 May 2003 09:19:44 -0000	1.118
+++ type_util.m	30 May 2003 08:46:02 -0000
@@ -265,6 +265,15 @@
 :- pred type_util__get_cons_defn(module_info::in, type_ctor::in, cons_id::in,
 		hlds_cons_defn::out) is semidet.
 
+	% Module-qualify the cons_id using module information from the type.
+	% The second output value is the cons_id required for use in insts which
+	% can be different from that used in types for typeclass_info and
+	% type_info.
+	% The list(prog_var) is the list of arguments to the cons_id and is just
+	% used for obtaining the arity for typeclass_info and type_info
+	% cons_ids.
+:- pred qualify_cons_id((type)::in, list(prog_var)::in, cons_id::in,
+		cons_id::out, cons_id::out) is det.
 
 	% Given a type and a cons_id, look up the definition of that
 	% constructor; if it is existentially typed, return its definition,
@@ -1140,6 +1149,41 @@
 			ThisConsDefn = hlds_cons_defn(_, _, _, TypeCtor, _)
 		)),
 	list__filter(MatchingCons, ConsDefns, [ConsDefn]).
+
+%-----------------------------------------------------------------------------%
+
+qualify_cons_id(Type, Args, ConsId0, ConsId, InstConsId) :-
+	(
+		ConsId0 = cons(Name0, OrigArity),
+		type_to_ctor_and_args(Type, TypeCtor, _),
+		TypeCtor = qualified(TypeModule, _) - _
+	->
+		unqualify_name(Name0, UnqualName),
+		Name = qualified(TypeModule, UnqualName),
+		ConsId = cons(Name, OrigArity),
+		%
+		% Fix up the cons_id arity for type(class)_info constructions.
+		% The cons_id for type(class)_info constructions always has
+		% arity 1, to match the arity in the declaration in
+		% library/private_builtin.m,
+		% but for the inst we need the arity of the cons_id
+		% to match the number of arguments.
+		%
+		(
+			mercury_private_builtin_module(TypeModule),
+			( UnqualName = "typeclass_info"
+			; UnqualName = "type_info"
+			)
+		->
+			list__length(Args, InstArity),
+			InstConsId = cons(Name, InstArity)
+		;
+			InstConsId = ConsId
+		)
+	;
+		ConsId = ConsId0,
+		InstConsId = ConsId
+	).
 	
 %-----------------------------------------------------------------------------%
 
cvs diff: Diffing notes
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------