[m-rev.] diff: allow memo tables to be reset

Zoltan Somogyi zs at cs.mu.OZ.AU
Mon Mar 7 15:59:23 AEDT 2005


This is for Ralph.

Add a mechanism for resetting all the tables implementing loopcheck, memo
and minimal_model pragmas in a given module. This mechanism is intended for
use only by implementors, to wit, Ralph's meaurements of packrat parsing.

compiler/options.m:
doc/user_guide.texi:
	Add a new option, --allow-table-reset, that causes the compiler to
	generate a C function for doing the reset in LLDS grades.

compiler/llds_out.m:
	If the option is set, generate the reset function. The only time it
	is safe to call the reset function is when no tabled predicate is
	active.

tests/debugger/fib.{m,exp,inp}:
	New test case (a modified version of tests/tabling/fib.m) to see
	if the option works.

tests/debugger/Mmakefile:
tests/debugger/Mercury.options:
	Enable the new test case.

Zoltan.

cvs diff: Diffing .
cvs diff: Diffing analysis
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/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.245
diff -u -b -r1.245 llds_out.m
--- compiler/llds_out.m	15 Feb 2005 05:22:18 -0000	1.245
+++ compiler/llds_out.m	5 Mar 2005 00:06:28 -0000
@@ -214,7 +214,7 @@
 			!IO),
 		dir__make_directory(ObjDirName, _, !IO),
 
-		output_split_c_file_init(ModuleName, Modules, Datas,
+		output_split_c_file_init(ModuleName, Modules, Datas, Vars,
 			ComplexityProcs, StackLayoutLabels, MaybeRLFile, !IO),
 		output_split_user_foreign_codes(UserForeignCodes, ModuleName,
 			C_HeaderInfo, ComplexityProcs, StackLayoutLabels,
@@ -323,10 +323,11 @@
 		ComplexityProcs, StackLayoutLabels, !Num, !IO).
 
 :- pred output_split_c_file_init(module_name::in, list(comp_gen_c_module)::in,
-	list(comp_gen_c_data)::in, list(complexity_proc_info)::in,
-	map(label, data_addr)::in, maybe(rl_file)::in, io::di, io::uo) is det.
+	list(comp_gen_c_data)::in, list(comp_gen_c_var)::in,
+	list(complexity_proc_info)::in, map(label, data_addr)::in,
+	maybe(rl_file)::in, io::di, io::uo) is det.
 
-output_split_c_file_init(ModuleName, Modules, Datas, ComplexityProcs,
+output_split_c_file_init(ModuleName, Modules, Datas, Vars, ComplexityProcs,
 		StackLayoutLabels, MaybeRLFile, !IO) :-
 	module_name_to_file_name(ModuleName, ".m", no, SourceFileName, !IO),
 	module_name_to_split_c_file_name(ModuleName, 0, ".c", FileName, !IO),
@@ -341,7 +342,7 @@
 		output_c_file_mercury_headers(!IO),
 		io__write_string("\n", !IO),
 		decl_set_init(DeclSet0),
-		output_c_module_init_list(ModuleName, Modules, Datas,
+		output_c_module_init_list(ModuleName, Modules, Datas, Vars,
 			ComplexityProcs, StackLayoutLabels,
 			DeclSet0, _DeclSet, !IO),
 		c_util__output_rl_file(ModuleName, MaybeRLFile, !IO),
@@ -469,7 +470,7 @@
 	;
 		SplitFiles = no,
 		io__write_string("\n", !IO),
-		output_c_module_init_list(ModuleName, Modules, Datas,
+		output_c_module_init_list(ModuleName, Modules, Datas, Vars,
 			ComplexityProcs, StackLayoutLabels, !DeclSet, !IO)
 	),
 	c_util__output_rl_file(ModuleName, MaybeRLFile, !IO),
@@ -505,11 +506,11 @@
 		!OtherLayouts).
 
 :- pred output_c_module_init_list(module_name::in, list(comp_gen_c_module)::in,
-	list(comp_gen_c_data)::in, list(complexity_proc_info)::in,
-	map(label, data_addr)::in, decl_set::in, decl_set::out,
-	io::di, io::uo) is det.
+	list(comp_gen_c_data)::in, list(comp_gen_c_var)::in,
+	list(complexity_proc_info)::in, map(label, data_addr)::in,
+	decl_set::in, decl_set::out, io::di, io::uo) is det.
 
