[m-dev.] for review: register type_ctor_infos

Zoltan Somogyi zs at cs.mu.OZ.AU
Tue Oct 10 16:40:26 AEDT 2000


This is part 1 of a change that provides a register of all the types defined
in the program. After this change, every .c file generated by the compiler
will have three separate initialization functions:

	- One that does the initializations that must be performed before
	  any code is executed, such as recording the addresses of labels
	  in grades that don't allow direct jumps and filling in the code_addr
	  slots of type_ctor_infos.

	- One that registers the type_ctor_infos of the types defined in this
	  module in a global table.

	- One that initializes the data structures needed by the debugger;
	  i.e. registers the module layout in a global table.

For now, the first function calls the third, since this is required for
backwards compatibility of traced code; this call will go away later.

For now, the second function is not called from anywhere. Part 2 of this
change will add two functions to the _init.c file generated by c2init that
call the second function and third function respectively in each module
in the program.

This change affects only the LLDS backend; Fergus or Tyson should look into
providing this functionality for the MLDS backend as well.

This change only registers type_ctor_infos; it does not register
base_typeclass_infos. DJ and I have discussed this and agree that adding code
to register base_typeclass_infos would wasteful, because the work would almost
certainly have to be redone when constructor classes are implemented;
therefore registering base_typeclass_infos should be postponed until then.

compiler/llds_out.m:
compiler/rtti_out.m:
	Generate the code for the two new initialization functions.

runtime/mercury_wrapper.[ch]:
	Add the functions do_init_modules_{type_tables,debugger},
	which are intended to eventually invoke the corresponding
	initialization functions in the compiler-generated .c files
	through the c2init-generated _init.c file, which themselves
	are accessed through pointers in accordance with the link-order
	convention. For now, these pointers will be NULL; part 2
	will change that.

runtime/mercury_type_tables.[ch]:
	New module that provides a capability of looking up MR_TypeCtorInfos
	specified by a modulename/typename pair.

runtime/Mmakefile:
runtime/mercury_imp.h:
	Include the new header file.

runtime/mercury_tabling.[ch]:
	Allow a trie node to contain a list pointer; the type table is
	implemented as a expandable hash table whose slots are lists of
	type_ctor_infos.

runtime/mercury_dlist.[ch]:
	Make this module conform to our naming conventions. Make the type of
	list elements const, in order to avoid warnings when using lists in
	mercury_type_tables.c.

runtime/mercury_hash_table.[ch]:
	Minor changes to conform to the new names in mercury_dlist.[ch].

runtime/*.[ch]:
	Fix indentation problems caused by past automatic substitutions.

Zoltan.

cvs diff: Diffing .
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/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.157
diff -u -r1.157 llds_out.m
--- compiler/llds_out.m	2000/10/03 00:34:15	1.157
+++ compiler/llds_out.m	2000/10/07 18:19:35
@@ -398,7 +398,7 @@
 		output_init_comment(ModuleName),
 		output_c_file_mercury_headers,
 		io__write_string("\n"),
-		output_c_data_init_list_decls(Datas),
+		output_debugger_init_list_decls(Datas),
 		io__write_string("\n"),
 		output_c_module_init_list(ModuleName, Modules, Datas,
 			StackLayoutLabels),
@@ -541,17 +541,27 @@
 		io__write_string("#endif\n\n")
 	),
 
+	io__write_string("/* suppress gcc -Wmissing-decls warnings */\n"),
 	io__write_string("void "),
 	output_init_name(ModuleName),
-	io__write_string("(void);"),
-	io__write_string("/* suppress gcc -Wmissing-decls warning */\n"),
+	io__write_string("(void);\n"),
 	io__write_string("void "),
 	output_init_name(ModuleName),
+	io__write_string("_type_tables(void);\n"),
+	io__write_string("void "),
+	output_init_name(ModuleName),
+	io__write_string("_debugger(void);\n"),
+	io__write_string("\n"),
+
+	io__write_string("void "),
+	output_init_name(ModuleName),
 	io__write_string("(void)\n"),
 	io__write_string("{\n"),
 	io__write_string("\tstatic bool done = FALSE;\n"),
-	io__write_string("\tif (!done) {\n"),
-	io__write_string("\t\tdone = TRUE;\n"),
+	io__write_string("\tif (done) {\n"),
+	io__write_string("\t\treturn;\n"),
+	io__write_string("\t}\n"),
+	io__write_string("\tdone = TRUE;\n"),
 
 	output_init_bunch_calls(AlwaysInitModuleBunches, ModuleName,
 		"always", 0),
@@ -566,8 +576,40 @@
 	),
 
 	output_c_data_init_list(Datas),
+		% The call to the debugger initialization function
+		% is for bootstrapping; once the debugger has been modified
+		% to call do_init_modules_debugger() and all debuggable
+		% object files created before this change have been
+		% overwritten, it can be deleted.
+	io__write_string("\t"),
+	output_init_name(ModuleName),
+	io__write_string("_debugger();\n"),
+	io__write_string("}\n\n"),
+
+	io__write_string("void "),
+	output_init_name(ModuleName),
+	io__write_string("_type_tables(void)\n"),
+	io__write_string("{\n"),
+	io__write_string("\tstatic bool done = FALSE;\n"),
+	io__write_string("\tif (done) {\n"),
+	io__write_string("\t\treturn;\n"),
+	io__write_string("\t}\n"),
+	io__write_string("\tdone = TRUE;\n"),
+	output_type_tables_init_list(Datas),
+	io__write_string("}\n\n"),
+
+	io__write_string("void "),
+	output_init_name(ModuleName),
+	io__write_string("_debugger(void)\n"),
+	io__write_string("{\n"),
+	io__write_string("\tstatic bool done = FALSE;\n"),
+	io__write_string("\tif (done) {\n"),
+	io__write_string("\t\treturn;\n"),
 	io__write_string("\t}\n"),
+	io__write_string("\tdone = TRUE;\n"),
+	output_debugger_init_list(Datas),
 	io__write_string("}\n\n"),
