[m-rev.] for review: --trace-table-descendant-io and --trace-table-io-unitize
Zoltan Somogyi
zs at cs.mu.OZ.AU
Tue Jul 23 12:32:15 AEST 2002
For review by anyone. As mentioned earlier, the documentation will come
when we have decided on the relationship to debug grades.
Zoltan.
Add two new annotations for foreign_procs, tabled_for_descendant_io and
tabled_for_io_unitize.
By adding the tabled_for_descendant_io annotation to a foreign_proc with I/O
states, the programmer is asserting that the foreign_proc itself doesn't do
I/O, and nor does any foreign language code it calls, though the Mercury
predicates it calls may.
By adding the tabled_for_io_unitize annotation to a foreign_proc with I/O
states, the programmer is saying that both the foreign_proc itself and the
Mercury predicates it calls may do I/O. To avoid the I/O tabling problems
that would arise on retries from Mercury code called by the foreign_proc,
the programmer is requesting that the debugger treat calls to the foreign_proc
as a unit. This means that if I/O tabling is turned on, then the implementation
will disable both debugging and I/O tabling inside Mercury code called from
the foreign_proc.
compiler/prog_data.m:
Add the tabled_for_descendant_io and tabled_for_io_unitize annotations.
Parameterize the eval_table_io eval_method to accommodate the
unitization of foreign_procs.
compiler/prog_io_pragma.m:
Add code to read in the tabled_for_descendant_io and
tabled_for_io_unitize annotations.
compiler/prog_io_pragma.m:
Handle the new annotations. Procedures with tabled_for_descendant_io
annotations don't need to be transformed at all; procedures with
tabled_for_io_unitize annotations need a small variation of the
existing transformation.
Fix an existing bug that made the HLDS not type-correct. Create new
variables with the appropriate type; do not assume all new variables
are c_pointers, since some are integers.
library/table_builtin.m:
Add two new predicates that table_gen.m emits calls to on either side
of the code of foreign_procs with tabled_for_io_unitize annotations.
compiler/hlds_out.m:
compiler/layout_out.m:
compiler/mercury_to_mercury.m:
Update the mechanisms for printing out eval methods.
compiler/hlds_pred.m:
Update the mechanisms for performing tests on eval methods.
Change some of the predicates involved to functions, partly in order
to make future maintenance easier.
compiler/det_analysis.m:
compiler/det_report.m:
compiler/make_hlds.m:
compiler/modes.m:
Conform to the change from predicates to functions.
runtime/mercury_trace_base.c:
Update the documentation of MR_trace_enabled.
runtime/mercury_stack_layout.h:
Add names for the new eval methods.
trace/mercury_trace_base.c:
Handle the new eval methods.
tests/debugger/tabled_read_unitize.{m,inp,exp,data}:
A new test case to check the handling of unitized foreign_procs.
tests/debugger/Mmakefile:
Turn on the new test case.
cvs diff: Diffing .
cvs diff: Diffing bench
cvs diff: Diffing bench/progs
cvs diff: Diffing bench/progs/compress
cvs diff: Diffing bench/progs/icfp2000
cvs diff: Diffing bench/progs/icfp2001
cvs diff: Diffing bench/progs/nuc
cvs diff: Diffing bench/progs/ray
cvs diff: Diffing bench/progs/tree234
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/det_analysis.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/det_analysis.m,v
retrieving revision 1.155
diff -u -b -r1.155 det_analysis.m
--- compiler/det_analysis.m 2002/04/29 05:50:41 1.155
+++ compiler/det_analysis.m 2002/07/21 12:28:41
@@ -289,7 +289,7 @@
% Now see if the evaluation model can change the detism
proc_info_eval_method(Proc0, EvalMethod),
- eval_method_change_determinism(EvalMethod, Detism2, Detism),
+ Detism = eval_method_change_determinism(EvalMethod, Detism2),
% Save the newly inferred information
proc_info_set_goal(Proc0, Goal, Proc1),
Index: compiler/det_report.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/det_report.m,v
retrieving revision 1.73
diff -u -b -r1.73 det_report.m
--- compiler/det_report.m 2002/06/30 17:06:12 1.73
+++ compiler/det_report.m 2002/07/21 12:35:42
@@ -246,7 +246,8 @@
% make sure the code model is valid given the eval method
{ proc_info_eval_method(ProcInfo0, EvalMethod) },
(
- { valid_determinism_for_eval_method(EvalMethod, InferredDetism) }
+ { valid_determinism_for_eval_method(EvalMethod,
+ InferredDetism) = yes }
->
{
proc_info_set_eval_method(ProcInfo0, EvalMethod, ProcInfo),
@@ -259,7 +260,7 @@
;
{ proc_info_context(ProcInfo0, Context) },
prog_out__write_context(Context),
- { eval_method_to_string(EvalMethod, EvalMethodS) },
+ { EvalMethodS = eval_method_to_string(EvalMethod) },
io__write_string("Error: `pragma "),
io__write_string(EvalMethodS),
io__write_string("' declaration not allowed for procedure\n"),
@@ -284,7 +285,7 @@
get_valid_dets(EvalMethod, Detism) :-
determinism(Detism),
- valid_determinism_for_eval_method(EvalMethod, Detism).
+ valid_determinism_for_eval_method(EvalMethod, Detism) = yes.
% generate all the possible determinisms
:- pred determinism(determinism).
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.287
diff -u -b -r1.287 hlds_out.m
--- compiler/hlds_out.m 2002/07/22 06:29:32 1.287
+++ compiler/hlds_out.m 2002/07/22 07:48:36
@@ -3505,10 +3505,23 @@
io__write_string("memo").
hlds_out__write_eval_method(eval_minimal) -->
io__write_string("minimal").
-hlds_out__write_eval_method(eval_table_io) -->
- io__write_string("table_io").
-hlds_out__write_eval_method(eval_table_io_decl) -->
- io__write_string("table_io_decl").
+hlds_out__write_eval_method(eval_table_io(IsDecl, IsUnitize)) -->
+ io__write_string("table_io("),
+ (
+ { IsDecl = table_io_decl },
+ io__write_string("decl, ")
+ ;
+ { IsDecl = table_io_proc },
+ io__write_string("proc, ")
+ ),
+ (
+ { IsUnitize = table_io_unitize },
+ io__write_string("unitize")
+ ;
+ { IsUnitize = table_io_alone },
+ io__write_string("alone")
+ ),
+ io__write_string(")").
%-----------------------------------------------------------------------------%
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.110
diff -u -b -r1.110 hlds_pred.m
--- compiler/hlds_pred.m 2002/06/30 17:06:16 1.110
+++ compiler/hlds_pred.m 2002/07/21 12:57:59
@@ -2785,12 +2785,10 @@
% Check if the given evaluation method is allowed with
% the given determinism.
-:- pred valid_determinism_for_eval_method(eval_method, determinism).
-:- mode valid_determinism_for_eval_method(in, in) is semidet.
+:- func valid_determinism_for_eval_method(eval_method, determinism) = bool.
% Convert an evaluation method to a string.
-:- pred eval_method_to_string(eval_method, string).
-:- mode eval_method_to_string(in, out) is det.
+:- func eval_method_to_string(eval_method) = string.
% Return true if the given evaluation method requires a
% stratification check.
@@ -2815,71 +2813,81 @@
% Return the change a given evaluation method can do to a given
% determinism.
-:- pred eval_method_change_determinism(eval_method, determinism,
- determinism).
-:- mode eval_method_change_determinism(in, in, out) is det.
+:- func eval_method_change_determinism(eval_method, determinism) = determinism.
:- implementation.
:- import_module check_hlds__det_analysis.
-valid_determinism_for_eval_method(eval_normal, _).
-valid_determinism_for_eval_method(eval_loop_check, _).
-valid_determinism_for_eval_method(eval_table_io, _) :-
+valid_determinism_for_eval_method(eval_normal, _) = yes.
+valid_determinism_for_eval_method(eval_loop_check, _) = yes.
+valid_determinism_for_eval_method(eval_table_io(_, _), _) = _ :-
error("valid_determinism_for_eval_method called after tabling phase").
-valid_determinism_for_eval_method(eval_memo, _).
-valid_determinism_for_eval_method(eval_minimal, Determinism) :-
- determinism_components(Determinism, can_fail, _).
-
-eval_method_to_string(eval_normal, "normal").
-eval_method_to_string(eval_loop_check, "loop_check").
-eval_method_to_string(eval_table_io, "table_io").
-eval_method_to_string(eval_table_io_decl, "table_io_decl").
-eval_method_to_string(eval_memo, "memo").
-eval_method_to_string(eval_minimal, "minimal_model").
+valid_determinism_for_eval_method(eval_memo, _) = yes.
+valid_determinism_for_eval_method(eval_minimal, Determinism) = Valid :-
+ ( determinism_components(Determinism, can_fail, _) ->
+ Valid = yes
+ ;
+ Valid = no
+ ).
+
+eval_method_to_string(eval_normal) = "normal".
+eval_method_to_string(eval_loop_check) = "loop_check".
+eval_method_to_string(eval_memo) = "memo".
+eval_method_to_string(eval_minimal) = "minimal_model".
+eval_method_to_string(eval_table_io(IsDecl, IsUnitize)) = Str :-
+ (
+ IsDecl = table_io_decl,
+ DeclStr = "decl, "
+ ;
+ IsDecl = table_io_proc,
+ DeclStr = "proc, "
+ ),
+ (
+ IsUnitize = table_io_unitize,
+ UnitizeStr = "unitize"
+ ;
+ IsUnitize = table_io_alone,
+ UnitizeStr = "alone"
+ ),
+ Str = "table_io(" ++ DeclStr ++ UnitizeStr ++ ")".
eval_method_needs_stratification(eval_normal) = no.
eval_method_needs_stratification(eval_loop_check) = no.
-eval_method_needs_stratification(eval_table_io) = no.
-eval_method_needs_stratification(eval_table_io_decl) = no.
+eval_method_needs_stratification(eval_table_io(_, _)) = no.
eval_method_needs_stratification(eval_memo) = no.
eval_method_needs_stratification(eval_minimal) = yes.
eval_method_has_per_proc_tabling_pointer(eval_normal) = no.
eval_method_has_per_proc_tabling_pointer(eval_loop_check) = yes.
-eval_method_has_per_proc_tabling_pointer(eval_table_io) = no.
-eval_method_has_per_proc_tabling_pointer(eval_table_io_decl) = no.
+eval_method_has_per_proc_tabling_pointer(eval_table_io(_, _)) = no.
eval_method_has_per_proc_tabling_pointer(eval_memo) = yes.
eval_method_has_per_proc_tabling_pointer(eval_minimal) = yes.
eval_method_requires_tabling_transform(eval_normal) = no.
eval_method_requires_tabling_transform(eval_loop_check) = yes.
-eval_method_requires_tabling_transform(eval_table_io) = yes.
-eval_method_requires_tabling_transform(eval_table_io_decl) = yes.
+eval_method_requires_tabling_transform(eval_table_io(_, _)) = yes.
eval_method_requires_tabling_transform(eval_memo) = yes.
eval_method_requires_tabling_transform(eval_minimal) = yes.
eval_method_requires_ground_args(eval_normal) = no.
eval_method_requires_ground_args(eval_loop_check) = yes.
-eval_method_requires_ground_args(eval_table_io) = yes.
-eval_method_requires_ground_args(eval_table_io_decl) = yes.
+eval_method_requires_ground_args(eval_table_io(_, _)) = yes.
eval_method_requires_ground_args(eval_memo) = yes.
eval_method_requires_ground_args(eval_minimal) = yes.
eval_method_destroys_uniqueness(eval_normal) = no.
eval_method_destroys_uniqueness(eval_loop_check) = yes.
-eval_method_destroys_uniqueness(eval_table_io) = no.
-eval_method_destroys_uniqueness(eval_table_io_decl) = no.
+eval_method_destroys_uniqueness(eval_table_io(_, _)) = no.
eval_method_destroys_uniqueness(eval_memo) = yes.
eval_method_destroys_uniqueness(eval_minimal) = yes.
-eval_method_change_determinism(eval_normal, Detism, Detism).
-eval_method_change_determinism(eval_loop_check, Detism, Detism).
-eval_method_change_determinism(eval_table_io, Detism, Detism).
-eval_method_change_determinism(eval_table_io_decl, Detism, Detism).
-eval_method_change_determinism(eval_memo, Detism, Detism).
-eval_method_change_determinism(eval_minimal, Det0, Det) :-
- det_conjunction_detism(semidet, Det0, Det).
+eval_method_change_determinism(eval_normal, Detism) = Detism.
+eval_method_change_determinism(eval_loop_check, Detism) = Detism.
+eval_method_change_determinism(eval_table_io(_, _), Detism) = Detism.
+eval_method_change_determinism(eval_memo, Detism) = Detism.
+eval_method_change_determinism(eval_minimal, Detism0) = Detism :-
+ det_conjunction_detism(semidet, Detism0, Detism).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/layout_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/layout_out.m,v
retrieving revision 1.11
diff -u -b -r1.11 layout_out.m
--- compiler/layout_out.m 2002/05/16 13:14:47 1.11
+++ compiler/layout_out.m 2002/07/21 12:46:06
@@ -720,9 +720,25 @@
eval_method_to_c_string(eval_normal) = "MR_EVAL_METHOD_NORMAL".
eval_method_to_c_string(eval_loop_check) = "MR_EVAL_METHOD_LOOP_CHECK".
eval_method_to_c_string(eval_memo) = "MR_EVAL_METHOD_MEMO".
-eval_method_to_c_string(eval_table_io) = "MR_EVAL_METHOD_TABLE_IO".
-eval_method_to_c_string(eval_table_io_decl) = "MR_EVAL_METHOD_TABLE_IO_DECL".
eval_method_to_c_string(eval_minimal) = "MR_EVAL_METHOD_MINIMAL".
+eval_method_to_c_string(eval_table_io(Decl, Unitize)) = Str :-
+ (
+ Decl = table_io_proc,
+ Unitize = table_io_alone,
+ Str = "MR_EVAL_METHOD_TABLE_IO"
+ ;
+ Decl = table_io_proc,
+ Unitize = table_io_unitize,
+ Str = "MR_EVAL_METHOD_TABLE_IO_UNITIZE"
+ ;
+ Decl = table_io_decl,
+ Unitize = table_io_alone,
+ Str = "MR_EVAL_METHOD_TABLE_IO_DECL"
+ ;
+ Decl = table_io_decl,
+ Unitize = table_io_unitize,
+ Str = "MR_EVAL_METHOD_TABLE_IO_UNITIZE_DECL"
+ ).
:- pred output_proc_layout_head_var_nums(proc_label::in, list(int)::in,
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.419
diff -u -b -r1.419 make_hlds.m
--- compiler/make_hlds.m 2002/07/22 06:29:37 1.419
+++ compiler/make_hlds.m 2002/07/22 07:48:37
@@ -754,7 +754,7 @@
{ module_info_incr_errors(Module0, Module) },
prog_out__write_context(Context),
io__write_string("Error: `:- pragma "),
- { eval_method_to_string(Type, EvalMethodS) },
+ { EvalMethodS = eval_method_to_string(Type) },
io__write_string(EvalMethodS),
io__write_string(
"' declaration requires the type_ctor_layout\n"),
@@ -4616,7 +4616,7 @@
module_add_pragma_tabled(EvalMethod, PredName, Arity, MaybePredOrFunc,
MaybeModes, Status, Context, ModuleInfo0, ModuleInfo) -->
{ module_info_get_predicate_table(ModuleInfo0, PredicateTable0) },
- { eval_method_to_string(EvalMethod, EvalMethodS) },
+ { EvalMethodS = eval_method_to_string(EvalMethod) },
% Find out if we are tabling a predicate or a function
(
@@ -4693,7 +4693,7 @@
{ adjust_func_arity(PredOrFunc, Arity0, Arity) },
% print out a progress message
- { eval_method_to_string(EvalMethod, EvalMethodS) },
+ { EvalMethodS = eval_method_to_string(EvalMethod) },
globals__io_lookup_bool_option(very_verbose, VeryVerbose),
(
{ VeryVerbose = yes }
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.218
diff -u -b -r1.218 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 2002/07/09 01:29:28 1.218
+++ compiler/mercury_to_mercury.m 2002/07/21 12:35:09
@@ -549,7 +549,7 @@
mercury_output_pragma_decl(Pred, Arity, predicate, "obsolete")
;
{ Pragma = tabled(Type, Pred, Arity, _PredOrFunc, _Mode) },
- { eval_method_to_string(Type, TypeS) },
+ { TypeS = eval_method_to_string(Type) },
mercury_output_pragma_decl(Pred, Arity, predicate, TypeS)
;
{ Pragma = type_spec(_, _, _, _, _, _, _, _) },
@@ -3769,18 +3769,9 @@
:- pred output_eval_method(eval_method::in, string::di, string::uo) is det.
-output_eval_method(eval_normal) -->
- output_string("eval_normal").
-output_eval_method(eval_loop_check) -->
- output_string("eval_loop_check").
-output_eval_method(eval_memo) -->
- output_string("eval_memo").
-output_eval_method(eval_table_io) -->
- output_string("eval_table_io").
-output_eval_method(eval_table_io_decl) -->
- output_string("eval_table_io_decl").
-output_eval_method(eval_minimal) -->
- output_string("eval_minimal").
+output_eval_method(EvalMethod) -->
+ output_string("eval_"),
+ output_string(eval_method_to_string(EvalMethod)).
:- pred output_lambda_eval_method(lambda_eval_method::in,
string::di, string::uo) is det.
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.260
diff -u -b -r1.260 modes.m
--- compiler/modes.m 2002/05/09 16:31:01 1.260
+++ compiler/modes.m 2002/07/21 12:29:13
@@ -2298,7 +2298,7 @@
report_eval_method_requires_ground_args(ProcInfo, ModuleInfo0, ModuleInfo) -->
{ proc_info_eval_method(ProcInfo, EvalMethod) },
{ proc_info_context(ProcInfo, Context) },
- { eval_method_to_string(EvalMethod, EvalMethodS) },
+ { EvalMethodS = eval_method_to_string(EvalMethod) },
globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
prog_out__write_context(Context),
io__write_string("Sorry, not implemented: `pragma "),
@@ -2326,7 +2326,7 @@
report_eval_method_destroys_uniqueness(ProcInfo, ModuleInfo0, ModuleInfo) -->
{ proc_info_eval_method(ProcInfo, EvalMethod) },
{ proc_info_context(ProcInfo, Context) },
- { eval_method_to_string(EvalMethod, EvalMethodS) },
+ { EvalMethodS = eval_method_to_string(EvalMethod) },
globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
prog_out__write_context(Context),
io__write_string("Error: `pragma "),
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.85
diff -u -b -r1.85 prog_data.m
--- compiler/prog_data.m 2002/07/09 01:29:45 1.85
+++ compiler/prog_data.m 2002/07/21 12:32:57
@@ -345,18 +345,34 @@
% Stuff for tabling pragmas
%
- % The evaluation method that should be used for a pred.
+ % The evaluation method that should be used for a procedure.
% Ignored for Aditi procedures.
:- type eval_method
---> eval_normal % normal mercury
% evaluation
; eval_loop_check % loop check only
; eval_memo % memoing + loop check
- ; eval_table_io % memoing I/O actions for debugging
- ; eval_table_io_decl % memoing I/O actions for declarative
- % debugging
+ ; eval_table_io( % memoing I/O actions for debugging
+ table_io_is_decl,
+ table_io_is_unitize
+ )
; eval_minimal. % minimal model
% evaluation
+
+:- type table_io_is_decl
+ ---> table_io_decl % The procedure is tabled for
+ % declarative debugging.
+ ; table_io_proc. % The procedure is tabled only for
+ % procedural debugging.
+
+:- type table_io_is_unitize
+ ---> table_io_unitize % The procedure is tabled for I/O
+ % together with its Mercury
+ % descendants.
+ ; table_io_alone. % The procedure is tabled for I/O
+ % by itself; it can have no Mercury
+ % descendants.
+
%
% Stuff for the `aditi_index' pragma
%
@@ -651,7 +667,9 @@
:- type tabled_for_io
---> not_tabled_for_io
- ; tabled_for_io.
+ ; tabled_for_io
+ ; tabled_for_io_unitize
+ ; tabled_for_descendant_io.
:- type pragma_var
---> pragma_var(prog_var, string, mode).
@@ -659,7 +677,6 @@
% we explicitly store the name because we need the real
% name in code_gen
-
:- type pragma_foreign_proc_extra_attribute
---> max_stack_size(int).
@@ -1125,7 +1142,6 @@
set_legacy_purity_behaviour(Attrs0, Legacy, Attrs) :-
Attrs = Attrs0 ^ legacy_purity_behaviour := Legacy.
-
attributes_to_strings(Attrs, StringList) :-
% We ignore Lang because it isn't an attribute that you can put
% in the attribute list -- the foreign language specifier string
@@ -1149,6 +1165,12 @@
(
TabledForIO = tabled_for_io,
TabledForIOStr = "tabled_for_io"
+ ;
+ TabledForIO = tabled_for_io_unitize,
+ TabledForIOStr = "tabled_for_io_unitize"
+ ;
+ TabledForIO = tabled_for_descendant_io,
+ TabledForIOStr = "tabled_for_descendant_io"
;
TabledForIO = not_tabled_for_io,
TabledForIOStr = "not_tabled_for_io"
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.51
diff -u -b -r1.51 prog_io_pragma.m
--- compiler/prog_io_pragma.m 2002/06/30 17:06:38 1.51
+++ compiler/prog_io_pragma.m 2002/07/21 15:04:59
@@ -1144,7 +1144,17 @@
thread_safe(thread_safe) -
thread_safe(not_thread_safe),
tabled_for_io(tabled_for_io) -
+ tabled_for_io(tabled_for_io_unitize),
+ tabled_for_io(tabled_for_io) -
+ tabled_for_io(tabled_for_descendant_io),
+ tabled_for_io(tabled_for_io) -
tabled_for_io(not_tabled_for_io),
+ tabled_for_io(tabled_for_io_unitize) -
+ tabled_for_io(tabled_for_descendant_io),
+ tabled_for_io(tabled_for_io_unitize) -
+ tabled_for_io(not_tabled_for_io),
+ tabled_for_io(tabled_for_descendant_io) -
+ tabled_for_io(not_tabled_for_io),
purity(pure) - purity(impure),
purity(pure) - purity(semipure),
purity(semipure) - purity(impure)
@@ -1278,10 +1288,20 @@
:- pred parse_tabled_for_io(term, tabled_for_io).
:- mode parse_tabled_for_io(in, out) is semidet.
-parse_tabled_for_io(term__functor(term__atom("tabled_for_io"), [], _),
- tabled_for_io).
-parse_tabled_for_io(term__functor(term__atom("not_tabled_for_io"), [], _),
- not_tabled_for_io).
+parse_tabled_for_io(term__functor(term__atom(Str), [], _), TabledForIo) :-
+ (
+ Str = "tabled_for_io",
+ TabledForIo = tabled_for_io
+ ;
+ Str = "tabled_for_io_unitize",
+ TabledForIo = tabled_for_io_unitize
+ ;
+ Str = "tabled_for_descendant_io",
+ TabledForIo = tabled_for_descendant_io
+ ;
+ Str = "not_tabled_for_io",
+ TabledForIo = not_tabled_for_io
+ ).
% XXX For the moment we just ignore the following attributes.
% These attributes are used for aliasing on the reuse branch,
@@ -1293,7 +1313,6 @@
parse_aliasing(term__functor(term__atom("no_aliasing"), [], _)).
parse_aliasing(term__functor(term__atom("unknown_aliasing"), [], _)).
parse_aliasing(term__functor(term__atom("alias"), [_Types, _Alias], _)).
-
:- pred parse_max_stack_size(term::in, int::out) is semidet.
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.36
diff -u -b -r1.36 table_gen.m
--- compiler/table_gen.m 2002/07/22 07:13:05 1.36
+++ compiler/table_gen.m 2002/07/22 06:35:45
@@ -300,70 +300,145 @@
map__lookup(PredTable, PredId, PredInfo),
pred_info_procedures(PredInfo, ProcTable),
map__lookup(ProcTable, ProcId, ProcInfo0),
+ table_gen__process_proc(PredId, ProcId, ProcInfo0, PredInfo,
+ ModuleInfo0, ModuleInfo1, S0, S1),
+ table_gen__process_procs(PredId, ProcIds, ModuleInfo1, ModuleInfo,
+ S1, S).
- module_info_globals(ModuleInfo0, Globals),
- proc_info_eval_method(ProcInfo0, EvalMethod),
+:- pred table_gen__process_proc(pred_id::in, proc_id::in, proc_info::in,
+ pred_info::in, module_info::in, module_info::out, io__state::di,
+ io__state::uo) is det.
+table_gen__process_proc(PredId, ProcId, ProcInfo0, PredInfo0,
+ ModuleInfo0, ModuleInfo, S0, S) :-
+ proc_info_eval_method(ProcInfo0, EvalMethod),
( eval_method_requires_tabling_transform(EvalMethod) = yes ->
- table_gen__process_proc(EvalMethod, PredId, ProcId, ProcInfo0,
- PredInfo, ModuleInfo0, ModuleInfo2),
- S1 = S0
+ table_gen__transform_proc(EvalMethod, PredId, ProcId,
+ ProcInfo0, PredInfo0, ModuleInfo0, ModuleInfo),
+ S = S0
;
+ module_info_globals(ModuleInfo0, Globals),
globals__lookup_bool_option(Globals, trace_table_io, yes),
+ proc_info_has_io_state_pair(ModuleInfo0, ProcInfo0,
+ _InArgNum, _OutArgNum)
+ ->
+% XXX We can't include this sanity checking code, because it fails on
+% globals:io_lookup_bool_option.
+%
+% proc_info_interface_code_model(ProcInfo0, CodeModel),
+% ( CodeModel = model_det ->
+% true
+% ;
+% pred_id_to_int(PredId, PredIdInt),
+% Msg = string__format(
+% "I/O procedure pred id %d not model_det",
+% [i(PredIdInt)]),
+% error(Msg)
+% ),
globals__lookup_bool_option(Globals, trace_table_io_require,
Require),
- proc_info_has_io_state_pair(ModuleInfo0, ProcInfo0,
- _InArgNum, _OutArgNum),
- proc_info_interface_code_model(ProcInfo0, model_det),
proc_info_goal(ProcInfo0, BodyGoal),
- some [SubGoal,Attrs] (
- goal_contains_goal(BodyGoal, SubGoal),
- SubGoal = foreign_proc(Attrs, _,_,_,_,_,_)
- - _,
- ( tabled_for_io(Attrs, tabled_for_io)
- ; Require = yes
- )
- ),
predicate_module(ModuleInfo0, PredId, PredModuleName),
- \+ any_mercury_builtin_module(PredModuleName)
- ->
+ should_io_procedure_be_transformed(Require, BodyGoal,
+ PredModuleName, AnnotationIsMissing,
+ TransformPrimitive),
(
- Require = yes,
- some [SubGoal,Attrs] (
- goal_contains_goal(BodyGoal, SubGoal),
- SubGoal = foreign_proc(Attrs, _,_,_,_,_,_)
- - _,
- \+ tabled_for_io(Attrs, tabled_for_io)
- )
- ->
- report_missing_tabled_for_io(ModuleInfo0, PredInfo,
- PredId, ProcId, S0, S1),
+ AnnotationIsMissing = yes,
+ report_missing_tabled_for_io(ModuleInfo0, PredInfo0,
+ PredId, ProcId, S0, S),
module_info_incr_errors(ModuleInfo0, ModuleInfo1)
;
+ AnnotationIsMissing = no,
ModuleInfo1 = ModuleInfo0,
- S1 = S0
+ S = S0
),
- globals__lookup_bool_option(Globals, trace_table_io_decl,
- TraceTableIoDecl),
(
+ TransformPrimitive = no,
+ ModuleInfo = ModuleInfo0
+ ;
+ TransformPrimitive = yes(Unitize),
+ globals__lookup_bool_option(Globals,
+ trace_table_io_decl, TraceTableIoDecl),
+ (
TraceTableIoDecl = yes,
- TableIoMethod = eval_table_io_decl
+ Decl = table_io_decl
;
TraceTableIoDecl = no,
- TableIoMethod = eval_table_io
+ Decl = table_io_proc
),
- proc_info_set_eval_method(ProcInfo0, TableIoMethod, ProcInfo1),
- table_gen__process_proc(TableIoMethod, PredId, ProcId,
- ProcInfo1, PredInfo, ModuleInfo1, ModuleInfo2)
+ TableIoMethod = eval_table_io(Decl, Unitize),
+ proc_info_set_eval_method(ProcInfo0, TableIoMethod,
+ ProcInfo1),
+ table_gen__transform_proc(TableIoMethod,
+ PredId, ProcId, ProcInfo1, PredInfo0,
+ ModuleInfo1, ModuleInfo)
+ )
;
- ModuleInfo2 = ModuleInfo0,
- S1 = S0
- ),
- table_gen__process_procs(PredId, ProcIds, ModuleInfo2, ModuleInfo,
- S1, S).
+ ModuleInfo = ModuleInfo0,
+ S = S0
+ ).
%-----------------------------------------------------------------------------%
+:- pred should_io_procedure_be_transformed(bool::in, hlds_goal::in,
+ sym_name::in, bool::out, maybe(table_io_is_unitize)::out) is det.
+
+should_io_procedure_be_transformed(Require, BodyGoal, PredModuleName,
+ AnnotationIsMissing, TransformInfo) :-
+ tabled_for_io_attributes(BodyGoal, TabledForIoAttrs),
+ ( TabledForIoAttrs = [] ->
+ AnnotationIsMissing = no,
+ TransformInfo = no
+ ; TabledForIoAttrs = [TabledForIoAttr] ->
+ (
+ TabledForIoAttr = not_tabled_for_io,
+ (
+ Require = yes,
+ \+ any_mercury_builtin_module(PredModuleName)
+ ->
+ AnnotationIsMissing = yes
+ ;
+ AnnotationIsMissing = no
+ ),
+ TransformInfo = no
+ ;
+ TabledForIoAttr = tabled_for_descendant_io,
+ AnnotationIsMissing = no,
+ % The procedure itself doesn't do any I/O, so don't
+ % transform it.
+ TransformInfo = no
+ ;
+ TabledForIoAttr = tabled_for_io,
+ AnnotationIsMissing = no,
+ TransformInfo = yes(table_io_alone)
+ ;
+ TabledForIoAttr = tabled_for_io_unitize,
+ AnnotationIsMissing = no,
+ TransformInfo = yes(table_io_unitize)
+ )
+ ;
+ % Since table_gen is run before inlining, each procedure
+ % should contain at most one foreign_proc goal.
+ error("should_io_procedure_be_transformed: different tabled_for_io attributes in one procedure")
+ ).
+
+:- pred tabled_for_io_attributes(hlds_goal::in, list(tabled_for_io)::out)
+ is det.
+
+tabled_for_io_attributes(Goal, TabledForIoAttrs) :-
+ solutions(subgoal_tabled_for_io_attribute(Goal), TabledForIoAttrs).
+
+:- pred subgoal_tabled_for_io_attribute(hlds_goal::in, tabled_for_io::out)
+ is nondet.
+
+subgoal_tabled_for_io_attribute(Goal, TabledForIoAttr) :-
+ some [SubGoal,Attrs] (
+ goal_contains_goal(Goal, SubGoal),
+ SubGoal = foreign_proc(Attrs, _,_,_,_,_,_) - _,
+ tabled_for_io(Attrs, TabledForIoAttr),
+ \+ TabledForIoAttr = not_tabled_for_io
+ ).
+
:- pred report_missing_tabled_for_io(module_info::in, pred_info::in,
pred_id::in, proc_id::in, io__state::di, io__state::uo) is det.
@@ -376,11 +451,11 @@
%-----------------------------------------------------------------------------%
-:- pred table_gen__process_proc(eval_method::in, pred_id::in, proc_id::in,
+:- pred table_gen__transform_proc(eval_method::in, pred_id::in, proc_id::in,
proc_info::in, pred_info::in, module_info::in, module_info::out)
is det.
-table_gen__process_proc(EvalMethod, PredId, ProcId, ProcInfo0, PredInfo0,
+table_gen__transform_proc(EvalMethod, PredId, ProcId, ProcInfo0, PredInfo0,
ModuleInfo0, ModuleInfo) :-
table_info_init(ModuleInfo0, PredId, ProcId, PredInfo0, ProcInfo0,
TableInfo0),
@@ -394,19 +469,11 @@
proc_info_goal(ProcInfo0, OrigGoal),
proc_info_argmodes(ProcInfo0, ArgModes),
- (
- (
- EvalMethod = eval_table_io,
- TableDecl = no
- ;
- EvalMethod = eval_table_io_decl,
- TableDecl = yes
- )
- ->
+ ( EvalMethod = eval_table_io(Decl, Unitize) ->
module_info_globals(ModuleInfo0, Globals),
globals__lookup_bool_option(Globals, trace_table_io_states,
TableIoStates),
- table_gen__create_new_io_goal(OrigGoal, TableDecl,
+ table_gen__create_new_io_goal(OrigGoal, Decl, Unitize,
TableIoStates, HeadVars, ArgModes, VarTypes0, VarTypes,
VarSet0, VarSet, TableInfo0, TableInfo, Goal,
MaybeTableIoDeclInfo),
@@ -469,13 +536,13 @@
% Transform procedures that do I/O.
%
-:- pred table_gen__create_new_io_goal(hlds_goal::in, bool::in, bool::in,
- list(prog_var)::in, list(mode)::in,
+:- pred table_gen__create_new_io_goal(hlds_goal::in, table_io_is_decl::in,
+ table_io_is_unitize::in, bool::in, list(prog_var)::in, list(mode)::in,
map(prog_var, type)::in, map(prog_var, type)::out,
prog_varset::in, prog_varset::out, table_info::in, table_info::out,
hlds_goal::out, maybe(table_io_decl_info)::out) is det.
-table_gen__create_new_io_goal(OrigGoal, TableDecl, TableIoStates,
+table_gen__create_new_io_goal(OrigGoal, TableDecl, Unitize, TableIoStates,
HeadVars, HeadVarModes, VarTypes0, VarTypes, VarSet0, VarSet,
TableInfo0, TableInfo, Goal, MaybeTableIoDeclInfo) :-
OrigGoal = _ - OrigGoalInfo,
@@ -502,11 +569,11 @@
HeadVars, _, SavedHeadVars)
),
- generate_new_table_var("TableVar0", VarTypes0, VarTypes1,
+ generate_new_table_var("TableVar0", node_type, VarTypes0, VarTypes1,
VarSet0, VarSet1, TableVar0),
- generate_new_table_var("CounterVar", VarTypes1, VarTypes2,
+ generate_new_table_var("CounterVar", int_type, VarTypes1, VarTypes2,
VarSet1, VarSet2, CounterVar),
- generate_new_table_var("StartVar", VarTypes2, VarTypes3,
+ generate_new_table_var("StartVar", int_type, VarTypes2, VarTypes3,
VarSet2, VarSet3, StartVar),
generate_call("table_io_in_range", [TableVar0, CounterVar, StartVar],
semidet, yes(impure), [TableVar0 - ground(shared, none),
@@ -514,7 +581,7 @@
StartVar - ground(shared, none)],
ModuleInfo, Context, InRangeGoal),
- generate_new_table_var("TableVar", VarTypes3, VarTypes4,
+ generate_new_table_var("TableVar", node_type, VarTypes3, VarTypes4,
VarSet3, VarSet4, TableVar),
generate_call("table_lookup_insert_start_int",
[TableVar0, StartVar, CounterVar, TableVar],
@@ -525,14 +592,13 @@
semidet, yes(semipure), [], ModuleInfo, Context, OccurredGoal),
(
- TableDecl = yes,
+ TableDecl = table_io_decl,
PredId = TableInfo0 ^ table_cur_pred_id,
ProcId = TableInfo0 ^ table_cur_proc_id,
RttiProcLabel = rtti__make_proc_label(ModuleInfo,
PredId, ProcId),
TableIoDeclConsId = table_io_decl(RttiProcLabel),
- get_table_var_type(TableVarType),
- make_const_construction(TableIoDeclConsId, TableVarType,
+ make_const_construction(TableIoDeclConsId, node_type,
yes("TableIoDeclPtr"), TableIoDeclGoal,
TableIoDeclPtrVar, VarTypes4, VarTypes5,
VarSet4, VarSet5),
@@ -548,7 +614,7 @@
NumberedSavedHeadVars, TableIoDeclInfo),
MaybeTableIoDeclInfo = yes(TableIoDeclInfo)
;
- TableDecl = no,
+ TableDecl = table_io_proc,
VarTypes5 = VarTypes4,
VarSet5 = VarSet4,
true_goal(TableIoDeclGoal),
@@ -605,12 +671,32 @@
RestoreAnsGoal = RestoreAnsGoalEx - RestoreAnsGoalInfo
),
generate_save_goal(NumberedSaveVars, TableVar, BlockSize,
- Context, VarTypes6, VarTypes, VarSet6, VarSet,
+ Context, VarTypes6, VarTypes7, VarSet6, VarSet7,
TableInfo0, TableInfo, SaveAnsGoal),
+
+ (
+ Unitize = table_io_alone,
+ VarSet = VarSet7,
+ VarTypes = VarTypes7,
+ CallSaveAnsGoalList = [OrigGoal, TableIoDeclGoal, SaveAnsGoal]
+ ;
+ Unitize = table_io_unitize,
+ generate_new_table_var("SavedTraceEnabled", int_type,
+ VarTypes7, VarTypes, VarSet7, VarSet,
+ SavedTraceEnabledVar),
+ generate_call("table_io_left_bracket_unitized_goal",
+ [SavedTraceEnabledVar], det, yes(impure),
+ [SavedTraceEnabledVar - ground(unique, none)],
+ ModuleInfo, Context, LeftBracketGoal),
+ generate_call("table_io_right_bracket_unitized_goal",
+ [SavedTraceEnabledVar], det, yes(impure), [],
+ ModuleInfo, Context, RightBracketGoal),
+ CallSaveAnsGoalList = [LeftBracketGoal, OrigGoal,
+ RightBracketGoal, TableIoDeclGoal, SaveAnsGoal]
+ ),
- CallSaveAnsGoalEx = conj([OrigGoal, TableIoDeclGoal, SaveAnsGoal]),
- create_instmap_delta([OrigGoal, TableIoDeclGoal, SaveAnsGoal],
- CallSaveAnsInstMapDelta0),
+ CallSaveAnsGoalEx = conj(CallSaveAnsGoalList),
+ create_instmap_delta(CallSaveAnsGoalList, CallSaveAnsInstMapDelta0),
set__insert(OrigNonLocals, TableVar, CallSaveAnsNonLocals),
instmap_delta_restrict(CallSaveAnsInstMapDelta0,
CallSaveAnsNonLocals, CallSaveAnsInstMapDelta),
@@ -1064,7 +1150,7 @@
generate_get_table_goal(PredId, ProcId, VarTypes0, VarTypes, VarSet0, VarSet,
PredTableVar, Goal) :-
- generate_new_table_var("PredTable", VarTypes0, VarTypes,
+ generate_new_table_var("PredTable", node_type, VarTypes0, VarTypes,
VarSet0, VarSet, PredTableVar),
ConsId = tabling_pointer_const(PredId, ProcId),
make_const_construction(PredTableVar, ConsId, GoalExpr - GoalInfo0),
@@ -1114,7 +1200,7 @@
generate_lookup_goals(Vars, Context, PredTableVar, TableNodeVar,
VarTypes1, VarTypes2, VarSet1, VarSet2, TableInfo0, TableInfo,
LookupGoals),
- generate_new_table_var("SubgoalVar", VarTypes2, VarTypes,
+ generate_new_table_var("SubgoalVar", node_type, VarTypes2, VarTypes,
VarSet2, VarSet, SubgoalVar),
generate_call("table_nondet_setup", [TableNodeVar, SubgoalVar],
det, yes(impure), [SubgoalVar - ground(unique, none)],
@@ -1186,7 +1272,7 @@
VarTypes1, VarSet0, VarSet1, RangeVar,
RangeUnifyGoal),
- generate_new_table_var("TableNodeVar",
+ generate_new_table_var("TableNodeVar", node_type,
VarTypes1, VarTypes, VarSet1, VarSet,
NextTableVar),
generate_call("table_lookup_insert_enum",
@@ -1206,8 +1292,8 @@
error("gen_lookup: unexpected type")
)
;
- generate_new_table_var("TableNodeVar", VarTypes0, VarTypes1,
- VarSet0, VarSet1, NextTableVar),
+ generate_new_table_var("TableNodeVar", node_type,
+ VarTypes0, VarTypes1, VarSet0, VarSet1, NextTableVar),
InstMapAL = [NextTableVar - ground(unique, none)],
(
( TypeCat = pred_type
@@ -1263,8 +1349,8 @@
VarTypes1, VarSet0, VarSet1, BlockSizeVar,
BlockSizeVarUnifyGoal),
- generate_new_table_var("AnswerTableVar", VarTypes1, VarTypes2,
- VarSet1, VarSet2, AnsTableVar),
+ generate_new_table_var("AnswerTableVar", node_type,
+ VarTypes1, VarTypes2, VarSet1, VarSet2, AnsTableVar),
generate_call("table_create_ans_block",
[TableVar, BlockSizeVar, AnsTableVar], det,
@@ -1305,8 +1391,8 @@
Goal) :-
ModuleInfo = TableInfo0 ^ table_module_info,
- generate_new_table_var("AnswerTableVar", VarTypes0, VarTypes1,
- VarSet0, VarSet1, AnsTableVar0),
+ generate_new_table_var("AnswerTableVar", node_type,
+ VarTypes0, VarTypes1, VarSet0, VarSet1, AnsTableVar0),
generate_call("table_nondet_get_ans_table", [TableVar, AnsTableVar0],
det, yes(impure), [AnsTableVar0 - ground(unique, none)],
ModuleInfo, Context, GetAnsTableGoal),
@@ -1318,15 +1404,15 @@
semidet, yes(impure), [], ModuleInfo, Context,
DuplicateCheckGoal),
- generate_new_table_var("AnswerSlotVar", VarTypes2, VarTypes3,
- VarSet2, VarSet3, AnsSlotVar),
+ generate_new_table_var("AnswerSlotVar", node_type,
+ VarTypes2, VarTypes3, VarSet2, VarSet3, AnsSlotVar),
generate_call("table_nondet_new_ans_slot", [TableVar, AnsSlotVar], det,
yes(impure), [AnsSlotVar - ground(unique, none)],
ModuleInfo, Context, NewAnsSlotGoal),
gen_int_construction("BlockSize", BlockSize, VarTypes3, VarTypes4,
VarSet3, VarSet4, BlockSizeVar, BlockSizeVarUnifyGoal),
- generate_new_table_var("AnswerBlock", VarTypes4, VarTypes5,
+ generate_new_table_var("AnswerBlock", node_type, VarTypes4, VarTypes5,
VarSet4, VarSet5, AnsBlockVar),
generate_call("table_create_ans_block",
[AnsSlotVar, BlockSizeVar, AnsBlockVar], det, yes(impure),
@@ -1453,7 +1539,7 @@
ModuleInfo, Context, VarTypes0, VarTypes, VarSet0, VarSet,
Goal) :-
- generate_new_table_var("AnswerTable", VarTypes0, VarTypes1,
+ generate_new_table_var("AnswerTable", node_type, VarTypes0, VarTypes1,
VarSet0, VarSet1, AnsTableVar),
( Detism = multidet ->
ReturnAllAns = "table_multi_return_all_ans"
@@ -1532,7 +1618,7 @@
generate_suspend_goal(NumberedOutputVars, TableVar, ModuleInfo, Context,
VarTypes0, VarTypes, VarSet0, VarSet, Goal) :-
- generate_new_table_var("AnswerTable", VarTypes0, VarTypes1,
+ generate_new_table_var("AnswerTable", node_type, VarTypes0, VarTypes1,
VarSet0, VarSet1, AnsTableVar),
generate_call("table_nondet_suspend", [TableVar, AnsTableVar],
nondet, yes(semipure), [AnsTableVar - ground(unique, none)],
@@ -1588,13 +1674,13 @@
%-----------------------------------------------------------------------------%
-:- pred generate_new_table_var(string::in,
+:- pred generate_new_table_var(string::in, (type)::in,
map(prog_var, type)::in, map(prog_var, type)::out,
prog_varset::in, prog_varset::out, prog_var::out) is det.
-generate_new_table_var(Name, VarTypes0, VarTypes, VarSet0, VarSet, Var) :-
+generate_new_table_var(Name, Type, VarTypes0, VarTypes, VarSet0, VarSet, Var)
+ :-
varset__new_named_var(VarSet0, Name, Var, VarSet),
- get_table_var_type(Type),
map__set(VarTypes0, Var, Type, VarTypes).
:- pred generate_call(string::in, list(prog_var)::in, determinism::in,
@@ -1639,11 +1725,9 @@
make_string_const_construction(VarValue, yes(VarName), Goal, Var,
VarTypes0, VarTypes, VarSet0, VarSet).
-:- pred get_table_var_type((type)::out) is det.
+:- func node_type = (type).
-get_table_var_type(Type) :-
- mercury_public_builtin_module(BuiltinModule),
- construct_type(qualified(BuiltinModule, "c_pointer") - 0, [], Type).
+node_type = c_pointer_type.
:- pred get_input_output_vars(list(prog_var)::in, list(mode)::in,
module_info::in, list(prog_var)::out, list(prog_var)::out) is det.
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
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/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/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/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
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 java
cvs diff: Diffing java/library
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/table_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/table_builtin.m,v
retrieving revision 1.20
diff -u -b -r1.20 table_builtin.m
--- library/table_builtin.m 2002/07/22 07:13:09 1.20
+++ library/table_builtin.m 2002/07/23 01:42:19
@@ -439,6 +439,18 @@
:- pred table_io_copy_io_state(io__state::di, io__state::uo) is det.
+ % Calls to these predicates bracket the code of foreign_procs with
+ % the tabled_for_io_unitize annotation. The left bracket procedure
+ % returns the current value of MR_trace_enabled, and then turns off
+ % both MR_trace_enabled and MR_io_tabling_enabled. (We don't need to
+ % save MR_io_tabling_enabled because we only get to this code if it
+ % contains true.) The right bracket code takes the value returned by
+ % the left bracket as input and restores both globals to the values
+ % they had before the call to the left bracket.
+
+:- impure pred table_io_left_bracket_unitized_goal(int::out) is det.
+:- impure pred table_io_right_bracket_unitized_goal(int::in) is det.
+
% N.B. interface continued below
%-----------------------------------------------------------------------------%
@@ -564,6 +576,23 @@
[will_not_call_mercury, promise_pure],
"
S = S0;
+").
+
+:- pragma foreign_proc("C",
+ table_io_left_bracket_unitized_goal(TraceEnabled::out),
+ [will_not_call_mercury],
+"
+ TraceEnabled = MR_trace_enabled;
+ MR_trace_enabled = MR_FALSE;
+ MR_io_tabling_enabled = MR_FALSE;
+").
+
+:- pragma foreign_proc("C",
+ table_io_right_bracket_unitized_goal(TraceEnabled::in),
+ [will_not_call_mercury],
+"
+ MR_io_tabling_enabled = MR_TRUE;
+ MR_trace_enabled = TraceEnabled;
").
table_io_in_range(_, _, _) :-
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/mercury_stack_layout.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_stack_layout.h,v
retrieving revision 1.60
diff -u -b -r1.60 mercury_stack_layout.h
--- runtime/mercury_stack_layout.h 2002/05/16 13:14:53 1.60
+++ runtime/mercury_stack_layout.h 2002/07/21 09:06:07
@@ -600,7 +600,9 @@
MR_EVAL_METHOD_MEMO,
MR_EVAL_METHOD_MINIMAL,
MR_EVAL_METHOD_TABLE_IO,
- MR_EVAL_METHOD_TABLE_IO_DECL
+ MR_EVAL_METHOD_TABLE_IO_DECL,
+ MR_EVAL_METHOD_TABLE_IO_UNITIZE,
+ MR_EVAL_METHOD_TABLE_IO_UNITIZE_DECL
} MR_EvalMethod;
typedef MR_int_least8_t MR_EvalMethodInt;
Index: runtime/mercury_trace_base.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_trace_base.c,v
retrieving revision 1.44
diff -u -b -r1.44 mercury_trace_base.c
--- runtime/mercury_trace_base.c 2002/07/22 07:13:10 1.44
+++ runtime/mercury_trace_base.c 2002/07/22 07:48:47
@@ -48,11 +48,17 @@
/*
** Compiler generated tracing code will check whether MR_trace_enabled is true,
** before calling MR_trace.
+**
** MR_trace_enabled should keep the same value throughout the execution of
-** the entire program after being set in mercury_wrapper.c. There is one
-** exception to this: the Mercury routines called as part of the functionality
-** of the tracer itself (e.g. the term browser) should always be executed
-** with MR_trace_enabled set to MR_FALSE.
+** the entire program after being set in mercury_wrapper.c. There are two
+** exceptions to this. First, the Mercury routines called as part of the
+** functionality of the tracer itself (e.g. the term browser) should always be
+** executed with MR_trace_enabled set to MR_FALSE. Second, when a procedure
+** implemented in foreign code has the tabled_for_io_unitize annotation,
+** which means that it can both do I/O and call Mercury code, then we turn the
+** procedure and its descendants into a single unit by turning off tracing
+** within the descendants. This is required to prevent the I/O tabling problems
+** that could otherwise arise if we got retries from within the descendants.
*/
MR_bool MR_trace_enabled = MR_FALSE;
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/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/Mmakefile,v
retrieving revision 1.79
diff -u -b -r1.79 Mmakefile
--- tests/debugger/Mmakefile 2002/06/30 17:07:11 1.79
+++ tests/debugger/Mmakefile 2002/07/22 01:23:40
@@ -22,6 +22,7 @@
queens \
retry \
tabled_read \
+ tabled_read_unitize \
tabled_read_decl
NONRETRY_PROGS = \
@@ -57,6 +58,7 @@
MCFLAGS-queens_rep = --trace rep
MCFLAGS-shallow = --trace shallow
MCFLAGS-tabled_read = --trace-table-io
+MCFLAGS-tabled_read_unitize = --trace-table-io
MCFLAGS-tabled_read_decl = --trace-table-io-decl
# By default, we reclaim heap on failure in non-Boehm-gc grades.
# The extra stack slots required for this reclamation cause spurious
@@ -292,6 +294,12 @@
tabled_read.out: tabled_read tabled_read.inp tabled_read.data
$(MDB) ./tabled_read < tabled_read.inp > tabled_read.out 2>&1
+
+tabled_read_unitize.out: tabled_read_unitize.data
+
+tabled_read_unitize.out: tabled_read_unitize tabled_read_unitize.inp
+ $(MDB) ./tabled_read_unitize < tabled_read_unitize.inp \
+ > tabled_read_unitize.out 2>&1
tabled_read_decl.out: tabled_read_decl tabled_read_decl.inp tabled_read_decl.data
$(MDB) ./tabled_read_decl < tabled_read_decl.inp \
Index: tests/debugger/tabled_read_unitize.data
===================================================================
RCS file: tabled_read_unitize.data
diff -N tabled_read_unitize.data
--- /dev/null Fri Dec 1 02:25:58 2000
+++ tabled_read_unitize.data Tue Jul 23 12:05:50 2002
@@ -0,0 +1,4 @@
+123
+45
+6
+789
Index: tests/debugger/tabled_read_unitize.exp
===================================================================
RCS file: tabled_read_unitize.exp
diff -N tabled_read_unitize.exp
--- /dev/null Fri Dec 1 02:25:58 2000
+++ tabled_read_unitize.exp Tue Jul 23 12:06:26 2002
@@ -0,0 +1,20 @@
+ 1: 1 1 CALL pred tabled_read_unitize:main/2-0 (det) tabled_read_unitize.m:17
+mdb> echo on
+Command echo enabled.
+mdb> register --quiet
+mdb> context none
+Contexts will not be printed.
+mdb> table_io start
+io tabling started
+mdb> break unitize
+ 0: + stop interface pred tabled_read_unitize:unitize/4-0 (det)
+mdb> continue
+ 37: 12 2 CALL pred tabled_read_unitize:unitize/4-0 (det)
+mdb> finish -a
+ 38: 12 2 THEN pred tabled_read_unitize:unitize/4-0 (det) t;
+ 39: 12 2 ELSE pred tabled_read_unitize:unitize/4-0 (det) t;c2;e;
+ 40: 12 2 EXIT pred tabled_read_unitize:unitize/4-0 (det)
+mdb> continue -S
+123
+4506
+789
Index: tests/debugger/tabled_read_unitize.inp
===================================================================
RCS file: tabled_read_unitize.inp
diff -N tabled_read_unitize.inp
--- /dev/null Fri Dec 1 02:25:58 2000
+++ tabled_read_unitize.inp Tue Jul 23 01:09:20 2002
@@ -0,0 +1,8 @@
+echo on
+register --quiet
+context none
+table_io start
+break unitize
+continue
+finish -a
+continue -S
Index: tests/debugger/tabled_read_unitize.m
===================================================================
RCS file: tabled_read_unitize.m
diff -N tabled_read_unitize.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ tabled_read_unitize.m Mon Jul 22 02:07:45 2002
@@ -0,0 +1,120 @@
+% We define our own I/O primitives, in case the library was compiled without
+% IO tabling.
+
+:- module tabled_read_unitize.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state, io__state).
+:- mode main(di, uo) is det.
+
+:- implementation.
+
+:- import_module list, char, int.
+
+main -->
+ tabled_read_unitize__open_input("tabled_read_unitize.data", Res,
+ Stream),
+ ( { Res = 0 } ->
+ tabled_read_unitize__read_num(Stream, A),
+ tabled_read_unitize__unitize(Stream, B),
+ tabled_read_unitize__read_num(Stream, C),
+ tabled_read_unitize__write_int(A),
+ tabled_read_unitize__write_int(B),
+ tabled_read_unitize__write_int(C)
+ ;
+ io__write_string("could not open tabled_rea_unitized.data\n")
+ ).
+
+:- pragma export(tabled_read_unitize__read_num(in, out, di, uo),
+ "MT_read_num").
+
+:- pred tabled_read_unitize__read_num(c_pointer::in, int::out,
+ io__state::di, io__state::uo) is det.
+
+tabled_read_unitize__read_num(Stream, Num) -->
+ tabled_read_unitize__read_num_2(Stream, 0, Num).
+
+:- pred tabled_read_unitize__read_num_2(c_pointer::in, int::in, int::out,
+ io__state::di, io__state::uo) is det.
+
+tabled_read_unitize__read_num_2(Stream, SoFar, N) -->
+ tabled_read_unitize__read_char_code(Stream, CharCode),
+ (
+ { char__to_int(Char, CharCode) },
+ { char__is_digit(Char) },
+ { char__digit_to_int(Char, CharInt) }
+ ->
+ tabled_read_unitize__read_num_2(Stream, SoFar * 10 + CharInt,
+ N)
+ ;
+ { N = SoFar }
+ ).
+
+:- pred tabled_read_unitize__unitize(c_pointer::in, int::out,
+ io__state::di, io__state::uo) is det.
+
+:- pragma foreign_proc("C",
+ tabled_read_unitize__unitize(Stream::in, N::out, _IO0::di, _IO::uo),
+ [may_call_mercury, promise_pure, tabled_for_io_unitize],
+"
+ MR_Integer int1;
+ MR_Integer int2;
+
+ MT_read_num(Stream, &int1);
+ MT_read_num(Stream, &int2);
+ N = int1 * 100 + int2;
+").
+
+:- pragma c_header_code("#include <stdio.h>").
+
+:- pred tabled_read_unitize__open_input(string::in, int::out, c_pointer::out,
+ io__state::di, io__state::uo) is det.
+
+:- pragma foreign_proc("C",
+ tabled_read_unitize__open_input(FileName::in, Res::out, Stream::out,
+ IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
+"
+ Stream = (MR_Word) fopen((const char *) FileName, ""r"");
+ Res = Stream? 0 : -1;
+ IO = IO0;
+").
+
+:- pred tabled_read_unitize__read_char_code(c_pointer::in, int::out,
+ io__state::di, io__state::uo) is det.
+
+:- pragma foreign_proc("C",
+ tabled_read_unitize__read_char_code(Stream::in, CharCode::out,
+ IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
+"
+ CharCode = getc((FILE *) Stream);
+ IO = IO0;
+").
+
+:- pred tabled_read_unitize__poly_read_char_code(c_pointer::in, T::in, int::out,
+ io__state::di, io__state::uo) is det.
+
+:- pragma foreign_proc("C",
+ tabled_read_unitize__poly_read_char_code(Stream::in, Unused::in,
+ CharCode::out, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
+"
+ /* ignore Unused */
+ CharCode = getc((FILE *) Stream);
+ IO = IO0;
+").
+
+:- pred tabled_read_unitize__write_int(int::in, io__state::di, io__state::uo)
+ is det.
+
+:- pragma foreign_proc("C",
+ tabled_read_unitize__write_int(N::in, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"{
+ printf(""%d\\n"", (int) N);
+ IO = IO0;
+}").
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/structure_reuse
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/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
Index: trace/mercury_trace.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace.c,v
retrieving revision 1.51
diff -u -b -r1.51 mercury_trace.c
--- trace/mercury_trace.c 2002/05/15 11:24:18 1.51
+++ trace/mercury_trace.c 2002/07/21 16:30:38
@@ -1354,6 +1354,8 @@
case MR_EVAL_METHOD_TABLE_IO:
case MR_EVAL_METHOD_TABLE_IO_DECL:
+ case MR_EVAL_METHOD_TABLE_IO_UNITIZE:
+ case MR_EVAL_METHOD_TABLE_IO_UNITIZE_DECL:
return;
}
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