-output_c_module_init_list(ModuleName, Modules, Datas, ComplexityProcs,
+output_c_module_init_list(ModuleName, Modules, Datas, Vars, ComplexityProcs,
 		StackLayoutLabels, !DeclSet, !IO) :-
 	MustInit = (pred(Module::in) is semidet :-
 		module_defines_label_with_layout(Module, StackLayoutLabels)
@@ -555,6 +556,16 @@
 	io__write_string("init_complexity_procs(void);\n", !IO),
 	io__write_string("#endif\n", !IO),
 
+	globals__io_lookup_bool_option(allow_table_reset, TableReset, !IO),
+	(
+		TableReset = yes,
+		io__write_string("void ", !IO),
+		output_init_name(ModuleName, !IO),
+		io__write_string("reset_tables(void);\n", !IO)
+	;
+		TableReset = no
+	),
+
 	io__write_string("\n", !IO),
 
 	io__write_string("void ", !IO),
@@ -635,6 +646,18 @@
 	io__write_string("}\n", !IO),
 	io__write_string("\n#endif\n\n", !IO),
 
+	(
+		TableReset = yes,
+		io__write_string("void ", !IO),
+		output_init_name(ModuleName, !IO),
+		io__write_string("reset_tables(void)\n", !IO),
+		io__write_string("{\n", !IO),
+		list__foldl(output_init_reset_table, Vars, !IO),
+		io__write_string("}\n\n", !IO)
+	;
+		TableReset = no
+	),
+
 	io__write_string(
 		"/* ensure everything is compiled with the same grade */\n",
 		!IO),
@@ -896,6 +919,14 @@
 
 complexity_arg_is_profiled(complexity_arg_info(_, Kind)) :-
 	Kind = complexity_input_variable_size.
+
+:- pred output_init_reset_table(comp_gen_c_var::in, io::di, io::uo) is det.
+
+output_init_reset_table(Var, !IO) :-
+	Var = tabling_pointer_var(_Module, ProcLabel),
+	io__write_string("\t", !IO),
+	output_tabling_pointer_var_name(ProcLabel, !IO),
+	io__write_string(".MR_integer = 0;\n", !IO).
 
 	% Output a comment to tell mkinit what functions to
 	% call from <module>_init.c.
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.450
diff -u -b -r1.450 options.m
--- compiler/options.m	6 Mar 2005 05:17:29 -0000	1.450
+++ compiler/options.m	7 Mar 2005 01:29:38 -0000
@@ -162,6 +162,7 @@
 		;	suppress_trace
 		;	stack_trace_higher_order
 		;	tabling_via_extra_args
+		;	allow_table_reset
 		;	generate_bytecode
 		;	line_numbers
 		;	auto_comments
@@ -844,6 +845,7 @@
 	delay_death		-	bool(yes),
 	stack_trace_higher_order -	bool(no),
 	tabling_via_extra_args	-	bool(yes),
+	allow_table_reset	-	bool(no),
 	generate_bytecode	-	bool(no),
 	line_numbers		-	bool(yes),
 	auto_comments		-	bool(no),
@@ -1511,6 +1513,7 @@
 long_option("delay-death",		delay_death).
 long_option("stack-trace-higher-order",	stack_trace_higher_order).
 long_option("tabling-via-extra-args",	tabling_via_extra_args).
+long_option("allow-table-reset",	allow_table_reset).
 long_option("generate-bytecode",	generate_bytecode).
 long_option("line-numbers",		line_numbers).
 long_option("auto-comments",		auto_comments).
@@ -2891,6 +2894,8 @@
 		"\tsupported in general.",
 %		"--tabling-via-extra-args",
 %		"\tGenerate output via extra_args in foreign_procs.",
+%		"--allow-table-reset",
+%		"\tGenerate C code for resetting tabling data structures.",
 		"--generate-bytecode",
 		"\tOutput a bytecode form of the module for use",
 		"\tby an experimental debugger.",
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.426
diff -u -b -r1.426 user_guide.texi
--- doc/user_guide.texi	6 Mar 2005 05:17:36 -0000	1.426
+++ doc/user_guide.texi	7 Mar 2005 04:52:33 -0000
@@ -5435,6 +5435,10 @@
 @c into a single piece of foreign language code
 @c and passing the required data as extra arguments.
 
+ at c @item --allow-table-reset
+ at c @findex --allow-table-reset
+ at c Generate C code for resetting tabling data structures.
+
 @item --generate-bytecode
 @findex --generate-bytecode
 @c Output a bytecode version of the module
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
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/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
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/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
Index: tests/debugger/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/Mercury.options,v
retrieving revision 1.10
diff -u -b -r1.10 Mercury.options
--- tests/debugger/Mercury.options	9 Dec 2004 01:03:19 -0000	1.10
+++ tests/debugger/Mercury.options	5 Mar 2005 02:16:55 -0000
@@ -45,3 +45,5 @@
 # The following is necessary for shared libraries to work on Linux.
 GRADEFLAGS-interactive = --pic-reg
 MLFLAGS-interactive = --shared
+
+MCFLAGS-fib = --allow-table-reset
Index: tests/debugger/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/Mmakefile,v
retrieving revision 1.111
diff -u -b -r1.111 Mmakefile
--- tests/debugger/Mmakefile	10 Feb 2005 04:10:31 -0000	1.111
+++ tests/debugger/Mmakefile	5 Mar 2005 00:12:57 -0000
@@ -28,6 +28,7 @@
 	exception_vars			\
 	existential_type_classes	\
 	exported_eqv_type		\
+	fib				\
 	field_names			\
 	higher_order			\
 	implied_instance		\
@@ -335,6 +336,9 @@
 
 exported_eqv_type.out: exported_eqv_type exported_eqv_type.inp
 	$(MDB_STD) ./exported_eqv_type < exported_eqv_type.inp > exported_eqv_type.out 2>&1
+
+fib.out: fib fib.inp
+	$(MDB_STD) ./fib < fib.inp > fib.out 2>&1
 
 field_names.out: field_names field_names.inp
 	$(MDB) ./field_names < field_names.inp > field_names.out 2>&1
Index: tests/debugger/fib.exp
===================================================================
RCS file: tests/debugger/fib.exp
diff -N tests/debugger/fib.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/fib.exp	5 Mar 2005 02:18:33 -0000
@@ -0,0 +1,48 @@
+      E1:     C1 CALL pred fib.main/2-0 (cc_multi) fib.m:13
+mdb> echo on
+Command echo enabled.
+mdb> context none
+Contexts will not be printed.
+mdb> register --quiet
+mdb> step
+      E2:     C2 CALL pred fib.perform_trials/3-0 (cc_multi)
+mdb> finish
+tabling works
+      E3:     C2 EXIT pred fib.perform_trials/3-0 (cc_multi)
+mdb> table mfib
+memo table for pred fib.mfib/2-0 (det):
+<0>: succeeded <1>
+<1>: succeeded <1>
+<2>: succeeded <2>
+<3>: succeeded <3>
+<4>: succeeded <5>
+<5>: succeeded <8>
+<6>: succeeded <13>
+<7>: succeeded <21>
+<8>: succeeded <34>
+<9>: succeeded <55>
+<10>: succeeded <89>
+<11>: succeeded <144>
+<12>: succeeded <233>
+<13>: succeeded <377>
+<14>: succeeded <610>
+<15>: succeeded <987>
+<16>: succeeded <1597>
+<17>: succeeded <2584>
+<18>: succeeded <4181>
+<19>: succeeded <6765>
+<20>: succeeded <10946>
+<21>: succeeded <17711>
+<22>: succeeded <28657>
+<23>: succeeded <46368>
+<24>: succeeded <75025>
+<25>: succeeded <121393>
+<26>: succeeded <196418>
+end of table (27 entries)
+mdb> step 2
+      E4:     C3 EXIT pred fib.reset/2-0 (det)
+mdb> table mfib
+memo table for pred fib.mfib/2-0 (det):
+end of table (0 entries)
+mdb> continue
+tabling works
Index: tests/debugger/fib.inp
===================================================================
RCS file: tests/debugger/fib.inp
diff -N tests/debugger/fib.inp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/fib.inp	5 Mar 2005 00:14:23 -0000
@@ -0,0 +1,9 @@
+echo on
+context none
+register --quiet
+step
+finish
+table mfib
+step 2
+table mfib
+continue
Index: tests/debugger/fib.m
===================================================================
RCS file: tests/debugger/fib.m
diff -N tests/debugger/fib.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/fib.m	5 Mar 2005 00:10:45 -0000
@@ -0,0 +1,87 @@
+:- module fib.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module benchmarking, require, int.
+
+main(!IO) :-
+	perform_trials(20, !IO),
+	reset(!IO),
+	perform_trials(20, !IO).
+
+:- pred perform_trials(int::in, io::di, io::uo) is cc_multi.
+
+perform_trials(N, !IO) :-
+	trial(N, Time, MTime),
+	% io__write_int(N, !IO),
+	% io__write_string(": ", !IO),
+	% io__write_int(Time, !IO),
+	% io__write_string("ms vs ", !IO),
+	% io__write_int(MTime, !IO),
+	% io__write_string("ms\n", !IO),
+	(
+		(
+			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+3, !IO)
+	).
+
+:- pred trial(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(int::in, int::out) is det.
+
+fib(N, F) :-
+	( N < 2 ->
+		F = 1
+	;
+		fib(N - 1, F1),
+		fib(N - 2, F2),
+		F = F1 + F2
+	).
+
+:- pred mfib(int::in, int::out) is det.
+:- pragma memo(mfib/2).
+
+mfib(N, F) :-
+	( N < 2 ->
+		F = 1
+	;
+		mfib(N - 1, F1),
+		mfib(N - 2, F2),
+		F = F1 + F2
+	).
+
+:- pred reset(io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+	reset(IO0::di, IO::uo),
+	[will_not_call_mercury, promise_pure],
+"
+	/* IO0, IO */
+	extern void mercury__fib__reset_tables(void);
+	mercury__fib__reset_tables();
+").
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/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------



More information about the reviews mailing list