+
 	io__write_string(
 		"/* ensure everything is compiled with the same grade */\n"),
 	io__write_string(
@@ -634,13 +676,44 @@
 	{ NextSeq is Seq + 1 },
 	output_init_bunch_calls(Bunches, ModuleName, InitStatus, NextSeq).
 
+	% Output MR_INIT_TYPE_CTOR_INFO(TypeCtorInfo, TypeId);
+	% for each type_ctor_info defined in this module.
+
+:- pred output_c_data_init_list(list(comp_gen_c_data)::in,
+	io__state::di, io__state::uo) is det.
+
+output_c_data_init_list([]) --> [].
+output_c_data_init_list([Data | Datas]) -->
+	( { Data = rtti_data(RttiData) } ->
+		rtti_out__init_rtti_data_if_nec(RttiData)
+	;
+		[]
+	),
+	output_c_data_init_list(Datas).
+
+	% Output code to register each type_ctor_info defined in this module.
+
+:- pred output_type_tables_init_list(list(comp_gen_c_data)::in,
+	io__state::di, io__state::uo) is det.
+
+output_type_tables_init_list([]) --> [].
+output_type_tables_init_list([Data | Datas]) -->
+	(
+		{ Data = rtti_data(RttiData) }
+	->
+		rtti_out__register_rtti_data_if_nec(RttiData)
+	;
+		[]
+	),
+	output_type_tables_init_list(Datas).
+
 	% Output declarations for each module layout defined in this module
 	% (there should only be one, of course).
-:- pred output_c_data_init_list_decls(list(comp_gen_c_data)::in,
+:- pred output_debugger_init_list_decls(list(comp_gen_c_data)::in,
 	io__state::di, io__state::uo) is det.
 
-output_c_data_init_list_decls([]) --> [].
-output_c_data_init_list_decls([Data | Datas]) -->
+output_debugger_init_list_decls([]) --> [].
+output_debugger_init_list_decls([Data | Datas]) -->
 	(
 		{ Data = comp_gen_c_data(ModuleName, DataName, _, _, _, _) },
 		{ DataName = module_layout }
@@ -651,24 +724,18 @@
 	;
 		[]
 	),
-	output_c_data_init_list_decls(Datas).
+	output_debugger_init_list_decls(Datas).
 
-	% Output MR_INIT_TYPE_CTOR_INFO(TypeCtorInfo, TypeId);
-	% for each type_ctor_info defined in this module.
-	% Also output calls to MR_register_module_layout()
+	% Output calls to MR_register_module_layout()
 	% for each module layout defined in this module
 	% (there should only be one, of course).
 
-:- pred output_c_data_init_list(list(comp_gen_c_data)::in,
+:- pred output_debugger_init_list(list(comp_gen_c_data)::in,
 	io__state::di, io__state::uo) is det.
 
-output_c_data_init_list([]) --> [].
-output_c_data_init_list([Data | Datas]) -->
+output_debugger_init_list([]) --> [].
+output_debugger_init_list([Data | Datas]) -->
 	(
-		{ Data = rtti_data(RttiData) }
-	->
-		rtti_out__init_rtti_data_if_nec(RttiData)
-	;
 		{ Data = comp_gen_c_data(ModuleName, DataName, _, _, _, _) },
 		{ DataName = module_layout }
 	->
@@ -680,7 +747,7 @@
 	;
 		[]
 	),
-	output_c_data_init_list(Datas).
+	output_debugger_init_list(Datas).
 
 	% Output a comment to tell mkinit what functions to
 	% call from <module>_init.c.
Index: compiler/rtti_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_out.m,v
retrieving revision 1.12
diff -u -r1.12 rtti_out.m
--- compiler/rtti_out.m	2000/07/12 13:54:39	1.12
+++ compiler/rtti_out.m	2000/10/10 03:46:24
@@ -32,32 +32,38 @@
 :- pred output_addr_of_rtti_data(rtti_data::in, io__state::di, io__state::uo)
 	is det.
 
-	% output a C declaration for the rtti_data
+	% Output a C declaration for the rtti_data.
 :- pred output_rtti_data_decl(rtti_data::in, decl_set::in, decl_set::out,
 	io__state::di, io__state::uo) is det.
 
-	% output a C definition for the rtti_data
+	% Output a C definition for the rtti_data.
 :- pred output_rtti_data_defn(rtti_data::in, decl_set::in, decl_set::out,
 	io__state::di, io__state::uo) is det.
 
-	% output C code (e.g. a call to the MR_INIT_TYPE_CTOR_INFO() macro)
+	% Output C code (e.g. a call to the MR_INIT_TYPE_CTOR_INFO() macro)
 	% to initialize the rtti_data if necessary.
 :- pred rtti_out__init_rtti_data_if_nec(rtti_data::in,
 	io__state::di, io__state::uo) is det.
 
-	% output the C name of the rtti_data specified by the given
+	% Output C code (e.g. a call to MR_register_type_ctor_info())
+	% to register the rtti_data in the type tables, if it represents a data
+	% structure that should be so registered.
+:- pred rtti_out__register_rtti_data_if_nec(rtti_data::in,
+	io__state::di, io__state::uo) is det.
+
+	% Output the C name of the rtti_data specified by the given
 	% rtti_type_id and rtti_name.
 :- pred output_rtti_addr(rtti_type_id::in, rtti_name::in,
 	io__state::di, io__state::uo) is det.
 
-	% output the C storage class, C type, and C name of the rtti_data 
+	% Output the C storage class, C type, and C name of the rtti_data 
 	% specified by the given rtti_type_id and rtti_name,
 	% for use in a declaration or definition.
 	% The bool should be `yes' iff it is for a definition.
 :- pred output_rtti_addr_storage_type_name(rtti_type_id::in, rtti_name::in,
 	bool::in, io__state::di, io__state::uo) is det.
 
-	% the same as output_rtti_addr_storage_type_name,
+	% The same as output_rtti_addr_storage_type_name,
 	% but for a base_typeclass_info.
 :- pred output_base_typeclass_info_storage_type_name(class_id::in, string::in,
 		bool::in, io__state::di, io__state::uo) is det.
@@ -639,9 +645,9 @@
 		{ Data = type_ctor_info(RttiTypeId,
 			_,_,_,_,_,_,_,_,_,_,_,_) }
 	->
-		io__write_string("\t\tMR_INIT_TYPE_CTOR_INFO(\n\t\t"),
+		io__write_string("\tMR_INIT_TYPE_CTOR_INFO(\n\t\t"),
 		output_rtti_addr(RttiTypeId, type_ctor_info),
-		io__write_string(",\n\t\t\t"),
+		io__write_string(",\n\t\t"),
 		{ RttiTypeId = rtti_type_id(ModuleName, TypeName, Arity) },
 		{ llds_out__sym_name_mangle(ModuleName, ModuleNameString) },
 		{ string__append(ModuleNameString, "__", UnderscoresModule) },
@@ -671,6 +677,32 @@
 		output_init_method_pointers(FirstFieldNum, CodeAddrs,
 			ClassName, ClassArity),
 		io__write_string("#endif /* MR_STATIC_CODE_ADDRESSES */\n")
+	;
+		[]
+	).
+
+rtti_out__register_rtti_data_if_nec(Data) -->
+	(
+		{ Data = type_ctor_info(RttiTypeId,
+			_,_,_,_,_,_,_,_,_,_,_,_) }
+	->
+		io__write_string("\tMR_register_type_ctor_info(\n\t\t&"),
+		output_rtti_addr(RttiTypeId, type_ctor_info),
+		io__write_string(");\n")
+	;
+		{ Data = base_typeclass_info(ClassId, InstanceString,
+			_BaseTypeClassInfo) }
+	->
+		% XXX Registering base_typeclass_infos by themselves is not
+		% enough. A base_typeclass_info doesn't say which types it
+		% declares to be members of which typeclass, and for now
+		% we don't even have any data structures in the runtime system
+		% to describe such membership information.
+		%
+		% io__write_string("\tMR_register_base_typeclass_info(\n\t\t&"),
+		% output_base_typeclass_info_storage_type_name(ClassId,
+		% 	InstanceString, no),
+		% io__write_string(");\n")
 	;
 		[]
 	).
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
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/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
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/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/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
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 library
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/Mmakefile,v
retrieving revision 1.62
diff -u -r1.62 Mmakefile
--- runtime/Mmakefile	2000/08/17 05:31:09	1.62
+++ runtime/Mmakefile	2000/10/07 18:24:08
@@ -84,6 +84,7 @@
 			mercury_trail.h		\
 			mercury_types.h		\
 			mercury_type_info.h	\
+			mercury_type_tables.h	\
 			mercury_wrapper.h	\
 			$(LIB_DLL_H)
 
@@ -149,6 +150,7 @@
 			mercury_trace_base.c	\
 			mercury_trail.c 	\
 			mercury_type_info.c	\
+			mercury_type_tables.c	\
 			mercury_wrapper.c
 
 OBJS		= $(CFILES:.c=.$O)
Index: runtime/mercury_dlist.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_dlist.c,v
retrieving revision 1.4
diff -u -r1.4 mercury_dlist.c
--- runtime/mercury_dlist.c	1999/10/18 22:00:18	1.4
+++ runtime/mercury_dlist.c	2000/10/08 22:13:50
@@ -17,15 +17,15 @@
 **	Make an empty list.
 */
 
-List *
-makelist0(void)
+MR_Dlist *
+MR_dlist_makelist0(void)
 {
-	reg	List	*list;
+	reg	MR_Dlist	*list;
 
-	list = MR_GC_NEW(List);
-	ldata(list) = NULL;
-	next(list) = list;
-	prev(list) = list;
+	list = MR_GC_NEW(MR_Dlist);
+	MR_dlist_data(list) = NULL;
+	MR_dlist_next(list) = list;
+	MR_dlist_prev(list) = list;
 	
 	return list;
 }
@@ -34,14 +34,14 @@
 **	Make a list with the argument is its only element.
 */
 
-List *
-list_makelist(void * data)
+MR_Dlist *
+MR_dlist_makelist(const void *data)
 {
-	reg	List	*list;
+	reg	MR_Dlist	*list;
 
 	MR_assert(data != NULL);
-	list = makelist0();
-	addhead(list, data);
+	list = MR_dlist_makelist0();
+	MR_dlist_addhead(list, data);
 	return list;
 }
 
@@ -49,25 +49,25 @@
 **	Add some data to the head of a list.
 */
 
-List *
-list_addhead(List *list, void *data)
+MR_Dlist *
+MR_dlist_addhead(MR_Dlist *list, const void *data)
 {
-	reg	List	*item;
+	reg	MR_Dlist	*item;
 
 	if (list == NULL) {
-		list = makelist0();
+		list = MR_dlist_makelist0();
 	}
 
-	item = MR_GC_NEW(List);
-	ldata(item) = data;
-	llength(list)++;
+	item = MR_GC_NEW(MR_Dlist);
+	MR_dlist_data(item) = data;
+	MR_dlist_length(list)++;
 
 	/* item's pointers	*/
-	next(item) = next(list);
-	prev(item) = list;
+	MR_dlist_next(item) = MR_dlist_next(list);
+	MR_dlist_prev(item) = list;
 	/* neighbours' pointers	*/
-	next(prev(item)) = item;
-	prev(next(item)) = item;
+	MR_dlist_next(MR_dlist_prev(item)) = item;
+	MR_dlist_prev(MR_dlist_next(item)) = item;
 
 	return list;
 }
@@ -76,25 +76,25 @@
 **	Add some data to the tail of a list.
 */
 
-List *
-list_addtail(List *list, void *data)
+MR_Dlist *
+MR_dlist_addtail(MR_Dlist *list, const void *data)
 {
-	reg	List	*item;
+	reg	MR_Dlist	*item;
 
 	if (list == NULL) {
-		list = makelist0();
+		list = MR_dlist_makelist0();
 	}
 
-	item = MR_GC_NEW(List);
-	ldata(item) = data;
-	llength(list)++;
+	item = MR_GC_NEW(MR_Dlist);
+	MR_dlist_data(item) = data;
+	MR_dlist_length(list)++;
 
 	/* item's pointers	*/
-	next(item) = list;
-	prev(item) = prev(list);
+	MR_dlist_next(item) = list;
+	MR_dlist_prev(item) = MR_dlist_prev(list);
 	/* neighbours' pointers	*/
-	next(prev(item)) = item;
-	prev(next(item)) = item;
+	MR_dlist_next(MR_dlist_prev(item)) = item;
+	MR_dlist_prev(MR_dlist_next(item)) = item;
 
 	return list;
 }
@@ -104,34 +104,37 @@
 **	list2 is not meaningful after the operation, it is freed.
 */
 
-List *
-addlist(List *list1, List *list2)
+MR_Dlist *
+MR_dlist_addlist(MR_Dlist *list1, MR_Dlist *list2)
 {
 	if (list1 == NULL) {
-		list1 = makelist0();
+		list1 = MR_dlist_makelist0();
 	}
 
 	if (list2 == NULL) {
-		list2 = makelist0();
+		list2 = MR_dlist_makelist0();
 	}
 
-	if (llength(list2) > 0) {
-		if (llength(list1) == 0) {
-			ldata(list1) = ldata(list2);
+	if (MR_dlist_length(list2) > 0) {
+		if (MR_dlist_length(list1) == 0) {
+			MR_dlist_data(list1) = MR_dlist_data(list2);
 			/* pointers from header	*/
-			next(list1) = next(list2);
-			prev(list1) = prev(list2);
+			MR_dlist_next(list1) = MR_dlist_next(list2);
+			MR_dlist_prev(list1) = MR_dlist_prev(list2);
 			/* pointers to header	*/
-			prev(next(list1)) = list1;
-			next(prev(list1)) = list1;
+			MR_dlist_prev(MR_dlist_next(list1)) = list1;
+			MR_dlist_next(MR_dlist_prev(list1)) = list1;
 		} else {
-			llength(list1) = llength(list1) + llength(list2);
+			MR_dlist_length(list1) = MR_dlist_length(list1)
+					+ MR_dlist_length(list2);
 			/* end of list 1 to start of list 2	*/
-			next(prev(list1)) = next(list2);
-			prev(next(list2)) = prev(list1);
+			MR_dlist_next(MR_dlist_prev(list1)) =
+					MR_dlist_next(list2);
+			MR_dlist_prev(MR_dlist_next(list2)) =
+					MR_dlist_prev(list1);
 			/* end of list 2 to start of list 1	*/
-			next(prev(list2)) = list1;
-			prev(list1) = prev(list2);
+			MR_dlist_next(MR_dlist_prev(list2)) = list1;
+			MR_dlist_prev(list1) = MR_dlist_prev(list2);
 		}
 	}
 
@@ -145,21 +148,21 @@
 **	but only the data pointers of the second are used.
 */
 
-List *
-addndlist(List *list1, List *list2)
+MR_Dlist *
+MR_dlist_addndlist(MR_Dlist *list1, MR_Dlist *list2)
 {
-	reg	List	*ptr;
+	reg	MR_Dlist	*ptr;
 
 	if (list1 == NULL) {
-		list1 = makelist0();
+		list1 = MR_dlist_makelist0();
 	}
 
 	if (list2 == NULL) {
-		list2 = makelist0();
+		list2 = MR_dlist_makelist0();
 	}
 
-	for_list (ptr, list2) {
-		addtail(list1, ldata(ptr));
+	MR_for_dlist (ptr, list2) {
+		MR_dlist_addtail(list1, MR_dlist_data(ptr));
 	}
 
 	return list1;
@@ -170,20 +173,20 @@
 */
 
 void 
-list_insert_before(List *list, List *where, void *data)
+MR_dlist_insert_before(MR_Dlist *list, MR_Dlist *where, const void *data)
 {
-	reg	List	*item;
+	reg	MR_Dlist	*item;
 
-	item = MR_GC_NEW(List);
-	ldata(item) = data;
-	llength(list)++;
+	item = MR_GC_NEW(MR_Dlist);
+	MR_dlist_data(item) = data;
+	MR_dlist_length(list)++;
 
 	/* item's pointers */
-	next(item) = where;
-	prev(item) = prev(where);
+	MR_dlist_next(item) = where;
+	MR_dlist_prev(item) = MR_dlist_prev(where);
 	/* neighbour's pointers */
-	next(prev(item)) = item;
-	prev(next(item)) = item;
+	MR_dlist_next(MR_dlist_prev(item)) = item;
+	MR_dlist_prev(MR_dlist_next(item)) = item;
 }
 
 /*
@@ -191,20 +194,20 @@
 */
 
 void 
-list_insert_after(List *list, List *where, void *data)
+MR_dlist_insert_after(MR_Dlist *list, MR_Dlist *where, const void *data)
 {
-	reg	List	*item;
+	reg	MR_Dlist	*item;
 
-	item = MR_GC_NEW(List);
-	ldata(item) = data;
-	llength(list)++;
+	item = MR_GC_NEW(MR_Dlist);
+	MR_dlist_data(item) = data;
+	MR_dlist_length(list)++;
 
 	/* item's pointers */
-	next(item) = next(where);
-	prev(item) = where;
+	MR_dlist_next(item) = MR_dlist_next(where);
+	MR_dlist_prev(item) = where;
 	/* neighbour's pointers */
-	next(prev(item)) = item;
-	prev(next(item)) = item;
+	MR_dlist_next(MR_dlist_prev(item)) = item;
+	MR_dlist_prev(MR_dlist_next(item)) = item;
 
 	return;
 }
@@ -214,13 +217,13 @@
 */
 
 int 
-length(const List *list)
+MR_dlist_maybe_null_length(const MR_Dlist *list)
 {
 	if (list == NULL) {
 		return 0;
 	}
 
-	return llength(list);
+	return MR_dlist_length(list);
 }
 
 /*
@@ -229,7 +232,7 @@
 */
 
 void 
-dlist_delete(List *list, List *item, void (* func)(void *))
+MR_dlist_delete(MR_Dlist *list, MR_Dlist *item, void (* func)(const void *))
 {
 	if (list == NULL) {
 		return;
@@ -240,12 +243,12 @@
 	}
 
 	if (func != NULL) {
-		func(ldata(item));
+		func(MR_dlist_data(item));
 	}
 
-	llength(list)--;
-	next(prev(item)) = next(item);
-	prev(next(item)) = prev(item);
+	MR_dlist_length(list)--;
+	MR_dlist_next(MR_dlist_prev(item)) = MR_dlist_next(item);
+	MR_dlist_prev(MR_dlist_next(item)) = MR_dlist_prev(item);
 
 	MR_GC_free(item);
 
@@ -259,22 +262,22 @@
 */
 
 void 
-oldlist(List *list, void (* func)(void *))
+MR_dlist_oldlist(MR_Dlist *list, void (* func)(const void *))
 {
-	reg	List	*ptr;
-	reg	List	*item;
+	reg	MR_Dlist	*ptr;
+	reg	MR_Dlist	*item;
 
 	if (list == NULL) {
 		return;
 	}
 
-	ptr = next(list);
+	ptr = MR_dlist_next(list);
 	while (ptr != list) {
 		item = ptr;
-		ptr = next(ptr);
+		ptr = MR_dlist_next(ptr);
 
 		if (func != NULL) {
-			func(ldata(item));
+			func(MR_dlist_data(item));
 		}
  
 		MR_GC_free(item);
Index: runtime/mercury_dlist.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_dlist.h,v
retrieving revision 1.2
diff -u -r1.2 mercury_dlist.h
--- runtime/mercury_dlist.h	1997/11/23 07:21:18	1.2
+++ runtime/mercury_dlist.h	2000/10/08 22:13:27
@@ -1,5 +1,5 @@
 /*
-** Copyright (C) 1995-1997 The University of Melbourne.
+** Copyright (C) 1995-1997,2000 The University of Melbourne.
 ** This file may only be copied under the terms of the GNU Library General
 ** Public License - see the file COPYING.LIB in the Mercury distribution.
 */
@@ -17,55 +17,70 @@
 ** in the header node.
 */
 
-typedef	struct	s_list {
+typedef	struct	MR_Dlist_Struct MR_Dlist;
+
+struct	MR_Dlist_Struct {
 	union {
-		void 	*l_data;
-		int	l_length;
-	} l_union;
-	struct	s_list	*l_prev;
-	struct	s_list	*l_next;
-} List;
-
-#define	next(ptr)		(ptr)->l_next
-#define	prev(ptr)		(ptr)->l_prev
-#define	ldata(ptr)		(ptr)->l_union.l_data
-#define	llength(list)		((list)->l_union.l_length)
-#define	first_ptr(list)		((list)->l_next)
-#define	last_ptr(list)		((list)->l_prev)
-#define	first(list)		((list)->l_next->l_union.l_data)
-#define	last(list)		((list)->l_prev->l_union.l_data)
-
-#define	makelist(d)		list_makelist(d)
-#define	addhead(l, d)		list_addhead(l, d)
-#define	addtail(l, d)		list_addtail(l, d)
-#define	insert_before(l, w, d)	list_insert_before(l, w, d)
-#define	insert_after(l, w, d)	list_insert_after(l, w, d)
-
-#define	for_list(p, l) \
-	for (p = (l? next(l): NULL); p != l && p != NULL; p = next(p))
-#define	for_2list(p1, p2, l1, l2) \
-	for (	\
-		p1 = (l1? next(l1): NULL), p2 = (l2? next(l2): NULL); \
-		p1 != l1 && p1 != NULL && p2 != l2 && p2 != NULL; \
-		p1 = next(p1), p2 = next(p2) \
+		const void 	*MR_dlist_data;
+		int		MR_dlist_length;
+	} MR_dlist_union;
+	MR_Dlist	*MR_dlist_prev;
+	MR_Dlist	*MR_dlist_next;
+};
+
+#define	MR_dlist_next(ptr)		(ptr)->MR_dlist_next
+#define	MR_dlist_prev(ptr)		(ptr)->MR_dlist_prev
+#define	MR_dlist_data(ptr)		(ptr)->MR_dlist_union.MR_dlist_data
+#define	MR_dlist_length(list)		((list)->MR_dlist_union.MR_dlist_length)
+#define	MR_dlist_first_ptr(list)	((list)->MR_dlist_next)
+#define	MR_dlist_last_ptr(list)		((list)->MR_dlist_prev)
+#define	MR_dlist_first(list)		((list)->MR_dlist_next->	\
+						MR_dlist_union.MR_dlist_data)
+#define	MR_dlist_last(list)		((list)->MR_dlist_prev->	\
+						MR_dlist_union.MR_dlist_data)
+
+#define	MR_dlist_makelist(d)		MR_dlist_makelist(d)
+#define	MR_dlist_addhead(l, d)		MR_dlist_addhead(l, d)
+#define	MR_dlist_addtail(l, d)		MR_dlist_addtail(l, d)
+#define	MR_dlist_insert_before(l, w, d)	MR_dlist_insert_before(l, w, d)
+#define	MR_dlist_insert_after(l, w, d)	MR_dlist_insert_after(l, w, d)
+
+#define	MR_for_dlist(p, l) 						\
+	for (								\
+		p = (l? MR_dlist_next(l): NULL);			\
+		p != l && p != NULL;					\
+		p = MR_dlist_next(p)					\
+	)
+#define	MR_for_2dlist(p1, p2, l1, l2)					\
+	for (								\
+		p1 = (l1? MR_dlist_next(l1): NULL),			\
+			p2 = (l2? MR_dlist_next(l2): NULL);		\
+		p1 != l1 && p1 != NULL && p2 != l2 && p2 != NULL;	\
+		p1 = MR_dlist_next(p1), p2 = MR_dlist_next(p2)		\
+	)
+#define MR_for_undlist(p, np, l)					\
+	for (								\
+		p = (l? MR_dlist_next(l): NULL),			\
+			np = (p? MR_dlist_next(p): NULL);		\
+		p != l && p != NULL;					\
+		p = np, np = (p? MR_dlist_next(p): NULL)		\
 	)
-#define for_unlist(p, np, l) \
-	for (p = (l? next(l): NULL), np = (p? next(p): NULL); \
-		p != l && p != NULL; \
-		p = np, np = (p? next(p): NULL))
-#define	end_list(p, l)\
+#define	MR_end_dlist(p, l)						\
 	(p == l || p == NULL)
 
-extern	List	*makelist0(void);
-extern	List	*list_makelist(void *);
-extern	List	*list_addhead(List *, void *);
-extern	List	*list_addtail(List *, void *);
-extern	List	*addlist(List *, List *);
-extern	List	*addndlist(List *, List *);
-extern	void	list_insert_before(List *, List *, void *);
-extern	void	list_insert_after(List *, List *, void *);
-extern	int	length(const List *);
-extern	void	dlist_delete(List *, List *, void (*)(void *));
-extern	void	oldlist(List *, void (*)(void *));
+extern	MR_Dlist	*MR_dlist_makelist0(void);
+extern	MR_Dlist	*MR_dlist_makelist(const void *);
+extern	MR_Dlist	*MR_dlist_addhead(MR_Dlist *, const void *);
+extern	MR_Dlist	*MR_dlist_addtail(MR_Dlist *, const void *);
+extern	MR_Dlist	*MR_dlist_addlist(MR_Dlist *, MR_Dlist *);
+extern	MR_Dlist	*MR_dlist_addndlist(MR_Dlist *, MR_Dlist *);
+extern	void		MR_dlist_insert_before(MR_Dlist *, MR_Dlist *,
+				const void *);
+extern	void		MR_dlist_insert_after(MR_Dlist *, MR_Dlist *,
+				const void *);
+extern	int		MR_dlist_maybe_null_length(const MR_Dlist *);
+extern	void		MR_dlist_delete(MR_Dlist *, MR_Dlist *,
+				void (*)(const void *));
+extern	void		MR_dlist_oldlist(MR_Dlist *, void (*)(const void *));
 
 #endif /* not MERCURY_DLIST_H */
Index: runtime/mercury_hash_table.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_hash_table.c,v
retrieving revision 1.2
diff -u -r1.2 mercury_hash_table.c
--- runtime/mercury_hash_table.c	1999/10/18 15:46:54	1.2
+++ runtime/mercury_hash_table.c	2000/10/08 22:14:37
@@ -29,7 +29,7 @@
 {
 	reg	int	i;
 
-	table->MR_ht_store = MR_GC_NEW_ARRAY(List *, table->MR_ht_size);
+	table->MR_ht_store = MR_GC_NEW_ARRAY(MR_Dlist *, table->MR_ht_size);
 
 	for (i = 0; i < table->MR_ht_size; i++) {
 		table->MR_ht_store[i] = NULL;
@@ -41,11 +41,11 @@
 **	in a table.
 */
 
-void *
+const void *
 MR_ht_lookup_table(const MR_Hash_Table *table, const void *key)
 {
-	reg	List	*ptr;
-	reg	int	h;
+	reg	MR_Dlist	*ptr;
+	reg	int		h;
 
 	h = MR_tablehash(table)(key);
 
@@ -57,9 +57,11 @@
 	}
 #endif
 
-	for_list (ptr, table->MR_ht_store[h]) {
-		if (MR_tableequal(table)(key, MR_tablekey(table)(ldata(ptr)))) {
-			return ldata(ptr);
+	MR_for_dlist (ptr, table->MR_ht_store[h]) {
+		if (MR_tableequal(table)(key,
+				MR_tablekey(table)(MR_dlist_data(ptr))))
+		{
+			return MR_dlist_data(ptr);
 		}
 	}
 
@@ -74,7 +76,7 @@
 bool 
 MR_ht_insert_table(const MR_Hash_Table *table, void *entry)
 {
-	reg	List		*ptr;
+	reg	MR_Dlist	*ptr;
 	reg	const void	*key;
 	reg	int		h;
 
@@ -89,13 +91,15 @@
 	}
 #endif
 
-	for_list (ptr, table->MR_ht_store[h]) {
-		if (MR_tableequal(table)(key, MR_tablekey(table)(ldata(ptr)))) {
+	MR_for_dlist (ptr, table->MR_ht_store[h]) {
+		if (MR_tableequal(table)(key,
+				MR_tablekey(table)(MR_dlist_data(ptr))))
+		{
 			return TRUE;
 		}
 	}
 
-	table->MR_ht_store[h] = addhead(table->MR_ht_store[h], entry);
+	table->MR_ht_store[h] = MR_dlist_addhead(table->MR_ht_store[h], entry);
 	return FALSE;
 }
 
@@ -103,15 +107,15 @@
 **	Return all table entries in a list.
 */
 
-List *
+MR_Dlist *
 MR_ht_get_all_entries(const MR_Hash_Table *table)
 {
-	reg	List	*list;
-	reg	int	i;
+	reg	MR_Dlist	*list;
+	reg	int		i;
 
-	list = makelist0();
+	list = MR_dlist_makelist0();
 	for (i = 0; i < table->MR_ht_size; i++) {
-		addndlist(list, table->MR_ht_store[i]);
+		MR_dlist_addndlist(list, table->MR_ht_store[i]);
 	}
 
 	return list;
@@ -124,12 +128,12 @@
 void
 MR_ht_process_all_entries(const MR_Hash_Table *table, void f(const void *))
 {
-	reg	List	*ptr;
-	reg	int	i;
+	reg	MR_Dlist	*ptr;
+	reg	int		i;
 
 	for (i = 0; i < table->MR_ht_size; i++) {
-		for_list (ptr, table->MR_ht_store[i]) {
-			f(ldata(ptr));
+		MR_for_dlist (ptr, table->MR_ht_store[i]) {
+			f(MR_dlist_data(ptr));
 		}
 	}
 }
Index: runtime/mercury_hash_table.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_hash_table.h,v
retrieving revision 1.1
diff -u -r1.1 mercury_hash_table.h
--- runtime/mercury_hash_table.h	1998/09/15 07:19:20	1.1
+++ runtime/mercury_hash_table.h	2000/10/08 22:14:55
@@ -17,11 +17,11 @@
 #define	MERCURY_HASH_TABLE_H
 
 #include "mercury_std.h"	/* for bool */
-#include "mercury_dlist.h"	/* for List */
+#include "mercury_dlist.h"	/* for MR_Dlist */
 
 typedef	struct {
 	int		MR_ht_size;
-	List		**MR_ht_store;
+	MR_Dlist	**MR_ht_store;
 	const void	*(*MR_ht_key)(const void *); /* applied to entries */
 	int		(*MR_ht_hash)(const void *); /* applied to keys */
 	bool		(*MR_ht_equal)(const void *, const void *);
@@ -39,12 +39,13 @@
 #define	MR_tablehash(table)		(*(table->MR_ht_hash))
 #define	MR_tableequal(table)		(*(table->MR_ht_equal))
 
-extern	void	MR_ht_init_table(MR_Hash_Table *);
-extern	void	*MR_ht_lookup_table(const MR_Hash_Table *, const void *);
-extern	bool	MR_ht_insert_table(const MR_Hash_Table *, void *);
-extern	List	*MR_ht_get_all_entries(const MR_Hash_Table *);
-extern	void	MR_ht_process_all_entries(const MR_Hash_Table *,
-			void f(const void *));
-extern	int	MR_ht_str_to_int(const char *);
+extern	void		MR_ht_init_table(MR_Hash_Table *);
+extern	const void	*MR_ht_lookup_table(const MR_Hash_Table *,
+				const void *);
+extern	bool		MR_ht_insert_table(const MR_Hash_Table *, void *);
+extern	MR_Dlist	*MR_ht_get_all_entries(const MR_Hash_Table *);
+extern	void		MR_ht_process_all_entries(const MR_Hash_Table *,
+				void f(const void *));
+extern	int		MR_ht_str_to_int(const char *);
 
 #endif /* not MERCURY_HASH_TABLE_H */
Index: runtime/mercury_imp.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_imp.h,v
retrieving revision 1.17
diff -u -r1.17 mercury_imp.h
--- runtime/mercury_imp.h	2000/08/11 16:50:21	1.17
+++ runtime/mercury_imp.h	2000/10/07 14:48:21
@@ -71,6 +71,7 @@
 #include	"mercury_context.h"
 #include	"mercury_thread.h"
 #include	"mercury_type_info.h"
+#include	"mercury_type_tables.h"
 #ifdef MR_USE_TRAIL
 #include	"mercury_trail.h"
 #endif
Index: runtime/mercury_tabling.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.c,v
retrieving revision 1.28
diff -u -r1.28 mercury_tabling.c
--- runtime/mercury_tabling.c	2000/09/18 11:52:33	1.28
+++ runtime/mercury_tabling.c	2000/10/08 22:08:16
@@ -33,19 +33,19 @@
 struct MR_IntHashTableSlot_Struct {
 	MR_IntHashTableSlot	*next;
 	MR_TableNode		data;
-	MR_Integer			key;
+	MR_Integer		key;
 };
 
 struct MR_FloatHashTableSlot_Struct {
 	MR_FloatHashTableSlot	*next;
 	MR_TableNode		data;
-	MR_Float			key;
+	MR_Float		key;
 };
 
 struct MR_StringHashTableSlot_Struct {
 	MR_StringHashTableSlot	*next;
 	MR_TableNode		data;
-	MR_String			key;
+	MR_ConstString		key;
 };
 
 typedef	union {
@@ -103,12 +103,12 @@
 */
 
 struct MR_HashTable_Struct {
-	MR_Integer			size;
-	MR_Integer			threshold;
-	MR_Integer			value_count;
+	MR_Integer		size;
+	MR_Integer		threshold;
+	MR_Integer		value_count;
 	MR_HashTableSlotPtr	*hash_table;
 	MR_HashTableSlotPtr	freespace;
-	MR_Integer			freeleft;
+	MR_Integer		freeleft;
 	MR_AllocRecord		*allocrecord;
 };
 
@@ -287,8 +287,8 @@
 #define	MR_GENERIC_HASH_LOOKUP_OR_ADD					      \
 	MR_HashTable	*table;						      \
 	table_type	*slot;						      \
-	MR_Integer		abs_hash;					      \
-	MR_Integer		home;						      \
+	MR_Integer	abs_hash;					      \
+	MR_Integer	home;						      \
 	DECLARE_PROBE_COUNT						      \
 									      \
 	debug_key_msg(key, key_format, key_cast);			      \
@@ -445,10 +445,10 @@
 }
 
 MR_TrieNode
-MR_string_hash_lookup_or_add(MR_TrieNode t, MR_String key)
+MR_string_hash_lookup_or_add(MR_TrieNode t, MR_ConstString key)
 {
 #define	key_format		"%s"
-#define	key_cast		char *
+#define	key_cast		const char *
 #define	table_type		MR_StringHashTableSlot
 #define	table_field		string_slot_ptr
 #define	hash(key)		(MR_hash_string((MR_Word) key))
@@ -501,7 +501,8 @@
 #define	MR_START_TABLE_INIT_SIZE	1024
 
 MR_TrieNode
-MR_int_start_index_lookup_or_add(MR_TrieNode table, MR_Integer start, MR_Integer key)
+MR_int_start_index_lookup_or_add(MR_TrieNode table,
+	MR_Integer start, MR_Integer key)
 {
 	MR_Integer	diff, size;
 
@@ -526,7 +527,7 @@
 
 	if (diff >= size) {
 		MR_TableNode	*new_array;
-		MR_Integer		new_size, i;
+		MR_Integer	new_size, i;
 
 		new_size = max(2 * size, diff + 1);
 		new_array = MR_TABLE_NEW_ARRAY(MR_TableNode, new_size + 1);
@@ -641,8 +642,8 @@
                 const MR_DuExistInfo    *exist_info;
                 MR_TypeInfo             arg_type_info;
                 int                     ptag;
-                MR_Word                    sectag;
-                MR_Word                    *arg_vector;
+                MR_Word                 sectag;
+                MR_Word                 *arg_vector;
                 int                     meta_args;
                 int                     i;
 
@@ -796,7 +797,7 @@
                 */
         #if 0
                 MR_closure  closure;
-                MR_Word        num_hidden_args;
+                MR_Word     num_hidden_args;
                 int         i;
 
                 closure = (MR_Closure *) data;
@@ -870,7 +871,7 @@
                 MR_TypeInfo     new_type_info;
                 MR_MemoryList   allocated_memory_cells = NULL;
                 MR_ArrayType    *array;
-                MR_Integer         array_size;
+                MR_Integer      array_size;
                 int             i;
 
                 array = (MR_ArrayType *) data;
@@ -1474,8 +1475,8 @@
 	MR_Subgoal	*subgoal;
 	MR_Consumer	*consumer;
 	MR_ConsumerList	listnode;
-	MR_Integer		cur_gen;
-	MR_Integer		cur_cut;
+	MR_Integer	cur_gen;
+	MR_Integer	cur_cut;
 	MR_Word		*fr;
 	MR_Word		*prev_fr;
 	MR_Word		*stop_addr;
Index: runtime/mercury_tabling.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.h,v
retrieving revision 1.22
diff -u -r1.22 mercury_tabling.h
--- runtime/mercury_tabling.h	2000/08/03 06:18:59	1.22
+++ runtime/mercury_tabling.h	2000/10/08 22:00:31
@@ -7,9 +7,9 @@
 /*
 ** mercury_tabling.h - definitions of some basic stuff used for tabling.
 ** For tabling code, the Mercury compiler (compiler/table_gen.m) generates
-** references to special procedures defined in library/private_builtin.m.
+** references to special procedures defined in library/table_builtin.m.
 ** The types and macros defined here are used by the procedures defined in
-** library/private_builtin.m.
+** library/table_builtin.m.
 */
 
 #ifndef	MERCURY_TABLING_H
@@ -19,6 +19,7 @@
 #include "mercury_type_info.h"
 #include "mercury_float.h"
 #include "mercury_reg_workarounds.h"
+#include "mercury_dlist.h"
 
 #ifndef CONSERVATIVE_GC
   #include "mercury_deep_copy.h"
@@ -123,16 +124,21 @@
 ** there will be no insertions into the same (or any other) table between
 ** getting back a tip node on the one hand and updating it and releasing the
 ** pointer to it on the other hand.
+** 
+** NOTE: the mercury_type_tables module uses the expandable hash table routines
+** defined in this module to implement its tables. This is the only use of the
+** MR_type_table field.
 */
 
 union MR_TableNode_Union {
-	MR_Integer		MR_integer;
+	MR_Integer	MR_integer;
 	MR_HashTable	*MR_hash_table;
 	MR_TableNode	*MR_fix_table;
 	MR_TableNode	*MR_start_table;
 	MR_Unsigned	MR_simpletable_status;
 	MR_Subgoal	*MR_subgoal;
 	MR_Word		*MR_answerblock;
+	MR_Dlist	*MR_type_table;
 };
 
 #define	MR_SIMPLETABLE_UNINITIALIZED	0
@@ -147,7 +153,7 @@
 } MR_SubgoalStatus;
 
 struct MR_AnswerListNode_Struct {
-	MR_Integer		answer_num;
+	MR_Integer	answer_num;
 	MR_TableNode	answer_data; /* always uses the MR_answerblock member */
 	MR_AnswerList	next_answer;
 };
@@ -182,31 +188,31 @@
 */
 
 typedef struct {
-	MR_Code	*succ_ip;
-	MR_Word	*s_p;
-	MR_Word	*cur_fr;
-	MR_Word	*max_fr;
-	MR_Word	*non_stack_block_start;
-	MR_Word	non_stack_block_size;
-	MR_Word	*non_stack_block;
-	MR_Word	*det_stack_block_start;
-	MR_Word	det_stack_block_size;
-	MR_Word	*det_stack_block;
-	MR_Integer	gen_next;
-	char	*generator_stack_block;
-	MR_Integer	cut_next;
-	char	*cut_stack_block;
+	MR_Code			*succ_ip;
+	MR_Word			*s_p;
+	MR_Word			*cur_fr;
+	MR_Word			*max_fr;
+	MR_Word			*non_stack_block_start;
+	MR_Word			non_stack_block_size;
+	MR_Word			*non_stack_block;
+	MR_Word			*det_stack_block_start;
+	MR_Word			det_stack_block_size;
+	MR_Word			*det_stack_block;
+	MR_Integer		gen_next;
+	char			*generator_stack_block;
+	MR_Integer		cut_next;
+	char			*cut_stack_block;
 } MR_SavedState;
 
 /* The state of a consumer subgoal */
 typedef struct {
-	MR_SavedState	saved_state;
-	MR_AnswerList	*remaining_answer_list_ptr;
+	MR_SavedState		saved_state;
+	MR_AnswerList		*remaining_answer_list_ptr;
 } MR_Consumer;
 
 struct MR_ConsumerListNode_Struct {
-	MR_Consumer			*item;
-	MR_ConsumerList			next;
+	MR_Consumer		*item;
+	MR_ConsumerList		next;
 };
 
 /*
@@ -238,9 +244,9 @@
 	MR_ResumeInfo		*resume_info;
 	MR_Word			answer_table;	/* Table of answers returned */
 						/* by the subgoal */
-	MR_Integer			num_ans;	/* # of answers returned */
+	MR_Integer		num_ans;	/* # of answers returned */
 						/* by the subgoal */
-	MR_Integer			num_committed_ans;
+	MR_Integer		num_committed_ans;
 						/* # of answers our leader */
 						/* is committed to returning */
 						/* to every consumer. */
@@ -283,7 +289,7 @@
 extern	MR_TrieNode	MR_float_hash_lookup_or_add(MR_TrieNode table,
 				MR_Float key);
 extern	MR_TrieNode	MR_string_hash_lookup_or_add(MR_TrieNode table,
-				MR_String key);
+				MR_ConstString key);
 
 /*
 ** This function assumes that the table is a statically sized array,
Index: runtime/mercury_type_info.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.c,v
retrieving revision 1.40
diff -u -r1.40 mercury_type_info.c
--- runtime/mercury_type_info.c	2000/09/18 11:52:34	1.40
+++ runtime/mercury_type_info.c	2000/10/07 18:26:28
@@ -5,7 +5,7 @@
 */
 
 /*
-** type_info.c -
+** mercury_type_info.c -
 **	Definitions for dealing with type_infos needed by the Mercury
 **	runtime system.
 */
@@ -35,7 +35,7 @@
 #define	ALLOCATE_WORDS(target, size)					      \
 				do {					      \
 					MR_MemoryList node;		      \
-					(target) = MR_GC_NEW_ARRAY(MR_Word,      \
+					(target) = MR_GC_NEW_ARRAY(MR_Word,   \
 						(size));		      \
 					node = MR_GC_malloc(sizeof(*node));   \
 					node->data = (target);		      \
@@ -57,7 +57,7 @@
 #define	MAYBE_DECLARE_ALLOC_ARG
 #define	MAYBE_PASS_ALLOC_ARG
 #define	ALLOCATE_WORDS(target, size)					      \
-				incr_saved_hp(LVALUE_CAST(MR_Word, (target)),    \
+				incr_saved_hp(LVALUE_CAST(MR_Word, (target)), \
 					(size))
 #include "mercury_make_type_info_body.h"
 #undef	usual_func
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.56
diff -u -r1.56 mercury_type_info.h
--- runtime/mercury_type_info.h	2000/09/25 04:37:25	1.56
+++ runtime/mercury_type_info.h	2000/10/08 22:00:22
@@ -138,7 +138,7 @@
 #define MR_HIGHER_ORDER_TYPEINFO_STRUCT(NAME, ARITY)			\
     struct NAME {							\
 	MR_TypeCtorInfo     MR_ti_type_ctor_info;			\
-	MR_Integer             MR_ti_higher_order_arity;			\
+	MR_Integer          MR_ti_higher_order_arity;			\
 	MR_TypeInfo         MR_ti_higher_order_arg_typeinfos[ARITY];	\
     }
 
@@ -152,7 +152,7 @@
 #define MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(NAME, ARITY)		\
     struct NAME {							\
 	MR_TypeCtorInfo     MR_pti_type_ctor_info;			\
-	MR_Integer             MR_pti_higher_order_arity;			\
+	MR_Integer          MR_pti_higher_order_arity;			\
 	MR_PseudoTypeInfo   MR_pti_higher_order_arg_pseudo_typeinfos[ARITY]; \
     }
 
@@ -345,7 +345,7 @@
 #define UNIV_OFFSET_FOR_DATA            1
 
 #define	MR_unravel_univ(univ, typeinfo, value)                      \
-    do {							                                \
+    do {                                                            \
         typeinfo = (MR_TypeInfo) MR_field(MR_mktag(0), (univ),      \
                         UNIV_OFFSET_FOR_TYPEINFO);                  \
         value = MR_field(MR_mktag(0), (univ),                       \
@@ -773,7 +773,7 @@
   */
   typedef	void        *MR_ProcAddr;
 #else
-  typedef	MR_Code 	*MR_ProcAddr;
+  typedef	MR_Code     *MR_ProcAddr;
 #endif
 
 /*---------------------------------------------------------------------------*/
@@ -1113,4 +1113,4 @@
 
 /*---------------------------------------------------------------------------*/
 
-#endif /* not MERCURY_TYPEINFO_H */
+#endif /* not MERCURY_TYPE_INFO_H */
Index: runtime/mercury_type_tables.c
===================================================================
RCS file: mercury_type_tables.c
diff -N mercury_type_tables.c
--- /dev/null	Thu Sep  2 15:00:04 1999
+++ mercury_type_tables.c	Mon Oct  9 20:42:01 2000
@@ -0,0 +1,81 @@
+/*
+** Copyright (C) 2000 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** This module manages tables that list the definitions of the types (and
+** eventually type class instances) defined in the program.
+**
+** The sizes of these tables can vary by several orders of magnitude,
+** so using a fixed size hash table would not be a good idea. This is why
+** we build on the implementation of expandable hash tables in the
+** mercury_tabling module.
+*/
+
+#ifndef MR_HIGHLEVEL_CODE
+  #include "mercury_imp.h"
+#endif
+#include "mercury_type_info.h"
+#include "mercury_type_tables.h"
+#include "mercury_tabling.h"
+
+static	MR_TableNode	MR_type_ctor_table = { 0 };
+
+#define	names_match(tc1, name, module_name)				\
+	( streq(tc1->type_ctor_name, name)				\
+	&& streq(tc1->type_ctor_module_name, module_name))
+
+#define	names_match_tc(tc1, tc2)					\
+	( streq(tc1->type_ctor_name, tc2->type_ctor_name)		\
+	&& streq(tc1->type_ctor_module_name, tc2->type_ctor_module_name))
+
+void
+MR_register_type_ctor_info(MR_TypeCtorInfo type_ctor_info)
+{
+	MR_TrieNode	slot;
+	MR_Dlist	*element_ptr;
+	MR_TypeCtorInfo	cur_type_ctor_info;
+
+	slot = MR_string_hash_lookup_or_add(&MR_type_ctor_table,
+			type_ctor_info->type_ctor_name);
+
+	MR_for_dlist (element_ptr, slot->MR_type_table) {
+		cur_type_ctor_info =
+			(MR_TypeCtorInfo) MR_dlist_data(element_ptr);
+
+		if (names_match_tc(type_ctor_info, cur_type_ctor_info)) {
+			if (cur_type_ctor_info == type_ctor_info) {
+				/* type_ctor_info has been registered before */
+				return;
+			} else {
+				fatal_error("MR_register_type_ctor_info: ambiguous type ctor");
+			}
+		}
+	}
+
+	slot->MR_type_table = MR_dlist_addhead(slot->MR_type_table,
+		type_ctor_info);
+}
+
+MR_TypeCtorInfo
+MR_lookup_type_ctor_info(const char *module_name, const char *name)
+{
+	MR_TrieNode	slot;
+	MR_Dlist	*element_ptr;
+	MR_TypeCtorInfo	cur_type_ctor_info;
+
+	slot = MR_string_hash_lookup_or_add(&MR_type_ctor_table, name);
+
+	MR_for_dlist (element_ptr, slot->MR_type_table) {
+		cur_type_ctor_info =
+			(MR_TypeCtorInfo) MR_dlist_data(element_ptr);
+
+		if (names_match(cur_type_ctor_info, name, module_name)) {
+			return cur_type_ctor_info;
+		}
+	}
+
+	return NULL;
+}
Index: runtime/mercury_type_tables.h
===================================================================
RCS file: mercury_type_tables.h
diff -N mercury_type_tables.h
--- /dev/null	Thu Sep  2 15:00:04 1999
+++ mercury_type_tables.h	Mon Oct  9 16:12:05 2000
@@ -0,0 +1,23 @@
+/*
+** Copyright (C) 2000 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** mercury_type_tables.h -
+**  This module manages tables that list the definitions of the types and
+**  type class instances defined in the program.
+*/
+
+#ifndef MERCURY_TYPE_TABLES_H
+#define MERCURY_TYPE_TABLES_H
+
+#include "mercury_type_info.h"
+
+extern	void		MR_register_type_ctor_info(
+				MR_TypeCtorInfo type_ctor_info);
+extern	MR_TypeCtorInfo	MR_lookup_type_ctor_info(const char *module_name,
+				const char *name);
+
+#endif /* not MERCURY_TYPE_TABLES */
Index: runtime/mercury_wrapper.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_wrapper.c,v
retrieving revision 1.71
diff -u -r1.71 mercury_wrapper.c
--- runtime/mercury_wrapper.c	2000/09/14 04:31:25	1.71
+++ runtime/mercury_wrapper.c	2000/10/06 23:30:28
@@ -171,6 +171,8 @@
 
 void	(*address_of_mercury_init_io)(void);
 void	(*address_of_init_modules)(void);
+void	(*address_of_init_modules_type_tables)(void);
+void	(*address_of_init_modules_debugger)(void);
 
 int	(*MR_address_of_do_load_aditi_rl_code)(void);
 
@@ -422,6 +424,30 @@
 
 	if (! done) {
 		(*address_of_init_modules)();
+		MR_close_prof_decl_file();
+		done = TRUE;
+	}
+}
+
+void 
+do_init_modules_type_tables(void)
+{
+	static	bool	done = FALSE;
+
+	if (! done) {
+		(*address_of_init_modules_type_tables)();
+		MR_close_prof_decl_file();
+		done = TRUE;
+	}
+}
+
+void 
+do_init_modules_debugger(void)
+{
+	static	bool	done = FALSE;
+
+	if (! done) {
+		(*address_of_init_modules_debugger)();
 		MR_close_prof_decl_file();
 		done = TRUE;
 	}
Index: runtime/mercury_wrapper.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_wrapper.h,v
retrieving revision 1.34
diff -u -r1.34 mercury_wrapper.h
--- runtime/mercury_wrapper.h	2000/08/26 04:34:01	1.34
+++ runtime/mercury_wrapper.h	2000/10/06 23:30:35
@@ -81,6 +81,8 @@
 
 extern	void		(*address_of_mercury_init_io)(void);
 extern	void		(*address_of_init_modules)(void);
+extern	void		(*address_of_init_modules_type_tables)(void);
+extern	void		(*address_of_init_modules_debugger)(void);
 
 #ifdef CONSERVATIVE_GC
 extern	void		(*address_of_init_gc)(void);
@@ -152,6 +154,8 @@
 extern	void		(*MR_register_module_layout)(const MR_Module_Layout *);
 
 extern	void		do_init_modules(void);
+extern	void		do_init_modules_type_tables(void);
+extern	void		do_init_modules_debugger(void);
 
 extern	const char	*progname;
 extern	int		mercury_argc;
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/hard_coded
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.90
diff -u -r1.90 Mmakefile
--- tests/hard_coded/Mmakefile	2000/09/25 04:23:16	1.90
+++ tests/hard_coded/Mmakefile	2000/10/09 05:14:27
@@ -108,6 +108,7 @@
 	test_imported_no_tag \
 	tim_qual1 \
 	type_qual \
+	type_tables \
 	type_to_term_bug \
 	tuple_test \
 	user_defined_equality \
Index: tests/hard_coded/type_tables.exp
===================================================================
RCS file: type_tables.exp
diff -N type_tables.exp
--- /dev/null	Thu Sep  2 15:00:04 1999
+++ type_tables.exp	Mon Oct  9 16:14:42 2000
@@ -0,0 +1,2 @@
+list list
+type_tables list
Index: tests/hard_coded/type_tables.m
===================================================================
RCS file: type_tables.m
diff -N type_tables.m
--- /dev/null	Thu Sep  2 15:00:04 1999
+++ type_tables.m	Mon Oct  9 15:49:58 2000
@@ -0,0 +1,32 @@
+% Test case for runtime/mercury_type_tables.h
+% 
+% Author: zs
+
+:- module type_tables.
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module list.
+
+:- type list	--->	a ; b.
+
+:- pragma(c_code, main(IO0::di, IO::uo), "
+extern const struct MR_TypeCtorInfo_Struct mercury_data_list__type_ctor_info_list_1;
+extern const struct MR_TypeCtorInfo_Struct mercury_data_type_tables__type_ctor_info_list_0;
+	MR_TypeCtorInfo	tc1;
+	MR_TypeCtorInfo	tc2;
+
+	MR_register_type_ctor_info(&mercury_data_list__type_ctor_info_list_1);
+	MR_register_type_ctor_info(&mercury_data_type_tables__type_ctor_info_list_0);
+
+	tc1 = MR_lookup_type_ctor_info(""list"", ""list"");
+	tc2 = MR_lookup_type_ctor_info(""type_tables"", ""list"");
+
+	printf(""%s %s\n"", tc1->type_ctor_module_name, tc1->type_ctor_name);
+	printf(""%s %s\n"", tc2->type_ctor_module_name, tc2->type_ctor_name);
+	IO = IO0;
+").
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/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 trax
cvs diff: Diffing trial
cvs diff: Diffing util
--------------------------------------------------------------------------
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