[m-rev.] for review: type_info_cell_constructor

[Zoltan Somogyi]

On 24-Jun-2003, David Overton <dmo at cs.mu.OZ.AU> wrote:
> > compiler/type_util.m:
> > 	Add a type and some predicates to control the representation of
> > 	type_info and typeclass_info cells in one place.
> > 
> > 	Since we no longer depend on the representations of the function
> > 	symbols of the type_info and typeclass_info types, do not special
> > 	case their representation.
> 
> You should ensure that type_util__cons_id_arg_types, which is called by 
> inst_match.bound_inst_list_is_complete_for_type, does the right thing.
> The predicate bound_inst_list_is_complete_for_type requires the
> representation of the cons_ids which are used in insts.

type_util__cons_id_arg_types returns all the declared constructors of the type,
one at a time, both before and after this change; this change doesn't affect
its correctness.

The definition of bound_inst_list_is_complete_for_type is:

bound_inst_list_is_complete_for_type(Expansions, ModuleInfo, BoundInsts, Type)
                :-
        % Is this a type for which cons_ids are recorded in the type_table?
        type_util__cons_id_arg_types(ModuleInfo, Type, _, _),

        % Is there a bound_inst for each cons_id in the type_table?
        all [ConsId, ArgTypes] (
                type_util__cons_id_arg_types(ModuleInfo, Type, ConsId,
                        ArgTypes)
        =>
                (
                        list__member(functor(ConsId0, ArgInsts), BoundInsts),
                        % Cons_ids returned from type_util__cons_id_arg_types
                        % are not module-qualified so we need to call
                        % equivalent_cons_ids instead of just using `=/2'.
                        equivalent_cons_ids(ConsId0, ConsId),
                        list__map(inst_is_complete_for_type(Expansions,
                                ModuleInfo), ArgInsts, ArgTypes)
                )
        ).

It seems to me that this predicate would always fail whenever called on
a type_info or typeclass_info. Both those types have a single declared function
symbol of arity 1, whereas all their actual uses have arity of at least 2,
and polymorphism puts the actual arities in the cons_ids inside BoundInsts.
The implication would therefore have been false.

After I delete the function symbols from those two types, I expect this
predicate will still fail, but for a different reason: the initial call
to cons_id_arg_types will fail.

Overall, bound_inst_list_is_complete_for_type doesn't check that the cons_ids
in insts are declared in the type definition; it only checks the reverse.

The full diff follows; it passes bootcheck cleanly. In the absence of
any more objections, I intend to commit it tonight.

Zoltan.

Prepare to make type_info and typeclass_info foreign types by eliminating the
compiler's dependence on their function symbols. At the moment, the compiler
generates type_intos and typeclass_infos by using the function symbols of these
types as cons_ids. However, the function symbols have fake arities, which
demanded special treatment in many places. This change makes the compiler use
the cons_ids type_into_cell_constructor and typeclass_into_cell_constructor
instead, except in insts, which need to know the arity of the constructor.

compiler/hlds_data.m:
	Add the two new cons_ids.

compiler/polymorphism.m:
	Use the two new cons_ids instead of the function symbols of the
	type_info and typeclass_info types, since those function symbols
	will soon be deleted.

compiler/type_util.m:
	Add a type and some predicates to control the representation of
	type_info and typeclass_info cells in one place.

	Since we no longer depend on the representations of the function
	symbols of the type_info and typeclass_info types, do not special
	case their representation.

compiler/hlds_code_util.m:
	Implement the representation of the two new function symbols.

compiler/bytecode.m:
	Add two new cons_ids to parallel the ones in hlds_data.m.

compiler/higher_order.m:
	Look for the two new cons_ids, instead of the old ones.

	Make the code more maintainable.

compiler/*.m:
	Minor changes to conform to the changes above.

library/private_builtin.m:
	Delete the statement that the compiler depends on the functors of the
	type_info and type_ctor_info types.

bytecode/mb_bytecode.h:
	Document that some bytecodes generated by the compiler are not yet
	implemented by the bytecode interpreter.

cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
Index: bytecode/mb_bytecode.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/bytecode/mb_bytecode.h,v
retrieving revision 1.3
diff -u -b -r1.3 mb_bytecode.h
--- bytecode/mb_bytecode.h	19 Feb 2001 02:05:46 -0000	1.3
+++ bytecode/mb_bytecode.h	22 Jun 2003 09:21:04 -0000
@@ -168,6 +168,7 @@
 #define	MB_CONSID_CODE_ADDR_CONST	5
 #define	MB_CONSID_BASE_TYPE_INFO_CONST	6
 #define	MB_CONSID_CHAR_CONST		7
+/* some more cons_ids generated by the compiler are not yet implemented */
 
 /*
 **	Possible values for Test_id
cvs diff: Diffing compiler
Index: compiler/bytecode.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/bytecode.m,v
retrieving revision 1.53
diff -u -b -r1.53 bytecode.m
--- compiler/bytecode.m	20 Jun 2003 12:45:41 -0000	1.53
+++ compiler/bytecode.m	22 Jun 2003 09:22:46 -0000
@@ -93,6 +93,8 @@
 					int)
 			;	base_typeclass_info_const(byte_module_id,
 					class_id, string)
+			;	type_info_cell_constructor
+			;	typeclass_info_cell_constructor
 			;	char_const(char)
 			.
 
@@ -791,11 +793,16 @@
 	output_byte(7),
 	{ char__to_int(Char, Byte) },
 	output_byte(Byte).
-
 	% XXX
 output_cons_id(base_typeclass_info_const(_, _, _)) -->
 	{ error("Sorry, bytecode for typeclass not yet implemented") },
 	output_byte(8).
+output_cons_id(type_info_cell_constructor) -->
+	{ error("Sorry, bytecode for type_info_cell_constructor not yet implemented") },
+	output_byte(9).
+output_cons_id(typeclass_info_cell_constructor) -->
+	{ error("Sorry, bytecode for typeclass_info_cell_constructor not yet implemented") },
+	output_byte(10).
 
 :- pred debug_cons_id(byte_cons_id, io__state, io__state).
 :- mode debug_cons_id(in, di, uo) is det.
@@ -840,6 +847,10 @@
 	debug_string("char_const"),
 	{ string__from_char_list([Char], String) },
 	debug_string(String).
+debug_cons_id(type_info_cell_constructor) -->
+	debug_string("type_info_cell_constructor").
+debug_cons_id(typeclass_info_cell_constructor) -->
+	debug_string("typeclass_info_cell_constructor").
 
 %---------------------------------------------------------------------------%
 
Index: compiler/bytecode_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/bytecode_gen.m,v
retrieving revision 1.74
diff -u -b -r1.74 bytecode_gen.m
--- compiler/bytecode_gen.m	20 Jun 2003 12:45:42 -0000	1.74
+++ compiler/bytecode_gen.m	22 Jun 2003 08:41:45 -0000
@@ -746,6 +746,12 @@
 		ByteConsId = base_typeclass_info_const(ModuleName, ClassId,
 			Instance)
 	;
+		ConsId = type_info_cell_constructor,
+		ByteConsId = type_info_cell_constructor
+	;
+		ConsId = typeclass_info_cell_constructor,
+		ByteConsId = typeclass_info_cell_constructor
+	;
 		ConsId = tabling_pointer_const(_, _),
 		sorry(this_file, "bytecode cannot implement tabling")
 	;
Index: compiler/dependency_graph.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dependency_graph.m,v
retrieving revision 1.62
diff -u -b -r1.62 dependency_graph.m
--- compiler/dependency_graph.m	20 Jun 2003 12:45:43 -0000	1.62
+++ compiler/dependency_graph.m	22 Jun 2003 08:41:45 -0000
@@ -509,6 +509,10 @@
 		_Caller, !DepGraph).
 dependency_graph__add_arcs_in_cons(base_typeclass_info_const(_, _, _, _),
 		_Caller, !DepGraph).
+dependency_graph__add_arcs_in_cons(type_info_cell_constructor,
+		_Caller, !DepGraph).
+dependency_graph__add_arcs_in_cons(typeclass_info_cell_constructor,
+		_Caller, !DepGraph).
 dependency_graph__add_arcs_in_cons(tabling_pointer_const(_, _),
 		_Caller, !DepGraph).
 dependency_graph__add_arcs_in_cons(deep_profiling_proc_static(_),
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.109
diff -u -b -r1.109 higher_order.m
--- compiler/higher_order.m	29 May 2003 18:17:14 -0000	1.109
+++ compiler/higher_order.m	22 Jun 2003 13:08:48 -0000
@@ -666,7 +666,10 @@
 check_unify(deconstruct(_, _, _, _, _, _)) --> [].
 
 check_unify(construct(LVar, ConsId, Args, _Modes, _, _, _), Info0, Info) :-
-	( is_interesting_cons_id(Info0 ^ global_info ^ ho_params, ConsId) ->
+	(
+		is_interesting_cons_id(Info0 ^ global_info ^ ho_params, ConsId)
+			= yes
+	->
 		( map__search(Info0 ^ pred_vars, LVar, Specializable) ->
 			(
 				% we can't specialize calls involving
@@ -695,28 +698,28 @@
 check_unify(complicated_unify(_, _, _)) -->
 	{ error("higher_order:check_unify - complicated unification") }.
 
-:- pred is_interesting_cons_id(ho_params::in, cons_id::in) is semidet.
-
-is_interesting_cons_id(Params, cons(qualified(Module, Name), _)) :-
-	yes = Params ^ user_type_spec,
-	mercury_private_builtin_module(Module),
-	( Name = "type_info"
-	; Name = "typeclass_info"
-	).
-is_interesting_cons_id(Params, pred_const(_, _, _)) :-
-	yes = Params ^ optimize_higher_order.
-is_interesting_cons_id(Params,
-		type_ctor_info_const(_, _, _)) :-
-	yes = Params ^ user_type_spec.
-is_interesting_cons_id(Params,
-		base_typeclass_info_const(_, _, _, _)) :-
-	yes = Params ^ user_type_spec.
+:- func is_interesting_cons_id(ho_params, cons_id) = bool.
 
+is_interesting_cons_id(_Params, cons(_, _)) = no.
 	% We need to keep track of int_consts so we can interpret
 	% superclass_info_from_typeclass_info and typeinfo_from_typeclass_info.
 	% We don't specialize based on them.
-is_interesting_cons_id(Params, int_const(_)) :-
-	yes = Params ^ user_type_spec.
+is_interesting_cons_id(Params, int_const(_)) = Params ^ user_type_spec.
+is_interesting_cons_id(_Params, string_const(_)) = no.
+is_interesting_cons_id(_Params, float_const(_)) = no.
+is_interesting_cons_id(Params, pred_const(_, _, _)) =
+	Params ^ optimize_higher_order.
+is_interesting_cons_id(Params, type_ctor_info_const(_, _, _)) =
+	Params ^ user_type_spec.
+is_interesting_cons_id(Params, base_typeclass_info_const(_, _, _, _)) =
+	Params ^ user_type_spec.
+is_interesting_cons_id(Params, type_info_cell_constructor) =
+	Params ^ user_type_spec.
+is_interesting_cons_id(Params, typeclass_info_cell_constructor) =
+	Params ^ user_type_spec.
+is_interesting_cons_id(_Params, tabling_pointer_const(_, _)) = no.
+is_interesting_cons_id(_Params, deep_profiling_proc_static(_)) = no.
+is_interesting_cons_id(_Params, table_io_decl(_)) = no.
 
 	% Process a higher-order call or class_method_call to see if it
 	% could possibly be specialized.
@@ -745,9 +748,7 @@
 			% A typeclass_info variable should consist of
 			% a known base_typeclass_info and some argument
 			% typeclass_infos.
-			ConsId = cons(TypeClassInfo, _),
-			mercury_private_builtin_module(Module),
-			TypeClassInfo = qualified(Module, "typeclass_info"),
+			ConsId = typeclass_info_cell_constructor,
 			CurriedArgs = [BaseTypeClassInfo | OtherTypeClassArgs],
 			map__search(Info0 ^ pred_vars, BaseTypeClassInfo,
 				constant(BaseConsId, _)),
Index: compiler/hlds_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_code_util.m,v
retrieving revision 1.6
diff -u -b -r1.6 hlds_code_util.m
--- compiler/hlds_code_util.m	20 Jun 2003 12:45:43 -0000	1.6
+++ compiler/hlds_code_util.m	22 Jun 2003 08:41:46 -0000
@@ -55,6 +55,8 @@
 		type_ctor_info_constant(M,T,A).
 cons_id_to_tag(base_typeclass_info_const(M,C,_,N), _, _) =
 		base_typeclass_info_constant(M,C,N).
+cons_id_to_tag(type_info_cell_constructor, _, _) = unshared_tag(0).
+cons_id_to_tag(typeclass_info_cell_constructor, _, _) = unshared_tag(0).
 cons_id_to_tag(tabling_pointer_const(PredId,ProcId), _, _) =
 		tabling_pointer_constant(PredId,ProcId).
 cons_id_to_tag(deep_profiling_proc_static(PPId), _, _) =
Index: compiler/hlds_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.77
diff -u -b -r1.77 hlds_data.m
--- compiler/hlds_data.m	20 Jun 2003 12:45:43 -0000	1.77
+++ compiler/hlds_data.m	22 Jun 2003 08:41:46 -0000
@@ -50,6 +50,8 @@
 		% class instance, a string encoding the type
 		% names and arities of the arguments to the
 		% instance declaration
+	;	type_info_cell_constructor
+	;	typeclass_info_cell_constructor
 	;	tabling_pointer_const(pred_id, proc_id)
 		% The address of the static variable
 		% that points to the table that implements
@@ -199,6 +201,10 @@
 	error("cons_id_arity: can't get arity of type_ctor_info_const").
 cons_id_arity(base_typeclass_info_const(_, _, _, _), _) :-
 	error("cons_id_arity: can't get arity of base_typeclass_info_const").
+cons_id_arity(type_info_cell_constructor, _) :-
+	error("cons_id_arity: can't get arity of type_info_cell_constructor").
+cons_id_arity(typeclass_info_cell_constructor, _) :-
+	error("cons_id_arity: can't get arity of typeclass_info_cell_constructor").
 cons_id_arity(tabling_pointer_const(_, _), _) :-
 	error("cons_id_arity: can't get arity of tabling_pointer_const").
 cons_id_arity(deep_profiling_proc_static(_), _) :-
@@ -213,6 +219,8 @@
 cons_id_maybe_arity(pred_const(_, _, _), no) .
 cons_id_maybe_arity(type_ctor_info_const(_, _, _), no) .
 cons_id_maybe_arity(base_typeclass_info_const(_, _, _, _), no).
+cons_id_maybe_arity(type_info_cell_constructor, no) .
+cons_id_maybe_arity(typeclass_info_cell_constructor, no) .
 cons_id_maybe_arity(tabling_pointer_const(_, _), no).
 cons_id_maybe_arity(deep_profiling_proc_static(_), no).
 cons_id_maybe_arity(table_io_decl(_), no).
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.312
diff -u -b -r1.312 hlds_out.m
--- compiler/hlds_out.m	20 Jun 2003 12:45:44 -0000	1.312
+++ compiler/hlds_out.m	22 Jun 2003 13:04:03 -0000
@@ -331,6 +331,10 @@
 hlds_out__cons_id_to_string(type_ctor_info_const(_, _, _), "<type_ctor_info>").
 hlds_out__cons_id_to_string(base_typeclass_info_const(_, _, _, _),
 	"<base_typeclass_info>").
+hlds_out__cons_id_to_string(type_info_cell_constructor,
+	"<type_info_cell_constructor>").
+hlds_out__cons_id_to_string(typeclass_info_cell_constructor,
+	"<typeclass_info_cell_constructor>").
 hlds_out__cons_id_to_string(tabling_pointer_const(_, _),
 	"<tabling_pointer>").
 hlds_out__cons_id_to_string(deep_profiling_proc_static(_),
@@ -351,6 +355,10 @@
 	io__write_string("<type_ctor_info>").
 hlds_out__write_cons_id(base_typeclass_info_const(_, _, _, _)) -->
 	io__write_string("<base_typeclass_info>").
+hlds_out__write_cons_id(type_info_cell_constructor) -->
+	io__write_string("<type_info_cell_constructor>").
+hlds_out__write_cons_id(typeclass_info_cell_constructor) -->
+	io__write_string("<typeclass_info_cell_constructor>").
 hlds_out__write_cons_id(tabling_pointer_const(_, _)) -->
 	io__write_string("<tabling_pointer>").
 hlds_out__write_cons_id(deep_profiling_proc_static(_)) -->
@@ -2480,6 +2488,16 @@
 		io__write_string("), "),
 		io__write_string(Instance),
 		io__write_string(")")
+	;
+		{ ConsId = type_info_cell_constructor },
+		hlds_out__write_functor(
+			term__atom("type_info_cell_constructor"),
+			ArgVars, VarSet, AppendVarnums, next_to_graphic_token)
+	;
+		{ ConsId = typeclass_info_cell_constructor },
+		hlds_out__write_functor(
+			term__atom("typeclass_info_cell_constructor"),
+			ArgVars, VarSet, AppendVarnums, next_to_graphic_token)
 	;
 		{ ConsId = tabling_pointer_const(PredId, ProcId) },
 		io__write_string("tabling_pointer_const("),
Index: compiler/make_tags.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_tags.m,v
retrieving revision 1.40
diff -u -b -r1.40 make_tags.m
--- compiler/make_tags.m	26 May 2003 08:59:59 -0000	1.40
+++ compiler/make_tags.m	22 Jun 2003 09:08:15 -0000
@@ -108,11 +108,7 @@
 	globals__lookup_bool_option(Globals, reserve_tag, GlobalReserveTag),
 	ReserveTag = GlobalReserveTag `or` ReservedTagPragma,
 
-		% We do not bother reserving a tag for type_infos --- these
-		% types are implemented in C, and there is no way (at present)
-		% to have a type become bound to a (HAL Herbrand solver) 
-		% variable.
-	( ReserveTag = yes, \+ type_constructors_are_type_info(Ctors) ->
+	( ReserveTag = yes ->
 		InitTag = 1
 	;
 		InitTag = 0
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.230
diff -u -b -r1.230 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m	20 Jun 2003 12:45:45 -0000	1.230
+++ compiler/mercury_to_mercury.m	22 Jun 2003 08:41:46 -0000
@@ -1598,6 +1598,10 @@
 	),
 	add_format(", instance number %d (%s)>",
 		[i(InstanceNum), s(InstanceString)]).
+mercury_format_cons_id(type_info_cell_constructor, _) -->
+	add_string("<type_info_cell_constructor>").
+mercury_format_cons_id(typeclass_info_cell_constructor, _) -->
+	add_string("<typeclass_info_cell_constructor>").
 mercury_format_cons_id(tabling_pointer_const(_, _), _) -->
 	add_string("<tabling pointer>").
 mercury_format_cons_id(deep_profiling_proc_static(_), _) -->
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.238
diff -u -b -r1.238 polymorphism.m
--- compiler/polymorphism.m	29 May 2003 18:17:14 -0000	1.238
+++ compiler/polymorphism.m	22 Jun 2003 09:40:13 -0000
@@ -295,9 +295,6 @@
 :- mode convert_pred_to_lambda_goal(in, in, in, in, in, in, in, in, 
 		in, in, in, in, in, out, out, out) is det.
 
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
-
 :- implementation.
 
 :- import_module backend_libs__base_typeclass_info.
@@ -2460,8 +2457,7 @@
 
 		% build a unification to add the argvars to the
 		% base_typeclass_info
-	NewConsId = cons(qualified(mercury_private_builtin_module,
-			"typeclass_info"), 1),
+	NewConsId = typeclass_info_cell_constructor,
 	NewArgVars = [BaseVar|ArgVars],
 	TypeClassInfoTerm = functor(NewConsId, no, NewArgVars),
 
@@ -2492,9 +2488,7 @@
 		% note that we could perhaps be more accurate than
 		% `ground(shared)', but it shouldn't make any
 		% difference.
-	InstConsId = cons(qualified(mercury_private_builtin_module,
-			"typeclass_info"), 
-		NumArgVars),
+	InstConsId = cell_inst_cons_id(typeclass_info_cell, NumArgVars),
 	instmap_delta_from_assoc_list(
 		[NewVar - 
 			bound(unique, [functor(InstConsId, ArgInsts)])],
@@ -2789,7 +2783,7 @@
 			ArityGoal, ArityVar, VarTypes0, VarTypes1,
 			VarSet0, VarSet1),
 		polymorphism__init_type_info_var(Type,
-			[BaseVar, ArityVar | ArgTypeInfoVars], "type_info",
+			[BaseVar, ArityVar | ArgTypeInfoVars], type_info_cell,
 			VarSet1, VarTypes1, Var, TypeInfoGoal,
 			VarSet, VarTypes),
 		list__append([ArityGoal |  ArgTypeInfoGoals], [TypeInfoGoal],
@@ -2797,7 +2791,7 @@
 		list__append(ExtraGoals0, ExtraGoals1, ExtraGoals)
 	; ArgTypeInfoVars = [_ | _] ->
 		polymorphism__init_type_info_var(Type,
-			[BaseVar | ArgTypeInfoVars], "type_info",
+			[BaseVar | ArgTypeInfoVars], type_info_cell,
 			VarSet0, VarTypes0, Var, TypeInfoGoal,
 			VarSet, VarTypes),
 		list__append(ArgTypeInfoGoals, [TypeInfoGoal], ExtraGoals1),
@@ -2874,22 +2868,21 @@
 	% These unifications WILL lead to the creation of cells on the
 	% heap at runtime.
 
-:- pred polymorphism__init_type_info_var(type, list(prog_var), string,
-	prog_varset, map(prog_var, type), prog_var, hlds_goal, prog_varset,
-	map(prog_var, type)).
+:- pred polymorphism__init_type_info_var(type, list(prog_var),
+	polymorphism_cell, prog_varset, map(prog_var, type), prog_var,
+	hlds_goal, prog_varset, map(prog_var, type)).
 :- mode polymorphism__init_type_info_var(in, in, in, in, in, out, out, out, out)
 	is det.
 
-polymorphism__init_type_info_var(Type, ArgVars, Symbol, VarSet0, VarTypes0,
+polymorphism__init_type_info_var(Type, ArgVars, WhichCell, VarSet0, VarTypes0,
 			TypeInfoVar, TypeInfoGoal, VarSet, VarTypes) :-
-
-	PrivateBuiltin = mercury_private_builtin_module,
-	ConsId = cons(qualified(PrivateBuiltin, Symbol), 1),
+	ConsId = cell_cons_id(WhichCell),
 	TypeInfoTerm = functor(ConsId, no, ArgVars),
 
 	% introduce a new variable
-	polymorphism__new_type_info_var_raw(Type, Symbol, typeinfo_prefix,
-		VarSet0, VarTypes0, TypeInfoVar, VarSet, VarTypes),
+	polymorphism__new_type_info_var_raw(Type, cell_type_name(WhichCell),
+		typeinfo_prefix, VarSet0, VarTypes0, TypeInfoVar,
+		VarSet, VarTypes),
 
 	% create the construction unification to initialize the variable
 	UniMode = (free - ground(shared, none) ->
@@ -2912,7 +2905,7 @@
 		% note that we could perhaps be more accurate than
 		% `ground(shared)', but it shouldn't make any
 		% difference.
-	InstConsId = cons(qualified(PrivateBuiltin, Symbol), NumArgVars),
+	InstConsId = cell_inst_cons_id(WhichCell, NumArgVars),
 	instmap_delta_from_assoc_list(
 		[TypeInfoVar - bound(unique, [functor(InstConsId, ArgInsts)])],
 		InstMapDelta),
Index: compiler/prog_rep.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_rep.m,v
retrieving revision 1.19
diff -u -b -r1.19 prog_rep.m
--- compiler/prog_rep.m	20 Jun 2003 12:45:46 -0000	1.19
+++ compiler/prog_rep.m	22 Jun 2003 08:41:46 -0000
@@ -105,6 +105,10 @@
 	Rep = "$type_ctor_info_const".
 prog_rep__represent_cons_id(base_typeclass_info_const(_, _, _, _), Rep) :-
 	Rep = "$base_typeclass_info_const".
+prog_rep__represent_cons_id(type_info_cell_constructor, Rep) :-
+	Rep = "$type_info_cell_constructor".
+prog_rep__represent_cons_id(typeclass_info_cell_constructor, Rep) :-
+	Rep = "$typeclass_info_cell_constructor".
 prog_rep__represent_cons_id(tabling_pointer_const(_, _), Rep) :-
 	Rep = "$tabling_pointer_const".
 prog_rep__represent_cons_id(deep_profiling_proc_static(_), Rep) :-
Index: compiler/rl_exprn.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rl_exprn.m,v
retrieving revision 1.32
diff -u -b -r1.32 rl_exprn.m
--- compiler/rl_exprn.m	20 Jun 2003 12:45:46 -0000	1.32
+++ compiler/rl_exprn.m	22 Jun 2003 08:41:46 -0000
@@ -513,6 +513,12 @@
 rl_exprn__set_term_arg_cons_id_code(base_typeclass_info_const(_, _, _, _),
 		_, _, _, _, _, _) -->
 	{ error("rl_exprn__set_term_arg_cons_id_code") }.
+rl_exprn__set_term_arg_cons_id_code(type_info_cell_constructor,
+		_, _, _, _, _, _) -->
+	{ error("rl_exprn__set_term_arg_cons_id_code") }.
+rl_exprn__set_term_arg_cons_id_code(typeclass_info_cell_constructor,
+		_, _, _, _, _, _) -->
+	{ error("rl_exprn__set_term_arg_cons_id_code") }.
 rl_exprn__set_term_arg_cons_id_code(tabling_pointer_const(_, _),
 		_, _, _, _, _, _) -->
 	{ error("rl_exprn__set_term_arg_cons_id_code") }.
@@ -1159,6 +1165,13 @@
 	; 
 		{ ConsId = base_typeclass_info_const(_, _, _, _) },
 		{ error("rl_exprn__unify: unsupported cons_id - base_typeclass_info_const") }
+	; 
+		{ ConsId = type_info_cell_constructor },
+		% XXX for now we ignore these and hope it doesn't matter.
+		{ Code = empty }
+	; 
+		{ ConsId = typeclass_info_cell_constructor },
+		{ error("rl_exprn__unify: unsupported cons_id - typeclass_info_cell_constructor") }
 	; 
 		{ ConsId = tabling_pointer_const(_, _) },
 		{ error("rl_exprn__unify: unsupported cons_id - tabling_pointer_const") }
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.119
diff -u -b -r1.119 type_util.m
--- compiler/type_util.m	30 May 2003 14:43:45 -0000	1.119
+++ compiler/type_util.m	22 Jun 2003 11:15:55 -0000
@@ -302,8 +302,7 @@
 
 	% Check whether a type is a no_tag type
 	% (i.e. one with only one constructor, and
-	% whose one constructor has only one argument,
-	% and which is not private_builtin:type_info/1),
+	% whose one constructor has only one argument),
 	% and if so, return its constructor symbol and argument type.
 
 :- pred type_is_no_tag_type(module_info, type, sym_name, type).
@@ -311,8 +310,7 @@
 
 	% Check whether some constructors are a no_tag type
 	% (i.e. one with only one constructor, and
-	% whose one constructor has only one argument,
-	% and which is not private_builtin:type_info/1),
+	% whose one constructor has only one argument),
 	% and if so, return its constructor symbol, argument type,
 	% and the argument's name (if it has one).
 	%
@@ -511,6 +509,16 @@
 :- pred maybe_get_higher_order_arg_types(maybe(type), arity, list(maybe(type))).
 :- mode maybe_get_higher_order_arg_types(in, in, out) is det.
 
+:- type polymorphism_cell
+	--->	type_info_cell
+	;	typeclass_info_cell.
+
+:- func cell_cons_id(polymorphism_cell) = cons_id.
+
+:- func cell_inst_cons_id(polymorphism_cell, int) = cons_id.
+
+:- func cell_type_name(polymorphism_cell) = string.
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
@@ -1161,25 +1169,19 @@
 		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"
-			)
+		InstConsId = ConsId
+	;
+		ConsId0 = type_info_cell_constructor
 		->
-			list__length(Args, InstArity),
-			InstConsId = cons(Name, InstArity)
+		ConsId = type_info_cell_constructor,
+		InstConsId = cell_inst_cons_id(type_info_cell,
+			list__length(Args))
 		;
-			InstConsId = ConsId
-		)
+		ConsId0 = typeclass_info_cell_constructor
+	->
+		ConsId = typeclass_info_cell_constructor,
+		InstConsId = cell_inst_cons_id(typeclass_info_cell,
+			list__length(Args))
 	;
 		ConsId = ConsId0,
 		InstConsId = ConsId
@@ -1200,20 +1202,8 @@
 		term__apply_substitution(ArgType0, Subn, ArgType)
 	).
 
-	% The checks for type_info and type_ctor_info
-	% are needed because those types lie about their
-	% arity; it might be cleaner to change that in
-	% private_builtin.m, but that would cause some
-	% bootstrapping difficulties.
-	% It might be slightly better to check for private_builtin:type_info
-	% etc. rather than just checking the unqualified type name,
-	% but I found it difficult to verify that the constructors
-	% would always be fully module-qualified at points where
-	% type_constructors_are_no_tag_type/3 is called.
-
 type_constructors_are_no_tag_type(Ctors, Ctor, ArgType, MaybeArgName) :-
 	type_is_single_ctor_single_arg(Ctors, Ctor, MaybeArgName0, ArgType),
-	\+ ctor_is_type_info(Ctor),
 
 	% We don't handle unary tuples as no_tag types --
 	% they are rare enough that it's not worth
@@ -1895,5 +1885,26 @@
 	;
 		list__duplicate(Arity, no, MaybeTypes)
 	).
+
+%-----------------------------------------------------------------------------%
+
+cell_cons_id(type_info_cell) = type_info_cell_constructor.
+cell_cons_id(typeclass_info_cell) = typeclass_info_cell_constructor.
+
+cell_inst_cons_id(Which, Arity) = InstConsId :-
+	% Soon neither of these function symbols will exist,
+	% even with fake arity, but they do not need to.
+	(
+		Which = type_info_cell,
+		Symbol = "type_info"
+	;
+		Which = typeclass_info_cell,
+		Symbol = "typeclass_info"
+	),
+	PrivateBuiltin = mercury_private_builtin_module,
+	InstConsId = cons(qualified(PrivateBuiltin, Symbol), Arity).
+
+cell_type_name(type_info_cell) = "type_info".
+cell_type_name(typeclass_info_cell) = "typeclass_info".
 
 %-----------------------------------------------------------------------------%
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing java
cvs diff: Diffing java/library
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.121
diff -u -b -r1.121 private_builtin.m
--- library/private_builtin.m	30 May 2003 06:37:18 -0000	1.121
+++ library/private_builtin.m	23 Jun 2003 14:30:02 -0000
@@ -270,11 +270,6 @@
 	% This section of the module handles the runtime representation of
 	% type information.
 
-	% The code generated by polymorphism.m always requires
-	% the existence of a type_info functor, and requires
-	% the existence of a type_ctor_info functor as well
-	% when using --type-info {shared-,}one-or-two-cell.
-	%
 	% The actual arities of these two function symbols are variable;
 	% they depend on the number of type parameters of the type represented
 	% by the type_info, and how many predicates we associate with each
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------