[m-rev.] diff: fix bug with table reset/statistics and function arity

[Julien Fischer]

Estimated hours taken: 0.5
Branches: main

Fix a bug reported by Jakob Puchinger.  When constructing the table reset or
statistics predicates for memoed functions we were not subtracting one from
the arity.

compiler/add_pragma.m:
 	When creating the name for a tabling reset or statistics predicate
 	subtract one from the arity if the reset or statistics predicate
         is for a memoed function.

tests/valid/Mmakefile:
tests/valid/table_wrong_func_arity.m:
 	Add a test case for the above.

Julien.

Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.41
diff -u -r1.41 add_pragma.m
--- compiler/add_pragma.m	27 Jul 2006 05:00:56 -0000	1.41
+++ compiler/add_pragma.m	28 Jul 2006 06:35:10 -0000
@@ -2113,7 +2113,14 @@
  :- func tabling_pred_name(string, simple_call_id, proc_id, bool) = sym_name.

  tabling_pred_name(Prefix, SimpleCallId, ProcId, SingleProc) = NewSymName :-
-    SimpleCallId = simple_call_id(_PorF, SymName, Arity),
+    SimpleCallId = simple_call_id(PorF, SymName, Arity0),
+    (
+        PorF = predicate,
+        Arity = Arity0
+    ;
+        PorF = function,
+        Arity = Arity0 - 1
+    ),
      (
          SymName = qualified(ModuleName, Name),
          MaybeModuleName = yes(ModuleName)
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.176
diff -u -r1.176 Mmakefile
--- tests/valid/Mmakefile	19 Jul 2006 17:20:56 -0000	1.176
+++ tests/valid/Mmakefile	28 Jul 2006 07:16:32 -0000
@@ -226,6 +226,11 @@
  	exists_cast_bug \
  	untuple_bug

+# These tests only work in grades that support tabling.
+#
+TABLE_PROGS=\
+	table_wrong_func_arity
+
  # These tests only work in grades that support parallel conjunction.
  #
  PAR_CONJ_PROGS = \
@@ -299,7 +304,7 @@
  		PROGS3 = $(PROGS2)
  	endif
  else
-	PROGS3 = $(PROGS2)
+	PROGS3 = $(PROGS2) $(TABLE_PROGS)
  endif

  ifeq "$(filter hl% java% il%,$(GRADE))" ""
Index: tests/valid/table_wrong_func_arity.m
===================================================================
RCS file: tests/valid/table_wrong_func_arity.m
diff -N tests/valid/table_wrong_func_arity.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/valid/table_wrong_func_arity.m	28 Jul 2006 07:07:38 -0000
@@ -0,0 +1,31 @@
+% rotd-2006-07-26 was not subtracting one from the arity when constructing the
+% name of the table reset and statistics predicates for a memoed function.
+%
+:- module table_wrong_func_arity.
+:- interface.
+
+:- import_module io.
+
+:- pred print_fib(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module int.
+:- import_module exception.
+
+print_fib(!IO) :-
+	io.write_int(fib(30), !IO),
+	table_statistics_for_fib_1(TableStats, !IO),
+	io.write(TableStats, !IO),
+	io.nl(!IO),
+	table_reset_for_fib_1(!IO).
+
+:- pragma memo(fib/1, [allow_reset, statistics]).
+:- func fib(int) = int.
+
+fib(N) = 
+	( N = 0 -> 0
+	; N = 1 -> 1
+	; N < 0 -> throw("fib with negative argument")
+	; fib(N - 2) + fib(N - 1)
+	).

--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------