[m-rev.] diff: support tabling of predicates with fixed size integer arguments
Julien Fischer
jfischer at opturion.com
Mon Aug 28 16:03:28 AEST 2017
Support tabling of predicates with fixed size integer arguments.
library/table_builtin.m:
Add the various tabling primitives -- they could not previously
be added until part 1 of the fixed size integer change had
bootstrapped.
library/table_statistics.m:
runtime/mercury_tabling.h:
Update the table_step_kind/0 type and its C version to cover the fixed
size integer types. (The corresponding type in compiler/hlds_pred.m
has already been updated.)
tests/tabling/Mmakefile:
tests/tabling/fib_int{8,16,32}.{m,exp}:
tests/tabling/fib_uint{8,16,32}.{m,exp}:
Test tabling for each of the fixed size integer types.
Julien.
diff --git a/library/table_builtin.m b/library/table_builtin.m
index a6f667438..478250ade 100644
--- a/library/table_builtin.m
+++ b/library/table_builtin.m
@@ -1239,6 +1239,36 @@ pretend_to_generate_value(Bogus) :-
:- impure pred table_lookup_insert_uint(ml_trie_node::in, uint::in,
ml_trie_node::out) is det.
+ % Lookup or insert a signed 8-bit integer in the given table.
+ %
+:- impure pred table_lookup_insert_int8(ml_trie_node::in, int8::in,
+ ml_trie_node::out) is det.
+
+ % Lookup or insert an unsigned 8-bit integer in the given table.
+ %
+:- impure pred table_lookup_insert_uint8(ml_trie_node::in, uint8::in,
+ ml_trie_node::out) is det.
+
+ % Lookup or insert a signed 16-bit integer in the given table.
+ %
+:- impure pred table_lookup_insert_int16(ml_trie_node::in, int16::in,
+ ml_trie_node::out) is det.
+
+ % Lookup or insert an unsigned 16-bit integer in the given table.
+ %
+:- impure pred table_lookup_insert_uint16(ml_trie_node::in, uint16::in,
+ ml_trie_node::out) is det.
+
+ % Lookup or insert a signed 32-bit integer in the given table.
+ %
+:- impure pred table_lookup_insert_int32(ml_trie_node::in, int32::in,
+ ml_trie_node::out) is det.
+
+ % Lookup or insert an unsigned 32-bit integer in the given table.
+ %
+:- impure pred table_lookup_insert_uint32(ml_trie_node::in, uint32::in,
+ ml_trie_node::out) is det.
+
% Lookup or insert an integer in the given table.
%
:- impure pred table_lookup_insert_start_int(ml_trie_node::in, int::in,
@@ -1317,6 +1347,42 @@ pretend_to_generate_value(Bogus) :-
:- impure pred table_save_uint_answer(ml_answer_block::in, int::in, uint::in)
is det.
+ % Save a signed 8-bit integer answer in the given answer block at the
+ % given offset.
+ %
+:- impure pred table_save_int8_answer(ml_answer_block::in, int::in, int8::in)
+ is det.
+
+ % Save an unsigned 8-bit integer answer in the given answer block at the
+ % given offset.
+ %
+:- impure pred table_save_uint8_answer(ml_answer_block::in, int::in, uint8::in)
+ is det.
+
+ % Save a signed 16-bit integer answer in the given answer block at the
+ % given offset.
+ %
+:- impure pred table_save_int16_answer(ml_answer_block::in, int::in, int16::in)
+ is det.
+
+ % Save an unsigned 16-bit integer answer in the given answer block at the
+ % given offset.
+ %
+:- impure pred table_save_uint16_answer(ml_answer_block::in, int::in, uint16::in)
+ is det.
+
+ % Save a signed 32-bit integer answer in the given answer block at the
+ % given offset.
+ %
+:- impure pred table_save_int32_answer(ml_answer_block::in, int::in, int32::in)
+ is det.
+
+ % Save an unsigned 32-bit integer answer in the given answer block at the
+ % given offset.
+ %
+:- impure pred table_save_uint32_answer(ml_answer_block::in, int::in, uint32::in)
+ is det.
+
% Save a character answer in the given answer block at the given
% offset.
%
@@ -1358,6 +1424,42 @@ pretend_to_generate_value(Bogus) :-
:- semipure pred table_restore_uint_answer(ml_answer_block::in, int::in,
uint::out) is det.
+ % Restore a signed 8-bit integer answer from the given answer block at the
+ % given offset.
+ %
+:- semipure pred table_restore_int8_answer(ml_answer_block::in, int::in,
+ int8::out) is det.
+
+ % Restore an unsigned 8-bit integer answer from the given answer block at
+ % the given offset.
+ %
+:- semipure pred table_restore_uint8_answer(ml_answer_block::in, int::in,
+ uint8::out) is det.
+
+ % Restore a signed 16-bit integer answer from the given answer block at the
+ % given offset.
+ %
+:- semipure pred table_restore_int16_answer(ml_answer_block::in, int::in,
+ int16::out) is det.
+
+ % Restore an unsigned 16-bit integer answer from the given answer block at
+ % the given offset.
+ %
+:- semipure pred table_restore_uint16_answer(ml_answer_block::in, int::in,
+ uint16::out) is det.
+
+ % Restore a signed 32-bit integer answer from the given answer block at the
+ % given offset.
+ %
+:- semipure pred table_restore_int32_answer(ml_answer_block::in, int::in,
+ int32::out) is det.
+
+ % Restore an unsigned 32-bit integer answer from the given answer block at
+ % the given offset.
+ %
+:- semipure pred table_restore_uint32_answer(ml_answer_block::in, int::in,
+ uint32::out) is det.
+
% Restore a character answer from the given answer block at the
% given offset.
%
@@ -1436,6 +1538,48 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_NAME(io, state, 0));
T0, S, V, T);
").
+:- pragma foreign_proc("C",
+ table_lookup_insert_int8(T0::in, V::in, T::out),
+ [will_not_call_mercury, does_not_affect_liveness],
+"
+ MR_tbl_lookup_insert_int8(NULL, MR_TABLE_DEBUG_BOOL, MR_FALSE, T0, V, T);
+").
+
+:- pragma foreign_proc("C",
+ table_lookup_insert_uint8(T0::in, V::in, T::out),
+ [will_not_call_mercury, does_not_affect_liveness],
+"
+ MR_tbl_lookup_insert_uint8(NULL, MR_TABLE_DEBUG_BOOL, MR_FALSE, T0, V, T);
+").
+
+:- pragma foreign_proc("C",
+ table_lookup_insert_int16(T0::in, V::in, T::out),
+ [will_not_call_mercury, does_not_affect_liveness],
+"
+ MR_tbl_lookup_insert_int16(NULL, MR_TABLE_DEBUG_BOOL, MR_FALSE, T0, V, T);
+").
+
+:- pragma foreign_proc("C",
+ table_lookup_insert_uint16(T0::in, V::in, T::out),
+ [will_not_call_mercury, does_not_affect_liveness],
+"
+ MR_tbl_lookup_insert_uint16(NULL, MR_TABLE_DEBUG_BOOL, MR_FALSE, T0, V, T);
+").
+
+:- pragma foreign_proc("C",
+ table_lookup_insert_int32(T0::in, V::in, T::out),
+ [will_not_call_mercury, does_not_affect_liveness],
+"
+ MR_tbl_lookup_insert_int32(NULL, MR_TABLE_DEBUG_BOOL, MR_FALSE, T0, V, T);
+").
+
+:- pragma foreign_proc("C",
+ table_lookup_insert_uint32(T0::in, V::in, T::out),
+ [will_not_call_mercury, does_not_affect_liveness],
+"
+ MR_tbl_lookup_insert_uint32(NULL, MR_TABLE_DEBUG_BOOL, MR_FALSE, T0, V, T);
+").
+
:- pragma foreign_proc("C",
table_lookup_insert_char(T0::in, V::in, T::out),
[will_not_call_mercury, does_not_affect_liveness],
@@ -1537,6 +1681,48 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_NAME(io, state, 0));
MR_tbl_save_uint_answer(MR_TABLE_DEBUG_BOOL, AB, Offset, V);
").
+:- pragma foreign_proc("C",
+ table_save_int8_answer(AB::in, Offset::in, V::in),
+ [will_not_call_mercury, does_not_affect_liveness],
+"
+ MR_tbl_save_int8_answer(MR_TABLE_DEBUG_BOOL, AB, Offset, V);
+").
+
+:- pragma foreign_proc("C",
+ table_save_uint8_answer(AB::in, Offset::in, V::in),
+ [will_not_call_mercury, does_not_affect_liveness],
+"
+ MR_tbl_save_uint8_answer(MR_TABLE_DEBUG_BOOL, AB, Offset, V);
+").
+
+:- pragma foreign_proc("C",
+ table_save_int16_answer(AB::in, Offset::in, V::in),
+ [will_not_call_mercury, does_not_affect_liveness],
+"
+ MR_tbl_save_int16_answer(MR_TABLE_DEBUG_BOOL, AB, Offset, V);
+").
+
+:- pragma foreign_proc("C",
+ table_save_uint16_answer(AB::in, Offset::in, V::in),
+ [will_not_call_mercury, does_not_affect_liveness],
+"
+ MR_tbl_save_uint16_answer(MR_TABLE_DEBUG_BOOL, AB, Offset, V);
+").
+
+:- pragma foreign_proc("C",
+ table_save_int32_answer(AB::in, Offset::in, V::in),
+ [will_not_call_mercury, does_not_affect_liveness],
+"
+ MR_tbl_save_int32_answer(MR_TABLE_DEBUG_BOOL, AB, Offset, V);
+").
+
+:- pragma foreign_proc("C",
+ table_save_uint32_answer(AB::in, Offset::in, V::in),
+ [will_not_call_mercury, does_not_affect_liveness],
+"
+ MR_tbl_save_uint32_answer(MR_TABLE_DEBUG_BOOL, AB, Offset, V);
+").
+
:- pragma foreign_proc("C",
table_save_char_answer(AB::in, Offset::in, V::in),
[will_not_call_mercury, does_not_affect_liveness],
@@ -1587,6 +1773,48 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_NAME(io, state, 0));
MR_tbl_restore_uint_answer(MR_TABLE_DEBUG_BOOL, AB, Offset, V);
").
+:- pragma foreign_proc("C",
+ table_restore_int8_answer(AB::in, Offset::in, V::out),
+ [will_not_call_mercury, promise_semipure, does_not_affect_liveness],
+"
+ MR_tbl_restore_int8_answer(MR_TABLE_DEBUG_BOOL, AB, Offset, V);
+").
+
+:- pragma foreign_proc("C",
+ table_restore_uint8_answer(AB::in, Offset::in, V::out),
+ [will_not_call_mercury, promise_semipure, does_not_affect_liveness],
+"
+ MR_tbl_restore_uint8_answer(MR_TABLE_DEBUG_BOOL, AB, Offset, V);
+").
+
+:- pragma foreign_proc("C",
+ table_restore_int16_answer(AB::in, Offset::in, V::out),
+ [will_not_call_mercury, promise_semipure, does_not_affect_liveness],
+"
+ MR_tbl_restore_int16_answer(MR_TABLE_DEBUG_BOOL, AB, Offset, V);
+").
+
+:- pragma foreign_proc("C",
+ table_restore_uint16_answer(AB::in, Offset::in, V::out),
+ [will_not_call_mercury, promise_semipure, does_not_affect_liveness],
+"
+ MR_tbl_restore_uint16_answer(MR_TABLE_DEBUG_BOOL, AB, Offset, V);
+").
+
+:- pragma foreign_proc("C",
+ table_restore_int32_answer(AB::in, Offset::in, V::out),
+ [will_not_call_mercury, promise_semipure, does_not_affect_liveness],
+"
+ MR_tbl_restore_int32_answer(MR_TABLE_DEBUG_BOOL, AB, Offset, V);
+").
+
+:- pragma foreign_proc("C",
+ table_restore_uint32_answer(AB::in, Offset::in, V::out),
+ [will_not_call_mercury, promise_semipure, does_not_affect_liveness],
+"
+ MR_tbl_restore_uint32_answer(MR_TABLE_DEBUG_BOOL, AB, Offset, V);
+").
+
:- pragma foreign_proc("C",
table_restore_char_answer(AB::in, Offset::in, V::out),
[will_not_call_mercury, promise_semipure, does_not_affect_liveness],
diff --git a/library/table_statistics.m b/library/table_statistics.m
index b5fc590cc..9fcd77346 100644
--- a/library/table_statistics.m
+++ b/library/table_statistics.m
@@ -63,7 +63,13 @@
; table_step_general_poly_addr
; table_step_typeinfo
; table_step_typeclassinfo
- ; table_step_promise_implied.
+ ; table_step_promise_implied
+ ; table_step_int8
+ ; table_step_uint8
+ ; table_step_int16
+ ; table_step_uint16
+ ; table_step_int32
+ ; table_step_uint32.
:- type table_step_stats
---> table_step_stats(
diff --git a/runtime/mercury_tabling.h b/runtime/mercury_tabling.h
index ba8a29454..a13506b74 100644
--- a/runtime/mercury_tabling.h
+++ b/runtime/mercury_tabling.h
@@ -250,7 +250,13 @@ typedef enum {
MR_DEFINE_BUILTIN_ENUM_CONST(MR_TABLE_STEP_GEN_POLY_ADDR),
MR_DEFINE_BUILTIN_ENUM_CONST(MR_TABLE_STEP_TYPEINFO),
MR_DEFINE_BUILTIN_ENUM_CONST(MR_TABLE_STEP_TYPECLASSINFO),
- MR_DEFINE_BUILTIN_ENUM_CONST(MR_TABLE_STEP_PROMISE_IMPLIED)
+ MR_DEFINE_BUILTIN_ENUM_CONST(MR_TABLE_STEP_PROMISE_IMPLIED),
+ MR_DEFINE_BUILTIN_ENUM_CONST(MR_TABLE_STEP_INT8),
+ MR_DEFINE_BUILTIN_ENUM_CONST(MR_TABLE_STEP_UINT8),
+ MR_DEFINE_BUILTIN_ENUM_CONST(MR_TABLE_STEP_INT16),
+ MR_DEFINE_BUILTIN_ENUM_CONST(MR_TABLE_STEP_UINT16),
+ MR_DEFINE_BUILTIN_ENUM_CONST(MR_TABLE_STEP_INT32),
+ MR_DEFINE_BUILTIN_ENUM_CONST(MR_TABLE_STEP_UINT32)
} MR_TableTrieStep;
typedef MR_Unsigned MR_Counter;
diff --git a/tests/tabling/Mmakefile b/tests/tabling/Mmakefile
index bfa37e60d..d133f82b9 100644
--- a/tests/tabling/Mmakefile
+++ b/tests/tabling/Mmakefile
@@ -20,10 +20,16 @@ SIMPLE_NONLOOP_PROGS = \
fast_loose \
fib \
fib_float \
+ fib_int16 \
+ fib_int32 \
+ fib_int8 \
fib_list \
fib_stats \
fib_string \
fib_uint \
+ fib_uint16 \
+ fib_uint32 \
+ fib_uint8 \
loopcheck_no_loop \
loopcheck_nondet_no_loop \
mercury_java_parser_dead_proc_elim_bug \
diff --git a/tests/tabling/fib_int16.exp b/tests/tabling/fib_int16.exp
index e69de29bb..6302bcdf8 100644
--- a/tests/tabling/fib_int16.exp
+++ b/tests/tabling/fib_int16.exp
@@ -0,0 +1 @@
+tabling works
diff --git a/tests/tabling/fib_int32.exp b/tests/tabling/fib_int32.exp
index e69de29bb..6302bcdf8 100644
--- a/tests/tabling/fib_int32.exp
+++ b/tests/tabling/fib_int32.exp
@@ -0,0 +1 @@
+tabling works
diff --git a/tests/tabling/fib_int32.m b/tests/tabling/fib_int32.m
index e69de29bb..f1642b62f 100644
--- a/tests/tabling/fib_int32.m
+++ b/tests/tabling/fib_int32.m
@@ -0,0 +1,83 @@
+% vim: ts=4 sw=4 et ft=mercury
+
+:- module fib_int32.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module benchmarking.
+:- import_module int.
+:- import_module int32.
+:- import_module require.
+
+:- pragma require_feature_set([memo]).
+
+main(!IO) :-
+ perform_trials(20i32, !IO).
+
+:- pred perform_trials(int32::in, io::di, io::uo) is cc_multi.
+
+perform_trials(N, !IO) :-
+ trial(N, Time, MTime),
+ trace [compiletime(flag("progress")), io(!S)] (
+ io.write_string("trial ", !S),
+ io.write_int32(N, !S),
+ io.write_string(": ", !S),
+ io.write_int(Time, !S),
+ io.write_string("ms nonmemoed vs ", !S),
+ io.write_int(MTime, !S),
+ io.write_string("ms memoed\n", !S)
+ ),
+ (
+ (
+ Time > 10 * MTime,
+ MTime > 0 % untabled takes ten times as long
+ ;
+ Time > 100, % untabled takes at least 100 ms
+ MTime < 1 % while tabled takes at most 1 ms
+ )
+ ->
+ io.write_string("tabling works\n", !IO)
+ ;
+ Time > 10000 % Untabled takes at least 10 seconds
+ ->
+ io.write_string("tabling does not appear to work\n", !IO)
+ ;
+ % We couldn't get a measurable result with N,
+ % and it looks like we can afford a bigger trial
+ perform_trials(N + 3i32, !IO)
+ ).
+
+:- pred trial(int32::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(int32::in, int32::out) is det.
+
+fib(N, F) :-
+ ( N < 2i32 ->
+ F = 1i32
+ ;
+ fib(N - 1i32, F1),
+ fib(N - 2i32, F2),
+ F = F1 + F2
+ ).
+
+:- pred mfib(int32::in, int32::out) is det.
+:- pragma memo(mfib/2).
+
+mfib(N, F) :-
+ ( N < 2i32 ->
+ F = 1i32
+ ;
+ mfib(N - 1i32, F1),
+ mfib(N - 2i32, F2),
+ F = F1 + F2
+ ).
diff --git a/tests/tabling/fib_int8.exp b/tests/tabling/fib_int8.exp
index e69de29bb..6302bcdf8 100644
--- a/tests/tabling/fib_int8.exp
+++ b/tests/tabling/fib_int8.exp
@@ -0,0 +1 @@
+tabling works
diff --git a/tests/tabling/fib_int8.m b/tests/tabling/fib_int8.m
index e69de29bb..9ef503825 100644
--- a/tests/tabling/fib_int8.m
+++ b/tests/tabling/fib_int8.m
@@ -0,0 +1,83 @@
+% vim: ts=4 sw=4 et ft=mercury
+
+:- module fib_int8.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module benchmarking.
+:- import_module int.
+:- import_module int8.
+:- import_module require.
+
+:- pragma require_feature_set([memo]).
+
+main(!IO) :-
+ perform_trials(20i8, !IO).
+
+:- pred perform_trials(int8::in, io::di, io::uo) is cc_multi.
+
+perform_trials(N, !IO) :-
+ trial(N, Time, MTime),
+ trace [compiletime(flag("progress")), io(!S)] (
+ io.write_string("trial ", !S),
+ io.write_int8(N, !S),
+ io.write_string(": ", !S),
+ io.write_int(Time, !S),
+ io.write_string("ms nonmemoed vs ", !S),
+ io.write_int(MTime, !S),
+ io.write_string("ms memoed\n", !S)
+ ),
+ (
+ (
+ Time > 10 * MTime,
+ MTime > 0 % untabled takes ten times as long
+ ;
+ Time > 100, % untabled takes at least 100 ms
+ MTime < 1 % while tabled takes at most 1 ms
+ )
+ ->
+ io.write_string("tabling works\n", !IO)
+ ;
+ Time > 10000 % Untabled takes at least 10 seconds
+ ->
+ io.write_string("tabling does not appear to work\n", !IO)
+ ;
+ % We couldn't get a measurable result with N,
+ % and it looks like we can afford a bigger trial
+ perform_trials(N + 3i8, !IO)
+ ).
+
+:- pred trial(int8::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(int8::in, int8::out) is det.
+
+fib(N, F) :-
+ ( N < 2i8 ->
+ F = 1i8
+ ;
+ fib(N - 1i8, F1),
+ fib(N - 2i8, F2),
+ F = F1 + F2
+ ).
+
+:- pred mfib(int8::in, int8::out) is det.
+:- pragma memo(mfib/2).
+
+mfib(N, F) :-
+ ( N < 2i8 ->
+ F = 1i8
+ ;
+ mfib(N - 1i8, F1),
+ mfib(N - 2i8, F2),
+ F = F1 + F2
+ ).
diff --git a/tests/tabling/fib_uint16.exp b/tests/tabling/fib_uint16.exp
index e69de29bb..6302bcdf8 100644
--- a/tests/tabling/fib_uint16.exp
+++ b/tests/tabling/fib_uint16.exp
@@ -0,0 +1 @@
+tabling works
diff --git a/tests/tabling/fib_uint16.m b/tests/tabling/fib_uint16.m
index e69de29bb..24d59bf65 100644
--- a/tests/tabling/fib_uint16.m
+++ b/tests/tabling/fib_uint16.m
@@ -0,0 +1,83 @@
+% vim: ts=4 sw=4 et ft=mercury
+
+:- module fib_uint16.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module benchmarking.
+:- import_module int.
+:- import_module uint16.
+:- import_module require.
+
+:- pragma require_feature_set([memo]).
+
+main(!IO) :-
+ perform_trials(20u16, !IO).
+
+:- pred perform_trials(uint16::in, io::di, io::uo) is cc_multi.
+
+perform_trials(N, !IO) :-
+ trial(N, Time, MTime),
+ trace [compiletime(flag("progress")), io(!S)] (
+ io.write_string("trial ", !S),
+ io.write_uint16(N, !S),
+ io.write_string(": ", !S),
+ io.write_int(Time, !S),
+ io.write_string("ms nonmemoed vs ", !S),
+ io.write_int(MTime, !S),
+ io.write_string("ms memoed\n", !S)
+ ),
+ (
+ (
+ Time > 10 * MTime,
+ MTime > 0 % untabled takes ten times as long
+ ;
+ Time > 100, % untabled takes at least 100 ms
+ MTime < 1 % while tabled takes at most 1 ms
+ )
+ ->
+ io.write_string("tabling works\n", !IO)
+ ;
+ Time > 10000 % Untabled takes at least 10 seconds
+ ->
+ io.write_string("tabling does not appear to work\n", !IO)
+ ;
+ % We couldn't get a measurable result with N,
+ % and it looks like we can afford a bigger trial
+ perform_trials(N + 3u16, !IO)
+ ).
+
+:- pred trial(uint16::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(uint16::in, uint16::out) is det.
+
+fib(N, F) :-
+ ( N < 2u16 ->
+ F = 1u16
+ ;
+ fib(N - 1u16, F1),
+ fib(N - 2u16, F2),
+ F = F1 + F2
+ ).
+
+:- pred mfib(uint16::in, uint16::out) is det.
+:- pragma memo(mfib/2).
+
+mfib(N, F) :-
+ ( N < 2u16 ->
+ F = 1u16
+ ;
+ mfib(N - 1u16, F1),
+ mfib(N - 2u16, F2),
+ F = F1 + F2
+ ).
diff --git a/tests/tabling/fib_uint32.exp b/tests/tabling/fib_uint32.exp
index e69de29bb..6302bcdf8 100644
--- a/tests/tabling/fib_uint32.exp
+++ b/tests/tabling/fib_uint32.exp
@@ -0,0 +1 @@
+tabling works
diff --git a/tests/tabling/fib_uint32.m b/tests/tabling/fib_uint32.m
index e69de29bb..32ab183c4 100644
--- a/tests/tabling/fib_uint32.m
+++ b/tests/tabling/fib_uint32.m
@@ -0,0 +1,83 @@
+% vim: ts=4 sw=4 et ft=mercury
+
+:- module fib_uint32.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module benchmarking.
+:- import_module int.
+:- import_module uint32.
+:- import_module require.
+
+:- pragma require_feature_set([memo]).
+
+main(!IO) :-
+ perform_trials(20u32, !IO).
+
+:- pred perform_trials(uint32::in, io::di, io::uo) is cc_multi.
+
+perform_trials(N, !IO) :-
+ trial(N, Time, MTime),
+ trace [compiletime(flag("progress")), io(!S)] (
+ io.write_string("trial ", !S),
+ io.write_uint32(N, !S),
+ io.write_string(": ", !S),
+ io.write_int(Time, !S),
+ io.write_string("ms nonmemoed vs ", !S),
+ io.write_int(MTime, !S),
+ io.write_string("ms memoed\n", !S)
+ ),
+ (
+ (
+ Time > 10 * MTime,
+ MTime > 0 % untabled takes ten times as long
+ ;
+ Time > 100, % untabled takes at least 100 ms
+ MTime < 1 % while tabled takes at most 1 ms
+ )
+ ->
+ io.write_string("tabling works\n", !IO)
+ ;
+ Time > 10000 % Untabled takes at least 10 seconds
+ ->
+ io.write_string("tabling does not appear to work\n", !IO)
+ ;
+ % We couldn't get a measurable result with N,
+ % and it looks like we can afford a bigger trial
+ perform_trials(N + 3u32, !IO)
+ ).
+
+:- pred trial(uint32::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(uint32::in, uint32::out) is det.
+
+fib(N, F) :-
+ ( N < 2u32 ->
+ F = 1u32
+ ;
+ fib(N - 1u32, F1),
+ fib(N - 2u32, F2),
+ F = F1 + F2
+ ).
+
+:- pred mfib(uint32::in, uint32::out) is det.
+:- pragma memo(mfib/2).
+
+mfib(N, F) :-
+ ( N < 2u32 ->
+ F = 1u32
+ ;
+ mfib(N - 1u32, F1),
+ mfib(N - 2u32, F2),
+ F = F1 + F2
+ ).
diff --git a/tests/tabling/fib_uint8.exp b/tests/tabling/fib_uint8.exp
index e69de29bb..6302bcdf8 100644
--- a/tests/tabling/fib_uint8.exp
+++ b/tests/tabling/fib_uint8.exp
@@ -0,0 +1 @@
+tabling works
diff --git a/tests/tabling/fib_uint8.m b/tests/tabling/fib_uint8.m
index e69de29bb..920f13ef0 100644
--- a/tests/tabling/fib_uint8.m
+++ b/tests/tabling/fib_uint8.m
@@ -0,0 +1,83 @@
+% vim: ts=4 sw=4 et ft=mercury
+
+:- module fib_uint8.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module benchmarking.
+:- import_module int.
+:- import_module uint8.
+:- import_module require.
+
+:- pragma require_feature_set([memo]).
+
+main(!IO) :-
+ perform_trials(20u8, !IO).
+
+:- pred perform_trials(uint8::in, io::di, io::uo) is cc_multi.
+
+perform_trials(N, !IO) :-
+ trial(N, Time, MTime),
+ trace [compiletime(flag("progress")), io(!S)] (
+ io.write_string("trial ", !S),
+ io.write_uint8(N, !S),
+ io.write_string(": ", !S),
+ io.write_int(Time, !S),
+ io.write_string("ms nonmemoed vs ", !S),
+ io.write_int(MTime, !S),
+ io.write_string("ms memoed\n", !S)
+ ),
+ (
+ (
+ Time > 10 * MTime,
+ MTime > 0 % untabled takes ten times as long
+ ;
+ Time > 100, % untabled takes at least 100 ms
+ MTime < 1 % while tabled takes at most 1 ms
+ )
+ ->
+ io.write_string("tabling works\n", !IO)
+ ;
+ Time > 10000 % Untabled takes at least 10 seconds
+ ->
+ io.write_string("tabling does not appear to work\n", !IO)
+ ;
+ % We couldn't get a measurable result with N,
+ % and it looks like we can afford a bigger trial
+ perform_trials(N + 3u8, !IO)
+ ).
+
+:- pred trial(uint8::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(uint8::in, uint8::out) is det.
+
+fib(N, F) :-
+ ( N < 2u8 ->
+ F = 1u8
+ ;
+ fib(N - 1u8, F1),
+ fib(N - 2u8, F2),
+ F = F1 + F2
+ ).
+
+:- pred mfib(uint8::in, uint8::out) is det.
+:- pragma memo(mfib/2).
+
+mfib(N, F) :-
+ ( N < 2u8 ->
+ F = 1u8
+ ;
+ mfib(N - 1u8, F1),
+ mfib(N - 2u8, F2),
+ F = F1 + F2
+ ).
More information about the reviews
mailing list