[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