[m-dev.] diff: cleanup of tabling

Zoltan Somogyi zs at cs.mu.OZ.AU
Mon Jan 3 19:59:10 AEDT 2000


Fergus has reviewed my previous diff, and I have applied all his suggestions
except the few we have discussed. However, in the meantime I have also added
several new test cases and fixed the bugs they detected, switched to the
use of a textbook separate chaining technique, and made the hash table
implementation type-safe. Someone may therefore wish to look this over,
although it is not necessary. This diff passes bootcheck, including all the
tough new test cases, and I have committed it.

Estimated hours taken: 40

A major cleanup of the internals of tabling.

Tabling builds up two kinds of tables, both conceptually tries. For call
tables, there is one layer in the trie for each input argument; for answer
tables, there is one layer in the trie for each output argument. However,
the way each trie node is implemented depends on the type of the relevant
argument. In addition, what is stored at the tips of the call and answer tables
also depends on what kind of tabling (e.g. loopcheck, memo, minimal model)
is being performed on the current predicate, and (in some cases) on what
stage the execution of the current predicate has reached.

Previously, all trie nodes were declared with the C type Word **, and were
cast to their actual types at the point of use, with the casts mostly being
hidden inside macros. This arrangement lacked readability and was highly
error prone. I have replaced it with a system in which trie nodes are declared
with a C type which is a pointer to a union of all the possible actual types.
There are very few casts left in the internals of the tabling system; this
change replaces them with casts at the interface (in the predicates of
private_builtin.m) and the use of the various fields of the union.

library/private_builtin.m:
	Changes to conform to the changed types in mercury_tabling.h.
	In some cases, improve the debugging support.

	Do not table the typeinfos of polymorphic types in the
	table_lookup_insert_poly predicate; since those typeinfos
	are also arguments, and since they appear before the polymorphic
	arguments, they have already been tabled by the time
	table_lookup_insert_poly is called.

library/private_builtin.m:
library/io.m:
	Add an interface to a new function in the runtime to report
	statistics about the operation of the tabling system.

runtime/mercury_tabling.h:
	Define and document the new types.

	Add macros for allocating memory for holding one or more structures.
	Make the existing macros call the versions that check for malloc
	returning NULL.

runtime/mercury_tabling_macros.h:
	This new file contains macros that used to be part of the file
	mercury_tabling.h. The macros call the functions defined in
	mercury_tabling.c, but they also optionally print debugging messages.

runtime/Mmakefile:
	Add mercury_tabling_macros.h to the list of header files.

runtime/mercury_tabling.c:
	Conform to the new system of C types.

	Recode the hash table routines to achieve code commonality, better
	debugging and statistics gathering support, much greater readability,
	and the following three performance benefits:

	1. The old code used open addressing to resolve collisions. In many
	   uses of tabling, successive searches specify keys that have
	   neighboring hash values, which frequently leads to very long
	   searches (I have observed searches that searched more than half
	   the slots of the hash table.) The new code uses separate chaining
	   to resolve collisions.

	2. The old code called GC_malloc whenever it inserted a new element
	   into the table. The new code amortizes this overhead over a
	   substantial (and configurable) number of insertions.

	3. In order to check whether the hash table should be expanded, the
	   old code was executing a float multiplication and a float comparison
	   on every hash table access. The new code executes the float
	   multiplication only when the table size is changed; in the usual
	   case it only executes an integer comparison, which is much cheaper.

	Recode the routines for tabling typeinfos for higher speed. Instead
	of storing them in a binary search tree, which requires lots of
	comparisons, store the address of the type_ctor_info in a hash table
	and chain its argument typeinfos from that.

	Add support for expandable tables, which are implemented as arrays
	indexed by key - start. This is not used yet, but will be used for
	I/O tabling soon.

runtime/mercury_stacks.c:
	Conform to the new system of C types for tabling.
	Improve the debugging support.

runtime/mercury_wrapper.c:
	When debugging tabling, set stdout to be line buffered.

runtime/mercury_engine.h:
runtime/mercury_wrapper.c:
	Add a new debugging flag, -dH, for debugging the operation of hash
	tables.

	In mercury_wrapper.c, sort the code fragments for for processing
	the arguments of -d.

runtime/mercury_trace_base.c:
	Disable the generation of nuisance debugging messages from Mercury
	initialization code called before main, which may have been compiled
	with MR_TABLE_DEBUG enabled.

runtime/mercury_conf_param.h:
	Document MR_TABLE_STATISTICS as well as MR_TABLE_DEBUG.

trace/mercury_trace_internal.c:
	Disable the generation of nuisance debugging messages from Mercury
	code called by the debugger that may have been compiled with
	MR_TABLE_DEBUG enabled, by turning off MR_tabledebug when MR_trace
	is entered. We then turn MR_tabledebug back on (even if it wasn't
	turned on in the first place) when executing debugger commands
	that require it to be turned on in order to work.

tests/tabling/fib.m:
	Improve the (commented out) debugging support. Start the search
	for the right problem size closer to its probable end point.

tests/tabling/fib_{float,string,list}.{m,exp}:
	New test cases to test the low-level routines for tabling floats,
	strings, and user-defined types; they are all modified versions of fib.

tests/tabling/expand.{m,exp}:
tests/tabling/expand_float.{m,exp}:
tests/tabling/expand_poly.{m,exp}:
	New test cases to test the code for resizing (i.e. expanding)
	hash tables, and the code for handling polymorphic arguments.

tests/tabling/Mmakefile:
	Enable the new test cases.

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
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/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/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 library
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.191
diff -u -b -r1.191 io.m
--- library/io.m	1999/12/13 13:47:02	1.191
+++ library/io.m	2000/01/03 08:45:27
@@ -1,5 +1,5 @@
 %-----------------------------------------------------------------------------%
-% Copyright (C) 1993-1999 The University of Melbourne.
+% Copyright (C) 1993-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.
 %-----------------------------------------------------------------------------%
@@ -982,6 +982,11 @@
 :- pred io__report_full_memory_stats(io__state, io__state).
 :- mode io__report_full_memory_stats(di, uo) is det.
 
+	% Write statistics about the operation of the tabling system to stderr.
+
+:- pred io__report_tabling_stats(io__state, io__state).
+:- mode io__report_tabling_stats(di, uo) is det.
+
 /*** no longer supported, sorry
 :- pred io__gc_call(pred(io__state, io__state), io__state, io__state).
 :- mode io__gc_call(pred(di, uo) is det, di, uo) is det.
@@ -2478,6 +2483,11 @@
 
 io__report_full_memory_stats -->
 	{ impure report_full_memory_stats }.
+
+:- pragma promise_pure(io__report_tabling_stats/2).
+
+io__report_tabling_stats -->
+	{ impure private_builtin__table_report_statistics }.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.35
diff -u -b -r1.35 private_builtin.m
--- library/private_builtin.m	1999/12/15 04:14:07	1.35
+++ library/private_builtin.m	2000/01/03 08:45:36
@@ -1,5 +1,5 @@
 %---------------------------------------------------------------------------%
-% Copyright (C) 1994-1999 The University of Melbourne.
+% Copyright (C) 1994-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.
 %---------------------------------------------------------------------------%
@@ -31,7 +31,6 @@
 
 :- interface.
 
-
 	% This section of the module contains predicates that are used
 	% by the compiler, to implement polymorphism. These predicates
 	% should not be used by user programs directly.
@@ -338,7 +337,6 @@
 	MR_RTTI_VERSION
 };
 
-
 const struct mercury_data_private_builtin__type_ctor_layout_type_info_1_struct {
 	TYPE_LAYOUT_FIELDS
 } mercury_data_private_builtin__type_ctor_layout_type_info_1 = {
@@ -415,8 +413,6 @@
 	MR_TYPE_CTOR_FUNCTORS_SPECIAL
 };
 
-
-
 BEGIN_MODULE(type_info_module)
 	init_entry(mercury____Unify___private_builtin__type_info_1_0);
 	init_entry(mercury____Index___private_builtin__type_info_1_0);
@@ -698,91 +694,136 @@
 :- implementation.
 
 :- pragma c_code(table_simple_is_complete(T::in), will_not_call_mercury, "
+	MR_TrieNode	table;
+
+	table = (MR_TrieNode) T;
+
 #ifdef	MR_TABLE_DEBUG
 	if (MR_tabledebug) {
-		printf(""checking if %p is succeeded or failed: %lu\\n"",
-			(Unsigned *) T, (unsigned long) (*((Unsigned *) T)));
+		printf(""checking if simple %p is complete: %ld (%lx)\\n"",
+			table, (long) table->MR_simpletable_status,
+			(long) table->MR_simpletable_status);
 	}
 #endif
 	SUCCESS_INDICATOR = 
-		((*((Unsigned *) T) == MR_SIMPLETABLE_FAILED)
-		|| (*((Unsigned *) T) >= MR_SIMPLETABLE_SUCCEEDED));
+		((table->MR_simpletable_status == MR_SIMPLETABLE_FAILED)
+		|| (table->MR_simpletable_status >= MR_SIMPLETABLE_SUCCEEDED));
 ").
 
 :- pragma c_code(table_simple_has_succeeded(T::in), will_not_call_mercury, "
+	MR_TrieNode	table;
+
+	table = (MR_TrieNode) T;
+
 #ifdef	MR_TABLE_DEBUG
 	if (MR_tabledebug) {
-		printf(""checking if %p is succeeded: %lu\\n"",
-			(Unsigned *) T, (unsigned long) (*((Unsigned *) T)));
+		printf(""checking if simple %p is succeeded: %ld (%lx)\\n"",
+			table, (long) table->MR_simpletable_status,
+			(long) table->MR_simpletable_status);
 	}
 #endif
-	SUCCESS_INDICATOR = (*((Unsigned *) T) >= MR_SIMPLETABLE_SUCCEEDED)
+	SUCCESS_INDICATOR =
+		(table->MR_simpletable_status >= MR_SIMPLETABLE_SUCCEEDED);
 ").
 
 :- pragma c_code(table_simple_has_failed(T::in), will_not_call_mercury, "
+	MR_TrieNode	table;
+
+	table = (MR_TrieNode) T;
+
 #ifdef	MR_TABLE_DEBUG
 	if (MR_tabledebug) {
-		printf(""checking if %p is failed: %lu\\n"",
-			(Unsigned *) T, (unsigned long) (*((Unsigned *) T)));
+		printf(""checking if simple %p is failed: %ld (%lx)\\n"",
+			table, (long) table->MR_simpletable_status,
+			(long) table->MR_simpletable_status);
 	}
 #endif
-	SUCCESS_INDICATOR = (*((Unsigned *) T) == MR_SIMPLETABLE_FAILED);
+	SUCCESS_INDICATOR =
+		(table->MR_simpletable_status == MR_SIMPLETABLE_FAILED);
 ").
 
 :- pragma c_code(table_simple_is_active(T::in), will_not_call_mercury, "
+	MR_TrieNode	table;
+
+	table = (MR_TrieNode) T;
+
 #ifdef	MR_TABLE_DEBUG
 	if (MR_tabledebug) {
-		printf(""checking if %p is active: %lu\\n"",
-			(Unsigned *) T, (unsigned long) (*((Unsigned *) T)));
+		printf(""checking if simple %p is active: %ld (%lx)\\n"",
+			table, (long) table->MR_simpletable_status,
+			(long) table->MR_simpletable_status);
 	}
 #endif
-	SUCCESS_INDICATOR = (*((Unsigned *) T) == MR_SIMPLETABLE_WORKING);
+	SUCCESS_INDICATOR =
+		(table->MR_simpletable_status == MR_SIMPLETABLE_WORKING);
 ").
 
 :- pragma c_code(table_simple_is_inactive(T::in), will_not_call_mercury, "
+	MR_TrieNode	table;
+
+	table = (MR_TrieNode) T;
+
 #ifdef	MR_TABLE_DEBUG
 	if (MR_tabledebug) {
-		printf(""checking if %p is not inactive: %lu\\n"",
-			(Unsigned *) T, (unsigned long) (*((Unsigned *) T)));
+		printf(""checking if simple %p is inactive: %ld (%lx)\\n"",
+			table, (long) table->MR_simpletable_status,
+			(long) table->MR_simpletable_status);
 	}
 #endif
-	SUCCESS_INDICATOR = (*((Unsigned *) T) != MR_SIMPLETABLE_WORKING);
+	SUCCESS_INDICATOR =
+		(table->MR_simpletable_status != MR_SIMPLETABLE_WORKING);
 ").
 
 :- pragma c_code(table_simple_mark_as_succeeded(T::in), will_not_call_mercury, "
+	MR_TrieNode	table;
+
+	table = (MR_TrieNode) T;
+
 #ifdef	MR_TABLE_DEBUG
 	if (MR_tabledebug) {
-		printf(""marking %p as succeeded\\n"", (Unsigned *) T);
+		printf(""marking %p as succeeded\\n"", table);
 	}
 #endif
-	*((Unsigned *) T) = MR_SIMPLETABLE_SUCCEEDED;
+	table->MR_simpletable_status = MR_SIMPLETABLE_SUCCEEDED;
 ").
 
 :- pragma c_code(table_simple_mark_as_failed(T::in), will_not_call_mercury, "
+	MR_TrieNode	table;
+
+	table = (MR_TrieNode) T;
+
 #ifdef	MR_TABLE_DEBUG
 	if (MR_tabledebug) {
-		printf(""marking %p as failed\\n"", (Unsigned *) T);
+		printf(""marking %p as failed\\n"", table);
 	}
 #endif
-	*((Unsigned *) T) = MR_SIMPLETABLE_FAILED;
+	table->MR_simpletable_status = MR_SIMPLETABLE_FAILED;
 ").
 
 :- pragma c_code(table_simple_mark_as_active(T::in), will_not_call_mercury, "
+	MR_TrieNode	table;
+
+	table = (MR_TrieNode) T;
+
 #ifdef	MR_TABLE_DEBUG
 	if (MR_tabledebug) {
-		printf(""marking %p as working\\n"", (Unsigned *) T);
+		printf(""marking %p as working\\n"", table);
 	}
 #endif
-	*((Unsigned *) T) = MR_SIMPLETABLE_WORKING;
+	table->MR_simpletable_status = MR_SIMPLETABLE_WORKING;
 ").
 
 :- pragma c_code(table_simple_mark_as_inactive(T::in), will_not_call_mercury, "
+	MR_TrieNode	table;
+
+	table = (MR_TrieNode) T;
+
 #ifdef	MR_TABLE_DEBUG
 	if (MR_tabledebug) {
-		printf(""marking %p as uninitialized\\n"", (Unsigned *) T);
+		printf(""marking %p as uninitialized\\n"", table);
 	}
 #endif
-	*((Unsigned *) T) = MR_SIMPLETABLE_UNINITIALIZED;
+	table->MR_simpletable_status = MR_SIMPLETABLE_UNINITIALIZED;
 ").
 
 %-----------------------------------------------------------------------------%
@@ -849,10 +890,16 @@
 :- implementation.
 
 :- pragma c_code(table_nondet_setup(T0::in, T::out), will_not_call_mercury, "
-#ifdef	MR_USE_MINIMAL_MODEL
+#ifndef	MR_USE_MINIMAL_MODEL
+	fatal_error(""minimal model code entered when not enabled"");
+#else
 #ifdef	MR_THREAD_SAFE
 #error ""Sorry, not yet implemented: mixing minimal model tabling and threads""
 #endif
+	MR_TrieNode	table;
+
+	table = (MR_TrieNode) T0;
+
 	/*
 	** Initialize the subgoal if this is the first time we see it.
 	** If the subgoal structure already exists but is marked inactive,
@@ -861,20 +908,14 @@
 	** In that case, we want to forget all about the old generator.
 	*/
 
-	if (MR_SUBGOAL(T0) == NULL) {
+	if (table->MR_subgoal == NULL) {
 		MR_Subgoal	*subgoal;
 
-		subgoal = (MR_Subgoal *)
-			table_allocate_bytes(sizeof(MR_Subgoal));
-#ifdef	MR_TABLE_DEBUG
-		if (MR_tabledebug) {
-			printf(""setting up table %p -> %p\\n"",
-				(MR_Subgoal **) T0, subgoal);
-		}
-#endif
+		subgoal = MR_TABLE_NEW(MR_Subgoal);
+
 		subgoal->status = MR_SUBGOAL_INACTIVE;
 		subgoal->leader = NULL;
-		subgoal->followers = MR_GC_NEW(struct MR_SubgoalListNode);
+		subgoal->followers = MR_TABLE_NEW(MR_SubgoalListNode);
 		subgoal->followers->item = subgoal;
 		subgoal->followers->next = NULL;
 		subgoal->followers_tail = &(subgoal->followers->next);
@@ -884,18 +925,24 @@
 		subgoal->answer_list_tail = &subgoal->answer_list;
 		subgoal->consumer_list = NULL;
 		subgoal->consumer_list_tail = &subgoal->consumer_list;
+
 #ifdef	MR_TABLE_DEBUG
+		if (MR_tabledebug) {
+			printf(""setting up table %p -> %p, answer slot %p\\n"",
+				table, subgoal, subgoal->answer_list_tail);
+		}
+
 		if (MR_maxfr != MR_curfr) {
 			fatal_error(""MR_maxfr != MR_curfr at table setup\\n"");
 		}
 #endif
+
 		subgoal->generator_maxfr = MR_prevfr_slot(MR_maxfr);
 		subgoal->generator_sp = MR_sp;
-		MR_SUBGOAL(T0) = subgoal;
+
+		table->MR_subgoal = subgoal;
 	}
 	T = T0;
-#else
-	fatal_error(""minimal model code entered when not enabled"");
 #endif
 ").
 
@@ -906,7 +953,11 @@
 
 :- pragma c_code(table_nondet_is_complete(T::in),"
 #ifdef	MR_USE_MINIMAL_MODEL
-	SUCCESS_INDICATOR = (MR_SUBGOAL(T)->status == MR_SUBGOAL_COMPLETE);
+	MR_TrieNode	table;
+
+	table = (MR_TrieNode) T;
+
+	SUCCESS_INDICATOR = (table->MR_subgoal->status == MR_SUBGOAL_COMPLETE);
 #else
 	fatal_error(""minimal model code entered when not enabled"");
 #endif
@@ -914,7 +965,11 @@
 
 :- pragma c_code(table_nondet_is_active(T::in), will_not_call_mercury, "
 #ifdef	MR_USE_MINIMAL_MODEL
-	SUCCESS_INDICATOR = (MR_SUBGOAL(T)->status == MR_SUBGOAL_ACTIVE);
+	MR_TrieNode	table;
+
+	table = (MR_TrieNode) T;
+
+	SUCCESS_INDICATOR = (table->MR_subgoal->status == MR_SUBGOAL_ACTIVE);
 #else
 	fatal_error(""minimal model code entered when not enabled"");
 #endif
@@ -922,9 +977,13 @@
 
 :- pragma c_code(table_nondet_mark_as_active(T::in), will_not_call_mercury, "
 #ifdef	MR_USE_MINIMAL_MODEL
-	MR_push_generator(MR_curfr, MR_SUBGOAL(T));
-	MR_register_generator_ptr((MR_Subgoal **) T);
-	MR_SUBGOAL(T)->status = MR_SUBGOAL_ACTIVE;
+	MR_TrieNode	table;
+
+	table = (MR_TrieNode) T;
+
+	MR_push_generator(MR_curfr, table);
+	MR_register_generator_ptr(table);
+	table->MR_subgoal->status = MR_SUBGOAL_ACTIVE;
 #else
 	fatal_error(""minimal model code entered when not enabled"");
 #endif
@@ -933,7 +992,11 @@
 :- pragma c_code(table_nondet_get_ans_table(T::in, AT::out),
 		will_not_call_mercury, "
 #ifdef	MR_USE_MINIMAL_MODEL
-	AT = (Word) &(MR_SUBGOAL(T)->answer_table);
+	MR_TrieNode	table;
+
+	table = (MR_TrieNode) T;
+
+	AT = (Word) &(table->MR_subgoal->answer_table);
 #else
 	fatal_error(""minimal model code entered when not enabled"");
 #endif
@@ -941,38 +1004,40 @@
 
 :- pragma c_code(table_nondet_answer_is_not_duplicate(T::in),
 		will_not_call_mercury, "
-#ifdef	MR_USE_MINIMAL_MODEL
+#ifndef	MR_USE_MINIMAL_MODEL
+	fatal_error(""minimal model code entered when not enabled"");
+#else
+	MR_TrieNode	table;
 	bool	is_new_answer;
 
+	table = (MR_TrieNode) T;
+
 #ifdef	MR_TABLE_DEBUG
 	if (MR_tabledebug) {
-		printf(""checking if %p is a duplicate answer: %d\\n"",
-			(Word *) T, *((Word *) T));
+		printf(""checking if %p is a duplicate answer: %ld\\n"",
+			table, (long) table->MR_integer);
 	}
 #endif
-	is_new_answer = (*((Word *) T) == MR_ANS_NOT_GENERATED);
-	*((Word *) T) = MR_ANS_GENERATED;
+
+	is_new_answer = (table->MR_integer == 0);
+	table->MR_integer = 1;	/* any nonzero value will do */
 	SUCCESS_INDICATOR = is_new_answer;
-#else
-	fatal_error(""minimal model code entered when not enabled"");
 #endif
 ").
 
 :- pragma c_code(table_nondet_new_ans_slot(T::in, Slot::out),
 		will_not_call_mercury, "
-#ifdef	MR_USE_MINIMAL_MODEL
-	MR_Subgoal		*table;
+#ifndef	MR_USE_MINIMAL_MODEL
+	fatal_error(""minimal model code entered when not enabled"");
+#else
+	MR_TrieNode		table;
+	MR_Subgoal		*subgoal;
 	MR_AnswerListNode	*answer_node;
 
-	table = MR_SUBGOAL(T);
-	table->num_ans += 1;
+	table = (MR_TrieNode) T;
+	subgoal = table->MR_subgoal;
+	subgoal->num_ans++;
 
-#ifdef	MR_TABLE_DEBUG
-	if (MR_tabledebug) {
-		printf(""new answer slot %d, storing into addr %p\\n"",
-			table->num_ans, table->answer_list_tail);
-	}
-#endif
 	/*
 	**
 	** We fill in the answer_data slot with a dummy value.
@@ -980,17 +1045,23 @@
 	** to be executed after we return, which is why we return its address.
 	*/
 
-	answer_node = table_allocate_bytes(sizeof(MR_AnswerListNode));
-	answer_node->answer_num = table->num_ans;
-	answer_node->answer_data = 0;
+	answer_node = MR_TABLE_NEW(MR_AnswerListNode);
+	answer_node->answer_num = subgoal->num_ans;
+	answer_node->answer_data.MR_integer = 0;
 	answer_node->next_answer = NULL;
+
+#ifdef	MR_TABLE_DEBUG
+	if (MR_tabledebug) {
+		printf(""new answer slot %d at %p(%p), storing into %p\\n"",
+			subgoal->num_ans, answer_node,
+			&answer_node->answer_data, subgoal->answer_list_tail);
+	}
+#endif
 
-	*(table->answer_list_tail) = answer_node;
-	table->answer_list_tail = &(answer_node->next_answer);
+	*(subgoal->answer_list_tail) = answer_node;
+	subgoal->answer_list_tail = &(answer_node->next_answer);
 
 	Slot = (Word) &(answer_node->answer_data);
-#else
-	fatal_error(""minimal model code entered when not enabled"");
 #endif
 ").
 
@@ -1006,7 +1077,17 @@
 	"),
 	first_code("
 #ifdef MR_USE_MINIMAL_MODEL
-		LOCALS->cur_node = MR_SUBGOAL(T)->answer_list;
+		MR_TrieNode	table;
+
+		table = (MR_TrieNode) T;
+		LOCALS->cur_node = table->MR_subgoal->answer_list;
+
+  #ifdef MR_TABLE_DEBUG
+		if (MR_tabledebug) {
+			printf(""restoring all answers in %p -> %p\\n"",
+				table, table->MR_subgoal);
+		}
+  #endif
 #endif
 	"),
 	retry_code("
@@ -1016,7 +1097,7 @@
 		if (LOCALS->cur_node == NULL) {
 			FAIL;
 		} else {
-			A = LOCALS->cur_node->answer_data;
+			A = (Word) &LOCALS->cur_node->answer_data;
 			LOCALS->cur_node = LOCALS->cur_node->next_answer;
 			SUCCEED;
 		}
@@ -1125,109 +1206,175 @@
 :- impure pred table_create_ans_block(ml_subgoal_table_node::in, int::in,
 	ml_answer_block::out) is det.
 
+	% Report statistics on the operation of the tabling system to stderr.
+:- impure pred table_report_statistics is det.
+
 %-----------------------------------------------------------------------------%
 
 :- implementation.
 
 :- pragma c_code(table_lookup_insert_int(T0::in, I::in, T::out),
 		will_not_call_mercury, "
-	MR_DEBUG_NEW_TABLE_INT(T, T0, I);
+	MR_TrieNode	table0, table;
+
+	table0 = (MR_TrieNode) T0;
+	MR_DEBUG_NEW_TABLE_INT(table, table0, (Integer) I);
+	T = (Word) table;
 ").
 
 :- pragma c_code(table_lookup_insert_char(T0::in, C::in, T::out),
 		will_not_call_mercury, "
-	MR_DEBUG_NEW_TABLE_CHAR(T, T0, C);
+	MR_TrieNode	table0, table;
+
+	table0 = (MR_TrieNode) T0;
+	MR_DEBUG_NEW_TABLE_CHAR(table, table0, (Integer) C);
+	T = (Word) table;
 ").
 
 :- pragma c_code(table_lookup_insert_string(T0::in, S::in, T::out),
 		will_not_call_mercury, "
-	MR_DEBUG_NEW_TABLE_STRING(T, T0, S);
+	MR_TrieNode	table0, table;
+
+	table0 = (MR_TrieNode) T0;
+	MR_DEBUG_NEW_TABLE_STRING(table, table0, (String) S);
+	T = (Word) table;
 ").
 
 :- pragma c_code(table_lookup_insert_float(T0::in, F::in, T::out),
 		will_not_call_mercury, "
-	MR_DEBUG_NEW_TABLE_FLOAT(T, T0, F);
+	MR_TrieNode	table0, table;
+
+	table0 = (MR_TrieNode) T0;
+	MR_DEBUG_NEW_TABLE_FLOAT(table, table0, F);
+	T = (Word) table;
 ").
 
 :- pragma c_code(table_lookup_insert_enum(T0::in, R::in, V::in, T::out),
 		will_not_call_mercury, "
-	MR_DEBUG_NEW_TABLE_ENUM(T, T0, R, V);
+	MR_TrieNode	table0, table;
+
+	table0 = (MR_TrieNode) T0;
+	MR_DEBUG_NEW_TABLE_ENUM(table, table0, R, V);
+	T = (Word) table;
 ").
 
 :- pragma c_code(table_lookup_insert_user(T0::in, V::in, T::out),
 		will_not_call_mercury, "
-	MR_DEBUG_NEW_TABLE_ANY(T, T0, TypeInfo_for_T, V);
+	MR_TrieNode	table0, table;
+
+	table0 = (MR_TrieNode) T0;
+	MR_DEBUG_NEW_TABLE_ANY(table, table0, (Word *) TypeInfo_for_T, V);
+	T = (Word) table;
 ").
 
 :- pragma c_code(table_lookup_insert_poly(T0::in, V::in, T::out),
 		will_not_call_mercury, "
-	Word T1;
-	MR_DEBUG_NEW_TABLE_TYPEINFO(T1, T0, TypeInfo_for_T);
-	MR_DEBUG_NEW_TABLE_ANY(T, T1, TypeInfo_for_T, V);
+	MR_TrieNode	table0, table;
+
+	table0 = (MR_TrieNode) T0;
+	MR_DEBUG_NEW_TABLE_ANY(table, table0, (Word *) TypeInfo_for_T, V);
+	T = (Word) table;
 ").
 
 :- pragma c_code(table_save_int_ans(T::in, Offset::in, I::in),
 		will_not_call_mercury, "
-	MR_TABLE_SAVE_ANSWER(Offset, T, I,
+	MR_TrieNode	table;
+
+	table = (MR_TrieNode) T;
+	MR_TABLE_SAVE_ANSWER(table, Offset, I,
 		mercury_data___type_ctor_info_int_0);
 ").
 
 :- pragma c_code(table_save_char_ans(T::in, Offset::in, C::in),
 		will_not_call_mercury, "
-	MR_TABLE_SAVE_ANSWER(Offset, T, C,
+	MR_TrieNode	table;
+
+	table = (MR_TrieNode) T;
+	MR_TABLE_SAVE_ANSWER(table, Offset, C,
 		mercury_data___type_ctor_info_character_0);
 ").
 
 :- pragma c_code(table_save_string_ans(T::in, Offset::in, S::in),
 		will_not_call_mercury, "
-	MR_TABLE_SAVE_ANSWER(Offset, T, (Word) S,
+	MR_TrieNode	table;
+
+	table = (MR_TrieNode) T;
+	MR_TABLE_SAVE_ANSWER(table, Offset, (Word) S,
 		mercury_data___type_ctor_info_string_0);
 ").
 
 :- pragma c_code(table_save_float_ans(T::in, Offset::in, F::in),
 		will_not_call_mercury, "
-	MR_TABLE_SAVE_ANSWER(Offset, T, float_to_word(F),
+	MR_TrieNode	table;
+
+	table = (MR_TrieNode) T;
+	MR_TABLE_SAVE_ANSWER(table, Offset, float_to_word(F),
 		mercury_data___type_ctor_info_float_0);
 ").
 
 :- pragma c_code(table_save_any_ans(T::in, Offset::in, V::in),
 		will_not_call_mercury, "
-	MR_TABLE_SAVE_ANSWER(Offset, T, V, TypeInfo_for_T);
+	MR_TrieNode	table;
+
+	table = (MR_TrieNode) T;
+	MR_TABLE_SAVE_ANSWER(table, Offset, V, TypeInfo_for_T);
 ").
 
 :- pragma c_code(table_restore_int_ans(T::in, Offset::in, I::out),
 		will_not_call_mercury, "
-	I = (Integer) MR_TABLE_GET_ANSWER(Offset, T);
+	MR_TrieNode	table;
+
+	table = (MR_TrieNode) T;
+	I = (Integer) MR_TABLE_GET_ANSWER(table, Offset);
 ").
 
 :- pragma c_code(table_restore_char_ans(T::in, Offset::in, C::out),
 		will_not_call_mercury, "
-	C = (Char) MR_TABLE_GET_ANSWER(Offset, T);
+	MR_TrieNode	table;
+
+	table = (MR_TrieNode) T;
+	C = (Char) MR_TABLE_GET_ANSWER(table, Offset);
 ").
 
 :- pragma c_code(table_restore_string_ans(T::in, Offset::in, S::out),
 		will_not_call_mercury, "
-	S = (String) MR_TABLE_GET_ANSWER(Offset, T);
+	MR_TrieNode	table;
+
+	table = (MR_TrieNode) T;
+	S = (String) MR_TABLE_GET_ANSWER(table, Offset);
 ").
 
 :- pragma c_code(table_restore_float_ans(T::in, Offset::in, F::out),
 		will_not_call_mercury, "
-	F = word_to_float(MR_TABLE_GET_ANSWER(Offset, T));
+	MR_TrieNode	table;
+
+	table = (MR_TrieNode) T;
+	F = word_to_float(MR_TABLE_GET_ANSWER(table, Offset));
 ").
 
 :- pragma c_code(table_restore_any_ans(T::in, Offset::in, V::out),
 		will_not_call_mercury, "
-	V = (Word) MR_TABLE_GET_ANSWER(Offset, T);
+	MR_TrieNode	table;
+
+	table = (MR_TrieNode) T;
+	V = (Word) MR_TABLE_GET_ANSWER(table, Offset);
 ").
 
 :- pragma c_code(table_create_ans_block(T0::in, Size::in, T::out),
 		will_not_call_mercury, "
-	MR_TABLE_CREATE_ANSWER_BLOCK(T0, Size);
+	MR_TrieNode	table0;
+
+	table0 = (MR_TrieNode) T0;
+	MR_TABLE_CREATE_ANSWER_BLOCK(table0, Size);
 	T = T0;
 ").
 
 table_loopcheck_error(Message) :-
 	error(Message).
+
+:- pragma c_code(table_report_statistics, will_not_call_mercury, "
+	MR_table_report_statistics(stderr);
+").
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
cvs diff: Diffing profiler
cvs diff: Diffing runtime
Index: runtime/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/Mmakefile,v
retrieving revision 1.49
diff -u -b -r1.49 Mmakefile
--- runtime/Mmakefile	1999/09/16 04:46:28	1.49
+++ runtime/Mmakefile	2000/01/03 08:45:57
@@ -1,5 +1,5 @@
 #-----------------------------------------------------------------------------#
-# Copyright (C) 1998-1999 The University of Melbourne.
+# Copyright (C) 1998-2000 The University of Melbourne.
 # This file may only be copied under the terms of the GNU General
 # Public License - see the file COPYING in the Mercury distribution.
 #-----------------------------------------------------------------------------#
@@ -71,6 +71,7 @@
 			mercury_stacks.h	\
 			mercury_string.h	\
 			mercury_tabling.h	\
+			mercury_tabling_macros.h	\
 			mercury_tags.h		\
 			mercury_thread.h	\
 			mercury_timing.h	\
Index: runtime/mercury_conf_param.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_conf_param.h,v
retrieving revision 1.30
diff -u -b -r1.30 mercury_conf_param.h
--- runtime/mercury_conf_param.h	1999/12/21 10:28:05	1.30
+++ runtime/mercury_conf_param.h	2000/01/03 08:46:41
@@ -1,5 +1,5 @@
 /*
-** Copyright (C) 1997-1999 The University of Melbourne.
+** Copyright (C) 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.
 */
@@ -155,6 +155,9 @@
 ** MR_DEBUG_AGC
 ** 	Turn on all debugging information for accurate garbage
 ** 	collection.  (Equivalent to all MR_DEBUG_AGC_* macros above).
+**
+** MR_TABLE_DEBUG
+** 	Enables low-level debugging messages from the tabling system.
 */
 
 #if MR_DEBUG_AGC
@@ -201,6 +204,10 @@
 ** various kinds of representations, then set this macro to a string giving
 ** the name of the file to which the statistics should be appended when the
 ** program exits.
+**
+** MR_TABLE_STATISTICS
+** Enable this if you want to gather statistics about the operation of the
+** tabling system. The results are reported via io__report_tabling_stats.
 */
 
 /*---------------------------------------------------------------------------*/
Index: runtime/mercury_engine.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_engine.h,v
retrieving revision 1.13
diff -u -b -r1.13 mercury_engine.h
--- runtime/mercury_engine.h	1999/09/16 09:24:39	1.13
+++ runtime/mercury_engine.h	2000/01/03 08:47:08
@@ -1,5 +1,5 @@
 /*
-** Copyright (C) 1994-1999 The University of Melbourne.
+** Copyright (C) 1994-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.
 */
@@ -47,9 +47,10 @@
 #define	MR_SREGFLAG		8
 #define	MR_TRACEFLAG		9
 #define	MR_TABLEFLAG		10
-#define	MR_TABLESTACKFLAG	11
-#define	MR_DETAILFLAG		12
-#define	MR_MAXFLAG		13
+#define	MR_TABLEHASHFLAG	11
+#define	MR_TABLESTACKFLAG	12
+#define	MR_DETAILFLAG		13
+#define	MR_MAXFLAG		14
 /* MR_DETAILFLAG should be the last real flag */
 
 #define	MR_progdebug		MR_debugflag[MR_PROGFLAG]
@@ -63,6 +64,7 @@
 #define	MR_sregdebug		MR_debugflag[MR_SREGFLAG]
 #define	MR_tracedebug		MR_debugflag[MR_TRACEFLAG]
 #define	MR_tabledebug		MR_debugflag[MR_TABLEFLAG]
+#define	MR_hashdebug		MR_debugflag[MR_TABLEHASHFLAG]
 #define	MR_tablestackdebug	MR_debugflag[MR_TABLESTACKFLAG]
 #define	MR_detaildebug		MR_debugflag[MR_DETAILFLAG]
 
Index: runtime/mercury_stacks.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_stacks.c,v
retrieving revision 1.4
diff -u -b -r1.4 mercury_stacks.c
--- runtime/mercury_stacks.c	1999/10/18 15:47:00	1.4
+++ runtime/mercury_stacks.c	2000/01/03 08:47:24
@@ -1,19 +1,44 @@
 /*
-** Copyright (C) 1998-1999 The University of Melbourne.
+** Copyright (C) 1998-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 file contains code for manipulating the generator stack and the cut
+** stack.
+**
+** The generator stack has one entry for each call to a minimal model tabled
+** procedure that is (a) acting as the generator for its subgoal and (b) is
+** in the active state. In systems such as XSB, each choice point has a flag
+** saying whether it is an active generator or not, and if yes, where its
+** subgoal's tabling information is stored. We achieve the same effect by 
+** checking whether a nondet stack frame at a given offset has an entry in
+** the generator stack, an approach that minimizes the performance impact
+** of tabling on non-tabled procedures.
+**
+** The cut stack has one entry for each commit goal that execution has entered
+** but not yet exited. Each commit stack entry has a list of all the generators
+** that have been started inside the corresponding commit goal. When the commit
+** goal is exited, it is possible that some of these generators are left
+** incomplete; due to the commit, they will in fact never be completed.
+** The purpose of the cut stack is to enable us to reset the call table
+** entries of such generators to inactive.
+**
+** All the functions in this file that take MR_TrieNode arguments use
+** only the subgoal member of the union.
+*/
+
 #include "mercury_imp.h"
 #include <stdio.h>
 
 #ifdef	MR_USE_MINIMAL_MODEL
 
 static	void	MR_print_gen_stack_entry(FILE *fp, Integer i);
-static	void	MR_cleanup_generator_ptr(MR_Subgoal **generator_ptr);
+static	void	MR_cleanup_generator_ptr(MR_TrieNode generator_ptr);
 
 void
-MR_push_generator(Word *frame_addr, MR_Subgoal *table_addr)
+MR_push_generator(Word *frame_addr, MR_TrieNode table_addr)
 {
 	MR_gen_stack[MR_gen_next].generator_frame = frame_addr;
 	MR_gen_stack[MR_gen_next].generator_table = table_addr;
@@ -37,7 +62,7 @@
 	}
 #endif
 
-	return MR_gen_stack[MR_gen_next - 1].generator_table;
+	return MR_gen_stack[MR_gen_next - 1].generator_table->MR_subgoal;
 }
 
 void
@@ -74,8 +99,7 @@
 	if (MR_tabledebug) {
 		fprintf(fp, "gen %ld = <", (long) i);
 		MR_print_nondstackptr(fp, MR_gen_stack[i].generator_frame);
-		fprintf(fp, ", %p>\n",
-			(void *) MR_gen_stack[i].generator_table);
+		fprintf(fp, ", %p>\n", MR_gen_stack[i].generator_table);
 	}
 #endif
 }
@@ -110,6 +134,10 @@
 	if (MR_tabledebug) {
 		printf("commit stack next down to %ld\n",
 			(long) MR_cut_next);
+		printf("setting generator stack next back to %ld from %ld\n",
+			(long) MR_cut_stack[MR_cut_next].gen_next,
+			(long) MR_gen_next);
+
 		if (MR_gen_next != MR_cut_stack[MR_cut_next].gen_next) {
 			if (MR_gen_next <= MR_cut_stack[MR_cut_next].gen_next)
 			{
@@ -123,10 +151,6 @@
 				fatal_error("GEN_NEXT ASSERTION FAILURE");
 			}
 		}
-
-		printf("setting generator stack next back to %ld from %ld\n",
-			(long) MR_cut_stack[MR_cut_next].gen_next,
-			(long) MR_gen_next);
 	}
 #endif
 
@@ -141,7 +165,7 @@
 }
 
 void
-MR_register_generator_ptr(MR_Subgoal **generator_ptr)
+MR_register_generator_ptr(MR_TrieNode generator_ptr)
 {
 	struct MR_CutGeneratorListNode	*node;
 
@@ -154,20 +178,21 @@
 	if (MR_tabledebug) {
 		printf("registering generator %p -> %p "
 			"at commit stack level %d\n",
-			generator_ptr, *generator_ptr, MR_cut_next - 1);
+			generator_ptr, generator_ptr->MR_subgoal,
+			MR_cut_next - 1);
 	}
 #endif
 }
 
 static void
-MR_cleanup_generator_ptr(MR_Subgoal **generator_ptr)
+MR_cleanup_generator_ptr(MR_TrieNode generator_ptr)
 {
-	if ((*generator_ptr)->status == MR_SUBGOAL_COMPLETE) {
+	if (generator_ptr->MR_subgoal->status == MR_SUBGOAL_COMPLETE) {
 		/* there is nothing to do, everything is OK */
 #ifdef	MR_TABLE_DEBUG
 		if (MR_tabledebug) {
 			printf("no cleanup: generator %p -> %p is complete\n",
-				generator_ptr, *generator_ptr);
+				generator_ptr, generator_ptr->MR_subgoal);
 		}
 #endif
 	} else {
@@ -175,11 +200,11 @@
 #ifdef	MR_TABLE_DEBUG
 		if (MR_tabledebug) {
 			printf("cleanup: generator %p -> %p deleted\n",
-				generator_ptr, *generator_ptr);
+				generator_ptr, generator_ptr->MR_subgoal);
 		}
 #endif
 
-		*generator_ptr = NULL;
+		generator_ptr->MR_subgoal = NULL;
 	}
 }
 
Index: runtime/mercury_stacks.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_stacks.h,v
retrieving revision 1.19
diff -u -b -r1.19 mercury_stacks.h
--- runtime/mercury_stacks.h	1999/09/27 05:20:47	1.19
+++ runtime/mercury_stacks.h	2000/01/03 08:47:26
@@ -1,5 +1,5 @@
 /*
-** Copyright (C) 1995-1999 The University of Melbourne.
+** Copyright (C) 1995-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.
 */
@@ -357,11 +357,11 @@
 
 typedef struct MR_GeneratorStackFrameStruct {
 	Word			*generator_frame;
-	MR_Subgoal		*generator_table;
+	MR_TrieNode		generator_table;
 } MR_GeneratorStackFrame;
 
 extern	void			MR_push_generator(Word *frame_addr,
-					MR_Subgoal *table_addr);
+					MR_TrieNode table_addr);
 extern	MR_Subgoal		*MR_top_generator_table(void);
 extern	void			MR_pop_generator(void);
 extern	void			MR_print_gen_stack(FILE *fp);
@@ -370,7 +370,7 @@
 
 typedef struct MR_CutGeneratorListNode *MR_CutGeneratorList;
 struct MR_CutGeneratorListNode {
-	MR_Subgoal		**generator_ptr;
+	MR_TrieNode		generator_ptr;
 	MR_CutGeneratorList	next_generator;
 };
 
@@ -383,7 +383,7 @@
 extern	void			MR_commit_mark(void);
 extern	void			MR_commit_cut(void);
 
-extern	void			MR_register_generator_ptr(MR_Subgoal **);
+extern	void			MR_register_generator_ptr(MR_TrieNode);
 
 #endif	/* MR_USE_MINIMAL_MODEL */
 
Index: runtime/mercury_tabling.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.c,v
retrieving revision 1.17
diff -u -b -r1.17 mercury_tabling.c
--- runtime/mercury_tabling.c	1999/12/11 15:32:32	1.17
+++ runtime/mercury_tabling.c	2000/01/03 08:47:29
@@ -1,5 +1,5 @@
 /*
-** Copyright (C) 1997-1999 The University of Melbourne.
+** Copyright (C) 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.
 */
@@ -13,40 +13,106 @@
 /*---------------------------------------------------------------------------*/
 
 /*
-** this part defines the functions
-**	MR_int_hash_lookup_or_add(),
-**	MR_float_hash_lookup_or_add(), and
-** 	MR_string_hash_lookup_or_add().
+** This part deals with tabling using resizable hash tables.
 */
 
-/* Initial size of a new table */
-#define TABLE_START_SIZE primes[0]
+/*
+** All hash table slot structures have the same fields, since they are
+** manipulated by the same macro (MR_GENERIC_HASH_LOOKUP_OR_ADD).
+** The variable size part is at the end, in order to make all the offsets
+** the same.
+*/
 
+typedef struct MR_IntHashTableSlot_Struct	MR_IntHashTableSlot;
+typedef struct MR_FloatHashTableSlot_Struct	MR_FloatHashTableSlot;
+typedef struct MR_StringHashTableSlot_Struct	MR_StringHashTableSlot;
+
+typedef struct MR_AllocRecord_Struct		MR_AllocRecord;
+
+struct MR_IntHashTableSlot_Struct {
+	MR_IntHashTableSlot	*next;
+	MR_TableNode		data;
+	Integer			key;
+};
+
+struct MR_FloatHashTableSlot_Struct {
+	MR_FloatHashTableSlot	*next;
+	MR_TableNode		data;
+	Float			key;
+};
+
+struct MR_StringHashTableSlot_Struct {
+	MR_StringHashTableSlot	*next;
+	MR_TableNode		data;
+	String			key;
+};
+
+typedef	union {
+	MR_IntHashTableSlot	*int_slot_ptr;
+	MR_FloatHashTableSlot	*float_slot_ptr;
+	MR_StringHashTableSlot	*string_slot_ptr;
+} MR_HashTableSlotPtr;
+
+struct MR_AllocRecord_Struct {
+	MR_HashTableSlotPtr	chunk;
+	MR_AllocRecord		*next;
+};
+
 /*
-** Maximum ratio of used to unused buckets in the table. Must be less than
-** 0.9 if you want even poor lookup times.
+** Our hash table design uses separate chaining to avoid the bad worst case
+** behavior of open addressing. This is important, because the worst case
+** can be expected to occur reasonably often in tabling workloads. The reason
+** is that successive queries are not independent. Often, query N is a
+** recursive call made from query N-1, which means that its input values are
+** much more likely to fall into the same or next hash bucket than an
+** independent query's input values would, especially for integer values.
+** Repeated over many queries, such input pattern can give rise to "convoys",
+** long sequences of occupied hash table slots. Any input value whose search
+** for a free slot runs into the convoy will have very long search time.
+**
+** The `hash_table' field points to an array of `size' slots, each of which
+** is a pointer to a hash table slot; hash table slots have embedded `next'
+** pointers to chain together all the values that hash to the same value.
+**
+** To keep maximum chain lengths bounded (in a statistical sense), we record
+** the number of values in the table (in the `value_count' field), and when
+** this exceeds a certain fraction of the size of the hash table, we increase
+** the size of the hash table and rehash all the existing entries. We do this
+** when the value in the `value_count' field exceeds the one in the `threshold'
+** field, which is set to `size' times MAX_LOAD_FACTOR whenever the size
+** is changed. (This avoids a float multiplication on each insertion.)
+**
+** The reason why the hash table array contains pointers to slots instead of
+** the slots themselves is that the latter would equire the addresses of some
+** hash table slots (those in the array itself and not in a chain) to change
+** when the table is resized. As for why this is bad, see the documentation
+** of the MR_TableNode type in mercury_tabling.h.
+**
+** To avoid calling GC_malloc on each insertion, we allocate memory in chunks,
+** with each chunk containing CHUNK_SIZE hash table slots. The `freeleft'
+** field contains count of the number of hash table slots left in the space
+** allocated but not yet used; the `freespace' field point to the first
+** of these slots.
+**
+** This design leads to pointers into the middle of GC_malloc'd memory.
+** To make sure that the code works even without the boehm gc being compiled
+** with interior pointers, we retain pointers to all the chunks we have
+** allocated in the `allocrecord' field. This field has no purpose other than
+** to serve as roots for boehm gc.
 */
-#define MAX_EL_SIZE_RATIO 0.65
+
+struct MR_HashTable_Struct {
+	Integer			size;
+	Integer			threshold;
+	Integer			value_count;
+	MR_HashTableSlotPtr	*hash_table;
+	MR_HashTableSlotPtr	freespace;
+	Integer			freeleft;
+	MR_AllocRecord		*allocrecord;
+};
 
-/* Extract info from a table */
-#define SIZE(table)		(((TableRoot *) table)->size)
-#define ELEMENTS(table)	 	(((TableRoot *) table)->used_elements)
-#define BUCKET(table, Bucket) 	((TableNode **) &(((TableRoot *) table)-> \
-					elements))[(Bucket)]
-typedef struct {
-	Word key;
-	Word * data;
-} TableNode;
-
-typedef struct {
-	Word size;
-	Word used_elements;
-	Word elements;
-} TableRoot;
-
-static Word next_prime(Word);
-static Word * create_hash_table(Word);
-static void re_hash(Word *, Word, TableNode * Node);
+#define	CHUNK_SIZE	256
+#define MAX_LOAD_FACTOR	0.65
 
 /*
 ** Prime numbers which are close to powers of 2.  Used for choosing
@@ -58,12 +124,18 @@
     {127, 257, 509, 1021, 2053, 4099, 8191, 16381, 32771, 65537, 131071,
        262147, 524287, 1048573, 2097143, 4194301};
 
+/* Initial size of a new table */
+#define HASH_TABLE_START_SIZE primes[0]
+
+static	Integer	next_prime(Integer);
+
 /*
 ** Return the next prime number greater than the number received.
 ** If no such prime number can be found, compute an approximate one.
 */
-static Word
-next_prime(Word old_size)
+
+static Integer
+next_prime(Integer old_size)
 {
 	int i;
 
@@ -79,371 +151,435 @@
 	}
 }
 
-/* Create a new empty hash table. */
-static Word *
-create_hash_table(Word table_size)
-{
-   	Word i;
-	TableRoot * table =
-		table_allocate_bytes(sizeof(Word) * 2 +
-				table_size * sizeof(TableNode *));
-
-	table->size = table_size;
-	table->used_elements = 0;
-
-	for (i = 0; i < table_size; i++) {
-		BUCKET(table, i) = NULL;
-	}
-
-	return (Word *) table;
-}
-
 /*
-** Insert key and Data into a new hash table using the given hash.
-** this function does not have to do compares as the given key
-** is definitely not in the table.
+** The MR_GENERIC_HASH_LOOKUP_OR_ADD macro is intended to be the body of
+** a function that looks to see if the given key is in the given hash table.
+** If it is, it returns the address of the data pointer associated with
+** the key. If it is not, it creates a new slot for the key in the table
+** and returns the address of its data pointer.
+**
+** It in turn relies on three groups of macros to perform part of the task.
+**
+** The first group optionally records statistics about the number of successful
+** and unsuccessful searches, and the number of probes they needed. From this
+** information, one can compute the average successful and unsuccessful
+** search lengths.
+**
+** The second optionally prints debugging messages.
+**
+** The third implements the initial creation of the hash table.
 */
-static void
-re_hash(Word * table, Word hash, TableNode * node)
-{
-	Word bucket = hash % SIZE(table);
 
-	while (BUCKET(table, bucket)) {
-		++bucket;
-		if (bucket == SIZE(table))
-			bucket = 0;
-	}
-
-	BUCKET(table, bucket) = node;
-	++ELEMENTS(table);
-}
+#ifdef	MR_TABLE_STATISTICS
+static	Unsigned	MR_table_hash_resizes = 0;
+static	Unsigned	MR_table_hash_allocs  = 0;
+static	Unsigned	MR_table_hash_lookups = 0;
+static	Unsigned	MR_table_hash_inserts = 0;
+static	Unsigned	MR_table_hash_lookup_probes = 0;
+static	Unsigned	MR_table_hash_insert_probes = 0;
+#endif
+
+#ifdef	MR_TABLE_STATISTICS
+  #define declare_probe_count	Integer	probe_count = 0;
+  #define record_probe_count	do { probe_count++; } while (0)
+  #define record_lookup_count	do {					      \
+					MR_table_hash_lookup_probes +=	      \
+						probe_count;		      \
+					MR_table_hash_lookups++;	      \
+				} while (0)
+  #define record_insert_count	do {					      \
+					MR_table_hash_insert_probes +=	      \
+						probe_count;		      \
+					MR_table_hash_inserts++;	      \
+				} while (0)
+  #define record_resize_count	do { MR_table_hash_resizes++; } while (0)
+  #define record_alloc_count	do { MR_table_hash_allocs++; } while (0)
+#else
+  #define declare_probe_count
+  #define record_probe_count	((void) 0)
+  #define record_lookup_count	((void) 0)
+  #define record_insert_count	((void) 0)
+  #define record_resize_count	((void) 0)
+  #define record_alloc_count	((void) 0)
+#endif
+
+#ifdef	MR_TABLE_DEBUG
+  #define debug_key_msg(keyvalue, keyformat, keycast)			      \
+	do {								      \
+		if (MR_hashdebug) {					      \
+			printf("HT search key " keyformat "\n",		      \
+				(keycast) keyvalue);			      \
+		}							      \
+	} while (0)
+
+  #define debug_resize_msg(oldsize, newsize, newthreshold)		      \
+	do {								      \
+		if (MR_hashdebug) {					      \
+			printf("HT expanding table from %d to %d(%d)\n",      \
+				(oldsize), (newsize), (newthreshold));	      \
+		}							      \
+	} while (0)
+
+  #define debug_rehash_msg(rehash_bucket)				      \
+	do {								      \
+		if (MR_hashdebug) {					      \
+			printf("HT rehashing bucket: %d\n",		      \
+				(rehash_bucket));			      \
+		}							      \
+	} while (0)
+
+  #define debug_probe_msg(probe_bucket)					      \
+	do {								      \
+		if (MR_hashdebug) {					      \
+			printf("HT probing bucket: %d\n", (probe_bucket));    \
+		}							      \
+	} while (0)
+
+  #define debug_lookup_msg(home_bucket)					      \
+	do {								      \
+		if (MR_hashdebug) {					      \
+			printf("HT search successful in bucket: %d\n",	      \
+				(home_bucket));				      \
+		}							      \
+	} while (0)
+
+  #define debug_insert_msg(home_bucket)					      \
+	do {								      \
+		if (MR_hashdebug) {					      \
+			printf("HT search unsuccessful in bucket: %d\n",      \
+				(home_bucket));				      \
+		}							      \
+	} while (0)
+#else
+  #define debug_key_msg(keyvalue, keyformat, keycast)		((void) 0)
+  #define debug_resize_msg(oldsize, newsize, newthreshold)	((void) 0)
+  #define debug_rehash_msg(rehash_bucket)			((void) 0)
+  #define debug_probe_msg(probe_bucket)				((void) 0)
+  #define debug_lookup_msg(home_bucket)				((void) 0)
+  #define debug_insert_msg(home_bucket)				((void) 0)
+#endif
+
+#define	MR_CREATE_HASH_TABLE(table_ptr, table_type, table_field, table_size)  \
+	do {								      \
+		Word		i;					      \
+		MR_HashTable	*newtable;				      \
+									      \
+		newtable = MR_TABLE_NEW(MR_HashTable);			      \
+									      \
+		newtable->size = table_size;				      \
+		newtable->threshold = (Integer) ((float) table_size	      \
+				* MAX_LOAD_FACTOR);			      \
+		newtable->value_count = 0;				      \
+		newtable->freespace.table_field = NULL;			      \
+		newtable->freeleft = 0;					      \
+		newtable->allocrecord = NULL;				      \
+		newtable->hash_table = MR_TABLE_NEW_ARRAY(MR_HashTableSlotPtr,\
+				table_size);				      \
+									      \
+		for (i = 0; i < table_size; i++) {			      \
+			newtable->hash_table[i].table_field = NULL;	      \
+		}							      \
+									      \
+		table_ptr = newtable;					      \
+	} while (0)
+
+#define	MR_GENERIC_HASH_LOOKUP_OR_ADD					      \
+	MR_HashTable	*table;						      \
+	table_type	*slot;						      \
+	Integer		abs_hash;					      \
+	Integer		home;						      \
+	declare_probe_count						      \
+									      \
+	debug_key_msg(key, key_format, key_cast);			      \
+									      \
+	/* Has the table been built? */					      \
+	if (t->MR_hash_table == NULL) {					      \
+		MR_CREATE_HASH_TABLE(t->MR_hash_table, table_type,	      \
+			table_field, HASH_TABLE_START_SIZE);		      \
+	}								      \
+									      \
+	table = t->MR_hash_table; /* Deref the table pointer */		      \
+									      \
+	/* Rehash the table if it has grown too full */			      \
+	if (table->value_count > table->threshold) {			      \
+		MR_HashTableSlotPtr	*new_hash_table;		      \
+		int			new_size;			      \
+		int			new_threshold;			      \
+		int			old_bucket;			      \
+		int			new_bucket;			      \
+		table_type		*next_slot;			      \
+									      \
+		new_size = next_prime(table->size);			      \
+		new_threshold = (Integer) ((float) new_size		      \
+				* MAX_LOAD_FACTOR);			      \
+		debug_resize_msg(table->size, new_size, new_threshold);	      \
+		record_resize_count;					      \
+									      \
+		new_hash_table = MR_TABLE_NEW_ARRAY(MR_HashTableSlotPtr,      \
+				new_size);				      \
+		for (new_bucket = 0; new_bucket < new_size; new_bucket++) {   \
+			new_hash_table[new_bucket].table_field = NULL;	      \
+		}							      \
+									      \
+		for (old_bucket = 0; old_bucket < table->size; old_bucket++) {\
+			slot = table->hash_table[old_bucket].table_field;     \
+			while (slot != NULL) {				      \
+				debug_rehash_msg(old_bucket);		      \
+									      \
+				abs_hash = hash(slot->key);		      \
+				if (abs_hash < 0) {			      \
+					abs_hash = -abs_hash;		      \
+				}					      \
+									      \
+				new_bucket = abs_hash % new_size;	      \
+				next_slot = slot->next;			      \
+				slot->next = new_hash_table[new_bucket].      \
+					table_field;			      \
+				new_hash_table[new_bucket].table_field = slot;\
+									      \
+				slot = next_slot;			      \
+			}						      \
+		}							      \
+									      \
+		table_free(table->hash_table);				      \
+		table->hash_table = new_hash_table;			      \
+		table->size = new_size;					      \
+		table->threshold = new_threshold;			      \
+	}								      \
+									      \
+	abs_hash = hash(key);						      \
+	if (abs_hash < 0) {						      \
+		abs_hash = -abs_hash;					      \
+	}								      \
+									      \
+	home = abs_hash % table->size;					      \
+									      \
+	/* Find if the element is present. If not add it */		      \
+	slot = table->hash_table[home].table_field;			      \
+	while (slot != NULL) {						      \
+		debug_probe_msg(home);					      \
+		record_probe_count;					      \
+									      \
+		if (equal_keys(key, slot->key)) {			      \
+			record_lookup_count;				      \
+			debug_lookup_msg(home);				      \
+			return &slot->data;				      \
+		}							      \
+									      \
+		slot = slot->next;					      \
+	}								      \
+									      \
+	debug_insert_msg(home);						      \
+	record_insert_count;						      \
+									      \
+	if (table->freeleft == 0) {					      \
+		MR_AllocRecord	*record;				      \
+									      \
+		table->freespace.table_field = MR_TABLE_NEW_ARRAY(	      \
+				table_type, CHUNK_SIZE);		      \
+		table->freeleft = CHUNK_SIZE;				      \
+									      \
+		record = MR_TABLE_NEW(MR_AllocRecord);			      \
+		record->chunk.table_field = table->freespace.table_field;     \
+		record->next = table->allocrecord;			      \
+		table->allocrecord = record;				      \
+									      \
+		record_alloc_count;					      \
+	}								      \
+									      \
+	slot = table->freespace.table_field;				      \
+	table->freespace.table_field++;					      \
+	table->freeleft--;						      \
+									      \
+	slot->key = key;						      \
+	slot->data.MR_integer = 0;					      \
+	slot->next = table->hash_table[home].table_field;		      \
+	table->hash_table[home].table_field = slot;			      \
+									      \
+	table->value_count++;						      \
+									      \
+	return &slot->data;
 
-/*
-** Look to see if the given integer key is in the given table. If it
-** is return the address of the data pointer associated with the key.
-** If it is not; create a new element for the key in the table and
-** return the address of its data pointer.
-*/
 MR_TrieNode
 MR_int_hash_lookup_or_add(MR_TrieNode t, Integer key)
 {
-	TableNode * p, * q;
-	Word * table = *t;	/* Deref the table pointer */
-	Word bucket;
-
-	/* Has the the table been built? */
-	if (table == NULL) {
-		table = create_hash_table(TABLE_START_SIZE);
-		*t = table;
-	}
-
-	bucket = key % SIZE(table);
-	p = BUCKET(table, bucket);
-
-	/* Find if the element is present. If not add it */
-	while (p) {
-		if (key == p->key) {
-			return &p->data;
-		}
-
-		bucket++;
-		if (bucket == SIZE(table))
-			bucket = 0;
-
-		p = BUCKET(table, bucket);
-	}
-
-	p = table_allocate_bytes(sizeof(TableNode));
-	p->key = key;
-	p->data = NULL;
-
-	/* Rehash the table if it has grown to full */
-	if ((float) ELEMENTS(table) / (float) SIZE(table) >
-	   		MAX_EL_SIZE_RATIO)
-	{
-		int old_size = SIZE(table);
-		int new_size = next_prime(old_size);
-		Word * new_table = create_hash_table(new_size);
-		int i;
-
-		for (i = 0; i < old_size; i++) {
-			q = BUCKET(table, i);
-			if (q) {
-				re_hash(new_table, q->key, q);
-			}
-		}
-
-		/* Free the old table */
-		table_free(table);
-
-		/* Point to the new table */
-		*t = new_table;
-
-		/* Add a new element */
-		re_hash(new_table, key, p);
-	} else {
-		BUCKET(table, bucket) = p;
-		++ELEMENTS(table);
-	}
-
-	return &p->data;
+#define	key_format		"%ld"
+#define	key_cast		long
+#define	table_type		MR_IntHashTableSlot
+#define	table_field		int_slot_ptr
+#define	hash(key)		(key)
+#define	equal_keys(k1, k2)	(k1 == k2)
+MR_GENERIC_HASH_LOOKUP_OR_ADD
+#undef	key_format
+#undef	key_cast
+#undef	table_type
+#undef	table_field
+#undef	hash(key)
+#undef	equal_keys(k1, k2)
 }
 
-/*
-** Look to see if the given float key is in the given table. If it
-** is return the address of the data pointer associated with the key.
-** If it is not create a new element for the key in the table and
-** return the address of its data pointer.
-*/
 MR_TrieNode
 MR_float_hash_lookup_or_add(MR_TrieNode t, Float key)
 {
-	TableNode	*p, *q;
-	Word		*table = *t;	/* Deref the table pointer */
-	Word		bucket;
-	Word		hash;
-
-	/* Has the the table been built? */
-	if (table == NULL) {
-		table = create_hash_table(TABLE_START_SIZE);
-		*t = table;
-	}
-
-	hash = hash_float(key);
-	bucket = hash % SIZE(table);
-
-	p = BUCKET(table, bucket);
-
-	/* Find if the element is present. If not add it */
-	while (p) {
-		if (key == word_to_float(p->key)) {
-			return &p->data;
-		}
-
-		++bucket;
-		if (bucket == SIZE(table))
-			bucket = 0;
-
-		p = BUCKET(table, bucket);
-	}
-
-	p = table_allocate_bytes(sizeof(TableNode));
-	p->key = float_to_word(key);
-	p->data = NULL;
-
-	/* Rehash the table if it has grown to full */
-	if ((float) ELEMENTS(table) / (float) SIZE(table) >
-	   		MAX_EL_SIZE_RATIO)
-	{
-		int old_size = SIZE(table);
-		int new_size = next_prime(old_size);
-		Word * new_table = create_hash_table(new_size);
-		int i;
-
-		for (i = 0; i < old_size; i++) {
-			q = BUCKET(table, i);
-			if (q) {
-				re_hash(new_table, hash_float(q->key), q);
-			}
-		}
-
-		/* Free the old table */
-		table_free(table);
-
-		/* Point to the new table */
-		*t = new_table;
-
-		/* Add a new element */
-		re_hash(new_table, hash, p);
-	} else {
-		++ELEMENTS(table);
-		BUCKET(table, bucket) = p;
-	}
-
-	return &p->data;
+#define	key_format		"%f"
+#define	key_cast		double
+#define	table_type		MR_FloatHashTableSlot
+#define	table_field		float_slot_ptr
+#define	hash(key)		(hash_float(key))
+#define	equal_keys(k1, k2)	(k1 == k2)
+MR_GENERIC_HASH_LOOKUP_OR_ADD
+#undef	key_format
+#undef	key_cast
+#undef	debug_search_key
+#undef	table_type
+#undef	table_field
+#undef	hash(key)
+#undef	equal_keys(k1, k2)
 }
 
-
-
-/*
-** Look to see if the given string key is in the given table. If it
-** is return the address of the data pointer associated with the key.
-** If it is not create a new element for the key in the table and
-** return the address of its data pointer.
-*/
 MR_TrieNode
 MR_string_hash_lookup_or_add(MR_TrieNode t, String key)
 {
-	TableNode * p, * q;
-	Word * table = *t;	/* Deref the table pointer */
-	Word bucket;
-	Word hash;
-
-	/* Has the the table been built? */
-	if (table == NULL) {
-		table = create_hash_table(TABLE_START_SIZE);
-		*t = table;
-	}
-
-	hash = hash_string((Word) key);
-	bucket = hash % SIZE(table);
-
-	p = BUCKET(table, bucket);
-
-	/* Find if the element is present. */
-	while (p) {
-		int res = strtest((String)p->key, key);
-
-		if (res == 0) {
-			return &p->data;
-		}
-
-		++bucket;
-		if (bucket == SIZE(table))
-			bucket = 0;
-
-		p = BUCKET(table, bucket);
-	}
-
-	p = table_allocate_bytes(sizeof(TableNode));
-	p->key = (Word) key;
-	p->data = NULL;
-
-	/* Rehash the table if it has grown to full */
-	if ((float) ELEMENTS(table) / (float) SIZE(table) >
-	   		MAX_EL_SIZE_RATIO)
-	{
-		int old_size = SIZE(table);
-		int new_size = next_prime(old_size);
-		Word * new_table = create_hash_table(new_size);
-		int i;
-
-		for (i = 0; i < old_size; i++) {
-			q = BUCKET(table, i);
-			if (q) {
-				re_hash(new_table,
-					hash_string((Word) q->key), q);
-			}
-		}
-
-		/* Free the old table */
-		table_free(t);
-
-		/* Point to the new table */
-		*t = new_table;
-
-		/* Add a new element to rehashed table */
-		re_hash(new_table, hash, p);
-	} else {
-		BUCKET(table, bucket) = p;
-		++ELEMENTS(table);
-	}
-
-	return &p->data;
+#define	key_format		"%s"
+#define	key_cast		char *
+#define	table_type		MR_StringHashTableSlot
+#define	table_field		string_slot_ptr
+#define	hash(key)		(hash_string((Word) key))
+#define	equal_keys(k1, k2)	(strtest(k1, k2) == 0)
+MR_GENERIC_HASH_LOOKUP_OR_ADD
+#undef	key_format
+#undef	key_cast
+#undef	debug_search_key
+#undef	table_type
+#undef	table_field
+#undef	hash(key)
+#undef	equal_keys(k1, k2)
 }
 
 /*---------------------------------------------------------------------------*/
 
-/*
-** This part defines the MR_int_index_lookup_or_add() function.
-*/
-
-#define ELEMENT(Table, Key) ((Word**)&((Table)[Key]))
-
 /*
-**  MR_int_index_lookup_or_add() : This function maintains a simple indexed
-**	table of size Range.
+** This part deals with tabling using fixed size tables simply indexed
+** by a given integer. t->MR_fix_table[i] contains the trie node for
+** key i.
 */
 
 MR_TrieNode
-MR_int_index_lookup_or_add(MR_TrieNode t, Integer range, Integer key)
+MR_int_fix_index_lookup_or_add(MR_TrieNode t, Integer range, Integer key)
 {
-	Word *table = *t;		/* Deref table */
+	if (t->MR_fix_table == NULL) {
+		t->MR_fix_table = MR_TABLE_NEW_ARRAY(MR_TableNode, range);
+		memset(t->MR_fix_table, 0, sizeof(MR_TableNode) * range);
+	}
 
 #ifdef	MR_TABLE_DEBUG
 	if (key >= range) {
-		fatal_error("MR_int_index_lookup_or_add: key out of range");
+		fatal_error("MR_int_fix_index_lookup_or_add: key out of range");
 	}
 #endif
-
-	if (table == NULL) {
-		*t = table = table_allocate_words(range);
-		memset(table, 0, sizeof(Word *) * range);
-	}
 
-	return ELEMENT(table, key);
+	return &t->MR_fix_table[key];
 }
 
-#undef ELEMENT
-
 /*---------------------------------------------------------------------------*/
 
 /*
-** This part defines the type_info_lookup_or_add() function.
+** This part deals with tabling using expandable tables simply indexed
+** by the given integer minus a given starting point. t->MR_start_table[i+1]
+** contains the trie node for key i - start. t->MR_start_table[0] contains
+** the number of trienode slots currently allocated for the array; this does
+** not include the slot used for the zeroeth element.
 */
 
-typedef struct TreeNode_struct {
-	Word * key;
-	Word value;
-	struct TreeNode_struct * right;
-	struct TreeNode_struct * left;
-} TreeNode;
+#define	MR_START_TABLE_INIT_SIZE	1024
 
 MR_TrieNode
-MR_type_info_lookup_or_add(MR_TrieNode table, Word * type_info)
+MR_int_start_index_lookup_or_add(MR_TrieNode table, Integer start, Integer key)
 {
-	TreeNode *p, *q;
-	int i;
+	Integer	diff, size;
 
-	if (*table == NULL) {
-		p = table_allocate_bytes(sizeof(TreeNode));
+	diff = key - start;
 
-		p->key = type_info;
-		p->value = (Word) NULL;
-		p->left = NULL;
-		p->right = NULL;
-
-		*table = (Word *) p;
+#ifdef	MR_TABLE_DEBUG
+	if (key < start) {
+		fatal_error("MR_int_start_index_lookup_or_add: small too key");
+	}
+#endif
 
-		return (Word**) &p->value;
+	if (table->MR_start_table == NULL) {
+		size = max(MR_START_TABLE_INIT_SIZE, diff + 1);
+		table->MR_start_table = MR_TABLE_NEW_ARRAY(MR_TableNode,
+					size + 1);
+		memset(table->MR_start_table + 1, 0,
+					sizeof(MR_TableNode) * size);
+		table->MR_start_table[0].MR_integer = size;
+	} else {
+		size = table->MR_start_table[0].MR_integer;
 	}
 
-	p = (TreeNode *) *table;
+	if (diff >= size) {
+		MR_TableNode	*new_array;
+		Integer		new_size, i;
 
-	while (p != NULL) {
-		i = MR_compare_type_info((Word) p->key, (Word) type_info);
+		new_size = max(2 * size, diff + 1);
+		new_array = MR_TABLE_NEW_ARRAY(MR_TableNode, new_size + 1);
 
-		if (i == COMPARE_EQUAL) {
-			return (Word **) &p->value;
-		}
+		new_array[0].MR_integer = new_size;
 
-		q = p;
+		for (i = 0; i < size; i++) {
+			new_array[i + 1] = table->MR_start_table[i + 1];
+		}
 
-		if (i == COMPARE_LESS) {
-			p = p->left;
-		} else {
-			p = p->right;
+		for (; i < new_size; i++) {
+			new_array[i + 1].MR_integer = 0;
 		}
+
+		table->MR_start_table = new_array;
 	}
 
-	p = table_allocate_bytes(sizeof(TreeNode));
-	p->key = type_info;
-	p->value = (Word) NULL;
-	p->left = NULL;
-	p->right = NULL;
+	return &table->MR_start_table[diff + 1];
+}
 
-	if (i == COMPARE_LESS) {
-		q->left = p;
-	} else {
-		q ->right = p;
+/*---------------------------------------------------------------------------*/
+
+MR_TrieNode
+MR_type_info_lookup_or_add(MR_TrieNode table, Word *type_info)
+{
+	MR_TypeInfo	collapsed_type_info;
+	MR_TypeCtorInfo	type_ctor_info;
+	MR_TrieNode	node;
+	Word		**type_info_args;
+	int		i;
+
+	/* XXX memory allocation here should be optimized */
+	collapsed_type_info = MR_collapse_equivalences((Word) type_info);
+
+	type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(
+			(Word *) collapsed_type_info);
+	node = MR_int_hash_lookup_or_add(table, (Integer) type_ctor_info);
+
+	/*
+	** All calls to MR_type_info_lookup_or_add that have the same value
+	** of node at this point agree on the type_ctor_info of the type
+	** being tabled. They must therefore also agree on its arity.
+	** This is why looping over all the arguments works.
+	**
+	** If collapsed_type_info has a zero-arity type_ctor, then it may be
+	** stored using a one-cell type_info, and type_info_args does not make
+	** sense. This is OK, because in that case it will never be used.
+	*/
+
+	type_info_args = (Word **) collapsed_type_info;
+
+	for (i = 1; i <= type_ctor_info->arity; i++) {
+		node = MR_type_info_lookup_or_add(node, type_info_args[i]);
 	}
 
-	return (Word **) &p->value;
+	return node;
 }
 
 /*---------------------------------------------------------------------------*/
 
-
 /*
 ** This part defines the MR_table_type() function.
 */
@@ -454,7 +590,7 @@
 /*
 ** Due to the depth of the control here, we'll use 4 space indentation.
 **
-** NOTE : changes to this function will probably also have to be reflected
+** NOTE: changes to this function will probably also have to be reflected
 ** in mercury_deep_copy.c and std_util::ML_expand().
 */
 
@@ -607,7 +743,7 @@
             break;
 
         case MR_TYPECTOR_REP_STRING:
-            MR_DEBUG_TABLE_STRING(table, data);
+            MR_DEBUG_TABLE_STRING(table, (String) data);
             break;
 
         case MR_TYPECTOR_REP_PRED: {
@@ -722,6 +858,45 @@
 
 /*---------------------------------------------------------------------------*/
 
+void
+MR_table_report_statistics(FILE *fp)
+{
+	fprintf(fp, "hash table search statistics:\n");
+
+#ifdef	MR_TABLE_STATISTICS
+	if (MR_table_hash_lookups == 0) {
+		fprintf(fp, "no successful searches\n");
+	} else {
+		fprintf(fp, "successful   %6d, "
+				"with an average of %6.3f comparisons\n",
+			MR_table_hash_lookups,
+			(float) MR_table_hash_lookup_probes /
+				(float) MR_table_hash_lookups);
+	}
+
+	if (MR_table_hash_inserts == 0) {
+		fprintf(fp, "no unsuccessful searches\n");
+	} else {
+		fprintf(fp, "unsuccessful %6d, "
+				"with an average of %6.3f comparisons\n",
+			MR_table_hash_inserts,
+			(float) MR_table_hash_insert_probes /
+				(float) MR_table_hash_inserts);
+	}
+
+	fprintf(fp, "rehash operations: %d, per search: %6.3f%%\n",
+			MR_table_hash_resizes,
+			(float) (100 * MR_table_hash_resizes) /
+			(float) (MR_table_hash_lookups
+				 + MR_table_hash_inserts));
+	fprintf(fp, "chunk allocations: %d\n", MR_table_hash_allocs);
+#else
+	fprintf(fp, "not enabled\n");
+#endif
+}
+
+/*---------------------------------------------------------------------------*/
+
 #ifdef	MR_USE_MINIMAL_MODEL
 
 /*
@@ -1199,7 +1374,8 @@
 
 Define_entry(mercury__table_nondet_suspend_2_0);
 {
-	MR_Subgoal	*table;
+	MR_TrieNode	table;
+	MR_Subgoal	*subgoal;
 	MR_Consumer	*consumer;
 	MR_ConsumerList	listnode;
 	Integer		cur_gen;
@@ -1219,13 +1395,14 @@
 	*/
 	MR_mkframe("mercury__table_nondet_suspend", 1, ENTRY(do_fail));
 
-	table = MR_SUBGOAL(r1);
+	table = (MR_TrieNode) r1;
+	subgoal = table->MR_subgoal;
 	consumer = table_allocate_bytes(sizeof(MR_Consumer));
-	consumer->remaining_answer_list_ptr = &table->answer_list;
+	consumer->remaining_answer_list_ptr = &subgoal->answer_list;
 
 	save_transient_registers();
 	save_state(&(consumer->saved_state),
-		table->generator_maxfr, table->generator_sp,
+		subgoal->generator_maxfr, subgoal->generator_sp,
 		"suspension", "consumer");
 	restore_transient_registers();
 
@@ -1247,7 +1424,9 @@
 #endif
 
 		if (fr == MR_gen_stack[cur_gen].generator_frame) {
-			if (MR_gen_stack[cur_gen].generator_table == table) {
+			if (MR_gen_stack[cur_gen].generator_table->MR_subgoal
+					== subgoal)
+			{
 				/*
 				** This is the nondet stack frame of the
 				** generator corresponding to this consumer.
@@ -1292,8 +1471,9 @@
 
 				save_transient_registers();
 				make_subgoal_follow_leader(
-					MR_gen_stack[cur_gen].generator_table,
-					table);
+					MR_gen_stack[cur_gen].
+						generator_table->MR_subgoal,
+					subgoal);
 				restore_transient_registers();
 			}
 
@@ -1324,15 +1504,15 @@
 #ifdef	MR_TABLE_DEBUG
 	if (MR_tabledebug) {
 		printf("adding suspension node %p to table %p",
-			(void *) consumer, (void *) table);
-		printf(" at slot %p\n", table->consumer_list_tail);
+			consumer, subgoal);
+		printf(" at slot %p\n", subgoal->consumer_list_tail);
 	}
 #endif
 
-	assert(*(table->consumer_list_tail) == NULL);
-	listnode = table_allocate_bytes(sizeof(struct MR_ConsumerListNode));
-	*(table->consumer_list_tail) = listnode;
-	table->consumer_list_tail = &(listnode->next);
+	assert(*(subgoal->consumer_list_tail) == NULL);
+	listnode = table_allocate_bytes(sizeof(MR_ConsumerListNode));
+	*(subgoal->consumer_list_tail) = listnode;
+	subgoal->consumer_list_tail = &(listnode->next);
 	listnode->item = consumer;
 	listnode->next = NULL;
 }
@@ -1439,7 +1619,7 @@
 		}
 #endif
 	} else {
-		MR_cur_leader->resume_info = MR_GC_NEW(MR_ResumeInfo);
+		MR_cur_leader->resume_info = MR_TABLE_NEW(MR_ResumeInfo);
 
 		save_transient_registers();
 		save_state(&(MR_cur_leader->resume_info->leader_state),
@@ -1586,7 +1766,6 @@
 	** since will not have changed in the meantime.
 	*/
 
-
 	r1 = (Word) &MR_cur_leader->resume_info->cur_consumer_answer_list->
 		answer_data;
 
@@ -1690,7 +1869,7 @@
 	MR_fail();
 END_MODULE
 
-#endif
+#endif	/* MR_USE_MINIMAL_MODEL */
 
 /* Ensure that the initialization code for the above modules gets to run. */
 /*
Index: runtime/mercury_tabling.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.h,v
retrieving revision 1.16
diff -u -b -r1.16 mercury_tabling.h
--- runtime/mercury_tabling.h	1999/10/26 14:17:56	1.16
+++ runtime/mercury_tabling.h	2000/01/03 08:47:30
@@ -1,5 +1,5 @@
 /*
-** Copyright (C) 1997-1999 The University of Melbourne.
+** Copyright (C) 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.
 */
@@ -16,529 +16,128 @@
 #define	MERCURY_TABLING_H
 
 #include "mercury_types.h"
+#include "mercury_type_info.h"
 #include "mercury_float.h"
 
 #ifndef CONSERVATIVE_GC
   #include "mercury_deep_copy.h"
 #endif
 
-/*---------------------------------------------------------------------------*/
-/*
-** The functions defined here are used only via the macros defined below.
-*/
+#include <stdio.h>
 
-typedef Word	**MR_TrieNode;
-typedef Word	**MR_AnswerBlock;
-
-/* functions to handle the builtin types: string, int, float, type_info */
-
-/* 
-** Look to see if the given integer key is in the given table. If it
-** is, return the address of the data pointer associated with the key.
-** If it is not, create a new element for the key in the table and
-** return the address of its data pointer.
-**/
-MR_TrieNode MR_int_hash_lookup_or_add(MR_TrieNode Table, Integer Key);
-
-/* 
-** Look to see if the given float key is in the given table. If it
-** is return the address of the data pointer associated with the key.
-** If it is not create a new element for the key in the table and
-** return the address of its data pointer.
-**/
-MR_TrieNode MR_float_hash_lookup_or_add(MR_TrieNode Table, Float Key);
-
-/* 
-** Look to see if the given string key is in the given table. If it
-** is return the address of the data pointer associated with the key.
-** If it is not create a new element for the key in the table and
-** return the address of its data pointer.
-**/
-MR_TrieNode MR_string_hash_lookup_or_add(MR_TrieNode Table, String Key);
+/*---------------------------------------------------------------------------*/
 
 /*
-** Lookup or insert the given type_info into the given table. Return a 
-** pointer to the node of the table reached by the lookup/insert. 
+** Forward declarations of type names.
 */
-MR_TrieNode MR_type_info_lookup_or_add(MR_TrieNode, Word *);
 
-/* --- a function to handle enumerated types --- */
+typedef	union MR_TableNode_Union		MR_TableNode;
+typedef	struct MR_HashTable_Struct		MR_HashTable;
+typedef	struct MR_Subgoal_Struct		MR_Subgoal;
+typedef	struct MR_SubgoalListNode_Struct	MR_SubgoalListNode;
+typedef	struct MR_AnswerListNode_Struct		MR_AnswerListNode;
+typedef	struct MR_ConsumerListNode_Struct	MR_ConsumerListNode;
+
+typedef MR_TableNode				*MR_TrieNode;
+typedef	MR_SubgoalListNode			*MR_SubgoalList;
+typedef	MR_AnswerListNode			*MR_AnswerList;
+typedef	MR_ConsumerListNode			*MR_ConsumerList;
 
-/*
-**  MR_int_index_lookup_or_add() : This function maintains a simple indexed 
-**	table of size Range. The return value is a pointer to the table
-** 	node found by the lookup/insert. 
-*/
-MR_TrieNode MR_int_index_lookup_or_add(MR_TrieNode table, Integer range, Integer key);
-
-/* --- a function to handle any type at all --- */
+/*---------------------------------------------------------------------------*/
 
 /*
-** This function will lookup or insert any type of value into a 
-** table. It uses the provided type_info to extract the necessary
-** info to do this. It returns a pointer to the node found by the 
-** insertion/lookup.
+** Tabling builds up two kinds of tables, both conceptually tries. For call
+** tables, there is one layer in the trie for each input argument; for answer
+** tables, there is one layer in the trie for each output argument. However,
+** the way each trie node is implemented depends on the type of the relevant
+** argument. In addition, what is stored at the tips of the call and answer
+** tables also depends on what kind of tabling (e.g. loopcheck, memo, minimal
+** model) is being performed on the current predicate, and (in some cases)
+** on what stage the execution of the current predicate has reached.
+**
+** We declare trie nodes to have type MR_TrieNode, which is a pointer to
+** MR_TableNode. MR_TableNode is a union of all the types that we may need
+** to be able to store in trie nodes: various kinds of trie implementations,
+** status indications, and answer blocks. Since in several places we write
+** to the union through one member and read from it through another, it is
+** important that all members be the same size; this is why the simple table
+** status field is an (unsigned) integer, not an enum.
+**
+** The integer field is by generic code that does not know what kind of node
+** the node will be; this means initialization. A value of zero means the node
+** is uninitialized; this must be true for all members. (Also, see below on
+** duplicate detection.)
+**
+** The hash table field is used when the "trie" node is implemented with a
+** hash table, whether of ints, floats, strings or another type that can be
+** coerced to one of these types.
+**
+** The fix table field implements a true trie node of fixed size, simply
+** indexed by an integer.
+**
+** The start table field implements a dynamically expandable trie node,
+** simply indexed by the difference between an integer value and a start value.
+**
+** The MR_simpletable_status member of the union gives the status of a
+** model_det or model_semi subgoal; it should be interpreted using the
+** MR_SIMPLETABLE_* macros below. Note that this word, which is at the end of
+** the chain of trie nodes given by the input arguments of the tabled subgoal,
+** will be overwritten by a pointer to the answer block containing the output
+** arguments when the goal succeeds; the MR_SIMPLETABLE_SUCCEEDED status code
+** is used only when the goal has no outputs, and this no answer block.
+** This is why MR_SIMPLETABLE_SUCCEEDED must have the highest value, and
+** why code looking at MR_simpletable_status must test for success with
+** "table->MR_simpletable_status >= MR_SIMPLETABLE_SUCCEEDED".
+**
+** The subgoal field contains the status of a model_non subgoal.
+**
+** The answer block field contains a pointer to an array of words, with
+** one word per output argument.
+**
+** The hash table, fix table and start table members may appear at any interior
+** node in the trie. The simple table status and subgoal members only appear
+** at the tips of call tables. The answer block member appears only at the tips
+** of call tables, either directly (for model_det and model_semi procedures),
+** or indirectly inside answer lists (for model_non procedures). There are no
+** answer tables for model_det and model_semi procedures, since they can only
+** ever have at most one answer. You can of course have answer tables for
+** model_non procedures, at whose tips you find only a duplicate indication.
+** When the tip nodes of answer tables are created, they are initialized to
+** zero as usual. Duplicate checking checks that the tip node is zero and
+** then sets the tip to a nonzero value; this way if the answer is generated
+** again, duplicate checking will fail.
+**
+** Note that once a tabled predicate has inserted its input arguments into
+** its table and got back a pointer to the MR_TableNode representing the
+** selected tip of its call table, it may in general call other tabled
+** predicates and cause insertions into many tables, including its own,
+** before it updates the call table tip node. This means that the tip node
+** must not change address; once a tabling operation has returned an
+** MR_TrieNode to its caller, that address must be valid and have the same
+** meaning until the end of the computation.
+**
+** The implementation of start tables currently does not obey this requirement.
+** This is okay, for two reasons. First, start tables are not yet used. Second,
+** when they are used, they will be used by I/O tabling, which guarantees that
+** 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.
 */
-MR_TrieNode MR_table_type(MR_TrieNode Table, Word *type_info, Word data_value);
-
-/*---------------------------------------------------------------------------*/
-
-#define MR_RAW_TABLE_ANY(Table, TypeInfo, Value)			\
-	MR_table_type(Table, (Word *) TypeInfo, Value)
-
-#define MR_RAW_TABLE_TAG(Table, Tag)					\
-	MR_int_index_lookup_or_add(Table, 1 << TAGBITS, Tag)
-
-#define MR_RAW_TABLE_ENUM(Table, Range, Value)				\
-	MR_int_index_lookup_or_add(Table, Range, Value)
-
-#define MR_RAW_TABLE_WORD(Table, Value)					\
-	MR_int_hash_lookup_or_add(Table, (Integer) Value);
-
-#define MR_RAW_TABLE_INT(Table, Value)					\
-	MR_int_hash_lookup_or_add(Table, Value);
-
-#define MR_RAW_TABLE_CHAR(Table, Value)					\
-	MR_int_hash_lookup_or_add(Table, (Integer) Value);
-
-#define MR_RAW_TABLE_FLOAT(Table, Value)				\
-	MR_float_hash_lookup_or_add(Table, Value);
-
-#define MR_RAW_TABLE_STRING(Table, Value)	 			\
-	MR_string_hash_lookup_or_add(Table, (String) Value);
-
-#define MR_RAW_TABLE_TYPE_INFO(Table, Type)				\
-	MR_type_info_lookup_or_add(Table, (Word *) Type)
-
-#ifdef	MR_TABLE_DEBUG
-
-#define	MR_DEBUG_NEW_TABLE_ANY(table, table0, type_info, value)		\
-	do {								\
-		(table) = (Word) MR_RAW_TABLE_ANY((Word **) (table0),	\
-					(type_info), (value));		\
-		if (MR_tabledebug) {					\
-			printf("TABLE %p: any %x type %p => %p\n",	\
-				(Word **) (table0), (value), 		\
-				(Word **) (type_info), (Word **) (table));\
-		}							\
-	} while (0)
-#define	MR_DEBUG_TABLE_ANY(table, type_info, value)			\
-	do {								\
-		MR_TrieNode prev_table = (table);			\
-		(table) = (Word **) MR_RAW_TABLE_ANY((table), 		\
-					(type_info), (value));		\
-		if (MR_tabledebug) {					\
-			printf("TABLE %p: any %x type %p => %p\n",	\
-				prev_table, (value), (type_info),	\
-				(table));				\
-		}							\
-	} while (0)
-
-#define	MR_DEBUG_NEW_TABLE_TAG(table, table0, value)			\
-	do {								\
-		(table) = (Word) MR_RAW_TABLE_TAG((Word **) (table0),	\
-					(value));			\
-		if (MR_tabledebug) {					\
-			printf("TABLE %p: tag %d => %p\n", 		\
-				(Word **) (table0), (value), 		\
-				(Word **) (table))			\
-		}							\
-	} while (0)
-#define	MR_DEBUG_TABLE_TAG(table, value)				\
-	do {								\
-		MR_TrieNode prev_table = (table);			\
-		(table) = (Word **) MR_RAW_TABLE_TAG((table), (value));	\
-		if (MR_tabledebug) {					\
-			printf("TABLE %p: tag %d => %p\n", prev_table,	\
-				(value), (table));			\
-		}							\
-	} while (0)
-
-#define	MR_DEBUG_NEW_TABLE_ENUM(table, table0, count, value)		\
-	do {								\
-		(table) = (Word) MR_RAW_TABLE_ENUM((Word **) (table0),	\
-					(count), (value));		\
-		if (MR_tabledebug) {					\
-			printf("TABLE %p: enum %d of %d => %p\n", 	\
-				(Word **) (table0), (value), (count),	\
-				(Word **) (table));			\
-		}							\
-	} while (0)
-#define	MR_DEBUG_TABLE_ENUM(table, count, value)			\
-	do {								\
-		MR_TrieNode prev_table = (table);			\
-		(table) = (Word **) MR_RAW_TABLE_ENUM((table), (count),	\
-					(value));			\
-		if (MR_tabledebug) {					\
-			printf("TABLE %p: enum %d of %d => %p\n", 	\
-				prev_table, (value), (count), (table));	\
-		}							\
-	} while (0)
-
-#define	MR_DEBUG_NEW_TABLE_WORD(table, table0, value)			\
-	do {								\
-		(table) = (Word) MR_RAW_TABLE_WORD((Word **) (table0),	\
-					(value));			\
-		if (MR_tabledebug) {					\
-			printf("TABLE %p: word %d => %p\n",		\
-				(Word **) (table0), (value),		\
-				(Word **) (table));			\
-		}							\
-	} while (0)
-#define	MR_DEBUG_TABLE_WORD(table, value)				\
-	do {								\
-		MR_TrieNode prev_table = (table);			\
-		(table) = (Word **) MR_RAW_TABLE_WORD((table), (value));\
-		if (MR_tabledebug) {					\
-			printf("TABLE %p: word %d => %p\n",		\
-				prev_table, (value), (table));		\
-		}							\
-	} while (0)
-
-#define	MR_DEBUG_NEW_TABLE_INT(table, table0, value)			\
-	do {								\
-		(table) = (Word) MR_RAW_TABLE_INT((Word **) (table0),	\
-					(value));			\
-		if (MR_tabledebug) {					\
-			printf("TABLE %p: int %d => %p\n",		\
-				(Word **) (table0), (value),		\
-				(Word **) (table));			\
-		}							\
-	} while (0)
-#define	MR_DEBUG_TABLE_INT(table, value)				\
-	do {								\
-		MR_TrieNode prev_table = (table);			\
-		(table) = (Word **) MR_RAW_TABLE_INT((table), (value));	\
-		if (MR_tabledebug) {					\
-			printf("TABLE %p: int %d => %p\n",		\
-				prev_table, (value), (table));		\
-		}							\
-	} while (0)
-
-#define	MR_DEBUG_NEW_TABLE_CHAR(table, table0, value)			\
-	do {								\
-		(table) = (Word) MR_RAW_TABLE_CHAR((Word **) (table0),	\
-					(value));			\
-		if (MR_tabledebug) {					\
-			printf("TABLE %p: char `%c'/%d => %p\n",	\
-				(Word **) (table0), (int) (value),	\
-				(int) (value), (Word **) (table));	\
-		}							\
-	} while (0)
-#define	MR_DEBUG_TABLE_CHAR(table, value)				\
-	do {								\
-		MR_TrieNode prev_table = (table);			\
-		(table) = (Word **) MR_RAW_TABLE_CHAR((table), (value));\
-		if (MR_tabledebug) {					\
-			printf("TABLE %p: char `%c'/%d => %p\n",	\
-				prev_table, (int) (value), 		\
-				(int) (value), (table));		\
-		}							\
-	} while (0)
-
-#define	MR_DEBUG_NEW_TABLE_FLOAT(table, table0, value)			\
-	do {								\
-		(table) = (Word) MR_RAW_TABLE_FLOAT((Word **) (table0),	\
-					(value));			\
-		if (MR_tabledebug) {					\
-			printf("TABLE %p: float %f => %p\n",		\
-				(Word **) (table0), value,		\
-				(Word **) (table));			\
-		}							\
-	} while (0)
-#define	MR_DEBUG_TABLE_FLOAT(table, value)				\
-	do {								\
-		MR_TrieNode prev_table = (table);			\
-		(table) = (Word **) MR_RAW_TABLE_FLOAT((table), (value));\
-		if (MR_tabledebug) {					\
-			printf("TABLE %p: float %f => %p\n",		\
-				prev_table, (double) word_to_float(value),\
-				(table));				\
-		}							\
-	} while (0)
-
-#define	MR_DEBUG_NEW_TABLE_STRING(table, table0, value)			\
-	do {								\
-		(table) = (Word) MR_RAW_TABLE_STRING((Word **) (table0),\
-					(value));			\
-		if (MR_tabledebug) {					\
-			printf("TABLE %p: string `%s' => %p\n",		\
-				(Word **) (table), (char *) (value),	\
-				(Word **) (table));			\
-		}							\
-	} while (0)
-#define	MR_DEBUG_TABLE_STRING(table, value)				\
-	do {								\
-		MR_TrieNode prev_table = (table);			\
-		(table) = (Word **) MR_RAW_TABLE_STRING((table), (value));\
-		if (MR_tabledebug) {					\
-			printf("TABLE %p: string `%s' => %p\n",		\
-				prev_table, (char *) (value), (table));	\
-		}							\
-	} while (0)
-
-#define	MR_DEBUG_NEW_TABLE_TYPEINFO(table, table0, value)		\
-	do {								\
-		(table) = (Word) MR_RAW_TABLE_TYPE_INFO((Word **) (table0),\
-					(value));			\
-		if (MR_tabledebug) {					\
-			printf("TABLE %p: typeinfo %p => %p\n",		\
-				(Word **) (table), (Word **) (value), 	\
-				(Word **) (table));			\
-		}							\
-	} while (0)
-#define	MR_DEBUG_TABLE_TYPEINFO(table, value)				\
-	do {								\
-		MR_TrieNode prev_table = (table);			\
-		(table) = (Word **) MR_RAW_TABLE_TYPE_INFO((table), (value));\
-		if (MR_tabledebug) {					\
-			printf("TABLE %p: typeinfo %p => %p\n",		\
-				prev_table, (value), (table));		\
-		}							\
-	} while (0)
-
-#else	/* not MR_TABLE_DEBUG */
-
-#define	MR_DEBUG_NEW_TABLE_ANY(table, table0, type_info, value)		\
-	do {								\
-		(table) = (Word) MR_RAW_TABLE_ANY((Word **) (table0),	\
-					(type_info), (value));		\
-	} while (0)
-#define	MR_DEBUG_TABLE_ANY(table, type_info, value)			\
-	do {								\
-		(table) = (Word **) MR_RAW_TABLE_ANY((table),		\
-					(type_info), (value));		\
-	} while (0)
-
-#define	MR_DEBUG_NEW_TABLE_TAG(table, table0, value)			\
-	do {								\
-		(table) = (Word) MR_RAW_TABLE_TAG((Word **) (table0),	\
-					(value));			\
-	} while (0)
-#define	MR_DEBUG_TABLE_TAG(table, value)				\
-	do {								\
-		(table) = (Word **) MR_RAW_TABLE_TAG((table), (value));	\
-	} while (0)
-
-#define	MR_DEBUG_NEW_TABLE_ENUM(table, table0, count, value)		\
-	do {								\
-		(table) = (Word) MR_RAW_TABLE_ENUM((Word **) (table0),	\
-					(count), (value));		\
-	} while (0)
-#define	MR_DEBUG_TABLE_ENUM(table, count, value)			\
-	do {								\
-		(table) = (Word **) MR_RAW_TABLE_ENUM((table), (count),	\
-					(value));			\
-	} while (0)
-
-#define	MR_DEBUG_NEW_TABLE_WORD(table, table0, value)			\
-	do {								\
-		(table) = (Word) MR_RAW_TABLE_WORD((Word **) (table0),	\
-					(value));			\
-	} while (0)
-#define	MR_DEBUG_TABLE_WORD(table, value)				\
-	do {								\
-		(table) = (Word **) MR_RAW_TABLE_WORD((table), (value));\
-	} while (0)
-
-#define	MR_DEBUG_NEW_TABLE_INT(table, table0, value)			\
-	do {								\
-		(table) = (Word) MR_RAW_TABLE_INT((Word **) (table0),	\
-					(value));			\
-	} while (0)
-#define	MR_DEBUG_TABLE_INT(table, value)				\
-	do {								\
-		(table) = (Word **) MR_RAW_TABLE_INT((table), (value));	\
-	} while (0)
-
-#define	MR_DEBUG_NEW_TABLE_CHAR(table, table0, value)			\
-	do {								\
-		(table) = (Word) MR_RAW_TABLE_CHAR((Word **) (table0),	\
-					(value));			\
-	} while (0)
-#define	MR_DEBUG_TABLE_CHAR(table, value)				\
-	do {								\
-		(table) = (Word **) MR_RAW_TABLE_CHAR((table), (value));\
-	} while (0)
-
-#define	MR_DEBUG_NEW_TABLE_FLOAT(table, table0, value)			\
-	do {								\
-		(table) = (Word) MR_RAW_TABLE_FLOAT((Word **) (table0),	\
-					(value));			\
-	} while (0)
-#define	MR_DEBUG_TABLE_FLOAT(table, value)				\
-	do {								\
-		(table) = (Word **) MR_RAW_TABLE_FLOAT((table), (value));\
-	} while (0)
-
-#define	MR_DEBUG_NEW_TABLE_STRING(table, table0, value)			\
-	do {								\
-		(table) = (Word) MR_RAW_TABLE_STRING((Word **) (table0),\
-					(value));			\
-	} while (0)
-#define	MR_DEBUG_TABLE_STRING(table, value)				\
-	do {								\
-		(table) = (Word **) MR_RAW_TABLE_STRING((table), (value));\
-	} while (0)
-
-#define	MR_DEBUG_NEW_TABLE_TYPEINFO(table, table0, value)		\
-	do {								\
-		(table) = (Word) MR_RAW_TABLE_TYPE_INFO((Word **) (table0),\
-					(value));			\
-	} while (0)
-#define	MR_DEBUG_TABLE_TYPEINFO(table, value)				\
-	do {								\
-		(table) = (Word **) MR_RAW_TABLE_TYPE_INFO((table), (value));\
-	} while (0)
-
-#endif	/* MR_TABLE_DEBUG */
-
-/***********************************************************************/
-
-#ifdef	MR_TABLE_DEBUG
-
-#define MR_TABLE_CREATE_ANSWER_BLOCK(ABlock, Elements)	 		\
-	do {								\
-		*((MR_AnswerBlock) ABlock) = 				\
-			(Word *) table_allocate_words(Elements);	\
-		if (MR_tabledebug)					\
-			printf("allocated answer block %p -> %p\n",	\
-				((MR_AnswerBlock) ABlock),		\
-				*((MR_AnswerBlock) ABlock));		\
-	} while(0)
-
-#define MR_TABLE_GET_ANSWER(Offset, ABlock)				\
-	(( MR_tabledebug ?						\
-		(printf("using answer block: %p\n",			\
-			((MR_AnswerBlock) ABlock)),			\
-		printf("pointing to: %p\n",				\
-			*((MR_AnswerBlock) ABlock)))			\
-	:								\
-		(void) 0 /* do nothing */				\
-	),								\
-	(* ((MR_AnswerBlock) ABlock))[Offset])
-
-#else
-
-#define MR_TABLE_CREATE_ANSWER_BLOCK(ABlock, Elements)	 		\
-	do {								\
-		*((MR_AnswerBlock) ABlock) = 				\
-			(Word *) table_allocate_words(Elements);	\
-	} while(0)
-
-#define MR_TABLE_GET_ANSWER(Offset, ABlock)				\
-	(* ((MR_AnswerBlock) ABlock))[Offset]
-
-#endif
-
-#ifdef CONSERVATIVE_GC
-
-  #define MR_TABLE_SAVE_ANSWER(Offset, ABlock, Value, TypeInfo)		\
-	do {								\
-		(* ((MR_AnswerBlock) ABlock))[Offset] = Value;		\
-	} while(0)
-
-#else /* not CONSERVATIVE_GC */
-
-  #define MR_TABLE_SAVE_ANSWER(Offset, ABlock, Value, TypeInfo)		\
-	do {								\
-		save_transient_hp();					\
-		{ Word local_val = Value;				\
-		(* ((MR_AnswerBlock) ABlock))[Offset] =			\
-			deep_copy(&local_val, (Word *) (Word) &TypeInfo,\
-				NULL, NULL);				\
-		}							\
-		restore_transient_hp();					\
-	} while(0)
-
-#endif /* CONSERVATIVE_GC */
 
-#ifdef CONSERVATIVE_GC
-
-  #define table_allocate_bytes(size)					\
-	GC_MALLOC(size)
-
-  #define table_reallocate_bytes(pointer, size)				\
-	GC_REALLOC(pointer, size)
-
-  #define table_allocate_words(size)					\
-	GC_MALLOC(sizeof(Word) * size)
-
-  #define table_reallocate_words(pointer, size)				\
-	GC_REALLOC(pointer, sizeof(Word) * size)
-
-  #define table_free(pointer)						\
-	GC_FREE(pointer)
-
-  #define MR_table_list_cons(h, t) MR_list_cons((h), (t))
-
-#else /* not CONSERVATIVE_GC */
-
-  #define table_allocate_bytes(Size)					\
-	(fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
-	(void *) NULL)
-  #define table_reallocate_bytes(Pointer, Size)				\
-	(fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
-	(void *) NULL)
-  #define table_allocate_words(Size)					\
-	(fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
-	(void *) NULL)
-  #define table_reallocate_words(Pointer, Size)				\
-	(fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
-	(void *) NULL)
-  #define table_free(Pointer)						\
-	fatal_error("Sorry, not implemented: tabling in non-GC grades")
-
-  #define MR_table_list_cons(h, t)					\
-	(fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
-	(Word) 0)
-
-#endif /* CONSERVATIVE_GC */
-
-#define table_copy_bytes(Dest, Source, Size)				\
-	MR_memcpy(Dest, Source, Size)
-
-#define table_copy_words(Dest, Source, Size)				\
-	MR_memcpy((char *) (Dest), (char *) (Source), sizeof(Word) * Size)
-
-/*---------------------------------------------------------------------------*/
-
-typedef	struct MR_AnswerListNodeStruct	MR_AnswerListNode;
-typedef	struct MR_AnswerListNodeStruct	*MR_AnswerList;
-
-struct MR_AnswerListNodeStruct {
-	Integer		answer_num;
-	Word		answer_data;
-	MR_AnswerList	next_answer;
+union MR_TableNode_Union {
+	Integer		MR_integer;
+	MR_HashTable	*MR_hash_table;
+	MR_TableNode	*MR_fix_table;
+	MR_TableNode	*MR_start_table;
+	Unsigned	MR_simpletable_status;
+	MR_Subgoal	*MR_subgoal;
+	Word		*MR_answerblock;
 };
-
-typedef enum {
-	MR_ANS_NOT_GENERATED,
-	MR_ANS_GENERATED
-} MR_AnswerDuplState;
-
-/*
-** The state of a model_det or model_semi subgoal.
-**
-** Note that the word containing the MR_SimpletableStatus,
-** which is at the end of the chain of trie nodes given by
-** the input arguments of the tabled subgoal, will be overwritten
-** by a pointer to the answer block containing the output arguments
-** when the goal succeeds. The MR_SIMPLETABLE_SUCCEEDED status code
-** is used only when the goal has no outputs. This is why
-** MR_SIMPLETABLE_SUCCEEDED must the last entry in the enum,
-** and why code looking at an MR_SimpletableStatus must test
-** for success with "(Unsigned) x >= MR_SIMPLETABLE_SUCCEEDED".
-*/
-
-typedef enum {
-	MR_SIMPLETABLE_UNINITIALIZED,
-	MR_SIMPLETABLE_WORKING,
-	MR_SIMPLETABLE_FAILED,
-	MR_SIMPLETABLE_SUCCEEDED
-} MR_SimpletableStatus;
 
-#ifdef	MR_USE_MINIMAL_MODEL
+#define	MR_SIMPLETABLE_UNINITIALIZED	0
+#define	MR_SIMPLETABLE_WORKING		1
+#define	MR_SIMPLETABLE_FAILED		2
+#define	MR_SIMPLETABLE_SUCCEEDED	3
 
 typedef enum {
    	MR_SUBGOAL_INACTIVE,
@@ -546,6 +145,12 @@
 	MR_SUBGOAL_COMPLETE
 } MR_SubgoalStatus;
 
+struct MR_AnswerListNode_Struct {
+	Integer		answer_num;
+	MR_TableNode	answer_data; /* always uses the MR_answerblock member */
+	MR_AnswerList	next_answer;
+};
+
 /*
 ** The saved state of a generator or a consumer. While consumers get
 ** suspended while they are waiting for generators to produce more solutions,
@@ -597,17 +202,12 @@
 	MR_SavedState	saved_state;
 	MR_AnswerList	*remaining_answer_list_ptr;
 } MR_Consumer;
-
-typedef	struct MR_ConsumerListNode	*MR_ConsumerList;
 
-struct MR_ConsumerListNode {
+struct MR_ConsumerListNode_Struct {
 	MR_Consumer			*item;
 	MR_ConsumerList			next;
 };
 
-typedef struct MR_SubgoalStruct		MR_Subgoal;
-typedef	struct MR_SubgoalListNode	*MR_SubgoalList;
-
 /*
 ** The following structure is used to hold the state and variables used in 
 ** the table_resume procedure.
@@ -623,13 +223,13 @@
 	bool			changed;
 } MR_ResumeInfo;
 
-struct MR_SubgoalListNode {
+struct MR_SubgoalListNode_Struct {
 	MR_Subgoal		*item;
 	MR_SubgoalList		next;
 };
 
 /* Used to save info about a single subgoal in the table */
-struct MR_SubgoalStruct {
+struct MR_Subgoal_Struct {
 	MR_SubgoalStatus	status;
 	MR_Subgoal		*leader;
 	MR_SubgoalList		followers;
@@ -660,15 +260,138 @@
 						/* MR_sp at the time of the */
 						/* call to the generator */
 };
+
+/*---------------------------------------------------------------------------*/
+
+/*
+** The functions defined here should be used only via the macros defined
+** in mercury_tabling_macros.h.
+**
+** These functions look to see if the given key is in the given table.
+** If it is, they return the address of the data pointer associated with
+** the key. If it is not, they create a new element for the key in the table
+** and return the address of its data pointer.
+*/
+
+/*
+** These functions assume that the table is a dynamically resizable hash table.
+*/
+
+extern	MR_TrieNode	MR_int_hash_lookup_or_add(MR_TrieNode table,
+				Integer key);
+extern	MR_TrieNode	MR_float_hash_lookup_or_add(MR_TrieNode table,
+				Float key);
+extern	MR_TrieNode	MR_string_hash_lookup_or_add(MR_TrieNode table,
+				String key);
+
+/*
+** This function assumes that the table is a statically sized array,
+** with the index ranging from 0 to range - 1.
+*/
+
+extern	MR_TrieNode	MR_int_fix_index_lookup_or_add(MR_TrieNode table,
+				Integer range, Integer key);
+
+/*
+** This function assumes that the table is an expandable array,
+** with the smallest valid index value being start.
+*/
+
+extern	MR_TrieNode	MR_int_start_index_lookup_or_add(MR_TrieNode table,
+				Integer start, Integer key);
+
+/*
+** This function tables type_infos in a hash table.
+*/
+
+extern	MR_TrieNode	MR_type_info_lookup_or_add(MR_TrieNode table,
+				Word *type_info);
+
+/*
+** This function tables values of arbitrary types; the form of the data
+** structure depends on the actual type of the value.
+*/
+
+extern	MR_TrieNode	MR_table_type(MR_TrieNode table,
+				Word *type_info, Word data_value);
+
+/*
+** This function prints statistics about the operation of tabling, if the
+** collection of such statistics is enabled, on the given stream.
+*/
+
+extern	void		MR_table_report_statistics(FILE *fp);
+
+/*---------------------------------------------------------------------------*/
+
+#ifdef CONSERVATIVE_GC
+
+  #define MR_TABLE_NEW(type)						\
+	MR_GC_NEW(type)
+
+  #define MR_TABLE_NEW_ARRAY(type, count)				\
+	MR_GC_NEW_ARRAY(type, (count))
+
+  #define MR_TABLE_RESIZE_ARRAY(ptr, type, count)			\
+	MR_GC_RESIZE_ARRAY((ptr), type, (count))
+
+  #define table_allocate_bytes(size)					\
+	MR_GC_malloc((size))
+
+  #define table_reallocate_bytes(pointer, size)				\
+	MR_GC_realloc((pointer), (size))
+
+  #define table_allocate_words(size)					\
+	MR_GC_malloc(sizeof(Word) * (size))
+
+  #define table_reallocate_words(pointer, size)				\
+	MR_GC_realloc((pointer), sizeof(Word) * (size))
+
+  #define table_free(pointer)						\
+	MR_GC_free((pointer))
+
+  #define MR_table_list_cons(h, t)					\
+	MR_list_cons((h), (t))
+
+#else /* not CONSERVATIVE_GC */
+
+  #define MR_TABLE_NEW(type)						\
+	(fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
+	(void *) NULL)
+  #define MR_TABLE_NEW_ARRAY(type, count)				\
+	(fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
+	(void *) NULL)
+  #define MR_TABLE_RESIZE_ARRAY(pointer, type, count)			\
+	(fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
+	(void *) NULL)
+  #define table_allocate_bytes(size)					\
+	(fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
+	(void *) NULL)
+  #define table_reallocate_bytes(pointer, size)				\
+	(fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
+	(void *) NULL)
+  #define table_allocate_words(size)					\
+	(fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
+	(void *) NULL)
+  #define table_reallocate_words(pointer, size)				\
+	(fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
+	(void *) NULL)
+  #define table_free(pointer)						\
+	fatal_error("Sorry, not implemented: tabling in non-GC grades")
+  #define MR_table_list_cons(h, t)					\
+	(fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
+	(Word) 0)
+
+#endif /* CONSERVATIVE_GC */
+
+#define table_copy_bytes(dest, source, size)				\
+	MR_memcpy((dest), (source), (size))
 
-	/* 
-	** Cast a Word to a MR_Subgoal*: saves on typing and improves 
-	** readability. 
-	*/
-#define MR_SUBGOAL(T)  (*(MR_Subgoal **) T)
+#define table_copy_words(dest, source, size)				\
+	MR_memcpy((char *) (dest), (char *) (source), sizeof(Word) * (size))
 
 /*---------------------------------------------------------------------------*/
 
-#endif	/* MR_USE_MINIMAL_MODEL */
+#include "mercury_tabling_macros.h"
 
 #endif	/* not MERCURY_TABLING_H */
Index: runtime/mercury_tabling_macros.h
===================================================================
RCS file: mercury_tabling_macros.h
diff -N mercury_tabling_macros.h
--- /dev/null	Thu Sep  2 15:00:04 1999
+++ mercury_tabling_macros.h	Mon Jan  3 19:47:32 2000
@@ -0,0 +1,340 @@
+/*
+** Copyright (C) 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.
+*/
+
+/*
+** mercury_tabling_macros.h
+**
+** This file defines macros used by the implementation of tabling
+** (which means mostly the procedures defined in library/private_builtin.m).
+** These macros just call the real implementation routines defined in
+** runtime/mercury_tabling.c, but they also optionally print debugging
+** information.
+*/
+
+#include "mercury_deep_copy.h"	/* for MR_make_permanent */
+
+#define MR_RAW_TABLE_ANY(table, type_info, value)			\
+	MR_table_type((table), (type_info), (value))
+
+#define MR_RAW_TABLE_TAG(table, tag)					\
+	MR_int_fix_index_lookup_or_add((table), 1 << TAGBITS, (tag))
+
+#define MR_RAW_TABLE_ENUM(table, range, value)				\
+	MR_int_fix_index_lookup_or_add((table), (range), (value))
+
+#define MR_RAW_TABLE_WORD(table, value)					\
+	MR_int_hash_lookup_or_add((table), (value));
+
+#define MR_RAW_TABLE_INT(table, value)					\
+	MR_int_hash_lookup_or_add((table), (value));
+
+#define MR_RAW_TABLE_CHAR(table, value)					\
+	MR_int_hash_lookup_or_add((table), (value));
+
+#define MR_RAW_TABLE_FLOAT(table, value)				\
+	MR_float_hash_lookup_or_add((table), (value));
+
+#define MR_RAW_TABLE_STRING(table, value)	 			\
+	MR_string_hash_lookup_or_add((table), (value));
+
+#define MR_RAW_TABLE_TYPEINFO(table, type_info)				\
+	MR_type_info_lookup_or_add((table), (type_info))
+
+#ifdef	MR_TABLE_DEBUG
+
+#define	MR_DEBUG_NEW_TABLE_ANY(table, table0, type_info, value)		\
+	do {								\
+		(table) = MR_RAW_TABLE_ANY((table0), (type_info),	\
+					   (value));			\
+		if (MR_tabledebug) {					\
+			printf("TABLE %p: any %x type %p => %p\n",	\
+				(table0), (value), (type_info), (table));\
+		}							\
+	} while (0)
+#define	MR_DEBUG_TABLE_ANY(table, type_info, value)			\
+	do {								\
+		MR_TrieNode prev_table = (table);			\
+		(table) = MR_RAW_TABLE_ANY((table), 		\
+					(type_info), (value));		\
+		if (MR_tabledebug) {					\
+			printf("TABLE %p: any %x type %p => %p\n",	\
+				prev_table, (value), (type_info),	\
+				(table));				\
+		}							\
+	} while (0)
+
+#define	MR_DEBUG_NEW_TABLE_TAG(table, table0, value)			\
+	do {								\
+		(table) = MR_RAW_TABLE_TAG((table0), (value));		\
+		if (MR_tabledebug) {					\
+			printf("TABLE %p: tag %d => %p\n", 		\
+				(table0), (value), (table))		\
+		}							\
+	} while (0)
+#define	MR_DEBUG_TABLE_TAG(table, value)				\
+	do {								\
+		MR_TrieNode prev_table = (table);			\
+		(table) = MR_RAW_TABLE_TAG((table), (value));		\
+		if (MR_tabledebug) {					\
+			printf("TABLE %p: tag %d => %p\n",		\
+				 prev_table, (value), (table));		\
+		}							\
+	} while (0)
+
+#define	MR_DEBUG_NEW_TABLE_ENUM(table, table0, count, value)		\
+	do {								\
+		(table) = MR_RAW_TABLE_ENUM((table0), (count), (value));\
+		if (MR_tabledebug) {					\
+			printf("TABLE %p: enum %d of %d => %p\n", 	\
+				(table0), (value), (count), (table));	\
+		}							\
+	} while (0)
+#define	MR_DEBUG_TABLE_ENUM(table, count, value)			\
+	do {								\
+		MR_TrieNode prev_table = (table);			\
+		(table) = MR_RAW_TABLE_ENUM((table), (count), (value));	\
+		if (MR_tabledebug) {					\
+			printf("TABLE %p: enum %d of %d => %p\n", 	\
+				prev_table, (value), (count), (table));	\
+		}							\
+	} while (0)
+
+#define	MR_DEBUG_NEW_TABLE_WORD(table, table0, value)			\
+	do {								\
+		(table) = MR_RAW_TABLE_WORD((table0), (value));		\
+		if (MR_tabledebug) {					\
+			printf("TABLE %p: word %d => %p\n",		\
+				(table0), (value), (table));		\
+		}							\
+	} while (0)
+#define	MR_DEBUG_TABLE_WORD(table, value)				\
+	do {								\
+		MR_TrieNode prev_table = (table);			\
+		(table) = MR_RAW_TABLE_WORD((table), (value));		\
+		if (MR_tabledebug) {					\
+			printf("TABLE %p: word %d => %p\n",		\
+				prev_table, (value), (table));		\
+		}							\
+	} while (0)
+
+#define	MR_DEBUG_NEW_TABLE_INT(table, table0, value)			\
+	do {								\
+		(table) = MR_RAW_TABLE_INT((table0), (value));		\
+		if (MR_tabledebug) {					\
+			printf("TABLE %p: int %d => %p\n",		\
+				(table0), (value), (table));		\
+		}							\
+	} while (0)
+#define	MR_DEBUG_TABLE_INT(table, value)				\
+	do {								\
+		MR_TrieNode prev_table = (table);			\
+		(table) = MR_RAW_TABLE_INT((table), (value));		\
+		if (MR_tabledebug) {					\
+			printf("TABLE %p: int %d => %p\n",		\
+				prev_table, (value), (table));		\
+		}							\
+	} while (0)
+
+#define	MR_DEBUG_NEW_TABLE_CHAR(table, table0, value)			\
+	do {								\
+		(table) = MR_RAW_TABLE_CHAR((table0), (value));		\
+		if (MR_tabledebug) {					\
+			printf("TABLE %p: char `%c'/%d => %p\n",	\
+				(table0), (int) (value),		\
+				(int) (value), (table));		\
+		}							\
+	} while (0)
+#define	MR_DEBUG_TABLE_CHAR(table, value)				\
+	do {								\
+		MR_TrieNode prev_table = (table);			\
+		(table) = MR_RAW_TABLE_CHAR((table), (value));		\
+		if (MR_tabledebug) {					\
+			printf("TABLE %p: char `%c'/%d => %p\n",	\
+				prev_table, (int) (value), 		\
+				(int) (value), (table));		\
+		}							\
+	} while (0)
+
+#define	MR_DEBUG_NEW_TABLE_FLOAT(table, table0, value)			\
+	do {								\
+		(table) = MR_RAW_TABLE_FLOAT((table0), (value));	\
+		if (MR_tabledebug) {					\
+			printf("TABLE %p: float %f => %p\n",		\
+				(table0), (double) (value), (table));	\
+		}							\
+	} while (0)
+#define	MR_DEBUG_TABLE_FLOAT(table, value)				\
+	do {								\
+		MR_TrieNode prev_table = (table);			\
+		(table) = MR_RAW_TABLE_FLOAT((table), (value));		\
+		if (MR_tabledebug) {					\
+			printf("TABLE %p: float %f => %p\n",		\
+				prev_table, (double) value, (table));	\
+		}							\
+	} while (0)
+
+#define	MR_DEBUG_NEW_TABLE_STRING(table, table0, value)			\
+	do {								\
+		(table) = MR_RAW_TABLE_STRING((table0), (value));	\
+		if (MR_tabledebug) {					\
+			printf("TABLE %p: string `%s' => %p\n",		\
+				(table), (char *) (value), (table));	\
+		}							\
+	} while (0)
+#define	MR_DEBUG_TABLE_STRING(table, value)				\
+	do {								\
+		MR_TrieNode prev_table = (table);			\
+		(table) = MR_RAW_TABLE_STRING((table), (value));	\
+		if (MR_tabledebug) {					\
+			printf("TABLE %p: string `%s' => %p\n",		\
+				prev_table, (char *) (value), (table));	\
+		}							\
+	} while (0)
+
+#define	MR_DEBUG_NEW_TABLE_TYPEINFO(table, table0, value)		\
+	do {								\
+		(table) = MR_RAW_TABLE_TYPEINFO((table0), (value));	\
+		if (MR_tabledebug) {					\
+			printf("TABLE %p: typeinfo %p => %p\n",		\
+				(table), (value), (table));		\
+		}							\
+	} while (0)
+#define	MR_DEBUG_TABLE_TYPEINFO(table, value)				\
+	do {								\
+		MR_TrieNode prev_table = (table);			\
+		(table) = MR_RAW_TABLE_TYPEINFO((table), (value));	\
+		if (MR_tabledebug) {					\
+			printf("TABLE %p: typeinfo %p => %p\n",		\
+				prev_table, (value), (table));		\
+		}							\
+	} while (0)
+
+#else	/* not MR_TABLE_DEBUG */
+
+#define	MR_DEBUG_NEW_TABLE_ANY(table, table0, type_info, value)		\
+	do {								\
+		(table) = MR_RAW_TABLE_ANY((table0), (type_info), (value));\
+	} while (0)
+#define	MR_DEBUG_TABLE_ANY(table, type_info, value)			\
+	do {								\
+		(table) = MR_RAW_TABLE_ANY((table), (type_info), (value));\
+	} while (0)
+
+#define	MR_DEBUG_NEW_TABLE_TAG(table, table0, value)			\
+	do {								\
+		(table) = MR_RAW_TABLE_TAG((table0), (value));		\
+	} while (0)
+#define	MR_DEBUG_TABLE_TAG(table, value)				\
+	do {								\
+		(table) = MR_RAW_TABLE_TAG((table), (value));		\
+	} while (0)
+
+#define	MR_DEBUG_NEW_TABLE_ENUM(table, table0, count, value)		\
+	do {								\
+		(table) = MR_RAW_TABLE_ENUM((table0), (count), (value));\
+	} while (0)
+#define	MR_DEBUG_TABLE_ENUM(table, count, value)			\
+	do {								\
+		(table) = MR_RAW_TABLE_ENUM((table), (count), (value));	\
+	} while (0)
+
+#define	MR_DEBUG_NEW_TABLE_WORD(table, table0, value)			\
+	do {								\
+		(table) = MR_RAW_TABLE_WORD((table0), (value));		\
+	} while (0)
+#define	MR_DEBUG_TABLE_WORD(table, value)				\
+	do {								\
+		(table) = MR_RAW_TABLE_WORD((table), (value));\
+	} while (0)
+
+#define	MR_DEBUG_NEW_TABLE_INT(table, table0, value)			\
+	do {								\
+		(table) = MR_RAW_TABLE_INT((table0), (value));		\
+	} while (0)
+#define	MR_DEBUG_TABLE_INT(table, value)				\
+	do {								\
+		(table) = MR_RAW_TABLE_INT((table), (value));		\
+	} while (0)
+
+#define	MR_DEBUG_NEW_TABLE_CHAR(table, table0, value)			\
+	do {								\
+		(table) = MR_RAW_TABLE_CHAR((table0), (value));		\
+	} while (0)
+#define	MR_DEBUG_TABLE_CHAR(table, value)				\
+	do {								\
+		(table) = MR_RAW_TABLE_CHAR((table), (value));		\
+	} while (0)
+
+#define	MR_DEBUG_NEW_TABLE_FLOAT(table, table0, value)			\
+	do {								\
+		(table) = MR_RAW_TABLE_FLOAT((table0), (value));	\
+	} while (0)
+#define	MR_DEBUG_TABLE_FLOAT(table, value)				\
+	do {								\
+		(table) = MR_RAW_TABLE_FLOAT((table), (value));		\
+	} while (0)
+
+#define	MR_DEBUG_NEW_TABLE_STRING(table, table0, value)			\
+	do {								\
+		(table) = MR_RAW_TABLE_STRING((table0), (value));	\
+	} while (0)
+#define	MR_DEBUG_TABLE_STRING(table, value)				\
+	do {								\
+		(table) = MR_RAW_TABLE_STRING((table), (value));	\
+	} while (0)
+
+#define	MR_DEBUG_NEW_TABLE_TYPEINFO(table, table0, value)		\
+	do {								\
+		(table) = MR_RAW_TABLE_TYPEINFO((table0), (value));	\
+	} while (0)
+#define	MR_DEBUG_TABLE_TYPEINFO(table, value)				\
+	do {								\
+		(table) = MR_RAW_TABLE_TYPEINFO((table), (value));	\
+	} while (0)
+
+#endif	/* MR_TABLE_DEBUG */
+
+/***********************************************************************/
+
+#ifdef	MR_TABLE_DEBUG
+
+#define MR_TABLE_CREATE_ANSWER_BLOCK(table, num_slots)	 		\
+	do {								\
+		(table)->MR_answerblock = MR_TABLE_NEW_ARRAY(Word,	\
+						(num_slots));		\
+		if (MR_tabledebug)					\
+			printf("allocated answer block %p -> %p, %d words\n",\
+				(table), (table)->MR_answerblock,	\
+				(int) (num_slots));			\
+	} while(0)
+
+#define MR_TABLE_GET_ANSWER(table, offset)				\
+	(( MR_tabledebug ?						\
+		printf("using answer block: %p -> %p, slot %d\n",	\
+			table, table->MR_answerblock, (int) (offset))	\
+	:								\
+		(void) 0 /* do nothing */				\
+	),								\
+	((table)->MR_answerblock)[(offset)])
+
+#else
+
+#define MR_TABLE_CREATE_ANSWER_BLOCK(table, num_slots)	 		\
+	do {								\
+		(table)->MR_answerblock = MR_TABLE_NEW_ARRAY(Word,	\
+						(num_slots));		\
+	} while(0)
+
+#define MR_TABLE_GET_ANSWER(table, offset)				\
+	((table)->MR_answerblock)[(offset)]
+
+#endif
+
+#define MR_TABLE_SAVE_ANSWER(table, offset, value, type_info)		\
+	do {								\
+		(table)->MR_answerblock[offset] =			\
+			MR_make_permanent((value), (type_info));	\
+	} while(0)
Index: runtime/mercury_trace_base.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_trace_base.c,v
retrieving revision 1.23
diff -u -b -r1.23 mercury_trace_base.c
--- runtime/mercury_trace_base.c	1999/12/20 14:03:50	1.23
+++ runtime/mercury_trace_base.c	2000/01/03 08:47:58
@@ -3,7 +3,7 @@
 ENDINIT
 */
 /*
-** Copyright (C) 1997-1999 The University of Melbourne.
+** Copyright (C) 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.
 */
@@ -156,9 +156,23 @@
 	return NULL;
 }
 
+#ifdef	MR_TABLE_DEBUG
+bool	MR_saved_tabledebug;
+#endif
+
 void
 MR_trace_init(void)
 {
+#ifdef	MR_TABLE_DEBUG
+	/*
+	** We don't want to see any tabling debugging messages from
+	** initialization code about entering and leaving commit goals.
+	*/
+
+	MR_saved_tabledebug = MR_tabledebug;
+	MR_tabledebug = FALSE;
+#endif
+
 #ifdef MR_USE_EXTERNAL_DEBUGGER
 	if (MR_trace_handler == MR_TRACE_EXTERNAL) {
 		if (MR_address_of_trace_init_external != NULL) {
@@ -192,6 +206,14 @@
 	MR_trace_call_depth = 0;
 	MR_trace_from_full = TRUE;
 	MR_trace_enabled = enabled;
+
+#ifdef	MR_TABLE_DEBUG
+	/*
+	** Restore the value saved by MR_trace_init.
+	*/
+
+	MR_tabledebug = MR_saved_tabledebug;
+#endif
 
 	/*
 	** Install the SIGINT signal handler.
Index: runtime/mercury_wrapper.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_wrapper.c,v
retrieving revision 1.52
diff -u -b -r1.52 mercury_wrapper.c
--- runtime/mercury_wrapper.c	1999/12/20 14:03:51	1.52
+++ runtime/mercury_wrapper.c	2000/01/03 08:48:01
@@ -3,7 +3,7 @@
 ENDINIT
 */
 /*
-** Copyright (C) 1994-1999 The University of Melbourne.
+** Copyright (C) 1994-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.
 */
@@ -231,7 +231,7 @@
 	*/
 	save_regs_to_mem(c_regs);
 
-#ifdef	MR_LOWLEVEL_DEBUG
+#if defined(MR_LOWLEVEL_DEBUG) || defined(MR_TABLE_DEBUG)
 	/*
 	** Ensure stdio & stderr are unbuffered even if redirected.
 	** Using setvbuf() is more complicated than using setlinebuf(),
@@ -668,12 +668,27 @@
 			break;
 
 		case 'd':	
-			if (streq(MR_optarg, "b"))
+			if (streq(MR_optarg, "a")) {
+				MR_calldebug      = TRUE;
+				MR_nondstackdebug = TRUE;
+				MR_detstackdebug  = TRUE;
+				MR_heapdebug      = TRUE;
+				MR_gotodebug      = TRUE;
+				MR_sregdebug      = TRUE;
+				MR_finaldebug     = TRUE;
+				MR_tracedebug     = TRUE;
+#ifdef CONSERVATIVE_GC
+				GC_quiet = FALSE;
+#endif
+			}
+			else if (streq(MR_optarg, "b"))
 				MR_nondstackdebug = TRUE;
 			else if (streq(MR_optarg, "c"))
 				MR_calldebug    = TRUE;
 			else if (streq(MR_optarg, "d"))
 				MR_detaildebug  = TRUE;
+			else if (streq(MR_optarg, "f"))
+				MR_finaldebug   = TRUE;
 			else if (streq(MR_optarg, "g"))
 				MR_gotodebug    = TRUE;
 			else if (streq(MR_optarg, "G"))
@@ -682,37 +697,24 @@
 #else
 			; /* ignore inapplicable option */
 #endif
-			else if (streq(MR_optarg, "s"))
-				MR_detstackdebug  = TRUE;
 			else if (streq(MR_optarg, "h"))
 				MR_heapdebug    = TRUE;
-			else if (streq(MR_optarg, "f"))
-				MR_finaldebug   = TRUE;
-			else if (streq(MR_optarg, "p"))
-				MR_progdebug    = TRUE;
+			else if (streq(MR_optarg, "H"))
+				MR_hashdebug    = TRUE;
 			else if (streq(MR_optarg, "m"))
 				MR_memdebug     = TRUE;
+			else if (streq(MR_optarg, "p"))
+				MR_progdebug    = TRUE;
 			else if (streq(MR_optarg, "r"))
 				MR_sregdebug    = TRUE;
-			else if (streq(MR_optarg, "t"))
-				MR_tracedebug   = TRUE;
+			else if (streq(MR_optarg, "s"))
+				MR_detstackdebug  = TRUE;
 			else if (streq(MR_optarg, "S"))
 				MR_tablestackdebug = TRUE;
+			else if (streq(MR_optarg, "t"))
+				MR_tracedebug   = TRUE;
 			else if (streq(MR_optarg, "T"))
 				MR_tabledebug   = TRUE;
-			else if (streq(MR_optarg, "a")) {
-				MR_calldebug      = TRUE;
-				MR_nondstackdebug = TRUE;
-				MR_detstackdebug  = TRUE;
-				MR_heapdebug      = TRUE;
-				MR_gotodebug      = TRUE;
-				MR_sregdebug      = TRUE;
-				MR_finaldebug     = TRUE;
-				MR_tracedebug     = TRUE;
-#ifdef CONSERVATIVE_GC
-				GC_quiet = FALSE;
-#endif
-			}
 			else
 				usage();
 
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 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
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/tabling
Index: tests/tabling/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/tabling/Mmakefile,v
retrieving revision 1.9
diff -u -b -r1.9 Mmakefile
--- tests/tabling/Mmakefile	1999/10/29 06:53:48	1.9
+++ tests/tabling/Mmakefile	2000/01/03 05:04:44
@@ -8,7 +8,13 @@
 
 SIMPLE_PROGS = \
 	boyer \
+	expand \
+	expand_float \
+	expand_poly \
 	fib \
+	fib_float \
+	fib_list \
+	fib_string \
 	loopcheck
 
 NONDET_PROGS = \
Index: tests/tabling/expand.exp
===================================================================
RCS file: expand.exp
diff -N expand.exp
--- /dev/null	Thu Sep  2 15:00:04 1999
+++ expand.exp	Fri Dec 31 20:11:39 1999
@@ -0,0 +1 @@
+Test successful.
Index: tests/tabling/expand.m
===================================================================
RCS file: expand.m
diff -N expand.m
--- /dev/null	Thu Sep  2 15:00:04 1999
+++ expand.m	Sun Jan  2 12:49:38 2000
@@ -0,0 +1,63 @@
+% A test case to exercise the code for expanding hash tables.
+
+:- module expand.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module bool, int, list, assoc_list, std_util, random, require.
+
+main -->
+	{ random__init(0, RS0) },
+	{ random__permutation(1024, Perm, RS0, RS1) },
+	{ choose_signs_and_enter(Perm, Solns, RS1, _RS) },
+	( { test_tables(Solns, yes) } ->
+		io__write_string("Test successful.\n")
+	;
+		io__write_string("Test unsuccessful.\n")
+	).
+	% io__report_tabling_stats.
+
+:- pred choose_signs_and_enter(list(int)::in, assoc_list(int)::out,
+	random__supply::mdi, random__supply::muo) is det.
+
+choose_signs_and_enter([], [], RS, RS).
+choose_signs_and_enter([N | Ns], [I - S | ISs], RS0, RS) :-
+	random__random(Random, RS0, RS1),
+	( Random mod 2 = 0 ->
+		I = N
+	;
+		I = 0 - N
+	),
+	sum(I, S),
+	choose_signs_and_enter(Ns, ISs, RS1, RS).
+
+:- pred test_tables(assoc_list(int)::in, bool::out) is det.
+
+test_tables([], yes).
+test_tables([I - S0 | Is], Correct) :-
+	sum(I, S1),
+	( S0 = S1 ->
+		test_tables(Is, Correct)
+	;
+		Correct = no
+	).
+
+:- pred sum(int::in, int::out) is det.
+:- pragma memo(sum/2).
+
+sum(N, F) :-
+	( N < 0 ->
+		sum(0 - N, NF),
+		F = 0 - NF
+	; N = 1 ->
+		F = 1
+	;
+		sum(N - 1, F1),
+		F is N + F1
+	).
Index: tests/tabling/expand_float.exp
===================================================================
RCS file: expand_float.exp
diff -N expand_float.exp
--- /dev/null	Thu Sep  2 15:00:04 1999
+++ expand_float.exp	Sun Jan  2 14:11:17 2000
@@ -0,0 +1 @@
+Test successful.
Index: tests/tabling/expand_float.m
===================================================================
RCS file: expand_float.m
diff -N expand_float.m
--- /dev/null	Thu Sep  2 15:00:04 1999
+++ expand_float.m	Sun Jan  2 14:09:45 2000
@@ -0,0 +1,63 @@
+% A test case to exercise the code for expanding hash tables.
+
+:- module expand_float.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module bool, int, float, list, assoc_list, std_util, random, require.
+
+main -->
+	{ random__init(0, RS0) },
+	{ random__permutation(1024, Perm, RS0, RS1) },
+	{ choose_signs_and_enter(Perm, Solns, RS1, _RS) },
+	( { test_tables(Solns, yes) } ->
+		io__write_string("Test successful.\n")
+	;
+		io__write_string("Test unsuccessful.\n")
+	).
+	% io__report_tabling_stats.
+
+:- pred choose_signs_and_enter(list(int)::in, assoc_list(float)::out,
+	random__supply::mdi, random__supply::muo) is det.
+
+choose_signs_and_enter([], [], RS, RS).
+choose_signs_and_enter([N | Ns], [F - S | ISs], RS0, RS) :-
+	random__random(Random, RS0, RS1),
+	( Random mod 2 = 0 ->
+		F = float(N)
+	;
+		F = float(0 - N)
+	),
+	sum(F, S),
+	choose_signs_and_enter(Ns, ISs, RS1, RS).
+
+:- pred test_tables(assoc_list(float)::in, bool::out) is det.
+
+test_tables([], yes).
+test_tables([I - S0 | Is], Correct) :-
+	sum(I, S1),
+	( S0 = S1 ->
+		test_tables(Is, Correct)
+	;
+		Correct = no
+	).
+
+:- pred sum(float::in, float::out) is det.
+:- pragma memo(sum/2).
+
+sum(N, F) :-
+	( N < 0.0 ->
+		sum(0.0 - N, NF),
+		F = 0.0 - NF
+	; N = 1.0 ->
+		F = 1.0
+	;
+		sum(N - 1.0, F1),
+		F is N + F1
+	).
Index: tests/tabling/expand_poly.exp
===================================================================
RCS file: expand_poly.exp
diff -N expand_poly.exp
--- /dev/null	Thu Sep  2 15:00:04 1999
+++ expand_poly.exp	Mon Jan  3 16:05:08 2000
@@ -0,0 +1,4 @@
+First test successful.
+Second test successful.
+Third test successful.
+Fourth test successful.
Index: tests/tabling/expand_poly.m
===================================================================
RCS file: expand_poly.m
diff -N expand_poly.m
--- /dev/null	Thu Sep  2 15:00:04 1999
+++ expand_poly.m	Mon Jan  3 16:05:26 2000
@@ -0,0 +1,85 @@
+% A test case to exercise the code for expanding hash tables,
+% and for tabling typeinfos. We test the tabling of typeinfos for types
+% of arity zero, one and two, and depths zero, one and two.
+
+:- module expand_poly.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module bool, int, list, std_util, random, require.
+
+:- type record(T1, T2)	--->	record(T1, T1, T2).
+
+main -->
+	{ random__init(0, RS0) },
+	{ random__permutation(1024, Perm, RS0, RS1) },
+	{ choose_signs_and_enter(Perm, 42, Solns1, RS1, RS2) },
+	( { test_tables(Solns1, yes) } ->
+		io__write_string("First test successful.\n")
+	;
+		io__write_string("First test unsuccessful.\n")
+	),
+	{ choose_signs_and_enter(Perm, [53], Solns2, RS2, RS3) },
+	( { test_tables(Solns2, yes) } ->
+		io__write_string("Second test successful.\n")
+	;
+		io__write_string("Second test unsuccessful.\n")
+	),
+	{ choose_signs_and_enter(Perm, [[64, 75]], Solns3, RS3, RS4) },
+	( { test_tables(Solns3, yes) } ->
+		io__write_string("Third test successful.\n")
+	;
+		io__write_string("Third test unsuccessful.\n")
+	),
+	{ choose_signs_and_enter(Perm, record("a", "b", [1]), Solns4, RS4, _) },
+	( { test_tables(Solns4, yes) } ->
+		io__write_string("Fourth test successful.\n")
+	;
+		io__write_string("Fourth test unsuccessful.\n")
+	).
+	% io__report_tabling_stats.
+
+:- pred choose_signs_and_enter(list(int)::in, T::in, list(record(int, T))::out,
+	random__supply::mdi, random__supply::muo) is det.
+
+choose_signs_and_enter([], _, [], RS, RS).
+choose_signs_and_enter([N | Ns], A, [record(F, S, A) | ISs], RS0, RS) :-
+	random__random(Random, RS0, RS1),
+	( Random mod 2 = 0 ->
+		F = N
+	;
+		F = 0 - N
+	),
+	sum(F, A, S),
+	choose_signs_and_enter(Ns, A, ISs, RS1, RS).
+
+:- pred test_tables(list(record(int, T))::in, bool::out) is det.
+
+test_tables([], yes).
+test_tables([record(I, S0, A) | Is], Correct) :-
+	sum(I, A, S1),
+	( S0 = S1 ->
+		test_tables(Is, Correct)
+	;
+		Correct = no
+	).
+
+:- pred sum(int::in, T::in, int::out) is det.
+:- pragma memo(sum/3).
+
+sum(N, A, F) :-
+	( N < 0 ->
+		sum(0 - N, A, NF),
+		F = 0 - NF
+	; N = 1 ->
+		F = 1
+	;
+		sum(N - 1, A, F1),
+		F is N + F1
+	).
Index: tests/tabling/fib.m
===================================================================
RCS file: /home/mercury1/repository/tests/tabling/fib.m,v
retrieving revision 1.1
diff -u -b -r1.1 fib.m
--- tests/tabling/fib.m	1998/08/14 06:27:08	1.1
+++ tests/tabling/fib.m	1999/12/30 08:21:48
@@ -11,16 +11,18 @@
 :- import_module benchmarking, require, int.
 
 main -->
-	perform_trials(10).
+	perform_trials(20).
 
 :- pred perform_trials(int::in, io__state::di, io__state::uo) is cc_multi.
 
 perform_trials(N) -->
 	{ trial(N, Time, MTime) },
+	% io__write_int(N),
+	% io__write_string(": "),
 	% io__write_int(Time),
-	% io__write_string(" "),
+	% io__write_string("ms vs "),
 	% io__write_int(MTime),
-	% io__write_string(" \n"),
+	% io__write_string("ms\n"),
 	(
 		{
 			Time > 10 * MTime,
Index: tests/tabling/fib_float.exp
===================================================================
RCS file: fib_float.exp
diff -N fib_float.exp
--- /dev/null	Thu Sep  2 15:00:04 1999
+++ fib_float.exp	Thu Dec 30 19:21:49 1999
@@ -0,0 +1 @@
+tabling works
Index: tests/tabling/fib_float.m
===================================================================
RCS file: fib_float.m
diff -N fib_float.m
--- /dev/null	Thu Sep  2 15:00:04 1999
+++ fib_float.m	Sun Jan  2 13:26:27 2000
@@ -0,0 +1,74 @@
+:- module fib_float.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module benchmarking, require, int, float.
+
+main -->
+	perform_trials(20.0).
+
+:- pred perform_trials(float::in, io__state::di, io__state::uo) is cc_multi.
+
+perform_trials(N) -->
+	{ trial(N, Time, MTime) },
+	% io__write_float(N),
+	% io__write_string(": "),
+	% io__write_int(Time),
+	% io__write_string("ms vs "),
+	% io__write_int(MTime),
+	% io__write_string("ms\n"),
+	(
+		{
+			Time > 10 * MTime,
+			MTime > 0	% untabled takes ten times as long
+		;
+			Time > 100,	% untabled takes at least 100 ms
+			MTime < 1	% while untabled takes at most 1 ms
+		}
+	->
+		io__write_string("tabling works\n")
+	;
+		{ Time > 10000 }	% Untabled takes at least 10 seconds
+	->
+		io__write_string("tabling does not appear to work\n")
+	;
+		% We couldn't get a measurable result with N,
+		% and it looks like we can afford a bigger trial
+		perform_trials(N + 3.0)
+	).
+
+:- pred trial(float::in, int::out, int::out) is cc_multi.
+
+trial(N, Time, MTime) :-
+	benchmark_det(fib, N, Res, 1, Time),
+	benchmark_det(mfib, N, MRes, 1, MTime),
+	require(unify(Res, MRes), "tabling produces wrong answer").
+
+:- pred fib(float::in, float::out) is det.
+
+fib(N, F) :-
+	( N < 2.0 ->
+		F = 1.0
+	;
+		fib(N - 1.0, F1),
+		fib(N - 2.0, F2),
+		F is F1 + F2
+	).
+
+:- pred mfib(float::in, float::out) is det.
+:- pragma memo(mfib/2).
+
+mfib(N, F) :-
+	( N < 2.0 ->
+		F = 1.0
+	;
+		mfib(N - 1.0, F1),
+		mfib(N - 2.0, F2),
+		F is F1 + F2
+	).
Index: tests/tabling/fib_list.exp
===================================================================
RCS file: fib_list.exp
diff -N fib_list.exp
--- /dev/null	Thu Sep  2 15:00:04 1999
+++ fib_list.exp	Sun Jan  2 14:11:31 2000
@@ -0,0 +1 @@
+tabling works
Index: tests/tabling/fib_list.m
===================================================================
RCS file: fib_list.m
diff -N fib_list.m
--- /dev/null	Thu Sep  2 15:00:04 1999
+++ fib_list.m	Sun Jan  2 14:12:38 2000
@@ -0,0 +1,112 @@
+:- module fib_list.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module benchmarking, require, std_util.
+:- import_module int, list, assoc_list.
+
+main -->
+	perform_trials([1, 4]).
+
+:- pred perform_trials(list(int)::in, io__state::di, io__state::uo) is cc_multi.
+
+perform_trials(N) -->
+	{ trial(N, Time, MTime) },
+	% io__write(N),
+	% io__write_string(": "),
+	% io__write_int(Time),
+	% io__write_string("ms vs "),
+	% io__write_int(MTime),
+	% io__write_string("ms\n"),
+	(
+		{
+			Time > 10 * MTime,
+			MTime > 0	% untabled takes ten times as long
+		;
+			Time > 100,	% untabled takes at least 100 ms
+			MTime < 1	% while untabled takes at most 1 ms
+		}
+	->
+		io__write_string("tabling works\n")
+	;
+		{ Time > 10000 }	% Untabled takes at least 10 seconds
+	->
+		io__write_string("tabling does not appear to work\n")
+	;
+		% We couldn't get a measurable result with N,
+		% and it looks like we can afford a bigger trial
+		perform_trials(add_digits(N, [3]))
+	).
+
+:- pred trial(list(int)::in, int::out, int::out) is cc_multi.
+
+trial(N, Time, MTime) :-
+	benchmark_det(fib, N, Res, 1, Time),
+	benchmark_det(mfib, N, MRes, 1, MTime),
+	require(unify(Res, MRes), "tabling produces wrong answer").
+
+:- pred fib(list(int)::in, list(int)::out) is det.
+
+fib(N, F) :-
+	( digits_to_num(N) < 2 ->
+		F = num_to_digits(1)
+	;
+		One = num_to_digits(1),
+		Two = num_to_digits(2),
+		fib(subtract_digits(N, One), F1),
+		fib(subtract_digits(N, Two), F2),
+		F = add_digits(F1, F2)
+	).
+
+:- pred mfib(list(int)::in, list(int)::out) is det.
+:- pragma memo(mfib/2).
+
+mfib(N, F) :-
+	( digits_to_num(N) < 2 ->
+		F = num_to_digits(1)
+	;
+		One = num_to_digits(1),
+		Two = num_to_digits(2),
+		mfib(subtract_digits(N, One), F1),
+		mfib(subtract_digits(N, Two), F2),
+		F = add_digits(F1, F2)
+	).
+
+:- func add_digits(list(int), list(int)) = list(int).
+
+add_digits(S1, S2) =
+	num_to_digits(digits_to_num(S1) + digits_to_num(S2)).
+
+:- func subtract_digits(list(int), list(int)) = list(int).
+
+subtract_digits(S1, S2) =
+	num_to_digits(digits_to_num(S1) - digits_to_num(S2)).
+
+:- func digits_to_num(list(int)) = int.
+
+digits_to_num(Digits) = Num :-
+	list__reverse(Digits, RevDigits),
+	Num = digits_to_num_2(RevDigits).
+
+:- func digits_to_num_2(list(int)) = int.
+
+digits_to_num_2([]) = 0.
+digits_to_num_2([Last | Rest]) =
+	10 * digits_to_num_2(Rest) + Last.
+
+:- func num_to_digits(int) = list(int).
+
+num_to_digits(Int) = Digits :-
+	( Int < 10 ->
+		Digits = [Int]
+	;
+		Last = Int mod 10,
+		Rest = Int // 10,
+		list__append(num_to_digits(Rest), [Last], Digits)
+	).
Index: tests/tabling/fib_string.exp
===================================================================
RCS file: fib_string.exp
diff -N fib_string.exp
--- /dev/null	Thu Sep  2 15:00:04 1999
+++ fib_string.exp	Sun Jan  2 14:11:27 2000
@@ -0,0 +1 @@
+tabling works
Index: tests/tabling/fib_string.m
===================================================================
RCS file: fib_string.m
diff -N fib_string.m
--- /dev/null	Thu Sep  2 15:00:04 1999
+++ fib_string.m	Sun Jan  2 13:29:46 2000
@@ -0,0 +1,171 @@
+:- module fib_string.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module benchmarking, require, std_util.
+:- import_module int, string, list, assoc_list.
+
+main -->
+	perform_trials("oneone").
+
+:- pred perform_trials(string::in, io__state::di, io__state::uo) is cc_multi.
+
+perform_trials(N) -->
+	{ trial(N, Time, MTime) },
+	% io__write_string(N),
+	% io__write_string(": "),
+	% io__write_int(Time),
+	% io__write_string("ms vs "),
+	% io__write_int(MTime),
+	% io__write_string("ms\n"),
+	(
+		{
+			Time > 10 * MTime,
+			MTime > 0	% untabled takes ten times as long
+		;
+			Time > 100,	% untabled takes at least 100 ms
+			MTime < 1	% while untabled takes at most 1 ms
+		}
+	->
+		io__write_string("tabling works\n")
+	;
+		{ Time > 10000 }	% Untabled takes at least 10 seconds
+	->
+		io__write_string("tabling does not appear to work\n")
+	;
+		% We couldn't get a measurable result with N,
+		% and it looks like we can afford a bigger trial
+		perform_trials(add_strings(N, "three"))
+	).
+
+:- pred trial(string::in, int::out, int::out) is cc_multi.
+
+trial(N, Time, MTime) :-
+	benchmark_det(fib, N, Res, 1, Time),
+	benchmark_det(mfib, N, MRes, 1, MTime),
+	require(unify(Res, MRes), "tabling produces wrong answer").
+
+:- pred fib(string::in, string::out) is det.
+
+fib(N, F) :-
+	( string_to_num(N) < 2 ->
+		F = num_to_string(1)
+	;
+		One = num_to_string(1),
+		Two = num_to_string(2),
+		fib(subtract_strings(N, One), F1),
+		fib(subtract_strings(N, Two), F2),
+		F = add_strings(F1, F2)
+	).
+
+:- pred mfib(string::in, string::out) is det.
+:- pragma memo(mfib/2).
+
+mfib(N, F) :-
+	( string_to_num(N) < 2 ->
+		F = num_to_string(1)
+	;
+		One = num_to_string(1),
+		Two = num_to_string(2),
+		mfib(subtract_strings(N, One), F1),
+		mfib(subtract_strings(N, Two), F2),
+		F = add_strings(F1, F2)
+	).
+
+:- func add_strings(string, string) = string.
+
+add_strings(S1, S2) =
+	num_to_string(string_to_num(S1) + string_to_num(S2)).
+
+:- func subtract_strings(string, string) = string.
+
+subtract_strings(S1, S2) =
+	num_to_string(string_to_num(S1) - string_to_num(S2)).
+
+:- func string_to_num(string) = int.
+
+string_to_num(String) = Num :-
+	translate_last_digit(String, LastNum, RestString),
+	( RestString = "" ->
+		Num = LastNum
+	;
+		Num = string_to_num(RestString) * 10 + LastNum
+	).
+
+:- pred translate_last_digit(string::in, int::out, string::out) is det.
+
+translate_last_digit(String, LastDigit, Rest) :-
+	digits(Pairs),
+	translate_last_digit_2(Pairs, String, LastDigit, Rest).
+
+:- pred translate_last_digit_2(assoc_list(string, int)::in, string::in,
+	int::out, string::out) is det.
+
+translate_last_digit_2([], _, _, _) :-
+	error("cannot determine last digit").
+translate_last_digit_2([DigitStr - DigitNum | Digits], String, Last, Rest) :-
+	( string__remove_suffix(String, DigitStr, RestPrime) ->
+		Last = DigitNum,
+		Rest = RestPrime
+	;
+		translate_last_digit_2(Digits, String, Last, Rest)
+	).
+
+:- func num_to_string(int) = string.
+
+num_to_string(Int) = String :-
+	translate_digits(Int, Digits),
+	string__append_list(Digits, String).
+
+:- pred translate_digits(int::in, list(string)::out) is det.
+
+translate_digits(N, Digits) :-
+	( N < 10 ->
+		translate_digit(N, Digit),
+		Digits = [Digit]
+	;
+		Last = N mod 10,
+		Rest = N // 10,
+		translate_digit(Last, LastDigit),
+		translate_digits(Rest, RestDigits),
+		list__append(RestDigits, [LastDigit], Digits)
+	).
+
+:- pred translate_digit(int::in, string::out) is det.
+
+translate_digit(Int, String) :-
+	( translate_digit_2(Int, StringPrime) ->
+		String = StringPrime
+	;
+		error("translate_digit give non-digit")
+	).
+
+:- pred translate_digit_2(int, string).
+:- mode translate_digit_2(in, out) is semidet.
+:- mode translate_digit_2(out, out) is multi.
+
+translate_digit_2(0, "zero").
+translate_digit_2(1, "one").
+translate_digit_2(2, "two").
+translate_digit_2(3, "three").
+translate_digit_2(4, "four").
+translate_digit_2(5, "five").
+translate_digit_2(6, "six").
+translate_digit_2(7, "seven").
+translate_digit_2(8, "eight").
+translate_digit_2(9, "nine").
+
+:- pred digits(assoc_list(string, int)::out) is det.
+:- pragma memo(digits/1).
+
+digits(PairList) :-
+	solutions(lambda([Pair::out] is multi, (
+		translate_digit_2(Int, String),
+		Pair = String - Int
+	)), PairList).
Index: tests/tabling/tc_loop.exp
===================================================================
RCS file: /home/mercury1/repository/tests/tabling/tc_loop.exp,v
retrieving revision 1.1
diff -u -b -r1.1 tc_loop.exp
--- tests/tabling/tc_loop.exp	1998/08/14 06:27:09	1.1
+++ tests/tabling/tc_loop.exp	1999/12/30 08:21:48
@@ -1,2 +1,3 @@
-Software error: detected infinite recursion in pred tc_loop:tc/2
+Uncaught exception:
+Software Error: detected infinite recursion in pred tc_loop:tc/2
 Stack dump not available in this grade.
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
Index: trace/mercury_trace_internal.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.61
diff -u -b -r1.61 mercury_trace_internal.c
--- trace/mercury_trace_internal.c	1999/12/20 14:04:03	1.61
+++ trace/mercury_trace_internal.c	2000/01/03 08:48:46
@@ -1,5 +1,5 @@
 /*
-** Copyright (C) 1998-1999 The University of Melbourne.
+** Copyright (C) 1998-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.
 */
@@ -203,6 +203,7 @@
 	char			*line;
 	MR_Next			res;
 	MR_Event_Details	event_details;
+	bool			saved_tabledebug;
 
 	if (! interactive) {
 		return MR_trace_event_internal_report(cmd, event_info);
@@ -216,7 +217,16 @@
 	}
 #endif	MR_USE_DECLARATIVE_DEBUGGER
 
+	/*
+	** We want to make sure that the Mercury code used to implement some
+	** of the debugger's commands (a) doesn't generate any trace events,
+	** and (b) doesn't generate any unwanted debugging output.
+	*/
+
 	MR_trace_enabled = FALSE;
+	saved_tabledebug = MR_tabledebug;
+	MR_tabledebug = FALSE;
+
 	MR_trace_internal_ensure_init();
 
 	MR_trace_event_print_internal_report(event_info);
@@ -254,6 +264,7 @@
 
 	MR_scroll_next = 0;
 	MR_trace_enabled = TRUE;
+	MR_tabledebug = saved_tabledebug;
 	return jumpaddr;
 }
 
@@ -1506,8 +1517,13 @@
 #ifdef	MR_USE_MINIMAL_MODEL
 	} else if (streq(words[0], "gen_stack")) {
 		if (word_count == 1) {
+			bool	saved_tabledebug;
+
 			do_init_modules();
+			saved_tabledebug = MR_tabledebug;
+			MR_tabledebug = TRUE;
 			MR_print_gen_stack(MR_mdb_out);
+			MR_tabledebug = saved_tabledebug;
 		} else {
 			MR_trace_usage("developer", "gen_stack");
 		}
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