[m-rev.] for review: resets and statistics for tabling
Zoltan Somogyi
zs at cs.mu.OZ.AU
Thu Jun 8 13:04:38 AEST 2006
Provide a mechanism for collecting statistics about tabling operations,
and provide a much more convenient mechanism for resetting tables.
Since it would too complex to do this while preserving the capability
of setting --tabling-via-extra-args to no, eliminate that capability
and the option. That option was useful only for measurements of the
performance boost from setting --tabling-via-extra-args to yes in any case,
so users lose functionality.
Previously, the only way to debug the low level details of the tabling
mechanism was to build a runtime with a specific C macro (MR_TABLE_DEBUG)
and link with that runtime; this was cumbersome. Change that so that
every one of the debuggable tabling macro has a bool argument that says
whether debugging is enabled or not. The compiler can then set this to
MR_TRUE if the new option --table-debug is given, and to MR_FALSE otherwise.
If set to MR_FALSE, the C compiler should optimize away the debug code,
with zero impact on program size or speed.
Since these changes to macros require nontrivial bootstrapping, which we don't
want to do unnecessarily, modify the interface of the tabling macros as
required to support size limits on tables. This diff also implements the
parsing of size limit specifications on tables, but does not implement them
yet; that is for a future change.
To make the syntax simpler, this diff deletes the free-standing fast_loose_memo
pragma. The same functionality is now available with a fast_loose annotation
on an ardinary memo pragma.
Make a bunch of changes to improve readability and maintainability
in the process. These mostly take the form of renaming ambiguous and/or
not sufficiently expressive function symbols.
runtime/mercury_stack_layout.h:
runtime/mercury_tabling.h:
Move the description of structure of tables from mercury_stack_layout.h
to mercury_tabling.h, since we now need it for statistics even if
execution tracing is not enabled.
Modify those data structures to have room for the statistics.
Don't distinguish "strict", "fast_loose" and "specified" memoing
as separate eval methods; treat them as just different kinds
of the same eval method: "memo".
Remove underscores from the names of some types that the style guide
says shouldn't be there.
runtime/mercury_tabling_preds.h:
runtime/mercury_tabling_macros.h:
Modify the approach we use to macros that implement the predicates
of library/table_builtin.m. Instead of selecting between debug and
nondebug based on whether MR_TABLE_DEBUG is defined or not, add
an explicit argument controlling this to each debuggable macro.
The advantage of the new arrangement is that it scales. Another
argument controls whether we are computing statistics (and if yes,
where do we put it), and a third argument controls whether we maintain
back links in the tries and hash tables (this last argument is present
but is ignored for now).
Since the values of the arguments will be known when the .c files
containing calls to these macros are compiled, we pay the space and
time cost of debugging, statistics gathering and the maintenance of
back links if and only we need the revelant functionality.
Provide macros for limited backward compatibility with the old set
of macros; these allow workspaces created by old compilers to work
with the new macros in the runtime. The old macros followed the
naming scheme MR_table_*, the new ones are named MR_tbl_*.
runtime/mercury_table_int_fix_index_body.h:
runtime/mercury_table_int_start_index_body.h:
runtime/mercury_table_type_body.h:
New files containing parts of the old mercury_tabling.c. Each of these
files contains the body of the functions that used to be in
mercury_tabling.c. The new mercury_tabling.c #includes each of these
files more than once, to provide more than one variant of the old
function. These variants differ in aspects such as whether debugging
is enabled or statistics is being collected. Each variant therefore
incurs only the time costs it needs to. (We pay the space cost of
having all these variants all the time of course, but this cost
is negligible.)
runtime/mercury_tabling_stats_defs.h:
runtime/mercury_tabling_stats_nodefs.h:
runtime/mercury_tabling_stats_undefs.h:
New files that serve as wrappers around the newly #included files,
controlling how they handle statistics.
runtime/mercury_tabling.c:
Delete functions now in the new files, and #include them instead.
Delete the data structures that used to contain summary statistics;
the new approach keeps statistics in compiler-generated,
procedure-specific data structures.
runtime/mercury_trace_base.c:
Use the new versions of the tabling macros to access the I/O table.
runtime/mercury_type_info.h:
Update some documentation for the movement of code out of
mercury_tabling.c.
runtime/mercury_types.h:
Provide forward declarations of the identifiers denoting the new types
in mercury_tabling.h.
runtime/mercury_grade.h:
Increment the exec trace version number, since we have changed
a part of the exec trace structure.
runtime/mercury_bootstrap.h:
runtime/mercury_hash_lookup_or_add_body.h:
Fix comment.
runtime/Mmakefile:
Mention the new files and the dependencies that involve them.
library/table_builtin.m:
Provide a type for representing statistics and a predicate for
printing statistics.
Use the updated versions of the macros in
runtime/mercury_tabling_preds.h.
compiler/prog_item.m:
Change representation of tabling pragmas to allow room for the new
attributes.
Allow an item to be marked as being generated by the compiler
as a result of a pragma memo attribute. We use this for the reset
and statistics predicates.
compiler/mercury_to_mercury.m:
Write out the new attributes of the tabling pragma.
compiler/prog_data.m:
compiler/hlds_data.m:
Change the cons_id that used to refer to a procedure's call table root
to refer to the entirety of the new data structure now containing it.
The compiler now needs a way to refer to the other components of this
new data structure, since it contains the statistics.
As in the runtime, don't distinguish "strict", "fast_loose" and
"specified" memoing as separate eval methods; treat them as just
different kinds of the same eval method: "memo".
Rename some of the uses of the function symbols "c", "java", "il".
compiler/hlds_pred.m:
Add an extra field in proc_infos for storing any tabling attributes.
Change the existing proc_info field that records information about
the kinds of arguments of tabled procedures to record the information
needed by the debugger too. This was needed to allow us to shift all
the RTTI for procedure-specific tables (as opposed to the RTTI for
the global I/O table) from mercury_stack_layout.h to mercury_tabling.h
without duplicating the data (which would be a maintenance problem).
Reformat some comments to make them easier to read.
compiler/layout.m:
compiler/layout_out.m:
Delete the part of the exec trace information that used to record
RTTI for tables, since this information is not generated only as
part of the debugger data structures anymore.
compiler/prog_io_pragma.m:
Recognize the updated syntax for tabling pragmas.
compiler/add_pragma.m:
When processing tabling pragmas for inclusion in the HLDS, create
any reset and statistics predicates they ask for.
compiler/make_hlds_passes.m:
Export a predicate now needed by add_pragma.m.
Handle the new attributes on tabling pragmas
compiler/globals.m:
Change the function symbols of the types describing backends and
foreign languages to say what they are. Previously, both types (as well
as several others) included the function symbol "c"; now, they are
target_c and lang_c respectively.
compiler/table_gen.m:
Implement the changes described at the top.
When passing around varsets and vartypes, pass the arguments in the
standard order.
compiler/goal_util.m:
compiler/hlds_goal.m:
When passing around varsets and vartypes, pass the arguments in the
standard order.
compiler/rtti.m:
Provide types for representing the runtime's data structures for
tabling (which are now significantly more complex than a single word)
and predicates for manipulating them, for use by both the ml and ll
backends.
compiler/llds.m:
Replace the comp_gen_c_var type with the tabling_info_struct type,
which contains the information needed to create the per-procedure
tabling data structures.
Replace references to call tables with references to the various
components of the new tabling data structures.
compiler/llds_out.m:
Add code to write out tabling_info_structs.
Delete the code required for old, hacky way of resetting tables.
Reorder some code more logically.
compiler/proc_gen.m:
Generate tabling_info_structs.
compiler/stack_layout.m:
Don't generate the information now generated in proc_gen.m.
compiler/mlds.m:
Give mlds_proc_labels their own function symbols, instead of using
a pair. Rename some other function symbols to avoid ambiguity and add
expressiveness.
Provide for the representation of references to the various components
of the new tabling data structures, and for the representation of their
types.
compiler/ml_code_gen.m:
When generating code for a tabled procedure, generate also the data
structures required for its table.
compiler/rtti_to_mlds.m:
compiler/ml_util.m:
Move some predicates from rtti_to_mlds.m to ml_util.m, since we
now also want to call them from ml_code_gen.m.
compiler/name_mangle.m:
Add some utility predicates.
compiler/options.m:
Delete the old --allow-table-reset option.
Add the new --table-debug option.
Comment out an implementor-only option.
compiler/add_pred.m:
compiler/add_solver.m:
compiler/add_trail_ops.m:
compiler/add_type.m:
compiler/bytecode_gen.m:
compiler/code_gen.m:
compiler/compile_target_code.m:
compiler/complexity.m:
compiler/dependency_graph.m:
compiler/det_report.m:
compiler/export.m:
compiler/fact_table.m:
compiler/foreign.m:
compiler/global_data.m:
compiler/globals.m:
compiler/handle_options.m:
compiler/higher_order.m:
compiler/hlds_code_util.m:
compiler/hlds_data.m:
compiler/hlds_goal.m:
compiler/hlds_out.m:
compiler/inlining.m:
compiler/intermod.m:
compiler/make.dependencies.m:
compiler/make.module_target.m:
compiler/make.program_target.m:
compiler/make.util.m:
compiler/make_hlds_passes.m:
compiler/mercury_compile.m:
compiler/ml_call_gen.m:
compiler/ml_closure_gen.m:
compiler/ml_code_gen.m:
compiler/ml_code_util.m:
compiler/ml_elim_nested.m:
compiler/ml_optimize.m:
compiler/ml_switch_gen.m:
compiler/ml_tailcall.m:
compiler/ml_type_gen.m:
compiler/ml_unify_gen.m:
compiler/mlds_to_c.m:
compiler/mlds_to_gcc.m:
compiler/mlds_to_il.m:
compiler/mlds_to_ilasm.m:
compiler/mlds_to_java.m:
compiler/mlds_to_managed.m:
compiler/modes.m:
compiler/module_qual.m:
compiler/modules.m:
compiler/opt_debug.m:
compiler/opt_util.m:
compiler/polymorphism.m:
compiler/pragma_c_gen.m:
compiler/proc_label.m:
compiler/prog_data.m:
compiler/prog_foreign.m:
compiler/prog_item.m:
compiler/prog_mutable.m:
compiler/prog_out.m:
compiler/prog_rep.m:
compiler/prog_util.m:
compiler/recompilation.version.m:
compiler/size_prof.m:
compiler/special_pred.m:
compiler/switch_util.m:
compiler/transform_llds.m:
compiler/tupling.m:
compiler/type_ctor_info.m:
compiler/unify_gen.m:
Conform to the changes above, and/or improve some comments.
mdbcomp/prim_data.m:
Make the names of the function symbols of the proc_label type more
expressive and less ambiguous.
mdbcomp/prim_data.m:
mdbcomp/mdbcomp.m:
mdbcomp/program_representation.m:
mdbcomp/rtti_access.m:
mdbcomp/slice_and_dice.m:
mdbcomp/trace_counts.m:
Use . instead of __ as module qualifier.
Conform to the change to prim_data.m.
browser/declarative_execution.m:
browser/declarative_oracle.m:
browser/declarative_tree.m:
Conform the change to mdbcomp/prim_data.m.
tests/debugger/Mercury.options:
Don't specify --allow-table-reset for fib.m, since that option
doesn't exist anymore.
tests/debugger/fib.m:
Use the new mechanism for resetting the table.
tests/debugger/print_table.m:
Use the new syntax for pragma memo attributes.
tests/invalid/specified.{m,err_exp}:
Use to the new syntax and reset method for pragma memo attributes.
Test the handling of errors in the new attribute syntax.
tests/tabling/Mercury.options:
Don't specify --allow-table-reset for specified.m, since that option
doesn't exist anymore.
tests/tabling/specified.m:
Use the new syntax for pragma memo attributes, and use the new
mechanism for resetting tables. We could also use this test case
for testing the printing of statistics, but the format of that
output is still not final.
tests/tabling/fast_loose.m:
Use the new syntax for pragma memo attributes, and use the new
mechanism for resetting tables.
trace/mercury_trace.c:
trace/mercury_trace_cmd_developer.c:
Conform to the changes in the RTTI data structures regarding tabling.
Remove underscores from the names of some types that the style guide
says shouldn't be there.
library/robdd.m:
Comment out the tabling pragma until this change is bootstrapped.
Without this, the conflict between the old calls to macros generated
by the existing compiler and the new definition of those macros
in the runtime would cause errors from the C compiler.
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
Index: browser/declarative_execution.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/declarative_execution.m,v
retrieving revision 1.50
diff -u -b -r1.50 declarative_execution.m
--- browser/declarative_execution.m 6 Jun 2006 02:27:13 -0000 1.50
+++ browser/declarative_execution.m 8 Jun 2006 01:56:34 -0000
@@ -482,9 +482,9 @@
get_pred_attributes(ProcId, Module, Name, Arity, PredOrFunc) :-
(
- ProcId = proc(Module, PredOrFunc, _, Name, Arity, _)
+ ProcId = ordinary_proc_label(Module, PredOrFunc, _, Name, Arity, _)
;
- ProcId = special_proc(Module, SpecialId, _, _, _, _),
+ ProcId = special_proc_label(Module, SpecialId, _, _, _, _),
PredOrFunc = predicate,
Arity = get_special_pred_id_arity(SpecialId),
Name = get_special_pred_id_target_name(SpecialId)
Index: browser/declarative_oracle.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/declarative_oracle.m,v
retrieving revision 1.51
diff -u -b -r1.51 declarative_oracle.m
--- browser/declarative_oracle.m 6 Jun 2006 02:27:14 -0000 1.51
+++ browser/declarative_oracle.m 8 Jun 2006 01:56:34 -0000
@@ -343,9 +343,10 @@
counter.allocate(Id, !.Oracle ^ trusted_id_counter, Counter),
ProcLabel = get_proc_label_from_layout(ProcLayout),
(
- ProcLabel = proc(ModuleName, PredOrFunc, _, Name, Arity, _)
+ ProcLabel = ordinary_proc_label(ModuleName, PredOrFunc, _,
+ Name, Arity, _)
;
- ProcLabel = special_proc(ModuleName, _, _, Name, Arity, _),
+ ProcLabel = special_proc_label(ModuleName, _, _, Name, Arity, _),
PredOrFunc = predicate
),
(
@@ -520,7 +521,7 @@
Trusted = Oracle ^ trusted,
ProcLabel = get_proc_label_from_layout(ProcLayout),
(
- ProcLabel = proc(Module, PredOrFunc, _, Name, Arity, _),
+ ProcLabel = ordinary_proc_label(Module, PredOrFunc, _, Name, Arity, _),
(
bimap.search(Trusted, standard_library, _),
(
@@ -539,7 +540,7 @@
bimap.search(Trusted, function(Module, Name, Arity), _)
)
;
- ProcLabel = special_proc(_, _, _, _, _, _)
+ ProcLabel = special_proc_label(_, _, _, _, _, _)
).
:- pred query_oracle_kb(oracle_kb::in, decl_question(T)::in,
Index: browser/declarative_tree.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/browser/declarative_tree.m,v
retrieving revision 1.42
diff -u -b -r1.42 declarative_tree.m
--- browser/declarative_tree.m 6 Jun 2006 02:27:14 -0000 1.42
+++ browser/declarative_tree.m 8 Jun 2006 01:56:34 -0000
@@ -454,7 +454,7 @@
missing_answer_special_case(Atom) :-
ProcLabel = get_proc_label_from_layout(Atom ^ proc_layout),
- ProcLabel = proc(StdUtilModule1, predicate, StdUtilModule2,
+ ProcLabel = ordinary_proc_label(StdUtilModule1, predicate, StdUtilModule2,
"builtin_aggregate", 4, _),
possible_sym_library_module_name("solutions", StdUtilModule1),
possible_sym_library_module_name("solutions", StdUtilModule2).
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.33
diff -u -b -r1.33 add_pragma.m
--- compiler/add_pragma.m 5 Jun 2006 02:26:06 -0000 1.33
+++ compiler/add_pragma.m 6 Jun 2006 09:08:06 -0000
@@ -79,9 +79,10 @@
qual_info::in, qual_info::out, io::di, io::uo) is det.
:- pred module_add_pragma_tabled(eval_method::in, sym_name::in, int::in,
- maybe(pred_or_func)::in, maybe(list(mer_mode))::in, import_status::in,
+ maybe(pred_or_func)::in, maybe(list(mer_mode))::in,
+ maybe(table_attributes)::in, import_status::in, import_status::out,
prog_context::in, module_info::in, module_info::out,
- io::di, io::uo) is det.
+ qual_info::in, qual_info::out, io::di, io::uo) is det.
% module_add_pragma_fact_table(PredName, Arity, FileName,
% Status, Context, Module0, Module, !Info):
@@ -112,7 +113,9 @@
:- import_module analysis.
:- import_module backend_libs.
:- import_module backend_libs.foreign.
+:- import_module backend_libs.rtti.
:- import_module check_hlds.mode_util.
+:- import_module hlds.code_model.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_out.
@@ -130,11 +133,16 @@
:- import_module libs.options.
:- import_module ll_backend.
:- import_module ll_backend.fact_table.
+:- import_module ll_backend.llds_out.
+:- import_module ml_backend.
+:- import_module ml_backend.mlds.
+:- import_module ml_backend.mlds_to_c.
:- import_module parse_tree.error_util.
:- import_module parse_tree.modules.
:- import_module parse_tree.prog_ctgc.
:- import_module parse_tree.prog_foreign.
:- import_module parse_tree.prog_io.
+:- import_module parse_tree.prog_mode.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.prog_type_subst.
@@ -154,14 +162,13 @@
:- import_module set.
:- import_module string.
:- import_module svmap.
+:- import_module svvarset.
:- import_module varset.
%-----------------------------------------------------------------------------%
add_pragma(Origin, Pragma, Context, !Status, !ModuleInfo, !IO) :-
- %
- % check for invalid pragmas in the `interface' section
- %
+ % Check for invalid pragmas in the `interface' section.
!.Status = item_status(ImportStatus, _),
pragma_allowed_in_interface(Pragma, Allowed),
(
@@ -197,7 +204,7 @@
Pragma = foreign_proc(_, _, _, _, _, _, _)
;
% Handle pragma tabled decls later on (when we process clauses).
- Pragma = tabled(_, _, _, _, _)
+ Pragma = tabled(_, _, _, _, _, _)
;
Pragma = inline(Name, Arity),
add_pred_marker("inline", Name, Arity, ImportStatus, Context,
@@ -390,7 +397,10 @@
;
Details = finalise_decl
;
- ( Details = solver_type ; Details = foreign_imports ),
+ ( Details = solver_type
+ ; Details = foreign_imports
+ ; Details = pragma_memo_attribute
+ ),
unexpected(this_file, "Bad introduced export pragma.")
)
)
@@ -410,7 +420,10 @@
;
Details = finalise_decl
;
- ( Details = solver_type ; Details = foreign_imports ),
+ ( Details = solver_type
+ ; Details = foreign_imports
+ ; Details = pragma_memo_attribute
+ ),
unexpected(this_file, "Bad introduced export pragma.")
)
)
@@ -1561,9 +1574,10 @@
%-----------------------------------------------------------------------------%
module_add_pragma_tabled(EvalMethod, PredName, Arity, MaybePredOrFunc,
- MaybeModes, Status, Context, !ModuleInfo, !IO) :-
+ MaybeModes, MaybeAttributes, !Status, Context, !ModuleInfo,
+ !QualInfo, !IO) :-
module_info_get_predicate_table(!.ModuleInfo, PredicateTable0),
- EvalMethodStr = eval_method_to_one_string(EvalMethod),
+ EvalMethodStr = eval_method_to_string(EvalMethod),
(
MaybePredOrFunc = yes(PredOrFunc0),
PredOrFunc = PredOrFunc0,
@@ -1573,16 +1587,15 @@
% a dummy declaration for the predicate.)
(
predicate_table_search_pf_sym_arity(PredicateTable0,
- is_fully_qualified, PredOrFunc,
- PredName, Arity, PredIds0)
+ is_fully_qualified, PredOrFunc, PredName, Arity, PredIds0)
->
PredIds = PredIds0
;
module_info_get_name(!.ModuleInfo, ModuleName),
- string.format("`:- pragma %s' declaration",
- [s(EvalMethodStr)], Message1),
+ string.format("`:- pragma %s' declaration", [s(EvalMethodStr)],
+ Message1),
preds_add_implicit_report_error(ModuleName, PredOrFunc, PredName,
- Arity, Status, no, Context, user(PredName), Message1, PredId,
+ Arity, !.Status, no, Context, user(PredName), Message1, PredId,
!ModuleInfo, !IO),
PredIds = [PredId]
)
@@ -1595,25 +1608,63 @@
PredIds = PredIds0
;
module_info_get_name(!.ModuleInfo, ModuleName),
- string.format("`:- pragma %s' declaration",
- [s(EvalMethodStr)], Message1),
+ string.format("`:- pragma %s' declaration", [s(EvalMethodStr)],
+ Message1),
preds_add_implicit_report_error(ModuleName, predicate, PredName,
- Arity, Status, no, Context, user(PredName), Message1, PredId,
+ Arity, !.Status, no, Context, user(PredName), Message1, PredId,
!ModuleInfo, !IO),
PredIds = [PredId]
)
),
- list.foldl2(
+ (
+ MaybeAttributes = yes(Attributes),
+ Statistics = Attributes ^ table_attr_statistics,
+ AllowReset = Attributes ^ table_attr_allow_reset,
+ ( PredIds = [_, _ | _] ->
+ (
+ Statistics = yes,
+ StatsPieces = [words("Error: cannot request statistics"),
+ words("for the ambiguous name"),
+ sym_name_and_arity(PredName / Arity), suffix(","),
+ words("since the compiler-generated statistics predicate"),
+ words("would have an ambiguous name too.")],
+ write_error_pieces(Context, 0, StatsPieces, !IO),
+ io.set_exit_status(1, !IO)
+ ;
+ Statistics = no
+ ),
+ (
+ AllowReset = yes,
+ ResetPieces = [words("Error: cannot request allow_reset"),
+ words("for the ambiguous name"),
+ sym_name_and_arity(PredName / Arity), suffix(","),
+ words("since the compiler-generated reset predicate"),
+ words("would have an ambiguous name too.")],
+ write_error_pieces(Context, 0, ResetPieces, !IO),
+ io.set_exit_status(1, !IO)
+ ;
+ AllowReset = no
+ )
+ ;
+ true
+ )
+ ;
+ MaybeAttributes = no
+ ),
+ list.foldl4(
module_add_pragma_tabled_2(EvalMethod, PredName, Arity,
- MaybePredOrFunc, MaybeModes, Context),
- PredIds, !ModuleInfo, !IO).
+ MaybePredOrFunc, MaybeModes, MaybeAttributes, Context),
+ PredIds, !Status, !ModuleInfo, !QualInfo, !IO).
:- pred module_add_pragma_tabled_2(eval_method::in, sym_name::in, int::in,
- maybe(pred_or_func)::in, maybe(list(mer_mode))::in, prog_context::in,
- pred_id::in, module_info::in, module_info::out, io::di, io::uo) is det.
+ maybe(pred_or_func)::in, maybe(list(mer_mode))::in,
+ maybe(table_attributes)::in, prog_context::in, pred_id::in,
+ import_status::in, import_status::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, io::di, io::uo) is det.
module_add_pragma_tabled_2(EvalMethod0, PredName, Arity0, MaybePredOrFunc,
- MaybeModes, Context, PredId, !ModuleInfo, !IO) :-
+ MaybeModes, MaybeAttributes, Context, PredId,
+ !Status, !ModuleInfo, !QualInfo, !IO) :-
( EvalMethod0 = eval_minimal(_) ->
globals.io_lookup_bool_option(use_minimal_model_own_stacks,
OwnStacks, !IO),
@@ -1628,7 +1679,6 @@
EvalMethod = EvalMethod0
),
- % Lookup the pred_info for this pred.
module_info_get_predicate_table(!.ModuleInfo, PredicateTable),
predicate_table_get_preds(PredicateTable, Preds),
map.lookup(Preds, PredId, PredInfo0),
@@ -1641,7 +1691,7 @@
),
adjust_func_arity(PredOrFunc, Arity0, Arity),
- EvalMethodStr = eval_method_to_one_string(EvalMethod),
+ EvalMethodStr = eval_method_to_string(EvalMethod),
globals.io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
(
VeryVerbose = yes,
@@ -1705,8 +1755,10 @@
!.ModuleInfo, ProcId)
->
map.lookup(ProcTable0, ProcId, ProcInfo0),
- set_eval_method(ProcId, ProcInfo0, Context, SimpleCallId,
- EvalMethod, ProcTable0, ProcTable, !ModuleInfo, !IO),
+ set_eval_method_create_aux_preds(ProcId, ProcInfo0, Context,
+ SimpleCallId, yes, EvalMethod, MaybeAttributes,
+ ProcTable0, ProcTable,
+ !Status, !ModuleInfo, !QualInfo, !IO),
pred_info_set_procedures(ProcTable, PredInfo0, PredInfo),
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo)
;
@@ -1728,57 +1780,80 @@
words("with no declared modes.")],
write_error_pieces(Context, 0, Pieces3, !IO)
;
- ExistingProcs = [_ | _],
- set_eval_method_list(ExistingProcs, Context, SimpleCallId,
- EvalMethod, ProcTable0, ProcTable, !ModuleInfo, !IO),
+ ExistingProcs = [_ | ExistingProcsTail],
+ (
+ ExistingProcsTail = [],
+ SingleProc = yes
+ ;
+ ExistingProcsTail = [_ | _],
+ SingleProc = no
+ ),
+ set_eval_method_create_aux_preds_list(ExistingProcs, Context,
+ SimpleCallId, SingleProc, EvalMethod, MaybeAttributes,
+ ProcTable0, ProcTable,
+ !Status, !ModuleInfo, !QualInfo, !IO),
pred_info_set_procedures(ProcTable, PredInfo0, PredInfo),
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo)
)
)
).
-:- pred set_eval_method_list(assoc_list(proc_id, proc_info)::in,
- prog_context::in, simple_call_id::in, eval_method::in,
- proc_table::in, proc_table::out, module_info::in, module_info::out,
+:- pred set_eval_method_create_aux_preds_list(
+ assoc_list(proc_id, proc_info)::in, prog_context::in, simple_call_id::in,
+ bool::in, eval_method::in, maybe(table_attributes)::in,
+ proc_table::in, proc_table::out, import_status::in, import_status::out,
+ module_info::in, module_info::out, qual_info::in, qual_info::out,
io::di, io::uo) is det.
-set_eval_method_list([], _, _, _, !ProcTable, !ModuleInfo, !IO).
-set_eval_method_list([ProcId - ProcInfo0 | Rest], Context, SimpleCallId,
- EvalMethod, !ProcTable, !ModuleInfo, !IO) :-
- set_eval_method(ProcId, ProcInfo0, Context, SimpleCallId,
- EvalMethod, !ProcTable, !ModuleInfo, !IO),
- set_eval_method_list(Rest, Context, SimpleCallId,
- EvalMethod, !ProcTable, !ModuleInfo, !IO).
-
-:- pred set_eval_method(proc_id::in, proc_info::in, prog_context::in,
- simple_call_id::in, eval_method::in, proc_table::in, proc_table::out,
- module_info::in, module_info::out, io::di, io::uo) is det.
+set_eval_method_create_aux_preds_list([], _, _, _, _, _, !ProcTable,
+ !Status, !ModuleInfo, !QualInfo, !IO).
+set_eval_method_create_aux_preds_list([ProcId - ProcInfo0 | Rest], Context,
+ SimpleCallId, SingleProc, EvalMethod, MaybeAttributes, !ProcTable,
+ !Status, !ModuleInfo, !QualInfo, !IO) :-
+ set_eval_method_create_aux_preds(ProcId, ProcInfo0, Context, SimpleCallId,
+ SingleProc, EvalMethod, MaybeAttributes, !ProcTable,
+ !Status, !ModuleInfo, !QualInfo, !IO),
+ set_eval_method_create_aux_preds_list(Rest, Context, SimpleCallId,
+ SingleProc, EvalMethod, MaybeAttributes, !ProcTable,
+ !Status, !ModuleInfo, !QualInfo, !IO).
+
+:- pred set_eval_method_create_aux_preds(proc_id::in, proc_info::in,
+ prog_context::in, simple_call_id::in, bool::in, eval_method::in,
+ maybe(table_attributes)::in, proc_table::in, proc_table::out,
+ import_status::in, import_status::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, io::di, io::uo) is det.
-set_eval_method(ProcId, ProcInfo0, Context, SimpleCallId, EvalMethod,
- !ProcTable, !ModuleInfo, !IO) :-
+set_eval_method_create_aux_preds(ProcId, ProcInfo0, Context, SimpleCallId,
+ SingleProc, EvalMethod, MaybeAttributes, !ProcTable,
+ !Status, !ModuleInfo, !QualInfo, !IO) :-
proc_info_get_eval_method(ProcInfo0, OldEvalMethod),
% NOTE: We don't bother detecting multiple tabling pragmas
% of the same type here.
- (
- OldEvalMethod \= eval_normal,
- OldEvalMethod \= EvalMethod
- ->
- % If there are conflicting tabling pragmas then emit an error message
- % and do not bother changing the evaluation method.
- OldEvalMethodStr = eval_method_to_one_string(OldEvalMethod),
- EvalMethodStr = eval_method_to_one_string(EvalMethod),
+ ( OldEvalMethod \= eval_normal ->
+ % We get here only if we have already processed a tabling pragma for
+ % this procedure.
+ EvalMethodStr = eval_method_to_string(EvalMethod),
+ ( OldEvalMethod = EvalMethod ->
+ Pieces = [words("Error:"), simple_call_id(SimpleCallId),
+ words("has duplicate"), fixed(EvalMethodStr),
+ words("pragmas specified.")
+ ]
+ ;
+ OldEvalMethodStr = eval_method_to_string(OldEvalMethod),
Pieces = [words("Error:"), simple_call_id(SimpleCallId),
words("has both"), fixed(OldEvalMethodStr), words("and"),
fixed(EvalMethodStr), words("pragmas specified."),
words("Only one kind of tabling pragma may be applied to it.")
- ],
+ ]
+ ),
module_info_incr_errors(!ModuleInfo),
write_error_pieces(Context, 0, Pieces, !IO)
;
- proc_info_get_maybe_declared_argmodes(ProcInfo0, MaybeDeclaredArgModes),
+ proc_info_get_maybe_declared_argmodes(ProcInfo0,
+ MaybeDeclaredArgModes),
(
MaybeDeclaredArgModes = no,
- EvalMethodStr = eval_method_to_one_string(EvalMethod),
+ EvalMethodStr = eval_method_to_string(EvalMethod),
Pieces = [words("Error:"),
fixed("`pragma" ++ EvalMethodStr ++ "'"),
words("declaration for"), simple_call_id(SimpleCallId),
@@ -1788,7 +1863,18 @@
write_error_pieces(Context, 0, Pieces, !IO)
;
MaybeDeclaredArgModes = yes(DeclaredArgModes),
- ( EvalMethod = eval_memo(specified(MaybeArgMethods)) ->
+ (
+ MaybeAttributes = yes(Attributes),
+ Strictness = Attributes ^ table_attr_strictness,
+ Statistics = Attributes ^ table_attr_statistics,
+ AllowReset = Attributes ^ table_attr_allow_reset
+ ;
+ MaybeAttributes = no,
+ Strictness = all_strict,
+ Statistics = no,
+ AllowReset = no
+ ),
+ ( Strictness = specified(MaybeArgMethods) ->
check_pred_args_against_tabling_methods(DeclaredArgModes,
MaybeArgMethods, !.ModuleInfo, 1, MaybeError)
;
@@ -1796,12 +1882,8 @@
1, MaybeError)
),
(
- MaybeError = no,
- proc_info_set_eval_method(EvalMethod, ProcInfo0, ProcInfo),
- svmap.det_update(ProcId, ProcInfo, !ProcTable)
- ;
MaybeError = yes(ArgMsg - ErrorMsg),
- EvalMethodStr = eval_method_to_one_string(EvalMethod),
+ EvalMethodStr = eval_method_to_string(EvalMethod),
Pieces = [words("Error in"),
fixed("`pragma " ++ EvalMethodStr ++ "'"),
words("declaration for"), simple_call_id(SimpleCallId),
@@ -1809,10 +1891,216 @@
],
module_info_incr_errors(!ModuleInfo),
write_error_pieces(Context, 0, Pieces, !IO)
+ ;
+ MaybeError = no
+ ),
+ proc_info_set_eval_method(EvalMethod, ProcInfo0, ProcInfo1),
+ proc_info_set_table_attributes(MaybeAttributes,
+ ProcInfo1, ProcInfo),
+ svmap.det_update(ProcId, ProcInfo, !ProcTable),
+ % We create the statistics and reset predicates if requested
+ % even in the presence of errors above, because if didn't do so,
+ % later compiler passes would report errors at the sites where
+ % these predicates are called.
+ (
+ Statistics = yes,
+ create_tabling_statistics_pred(ProcId, Context,
+ SimpleCallId, SingleProc, !ProcTable,
+ !Status, !ModuleInfo, !QualInfo, !IO)
+ ;
+ Statistics = no
+ ),
+ (
+ AllowReset = yes,
+ create_tabling_reset_pred(ProcId, Context,
+ SimpleCallId, SingleProc, !ProcTable,
+ !Status, !ModuleInfo, !QualInfo, !IO)
+ ;
+ AllowReset = no
)
)
).
+:- pred create_tabling_statistics_pred(proc_id::in, prog_context::in,
+ simple_call_id::in, bool::in, proc_table::in, proc_table::out,
+ import_status::in, import_status::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, io::di, io::uo) is det.
+
+create_tabling_statistics_pred(ProcId, Context, SimpleCallId, SingleProc,
+ !ProcTable, !Status, !ModuleInfo, !QualInfo, !IO) :-
+ mercury_table_builtin_module(TableBuiltinModule),
+ StatsTypeName = qualified(TableBuiltinModule, "proc_table_statistics"),
+ StatsType = defined(StatsTypeName, [], star),
+ ArgDecl1 = type_and_mode(StatsType, out_mode),
+ ArgDecl2 = type_and_mode(io_state_type, di_mode),
+ ArgDecl3 = type_and_mode(io_state_type, uo_mode),
+ ArgDecls = [ArgDecl1, ArgDecl2, ArgDecl3],
+
+ StatsPredSymName = tabling_stats_pred_name(SimpleCallId, ProcId,
+ SingleProc),
+ varset.init(VarSet0),
+ varset.init(InstVarSet),
+ ExistQVars = [],
+ Constraints = constraints([], []),
+ WithType = no,
+ WithInst = no,
+ Condition = true,
+ StatsPredDecl = pred_or_func(VarSet0, InstVarSet, ExistQVars,
+ predicate, StatsPredSymName, ArgDecls, WithType, WithInst,
+ yes(det), Condition, purity_pure, Constraints),
+ ItemStatus0 = item_status(!.Status, may_be_unqualified),
+ add_item_decl_pass_1(StatsPredDecl, Context, ItemStatus0, _,
+ !ModuleInfo, _, !IO),
+
+ some [!Attrs, !VarSet] (
+ !:Attrs = default_attributes(lang_c),
+ % It is easier to construct a complex Mercury structure if we are
+ % allowed to use Mercury code to build it out of simple components
+ % of primitive types.
+ set_may_call_mercury(may_call_mercury, !Attrs),
+ set_thread_safe(thread_safe, !Attrs),
+ set_purity(purity_pure, !Attrs),
+ varset.init(!:VarSet),
+ svvarset.new_named_var("Stats", Stats, !VarSet),
+ svvarset.new_named_var("IO0", IO0, !VarSet),
+ svvarset.new_named_var("IO", IO, !VarSet),
+ Arg1 = pragma_var(Stats, "Stats", out_mode, always_boxed),
+ Arg2 = pragma_var(IO0, "_IO0", di_mode, always_boxed),
+ Arg3 = pragma_var(IO, "_IO", uo_mode, always_boxed),
+
+ Global = table_info_global_var_name(!.ModuleInfo, SimpleCallId,
+ ProcId),
+ StatsPredClause = pragma(compiler(pragma_memo_attribute),
+ foreign_proc(!.Attrs, StatsPredSymName, predicate,
+ [Arg1, Arg2, Arg3], !.VarSet, InstVarSet,
+ ordinary("MR_get_tabling_stats(&" ++ Global ++ ", &Stats);",
+ yes(Context))))
+ ),
+ add_item_clause(StatsPredClause, !Status, Context, !ModuleInfo,
+ !QualInfo, !IO).
+
+:- pred create_tabling_reset_pred(proc_id::in, prog_context::in,
+ simple_call_id::in, bool::in, proc_table::in, proc_table::out,
+ import_status::in, import_status::out, module_info::in, module_info::out,
+ qual_info::in, qual_info::out, io::di, io::uo) is det.
+
+create_tabling_reset_pred(ProcId, Context, SimpleCallId, SingleProc,
+ !ProcTable, !Status, !ModuleInfo, !QualInfo, !IO) :-
+ ArgDecl1 = type_and_mode(io_state_type, di_mode),
+ ArgDecl2 = type_and_mode(io_state_type, uo_mode),
+ ArgDecls = [ArgDecl1, ArgDecl2],
+
+ ResetPredSymName = tabling_reset_pred_name(SimpleCallId, ProcId,
+ SingleProc),
+ varset.init(VarSet0),
+ varset.init(InstVarSet),
+ ExistQVars = [],
+ Constraints = constraints([], []),
+ WithType = no,
+ WithInst = no,
+ Condition = true,
+ ResetPredDecl = pred_or_func(VarSet0, InstVarSet, ExistQVars,
+ predicate, ResetPredSymName, ArgDecls, WithType, WithInst,
+ yes(det), Condition, purity_pure, Constraints),
+ ItemStatus0 = item_status(!.Status, may_be_unqualified),
+ add_item_decl_pass_1(ResetPredDecl, Context, ItemStatus0, _,
+ !ModuleInfo, _, !IO),
+
+ some [!Attrs, !VarSet] (
+ !:Attrs = default_attributes(lang_c),
+ set_may_call_mercury(will_not_call_mercury, !Attrs),
+ set_thread_safe(thread_safe, !Attrs),
+ set_purity(purity_pure, !Attrs),
+ varset.init(!:VarSet),
+ svvarset.new_named_var("IO0", IO0, !VarSet),
+ svvarset.new_named_var("IO", IO, !VarSet),
+ Arg1 = pragma_var(IO0, "_IO0", di_mode, always_boxed),
+ Arg2 = pragma_var(IO, "_IO", uo_mode, always_boxed),
+
+ Global = table_info_global_var_name(!.ModuleInfo, SimpleCallId,
+ ProcId),
+ ResetPredClause = pragma(compiler(pragma_memo_attribute),
+ foreign_proc(!.Attrs, ResetPredSymName, predicate,
+ [Arg1, Arg2], !.VarSet, InstVarSet,
+ ordinary(Global ++ ".MR_pt_tablenode.MR_integer = 0;",
+ yes(Context))))
+ ),
+ add_item_clause(ResetPredClause, !Status, Context, !ModuleInfo,
+ !QualInfo, !IO).
+
+:- func tabling_stats_pred_name(simple_call_id, proc_id, bool) = sym_name.
+
+tabling_stats_pred_name(SimpleCallId, ProcId, SingleProc) =
+ tabling_pred_name("table_statistics_for", SimpleCallId, ProcId,
+ SingleProc).
+
+:- func tabling_reset_pred_name(simple_call_id, proc_id, bool) = sym_name.
+
+tabling_reset_pred_name(SimpleCallId, ProcId, SingleProc) =
+ tabling_pred_name("table_reset_for", SimpleCallId, ProcId, SingleProc).
+
+:- 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),
+ (
+ SymName = qualified(ModuleName, Name),
+ MaybeModuleName = yes(ModuleName)
+ ;
+ SymName = unqualified(Name),
+ MaybeModuleName = no
+ ),
+ NewName0 = Prefix ++ "_" ++ Name ++ "_" ++ int_to_string(Arity),
+ (
+ SingleProc = yes,
+ NewName = NewName0
+ ;
+ SingleProc = no,
+ NewName = NewName0 ++ "_" ++ int_to_string(proc_id_to_int(ProcId))
+ ),
+ (
+ MaybeModuleName = yes(ModuleNameAgain),
+ NewSymName = qualified(ModuleNameAgain, NewName)
+ ;
+ MaybeModuleName = no,
+ NewSymName = unqualified(NewName)
+ ).
+
+:- func table_info_global_var_name(module_info, simple_call_id, proc_id)
+ = string.
+
+table_info_global_var_name(ModuleInfo, SimpleCallId, ProcId) = VarName :-
+ module_info_get_globals(ModuleInfo, Globals),
+ globals.get_target(Globals, Target),
+ expect(unify(Target, target_c), this_file,
+ "memo table statistics and reset are supported only for C"),
+ globals.lookup_bool_option(Globals, highlevel_code, HighLevelCode),
+ module_info_get_name(ModuleInfo, ModuleName),
+ SimpleCallId = simple_call_id(PredOrFunc, PredSymName, Arity),
+ (
+ HighLevelCode = yes,
+ MaybeModuleName = no,
+ unqualify_name(PredSymName, PredName),
+ % We set CodeModel and NoReturnValue to dummy values because we cannot
+ % do any better right now. The code in that outputs the mlds_proc_label
+ % of an mlds_tabling_ref should use mlds_std_tabling_proc_label to
+ % set these fields to the same values.
+ CodeModel = model_det,
+ NoReturnValue = no,
+ MLDS_PredLabel = mlds_user_pred_label(PredOrFunc, MaybeModuleName,
+ PredName, Arity, CodeModel, NoReturnValue),
+ MLDS_ProcLabel = mlds_proc_label(MLDS_PredLabel, ProcId),
+ VarName = sym_name_mangle(ModuleName) ++ "__" ++
+ mlds_tabling_data_name(MLDS_ProcLabel, tabling_info)
+ ;
+ HighLevelCode = no,
+ unqualify_name(PredSymName, PredName),
+ proc_id_to_int(ProcId, ProcIdInt),
+ ProcLabel = ordinary_proc_label(ModuleName, PredOrFunc, ModuleName,
+ PredName, Arity, ProcIdInt),
+ VarName = proc_tabling_info_var_name(ProcLabel)
+ ).
+
:- pred check_pred_args_against_tabling_methods(list(mer_mode)::in,
list(maybe(arg_tabling_method))::in, module_info::in, int::in,
maybe(pair(string))::out) is det.
@@ -1930,7 +2218,7 @@
adjust_func_arity(PredOrFunc, Arity, NumArgs),
% Create foreign_decls to declare extern variables.
- module_add_foreign_decl(c, foreign_decl_is_local,
+ module_add_foreign_decl(lang_c, foreign_decl_is_local,
C_HeaderCode, Context, !ModuleInfo),
module_add_fact_table_file(FileName, !ModuleInfo),
@@ -1998,7 +2286,7 @@
fact_table_generate_c_code(SymName, PragmaVars, ProcID, PrimaryProcID,
ProcInfo, ArgTypes, !.ModuleInfo, C_ProcCode, C_ExtraCode, !IO),
- Attrs0 = default_attributes(c),
+ Attrs0 = default_attributes(lang_c),
set_may_call_mercury(will_not_call_mercury, Attrs0, Attrs1),
set_thread_safe(thread_safe, Attrs1, Attrs2),
% Fact tables procedures should be considered pure.
@@ -2010,7 +2298,7 @@
( C_ExtraCode = "" ->
true
;
- module_add_foreign_body_code(c, C_ExtraCode, Context, !ModuleInfo)
+ module_add_foreign_body_code(lang_c, C_ExtraCode, Context, !ModuleInfo)
),
%
% The C code for fact tables includes C labels;
Index: compiler/add_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pred.m,v
retrieving revision 1.16
diff -u -b -r1.16 add_pred.m
--- compiler/add_pred.m 29 Mar 2006 08:06:34 -0000 1.16
+++ compiler/add_pred.m 16 May 2006 03:48:45 -0000
@@ -49,8 +49,7 @@
% Whenever there is a clause or mode declaration for an undeclared
% predicate, we add an implicit declaration
% :- pred p(T1, T2, ..., Tn).
- % for that predicate; the real types will be inferred by
- % type inference.
+ % for that predicate; the real types will be inferred by type inference.
%
:- pred preds_add_implicit_report_error(module_name::in, pred_or_func::in,
sym_name::in, arity::in, import_status::in, bool::in, prog_context::in,
Index: compiler/add_solver.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_solver.m,v
retrieving revision 1.12
diff -u -b -r1.12 add_solver.m
--- compiler/add_solver.m 29 Mar 2006 08:06:35 -0000 1.12
+++ compiler/add_solver.m 30 May 2006 04:37:23 -0000
@@ -194,7 +194,7 @@
InstVarSet = varset.init,
- Attrs0 = default_attributes(c),
+ Attrs0 = default_attributes(lang_c),
some [!Attrs] (
!:Attrs = Attrs0,
set_may_call_mercury(will_not_call_mercury, !Attrs),
Index: compiler/add_trail_ops.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_trail_ops.m,v
retrieving revision 1.36
diff -u -b -r1.36 add_trail_ops.m
--- compiler/add_trail_ops.m 31 Mar 2006 03:32:09 -0000 1.36
+++ compiler/add_trail_ops.m 30 May 2006 05:05:13 -0000
@@ -647,18 +647,15 @@
Detism = det,
some [!ForeignProcAttrs] (
% XXX handle other target languages here.
- !:ForeignProcAttrs = default_attributes(c),
+ !:ForeignProcAttrs = default_attributes(lang_c),
set_may_call_mercury(will_not_call_mercury, !ForeignProcAttrs),
set_thread_safe(thread_safe, !ForeignProcAttrs),
FinalForeignProcAttrs = !.ForeignProcAttrs
),
- PrefixCode = "",
ExtraArgs = [],
- SuffixCode = "",
goal_util.generate_foreign_proc(PrivateBuiltinModule, PredName,
- predicate, only_mode, Detism, FinalForeignProcAttrs,
- Args, ExtraArgs, PrefixCode, ForeignCode, SuffixCode, Features,
- InstMap, ModuleInfo, Context, ForeignProcGoal).
+ predicate, only_mode, Detism, FinalForeignProcAttrs, Args, ExtraArgs,
+ ForeignCode, Features, InstMap, ModuleInfo, Context, ForeignProcGoal).
%-----------------------------------------------------------------------------%
Index: compiler/add_type.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_type.m,v
retrieving revision 1.14
diff -u -b -r1.14 add_type.m
--- compiler/add_type.m 20 Apr 2006 05:36:49 -0000 1.14
+++ compiler/add_type.m 30 May 2006 04:37:39 -0000
@@ -434,10 +434,10 @@
VeryVerbose = no,
VerboseErrorPieces = []
),
- ( Target = c, LangStr = "C"
- ; Target = il, LangStr = "IL"
- ; Target = java, LangStr = "Java"
- ; Target = asm, LangStr = "C"
+ ( Target = target_c, LangStr = "C"
+ ; Target = target_il, LangStr = "IL"
+ ; Target = target_java, LangStr = "Java"
+ ; Target = target_asm, LangStr = "C"
),
TypeStr = describe_sym_name_and_arity(Name/Arity),
ErrorPieces = [
Index: compiler/bytecode_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/bytecode_gen.m,v
retrieving revision 1.103
diff -u -b -r1.103 bytecode_gen.m
--- compiler/bytecode_gen.m 29 Mar 2006 08:06:36 -0000 1.103
+++ compiler/bytecode_gen.m 5 Jun 2006 08:47:37 -0000
@@ -740,7 +740,7 @@
ConsId = typeclass_info_cell_constructor,
ByteConsId = typeclass_info_cell_constructor
;
- ConsId = tabling_pointer_const(_),
+ ConsId = tabling_info_const(_),
sorry(this_file, "bytecode cannot implement tabling")
;
ConsId = table_io_decl(_),
@@ -777,9 +777,9 @@
map_cons_tag(base_typeclass_info_constant(_, _, _), _) :-
unexpected(this_file, "base_typeclass_info_constant cons tag " ++
"for non-base_typeclass_info_constant cons id").
-map_cons_tag(tabling_pointer_constant(_, _), _) :-
- unexpected(this_file, "tabling_pointer_constant cons tag " ++
- "for non-tabling_pointer_constant cons id").
+map_cons_tag(tabling_info_constant(_, _), _) :-
+ unexpected(this_file, "tabling_info_constant cons tag " ++
+ "for non-tabling_info_constant cons id").
map_cons_tag(deep_profiling_proc_layout_tag(_, _), _) :-
unexpected(this_file, "deep_profiling_proc_layout_tag cons tag " ++
"for non-deep_profiling_proc_static cons id").
Index: compiler/code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_gen.m,v
retrieving revision 1.160
diff -u -b -r1.160 code_gen.m
--- compiler/code_gen.m 3 May 2006 06:46:14 -0000 1.160
+++ compiler/code_gen.m 30 May 2006 04:42:25 -0000
@@ -249,7 +249,7 @@
;
GoalExpr = foreign_proc(Attributes, PredId, ProcId, Args, ExtraArgs,
PragmaCode),
- ( c = foreign_language(Attributes) ->
+ ( foreign_language(Attributes) = lang_c ->
pragma_c_gen.generate_pragma_c_code(CodeModel, Attributes,
PredId, ProcId, Args, ExtraArgs, GoalInfo, PragmaCode, Code,
!CI)
Index: compiler/compile_target_code.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/compile_target_code.m,v
retrieving revision 1.87
diff -u -b -r1.87 compile_target_code.m
--- compiler/compile_target_code.m 21 May 2006 06:22:57 -0000 1.87
+++ compiler/compile_target_code.m 30 May 2006 04:27:11 -0000
@@ -945,7 +945,7 @@
globals.io_get_target(Target, !IO),
io.output_stream(OutputStream, !IO),
- ( Target = asm ->
+ ( Target = target_asm ->
% For --target asm, we generate everything into a single object file.
(
Modules = [FirstModule | _],
@@ -1756,7 +1756,7 @@
( LinkWithPicObjExt = ObjExt
; HighLevelCode = yes
; GCCGlobals = no
- ; Target \= c
+ ; Target \= target_c
)
->
ObjectCodeType = non_pic
Index: compiler/complexity.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/complexity.m,v
retrieving revision 1.16
diff -u -b -r1.16 complexity.m
--- compiler/complexity.m 20 Apr 2006 05:36:49 -0000 1.16
+++ compiler/complexity.m 30 May 2006 04:51:00 -0000
@@ -299,28 +299,28 @@
IsActiveVarName ++ ");\n",
complexity_generate_foreign_proc(IsActivePred, det,
- [IsActiveOutputArg], [], "", IsActiveStr, "", [IsActiveVar],
+ [IsActiveOutputArg], [], IsActiveStr, [IsActiveVar],
!.ModuleInfo, Context, IsActiveGoal),
ExitPred = "complexity_exit_proc",
ExitStr = "\tMR_" ++ ExitPred ++ "(" ++
ProcNumStr ++ ", " ++ slot_var_name ++ ");\n",
complexity_generate_foreign_proc(ExitPred, det,
- [SlotInputArg], [], "", ExitStr, "", [],
+ [SlotInputArg], [], ExitStr, [],
!.ModuleInfo, Context, ExitGoal),
FailPred = "complexity_fail_proc",
FailStr = "\tMR_" ++ FailPred ++ "(" ++
ProcNumStr ++ ", " ++ slot_var_name ++ ");\n",
complexity_generate_foreign_proc(FailPred, failure,
- [SlotInputArg], [], "", FailStr, "", [],
+ [SlotInputArg], [], FailStr, [],
!.ModuleInfo, Context, FailGoal),
RedoPred = "complexity_redo_proc",
RedoStr = "\tMR_" ++ RedoPred ++ "(" ++
ProcNumStr ++ ", " ++ slot_var_name ++ ");\n",
complexity_generate_foreign_proc(RedoPred, failure,
- [SlotInputArg], [], "", RedoStr, "", [],
+ [SlotInputArg], [], RedoStr, [],
!.ModuleInfo, Context, RedoGoal0),
(
@@ -415,7 +415,7 @@
ProcStr = "\t" ++ ProcVarName ++ " = &MR_complexity_procs[" ++
int_to_string(ProcNum) ++ "];\n",
complexity_generate_foreign_proc(PredName, det, [SlotVarArg],
- ForeignArgs, DeclCodeStr, PredCodeStr, ProcStr ++ FillCodeStr,
+ ForeignArgs, DeclCodeStr ++ PredCodeStr ++ ProcStr ++ FillCodeStr,
[SlotVar], !.ModuleInfo, Context, CallGoal),
list.append(PrefixGoals, [CallGoal], Goals).
@@ -481,18 +481,17 @@
proc_info_set_vartypes(VarTypes, !ProcInfo).
:- pred complexity_generate_foreign_proc(string::in, determinism::in,
- list(foreign_arg)::in, list(foreign_arg)::in, string::in, string::in,
- string::in, list(prog_var)::in, module_info::in, term.context::in,
- hlds_goal::out) is det.
+ list(foreign_arg)::in, list(foreign_arg)::in, string::in,
+ list(prog_var)::in, module_info::in, term.context::in, hlds_goal::out)
+ is det.
complexity_generate_foreign_proc(PredName, Detism, Args, ExtraArgs,
- PrefixCode, Code, SuffixCode, BoundVars, ModuleInfo, Context, Goal) :-
+ Code, BoundVars, ModuleInfo, Context, Goal) :-
mercury_term_size_prof_builtin_module(BuiltinModule),
- Attrs0 = default_attributes(c),
+ Attrs0 = default_attributes(lang_c),
set_may_call_mercury(will_not_call_mercury, Attrs0, Attrs),
goal_util.generate_foreign_proc(BuiltinModule, PredName, predicate,
- only_mode, Detism, Attrs, Args, ExtraArgs,
- PrefixCode, Code, SuffixCode, [impure_goal],
+ only_mode, Detism, Attrs, Args, ExtraArgs, Code, [impure_goal],
ground_vars(BoundVars), ModuleInfo, Context, Goal).
%-----------------------------------------------------------------------------%
Index: compiler/dependency_graph.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/dependency_graph.m,v
retrieving revision 1.87
diff -u -b -r1.87 dependency_graph.m
--- compiler/dependency_graph.m 29 Mar 2006 08:06:42 -0000 1.87
+++ compiler/dependency_graph.m 5 Jun 2006 11:05:44 -0000
@@ -5,10 +5,10 @@
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-
+%
% File: dependency_graph.m.
% Main authors: bromage, conway, stayl.
-
+%
% The dependency_graph records which procedures depend on which other
% procedures. It is defined as a relation (see hlds_module.m) R where xRy
% means that the definition of x depends on the definition of y.
@@ -18,7 +18,7 @@
% The other important structure is the dependency_ordering which is
% a list of the cliques (strongly-connected components) of this relation,
% in topological order. This is very handy for doing fixpoint iterations.
-
+%
%-----------------------------------------------------------------------------%
:- module transform_hlds.dependency_graph.
@@ -512,46 +512,37 @@
;
true
).
-dependency_graph.add_arcs_in_cons(type_ctor_info_const(_, _, _),
- _Caller, !DepGraph).
-dependency_graph.add_arcs_in_cons(base_typeclass_info_const(_, _, _, _),
- _Caller, !DepGraph).
-dependency_graph.add_arcs_in_cons(type_info_cell_constructor(_),
- _Caller, !DepGraph).
-dependency_graph.add_arcs_in_cons(typeclass_info_cell_constructor,
- _Caller, !DepGraph).
-dependency_graph.add_arcs_in_cons(tabling_pointer_const(_),
- _Caller, !DepGraph).
-dependency_graph.add_arcs_in_cons(deep_profiling_proc_layout(_),
- _Caller, !DepGraph).
-dependency_graph.add_arcs_in_cons(table_io_decl(_),
- _Caller, !DepGraph).
+dependency_graph.add_arcs_in_cons(type_ctor_info_const(_, _, _), _, !DepGraph).
+dependency_graph.add_arcs_in_cons(base_typeclass_info_const(_, _, _, _), _,
+ !DepGraph).
+dependency_graph.add_arcs_in_cons(type_info_cell_constructor(_), _, !DepGraph).
+dependency_graph.add_arcs_in_cons(typeclass_info_cell_constructor, _,
+ !DepGraph).
+dependency_graph.add_arcs_in_cons(tabling_info_const(_), _Caller, !DepGraph).
+dependency_graph.add_arcs_in_cons(deep_profiling_proc_layout(_), _, !DepGraph).
+dependency_graph.add_arcs_in_cons(table_io_decl(_), _Caller, !DepGraph).
%-----------------------------------------------------------------------------%
-:- pred dependency_graph.write_dependency_ordering(
- list(list(pred_proc_id))::in, module_info::in, int::in,
- io::di, io::uo) is det.
+:- pred write_dependency_ordering( list(list(pred_proc_id))::in,
+ module_info::in, int::in, io::di, io::uo) is det.
-dependency_graph.write_dependency_ordering([], _ModuleInfo, _N, !IO) :-
+write_dependency_ordering([], _ModuleInfo, _N, !IO) :-
io.write_string("\n", !IO).
-dependency_graph.write_dependency_ordering([Clique | Rest], ModuleInfo, N,
- !IO) :-
+write_dependency_ordering([Clique | Rest], ModuleInfo, N, !IO) :-
io.write_string("% Clique ", !IO),
io.write_int(N, !IO),
io.write_string("\n", !IO),
- dependency_graph.write_clique(Clique, ModuleInfo, !IO),
+ write_clique(Clique, ModuleInfo, !IO),
N1 = N + 1,
- dependency_graph.write_dependency_ordering(Rest, ModuleInfo, N1, !IO).
+ write_dependency_ordering(Rest, ModuleInfo, N1, !IO).
-:- pred dependency_graph.write_clique(list(pred_proc_id)::in, module_info::in,
- io::di, io::uo) is det.
+:- pred write_clique(list(pred_proc_id)::in, module_info::in, io::di, io::uo)
+ is det.
-dependency_graph.write_clique([], _ModuleInfo, !IO).
-dependency_graph.write_clique([proc(PredId, ProcId) | Rest], ModuleInfo,
- !IO) :-
- module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
- PredInfo, ProcInfo),
+write_clique([], _ModuleInfo, !IO).
+write_clique([proc(PredId, ProcId) | Rest], ModuleInfo, !IO) :-
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo),
Name = pred_info_name(PredInfo),
proc_info_get_declared_determinism(ProcInfo, Det),
proc_info_get_argmodes(ProcInfo, Modes),
@@ -562,17 +553,17 @@
mercury_output_pred_mode_subdecl(ModeVarSet, unqualified(Name),
Modes, Det, Context, !IO),
io.write_string("\n", !IO),
- dependency_graph.write_clique(Rest, ModuleInfo, !IO).
+ write_clique(Rest, ModuleInfo, !IO).
%-----------------------------------------------------------------------------%
-dependency_graph.write_prof_dependency_graph(!ModuleInfo, !IO) :-
+write_prof_dependency_graph(!ModuleInfo, !IO) :-
module_info_ensure_dependency_info(!ModuleInfo),
module_info_dependency_info(!.ModuleInfo, DepInfo),
write_graph(DepInfo, write_empty_node,
write_prof_dep_graph_link(!.ModuleInfo), !IO).
-dependency_graph.write_dependency_graph(!ModuleInfo, !IO) :-
+write_dependency_graph(!ModuleInfo, !IO) :-
module_info_ensure_dependency_info(!ModuleInfo),
module_info_dependency_info(!.ModuleInfo, DepInfo),
io.write_string("% Dependency graph\n", !IO),
@@ -653,24 +644,22 @@
% Print out the label corresponding to the given pred_id and proc_id.
%
-:- pred dependency_graph.output_label(module_info::in,
- pred_id::in, proc_id::in, io::di, io::uo) is det.
+:- pred output_label(module_info::in, pred_id::in, proc_id::in, io::di, io::uo)
+ is det.
-dependency_graph.output_label(ModuleInfo, PredId, ProcId, !IO) :-
+output_label(ModuleInfo, PredId, ProcId, !IO) :-
ProcLabel = make_proc_label(ModuleInfo, PredId, ProcId),
output_proc_label(ProcLabel, !IO).
%-----------------------------------------------------------------------------%
-dependency_graph.get_scc_entry_points(SCC, HigherSCCs,
- ModuleInfo, EntryPoints) :-
- list.filter(dependency_graph.is_entry_point(HigherSCCs, ModuleInfo),
- SCC, EntryPoints).
+get_scc_entry_points(SCC, HigherSCCs, ModuleInfo, EntryPoints) :-
+ list.filter(is_entry_point(HigherSCCs, ModuleInfo), SCC, EntryPoints).
-:- pred dependency_graph.is_entry_point(list(list(pred_proc_id))::in,
- module_info::in, pred_proc_id::in) is semidet.
+:- pred is_entry_point(list(list(pred_proc_id))::in, module_info::in,
+ pred_proc_id::in) is semidet.
-dependency_graph.is_entry_point(HigherSCCs, ModuleInfo, PredProcId) :-
+is_entry_point(HigherSCCs, ModuleInfo, PredProcId) :-
(
% Is the predicate exported?
PredProcId = proc(PredId, _ProcId),
@@ -693,10 +682,10 @@
% Find the SCCs called from a given SCC.
%
-:- pred dependency_graph.get_called_scc_ids(scc_id::in, relation(scc_id)::in,
- set(scc_id)::out) is det.
+:- pred get_called_scc_ids(scc_id::in, relation(scc_id)::in, set(scc_id)::out)
+ is det.
-dependency_graph.get_called_scc_ids(SCCid, SCCRel, CalledSCCSet) :-
+get_called_scc_ids(SCCid, SCCRel, CalledSCCSet) :-
relation.lookup_element(SCCRel, SCCid, SCCidKey),
relation.lookup_from(SCCRel, SCCidKey, CalledSCCKeys),
set.to_sorted_list(CalledSCCKeys, CalledSCCKeyList),
Index: compiler/det_report.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_report.m,v
retrieving revision 1.118
diff -u -b -r1.118 det_report.m
--- compiler/det_report.m 20 Apr 2006 05:36:50 -0000 1.118
+++ compiler/det_report.m 12 May 2006 04:15:28 -0000
@@ -303,7 +303,7 @@
proc_info_get_context(ProcInfo0, Context),
write_error_pieces(Context, 0,
[words("Error: `pragma "
- ++ eval_method_to_one_string(EvalMethod) ++ "'"),
+ ++ eval_method_to_string(EvalMethod) ++ "'"),
words("declaration not allowed for procedure"),
words("with determinism `"
++ determinism_to_string(InferredDetism) ++ "'.")], !IO),
Index: compiler/export.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/export.m,v
retrieving revision 1.99
diff -u -b -r1.99 export.m
--- compiler/export.m 29 Mar 2006 08:06:43 -0000 1.99
+++ compiler/export.m 30 May 2006 04:28:06 -0000
@@ -134,7 +134,8 @@
C_RetType, _DeclareReturnVal, _FailureAction, _SuccessAction,
HeadArgInfoTypes),
get_argument_declarations(HeadArgInfoTypes, no, ModuleInfo, ArgDecls),
- C_ExportDecl = foreign_export_decl(c, C_RetType, C_Function, ArgDecls),
+ C_ExportDecl =
+ foreign_export_decl(lang_c, C_RetType, C_Function, ArgDecls),
get_foreign_export_decls_2(Preds, ExportedProcs, Globals,
ModuleInfo, C_ExportDecls0),
C_ExportDecls = [C_ExportDecl | C_ExportDecls0].
@@ -385,7 +386,7 @@
\+ is_dummy_argument_type(ModuleInfo, RetType)
->
Export_RetType = foreign.to_exported_type(ModuleInfo, RetType),
- C_RetType = foreign.to_type_string(c, Export_RetType),
+ C_RetType = foreign.to_type_string(lang_c, Export_RetType),
argloc_to_string(RetArgLoc, RetArgString0),
convert_type_from_mercury(RetArgString0, RetType, RetArgString),
MaybeDeclareRetval = "\t" ++ C_RetType ++ " return_value;\n",
@@ -484,7 +485,7 @@
NameThem = no,
ArgName = ""
),
- TypeString0 = foreign.to_type_string(c, ModuleInfo, Type),
+ TypeString0 = foreign.to_type_string(lang_c, ModuleInfo, Type),
( Mode = top_out ->
% output variables are passed as pointers
TypeString = TypeString0 ++ " *"
@@ -510,7 +511,7 @@
% We need to box non-word-sized foreign types
% before passing them to Mercury code
( foreign.is_foreign_type(Export_Type) = yes(_) ->
- C_Type = foreign.to_type_string(c, Export_Type),
+ C_Type = foreign.to_type_string(lang_c, Export_Type),
string.append_list(["\tMR_MAYBE_BOX_FOREIGN_TYPE(",
C_Type, ", ", ArgName, ", ", ArgLocString, ");\n"], InputArg)
;
@@ -547,7 +548,7 @@
% We need to unbox non-word-sized foreign types
% before returning them to C code
( foreign.is_foreign_type(Export_Type) = yes(_) ->
- C_Type = foreign.to_type_string(c, Export_Type),
+ C_Type = foreign.to_type_string(lang_c, Export_Type),
string.append_list(["\tMR_MAYBE_UNBOX_FOREIGN_TYPE(", C_Type,
", ", ArgLocString, ", * ", ArgName, ");\n"], OutputArg)
;
@@ -687,7 +688,7 @@
produce_header_file_2([], !IO).
produce_header_file_2([E | ExportedProcs], !IO) :-
E = foreign_export_decl(Lang, C_RetType, C_Function, ArgDecls),
- ( Lang = c ->
+ ( Lang = lang_c ->
% Output the function header.
io.write_string(C_RetType, !IO),
io.write_string(" ", !IO),
@@ -706,7 +707,7 @@
output_foreign_decl(MaybeDesiredIsLocal, DeclCode, !IO) :-
DeclCode = foreign_decl_code(Lang, IsLocal, Code, Context),
(
- Lang = c,
+ Lang = lang_c,
(
MaybeDesiredIsLocal = no
;
Index: compiler/fact_table.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/fact_table.m,v
retrieving revision 1.74
diff -u -b -r1.74 fact_table.m
--- compiler/fact_table.m 29 Mar 2006 08:06:44 -0000 1.74
+++ compiler/fact_table.m 30 May 2006 04:42:33 -0000
@@ -3016,7 +3016,7 @@
string::out) is det.
generate_arg_decl_code(Name, Type, Module, DeclCode) :-
- C_Type = to_type_string(c, Module, Type),
+ C_Type = to_type_string(lang_c, Module, Type),
string.format("\t\t%s %s;\n", [s(C_Type), s(Name)], DeclCode).
:- pred generate_arg_input_code(string::in, mer_type::in, int::in, int::in,
Index: compiler/foreign.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/foreign.m,v
retrieving revision 1.58
diff -u -b -r1.58 foreign.m
--- compiler/foreign.m 29 Mar 2006 08:06:45 -0000 1.58
+++ compiler/foreign.m 30 May 2006 05:16:08 -0000
@@ -237,78 +237,72 @@
% C_ExtraCode, Context, ModuleInfo0, ModuleInfo),
% Impl = import(NewName, ReturnCode, VarString, no)
-extrude_pragma_implementation_2(c, managed_cplusplus, _, _, _, _) :-
- unimplemented_combination(c, managed_cplusplus).
-
-extrude_pragma_implementation_2(c, csharp, _, _, _, _) :-
- unimplemented_combination(c, csharp).
-
-extrude_pragma_implementation_2(c, il, _, _, _, _) :-
- unimplemented_combination(c, il).
-
-extrude_pragma_implementation_2(c, java, _, _, _, _) :-
- unimplemented_combination(c, java).
-
-extrude_pragma_implementation_2(c, c, !ModuleInfo, !Impl).
-
+extrude_pragma_implementation_2(TargetLanguage, ForeignLanguage,
+ !ModuleInfo, !Impl) :-
+ (
+ TargetLanguage = lang_c,
+ (
+ ForeignLanguage = lang_c
+ ;
+ ( ForeignLanguage = lang_managed_cplusplus
+ ; ForeignLanguage = lang_csharp
+ ; ForeignLanguage = lang_il
+ ; ForeignLanguage = lang_java
+ ),
+ unimplemented_combination(TargetLanguage, ForeignLanguage)
+ )
+ ;
+ TargetLanguage = lang_managed_cplusplus,
+ (
+ ( ForeignLanguage = lang_managed_cplusplus
+ ; ForeignLanguage = lang_c
+ )
% Don't do anything - C and MC++ are embedded inside MC++
% without any changes.
-extrude_pragma_implementation_2(managed_cplusplus, managed_cplusplus,
- !ModuleInfo, !Impl).
-
-extrude_pragma_implementation_2(managed_cplusplus, c, !ModuleInfo, !Impl).
-
-extrude_pragma_implementation_2(managed_cplusplus, csharp, _, _, _, _) :-
- unimplemented_combination(managed_cplusplus, csharp).
-
-extrude_pragma_implementation_2(managed_cplusplus, il, _, _, _, _) :-
- unimplemented_combination(managed_cplusplus, il).
-
-extrude_pragma_implementation_2(managed_cplusplus, java, _, _, _, _) :-
- unimplemented_combination(managed_cplusplus, java).
-
-extrude_pragma_implementation_2(csharp, csharp, !ModuleInfo, !Impl).
-
-extrude_pragma_implementation_2(csharp, c, _, _, _, _) :-
- unimplemented_combination(csharp, c).
-
-extrude_pragma_implementation_2(csharp, managed_cplusplus, _, _, _, _) :-
- unimplemented_combination(csharp, managed_cplusplus).
-
-extrude_pragma_implementation_2(csharp, il, _, _, _, _) :-
- unimplemented_combination(csharp, il).
-
-extrude_pragma_implementation_2(csharp, java, _, _, _, _) :-
- unimplemented_combination(csharp, java).
-
-extrude_pragma_implementation_2(il, il, !ModuleInfo, !Impl).
-
-extrude_pragma_implementation_2(il, c, _, _, _, _) :-
- unimplemented_combination(il, c).
-
-extrude_pragma_implementation_2(il, managed_cplusplus, _, _, _, _) :-
- unimplemented_combination(il, managed_cplusplus).
-
-extrude_pragma_implementation_2(il, csharp, _, _, _, _) :-
- unimplemented_combination(il, csharp).
-
-extrude_pragma_implementation_2(il, java, _, _, _, _) :-
- unimplemented_combination(il, java).
-
-extrude_pragma_implementation_2(java, java,
- !ModuleInfo, !Impl).
-
-extrude_pragma_implementation_2(java, c, _, _, _, _) :-
- unimplemented_combination(java, c).
-
-extrude_pragma_implementation_2(java, managed_cplusplus, _, _, _, _) :-
- unimplemented_combination(java, managed_cplusplus).
-
-extrude_pragma_implementation_2(java, csharp, _, _, _, _) :-
- unimplemented_combination(java, csharp).
-
-extrude_pragma_implementation_2(java, il, _, _, _, _) :-
- unimplemented_combination(java, il).
+ ;
+ ( ForeignLanguage = lang_csharp
+ ; ForeignLanguage = lang_il
+ ; ForeignLanguage = lang_java
+ ),
+ unimplemented_combination(TargetLanguage, ForeignLanguage)
+ )
+ ;
+ TargetLanguage = lang_csharp,
+ (
+ ForeignLanguage = lang_csharp
+ ;
+ ( ForeignLanguage = lang_c
+ ; ForeignLanguage = lang_managed_cplusplus
+ ; ForeignLanguage = lang_il
+ ; ForeignLanguage = lang_java
+ ),
+ unimplemented_combination(TargetLanguage, ForeignLanguage)
+ )
+ ;
+ TargetLanguage = lang_il,
+ (
+ ForeignLanguage = lang_il
+ ;
+ ( ForeignLanguage = lang_c
+ ; ForeignLanguage = lang_managed_cplusplus
+ ; ForeignLanguage = lang_csharp
+ ; ForeignLanguage = lang_java
+ ),
+ unimplemented_combination(TargetLanguage, ForeignLanguage)
+ )
+ ;
+ TargetLanguage = lang_java,
+ (
+ ForeignLanguage = lang_java
+ ;
+ ( ForeignLanguage = lang_c
+ ; ForeignLanguage = lang_managed_cplusplus
+ ; ForeignLanguage = lang_csharp
+ ; ForeignLanguage = lang_il
+ ),
+ unimplemented_combination(TargetLanguage, ForeignLanguage)
+ )
+ ).
:- pred unimplemented_combination(foreign_language::in, foreign_language::in)
is erroneous.
@@ -329,13 +323,13 @@
:- func make_pred_name_rest(foreign_language, sym_name) = string.
-make_pred_name_rest(c, _SymName) = "some_c_name".
-make_pred_name_rest(managed_cplusplus, qualified(ModuleSpec, Name)) =
- make_pred_name_rest(managed_cplusplus, ModuleSpec) ++ "__" ++ Name.
-make_pred_name_rest(managed_cplusplus, unqualified(Name)) = Name.
-make_pred_name_rest(csharp, _SymName) = "some_csharp_name".
-make_pred_name_rest(il, _SymName) = "some_il_name".
-make_pred_name_rest(java, _SymName) = "some_java_name".
+make_pred_name_rest(lang_c, _SymName) = "some_c_name".
+make_pred_name_rest(lang_managed_cplusplus, qualified(ModuleSpec, Name)) =
+ make_pred_name_rest(lang_managed_cplusplus, ModuleSpec) ++ "__" ++ Name.
+make_pred_name_rest(lang_managed_cplusplus, unqualified(Name)) = Name.
+make_pred_name_rest(lang_csharp, _SymName) = "some_csharp_name".
+make_pred_name_rest(lang_il, _SymName) = "some_il_name".
+make_pred_name_rest(lang_java, _SymName) = "some_java_name".
make_pragma_import(PredInfo, ProcInfo, C_Function, Context, PragmaImpl, VarSet,
PragmaVars, ArgTypes, Arity, PredOrFunc, !ModuleInfo, !IO) :-
@@ -510,14 +504,14 @@
%-----------------------------------------------------------------------------%
-have_foreign_type_for_backend(c, ForeignTypeBody,
+have_foreign_type_for_backend(target_c, ForeignTypeBody,
( ForeignTypeBody ^ c = yes(_) -> yes ; no )).
-have_foreign_type_for_backend(il, ForeignTypeBody,
+have_foreign_type_for_backend(target_il, ForeignTypeBody,
( ForeignTypeBody ^ il = yes(_) -> yes ; no )).
-have_foreign_type_for_backend(java, ForeignTypeBody,
+have_foreign_type_for_backend(target_java, ForeignTypeBody,
( ForeignTypeBody ^ java = yes(_) -> yes ; no )).
-have_foreign_type_for_backend(asm, ForeignTypeBody, Result) :-
- have_foreign_type_for_backend(c, ForeignTypeBody, Result).
+have_foreign_type_for_backend(target_asm, ForeignTypeBody, Result) :-
+ have_foreign_type_for_backend(target_c, ForeignTypeBody, Result).
:- type exported_type
---> foreign(sym_name, list(foreign_type_assertion))
@@ -559,10 +553,10 @@
module_info_get_globals(ModuleInfo, Globals),
globals.get_target(Globals, Target),
(
- Target = c,
+ Target = target_c,
(
MaybeC = yes(Data),
- Data = foreign_type_lang_data(c(NameStr), MaybeUserEqComp,
+ Data = foreign_type_lang_data(c_type(NameStr), MaybeUserEqComp,
Assertions),
Name = unqualified(NameStr)
;
@@ -570,20 +564,20 @@
unexpected(this_file, "to_exported_type: no C type")
)
;
- Target = il,
+ Target = target_il,
(
MaybeIL = yes(Data),
- Data = foreign_type_lang_data(il(_, _, Name), MaybeUserEqComp,
+ Data = foreign_type_lang_data(il_type(_, _, Name), MaybeUserEqComp,
Assertions)
;
MaybeIL = no,
unexpected(this_file, "to_exported_type: no IL type")
)
;
- Target = java,
+ Target = target_java,
(
MaybeJava = yes(Data),
- Data = foreign_type_lang_data(java(NameStr), MaybeUserEqComp,
+ Data = foreign_type_lang_data(java_type(NameStr), MaybeUserEqComp,
Assertions),
Name = unqualified(NameStr)
;
@@ -591,10 +585,10 @@
unexpected(this_file, "to_exported_type: no Java type")
)
;
- Target = asm,
+ Target = target_asm,
(
MaybeC = yes(Data),
- Data = foreign_type_lang_data(c(NameStr), MaybeUserEqComp,
+ Data = foreign_type_lang_data(c_type(NameStr), MaybeUserEqComp,
Assertions),
Name = unqualified(NameStr)
;
@@ -609,23 +603,24 @@
to_type_string(Lang, ModuleInfo, Type) =
to_type_string(Lang, to_exported_type(ModuleInfo, Type)).
-to_type_string(c, foreign(ForeignType, _)) = Result :-
+to_type_string(lang_c, foreign(ForeignType, _)) = Result :-
( ForeignType = unqualified(Result0) ->
Result = Result0
;
unexpected(this_file, "to_type_string: qualified C type")
).
-to_type_string(csharp, foreign(ForeignType, _)) = Result :-
+to_type_string(lang_csharp, foreign(ForeignType, _)) = Result :-
sym_name_to_string(ForeignType, ".", Result).
-to_type_string(managed_cplusplus, foreign(ForeignType, _)) = Result ++ " *" :-
+to_type_string(lang_managed_cplusplus, foreign(ForeignType, _)) =
+ Result ++ " *" :-
sym_name_to_string(ForeignType, "::", Result).
-to_type_string(il, foreign(ForeignType, _)) = Result :-
+to_type_string(lang_il, foreign(ForeignType, _)) = Result :-
sym_name_to_string(ForeignType, ".", Result).
-to_type_string(java, foreign(ForeignType, _)) = Result :-
+to_type_string(lang_java, foreign(ForeignType, _)) = Result :-
sym_name_to_string(ForeignType, ".", Result).
% XXX does this do the right thing for high level data?
-to_type_string(c, mercury(Type)) = Result :-
+to_type_string(lang_c, mercury(Type)) = Result :-
( Type = builtin(BuiltinType) ->
(
BuiltinType = int,
@@ -643,17 +638,17 @@
;
Result = "MR_Word"
).
-to_type_string(csharp, mercury(_Type)) = _ :-
+to_type_string(lang_csharp, mercury(_Type)) = _ :-
sorry(this_file, "to_type_string for csharp").
-to_type_string(managed_cplusplus, mercury(Type)) = TypeString :-
+to_type_string(lang_managed_cplusplus, mercury(Type)) = TypeString :-
( Type = variable(_, _) ->
TypeString = "MR_Box"
;
- TypeString = to_type_string(c, mercury(Type))
+ TypeString = to_type_string(lang_c, mercury(Type))
).
-to_type_string(il, mercury(_Type)) = _ :-
+to_type_string(lang_il, mercury(_Type)) = _ :-
sorry(this_file, "to_type_string for il").
-to_type_string(java, mercury(Type)) = Result :-
+to_type_string(lang_java, mercury(Type)) = Result :-
( Type = builtin(BuiltinType) ->
(
BuiltinType = int,
Index: compiler/global_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/global_data.m,v
retrieving revision 1.19
diff -u -b -r1.19 global_data.m
--- compiler/global_data.m 8 May 2006 03:35:59 -0000 1.19
+++ compiler/global_data.m 12 May 2006 02:52:10 -0000
@@ -34,7 +34,7 @@
:- pred global_data_init(static_cell_info::in, global_data::out) is det.
-:- pred global_data_add_new_proc_var(pred_proc_id::in, comp_gen_c_var::in,
+:- pred global_data_add_new_proc_var(pred_proc_id::in, tabling_info_struct::in,
global_data::in, global_data::out) is det.
:- pred global_data_add_new_proc_layout(pred_proc_id::in, proc_layout_info::in,
@@ -53,7 +53,7 @@
proc_layout_info::out) is det.
:- pred global_data_get_all_proc_vars(global_data::in,
- list(comp_gen_c_var)::out) is det.
+ list(tabling_info_struct)::out) is det.
:- pred global_data_get_all_proc_layouts(global_data::in,
list(proc_layout_info)::out) is det.
@@ -118,7 +118,7 @@
%-----------------------------------------------------------------------------%
-:- type proc_var_map == map(pred_proc_id, comp_gen_c_var).
+:- type proc_var_map == map(pred_proc_id, tabling_info_struct).
:- type proc_layout_map == map(pred_proc_id, proc_layout_info).
:- type global_data
Index: compiler/globals.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/globals.m,v
retrieving revision 1.74
diff -u -b -r1.74 globals.m
--- compiler/globals.m 29 Mar 2006 08:06:45 -0000 1.74
+++ compiler/globals.m 30 May 2006 04:39:57 -0000
@@ -36,22 +36,23 @@
:- type globals.
:- type compilation_target
- ---> c % Generate C code (including GNU C)
- ; il % Generate IL assembler code
- % IL is the Microsoft .NET Intermediate Language
- ; java % Generate Java
+ ---> target_c % Generate C code (including GNU C).
+ ; target_il % Generate IL assembler code.
+ % IL is the Microsoft .NET Intermediate Language.
+ ; target_java % Generate Java.
% (Work in progress)
- ; asm. % Compile directly to assembler via the GCC back-end.
- % Do not go via C, instead generate GCC's internal
- % `tree' data structure. (Work in progress.)
+ ; target_asm. % Compile directly to assembler via the GCC
+ % back-end. Do not go via C, instead generate GCC's
+ % internal `tree' data structure.
+ % (Work in progress.)
:- type foreign_language
- ---> c
-% ; cplusplus
- ; csharp
- ; managed_cplusplus
- ; java
- ; il.
+ ---> lang_c
+% ; lang_cplusplus
+ ; lang_csharp
+ ; lang_managed_cplusplus
+ ; lang_java
+ ; lang_il.
% A string representation of the compilation target suitable
% for use in human-readable error messages.
@@ -290,10 +291,10 @@
:- pred convert_target_2(string::in, compilation_target::out) is semidet.
-convert_target_2("java", java).
-convert_target_2("asm", asm).
-convert_target_2("il", il).
-convert_target_2("c", c).
+convert_target_2("java", target_java).
+convert_target_2("asm", target_asm).
+convert_target_2("il", target_il).
+convert_target_2("c", target_c).
convert_foreign_language(String, ForeignLanguage) :-
convert_foreign_language_2(string.to_lower(String), ForeignLanguage).
@@ -301,15 +302,15 @@
:- pred convert_foreign_language_2(string::in, foreign_language::out)
is semidet.
-convert_foreign_language_2("c", c).
-convert_foreign_language_2("mc++", managed_cplusplus).
-convert_foreign_language_2("managedc++", managed_cplusplus).
-convert_foreign_language_2("managed c++", managed_cplusplus).
-convert_foreign_language_2("c#", csharp).
-convert_foreign_language_2("csharp", csharp).
-convert_foreign_language_2("c sharp", csharp).
-convert_foreign_language_2("il", il).
-convert_foreign_language_2("java", java).
+convert_foreign_language_2("c", lang_c).
+convert_foreign_language_2("mc++", lang_managed_cplusplus).
+convert_foreign_language_2("managedc++", lang_managed_cplusplus).
+convert_foreign_language_2("managed c++", lang_managed_cplusplus).
+convert_foreign_language_2("c#", lang_csharp).
+convert_foreign_language_2("csharp", lang_csharp).
+convert_foreign_language_2("c sharp", lang_csharp).
+convert_foreign_language_2("il", lang_il).
+convert_foreign_language_2("java", lang_java).
convert_gc_method("none", none).
convert_gc_method("conservative", boehm).
@@ -330,22 +331,23 @@
convert_maybe_thread_safe("yes", yes).
convert_maybe_thread_safe("no", no).
-compilation_target_string(c) = "C".
-compilation_target_string(il) = "IL".
-compilation_target_string(java) = "Java".
-compilation_target_string(asm) = "asm".
-
-foreign_language_string(c) = "C".
-foreign_language_string(managed_cplusplus) = "Managed C++".
-foreign_language_string(csharp) = "C#".
-foreign_language_string(il) = "IL".
-foreign_language_string(java) = "Java".
-
-simple_foreign_language_string(c) = "c".
-simple_foreign_language_string(managed_cplusplus) = "cpp". % XXX mcpp is better
-simple_foreign_language_string(csharp) = "csharp".
-simple_foreign_language_string(il) = "il".
-simple_foreign_language_string(java) = "java".
+compilation_target_string(target_c) = "C".
+compilation_target_string(target_il) = "IL".
+compilation_target_string(target_java) = "Java".
+compilation_target_string(target_asm) = "asm".
+
+foreign_language_string(lang_c) = "C".
+foreign_language_string(lang_managed_cplusplus) = "Managed C++".
+foreign_language_string(lang_csharp) = "C#".
+foreign_language_string(lang_il) = "IL".
+foreign_language_string(lang_java) = "Java".
+
+simple_foreign_language_string(lang_c) = "c".
+simple_foreign_language_string(lang_managed_cplusplus) = "cpp".
+ % XXX mcpp is better
+simple_foreign_language_string(lang_csharp) = "csharp".
+simple_foreign_language_string(lang_il) = "il".
+simple_foreign_language_string(lang_java) = "java".
gc_is_conservative(boehm) = yes.
gc_is_conservative(mps) = yes.
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.130
diff -u -b -r1.130 goal_util.m
--- compiler/goal_util.m 29 Mar 2006 08:06:46 -0000 1.130
+++ compiler/goal_util.m 6 Jun 2006 03:07:13 -0000
@@ -57,7 +57,7 @@
% OutputVar in InstMapDelta (the initial inst is free).
%
:- pred create_renaming(prog_vars::in, instmap_delta::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
hlds_goals::out, prog_vars::out, prog_var_renaming::out) is det.
% The predicates rename_var* take a structure and a mapping from var -> var
@@ -313,25 +313,22 @@
list(goal_feature)::in, assoc_list(prog_var, mer_inst)::in,
module_info::in, term.context::in, hlds_goal::out) is det.
- % generate_foreign_proc(ModuleName, ProcName, PredOrFunc,
- % ModeNo, Detism, Attributes, Args, ExtraArgs, PrefixCode, Code,
- % SuffixCode, Features, InstMapDelta, ModuleInfo, Context,
- % CallGoal):
+ % generate_foreign_proc(ModuleName, ProcName, PredOrFunc, ModeNo, Detism,
+ % Attributes, Args, ExtraArgs, Code, Features, InstMapDelta,
+ % ModuleInfo, Context, CallGoal):
%
% generate_foreign_proc is similar to generate_simple_call,
% but also assumes that the called predicate is defined via a
% foreign_proc, that the foreign_proc's arguments are as given in
% Args, its attributes are Attributes, and its code is Code.
% As well as returning a foreign_code instead of a call, effectively
- % inlining the call, generate_foreign_proc also puts PrefixCode
- % before Code, SuffixCode after Code, and passes ExtraArgs as well
- % as Args.
- %
-:- pred generate_foreign_proc(module_name::in, string::in,
- pred_or_func::in, mode_no::in, determinism::in,
- pragma_foreign_proc_attributes::in,
- list(foreign_arg)::in, list(foreign_arg)::in, string::in, string::in,
- string::in, list(goal_feature)::in, assoc_list(prog_var, mer_inst)::in,
+ % inlining the call, generate_foreign_proc also and passes ExtraArgs
+ % as well as Args.
+ %
+:- pred generate_foreign_proc(module_name::in, string::in, pred_or_func::in,
+ mode_no::in, determinism::in, pragma_foreign_proc_attributes::in,
+ list(foreign_arg)::in, list(foreign_arg)::in, string::in,
+ list(goal_feature)::in, assoc_list(prog_var, mer_inst)::in,
module_info::in, term.context::in, hlds_goal::out) is det.
% Generate a cast goal. The input and output insts are just ground.
@@ -386,21 +383,21 @@
%-----------------------------------------------------------------------------%
-create_renaming(OrigVars, InstMapDelta, !VarTypes, !VarSet, Unifies, NewVars,
+create_renaming(OrigVars, InstMapDelta, !VarSet, !VarTypes, Unifies, NewVars,
Renaming) :-
- create_renaming_2(OrigVars, InstMapDelta, !VarTypes, !VarSet,
+ create_renaming_2(OrigVars, InstMapDelta, !VarSet, !VarTypes,
[], RevUnifies, [], RevNewVars, map.init, Renaming),
list.reverse(RevNewVars, NewVars),
list.reverse(RevUnifies, Unifies).
:- pred create_renaming_2(prog_vars::in, instmap_delta::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
hlds_goals::in, hlds_goals::out, prog_vars::in, prog_vars::out,
prog_var_renaming::in, prog_var_renaming::out) is det.
-create_renaming_2([], _, !VarTypes, !VarSet, !RevUnifies, !RevNewVars,
+create_renaming_2([], _, !VarSet, !VarTypes, !RevUnifies, !RevNewVars,
!Renaming).
-create_renaming_2([OrigVar | OrigVars], InstMapDelta, !VarTypes, !VarSet,
+create_renaming_2([OrigVar | OrigVars], InstMapDelta, !VarSet, !VarTypes,
!RevUnifies, !RevNewVars, !Renaming) :-
svvarset.new_var(NewVar, !VarSet),
map.lookup(!.VarTypes, OrigVar, Type),
@@ -422,7 +419,7 @@
!:RevUnifies = [Goal | !.RevUnifies],
svmap.det_insert(OrigVar, NewVar, !Renaming),
!:RevNewVars = [NewVar | !.RevNewVars],
- create_renaming_2(OrigVars, InstMapDelta, !VarTypes, !VarSet,
+ create_renaming_2(OrigVars, InstMapDelta, !VarSet, !VarTypes,
!RevUnifies, !RevNewVars, !Renaming).
%-----------------------------------------------------------------------------%
@@ -1589,15 +1586,14 @@
Goal = GoalExpr - GoalInfo.
generate_foreign_proc(ModuleName, ProcName, PredOrFunc, ModeNo, Detism,
- Attributes, Args, ExtraArgs, PrefixCode, Code, SuffixCode, Features,
- InstMap, ModuleInfo, Context, Goal) :-
+ Attributes, Args, ExtraArgs, Code, Features, InstMap, ModuleInfo,
+ Context, Goal) :-
list.length(Args, Arity),
lookup_builtin_pred_proc_id(ModuleInfo, ModuleName, ProcName,
PredOrFunc, Arity, ModeNo, PredId, ProcId),
- AllCode = PrefixCode ++ Code ++ SuffixCode,
GoalExpr = foreign_proc(Attributes, PredId, ProcId, Args, ExtraArgs,
- ordinary(AllCode, no)),
+ ordinary(Code, no)),
ArgVars = list.map(foreign_arg_var, Args),
ExtraArgVars = list.map(foreign_arg_var, ExtraArgs),
Vars = ArgVars ++ ExtraArgVars,
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.267
diff -u -b -r1.267 handle_options.m
--- compiler/handle_options.m 29 May 2006 08:03:30 -0000 1.267
+++ compiler/handle_options.m 30 May 2006 08:00:17 -0000
@@ -134,7 +134,7 @@
globals.io_lookup_bool_option(target_code_only,
TargetCodeOnly, !IO),
globals.io_get_target(Target, !IO),
- GenerateIL = (if Target = il then yes else no),
+ GenerateIL = (if Target = target_il then yes else no),
globals.io_lookup_bool_option(compile_only, CompileOnly, !IO),
bool.or_list([GenerateDependencies, GenerateDependencyFile,
MakeInterface, MakePrivateInterface, MakeShortInterface,
@@ -214,7 +214,7 @@
->
Target = TargetPrime
;
- Target = c, % dummy
+ Target = target_c, % dummy
add_error("Invalid target option " ++
"(must be `c', `asm', `il', or `java')", !Errors)
),
@@ -473,7 +473,7 @@
% intermodule optimization pulls in a lot of code which isn't
% needed, so ensure that this dead code is removed.
- ( Target = il ->
+ ( Target = target_il ->
globals.set_gc_method(automatic, !Globals),
globals.set_option(gc, string("automatic"), !Globals),
globals.set_option(reclaim_heap_on_nondet_failure, bool(no),
@@ -567,7 +567,7 @@
% intermodule optimization pulls in a lot of code which isn't
% needed, so ensure that this dead code is removed.
- ( Target = java ->
+ ( Target = target_java ->
globals.set_gc_method(automatic, !Globals),
globals.set_option(gc, string("automatic"), !Globals),
globals.set_option(reclaim_heap_on_nondet_failure, bool(no),
@@ -597,7 +597,7 @@
),
% Generating assembler via the gcc back-end requires
% using high-level code.
- ( Target = asm ->
+ ( Target = target_asm ->
globals.set_option(highlevel_code, bool(yes), !Globals)
;
true
@@ -607,8 +607,8 @@
% in its own function, to avoid problems with setjmp() and
% non-volatile local variables.
(
- ( Target = c
- ; Target = asm
+ ( Target = target_c
+ ; Target = target_asm
)
->
option_implies(highlevel_code, put_commit_in_own_func, bool(yes),
@@ -1066,7 +1066,7 @@
% For the IL backend we turn off optimize_peep
% so that we don't optimize away references to the
% local variables of a procedure.
- ( Target = il ->
+ ( Target = target_il ->
globals.set_option(optimize_peep, bool(no), !Globals)
;
true
@@ -1127,7 +1127,7 @@
ProfileDeep = yes,
(
HighLevel = no,
- Target = c
+ Target = target_c
->
true
;
@@ -1181,8 +1181,8 @@
(
( given_trace_level_is_none(TraceLevel) = yes
- ; HighLevel = no, Target = c
- ; Target = il
+ ; HighLevel = no, Target = target_c
+ ; Target = target_il
)
->
true
@@ -1642,18 +1642,18 @@
% The backend foreign languages depend on the target.
(
- Target = c,
+ Target = target_c,
BackendForeignLanguages = ["c"]
;
- Target = il,
+ Target = target_il,
BackendForeignLanguages = ["il", "csharp", "mc++"],
set_option(optimize_constructor_last_call, bool(no), !Globals)
;
- Target = asm,
+ Target = target_asm,
% XXX This is wrong! It should be asm.
BackendForeignLanguages = ["c"]
;
- Target = java,
+ Target = target_java,
BackendForeignLanguages = ["java"],
set_option(optimize_constructor_last_call, bool(no), !Globals)
),
@@ -1690,8 +1690,8 @@
(
% In the non-C backends, it may not be possible to cast a value
% of a non-enum du type to an integer.
- ( Target = c
- ; Target = asm
+ ( Target = target_c
+ ; Target = target_asm
),
% To ensure that all constants in general du types are
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.153
diff -u -b -r1.153 higher_order.m
--- compiler/higher_order.m 20 Apr 2006 05:36:52 -0000 1.153
+++ compiler/higher_order.m 5 Jun 2006 11:05:49 -0000
@@ -873,7 +873,7 @@
Params ^ user_type_spec.
is_interesting_cons_id(Params, typeclass_info_cell_constructor) =
Params ^ user_type_spec.
-is_interesting_cons_id(_Params, tabling_pointer_const(_)) = no.
+is_interesting_cons_id(_Params, tabling_info_const(_)) = no.
is_interesting_cons_id(_Params, deep_profiling_proc_layout(_)) = no.
is_interesting_cons_id(_Params, table_io_decl(_)) = no.
Index: compiler/hlds_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_code_util.m,v
retrieving revision 1.26
diff -u -b -r1.26 hlds_code_util.m
--- compiler/hlds_code_util.m 20 Apr 2006 05:36:52 -0000 1.26
+++ compiler/hlds_code_util.m 5 Jun 2006 08:47:41 -0000
@@ -68,8 +68,8 @@
globals.lookup_bool_option(Globals, highlevel_data, HighLevelData),
HighLevelData = yes,
globals.get_target(Globals, Target),
- ( Target = il
- ; Target = java
+ ( Target = target_il
+ ; Target = target_java
).
%-----------------------------------------------------------------------------%
@@ -86,8 +86,8 @@
base_typeclass_info_constant(M,C,N).
cons_id_to_tag(type_info_cell_constructor(_), _, _) = unshared_tag(0).
cons_id_to_tag(typeclass_info_cell_constructor, _, _) = unshared_tag(0).
-cons_id_to_tag(tabling_pointer_const(ShroudedPredProcId), _, _) =
- tabling_pointer_constant(PredId, ProcId) :-
+cons_id_to_tag(tabling_info_const(ShroudedPredProcId), _, _) =
+ tabling_info_constant(PredId, ProcId) :-
proc(PredId, ProcId) = unshroud_pred_proc_id(ShroudedPredProcId).
cons_id_to_tag(deep_profiling_proc_layout(ShroudedPredProcId), _, _) =
deep_profiling_proc_layout_tag(PredId, ProcId) :-
Index: compiler/hlds_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.106
diff -u -b -r1.106 hlds_data.m
--- compiler/hlds_data.m 31 May 2006 16:00:36 -0000 1.106
+++ compiler/hlds_data.m 5 Jun 2006 08:46:40 -0000
@@ -249,10 +249,10 @@
% uniquely identifies the instance declaration (it is made from
% the type of the arguments to the instance decl).
- ; tabling_pointer_constant(pred_id, proc_id)
- % This is how we refer to tabling pointer variables represented
- % as global data. The word just contains the address of the tabling
- % pointer of the specified procedure.
+ ; tabling_info_constant(pred_id, proc_id)
+ % This is how we refer to the global structures containing
+ % tabling pointer variables and related data. The word just
+ % contains the address of the global struct.
; deep_profiling_proc_layout_tag(pred_id, proc_id)
% This is for constants representing procedure descriptions for
@@ -362,7 +362,7 @@
get_primary_tag(pred_closure_tag(_, _, _)) = no.
get_primary_tag(type_ctor_info_constant(_, _, _)) = no.
get_primary_tag(base_typeclass_info_constant(_, _, _)) = no.
-get_primary_tag(tabling_pointer_constant(_, _)) = no.
+get_primary_tag(tabling_info_constant(_, _)) = no.
get_primary_tag(deep_profiling_proc_layout_tag(_, _)) = no.
get_primary_tag(table_io_decl_tag(_, _)) = no.
get_primary_tag(single_functor) = yes(0).
@@ -381,7 +381,7 @@
get_secondary_tag(pred_closure_tag(_, _, _)) = no.
get_secondary_tag(type_ctor_info_constant(_, _, _)) = no.
get_secondary_tag(base_typeclass_info_constant(_, _, _)) = no.
-get_secondary_tag(tabling_pointer_constant(_, _)) = no.
+get_secondary_tag(tabling_info_constant(_, _)) = no.
get_secondary_tag(deep_profiling_proc_layout_tag(_, _)) = no.
get_secondary_tag(table_io_decl_tag(_, _)) = no.
get_secondary_tag(single_functor) = no.
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.158
diff -u -b -r1.158 hlds_goal.m
--- compiler/hlds_goal.m 5 Jun 2006 02:26:06 -0000 1.158
+++ compiler/hlds_goal.m 6 Jun 2006 03:23:21 -0000
@@ -1327,19 +1327,19 @@
:- pred make_int_const_construction_alloc(int::in, maybe(string)::in,
hlds_goal::out, prog_var::out,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out) is det.
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out) is det.
:- pred make_string_const_construction_alloc(string::in, maybe(string)::in,
hlds_goal::out, prog_var::out,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out) is det.
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out) is det.
:- pred make_float_const_construction_alloc(float::in, maybe(string)::in,
hlds_goal::out, prog_var::out,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out) is det.
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out) is det.
:- pred make_char_const_construction_alloc(char::in, maybe(string)::in,
hlds_goal::out, prog_var::out,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out) is det.
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out) is det.
:- pred make_const_construction_alloc(cons_id::in, mer_type::in,
maybe(string)::in, hlds_goal::out, prog_var::out,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out) is det.
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out) is det.
:- pred make_int_const_construction_alloc_in_proc(int::in,
maybe(string)::in, hlds_goal::out, prog_var::out,
@@ -2221,31 +2221,31 @@
make_const_construction(Var, ConsId, Goal).
make_int_const_construction_alloc(Int, MaybeName, Goal, Var,
- !VarTypes, !VarSet) :-
+ !VarSet, !VarTypes) :-
svvarset.new_maybe_named_var(MaybeName, Var, !VarSet),
svmap.det_insert(Var, int_type, !VarTypes),
make_int_const_construction(Var, Int, Goal).
make_string_const_construction_alloc(String, MaybeName, Goal, Var,
- !VarTypes, !VarSet) :-
+ !VarSet, !VarTypes) :-
svvarset.new_maybe_named_var(MaybeName, Var, !VarSet),
svmap.det_insert(Var, string_type, !VarTypes),
make_string_const_construction(Var, String, Goal).
make_float_const_construction_alloc(Float, MaybeName, Goal, Var,
- !VarTypes, !VarSet) :-
+ !VarSet, !VarTypes) :-
svvarset.new_maybe_named_var(MaybeName, Var, !VarSet),
svmap.det_insert(Var, float_type, !VarTypes),
make_float_const_construction(Var, Float, Goal).
make_char_const_construction_alloc(Char, MaybeName, Goal, Var,
- !VarTypes, !VarSet) :-
+ !VarSet, !VarTypes) :-
svvarset.new_maybe_named_var(MaybeName, Var, !VarSet),
svmap.det_insert(Var, char_type, !VarTypes),
make_char_const_construction(Var, Char, Goal).
make_const_construction_alloc(ConsId, Type, MaybeName, Goal, Var,
- !VarTypes, !VarSet) :-
+ !VarSet, !VarTypes) :-
svvarset.new_maybe_named_var(MaybeName, Var, !VarSet),
svmap.det_insert(Var, Type, !VarTypes),
make_const_construction(Var, ConsId, Goal).
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.392
diff -u -b -r1.392 hlds_out.m
--- compiler/hlds_out.m 10 May 2006 10:56:51 -0000 1.392
+++ compiler/hlds_out.m 5 Jun 2006 11:06:01 -0000
@@ -304,7 +304,7 @@
io.write_string(cons_id_to_string(ConsId), !IO).
cons_id_to_string(cons(SymName, Arity)) = String :-
- mdbcomp.prim_data.sym_name_to_string(SymName, SymNameString0),
+ sym_name_to_string(SymName, SymNameString0),
( string.contains_char(SymNameString0, '*') ->
% We need to protect against the * appearing next to a /
Stuff = (pred(Char::in, Str0::in, Str::out) is det :-
@@ -340,9 +340,8 @@
"<type_info_cell_constructor>".
cons_id_to_string(typeclass_info_cell_constructor) =
"<typeclass_info_cell_constructor>".
-cons_id_to_string(
- tabling_pointer_const(shrouded_pred_proc_id(PredId, ProcId))) =
- "<tabling_pointer " ++ int_to_string(PredId) ++
+cons_id_to_string(tabling_info_const(shrouded_pred_proc_id(PredId, ProcId))) =
+ "<tabling_info " ++ int_to_string(PredId) ++
", " ++ int_to_string(ProcId) ++ ">".
cons_id_to_string(deep_profiling_proc_layout(
shrouded_pred_proc_id(PredId, ProcId))) =
@@ -352,10 +351,10 @@
"<table_io_decl " ++ int_to_string(PredId) ++
", " ++ int_to_string(ProcId) ++ ">".
+write_pred_id(ModuleInfo, PredId, !IO) :-
% The code of this predicate duplicates the functionality of
% hlds_error_util.describe_one_pred_name. Changes here should be made
% there as well.
-write_pred_id(ModuleInfo, PredId, !IO) :-
io.write_string(pred_id_to_string(ModuleInfo, PredId), !IO).
pred_id_to_string(ModuleInfo, PredId) = Str :-
@@ -2667,10 +2666,10 @@
term.atom("typeclass_info_cell_constructor"),
ArgVars, VarSet, AppendVarNums, next_to_graphic_token)
;
- ConsId = tabling_pointer_const(ShroudedPredProcId),
+ ConsId = tabling_info_const(ShroudedPredProcId),
proc(PredId, ProcId) = unshroud_pred_proc_id(ShroudedPredProcId),
proc_id_to_int(ProcId, ProcIdInt),
- Str = "tabling_pointer_const("
+ Str = "tabling_info_const("
++ pred_id_to_string(ModuleInfo, PredId)
++ ", " ++ int_to_string(ProcIdInt) ++ ")"
;
@@ -3762,7 +3761,7 @@
can_fail_to_string(cannot_fail) = "cannot_fail".
write_eval_method(EvalMethod, !IO) :-
- io.write_string(eval_method_to_one_string(EvalMethod), !IO).
+ io.write_string(eval_method_to_string(EvalMethod), !IO).
%-----------------------------------------------------------------------------%
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.197
diff -u -b -r1.197 hlds_pred.m
--- compiler/hlds_pred.m 20 Apr 2006 05:36:53 -0000 1.197
+++ compiler/hlds_pred.m 6 Jun 2006 07:01:19 -0000
@@ -877,123 +877,105 @@
% accurate GC for the MLDS back-end relies on this.
:- type pred_info
---> pred_info(
- module_name :: module_name,
% Module in which pred occurs.
+ module_name :: module_name,
- name :: string,
% Predicate name.
+ name :: string,
+ % The arity of the pred (*not* counting any inserted type_info
+ % arguments).
orig_arity :: arity,
- % The arity of the pred (*not* counting any
- % inserted type_info arguments)
+ % Whether this "predicate" is really a predicate or a function.
is_pred_or_func :: pred_or_func,
- % Whether this "predicate" was really
- % a predicate or a function.
- context :: prog_context,
% The location (line #) of the :- pred decl.
+ context :: prog_context,
- pred_origin :: pred_origin,
% Where did the predicate come from.
+ pred_origin :: pred_origin,
import_status :: import_status,
+ % Whether the goals seen so far, if any, for this predicate
+ % are clauses or foreign_code(...) pragmas.
goal_type :: goal_type,
- % Whether the goals seen so far, if any,
- % for this predicate are clauses or
- % foreign_code(...) pragmas.
- markers :: pred_markers,
% Various boolean flags.
+ markers :: pred_markers,
- attributes :: pred_attributes,
% Various attributes.
+ attributes :: pred_attributes,
- arg_types :: list(mer_type),
% Argument types.
+ arg_types :: list(mer_type),
+ % Names of type vars in the predicate's type declaration.
decl_typevarset :: tvarset,
- % Names of type vars in the predicate's
- % type declaration.
+ % Names of type vars in the predicate's type declaration
+ % or in the variable type assignments.
typevarset :: tvarset,
- % Names of type vars in the predicate's
- % type declaration or in the variable
- % type assignments.
- tvar_kinds :: tvar_kind_map,
% Kinds of the type vars.
+ tvar_kinds :: tvar_kind_map,
+ % The set of existentially quantified type variables in the
+ % predicate's type declaration.
exist_quant_tvars :: existq_tvars,
- % The set of existentially quantified type
- % variables in the predicate's type
- % declaration.
- existq_tvar_binding :: tsubst,
- % The statically known bindings of
- % existentially quantified type variables
- % inside this predicate. This field is set
+ % The statically known bindings of existentially quantified
+ % type variables inside this predicate. This field is set
% at the end of the polymorphism stage.
+ existq_tvar_binding :: tsubst,
+ % The set of type variables which the body of the predicate
+ % can't bind, and whose type_infos are produced elsewhere.
+ % This includes universally quantified head types (the
+ % type_infos are passed in) plus existentially quantified types
+ % in preds called from the body (the type_infos are returned
+ % from the called predicates). Computed during type checking.
head_type_params :: head_type_params,
- % The set of type variables which the body
- % of the predicate can't bind, and whose
- % type_infos are produced elsewhere.
- % This includes universally quantified
- % head types (the type_infos are passed in)
- % plus existentially quantified types
- % in preds called from the body (the
- % type_infos are returned from the
- % called predicates). Computed during
- % type checking.
+ % The class constraints on the type variables in the
+ % predicate's type declaration.
class_context :: prog_constraints,
- % The class constraints on the type
- % variables in the predicate's type
- % declaration.
+ % Explanations of how redundant constraints were eliminated.
+ % These are needed by polymorphism.m to work out where to get
+ % the typeclass_infos from. Computed during type checking.
constraint_proofs :: constraint_proof_map,
- % Explanations of how redundant constraints
- % were eliminated. These are needed by
- % polymorphism.m to work out where to get
- % the typeclass_infos from. Computed
- % during type checking.
+ % Maps constraint identifiers to the actual constraints.
+ % Computed during type checking.
constraint_map :: constraint_map,
- % Maps constraint identifiers to the actual
- % constraints. Computed during type
- % checking.
- unproven_body_constraints :: list(prog_constraint),
- % Unproven class constraints on type
- % variables in the predicate's body,
- % if any (if this remains non-empty
- % after type checking has finished,
- % post_typecheck.m will report a
+ % Unproven class constraints on type variables in the
+ % predicate's body, if any (if this remains non-empty after
+ % type checking has finished, post_typecheck.m will report a
% type error).
+ unproven_body_constraints :: list(prog_constraint),
+ % The predicate's inst graph, for constraint based
+ % mode analysis.
inst_graph_info :: inst_graph_info,
- % The predicate's inst graph, for
- % constraint based mode analysis.
+ % Mode information extracted from constraint based
+ % mode analysis.
modes :: list(arg_modes_map),
- % Mode information extracted from
- % constraint based mode analysis.
+ % List of assertions which mention this predicate.
assertions :: set(assert_id),
- % List of assertions which mention
- % this predicate.
clauses_info :: clauses_info,
procedures :: proc_table
).
-pred_info_init(ModuleName, SymName, Arity, PredOrFunc, Context, Origin,
- Status, GoalType, Markers, ArgTypes, TypeVarSet, ExistQVars,
- ClassContext, ClassProofs, ClassConstraintMap, ClausesInfo,
- PredInfo) :-
+pred_info_init(ModuleName, SymName, Arity, PredOrFunc, Context, Origin, Status,
+ GoalType, Markers, ArgTypes, TypeVarSet, ExistQVars, ClassContext,
+ ClassProofs, ClassConstraintMap, ClausesInfo, PredInfo) :-
unqualify_name(SymName, PredName),
sym_name_get_module_name(SymName, ModuleName, PredModuleName),
prog_type.vars_list(ArgTypes, TVars),
@@ -1599,6 +1581,10 @@
---> direct(int)
; indirect(int, int).
+ % This type is differs from the type table_step_kind in
+ % library/table_builtin.m in that (a) in gives more information about the
+ % type of the corresponding argument (if this info is needed and
+ % available), and (b) it doesn't have to handle dummy steps.
:- type table_trie_step
---> table_trie_step_int
; table_trie_step_char
@@ -1623,17 +1609,17 @@
).
:- type proc_table_info
-
+ ---> table_io_decl_info(
% The information we need to display an I/O action to the user.
%
% The table_arg_type_infos correspond one to one to the
% elements of the block saved for an I/O action. The first
% element will be the pointer to the proc_layout of the
% action's procedure.
- ---> table_io_decl_info(
+
table_arg_infos
)
-
+ ; table_gen_info(
% The information we need to interpret the data structures
% created by tabling for a procedure, except the information
% (such as determinism) that is already available from
@@ -1641,10 +1627,11 @@
%
% The table_arg_type_infos list first all the input arguments,
% then all the output arguments.
- ; table_gen_info(
+
num_inputs :: int,
num_outputs :: int,
input_steps :: list(table_trie_step),
+ maybe_output_steps :: maybe(list(table_trie_step)),
gen_arg_infos :: table_arg_infos
).
@@ -1713,6 +1700,8 @@
maybe(prog_var)::out) is det.
:- pred proc_info_get_maybe_proc_table_info(proc_info::in,
maybe(proc_table_info)::out) is det.
+:- pred proc_info_get_table_attributes(proc_info::in,
+ maybe(table_attributes)::out) is det.
:- pred proc_info_get_maybe_deep_profile_info(proc_info::in,
maybe(deep_profile_proc_info)::out) is det.
:- pred proc_info_get_maybe_untuple_info(proc_info::in,
@@ -1762,6 +1751,8 @@
proc_info::in, proc_info::out) is det.
:- pred proc_info_set_maybe_proc_table_info(maybe(proc_table_info)::in,
proc_info::in, proc_info::out) is det.
+:- pred proc_info_set_table_attributes(maybe(table_attributes)::in,
+ proc_info::in, proc_info::out) is det.
:- pred proc_info_set_maybe_deep_profile_info(
maybe(deep_profile_proc_info)::in,
proc_info::in, proc_info::out) is det.
@@ -1912,192 +1903,139 @@
:- type proc_info
---> proc_info(
+ % The context of the `:- mode' decl (or the context of the
+ % first clause, if there was no mode declaration).
proc_context :: prog_context,
- % The context of the `:- mode' decl
- % (or the context of the first
- % clause, if there was no mode
- % declaration).
prog_varset :: prog_varset,
var_types :: vartypes,
head_vars :: list(prog_var),
inst_varset :: inst_varset,
- maybe_declared_head_modes :: maybe(list(mer_mode)),
% The declared modes of arguments.
+ maybe_declared_head_modes :: maybe(list(mer_mode)),
+
actual_head_modes :: list(mer_mode),
maybe_head_modes_constraint :: maybe(mode_constraint),
+ % Liveness (in the mode analysis sense) of the arguments
+ % in the caller; says whether each argument may be used
+ % after the call.
head_var_caller_liveness :: maybe(list(is_live)),
- % Liveness (in the mode analysis
- % sense) of the arguments in the
- % caller; says whether each
- % argument may be used after
- % the call.
+ % The _declared_ determinism of the procedure, or `no'
+ % if there was no detism declaration.
declared_detism :: maybe(determinism),
- % The _declared_ determinism of the
- % procedure, or `no' if there was
- % no detism declaration.
inferred_detism :: determinism,
body :: hlds_goal,
+
+ % No if we must not process this procedure yet (used to delay
+ % mode checking etc. for complicated modes of unification
+ % predicates until the end of the unique_modes pass.)
can_process :: bool,
- % No if we must not process
- % this procedure yet (used to delay
- % mode checking etc. for
- % complicated modes of unification
- % predicates until the end of the
- % unique_modes pass.)
mode_errors :: list(mode_error_info),
+ % Information about type_infos and typeclass_infos.
proc_rtti_varmaps :: rtti_varmaps,
- % Information about type_infos and
- % typeclass_infos.
- eval_method :: eval_method,
% How should the proc be evaluated.
+ eval_method :: eval_method,
proc_sub_info :: proc_sub_info
).
:- type proc_sub_info
---> proc_sub_info(
+ % Information about the relative sizes of the input and output
+ % args of the procedure. Set by termination analysis.
maybe_arg_sizes :: maybe(arg_size_info),
- % Information about the relative
- % sizes of the input and output
- % args of the procedure. Set by
- % termination analysis.
+ % The termination properties of the procedure.
+ % Set by termination analysis.
maybe_termination :: maybe(termination_info),
- % The termination properties of the
- % procedure. Set by termination
- % analysis.
+ % Termination properties and argument size constraints for
+ % the procedure. Set by termination2 analysis.
termination2 :: termination2_info,
- % Termination properties and
- % argument size constraints for
- % the procedure. Set by
- % termination2 analysis.
+ % Is the address of this procedure taken? If yes, we will
+ % need to use typeinfo liveness for them, so that deep_copy
+ % and accurate gc have the RTTI they need for copying closures.
+ %
+ % Note that any non-local procedure must be considered
+ % as having its address taken, since it is possible that
+ % some other module may do so.
is_address_taken :: is_address_taken,
- % Is the address of this procedure
- % taken? If yes, we will need to
- % use typeinfo liveness for them,
- % so that deep_copy and accurate gc
- % have the RTTI they need for
- % copying closures.
- %
- % Note that any non-local procedure
- % must be considered as having its
- % address taken, since it is
- % possible that some other module
- % may do so.
+ % Allocation of variables to stack slots.
stack_slots :: stack_slots,
- % Allocation of variables
- % to stack slots.
+ % The calling convention of each argument: information computed
+ % by arg_info.m (based on the modes etc.) and used by code
+ % generation to determine how each argument should be passed.
arg_pass_info :: maybe(list(arg_info)),
- % The calling convention of
- % each argument: information
- % computed by arg_info.m (based on
- % the modes etc.) and used by code
- % generation to determine how
- % each argument should be passed.
+ % The initial liveness, for code generation.
initial_liveness :: liveness_info,
- % The initial liveness, for code
- % generation.
+ % True iff tracing is enabled, this is a procedure that lives
+ % on the det stack, and the code of this procedure may create
+ % a frame on the det stack. (Only in these circumstances do we
+ % need to reserve a stack slot to hold the value of maxfr
+ % at the call, for use in implementing retry.) This slot
+ % is used only with the LLDS backend XXX. Its value is set
+ % during the live_vars pass; it is invalid before then.
need_maxfr_slot :: bool,
- % True iff tracing is enabled,
- % this is a procedure that lives
- % on the det stack, and the code
- % of this procedure may create
- % a frame on the det stack.
- % (Only in these circumstances
- % do we need to reserve a stack
- % slot to hold the value of maxfr
- % at the call, for use in
- % implementing retry.)
- % This slot is used only with
- % the LLDS backend XXX.
- % Its value is set during the
- % live_vars pass; it is invalid
- % before then.
+ % If the procedure's evaluation method is memo, loopcheck or
+ % minimal, this slot identifies the variable that holds the tip
+ % of the call table. Otherwise, this field will be set to `no'.
+ %
+ % Tabled procedures record, in the data structure identified
+ % by this variable, that the call is active. When performing
+ % a retry across such a procedure, we must reset the state
+ % of the call; if we don't, the retried call will find the
+ % active call and report an infinite loop error.
+ %
+ % Such resetting of course requires the debugger to know
+ % whether the procedure has reached the call table tip yet.
+ % Therefore when binding this variable, the code generator
+ % of the relevant backend must record this fact in a place
+ % accessible to the debugger, if debugging is enabled.
call_table_tip :: maybe(prog_var),
- % If the procedure's evaluation
- % method is memo, loopcheck or
- % minimal, this slot identifies the
- % variable that holds the tip
- % of the call table. Otherwise,
- % this field will be set to `no'.
- %
- % Tabled procedures record, in the
- % data structure identified by this
- % variable, that the call is
- % active. When performing a retry
- % across such a procedure, we must
- % reset the state of the call;
- % if we don't, the retried call
- % will find the active call and
- % report an infinite loop error.
- %
- % Such resetting of course requires
- % the debugger to know whether the
- % procedure has reached the call
- % table tip yet. Therefore when
- % binding this variable, the code
- % generator of the relevant backend
- % must record this fact in a place
- % accessible to the debugger,
- % if debugging is enabled.
+ % If set, it means that procedure has been subject to a tabling
+ % transformation, either I/O tabling or the regular kind.
+ % In the former case, the argument will contain all the
+ % information we need to display I/O actions involving
+ % this procedure; in the latter case, it will contain
+ % all the information we need to display the call tables,
+ % answer tables and answer blocks of the procedure.
+ % XXX For now, the compiler fully supports only procedures
+ % whose arguments are all either ints, floats or strings.
+ % However, this is still sufficient for debugging most problems
+ % in the tabling system.
maybe_table_info :: maybe(proc_table_info),
- % If set, it means that procedure
- % has been subject to a tabling
- % transformation, either I/O
- % tabling or the regular kind.
- % In the former case, the argument
- % will contain all the information
- % we need to display I/O actions
- % involving this procedure; in the
- % latter case, it will contain
- % all the information we need
- % to display the call tables,
- % answer tables and answer blocks
- % of the procedure.
- % XXX For now, the compiler fully
- % supports only procedures whose
- % arguments are all either ints,
- % floats or strings. However, this
- % is still sufficient for debugging
- % most problems in the tabling
- % system.
+
+ table_attributes :: maybe(table_attributes),
maybe_deep_profile_proc_info :: maybe(deep_profile_proc_info),
+ % If set, it means this procedure was created from another
+ % procedure by the untupling transformation. This slot records
+ % which of the procedure's arguments were derived from which
+ % arguments in the original procedure.
maybe_untuple_info :: maybe(untuple_proc_info),
- % If set, it means this procedure
- % was created from another
- % procedure by the untupling
- % transformation. This slot records
- % which of the procedure's
- % arguments were derived from which
- % arguments in the original
- % procedure.
- maybe_structure_sharing :: maybe(structure_sharing_domain)
- % Structure sharing information
- % as obtained by the structure
+ % Structure sharing information as obtained by the structure
% sharing analysis.
+ maybe_structure_sharing :: maybe(structure_sharing_domain)
).
proc_info_init(MContext, Arity, Types, DeclaredModes, Modes, MaybeArgLives,
- MaybeDet, IsAddressTaken, NewProc) :-
+ MaybeDet, IsAddressTaken, ProcInfo) :-
% Some parts of the procedure aren't known yet. We initialize them
% to any old garbage which we will later throw away.
@@ -2118,11 +2056,12 @@
CanProcess = yes,
rtti_varmaps_init(RttiVarMaps),
Term2Info = term_constr_main.term2_info_init,
- NewProc = proc_info(MContext, BodyVarSet, BodyTypes, HeadVars, InstVarSet,
+ ProcSubInfo = proc_sub_info(no, no, Term2Info, IsAddressTaken, StackSlots,
+ ArgInfo, InitialLiveness, no, no, no, no, no, no, no),
+ ProcInfo = proc_info(MContext, BodyVarSet, BodyTypes, HeadVars, InstVarSet,
DeclaredModes, Modes, no, MaybeArgLives, MaybeDet, InferredDet,
ClauseBody, CanProcess, ModeErrors, RttiVarMaps, eval_normal,
- proc_sub_info(no, no, Term2Info, IsAddressTaken, StackSlots,
- ArgInfo, InitialLiveness, no, no, no, no, no, no)).
+ ProcSubInfo).
proc_info_set(Context, BodyVarSet, BodyTypes, HeadVars, InstVarSet, HeadModes,
HeadLives, DeclaredDetism, InferredDetism, Goal, CanProcess,
@@ -2130,7 +2069,8 @@
IsAddressTaken, StackSlots, ArgInfo, Liveness, ProcInfo) :-
ModeErrors = [],
ProcSubInfo = proc_sub_info(ArgSizes, Termination, Termination2,
- IsAddressTaken, StackSlots, ArgInfo, Liveness, no, no, no, no, no, no),
+ IsAddressTaken, StackSlots, ArgInfo, Liveness, no, no, no, no,
+ no, no, no),
ProcInfo = proc_info(Context, BodyVarSet, BodyTypes, HeadVars,
InstVarSet, no, HeadModes, no, HeadLives,
DeclaredDetism, InferredDetism, Goal, CanProcess, ModeErrors,
@@ -2151,7 +2091,7 @@
ModeErrors = [],
Term2Info = term_constr_main.term2_info_init,
ProcSubInfo = proc_sub_info(no, no, Term2Info, IsAddressTaken,
- StackSlots, no, Liveness, no, no, no, no, no, no),
+ StackSlots, no, Liveness, no, no, no, no, no, no, no),
ProcInfo = proc_info(Context, VarSet, VarTypes, HeadVars,
InstVarSet, no, HeadModes, no, MaybeHeadLives,
MaybeDeclaredDetism, Detism, Goal, yes, ModeErrors,
@@ -2189,6 +2129,7 @@
proc_info_get_need_maxfr_slot(PI, PI ^ proc_sub_info ^ need_maxfr_slot).
proc_info_get_call_table_tip(PI, PI ^ proc_sub_info ^ call_table_tip).
proc_info_get_maybe_proc_table_info(PI, PI ^ proc_sub_info ^ maybe_table_info).
+proc_info_get_table_attributes(PI, PI ^ proc_sub_info ^ table_attributes).
proc_info_get_maybe_deep_profile_info(PI,
PI ^ proc_sub_info ^ maybe_deep_profile_proc_info).
proc_info_get_maybe_untuple_info(PI,
@@ -2223,6 +2164,8 @@
PI ^ proc_sub_info ^ call_table_tip := CTT).
proc_info_set_maybe_proc_table_info(MTI, PI,
PI ^ proc_sub_info ^ maybe_table_info := MTI).
+proc_info_set_table_attributes(TA, PI,
+ PI ^ proc_sub_info ^ table_attributes := TA).
proc_info_set_maybe_deep_profile_info(DPI, PI,
PI ^ proc_sub_info ^ maybe_deep_profile_proc_info := DPI).
proc_info_set_maybe_untuple_info(MUI, PI,
@@ -2750,7 +2693,7 @@
;
Valid = yes
).
-valid_determinism_for_eval_method(eval_memo(_), Detism) = Valid :-
+valid_determinism_for_eval_method(eval_memo, Detism) = Valid :-
determinism_components(Detism, _, MaxSoln),
( MaxSoln = at_most_zero ->
Valid = no
@@ -2778,37 +2721,37 @@
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_memo(_)) = 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_memo(_)) = yes.
+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_memo(_)) = 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_memo(_)) = 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_memo(_)) = yes.
+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_memo(_), 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/inlining.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inlining.m,v
retrieving revision 1.138
diff -u -b -r1.138 inlining.m
--- compiler/inlining.m 29 Mar 2006 08:06:49 -0000 1.138
+++ compiler/inlining.m 30 May 2006 04:51:51 -0000
@@ -962,7 +962,7 @@
:- pred ok_to_inline_language(foreign_language::in, compilation_target::in)
is semidet.
-ok_to_inline_language(c, c).
+ok_to_inline_language(lang_c, target_c).
% ok_to_inline_language(il, il). %
% XXX we need to fix the handling of parameter marhsalling for inlined code
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.199
diff -u -b -r1.199 intermod.m
--- compiler/intermod.m 20 Apr 2006 05:36:54 -0000 1.199
+++ compiler/intermod.m 30 May 2006 04:53:08 -0000
@@ -380,11 +380,11 @@
list(clause)::in) is semidet.
clauses_contain_noninlinable_foreign_code(Target, [C | _Cs]) :-
- Target = il,
+ Target = target_il,
Lang = C ^ clause_lang,
Lang = foreign_language(ForeignLang),
- ( ForeignLang = csharp
- ; ForeignLang = managed_cplusplus
+ ( ForeignLang = lang_csharp
+ ; ForeignLang = lang_managed_cplusplus
).
clauses_contain_noninlinable_foreign_code(Target, [_ | Cs]) :-
clauses_contain_noninlinable_foreign_code(Target, Cs).
@@ -1035,22 +1035,38 @@
% for the other definitions to be present (e.g. when testing compiling
% a module to IL when the workspace was compiled to C).
%
- ( ( Target = c ; Target = asm ) ->
+ (
+ ( Target = target_c
+ ; Target = target_asm
+ ),
resolve_foreign_type_body_overloading_2(ModuleInfo, TypeCtor,
MaybeC0, MaybeC, !Info)
;
+ ( Target = target_il
+ ; Target = target_java
+ ),
MaybeC = MaybeC0
),
- ( Target = il ->
+ (
+ Target = target_il,
resolve_foreign_type_body_overloading_2(ModuleInfo, TypeCtor,
MaybeIL0, MaybeIL, !Info)
;
+ ( Target = target_c
+ ; Target = target_asm
+ ; Target = target_java
+ ),
MaybeIL = MaybeIL0
),
- ( Target = java ->
+ (
+ Target = target_java,
resolve_foreign_type_body_overloading_2(ModuleInfo, TypeCtor,
MaybeJava0, MaybeJava, !Info)
;
+ ( Target = target_c
+ ; Target = target_asm
+ ; Target = target_il
+ ),
MaybeJava = MaybeJava0
).
Index: compiler/layout.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/layout.m,v
retrieving revision 1.27
diff -u -b -r1.27 layout.m
--- compiler/layout.m 8 May 2006 03:36:00 -0000 1.27
+++ compiler/layout.m 12 May 2006 04:01:22 -0000
@@ -95,15 +95,6 @@
table_io_decl_ptis :: rval,
% pseudo-typeinfos for headvars
table_io_decl_type_params :: rval
- )
- ; table_gen_data(
- table_gen_proc_ptr :: rtti_proc_label,
- table_gen_num_inputs :: int,
- table_gen_num_outputs :: int,
- table_gen_steps :: list(table_trie_step),
- table_gen_ptis :: rval,
- % pseudo-typeinfos for headvars
- table_gen_type_params :: rval
).
:- type label_var_info
@@ -161,7 +152,7 @@
% The procedure body represented as
% a list of bytecodes.
- maybe_table_info :: maybe(layout_name),
+ maybe_table_info :: maybe(data_addr),
head_var_nums :: list(int),
% The variable numbers of the
% head variables, including the
@@ -209,9 +200,6 @@
% the string table) for a procedure layout structure.
; proc_layout_body_bytecode(rtti_proc_label)
; table_io_decl(rtti_proc_label)
- ; table_gen_info(rtti_proc_label)
- ; table_gen_enum_params(rtti_proc_label)
- ; table_gen_steps(rtti_proc_label)
; closure_proc_id(proc_label, int, proc_label)
; file_layout(module_name, int)
; file_layout_line_number_vector(module_name, int)
Index: compiler/layout_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/layout_out.m,v
retrieving revision 1.66
diff -u -b -r1.66 layout_out.m
--- compiler/layout_out.m 8 May 2006 03:36:00 -0000 1.66
+++ compiler/layout_out.m 6 Jun 2006 15:01:04 -0000
@@ -152,11 +152,6 @@
PTIVectorRval, TypeParamsRval),
output_table_io_decl(RttiProcLabel, Kind, NumPTIs,
PTIVectorRval, TypeParamsRval, !DeclSet, !IO)
- ;
- Data = table_gen_data(RttiProcLabel, NumInputs, NumOutputs,
- Steps, PTIVectorRval, TypeParamsRval),
- output_table_gen(RttiProcLabel, NumInputs, NumOutputs, Steps,
- PTIVectorRval, TypeParamsRval, !DeclSet, !IO)
).
%-----------------------------------------------------------------------------%
@@ -201,9 +196,6 @@
;
Data = table_io_decl_data(RttiProcLabel, _, _, _, _),
LayoutName = table_io_decl(RttiProcLabel)
- ;
- Data = table_gen_data(RttiProcLabel, _, _, _, _, _),
- LayoutName = table_gen_info(RttiProcLabel)
).
:- pred output_layout_decl(layout_name::in, decl_set::in, decl_set::out,
@@ -247,32 +239,36 @@
% mercury_data_prefix duplicates it, because there is no simply way
% to make the MR_init_entryl_sl macro delete that prefix from the
% entry label's name to get the name of its layout structure.
- output_proc_label(make_proc_label_from_rtti(RttiProcLabel), yes, !IO)
+ output_proc_label(make_proc_label_from_rtti(RttiProcLabel), !IO)
;
Data = proc_layout_exec_trace(RttiProcLabel),
io.write_string(mercury_data_prefix, !IO),
io.write_string("_proc_layout_exec_trace__", !IO),
- output_proc_label(make_proc_label_from_rtti(RttiProcLabel), no, !IO)
+ output_proc_label_no_prefix(make_proc_label_from_rtti(RttiProcLabel),
+ !IO)
;
Data = proc_layout_head_var_nums(RttiProcLabel),
io.write_string(mercury_data_prefix, !IO),
io.write_string("_head_var_nums__", !IO),
- output_proc_label(make_proc_label_from_rtti(RttiProcLabel), no, !IO)
+ output_proc_label_no_prefix(make_proc_label_from_rtti(RttiProcLabel),
+ !IO)
;
Data = proc_layout_var_names(RttiProcLabel),
io.write_string(mercury_data_prefix, !IO),
io.write_string("_var_names__", !IO),
- output_proc_label(make_proc_label_from_rtti(RttiProcLabel), no, !IO)
+ output_proc_label_no_prefix(make_proc_label_from_rtti(RttiProcLabel),
+ !IO)
;
Data = proc_layout_body_bytecode(RttiProcLabel),
io.write_string(mercury_data_prefix, !IO),
io.write_string("_body_bytecode__", !IO),
- output_proc_label(make_proc_label_from_rtti(RttiProcLabel), no, !IO)
+ output_proc_label_no_prefix(make_proc_label_from_rtti(RttiProcLabel),
+ !IO)
;
Data = closure_proc_id(CallerProcLabel, SeqNo, _),
io.write_string(mercury_data_prefix, !IO),
io.write_string("_closure_layout__", !IO),
- output_proc_label(CallerProcLabel, no, !IO),
+ output_proc_label_no_prefix(CallerProcLabel, !IO),
io.write_string("_", !IO),
io.write_int(SeqNo, !IO)
;
@@ -334,37 +330,19 @@
io.write_string(mercury_data_prefix, !IO),
io.write_string("_proc_static__", !IO),
ProcLabel = make_proc_label_from_rtti(RttiProcLabel),
- output_proc_label(ProcLabel, no, !IO)
+ output_proc_label_no_prefix(ProcLabel, !IO)
;
Data = proc_static_call_sites(RttiProcLabel),
io.write_string(mercury_data_prefix, !IO),
io.write_string("_proc_static_call_sites__", !IO),
ProcLabel = make_proc_label_from_rtti(RttiProcLabel),
- output_proc_label(ProcLabel, no, !IO)
+ output_proc_label_no_prefix(ProcLabel, !IO)
;
Data = table_io_decl(RttiProcLabel),
io.write_string(mercury_data_prefix, !IO),
io.write_string("_table_io_decl__", !IO),
ProcLabel = make_proc_label_from_rtti(RttiProcLabel),
- output_proc_label(ProcLabel, no, !IO)
- ;
- Data = table_gen_info(RttiProcLabel),
- io.write_string(mercury_data_prefix, !IO),
- io.write_string("_table_gen__", !IO),
- ProcLabel = make_proc_label_from_rtti(RttiProcLabel),
- output_proc_label(ProcLabel, no, !IO)
- ;
- Data = table_gen_enum_params(RttiProcLabel),
- io.write_string(mercury_data_prefix, !IO),
- io.write_string("_table_enum_params__", !IO),
- ProcLabel = make_proc_label_from_rtti(RttiProcLabel),
- output_proc_label(ProcLabel, no, !IO)
- ;
- Data = table_gen_steps(RttiProcLabel),
- io.write_string(mercury_data_prefix, !IO),
- io.write_string("_table_steps__", !IO),
- ProcLabel = make_proc_label_from_rtti(RttiProcLabel),
- output_proc_label(ProcLabel, no, !IO)
+ output_proc_label_no_prefix(ProcLabel, !IO)
).
output_layout_name_storage_type_name(Data, BeingDefined, !IO) :-
@@ -421,10 +399,10 @@
Data = closure_proc_id(CallerProcLabel, SeqNo, ClosureProcLabel),
io.write_string("static const ", !IO),
(
- ClosureProcLabel = proc(_, _, _, _, _, _),
+ ClosureProcLabel = ordinary_proc_label(_, _, _, _, _, _),
io.write_string("MR_User_Closure_Id\n", !IO)
;
- ClosureProcLabel = special_proc(_, _, _, _, _, _),
+ ClosureProcLabel = special_proc_label(_, _, _, _, _, _),
io.write_string("MR_UCI_Closure_Id\n", !IO)
),
output_layout_name(closure_proc_id(CallerProcLabel, SeqNo,
@@ -485,20 +463,6 @@
Data = table_io_decl(RttiProcLabel),
io.write_string("static const MR_Table_Io_Decl ", !IO),
output_layout_name(table_io_decl(RttiProcLabel), !IO)
- ;
- Data = table_gen_info(RttiProcLabel),
- io.write_string("static const MR_Table_Gen ", !IO),
- output_layout_name(table_gen_info(RttiProcLabel), !IO)
- ;
- Data = table_gen_enum_params(RttiProcLabel),
- io.write_string("static const MR_Integer ", !IO),
- output_layout_name(table_gen_enum_params(RttiProcLabel), !IO),
- io.write_string("[]", !IO)
- ;
- Data = table_gen_steps(RttiProcLabel),
- io.write_string("static const MR_Table_Trie_Step ", !IO),
- output_layout_name(table_gen_steps(RttiProcLabel), !IO),
- io.write_string("[]", !IO)
).
layout_name_would_include_code_addr(label_layout(_, _, _)) = no.
@@ -520,9 +484,6 @@
layout_name_would_include_code_addr(proc_static(_)) = no.
layout_name_would_include_code_addr(proc_static_call_sites(_)) = no.
layout_name_would_include_code_addr(table_io_decl(_)) = no.
-layout_name_would_include_code_addr(table_gen_info(_)) = no.
-layout_name_would_include_code_addr(table_gen_enum_params(_)) = no.
-layout_name_would_include_code_addr(table_gen_steps(_)) = no.
:- func label_vars_to_type(label_vars) = string.
@@ -630,7 +591,7 @@
io.write_string("\n", !IO),
io.write_string(Macro, !IO),
io.write_string("(", !IO),
- output_proc_label(ProcLabel, no, !IO),
+ output_proc_label_no_prefix(ProcLabel, !IO),
io.write_string(",\n", !IO),
io.write_int(LabelNum, !IO),
io.write_string(", ", !IO),
@@ -784,8 +745,8 @@
Kind = proc_layout_proc_id(proc_label_user_or_uci(ProcLabel))
).
-proc_label_user_or_uci(proc(_, _, _, _, _, _)) = user.
-proc_label_user_or_uci(special_proc(_, _, _, _, _, _)) = uci.
+proc_label_user_or_uci(ordinary_proc_label(_, _, _, _, _, _)) = user.
+proc_label_user_or_uci(special_proc_label(_, _, _, _, _, _)) = uci.
:- pred output_proc_layout_data_defn_start(rtti_proc_label::in,
proc_layout_kind::in, proc_layout_stack_traversal::in,
@@ -886,7 +847,7 @@
output_layout_decl(module_layout(ModuleName), !DeclSet, !IO),
(
MaybeTableInfo = yes(TableInfo),
- output_layout_decl(TableInfo, !DeclSet, !IO)
+ output_data_addr_decls(TableInfo, !DeclSet, !IO)
;
MaybeTableInfo = no
).
@@ -971,19 +932,11 @@
output_layout_name(proc_layout_body_bytecode(RttiProcLabel), !IO)
),
io.write_string(",\n", !IO),
- (
- MaybeCallTableSlot = yes(_),
- io.write_string("&", !IO),
- output_tabling_pointer_var_name(ProcLabel, !IO)
- ;
- MaybeCallTableSlot = no,
- io.write_string("NULL", !IO)
- ),
- io.write_string(",\n{ ", !IO),
+ io.write_string("0,\n{ ", !IO),
(
MaybeTableInfo = yes(TableInfo),
io.write_string("(const void *) &", !IO),
- output_layout_name(TableInfo, !IO)
+ output_data_addr(TableInfo, !IO)
;
MaybeTableInfo = no,
io.write_string("NULL", !IO)
@@ -1027,17 +980,7 @@
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(CallStrictness)) = Str :-
- (
- CallStrictness = all_strict,
- Str = "MR_EVAL_METHOD_MEMO_STRICT"
- ;
- CallStrictness = all_fast_loose,
- Str = "MR_EVAL_METHOD_MEMO_FAST_LOOSE"
- ;
- CallStrictness = specified(_),
- Str = "MR_EVAL_METHOD_MEMO_SPECIFIED"
- ).
+eval_method_to_c_string(eval_memo) = "MR_EVAL_METHOD_MEMO".
eval_method_to_c_string(eval_minimal(MinimalMethod)) = Str :-
(
MinimalMethod = stack_copy,
@@ -1140,8 +1083,8 @@
output_proc_id(ProcLabel, Origin, !IO) :-
(
- ProcLabel = proc(DefiningModule, PredOrFunc, DeclaringModule,
- PredName0, Arity, Mode),
+ ProcLabel = ordinary_proc_label(DefiningModule, PredOrFunc,
+ DeclaringModule, PredName0, Arity, Mode),
PredName = origin_name(Origin, PredName0),
sym_name_to_string(DefiningModule, DefiningModuleStr),
sym_name_to_string(DeclaringModule, DeclaringModuleStr),
@@ -1158,7 +1101,7 @@
io.write_int(Mode, !IO),
io.write_string("\n", !IO)
;
- ProcLabel = special_proc(DefiningModule, SpecialPredId,
+ ProcLabel = special_proc_label(DefiningModule, SpecialPredId,
TypeModule, TypeName, TypeArity, Mode),
TypeCtor = type_ctor(qualified(TypeModule, TypeName), TypeArity),
PredName0 = special_pred_name(SpecialPredId, TypeCtor),
@@ -1363,7 +1306,7 @@
( LayoutName = proc_layout(RttiProcLabel, _) ->
ProcLabel = make_proc_label_from_rtti(RttiProcLabel),
io.write_string("MR_PROC_LAYOUT1(", !IO),
- output_proc_label(ProcLabel, no, !IO),
+ output_proc_label_no_prefix(ProcLabel, !IO),
io.write_string(")\n", !IO)
;
unexpected(this_file,
@@ -1573,7 +1516,7 @@
io.write_string("MR_LABEL_LAYOUT", !IO),
io.write_int(list.length(LabelNums), !IO),
io.write_string("(", !IO),
- output_proc_label(ProcLabel, no, !IO),
+ output_proc_label_no_prefix(ProcLabel, !IO),
io.write_string(",", !IO),
io.write_list(LabelNums, ",", io.write_int, !IO),
io.write_string(")\n", !IO),
@@ -1792,140 +1735,6 @@
io.write_string("\n};\n", !IO),
decl_set_insert(decl_data_addr(layout_addr(LayoutName)), !DeclSet).
-:- pred output_table_gen(rtti_proc_label::in, int::in, int::in,
- list(table_trie_step)::in, rval::in, rval::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
-
-output_table_gen(RttiProcLabel, NumInputs, NumOutputs, Steps,
- PTIVectorRval, TypeParamsRval, !DeclSet, !IO) :-
- output_table_gen_steps_table(RttiProcLabel, Steps, MaybeEnumParams,
- !DeclSet, !IO),
- output_table_gen_enum_params_table(RttiProcLabel, MaybeEnumParams,
- !DeclSet, !IO),
- output_rval_decls(PTIVectorRval, !DeclSet, !IO),
- LayoutName = table_gen_info(RttiProcLabel),
- io.write_string("\n", !IO),
- output_layout_name_storage_type_name(LayoutName, yes, !IO),
- io.write_string(" = {\n", !IO),
- io.write_int(NumInputs, !IO),
- io.write_string(",\n", !IO),
- io.write_int(NumOutputs, !IO),
- io.write_string(",\n", !IO),
- output_layout_name(table_gen_steps(RttiProcLabel), !IO),
- io.write_string(",\n", !IO),
- output_layout_name(table_gen_enum_params(RttiProcLabel), !IO),
- io.write_string(",\n(const MR_PseudoTypeInfo *)\n", !IO),
- output_rval(PTIVectorRval, !IO),
- io.write_string(",\n(const MR_Type_Param_Locns *)\n", !IO),
- output_rval(TypeParamsRval, !IO),
- io.write_string("\n};\n", !IO),
- decl_set_insert(decl_data_addr(layout_addr(LayoutName)), !DeclSet).
-
-:- pred output_table_gen_steps_table(rtti_proc_label::in,
- list(table_trie_step)::in, list(maybe(int))::out,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
-
-output_table_gen_steps_table(RttiProcLabel, Steps, MaybeEnumParams,
- !DeclSet, !IO) :-
- LayoutName = table_gen_steps(RttiProcLabel),
- io.write_string("\n", !IO),
- output_layout_name_storage_type_name(LayoutName, yes, !IO),
- io.write_string(" = {\n", !IO),
- output_table_gen_steps(Steps, MaybeEnumParams, !IO),
- io.write_string("};\n", !IO),
- decl_set_insert(decl_data_addr(layout_addr(LayoutName)), !DeclSet).
-
-:- pred output_table_gen_steps(list(table_trie_step)::in,
- list(maybe(int))::out, io::di, io::uo) is det.
-
-output_table_gen_steps([], [], !IO).
-output_table_gen_steps([Step | Steps], [MaybeEnumParam | MaybeEnumParams],
- !IO) :-
- (
- Step = table_trie_step_dummy,
- StepType = "MR_TABLE_STEP_DUMMY",
- MaybeEnumParam = no
- ;
- Step = table_trie_step_int,
- StepType = "MR_TABLE_STEP_INT",
- MaybeEnumParam = no
- ;
- Step = table_trie_step_char,
- StepType = "MR_TABLE_STEP_CHAR",
- MaybeEnumParam = no
- ;
- Step = table_trie_step_string,
- StepType = "MR_TABLE_STEP_STRING",
- MaybeEnumParam = no
- ;
- Step = table_trie_step_float,
- StepType = "MR_TABLE_STEP_FLOAT",
- MaybeEnumParam = no
- ;
- Step = table_trie_step_enum(EnumRange),
- StepType = "MR_TABLE_STEP_ENUM",
- MaybeEnumParam = yes(EnumRange)
- ;
- Step = table_trie_step_user(_),
- StepType = "MR_TABLE_STEP_USER",
- MaybeEnumParam = no
- ;
- Step = table_trie_step_user_fast_loose(_),
- StepType = "MR_TABLE_STEP_USER_FAST_LOOSE",
- MaybeEnumParam = no
- ;
- Step = table_trie_step_poly,
- StepType = "MR_TABLE_STEP_POLY",
- MaybeEnumParam = no
- ;
- Step = table_trie_step_poly_fast_loose,
- StepType = "MR_TABLE_STEP_POLY_FAST_LOOSE",
- MaybeEnumParam = no
- ;
- Step = table_trie_step_typeinfo,
- StepType = "MR_TABLE_STEP_TYPEINFO",
- MaybeEnumParam = no
- ;
- Step = table_trie_step_typeclassinfo,
- StepType = "MR_TABLE_STEP_TYPECLASSINFO",
- MaybeEnumParam = no
- ;
- Step = table_trie_step_promise_implied,
- StepType = "MR_TABLE_STEP_PROMISE_IMPLIED",
- MaybeEnumParam = no
- ),
- io.write_string(StepType, !IO),
- io.write_string(",\n", !IO),
- output_table_gen_steps(Steps, MaybeEnumParams, !IO).
-
-:- pred output_table_gen_enum_params_table(rtti_proc_label::in,
- list(maybe(int))::in, decl_set::in, decl_set::out, io::di, io::uo) is det.
-
-output_table_gen_enum_params_table(RttiProcLabel, MaybeEnumParams,
- !DeclSet, !IO) :-
- LayoutName = table_gen_enum_params(RttiProcLabel),
- io.write_string("\n", !IO),
- output_layout_name_storage_type_name(LayoutName, yes, !IO),
- io.write_string(" = {\n", !IO),
- output_table_gen_enum_params(MaybeEnumParams, !IO),
- io.write_string("};\n", !IO),
- decl_set_insert(decl_data_addr(layout_addr(LayoutName)), !DeclSet).
-
-:- pred output_table_gen_enum_params(list(maybe(int))::in,
- io::di, io::uo) is det.
-
-output_table_gen_enum_params([], !IO).
-output_table_gen_enum_params([MaybeEnumParam | MaybeEnumParams], !IO) :-
- (
- MaybeEnumParam = no,
- io.write_int(-1, !IO)
- ;
- MaybeEnumParam = yes(EnumRange),
- io.write_int(EnumRange, !IO)
- ),
- io.write_string(",\n", !IO),
- output_table_gen_enum_params(MaybeEnumParams, !IO).
-
%-----------------------------------------------------------------------------%
output_pred_or_func(PredOrFunc, !IO) :-
Index: compiler/llds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds.m,v
retrieving revision 1.331
diff -u -b -r1.331 llds.m
--- compiler/llds.m 8 May 2006 03:36:00 -0000 1.331
+++ compiler/llds.m 5 Jun 2006 08:29:15 -0000
@@ -69,7 +69,7 @@
cfile_foreign_decl :: foreign_decl_info,
cfile_foreign_code :: list(user_foreign_code),
cfile_foreign_export :: list(foreign_export),
- cfile_vars :: list(comp_gen_c_var),
+ cfile_vars :: list(tabling_info_struct),
cfile_scalar_common_data :: list(scalar_common_data_array),
cfile_vector_common_data :: list(vector_common_data_array),
cfile_rtti_data :: list(rtti_data),
@@ -80,11 +80,25 @@
).
% Global variables generated by the compiler.
-:- type comp_gen_c_var
- ---> tabling_pointer_var(
- module_name, % The basename of this C file.
- proc_label % The id of the procedure whose table
- % this variable represents.
+:- type tabling_info_struct
+ ---> tabling_info_struct(
+ tis_module_name :: module_name,
+ % The basename of this C file.
+ tis_proc_label :: proc_label,
+ % The id of the procedure whose
+ % table this structure represents.
+ tis_eval_method :: eval_method,
+
+ tis_num_inputs :: int,
+ tis_num_outputs :: int,
+ tis_input_steps :: list(table_trie_step),
+ tis_maybe_output_steps :: maybe(list(table_trie_step)),
+ tis_ptis :: rval,
+ % Pseudo-typeinfos for headvars.
+ tis_type_params :: rval,
+ % Where to fill the ptis in from.
+ tis_size_limit :: maybe(int),
+ tis_stats :: bool
).
:- type common_cell_type
@@ -883,10 +897,7 @@
% identified by a sequence number. The first integer is this
% sequence number; the second is the offset in the array.
- ; tabling_pointer(proc_label).
- % A variable that contains a pointer that points to the table
- % used to implement memoization, loopcheck or minimal model
- % semantics for the given procedure.
+ ; proc_tabling_ref(proc_label, proc_tabling_struct_id).
:- type reg_type
---> r % general-purpose (integer) regs
@@ -1221,8 +1232,10 @@
get_proc_label(entry(_, ProcLabel)) = ProcLabel.
get_proc_label(internal(_, ProcLabel)) = ProcLabel.
-get_defining_module_name(proc(ModuleName, _, _, _, _, _)) = ModuleName.
-get_defining_module_name(special_proc(ModuleName, _, _, _, _, _)) = ModuleName.
+get_defining_module_name(ordinary_proc_label(ModuleName, _, _, _, _, _))
+ = ModuleName.
+get_defining_module_name(special_proc_label(ModuleName, _, _, _, _, _))
+ = ModuleName.
%-----------------------------------------------------------------------------%
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.279
diff -u -b -r1.279 llds_out.m
--- compiler/llds_out.m 12 May 2006 08:32:06 -0000 1.279
+++ compiler/llds_out.m 6 Jun 2006 15:01:37 -0000
@@ -25,6 +25,7 @@
:- import_module hlds.hlds_module.
:- import_module libs.globals.
:- import_module ll_backend.llds.
+:- import_module mdbcomp.prim_data.
:- import_module parse_tree.prog_data.
:- import_module bool.
@@ -76,6 +77,8 @@
:- pred output_data_addr(data_addr::in, io::di, io::uo) is det.
+:- func proc_tabling_info_var_name(proc_label) = string.
+
% c_data_linkage_string(DefaultLinkage, BeingDefined):
%
% Return a C string that gives the storage class appropriate for the
@@ -196,7 +199,6 @@
:- import_module ll_backend.layout_out.
:- import_module ll_backend.pragma_c_gen.
:- import_module ll_backend.rtti_out.
-:- import_module mdbcomp.prim_data.
:- import_module parse_tree.mercury_to_mercury.
:- import_module parse_tree.modules.
:- import_module parse_tree.prog_foreign.
@@ -260,6 +262,7 @@
:- pred output_c_file_mercury_headers(io::di, io::uo) is det.
output_c_file_mercury_headers(!IO) :-
+ io.write_string("#define MR_ALLOW_RESET\n", !IO),
globals.io_get_trace_level(TraceLevel, !IO),
( given_trace_level_is_none(TraceLevel) = no ->
io.write_string("#include ""mercury_imp.h""\n", !IO),
@@ -289,8 +292,9 @@
output_single_c_file(CFile, ComplexityProcs, StackLayoutLabels,
FileStream, !DeclSet, !IO) :-
CFile = c_file(ModuleName, C_HeaderLines, UserForeignCode, Exports,
- Vars, ScalarCommonDatas, VectorCommonDatas, RttiDatas, LayoutDatas0,
- Modules, UserInitPredCNames, UserFinalPredCNames),
+ TablingInfoStructs, ScalarCommonDatas, VectorCommonDatas,
+ RttiDatas, LayoutDatas0, Modules,
+ UserInitPredCNames, UserFinalPredCNames),
library.version(Version),
io.set_output_stream(FileStream, OutputStream, !IO),
module_name_to_file_name(ModuleName, ".m", no, SourceFileName, !IO),
@@ -311,7 +315,7 @@
!DeclSet, !IO),
output_rtti_data_decl_list(RttiDatas, !DeclSet, !IO),
output_c_label_decls(StackLayoutLabels, Labels, !DeclSet, !IO),
- list.foldl2(output_comp_gen_c_var, Vars, !DeclSet, !IO),
+ list.foldl2(output_tabling_info_struct, TablingInfoStructs, !DeclSet, !IO),
list.foldl2(output_scalar_common_data_defn, ScalarCommonDatas,
!DeclSet, !IO),
list.foldl2(output_vector_common_data_defn, VectorCommonDatas,
@@ -325,7 +329,7 @@
list.foldl(io.write_string, Exports, !IO),
io.write_string("\n", !IO),
output_c_module_init_list(ModuleName, Modules, RttiDatas, LayoutDatas,
- Vars, ComplexityProcs, StackLayoutLabels, UserInitPredCNames,
+ ComplexityProcs, StackLayoutLabels, UserInitPredCNames,
UserFinalPredCNames, !DeclSet, !IO),
io.set_output_stream(OutputStream, _, !IO).
@@ -358,12 +362,11 @@
order_layout_datas_2(Layouts, !ProcLayouts, !LabelLayouts, !OtherLayouts).
:- pred output_c_module_init_list(module_name::in, list(comp_gen_c_module)::in,
- list(rtti_data)::in, list(layout_data)::in, list(comp_gen_c_var)::in,
- list(complexity_proc_info)::in, map(label, data_addr)::in,
- list(string)::in, list(string)::in, decl_set::in, decl_set::out,
- io::di, io::uo) is det.
+ list(rtti_data)::in, list(layout_data)::in, list(complexity_proc_info)::in,
+ map(label, data_addr)::in, list(string)::in, list(string)::in,
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
-output_c_module_init_list(ModuleName, Modules, RttiDatas, LayoutDatas, Vars,
+output_c_module_init_list(ModuleName, Modules, RttiDatas, LayoutDatas,
ComplexityProcs, StackLayoutLabels, InitPredNames, FinalPredNames,
!DeclSet, !IO) :-
MustInit = (pred(Module::in) is semidet :-
@@ -426,16 +429,6 @@
io.write_string("required_final(void);\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),
@@ -540,18 +533,6 @@
io.write_string("}\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),
@@ -570,6 +551,8 @@
list.member(Label, Labels),
map.search(StackLayoutLabels, Label, _).
+%-----------------------------------------------------------------------------%
+
:- pred output_init_bunch_defs(list(list(comp_gen_c_module))::in,
module_name::in, string::in, int::in, io::di, io::uo) is det.
@@ -777,13 +760,7 @@
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.
@@ -852,38 +829,322 @@
io.write_string("_bunch_", !IO),
io.write_int(Number, !IO).
-:- pred output_scalar_common_data_decl(scalar_common_data_array::in,
+%-----------------------------------------------------------------------------%
+
+:- pred output_comp_gen_c_module(map(label, data_addr)::in,
+ comp_gen_c_module::in, decl_set::in, decl_set::out, io::di, io::uo)
+ is det.
+
+output_comp_gen_c_module(StackLayoutLabels,
+ comp_gen_c_module(ModuleName, Procedures), !DeclSet, !IO) :-
+ io.write_string("\n", !IO),
+ list.foldl2(output_c_procedure_decls(StackLayoutLabels),
+ Procedures, !DeclSet, !IO),
+ io.write_string("\n", !IO),
+ io.write_string("MR_BEGIN_MODULE(", !IO),
+ io.write_string(ModuleName, !IO),
+ io.write_string(")\n", !IO),
+ gather_c_module_labels(Procedures, Labels),
+ output_c_label_inits(StackLayoutLabels, Labels, !IO),
+ io.write_string("MR_BEGIN_CODE\n", !IO),
+ io.write_string("\n", !IO),
+ globals.io_lookup_bool_option(auto_comments, PrintComments, !IO),
+ globals.io_lookup_bool_option(emit_c_loops, EmitCLoops, !IO),
+ list.foldl(output_c_procedure(PrintComments, EmitCLoops), Procedures, !IO),
+ io.write_string("MR_END_MODULE\n", !IO).
+
+%-----------------------------------------------------------------------------%
+
+:- pred output_tabling_info_struct(tabling_info_struct::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
-output_scalar_common_data_decl(ScalarCommonDataArray, !DeclSet, !IO) :-
- ScalarCommonDataArray = scalar_common_data_array(_ModuleName, CellType,
- TypeNum, _Values),
+output_tabling_info_struct(TablingInfoStruct, !DeclSet, !IO) :-
+ TablingInfoStruct = tabling_info_struct(ModuleName, ProcLabel, EvalMethod,
+ NumInputs, NumOutputs, InputSteps, MaybeOutputSteps, PTIVectorRval,
+ TypeParamsRval, MaybeSizeLimit, Stats),
+
+ InfoDataAddr = data_addr(ModuleName,
+ proc_tabling_ref(ProcLabel, tabling_info)),
+ InputStepsDataAddr = data_addr(ModuleName,
+ proc_tabling_ref(ProcLabel, tabling_input_steps)),
+ InputEnumParamsDataAddr = data_addr(ModuleName,
+ proc_tabling_ref(ProcLabel, tabling_input_enum_params)),
+ OutputStepsDataAddr = data_addr(ModuleName,
+ proc_tabling_ref(ProcLabel, tabling_output_steps)),
+ OutputEnumParamsDataAddr = data_addr(ModuleName,
+ proc_tabling_ref(ProcLabel, tabling_output_enum_params)),
+ TipsDataAddr = data_addr(ModuleName,
+ proc_tabling_ref(ProcLabel, tabling_tips)),
+
+ CallStatsDataName =
+ proc_tabling_ref(ProcLabel, tabling_call_stats),
+ PrevCallStatsDataName =
+ proc_tabling_ref(ProcLabel, tabling_prev_call_stats),
+ CallStatsDataAddr = data_addr(ModuleName, CallStatsDataName),
+ PrevCallStatsDataAddr = data_addr(ModuleName, PrevCallStatsDataName),
+
+ AnswerStatsDataName =
+ proc_tabling_ref(ProcLabel, tabling_answer_stats),
+ PrevAnswerStatsDataName =
+ proc_tabling_ref(ProcLabel, tabling_prev_answer_stats),
+ AnswerStatsDataAddr = data_addr(ModuleName, AnswerStatsDataName),
+ PrevAnswerStatsDataAddr = data_addr(ModuleName, PrevAnswerStatsDataName),
+
+ InputStepsDataName =
+ proc_tabling_ref(ProcLabel, tabling_input_steps),
+ output_table_steps_table(ModuleName, InputStepsDataName, InputSteps,
+ MaybeInputStepEnumParams, !DeclSet, !IO),
+ InputEnumParamsDataName =
+ proc_tabling_ref(ProcLabel, tabling_input_enum_params),
+ output_table_enum_params_table(ModuleName, InputEnumParamsDataName,
+ MaybeInputStepEnumParams, !DeclSet, !IO),
+ output_rval_decls(PTIVectorRval, !DeclSet, !IO),
+
+ (
+ MaybeOutputSteps = no
+ ;
+ MaybeOutputSteps = yes(OutputSteps),
+ OutputStepsDataName =
+ proc_tabling_ref(ProcLabel, tabling_output_steps),
+ output_table_steps_table(ModuleName, OutputStepsDataName, OutputSteps,
+ MaybeOutputStepEnumParams, !DeclSet, !IO),
+ OutputEnumParamsDataName =
+ proc_tabling_ref(ProcLabel, tabling_output_enum_params),
+ output_table_enum_params_table(ModuleName, OutputEnumParamsDataName,
+ MaybeOutputStepEnumParams, !DeclSet, !IO),
+ output_rval_decls(PTIVectorRval, !DeclSet, !IO)
+ ),
+
+ (
+ MaybeSizeLimit = no
+ ;
+ MaybeSizeLimit = yes(SizeLimit1),
+ output_table_tips(ModuleName, ProcLabel, SizeLimit1, !DeclSet, !IO)
+ ),
+
+ (
+ Stats = no
+ ;
+ Stats = yes,
+ output_table_stats(ModuleName, CallStatsDataName, NumInputs,
+ !DeclSet, !IO),
+ output_table_stats(ModuleName, PrevCallStatsDataName, NumInputs,
+ !DeclSet, !IO),
+ (
+ MaybeOutputSteps = no
+ ;
+ MaybeOutputSteps = yes(_),
+ output_table_stats(ModuleName, AnswerStatsDataName, NumOutputs,
+ !DeclSet, !IO),
+ output_table_stats(ModuleName, PrevAnswerStatsDataName, NumOutputs,
+ !DeclSet, !IO)
+ )
+ ),
+
+ io.write_string("\nstatic MR_ProcTableInfo ", !IO),
+ output_data_addr(InfoDataAddr, !IO),
+ io.write_string(" = {\n", !IO),
+ (
+ EvalMethod = eval_normal,
+ unexpected(this_file, "output_tabling_info_struct: eval_normal")
+ ;
+ EvalMethod = eval_loop_check,
+ io.write_string("MR_TABLE_TYPE_LOOPCHECK,\n", !IO)
+ ;
+ EvalMethod = eval_memo,
+ io.write_string("MR_TABLE_TYPE_MEMO,\n", !IO)
+ ;
+ EvalMethod = eval_minimal(stack_copy),
+ io.write_string("MR_TABLE_TYPE_MINIMAL_MODEL_STACK_COPY,\n", !IO)
+ ;
+ EvalMethod = eval_minimal(own_stacks),
+ io.write_string("MR_TABLE_TYPE_MINIMAL_MODEL_OWN_STACKS,\n", !IO)
+ ;
+ EvalMethod = eval_table_io(_, _),
+ unexpected(this_file, "output_tabling_info_struct: eval_table_io")
+ ),
+ io.write_int(NumInputs, !IO),
+ io.write_string(",\n", !IO),
+ io.write_int(NumOutputs, !IO),
+ io.write_string(",\n", !IO),
+ (
+ MaybeOutputSteps = no,
+ io.write_string("0,\n", !IO)
+ ;
+ MaybeOutputSteps = yes(_),
+ io.write_string("1,\n", !IO)
+ ),
+ output_data_addr(InputStepsDataAddr, !IO),
+ io.write_string(",\n", !IO),
+ output_data_addr(InputEnumParamsDataAddr, !IO),
+ io.write_string(",\n", !IO),
+ (
+ MaybeOutputSteps = no,
+ io.write_string("NULL,\n", !IO),
+ io.write_string("NULL,\n", !IO)
+ ;
+ MaybeOutputSteps = yes(_),
+ output_data_addr(OutputStepsDataAddr, !IO),
+ io.write_string(",\n", !IO),
+ output_data_addr(OutputEnumParamsDataAddr, !IO),
+ io.write_string(",\n", !IO)
+ ),
+ io.write_string("(const MR_PseudoTypeInfo *) ", !IO),
+ output_rval(PTIVectorRval, !IO),
+ io.write_string(",\n", !IO),
+ io.write_string("(const MR_Type_Param_Locns *) ", !IO),
+ output_rval(TypeParamsRval, !IO),
+ io.write_string(",\n", !IO),
+ io.write_string("{ 0 },\n", !IO),
+ (
+ Stats = no,
+ io.write_string("0,\n", !IO),
+ io.write_string("0,\n", !IO),
+ io.write_string("NULL,\n", !IO),
+ io.write_string("0,\n", !IO),
+ io.write_string("0,\n", !IO),
+ io.write_string("NULL,\n", !IO),
+ io.write_string("0,\n", !IO),
+ io.write_string("0,\n", !IO),
+ io.write_string("NULL,\n", !IO),
+ io.write_string("0,\n", !IO),
+ io.write_string("0,\n", !IO),
+ io.write_string("NULL,\n", !IO)
+ ;
+ Stats = yes,
+ io.write_string("0,\n", !IO),
+ io.write_string("0,\n", !IO),
+ output_data_addr(CallStatsDataAddr, !IO),
+ io.write_string(",\n", !IO),
+ io.write_string("0,\n", !IO),
+ io.write_string("0,\n", !IO),
+ output_data_addr(PrevCallStatsDataAddr, !IO),
+ io.write_string(",\n", !IO),
+ (
+ MaybeOutputSteps = no,
+ io.write_string("0,\n", !IO),
+ io.write_string("0,\n", !IO),
+ io.write_string("NULL,\n", !IO),
+ io.write_string("0,\n", !IO),
+ io.write_string("0,\n", !IO),
+ io.write_string("NULL,\n", !IO)
+ ;
+ MaybeOutputSteps = yes(_),
+ io.write_string("0,\n", !IO),
+ io.write_string("0,\n", !IO),
+ output_data_addr(AnswerStatsDataAddr, !IO),
+ io.write_string(",\n", !IO),
+ io.write_string("0,\n", !IO),
+ io.write_string("0,\n", !IO),
+ output_data_addr(PrevAnswerStatsDataAddr, !IO),
+ io.write_string(",\n", !IO)
+ )
+ ),
+ (
+ MaybeSizeLimit = no,
+ io.write_string("-1,\n", !IO),
+ io.write_string("NULL,\n", !IO),
+ io.write_string("0,\n", !IO),
+ io.write_string("0\n", !IO)
+ ;
+ MaybeSizeLimit = yes(SizeLimit2),
+ io.write_int(SizeLimit2, !IO),
+ io.write_string(",\n", !IO),
+ output_data_addr(TipsDataAddr, !IO),
+ io.write_string("0,\n", !IO),
+ io.write_string("0\n", !IO)
+ ),
+ io.write_string("};\n", !IO),
+ decl_set_insert(decl_data_addr(InfoDataAddr), !DeclSet).
+
+:- pred output_table_steps_table(module_name::in, data_name::in,
+ list(table_trie_step)::in, list(maybe(int))::out,
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
+
+output_table_steps_table(ModuleName, DataName, Steps, MaybeEnumParams,
+ !DeclSet, !IO) :-
+ DataAddr = data_addr(ModuleName, DataName),
io.write_string("\n", !IO),
- output_common_type_defn(TypeNum, CellType, !DeclSet, !IO),
- VarDeclId = decl_scalar_common_array(TypeNum),
- io.write_string("static const struct ", !IO),
- output_common_cell_type_name(TypeNum, !IO),
- io.write_string(" ", !IO),
- output_common_scalar_cell_array_name(TypeNum, !IO),
- io.write_string("[];\n", !IO),
- decl_set_insert(VarDeclId, !DeclSet).
+ io.write_string("static const MR_TableTrieStep ", !IO),
+ output_data_addr(DataAddr, !IO),
+ io.write_string("[] = {\n", !IO),
+ output_table_steps(Steps, MaybeEnumParams, !IO),
+ io.write_string("};\n", !IO),
+ decl_set_insert(decl_data_addr(DataAddr), !DeclSet).
-:- pred output_vector_common_data_decl(vector_common_data_array::in,
+:- pred output_table_steps(list(table_trie_step)::in,
+ list(maybe(int))::out, io::di, io::uo) is det.
+
+output_table_steps([], [], !IO).
+output_table_steps([Step | Steps], [MaybeEnumParam | MaybeEnumParams],
+ !IO) :-
+ table_trie_step_to_c(Step, StepType, MaybeEnumParam),
+ io.write_string(StepType, !IO),
+ io.write_string(",\n", !IO),
+ output_table_steps(Steps, MaybeEnumParams, !IO).
+
+:- pred output_table_enum_params_table(module_name::in, data_name::in,
+ list(maybe(int))::in, decl_set::in, decl_set::out, io::di, io::uo) is det.
+
+output_table_enum_params_table(ModuleName, DataName, MaybeEnumParams,
+ !DeclSet, !IO) :-
+ DataAddr = data_addr(ModuleName, DataName),
+ io.write_string("\n", !IO),
+ io.write_string("static const MR_Integer ", !IO),
+ output_data_addr(DataAddr, !IO),
+ io.write_string("[] = {\n", !IO),
+ output_table_enum_params(MaybeEnumParams, !IO),
+ io.write_string("};\n", !IO),
+ decl_set_insert(decl_data_addr(DataAddr), !DeclSet).
+
+:- pred output_table_enum_params(list(maybe(int))::in, io::di, io::uo) is det.
+
+output_table_enum_params([], !IO).
+output_table_enum_params([MaybeEnumParam | MaybeEnumParams], !IO) :-
+ (
+ MaybeEnumParam = no,
+ io.write_int(-1, !IO)
+ ;
+ MaybeEnumParam = yes(EnumRange),
+ io.write_int(EnumRange, !IO)
+ ),
+ io.write_string(",\n", !IO),
+ output_table_enum_params(MaybeEnumParams, !IO).
+
+:- pred output_table_tips(module_name::in, proc_label::in, int::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
-output_vector_common_data_decl(VectorCommonDataArray, !DeclSet, !IO) :-
- VectorCommonDataArray = vector_common_data_array(ModuleName, CellType,
- TypeNum, CellNum, _Values),
+output_table_tips(ModuleName, ProcLabel, SizeLimit, !DeclSet, !IO) :-
+ % We don't need to initialize the elements of the array, since the
+ % MR_pt_num_call_table_tips field explicitly says that none of the
+ % array elements are meaningful.
+ DataAddr = data_addr(ModuleName,
+ proc_tabling_ref(ProcLabel, tabling_tips)),
io.write_string("\n", !IO),
- output_common_type_defn(TypeNum, CellType, !DeclSet, !IO),
- VarDeclId = decl_data_addr(data_addr(ModuleName,
- vector_common_ref(TypeNum, CellNum))),
- io.write_string("static const struct ", !IO),
- output_common_cell_type_name(TypeNum, !IO),
- io.write_string(" ", !IO),
- output_common_vector_cell_array_name(TypeNum, CellNum, !IO),
- io.write_string("[];\n", !IO),
- decl_set_insert(VarDeclId, !DeclSet).
+ io.write_string("static MR_TrieNode ", !IO),
+ output_data_addr(DataAddr, !IO),
+ io.write_string("[", !IO),
+ io.write_int(SizeLimit, !IO),
+ io.write_string("];\n", !IO),
+ decl_set_insert(decl_data_addr(DataAddr), !DeclSet).
+
+:- pred output_table_stats(module_name::in, data_name::in, int::in,
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
+
+output_table_stats(ModuleName, DataName, NumInputs, !DeclSet, !IO) :-
+ % We don't need to initialize the elements of the array, because
+ % we want to initialize all members of the array to structures
+ % that contain all zeros, and C does that for us.
+ DataAddr = data_addr(ModuleName, DataName),
+ io.write_string("\n", !IO),
+ io.write_string("static MR_TableStepStats ", !IO),
+ output_data_addr(DataAddr, !IO),
+ io.write_string("[", !IO),
+ io.write_int(NumInputs, !IO),
+ io.write_string("];\n", !IO),
+ decl_set_insert(decl_data_addr(DataAddr), !DeclSet).
+
+%-----------------------------------------------------------------------------%
:- pred output_common_type_defn(int::in, common_cell_type::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
@@ -907,38 +1168,40 @@
decl_set_insert(TypeDeclId, !DeclSet)
).
-:- pred output_comp_gen_c_module(map(label, data_addr)::in,
- comp_gen_c_module::in, decl_set::in, decl_set::out, io::di, io::uo)
- is det.
+:- pred output_scalar_common_data_decl(scalar_common_data_array::in,
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
-output_comp_gen_c_module(StackLayoutLabels,
- comp_gen_c_module(ModuleName, Procedures), !DeclSet, !IO) :-
- io.write_string("\n", !IO),
- list.foldl2(output_c_procedure_decls(StackLayoutLabels),
- Procedures, !DeclSet, !IO),
- io.write_string("\n", !IO),
- io.write_string("MR_BEGIN_MODULE(", !IO),
- io.write_string(ModuleName, !IO),
- io.write_string(")\n", !IO),
- gather_c_module_labels(Procedures, Labels),
- output_c_label_inits(StackLayoutLabels, Labels, !IO),
- io.write_string("MR_BEGIN_CODE\n", !IO),
+output_scalar_common_data_decl(ScalarCommonDataArray, !DeclSet, !IO) :-
+ ScalarCommonDataArray = scalar_common_data_array(_ModuleName, CellType,
+ TypeNum, _Values),
io.write_string("\n", !IO),
- globals.io_lookup_bool_option(auto_comments, PrintComments, !IO),
- globals.io_lookup_bool_option(emit_c_loops, EmitCLoops, !IO),
- list.foldl(output_c_procedure(PrintComments, EmitCLoops), Procedures, !IO),
- io.write_string("MR_END_MODULE\n", !IO).
+ output_common_type_defn(TypeNum, CellType, !DeclSet, !IO),
+ VarDeclId = decl_scalar_common_array(TypeNum),
+ io.write_string("static const struct ", !IO),
+ output_common_cell_type_name(TypeNum, !IO),
+ io.write_string(" ", !IO),
+ output_common_scalar_cell_array_name(TypeNum, !IO),
+ io.write_string("[];\n", !IO),
+ decl_set_insert(VarDeclId, !DeclSet).
-:- pred output_comp_gen_c_var(comp_gen_c_var::in,
+:- pred output_vector_common_data_decl(vector_common_data_array::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
-output_comp_gen_c_var(tabling_pointer_var(ModuleName, ProcLabel),
- !DeclSet, !IO) :-
- io.write_string("\nMR_TableNode ", !IO),
- output_tabling_pointer_var_name(ProcLabel, !IO),
- io.write_string(" = { 0 };\n", !IO),
- DataAddr = data_addr(ModuleName, tabling_pointer(ProcLabel)),
- decl_set_insert(decl_data_addr(DataAddr), !DeclSet).
+output_vector_common_data_decl(VectorCommonDataArray, !DeclSet, !IO) :-
+ VectorCommonDataArray = vector_common_data_array(ModuleName, CellType,
+ TypeNum, CellNum, _Values),
+ io.write_string("\n", !IO),
+ output_common_type_defn(TypeNum, CellType, !DeclSet, !IO),
+ VarDeclId = decl_data_addr(data_addr(ModuleName,
+ vector_common_ref(TypeNum, CellNum))),
+ io.write_string("static const struct ", !IO),
+ output_common_cell_type_name(TypeNum, !IO),
+ io.write_string(" ", !IO),
+ output_common_vector_cell_array_name(TypeNum, CellNum, !IO),
+ io.write_string("[];\n", !IO),
+ decl_set_insert(VarDeclId, !DeclSet).
+
+%-----------------------------------------------------------------------------%
:- pred output_scalar_common_data_defn(scalar_common_data_array::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
@@ -1010,11 +1273,13 @@
common_group_get_rvals(common_cell_grouped_args(_, _, Rvals)) = Rvals.
common_group_get_rvals(common_cell_ungrouped_arg(_, Rval)) = [Rval].
+%-----------------------------------------------------------------------------%
+
:- pred output_user_foreign_code(user_foreign_code::in, io::di, io::uo) is det.
output_user_foreign_code(user_foreign_code(Lang, Foreign_Code, Context),
!IO) :-
- ( Lang = c ->
+ ( Lang = lang_c ->
globals.io_lookup_bool_option(auto_comments, PrintComments, !IO),
(
PrintComments = yes,
@@ -1044,7 +1309,7 @@
output_foreign_header_include_line(Decl, !AlreadyDone, !IO) :-
Decl = foreign_decl_code(Lang, _IsLocal, Code, Context),
- ( Lang = c ->
+ ( Lang = lang_c ->
( set.member(Code, !.AlreadyDone) ->
true
;
@@ -1140,7 +1405,7 @@
io.write_string("MR_DECL_LL", !IO),
io.write_int(list.length(LabelNums), !IO),
io.write_string("(", !IO),
- output_proc_label(ProcLabel, no, !IO),
+ output_proc_label_no_prefix(ProcLabel, !IO),
io.write_string(", ", !IO),
io.write_list(LabelNums, ",", io.write_int, !IO),
io.write_string(")\n", !IO).
@@ -1167,7 +1432,7 @@
io.write_string("MR_decl_label", !IO),
io.write_int(list.length(LabelNums), !IO),
io.write_string("(", !IO),
- output_proc_label(ProcLabel, no, !IO),
+ output_proc_label_no_prefix(ProcLabel, !IO),
io.write_string(", ", !IO),
io.write_list(LabelNums, ",", io.write_int, !IO),
io.write_string(")\n", !IO),
@@ -1211,7 +1476,7 @@
),
io.write_string(Macro, !IO),
io.write_string("(", !IO),
- output_proc_label(ProcLabel, no, !IO),
+ output_proc_label_no_prefix(ProcLabel, !IO),
io.write_string(", ", !IO),
io.write_int(LabelNum, !IO),
% The final semicolon is in the macro definition.
@@ -1314,7 +1579,7 @@
io.write_string(Suffix, !IO),
io.write_int(list.length(LabelNums), !IO),
io.write_string("(", !IO),
- output_proc_label(ProcLabel, no, !IO),
+ output_proc_label_no_prefix(ProcLabel, !IO),
io.write_string(",", !IO),
io.write_list(LabelNums, ",", io.write_int, !IO),
io.write_string(")\n", !IO).
@@ -1356,7 +1621,7 @@
),
io.write_string(TabInitMacro, !IO),
io.write_string(SuffixOpen, !IO),
- output_proc_label(ProcLabel, no, !IO),
+ output_proc_label_no_prefix(ProcLabel, !IO),
io.write_string(");\n", !IO),
(
InitProcLayout = yes,
@@ -1825,7 +2090,7 @@
DummyModule = unqualified("DEBUG"),
DummyPredName = "DEBUG",
proc_id_to_int(hlds_pred.initial_proc_id, InitialProcIdInt),
- ProcLabel = proc(DummyModule, predicate, DummyModule,
+ ProcLabel = ordinary_proc_label(DummyModule, predicate, DummyModule,
DummyPredName, 0, InitialProcIdInt),
ProfInfo = entry(local, ProcLabel) - ContLabelSet,
output_instruction_and_comment(Instr, Comment, PrintComments,
@@ -1839,7 +2104,7 @@
DummyModule = unqualified("DEBUG"),
DummyPredName = "DEBUG",
proc_id_to_int(hlds_pred.initial_proc_id, InitialProcIdInt),
- ProcLabel = proc(DummyModule, predicate, DummyModule,
+ ProcLabel = ordinary_proc_label(DummyModule, predicate, DummyModule,
DummyPredName, 0, InitialProcIdInt),
ProfInfo = entry(local, ProcLabel) - ContLabelSet,
output_instruction(Instr, ProfInfo, !IO).
@@ -2845,7 +3110,7 @@
% static code addresses.
data_name_may_include_non_static_code_address(scalar_common_ref(_, _)) = no.
data_name_may_include_non_static_code_address(vector_common_ref(_, _)) = no.
-data_name_may_include_non_static_code_address(tabling_pointer(_)) = no.
+data_name_may_include_non_static_code_address(proc_tabling_ref(_, _)) = no.
:- pred output_decl_id(decl_id::in, io::di, io::uo) is det.
@@ -3270,7 +3535,7 @@
output_label_as_code_addr_decls(Label, !IO).
output_code_addr_decls(imported(ProcLabel), !IO) :-
io.write_string("MR_decl_entry(", !IO),
- output_proc_label(ProcLabel, no, !IO),
+ output_proc_label_no_prefix(ProcLabel, !IO),
io.write_string(");\n", !IO).
output_code_addr_decls(succip, !IO).
output_code_addr_decls(do_succeed(_), !IO).
@@ -3436,7 +3701,7 @@
data_name_linkage(scalar_common_ref(_, _), static).
data_name_linkage(vector_common_ref(_, _), static).
-data_name_linkage(tabling_pointer(_), static).
+data_name_linkage(proc_tabling_ref(_, _), static).
%-----------------------------------------------------------------------------%
@@ -3543,7 +3808,7 @@
;
ProfileCalls = no,
io.write_string("MR_np_tailcall_ent(", !IO),
- output_proc_label(ProcLabel, no, !IO),
+ output_proc_label_no_prefix(ProcLabel, !IO),
io.write_string(");\n", !IO)
).
output_goto(succip, _, !IO) :-
@@ -3904,10 +4169,21 @@
VarName = vector_common_ref(TypeNum, CellNum),
output_common_vector_cell_array_name(TypeNum, CellNum, !IO)
;
- VarName = tabling_pointer(ProcLabel),
- output_tabling_pointer_var_name(ProcLabel, !IO)
+ VarName = proc_tabling_ref(ProcLabel, TablingId),
+ io.write_string(tabling_struct_data_addr_string(ProcLabel, TablingId),
+ !IO)
).
+proc_tabling_info_var_name(ProcLabel) =
+ tabling_struct_data_addr_string(ProcLabel, tabling_info).
+
+:- func tabling_struct_data_addr_string(proc_label, proc_tabling_struct_id)
+ = string.
+
+tabling_struct_data_addr_string(ProcLabel, Id) =
+ mercury_var_prefix ++ "_proc" ++ tabling_info_id_str(Id) ++ "__" ++
+ proc_label_to_c_string(ProcLabel, no).
+
:- pred output_common_cell_type_name(int::in, io::di, io::uo) is det.
output_common_cell_type_name(TypeNum, !IO) :-
@@ -3982,15 +4258,15 @@
io.write_string(");\n", !IO).
output_label_defn(entry(local, ProcLabel), !IO) :-
io.write_string("MR_def_static(", !IO),
- output_proc_label(ProcLabel, no, !IO),
+ output_proc_label_no_prefix(ProcLabel, !IO),
io.write_string(")\n", !IO).
output_label_defn(entry(c_local, ProcLabel), !IO) :-
io.write_string("MR_def_local(", !IO),
- output_proc_label(ProcLabel, no, !IO),
+ output_proc_label_no_prefix(ProcLabel, !IO),
io.write_string(")\n", !IO).
output_label_defn(internal(Num, ProcLabel), !IO) :-
io.write_string("MR_def_label(", !IO),
- output_proc_label(ProcLabel, no, !IO),
+ output_proc_label_no_prefix(ProcLabel, !IO),
io.write_string(",", !IO),
io.write_int(Num, !IO),
io.write_string(")\n", !IO).
Index: compiler/make.dependencies.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make.dependencies.m,v
retrieving revision 1.28
diff -u -b -r1.28 make.dependencies.m
--- compiler/make.dependencies.m 24 Mar 2006 04:40:44 -0000 1.28
+++ compiler/make.dependencies.m 30 May 2006 05:24:17 -0000
@@ -194,7 +194,7 @@
compiled_code_dependencies(Globals).
target_dependencies(Globals, object_code(PIC)) = Deps :-
globals.get_target(Globals, CompilationTarget),
- TargetCode = ( CompilationTarget = asm -> asm_code(PIC) ; c_code ),
+ TargetCode = ( CompilationTarget = target_asm -> asm_code(PIC) ; c_code ),
globals.lookup_bool_option(Globals, highlevel_code, HighLevelCode),
%
@@ -202,7 +202,7 @@
% file for all imported modules.
%
(
- CompilationTarget = c,
+ CompilationTarget = target_c,
HighLevelCode = yes
->
HeaderDeps = combine_deps_list([
@@ -238,12 +238,12 @@
il_asm `of` self,
il_asm `of` filter(maybe_keep_std_lib_module, direct_imports),
il_asm `of` filter(maybe_keep_std_lib_module,
- foreign_imports(il)),
- foreign_il_asm(managed_cplusplus) `of`
+ foreign_imports(lang_il)),
+ foreign_il_asm(lang_managed_cplusplus) `of`
filter(maybe_keep_std_lib_module,
- foreign_imports(managed_cplusplus)),
- foreign_il_asm(csharp) `of` filter(maybe_keep_std_lib_module,
- foreign_imports(csharp))
+ foreign_imports(lang_managed_cplusplus)),
+ foreign_il_asm(lang_csharp) `of` filter(maybe_keep_std_lib_module,
+ foreign_imports(lang_csharp))
]).
target_dependencies(Globals, foreign_object(PIC, _)) =
get_foreign_deps(Globals, PIC).
@@ -255,7 +255,7 @@
get_foreign_deps(Globals, PIC) = Deps :-
globals.get_target(Globals, CompilationTarget),
- TargetCode = ( CompilationTarget = asm -> asm_code(PIC) ; c_code ),
+ TargetCode = ( CompilationTarget = target_asm -> asm_code(PIC) ; c_code ),
Deps = combine_deps_list([
TargetCode `of` self
]).
@@ -945,10 +945,8 @@
;
UnbuiltDependencies = [],
debug_msg(
- (pred(!.IO::di, !:IO::uo) is det :-
- io.write_string(TargetFileName, !IO),
- io.write_string(": finished dependencies\n", !IO)
- ), !IO),
+ io.write_string(TargetFileName ++ ": finished dependencies\n"),
+ !IO),
list.map_foldl2(get_dependency_timestamp, DepFiles,
DepTimestamps, !Info, !IO),
@@ -986,11 +984,7 @@
(
MaybeTimestamp = error(_),
DepsResult = out_of_date,
- debug_msg(
- (pred(!.IO::di, !:IO::uo) is det :-
- io.write_string(TargetFileName, !IO),
- io.write_string(" does not exist.\n", !IO)
- ), !IO)
+ debug_msg(io.write_string(TargetFileName ++ " does not exist.\n"), !IO)
;
MaybeTimestamp = ok(Timestamp),
globals.io_lookup_bool_option(rebuild, Rebuild, !IO),
Index: compiler/make.module_target.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make.module_target.m,v
retrieving revision 1.41
diff -u -b -r1.41 make.module_target.m
--- compiler/make.module_target.m 4 Apr 2006 08:03:43 -0000 1.41
+++ compiler/make.module_target.m 30 May 2006 05:02:39 -0000
@@ -439,19 +439,21 @@
io.output_stream::in, module_imports::in, bool::out,
io::di, io::uo) is det.
-build_object_code(ModuleName, c, PIC, ErrorStream, _Imports, Succeeded, !IO) :-
+build_object_code(ModuleName, target_c, PIC, ErrorStream, _Imports,
+ Succeeded, !IO) :-
compile_target_code.compile_c_file(ErrorStream, PIC, ModuleName,
Succeeded, !IO).
-build_object_code(ModuleName, asm, PIC, ErrorStream, _Imports, Succeeded,
- !IO) :-
+build_object_code(ModuleName, target_asm, PIC, ErrorStream, _Imports,
+ Succeeded, !IO) :-
compile_target_code.assemble(ErrorStream, PIC, ModuleName,
Succeeded, !IO).
-build_object_code(ModuleName, java, _, ErrorStream, _Imports, Succeeded,
+build_object_code(ModuleName, target_java, _, ErrorStream, _Imports, Succeeded,
!IO) :-
module_name_to_file_name(ModuleName, ".java", yes, JavaFile, !IO),
compile_target_code.compile_java_file(ErrorStream, JavaFile,
Succeeded, !IO).
-build_object_code(ModuleName, il, _, ErrorStream, Imports, Succeeded, !IO) :-
+build_object_code(ModuleName, target_il, _, ErrorStream, Imports, Succeeded,
+ !IO) :-
compile_target_code.il_assemble(ErrorStream, ModuleName,
Imports ^ has_main, Succeeded, !IO).
@@ -460,24 +462,24 @@
io::di, io::uo) is det.
compile_foreign_code_file(ErrorStream, PIC, _Imports,
- foreign_code_file(c, CFile, ObjFile), Succeeded, !IO) :-
+ foreign_code_file(lang_c, CFile, ObjFile), Succeeded, !IO) :-
compile_target_code.compile_c_file(ErrorStream, PIC,
CFile, ObjFile, Succeeded, !IO).
compile_foreign_code_file(ErrorStream, _, _Imports,
- foreign_code_file(il, ILFile, DLLFile), Succeeded, !IO) :-
+ foreign_code_file(lang_il, ILFile, DLLFile), Succeeded, !IO) :-
compile_target_code.il_assemble(ErrorStream, ILFile, DLLFile,
no_main, Succeeded, !IO).
compile_foreign_code_file(ErrorStream, _, _Imports,
- foreign_code_file(java, JavaFile, _ClassFile), Succeeded, !IO) :-
+ foreign_code_file(lang_java, JavaFile, _ClassFile), Succeeded, !IO) :-
compile_target_code.compile_java_file(ErrorStream, JavaFile,
Succeeded, !IO).
compile_foreign_code_file(ErrorStream, _, _Imports,
- foreign_code_file(managed_cplusplus, MCPPFile, DLLFile),
+ foreign_code_file(lang_managed_cplusplus, MCPPFile, DLLFile),
Succeeded, !IO) :-
compile_target_code.compile_managed_cplusplus_file(ErrorStream,
MCPPFile, DLLFile, Succeeded, !IO).
compile_foreign_code_file(ErrorStream, _, Imports,
- foreign_code_file(csharp, CSharpFile, DLLFile),
+ foreign_code_file(lang_csharp, CSharpFile, DLLFile),
Succeeded, !IO) :-
compile_target_code.compile_csharp_file(ErrorStream, Imports,
CSharpFile, DLLFile, Succeeded, !IO).
@@ -523,23 +525,23 @@
ObjExt = get_object_extension(Globals, PIC),
fact_table_file_name(ModuleName, FactTableName, ".c", yes, CFile, !IO),
fact_table_file_name(ModuleName, FactTableName, ObjExt, yes, ObjFile, !IO),
- ForeignCodeFile = foreign_code_file(c, CFile, ObjFile).
+ ForeignCodeFile = foreign_code_file(lang_c, CFile, ObjFile).
:- func get_object_extension(globals, pic) = string.
get_object_extension(Globals, PIC) = Ext :-
globals.get_target(Globals, CompilationTarget),
(
- CompilationTarget = c,
+ CompilationTarget = target_c,
maybe_pic_object_file_extension(Globals, PIC, Ext)
;
- CompilationTarget = asm,
+ CompilationTarget = target_asm,
maybe_pic_object_file_extension(Globals, PIC, Ext)
;
- CompilationTarget = il,
+ CompilationTarget = target_il,
Ext = ".dll"
;
- CompilationTarget = java,
+ CompilationTarget = target_java,
sorry(this_file, "object extension for java")
).
@@ -754,7 +756,7 @@
globals.io_get_target(CompilationTarget, !IO),
(
Task = compile_to_target_code,
- CompilationTarget = asm
+ CompilationTarget = target_asm
->
% For `--target asm' the code for the nested children
% is placed in the `.s' file for the top-level module
@@ -777,7 +779,7 @@
list.map((func(ForeignFile) = ForeignFile ^ target_file),
list.condense(ForeignCodeFileList)),
(
- CompilationTarget = c,
+ CompilationTarget = target_c,
globals.io_lookup_bool_option(highlevel_code, HighLevelCode, !IO),
(
HighLevelCode = yes,
@@ -793,7 +795,7 @@
HeaderTargets0 = []
)
;
- CompilationTarget = asm,
+ CompilationTarget = target_asm,
%
% When compiling to assembler, we only generate
% a header file if the module contains foreign code.
@@ -805,16 +807,16 @@
), ModuleImportsList),
HeaderTargets0 = make_target_list(HeaderModuleNames, c_header(mih))
;
- CompilationTarget = il,
+ CompilationTarget = target_il,
HeaderTargets0 = []
;
- CompilationTarget = java,
+ CompilationTarget = target_java,
HeaderTargets0 = []
),
(
- ( CompilationTarget = c
- ; CompilationTarget = asm
+ ( CompilationTarget = target_c
+ ; CompilationTarget = target_asm
)
->
Names = SourceFileModuleNames,
@@ -881,17 +883,19 @@
globals.io_get_target(CompilationTarget, !IO),
ModuleName = Imports ^ module_name,
(
- CompilationTarget = asm,
+ CompilationTarget = target_asm,
Imports ^ foreign_code = contains_foreign_code(Langs),
- set.member(c, Langs)
+ set.member(lang_c, Langs)
->
- module_name_to_file_name(foreign_language_module_name(ModuleName, c),
+ module_name_to_file_name(
+ foreign_language_module_name(ModuleName, lang_c),
".c", no, CCodeFileName, !IO),
- module_name_to_file_name(foreign_language_module_name(ModuleName, c),
+ module_name_to_file_name(
+ foreign_language_module_name(ModuleName, lang_c),
ObjExt, no, ObjFileName, !IO),
- ForeignFiles0 = [foreign_code_file(c, CCodeFileName, ObjFileName) ]
+ ForeignFiles0 = [foreign_code_file(lang_c, CCodeFileName, ObjFileName)]
;
- CompilationTarget = il,
+ CompilationTarget = target_il,
Imports ^ foreign_code = contains_foreign_code(Langs)
->
list.map_foldl(external_foreign_code_files_for_il(ModuleName),
@@ -905,8 +909,8 @@
% Find externally compiled foreign code files for fact tables.
%
(
- ( CompilationTarget = c
- ; CompilationTarget = asm
+ ( CompilationTarget = target_c
+ ; CompilationTarget = target_asm
)
->
list.map_foldl(
@@ -916,7 +920,7 @@
".c", no, FactTableCFile),
fact_table_file_name(ModuleName, FactTableFile,
ObjExt, no, FactTableObjFile),
- { FactTableForeignFile = foreign_code_file(c,
+ { FactTableForeignFile = foreign_code_file(lang_c,
FactTableCFile, FactTableObjFile) }
), Imports ^ fact_table_deps, FactTableForeignFiles, !IO),
ForeignFiles = ForeignFiles0 ++ FactTableForeignFiles
Index: compiler/make.program_target.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make.program_target.m,v
retrieving revision 1.48
diff -u -b -r1.48 make.program_target.m
--- compiler/make.program_target.m 21 May 2006 06:22:57 -0000 1.48
+++ compiler/make.program_target.m 30 May 2006 06:01:04 -0000
@@ -113,19 +113,19 @@
% as soon as possible.
globals.io_get_target(CompilationTarget, !IO),
(
- CompilationTarget = c,
+ CompilationTarget = target_c,
IntermediateTargetType = c_code,
ObjectTargetType = object_code(PIC)
;
- CompilationTarget = asm,
+ CompilationTarget = target_asm,
IntermediateTargetType = asm_code(PIC),
ObjectTargetType = object_code(PIC)
;
- CompilationTarget = il,
+ CompilationTarget = target_il,
IntermediateTargetType = il_code,
ObjectTargetType = il_asm
;
- CompilationTarget = java,
+ CompilationTarget = target_java,
IntermediateTargetType = java_code,
% XXX Whoever finishes the Java backend can fill this in.
ObjectTargetType = object_code(non_pic)
@@ -179,7 +179,7 @@
(
TargetType = errors
;
- CompilationTarget = asm,
+ CompilationTarget = target_asm,
( TargetType = asm_code(_)
; TargetType = object_code(_)
)
@@ -225,13 +225,14 @@
unexpected(this_file, "unknown imports")
),
(
- CompilationTarget = asm,
+ CompilationTarget = target_asm,
Imports ^ foreign_code = contains_foreign_code(Langs),
- set.member(c, Langs)
+ set.member(lang_c, Langs)
->
- ForeignObjectTargets = [target(ModuleName - foreign_object(PIC, c))]
+ ForeignObjectTargets =
+ [target(ModuleName - foreign_object(PIC, lang_c))]
;
- CompilationTarget = il,
+ CompilationTarget = target_il,
Imports ^ foreign_code = contains_foreign_code(Langs)
->
ForeignObjectTargets = list.map(
@@ -244,8 +245,8 @@
% Find out if any externally compiled foreign code files for fact tables
% exist.
(
- ( CompilationTarget = c
- ; CompilationTarget = asm
+ ( CompilationTarget = target_c
+ ; CompilationTarget = target_asm
)
->
FactObjectTargets = list.map(
@@ -309,8 +310,8 @@
AllModulesList = set.to_sorted_list(AllModules),
(
FileType = executable,
- ( CompilationTarget = c
- ; CompilationTarget = asm
+ ( CompilationTarget = target_c
+ ; CompilationTarget = target_asm
)
->
compile_target_code.make_init_obj_file(ErrorStream,
@@ -411,7 +412,7 @@
% after all the object files on the linker command line.
AllObjects = InitObjects ++ ObjList ++ ForeignObjects ++ LinkObjects,
(
- CompilationTarget = c,
+ CompilationTarget = target_c,
% Run the link in a separate process so it can be killed
% if an interrupt is received.
call_in_forked_process(
@@ -419,7 +420,7 @@
FileType, MainModuleName, AllObjects),
Succeeded, !IO)
;
- CompilationTarget = asm,
+ CompilationTarget = target_asm,
% Run the link in a separate process so it can
% be killed if an interrupt is received.
call_in_forked_process(
@@ -427,10 +428,10 @@
FileType, MainModuleName, AllObjects),
Succeeded, !IO)
;
- CompilationTarget = il,
+ CompilationTarget = target_il,
Succeeded = yes
;
- CompilationTarget = java,
+ CompilationTarget = target_java,
create_java_shell_script(MainModuleName, Succeeded, !IO)
),
!:Info = !.Info ^ command_line_targets :=
@@ -477,8 +478,8 @@
make_remove_file(OutputFileName, !Info, !IO),
(
FileType = executable,
- ( CompilationTarget = c
- ; CompilationTarget = asm
+ ( CompilationTarget = target_c
+ ; CompilationTarget = target_asm
)
->
remove_init_files(MainModuleName, !Info, !IO)
@@ -843,7 +844,7 @@
% otherwise there is trouble using libraries installed by
% `mmc --make' with Mmake.
% XXX If we ever phase out mmake we could revert this behaviour.
- ( Target = c ; Target = asm )
+ ( Target = target_c ; Target = target_asm )
% Imports ^ contains_foreign_export = contains_foreign_export
->
module_name_to_file_name(ModuleName, ".mh", no, FileName, !IO),
@@ -1016,10 +1017,10 @@
globals.io_lookup_bool_option(highlevel_code, HighLevelCode, !IO),
(
(
- Target = c,
+ Target = target_c,
HighLevelCode = yes
;
- Target = asm,
+ Target = target_asm,
Imports ^ foreign_code = contains_foreign_code(_)
)
->
@@ -1277,7 +1278,7 @@
make_remove_file(FactTableCFile, !Info)
), FactTableFiles, !Info, !IO),
- CCodeModule = foreign_language_module_name(ModuleName, c),
+ CCodeModule = foreign_language_module_name(ModuleName, lang_c),
make_remove_target_file(CCodeModule, c_code, !Info, !IO),
% Remove object and assembler files.
@@ -1285,7 +1286,8 @@
(pred(PIC::in, !.Info::in, !:Info::out, !.IO::di, !:IO::uo) is det :-
make_remove_target_file(ModuleName, object_code(PIC), !Info, !IO),
make_remove_target_file(ModuleName, asm_code(PIC), !Info, !IO),
- make_remove_target_file(ModuleName, foreign_object(PIC, c), !Info, !IO),
+ make_remove_target_file(ModuleName, foreign_object(PIC, lang_c),
+ !Info, !IO),
list.foldl2(
(pred(FactTableFile::in, !.Info::in, !:Info::out,
!.IO::di, !:IO::uo) is det :-
@@ -1296,16 +1298,18 @@
[pic, link_with_pic, non_pic], !Info, !IO),
% Remove IL foreign code files.
- CSharpModule = foreign_language_module_name(ModuleName, csharp),
- make_remove_file(CSharpModule, foreign_language_file_extension(csharp),
+ CSharpModule = foreign_language_module_name(ModuleName, lang_csharp),
+ make_remove_file(CSharpModule,
+ foreign_language_file_extension(lang_csharp), !Info, !IO),
+ make_remove_target_file(CSharpModule, foreign_il_asm(lang_csharp),
!Info, !IO),
- make_remove_target_file(CSharpModule, foreign_il_asm(csharp), !Info, !IO),
- McppModule = foreign_language_module_name(ModuleName, managed_cplusplus),
+ McppModule = foreign_language_module_name(ModuleName,
+ lang_managed_cplusplus),
make_remove_file(McppModule,
- foreign_language_file_extension(managed_cplusplus),
+ foreign_language_file_extension(lang_managed_cplusplus),
!Info, !IO),
- make_remove_target_file(McppModule, foreign_il_asm(managed_cplusplus),
+ make_remove_target_file(McppModule, foreign_il_asm(lang_managed_cplusplus),
!Info, !IO).
:- pred make_module_realclean(module_name::in, make_info::in, make_info::out,
Index: compiler/make.util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make.util.m,v
retrieving revision 1.34
diff -u -b -r1.34 make.util.m
--- compiler/make.util.m 17 Mar 2006 01:40:26 -0000 1.34
+++ compiler/make.util.m 30 May 2006 05:04:58 -0000
@@ -913,7 +913,7 @@
timestamp_extension(Globals, c_header(_)) = Ext :-
globals.get_target(Globals, Target),
Ext = timestamp_extension(Globals,
- (Target = asm -> asm_code(non_pic) ; c_code)).
+ (Target = target_asm -> asm_code(non_pic) ; c_code)).
timestamp_extension(_, il_code) = ".il_date".
timestamp_extension(_, java_code) = ".java_date".
timestamp_extension(_, asm_code(non_pic)) = ".s_date".
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.41
diff -u -b -r1.41 make_hlds_passes.m
--- compiler/make_hlds_passes.m 27 Apr 2006 07:34:30 -0000 1.41
+++ compiler/make_hlds_passes.m 30 May 2006 04:56:20 -0000
@@ -44,6 +44,12 @@
module_info::out, qual_info::out, bool::out, bool::out, io::di, io::uo)
is det.
+ % The bool records whether any cyclic insts or modes were detected.
+ %
+:- pred add_item_decl_pass_1(item::in, prog_context::in,
+ item_status::in, item_status::out, module_info::in, module_info::out,
+ bool::out, io::di, io::uo) is det.
+
:- pred add_item_clause(item::in, import_status::in, import_status::out,
prog_context::in, module_info::in, module_info::out,
qual_info::in, qual_info::out, io::di, io::uo) is det.
@@ -147,11 +153,10 @@
item_status(local, may_be_unqualified)),
InvalidTypes1, !Module, !IO),
- % Add constructors and special preds to the HLDS.
- % This must be done after adding all type and
- % `:- pragma foreign_type' declarations.
- % If there were errors in foreign type type declarations,
- % doing this may cause a compiler abort.
+ % Add constructors and special preds to the HLDS. This must be done
+ % after adding all type and `:- pragma foreign_type' declarations.
+ % If there were errors in foreign type type declarations, doing this
+ % may cause a compiler abort.
(
InvalidTypes1 = no,
module_info_get_type_table(!.Module, Types),
@@ -168,16 +173,8 @@
Name = mercury_public_builtin_module,
compiler_generated_rtti_for_builtins(!.Module)
->
- varset.init(TVarSet),
- Body = abstract_type(non_solver_type),
- term.context_init(Context),
- Status = local,
- list.foldl(
- (pred(TypeCtor::in, M0::in, M::out) is det :-
- construct_type(TypeCtor, [], Type),
- add_special_preds(TVarSet, Type, TypeCtor, Body, Context,
- Status, M0, M)
- ), builtin_type_ctors_with_no_hlds_type_defn, !Module)
+ list.foldl(add_builtin_type_ctor_special_preds,
+ builtin_type_ctors_with_no_hlds_type_defn, !Module)
;
true
),
@@ -206,6 +203,18 @@
ModuleInfo = !.Module
).
+:- pred add_builtin_type_ctor_special_preds(type_ctor::in,
+ module_info::in, module_info::out) is det.
+
+add_builtin_type_ctor_special_preds(TypeCtor, !ModuleInfo) :-
+ varset.init(TVarSet),
+ Body = abstract_type(non_solver_type),
+ term.context_init(Context),
+ Status = local,
+ construct_type(TypeCtor, [], Type),
+ add_special_preds(TVarSet, Type, TypeCtor, Body, Context, Status,
+ !ModuleInfo).
+
check_for_errors(P, FoundError, !ModuleInfo, !IO) :-
io.get_exit_status(BeforeStatus, !IO),
io.set_exit_status(0, !IO),
@@ -241,12 +250,12 @@
io::di, io::uo) is det.
add_item_list_decls_pass_1([], _, !ModuleInfo, !InvalidModes, !IO).
-add_item_list_decls_pass_1([Item - Context | Items], Status0, !ModuleInfo,
+add_item_list_decls_pass_1([Item - Context | Items], !.Status, !ModuleInfo,
!InvalidModes, !IO) :-
- add_item_decl_pass_1(Item, Context, Status0, Status1, !ModuleInfo,
+ add_item_decl_pass_1(Item, Context, !Status, !ModuleInfo,
NewInvalidModes, !IO),
!:InvalidModes = bool.or(!.InvalidModes, NewInvalidModes),
- add_item_list_decls_pass_1(Items, Status1, !ModuleInfo, !InvalidModes,
+ add_item_list_decls_pass_1(Items, !.Status, !ModuleInfo, !InvalidModes,
!IO).
% pass 2:
@@ -279,14 +288,13 @@
% pass 3:
% Add the clauses one by one to the module.
%
- % Check that the declarations for field extraction
- % and update functions are sensible.
+ % Check that the declarations for field extraction and update functions
+ % are sensible.
%
- % Check that predicates listed in `:- initialise' declarations
- % exist and have the right signature, introduce pragma export
- % declarations for them and record their exported name in the
- % module_info so that we can tell the code generator to call
- % it at initialisation time.
+ % Check that predicates listed in `:- initialise' declarations exist
+ % and have the right signature, introduce pragma export declarations
+ % for them and record their exported name in the module_info so that
+ % we can tell the code generator to call it at initialisation time.
%
:- pred add_item_list_clauses(item_list::in, import_status::in,
module_info::in, module_info::out, qual_info::in, qual_info::out,
@@ -301,13 +309,6 @@
%-----------------------------------------------------------------------------%
- % The bool records whether any cyclic insts or modes were
- % detected.
- %
-:- pred add_item_decl_pass_1(item::in, prog_context::in,
- item_status::in, item_status::out, module_info::in, module_info::out,
- bool::out, io::di, io::uo) is det.
-
add_item_decl_pass_1(clause(_, _, _, _, _, _), _, !Status, !ModuleInfo, no,
!IO).
% Skip clauses.
@@ -620,9 +621,10 @@
Details = mutable_decl
;
( Details = initialise_decl
+ ; Details = finalise_decl
; Details = solver_type
; Details = foreign_imports
- ; Details = finalise_decl
+ ; Details = pragma_memo_attribute
),
unexpected(this_file, "Bad introduced initialise declaration.")
)
@@ -669,7 +671,7 @@
% XXX We don't currently support the foreign_name attribute
% for languages other than C.
%
- ( CompilationTarget = c ->
+ ( CompilationTarget = target_c ->
mutable_var_maybe_foreign_names(MutAttrs) = MaybeForeignNames,
module_info_get_name(!.ModuleInfo, ModuleName),
(
@@ -719,7 +721,7 @@
get_global_name_from_foreign_names(ReportErrors, Context, ModuleName,
MercuryMutableName, ForeignNames, TargetMutableName, !IO) :-
- solutions.solutions(get_matching_foreign_name(ForeignNames, c),
+ solutions.solutions(get_matching_foreign_name(ForeignNames, lang_c),
TargetMutableNames),
(
TargetMutableNames = [],
@@ -774,10 +776,12 @@
Origin = compiler(Details),
(
% Ignore clauses that are introduced as a result of
- % `initialise', `finalise' or `mutable' declarations.
+ % `initialise', `finalise' or `mutable' declarations
+ % or pragma memos.
( Details = initialise_decl
- ; Details = mutable_decl
; Details = finalise_decl
+ ; Details = mutable_decl
+ ; Details = pragma_memo_attribute
)
;
( Details = solver_type
@@ -805,7 +809,8 @@
->
add_solver_type_clause_items(SymName, TypeParams, SolverTypeDetails,
!Status, Context, !ModuleInfo, !QualInfo, !IO),
- add_solver_type_mutable_items_clauses(SolverTypeDetails^mutable_items,
+ MutableItems = SolverTypeDetails ^ mutable_items,
+ add_solver_type_mutable_items_clauses(MutableItems,
!Status, Context, !ModuleInfo, !QualInfo, !IO)
;
true
@@ -869,19 +874,20 @@
module_add_pragma_fact_table(Pred, Arity, File, !.Status,
Context, !ModuleInfo, !QualInfo, !IO)
;
- Pragma = tabled(Type, Name, Arity, PredOrFunc, Mode)
+ Pragma = tabled(Type, Name, Arity, PredOrFunc, MaybeModes,
+ MaybeAttributes)
->
globals.io_lookup_bool_option(type_layout, TypeLayout, !IO),
(
TypeLayout = yes,
- module_add_pragma_tabled(Type, Name, Arity, PredOrFunc,
- Mode, !.Status, Context, !ModuleInfo, !IO)
+ module_add_pragma_tabled(Type, Name, Arity, PredOrFunc, MaybeModes,
+ MaybeAttributes, !Status, Context, !ModuleInfo, !QualInfo, !IO)
;
TypeLayout = no,
module_info_incr_errors(!ModuleInfo),
prog_out.write_context(Context, !IO),
io.write_string("Error: `:- pragma ", !IO),
- EvalMethodS = eval_method_to_one_string(Type),
+ EvalMethodS = eval_method_to_string(Type),
io.write_string(EvalMethodS, !IO),
io.write_string("' declaration requires the type_ctor_layout\n",
!IO),
@@ -898,7 +904,7 @@
% So we ignore these pragmas for the Java back-end.
%
globals.io_get_target(Target, !IO),
- ( Target = java ->
+ ( Target = target_java ->
true
;
add_pragma_type_spec(Pragma, Context, !ModuleInfo, !QualInfo, !IO)
@@ -927,8 +933,8 @@
;
Pragma = reserve_tag(TypeName, TypeArity)
->
- add_pragma_reserve_tag(TypeName, TypeArity, !.Status,
- Context, !ModuleInfo, !IO)
+ add_pragma_reserve_tag(TypeName, TypeArity, !.Status, Context,
+ !ModuleInfo, !IO)
;
Pragma = export(Name, PredOrFunc, Modes, C_Function)
->
@@ -1090,8 +1096,7 @@
may_be_partially_qualified, SymName, Arity, PredIds)
->
(
- PredIds = [PredId]
- ->
+ PredIds = [PredId],
module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
pred_info_get_arg_types(PredInfo, ArgTypes),
pred_info_get_procedures(PredInfo, ProcTable),
@@ -1146,6 +1151,14 @@
module_info_incr_errors(!ModuleInfo)
)
;
+ PredIds = [],
+ write_error_pieces(Context, 0, [words("Error:"),
+ sym_name_and_arity(SymName/Arity),
+ words(" used in finalise declaration has " ++
+ "no pred declarations.")], !IO),
+ module_info_incr_errors(!ModuleInfo)
+ ;
+ PredIds = [_, _ | _],
write_error_pieces(Context, 0, [words("Error:"),
sym_name_and_arity(SymName/Arity),
words(" used in finalise declaration has " ++
@@ -1165,7 +1178,7 @@
module_info_get_name(!.ModuleInfo, ModuleName),
varset.new_named_var(varset.init, "X", X, ProgVarSet0),
InstVarset = varset.init,
- Attrs0 = default_attributes(c),
+ Attrs0 = default_attributes(lang_c),
globals.io_lookup_bool_option(mutable_always_boxed, AlwaysBoxed, !IO),
(
AlwaysBoxed = yes,
@@ -1203,7 +1216,7 @@
% XXX We don't currently support the foreign_name attribute
% for languages other than C.
%
- ( CompilationTarget = c ->
+ ( CompilationTarget = target_c ->
get_mutable_global_foreign_decl_defn(!.ModuleInfo, Type,
TargetMutableName, ForeignDecl, ForeignDefn),
ItemStatus0 = item_status(local, may_be_unqualified),
@@ -1379,13 +1392,14 @@
module_info_get_globals(ModuleInfo, Globals),
globals.lookup_bool_option(Globals, mutable_always_boxed, AlwaysBoxed),
globals.get_target(Globals, Backend),
- ( Backend = c ->
- TypeName = global_foreign_type_name(AlwaysBoxed, c, ModuleInfo, Type),
+ ( Backend = target_c ->
+ TypeName = global_foreign_type_name(AlwaysBoxed, lang_c, ModuleInfo,
+ Type),
Decl = pragma(compiler(mutable_decl),
- foreign_decl(c, foreign_decl_is_exported,
+ foreign_decl(lang_c, foreign_decl_is_exported,
"extern " ++ TypeName ++ " " ++ TargetMutableName ++ ";")),
Defn = pragma(compiler(mutable_decl),
- foreign_code(c, TypeName ++ " " ++ TargetMutableName ++ ";"))
+ foreign_code(lang_c, TypeName ++ " " ++ TargetMutableName ++ ";"))
;
sorry(this_file, "we don't yet support mutables for non-C backends")
).
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.389
diff -u -b -r1.389 mercury_compile.m
--- compiler/mercury_compile.m 5 Jun 2006 02:26:07 -0000 1.389
+++ compiler/mercury_compile.m 5 Jun 2006 03:20:18 -0000
@@ -419,7 +419,7 @@
file_name_to_module_name(FirstModule,
MainModuleName),
globals.get_target(Globals, Target),
- ( Target = java ->
+ ( Target = target_java ->
% For Java, at the "link" step we just
% generate a shell script; the actual
% linking will be done at runtime by
@@ -531,7 +531,7 @@
:- pred compiling_to_asm(globals::in) is semidet.
compiling_to_asm(Globals) :-
- globals.get_target(Globals, asm),
+ globals.get_target(Globals, target_asm),
% even if --target asm is specified,
% it can be overridden by other options:
OptionList = [convert_to_mercury, generate_dependencies,
@@ -1067,7 +1067,7 @@
recompilation.check.should_recompile(ModuleName, FindTargetFiles,
FindTimestampFiles, ModulesToRecompile0, ReadModules, !IO),
(
- Target = asm,
+ Target = target_asm,
ModulesToRecompile0 = some_modules([_ | _])
->
%
@@ -1095,7 +1095,7 @@
FactTableObjFiles = []
;
(
- Target = asm,
+ Target = target_asm,
Smart = yes
->
% See the comment in process_all_args.
@@ -1295,10 +1295,10 @@
find_smart_recompilation_target_files(TopLevelModuleName,
Globals, FindTargetFiles) :-
globals.get_target(Globals, CompilationTarget),
- ( CompilationTarget = c, TargetSuffix = ".c"
- ; CompilationTarget = il, TargetSuffix = ".il"
- ; CompilationTarget = java, TargetSuffix = ".java"
- ; CompilationTarget = asm, TargetSuffix = ".s"
+ ( CompilationTarget = target_c, TargetSuffix = ".c"
+ ; CompilationTarget = target_il, TargetSuffix = ".il"
+ ; CompilationTarget = target_java, TargetSuffix = ".java"
+ ; CompilationTarget = target_asm, TargetSuffix = ".s"
),
FindTargetFiles = usual_find_target_files(CompilationTarget,
TargetSuffix, TopLevelModuleName).
@@ -1311,7 +1311,7 @@
ModuleName, TargetFiles, !IO) :-
% XXX Should we check the generated header files?
(
- CompilationTarget = asm,
+ CompilationTarget = target_asm,
ModuleName \= TopLevelModuleName
->
% With `--target asm' all the nested sub-modules are placed
@@ -1329,16 +1329,16 @@
globals.lookup_bool_option(Globals, pic, Pic),
globals.get_target(Globals, CompilationTarget),
(
- CompilationTarget = c,
+ CompilationTarget = target_c,
TimestampSuffix = ".c_date"
;
- CompilationTarget = il,
+ CompilationTarget = target_il,
TimestampSuffix = ".il_date"
;
- CompilationTarget = java,
+ CompilationTarget = target_java,
TimestampSuffix = ".java_date"
;
- CompilationTarget = asm,
+ CompilationTarget = target_asm,
TimestampSuffix = (Pic = yes -> ".pic_s_date" ; ".s_date")
),
FindTimestampFiles = find_timestamp_files_2(CompilationTarget,
@@ -1351,7 +1351,7 @@
find_timestamp_files_2(CompilationTarget, TimestampSuffix,
TopLevelModuleName, ModuleName, TimestampFiles, !IO) :-
(
- CompilationTarget = asm,
+ CompilationTarget = target_asm,
ModuleName \= TopLevelModuleName
->
% With `--target asm' all the nested
@@ -1504,8 +1504,8 @@
module_info_get_num_errors(!.HLDS, NumErrors),
( NumErrors = 0 ->
(
- ( Target = c
- ; Target = asm
+ ( Target = target_c
+ ; Target = target_asm
)
->
%
@@ -1518,7 +1518,8 @@
;
true
),
- ( Target = il ->
+ (
+ Target = target_il,
mlds_backend(!.HLDS, _, MLDS, !DumpInfo, !IO),
(
TargetCodeOnly = yes,
@@ -1533,7 +1534,8 @@
maybe_set_exit_status(Succeeded, !IO)
),
FactTableBaseFiles = []
- ; Target = java ->
+ ;
+ Target = target_java,
mlds_backend(!.HLDS, _, MLDS, !DumpInfo, !IO),
mlds_to_java(!.HLDS, MLDS, !IO),
(
@@ -1548,7 +1550,8 @@
maybe_set_exit_status(Succeeded, !IO)
),
FactTableBaseFiles = []
- ; Target = asm ->
+ ;
+ Target = target_asm,
% compile directly to assembler using the gcc back-end
mlds_backend(!.HLDS, _, MLDS, !DumpInfo, !IO),
maybe_mlds_to_gcc(MLDS, ContainsCCode, !IO),
@@ -1570,28 +1573,34 @@
)
),
FactTableBaseFiles = []
- ; HighLevelCode = yes ->
+ ;
+ Target = target_c,
+ (
+ HighLevelCode = yes,
mlds_backend(!.HLDS, _, MLDS, !DumpInfo, !IO),
mlds_to_high_level_c(MLDS, !IO),
(
TargetCodeOnly = yes
;
TargetCodeOnly = no,
- module_name_to_file_name(ModuleName, ".c", no, C_File, !IO),
+ module_name_to_file_name(ModuleName, ".c", no, C_File,
+ !IO),
get_linked_target_type(TargetType, !IO),
get_object_code_type(TargetType, PIC, !IO),
maybe_pic_object_file_extension(PIC, Obj, !IO),
module_name_to_file_name(ModuleName, Obj, yes, O_File, !IO),
io.output_stream(OutputStream, !IO),
- compile_target_code.compile_c_file(OutputStream, PIC, C_File,
- O_File, CompileOK, !IO),
+ compile_target_code.compile_c_file(OutputStream, PIC,
+ C_File, O_File, CompileOK, !IO),
maybe_set_exit_status(CompileOK, !IO)
),
FactTableBaseFiles = []
;
+ HighLevelCode = no,
backend_pass(!HLDS, GlobalData, LLDS, !DumpInfo, !IO),
output_pass(!.HLDS, GlobalData, LLDS, ModuleName,
_CompileErrors, FactTableBaseFiles, !IO)
+ )
),
recompilation.usage.write_usage_file(!.HLDS, NestedSubModules,
MaybeTimestamps, !IO),
@@ -1616,7 +1625,7 @@
get_object_code_type(TargetType, PIC, !IO),
maybe_pic_object_file_extension(PIC, Obj, !IO),
module_name_to_file_name(ModuleName, ".c", no, CCode_C_File, !IO),
- ForeignModuleName = foreign_language_module_name(ModuleName, c),
+ ForeignModuleName = foreign_language_module_name(ModuleName, lang_c),
module_name_to_file_name(ForeignModuleName, Obj, yes, CCode_O_File, !IO),
io.output_stream(OutputStream, !IO),
compile_target_code.compile_c_file(OutputStream, PIC,
@@ -3182,16 +3191,16 @@
globals.io_lookup_bool_option(optimize_trail_usage, OptTrailUse, !IO),
globals.io_get_target(Target, !IO),
(
- Target = c,
+ Target = target_c,
globals.io_lookup_bool_option(generate_trail_ops_inline,
GenerateInline, !IO)
;
% XXX Currently, we can only generate trail ops inline for
% the C backends.
%
- ( Target = il
- ; Target = java
- ; Target = asm
+ ( Target = target_il
+ ; Target = target_java
+ ; Target = target_asm
),
GenerateInline = no
),
@@ -3314,7 +3323,7 @@
tabling(Verbose, Stats, !HLDS, !IO) :-
maybe_write_string(Verbose, "% Transforming tabled predicates...", !IO),
maybe_flush_output(Verbose, !IO),
- table_gen.process_module(!HLDS, !IO),
+ table_gen_process_module(!HLDS, !IO),
maybe_write_string(Verbose, " done.\n", !IO),
maybe_report_stats(Stats, !IO).
@@ -4072,8 +4081,8 @@
% Here we perform some optimizations on the LLDS data.
% XXX This should perhaps be part of backend_pass rather than output_pass.
% XXX We assume that the foreign language we use is C.
- get_c_interface_info(HLDS, c, C_InterfaceInfo),
- global_data_get_all_proc_vars(GlobalData, GlobalVars),
+ get_c_interface_info(HLDS, lang_c, C_InterfaceInfo),
+ global_data_get_all_proc_vars(GlobalData, TablingInfoStructs),
global_data_get_all_closure_layouts(GlobalData, ClosureLayoutDatas),
global_data_get_static_cell_info(GlobalData, StaticCellInfo),
get_static_cells(StaticCellInfo,
@@ -4082,7 +4091,7 @@
% Next we put it all together and output it to one or more C files.
RttiDatas = TypeCtorRttiData ++ TypeClassInfoRttiData,
LayoutDatas = ClosureLayoutDatas ++ StackLayoutDatas,
- construct_c_file(HLDS, C_InterfaceInfo, Procs, GlobalVars,
+ construct_c_file(HLDS, C_InterfaceInfo, Procs, TablingInfoStructs,
ScalarCommonCellDatas, VectorCommonCellDatas, RttiDatas, LayoutDatas,
CFile, !IO),
module_info_get_complexity_proc_infos(HLDS, ComplexityProcs),
@@ -4113,12 +4122,12 @@
% Split the code up into bite-size chunks for the C compiler.
%
:- pred construct_c_file(module_info::in, foreign_interface_info::in,
- list(c_procedure)::in, list(comp_gen_c_var)::in,
+ list(c_procedure)::in, list(tabling_info_struct)::in,
list(scalar_common_data_array)::in, list(vector_common_data_array)::in,
list(rtti_data)::in, list(layout_data)::in, c_file::out, io::di, io::uo)
is det.
-construct_c_file(ModuleInfo, C_InterfaceInfo, Procedures, GlobalVars,
+construct_c_file(ModuleInfo, C_InterfaceInfo, Procedures, TablingInfoStructs,
ScalarCommonCellDatas, VectorCommonCellDatas, RttiDatas, LayoutDatas,
CFile, !IO) :-
C_InterfaceInfo = foreign_interface_info(ModuleSymName, C_HeaderCode0,
@@ -4153,7 +4162,7 @@
module_info_user_final_pred_c_names(ModuleInfo, UserFinalPredCNames),
CFile = c_file(ModuleSymName, C_HeaderCode, C_BodyCode, C_ExportDefns,
- GlobalVars, ScalarCommonCellDatas, VectorCommonCellDatas,
+ TablingInfoStructs, ScalarCommonCellDatas, VectorCommonCellDatas,
RttiDatas, LayoutDatas, ChunkedModules, UserInitPredCNames,
UserFinalPredCNames).
@@ -4169,9 +4178,9 @@
Define = decl_guard(ModuleName),
Start = "#ifndef " ++ Define ++ "\n#define " ++ Define ++ "\n",
End = "\n#endif",
- StartGuard = foreign_decl_code(c, foreign_decl_is_exported, Start,
+ StartGuard = foreign_decl_code(lang_c, foreign_decl_is_exported, Start,
term.context_init),
- EndGuard = foreign_decl_code(c, foreign_decl_is_exported, End,
+ EndGuard = foreign_decl_code(lang_c, foreign_decl_is_exported, End,
term.context_init).
:- pred make_foreign_import_header_code(foreign_import_module::in,
@@ -4180,26 +4189,26 @@
make_foreign_import_header_code(ForeignImportModule, Include, !IO) :-
ForeignImportModule = foreign_import_module(Lang, ModuleName, Context),
(
- Lang = c,
+ Lang = lang_c,
module_name_to_search_file_name(ModuleName, ".mh", HeaderFileName,
!IO),
IncludeString = "#include """ ++ HeaderFileName ++ """\n",
- Include = foreign_decl_code(c, foreign_decl_is_exported,
+ Include = foreign_decl_code(lang_c, foreign_decl_is_exported,
IncludeString, Context)
;
- Lang = csharp,
+ Lang = lang_csharp,
sorry(this_file, ":- import_module not yet implemented: " ++
"`:- pragma foreign_import_module' for C#")
;
- Lang = managed_cplusplus,
+ Lang = lang_managed_cplusplus,
sorry(this_file, ":- import_module not yet implemented: " ++
"`:- pragma foreign_import_module' for Managed C++")
;
- Lang = il,
+ Lang = lang_il,
sorry(this_file, ":- import_module not yet implemented: " ++
"`:- pragma foreign_import_module' for IL")
;
- Lang = java,
+ Lang = lang_java,
sorry(this_file, ":- import_module not yet implemented: " ++
"`:- pragma foreign_import_module' for Java")
).
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.291
diff -u -b -r1.291 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 5 Jun 2006 02:26:08 -0000 1.291
+++ compiler/mercury_to_mercury.m 5 Jun 2006 11:29:00 -0000
@@ -584,10 +584,61 @@
Pragma = obsolete(Pred, Arity),
mercury_output_pragma_decl(Pred, Arity, predicate, "obsolete", no, !IO)
;
- Pragma = tabled(Type, Pred, Arity, _PredOrFunc, _Mode),
- TypeS - MaybeAfter = eval_method_to_string(Type),
- mercury_output_pragma_decl(Pred, Arity, predicate, TypeS, MaybeAfter,
- !IO)
+ Pragma = tabled(Type, Pred, Arity, _PredOrFunc, _Mode,
+ MaybeAttributes),
+ PragmaName = eval_method_to_string(Type),
+ (
+ MaybeAttributes = yes(Attributes),
+ Attributes = table_attributes(Strictness, MaybeSizeLimit, Stats,
+ AllowReset),
+ some [!Strs] (
+ !:Strs = [],
+ (
+ Strictness = all_strict
+ ;
+ Strictness = all_fast_loose,
+ !:Strs = ["fast_loose" | !.Strs]
+ ;
+ Strictness = specified(Args),
+ ArgStrs = list.map(maybe_arg_tabling_method_to_string,
+ Args),
+ ArgsStr = string.join_list(", ", ArgStrs),
+ !:Strs = ["specified(" ++ ArgsStr ++ ")" | !.Strs]
+ ),
+ (
+ MaybeSizeLimit = yes(SizeLimit),
+ LimitStr = "limit(" ++ int_to_string(SizeLimit) ++ ")",
+ !:Strs = [LimitStr | !.Strs]
+ ;
+ MaybeSizeLimit = no
+ ),
+ (
+ Stats = yes,
+ !:Strs = ["statistics" | !.Strs]
+ ;
+ Stats = no
+ ),
+ (
+ AllowReset = yes,
+ !:Strs = ["allow_reset" | !.Strs]
+ ;
+ AllowReset = no
+ ),
+ (
+ !.Strs = [],
+ MaybeAfter = no
+ ;
+ !.Strs = [_ | _],
+ MaybeAfter =
+ yes("[" ++ string.join_list(", ", !.Strs) ++ "]")
+ )
+ )
+ ;
+ MaybeAttributes = no,
+ MaybeAfter = no
+ ),
+ mercury_output_pragma_decl(Pred, Arity, predicate, PragmaName,
+ MaybeAfter, !IO)
;
Pragma = type_spec(_, _, _, _, _, _, _, _),
AppendVarnums = no,
@@ -1525,8 +1576,8 @@
add_string("<type_info_cell_constructor>", !U).
mercury_format_cons_id(typeclass_info_cell_constructor, _, !U) :-
add_string("<typeclass_info_cell_constructor>", !U).
-mercury_format_cons_id(tabling_pointer_const(_), _, !U) :-
- add_string("<tabling pointer>", !U).
+mercury_format_cons_id(tabling_info_const(_), _, !U) :-
+ add_string("<tabling info>", !U).
mercury_format_cons_id(deep_profiling_proc_layout(_), _, !U) :-
add_string("<deep_profiling_proc_layout>", !U).
mercury_format_cons_id(table_io_decl(_), _, !U) :-
@@ -1680,7 +1731,7 @@
mercury_output_term(MercuryType, TVarSet, no, !IO),
io.write_string(", \"", !IO),
(
- ForeignType = il(il(RefOrVal, ForeignLocStr, ForeignTypeName)),
+ ForeignType = il(il_type(RefOrVal, ForeignLocStr, ForeignTypeName)),
(
RefOrVal = reference,
RefOrValStr = "class "
@@ -1691,9 +1742,9 @@
sym_name_to_string(ForeignTypeName, ".", NameStr),
ForeignTypeStr = RefOrValStr ++ "[" ++ ForeignLocStr ++ "]" ++ NameStr
;
- ForeignType = c(c(ForeignTypeStr))
+ ForeignType = c(c_type(ForeignTypeStr))
;
- ForeignType = java(java(ForeignTypeStr))
+ ForeignType = java(java_type(ForeignTypeStr))
),
io.write_string(ForeignTypeStr, !IO),
io.write_string("\"", !IO),
@@ -4097,7 +4148,7 @@
output_eval_method(EvalMethod, !Str) :-
output_string("eval_", !Str),
- output_string(eval_method_to_one_string(EvalMethod), !Str).
+ output_string(eval_method_to_string(EvalMethod), !Str).
:- pred output_lambda_eval_method(lambda_eval_method::in,
string::di, string::uo) is det.
Index: compiler/ml_call_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_call_gen.m,v
retrieving revision 1.67
diff -u -b -r1.67 ml_call_gen.m
--- compiler/ml_call_gen.m 29 Mar 2006 08:07:02 -0000 1.67
+++ compiler/ml_call_gen.m 5 Jun 2006 18:28:04 -0000
@@ -595,7 +595,8 @@
ml_gen_pred_label(ModuleInfo, PredId, ProcId, PredLabel, PredModule),
ml_gen_proc_params(PredId, ProcId, Params, !Info),
Signature = mlds_get_func_signature(Params),
- QualifiedProcLabel = qual(PredModule, module_qual, PredLabel - ProcId),
+ ProcLabel = mlds_proc_label(PredLabel, ProcId),
+ QualifiedProcLabel = qual(PredModule, module_qual, ProcLabel),
CodeAddrRval = const(code_addr_const(proc(QualifiedProcLabel, Signature))).
% Generate rvals and lvals for the arguments of a procedure call
Index: compiler/ml_closure_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_closure_gen.m,v
retrieving revision 1.42
diff -u -b -r1.42 ml_closure_gen.m
--- compiler/ml_closure_gen.m 29 Mar 2006 08:07:02 -0000 1.42
+++ compiler/ml_closure_gen.m 12 May 2006 04:19:38 -0000
@@ -355,7 +355,7 @@
),
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
Rval = const(data_addr_const(data_addr(MLDS_ModuleName,
- rtti(RttiId)))),
+ mlds_rtti(RttiId)))),
Type = mlds_rtti_type(item_type(RttiId))
).
@@ -388,7 +388,8 @@
arg_type_infos(TypeInfo), !Defns)
),
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
- Rval = const(data_addr_const(data_addr(MLDS_ModuleName, rtti(RttiId)))),
+ Rval = const(data_addr_const(data_addr(MLDS_ModuleName,
+ mlds_rtti(RttiId)))),
Type = mlds_rtti_type(item_type(RttiId)).
:- func arg_maybe_pseudo_type_infos(rtti_pseudo_type_info)
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.177
diff -u -b -r1.177 ml_code_gen.m
--- compiler/ml_code_gen.m 26 Apr 2006 03:05:37 -0000 1.177
+++ compiler/ml_code_gen.m 6 Jun 2006 02:18:09 -0000
@@ -766,6 +766,7 @@
:- import_module backend_libs.c_util.
:- import_module backend_libs.export.
:- import_module backend_libs.foreign. % XXX needed for pragma foreign code
+:- import_module backend_libs.rtti.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.type_util.
:- import_module hlds.goal_util.
@@ -782,6 +783,7 @@
:- import_module ml_backend.ml_switch_gen.
:- import_module ml_backend.ml_type_gen.
:- import_module ml_backend.ml_unify_gen.
+:- import_module ml_backend.ml_util.
:- import_module parse_tree.modules.
:- import_module parse_tree.prog_foreign.
:- import_module parse_tree.prog_type.
@@ -797,6 +799,7 @@
:- import_module set.
:- import_module solutions.
:- import_module string.
+:- import_module std_util.
:- import_module term.
%-----------------------------------------------------------------------------%
@@ -848,8 +851,8 @@
MLDSWantedForeignBodys = list.map(ConvBody, WantedForeignBodys),
% XXX Exports are only implemented for C and IL at the moment.
(
- ( Lang = c
- ; Lang = il
+ ( Lang = lang_c
+ ; Lang = lang_il
)
->
ml_gen_pragma_export(ModuleInfo, MLDS_PragmaExports)
@@ -886,13 +889,13 @@
:- func foreign_type_required_imports(compilation_target, hlds_type_defn)
= list(mlds_import).
-foreign_type_required_imports(c, _) = [].
-foreign_type_required_imports(il, TypeDefn) = Imports :-
+foreign_type_required_imports(target_c, _) = [].
+foreign_type_required_imports(target_il, TypeDefn) = Imports :-
hlds_data.get_type_defn_body(TypeDefn, Body),
( Body = foreign_type(foreign_type_body(MaybeIL, _MaybeC, _MaybeJava)) ->
(
MaybeIL = yes(Data),
- Data = foreign_type_lang_data(il(_, Location, _), _, _)
+ Data = foreign_type_lang_data(il_type(_, Location, _), _, _)
->
Name = il_assembly_name(mercury_module_name_to_mlds(
unqualified(Location))),
@@ -903,8 +906,8 @@
;
Imports = []
).
-foreign_type_required_imports(java, _) = [].
-foreign_type_required_imports(asm, _) = [].
+foreign_type_required_imports(target_java, _) = [].
+foreign_type_required_imports(target_asm, _) = [].
:- pred ml_gen_defns(module_info::in, mlds_defns::out, io::di, io::uo) is det.
@@ -1039,36 +1042,285 @@
ml_gen_maybe_add_table_var(ModuleInfo, PredId, ProcId, ProcInfo, !Defns) :-
proc_info_get_eval_method(ProcInfo, EvalMethod),
+ HasTablingPointer = eval_method_has_per_proc_tabling_pointer(EvalMethod),
(
- eval_method_has_per_proc_tabling_pointer(EvalMethod) = yes
- ->
+ HasTablingPointer = yes,
+ ml_gen_add_table_var(ModuleInfo, PredId, ProcId, ProcInfo, EvalMethod,
+ !Defns)
+ ;
+ HasTablingPointer = no
+ ).
+
+:- pred ml_gen_add_table_var(module_info::in, pred_id::in, proc_id::in,
+ proc_info::in, eval_method::in, mlds_defns::in, mlds_defns::out) is det.
+
+ml_gen_add_table_var(ModuleInfo, PredId, ProcId, ProcInfo, EvalMethod,
+ !Defns) :-
+ module_info_get_name(ModuleInfo, ModuleName),
+ MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
ml_gen_pred_label(ModuleInfo, PredId, ProcId, PredLabel, _PredModule),
- Var = tabling_pointer(PredLabel - ProcId),
- Type = mlds_generic_type,
- Initializer = init_obj(const(null(Type))),
+ ProcLabel = mlds_proc_label(PredLabel, ProcId),
proc_info_get_context(ProcInfo, Context),
- (
+ MLDS_Context = mlds_make_context(Context),
+
module_info_get_globals(ModuleInfo, Globals),
globals.get_gc_method(Globals, GC_Method),
- GC_Method = accurate
- ->
- % XXX To handle this case properly, the GC would need to trace
- % through the global variable that we generate for the table
- % pointer. Support for this is not yet implemented. Also, we'd need
- % to add GC support (stack frame registration, and calls to
- % MR_GC_check()) to MR_make_long_lived() and MR_deep_copy()
- % so that we do garbage collection of the "global heap" which is
- % used to store the tables.
- sorry(this_file, "tabling and `--gc accurate'")
+ % XXX To handle accurate GC properly, the GC would need to trace through
+ % the global variable that we generate for the table pointer. Support
+ % for this is not yet implemented. Also, we would need to add GC support
+ % (stack frame registration, and calls to MR_GC_check()) to
+ % MR_make_long_lived() and MR_deep_copy() so that we do garbage collection
+ % of the "global heap" which is used to store the tables.
+ expect(isnt(unify(accurate), GC_Method), this_file,
+ "tabling and `--gc accurate'"),
+
+ (
+ EvalMethod = eval_normal,
+ unexpected(this_file, "ml_gen_add_table_var: eval_normal")
+ ;
+ EvalMethod = eval_table_io(_, _),
+ unexpected(this_file, "ml_gen_add_table_var: eval_table_io")
+ ;
+ EvalMethod = eval_loop_check,
+ TableTypeStr = "MR_TABLE_TYPE_LOOPCHECK"
;
- GC_TraceCode = no
+ EvalMethod = eval_memo,
+ TableTypeStr = "MR_TABLE_TYPE_MEMO"
+ ;
+ EvalMethod = eval_minimal(stack_copy),
+ TableTypeStr = "MR_TABLE_TYPE_MINIMAL_MODEL_STACK_COPY"
+ ;
+ EvalMethod = eval_minimal(own_stacks),
+ TableTypeStr = "MR_TABLE_TYPE_MINIMAL_MODEL_OWN_STACKS"
),
- TablePointerVarDefn = ml_gen_mlds_var_decl(Var, Type, Initializer,
- GC_TraceCode, mlds_make_context(Context)),
- !:Defns = [TablePointerVarDefn | !.Defns]
+ proc_info_get_maybe_proc_table_info(ProcInfo, MaybeTableInfo),
+ (
+ MaybeTableInfo = yes(TableInfo),
+ (
+ % The _ArgInfos argument is intended for the debugger,
+ % which isn't supported by the this backend.
+ TableInfo = table_gen_info(NumInputs, NumOutputs,
+ InputSteps, MaybeOutputSteps, _ArgInfos)
;
- true
- ).
+ TableInfo = table_io_decl_info(_),
+ unexpected(this_file, "ml_gen_add_table_var: bad TableInfo")
+ )
+ ;
+ MaybeTableInfo = no,
+ unexpected(this_file, "ml_gen_add_table_var: no TableInfo")
+ ),
+
+ (
+ InputSteps = [],
+ % We don't want to generate arrays with zero elements.
+ InputStepsName = gen_init_null_pointer(
+ mlds_tabling_type(tabling_input_steps)),
+ InputEnumParamsName = gen_init_null_pointer(
+ mlds_tabling_type(tabling_input_enum_params)),
+ InputStepsDefns = [],
+ InputEnumParamsDefns = [],
+ CallStatsName = gen_init_null_pointer(
+ mlds_tabling_type(tabling_call_stats)),
+ PrevCallStatsName = gen_init_null_pointer(
+ mlds_tabling_type(tabling_prev_call_stats)),
+ CallStatsDefns = []
+ ;
+ InputSteps = [_ | _],
+ list.map2(table_trie_step_to_c, InputSteps,
+ InputStepStrs, InputParams),
+ InputStepsInit = init_array(list.map(init_step, InputStepStrs)),
+ InputEnumParamsInit = init_array(
+ list.map(gen_init_enum_param, InputParams)),
+ InputStepsDefn = tabling_name_and_init_to_defn(ProcLabel,
+ MLDS_Context, const, tabling_input_steps,
+ InputStepsInit),
+ InputEnumParamsDefn = tabling_name_and_init_to_defn(ProcLabel,
+ MLDS_Context, const, tabling_input_enum_params,
+ InputEnumParamsInit),
+ InputStepsName = gen_init_tabling_name(MLDS_ModuleName,
+ ProcLabel, tabling_input_steps),
+ InputEnumParamsName = gen_init_tabling_name(MLDS_ModuleName,
+ ProcLabel, tabling_input_enum_params),
+ CallStatsInit =
+ init_array(list.map(init_stats(tabling_call_stats),
+ InputSteps)),
+ PrevCallStatsInit =
+ init_array(list.map(init_stats(tabling_prev_call_stats),
+ InputSteps)),
+ CallStatsDefn = tabling_name_and_init_to_defn(ProcLabel,
+ MLDS_Context, modifiable, tabling_call_stats,
+ CallStatsInit),
+ PrevCallStatsDefn = tabling_name_and_init_to_defn(ProcLabel,
+ MLDS_Context, modifiable, tabling_prev_call_stats,
+ PrevCallStatsInit),
+ CallStatsName = gen_init_tabling_name(MLDS_ModuleName,
+ ProcLabel, tabling_call_stats),
+ PrevCallStatsName = gen_init_tabling_name(MLDS_ModuleName,
+ ProcLabel, tabling_prev_call_stats),
+ InputStepsDefns = [InputStepsDefn],
+ InputEnumParamsDefns = [InputEnumParamsDefn],
+ CallStatsDefns = [CallStatsDefn, PrevCallStatsDefn]
+ ),
+ (
+ MaybeOutputSteps = no,
+ HasAnswerTable = 0,
+ OutputStepsName = gen_init_null_pointer(
+ mlds_tabling_type(tabling_output_steps)),
+ OutputEnumParamsName = gen_init_null_pointer(
+ mlds_tabling_type(tabling_output_enum_params)),
+ OutputStepsDefns = [],
+ OutputEnumParamsDefns = [],
+ AnswerStatsDefns = [],
+ AnswerStatsName = gen_init_null_pointer(
+ mlds_tabling_type(tabling_answer_stats)),
+ PrevAnswerStatsName = gen_init_null_pointer(
+ mlds_tabling_type(tabling_prev_answer_stats))
+ ;
+ MaybeOutputSteps = yes(OutputSteps),
+ HasAnswerTable = 1,
+ list.map2(table_trie_step_to_c, OutputSteps,
+ OutputStepStrs, OutputParams),
+ OutputStepsInit = init_array(list.map(init_step, OutputStepStrs)),
+ OutputEnumParamsInit = init_array(
+ list.map(gen_init_enum_param, OutputParams)),
+ OutputStepsDefn = tabling_name_and_init_to_defn(ProcLabel,
+ MLDS_Context, const, tabling_output_steps,
+ OutputStepsInit),
+ OutputEnumParamsDefn = tabling_name_and_init_to_defn(ProcLabel,
+ MLDS_Context, const, tabling_output_enum_params,
+ OutputEnumParamsInit),
+ OutputStepsName = gen_init_tabling_name(MLDS_ModuleName,
+ ProcLabel, tabling_output_steps),
+ OutputEnumParamsName = gen_init_tabling_name(MLDS_ModuleName,
+ ProcLabel, tabling_output_enum_params),
+ OutputStepsDefns = [OutputStepsDefn],
+ OutputEnumParamsDefns = [OutputEnumParamsDefn],
+ AnswerStatsInit =
+ init_array(list.map(init_stats(tabling_answer_stats),
+ OutputSteps)),
+ PrevAnswerStatsInit =
+ init_array(list.map(init_stats(tabling_prev_answer_stats),
+ OutputSteps)),
+ AnswerStatsDefn = tabling_name_and_init_to_defn(ProcLabel,
+ MLDS_Context, modifiable, tabling_answer_stats,
+ AnswerStatsInit),
+ PrevAnswerStatsDefn = tabling_name_and_init_to_defn(ProcLabel,
+ MLDS_Context, modifiable, tabling_prev_answer_stats,
+ PrevAnswerStatsInit),
+ AnswerStatsDefns = [AnswerStatsDefn, PrevAnswerStatsDefn],
+ AnswerStatsName = gen_init_tabling_name(MLDS_ModuleName,
+ ProcLabel, tabling_answer_stats),
+ PrevAnswerStatsName = gen_init_tabling_name(MLDS_ModuleName,
+ ProcLabel, tabling_prev_answer_stats)
+ ),
+
+ PTIsName = gen_init_null_pointer(mlds_tabling_type(tabling_ptis)),
+ TypeParamLocnsName = gen_init_null_pointer(
+ mlds_tabling_type(tabling_type_param_locns)),
+ RootNodeName = init_struct(mlds_tabling_type(tabling_root_node),
+ [gen_init_int(0)]),
+ TipsName = gen_init_null_pointer(mlds_tabling_type(tabling_tips)),
+
+ ProcTableInfoInit = init_struct(mlds_tabling_type(tabling_info), [
+ gen_init_builtin_const(TableTypeStr),
+ gen_init_int(NumInputs),
+ gen_init_int(NumOutputs),
+ gen_init_int(HasAnswerTable),
+ InputStepsName,
+ InputEnumParamsName,
+ OutputStepsName,
+ OutputEnumParamsName,
+ PTIsName,
+ TypeParamLocnsName,
+ RootNodeName,
+ gen_init_int(0),
+ gen_init_int(0),
+ CallStatsName,
+ gen_init_int(0),
+ gen_init_int(0),
+ PrevCallStatsName,
+ gen_init_int(0),
+ gen_init_int(0),
+ AnswerStatsName,
+ gen_init_int(0),
+ gen_init_int(0),
+ PrevAnswerStatsName,
+ gen_init_int(0),
+ TipsName,
+ gen_init_int(0),
+ gen_init_int(0)
+ ]),
+ ProcTableInfoDefn = tabling_name_and_init_to_defn(ProcLabel, MLDS_Context,
+ modifiable, tabling_info, ProcTableInfoInit),
+
+ !:Defns = InputStepsDefns ++ InputEnumParamsDefns ++
+ OutputStepsDefns ++ OutputEnumParamsDefns ++
+ CallStatsDefns ++ AnswerStatsDefns ++
+ [ProcTableInfoDefn | !.Defns].
+
+:- func init_step(string) = mlds_initializer.
+
+init_step(Str) = init_obj(Rval) :-
+ mercury_private_builtin_module(PrivateBuiltin),
+ MLDS_ModuleName = mercury_module_name_to_mlds(PrivateBuiltin),
+ Var = qual(MLDS_ModuleName, module_qual, mlds_var_name(Str, no)),
+ % XXX These are actually enumeration constants.
+ % Perhaps we should be using an enumeration type here,
+ % rather than `mlds_native_int_type'.
+ Type = mlds_native_int_type,
+ Rval = lval(var(Var, Type)).
+
+:- func gen_init_enum_param(maybe(int)) = mlds_initializer.
+
+gen_init_enum_param(no) = gen_init_int(-1).
+gen_init_enum_param(yes(NumFunctors)) = gen_init_int(NumFunctors).
+
+:- func gen_init_tabling_name(mlds_module_name, mlds_proc_label,
+ proc_tabling_struct_id) = mlds_initializer.
+
+gen_init_tabling_name(ModuleName, ProcLabel, TablingId) = Rval :-
+ DataAddr = data_addr(ModuleName, mlds_tabling_ref(ProcLabel, TablingId)),
+ Rval = init_obj(const(data_addr_const(DataAddr))).
+
+:- func init_stats(proc_tabling_struct_id, table_trie_step) = mlds_initializer.
+
+init_stats(Id, _) =
+ % Id should be one of tabling_{,prev_}{call,answer}_stats.
+ init_struct(mlds_tabling_type(Id), [
+ gen_init_int(0),
+ gen_init_int(0),
+ gen_init_int(0),
+ gen_init_int(0),
+ gen_init_int(0),
+ gen_init_int(0),
+ gen_init_int(0),
+ gen_init_int(0)
+ ]).
+
+:- func tabling_name_and_init_to_defn(mlds_proc_label, mlds_context, constness,
+ proc_tabling_struct_id, mlds_initializer) = mlds_defn.
+
+tabling_name_and_init_to_defn(ProcLabel, MLDS_Context, Constness, Id,
+ Initializer) = Defn :-
+ GC_TraceCode = no,
+ MLDS_Type = mlds_tabling_type(Id),
+ Flags = tabling_data_decl_flags(Constness),
+ DefnBody = mlds_data(MLDS_Type, Initializer, GC_TraceCode),
+ Name = data(mlds_tabling_ref(ProcLabel, Id)),
+ Defn = mlds_defn(Name, MLDS_Context, Flags, DefnBody).
+
+ % Return the declaration flags appropriate for a tabling data structure.
+ %
+:- func tabling_data_decl_flags(constness) = mlds_decl_flags.
+
+tabling_data_decl_flags(Constness) = MLDS_DeclFlags :-
+ Access = private,
+ PerInstance = one_copy,
+ Virtuality = non_virtual,
+ Finality = final,
+ Abstractness = concrete,
+ MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
+ Virtuality, Finality, Constness, Abstractness).
% Return the declaration flags appropriate for a procedure definition.
%
@@ -2088,7 +2340,7 @@
SharedCode, SharedContext, Decls, Statements, !Info) :-
Lang = foreign_language(Attributes),
- ( Lang = csharp ->
+ ( Lang = lang_csharp ->
sorry(this_file, "nondet pragma foreign_proc for C#")
;
true
@@ -2167,7 +2419,7 @@
% to call back into IL and make the continuation call in IL. This is
% called an "indirect" success continuation call.
- ( Target = il ->
+ ( Target = target_il ->
ml_gen_call_current_success_cont_indirectly(Context, CallCont,
!Info)
;
@@ -2241,28 +2493,28 @@
)
),
(
- Lang = c,
+ Lang = lang_c,
ml_gen_ordinary_pragma_c_proc(OrdinaryKind, Attributes,
PredId, ProcId, Args, ExtraArgs,
Foreign_Code, Context, Decls, Statements, !Info)
;
- Lang = managed_cplusplus,
+ Lang = lang_managed_cplusplus,
ml_gen_ordinary_pragma_managed_proc(OrdinaryKind, Attributes,
PredId, ProcId, Args, ExtraArgs,
Foreign_Code, Context, Decls, Statements, !Info)
;
- Lang = csharp,
+ Lang = lang_csharp,
ml_gen_ordinary_pragma_managed_proc(OrdinaryKind, Attributes,
PredId, ProcId, Args, ExtraArgs,
Foreign_Code, Context, Decls, Statements, !Info)
;
- Lang = il,
+ Lang = lang_il,
% XXX should pass OrdinaryKind
ml_gen_ordinary_pragma_il_proc(CodeModel, Attributes,
PredId, ProcId, Args, ExtraArgs,
Foreign_Code, Context, Decls, Statements, !Info)
;
- Lang = java,
+ Lang = lang_java,
% XXX should pass OrdinaryKind
ml_gen_ordinary_pragma_java_proc(CodeModel, Attributes,
PredId, ProcId, Args, ExtraArgs,
@@ -2474,7 +2726,7 @@
OutlineStmt = inline_target_code(lang_il, [
user_target_code(ForeignCode, yes(Context),
- get_target_code_attributes(il,
+ get_target_code_attributes(lang_il,
Attributes ^ extra_attributes))
]),
@@ -2797,7 +3049,7 @@
get_target_code_attributes(Lang, [backend(_Backend) | Attrs]) =
get_target_code_attributes(Lang, Attrs).
get_target_code_attributes(Lang, [max_stack_size(N) | Attrs]) =
- ( Lang = il ->
+ ( Lang = lang_il ->
[max_stack_size(N) | get_target_code_attributes(Lang, Attrs)]
;
[]
@@ -2927,14 +3179,14 @@
IsForeign = foreign.is_foreign_type(ExportedType),
(
(
- Lang = java,
+ Lang = lang_java,
MaybeCast = no
;
- Lang = c,
+ Lang = lang_c,
IsForeign = no,
MaybeCast = no
;
- Lang = c,
+ Lang = lang_c,
IsForeign = yes(Assertions),
list.member(can_pass_as_mercury_type, Assertions),
MaybeCast = yes("(" ++ TypeString ++ ") ")
@@ -2965,7 +3217,7 @@
Cast = ""
)
),
- string.format("\t%s = %s\n", [s(ArgName), s(Cast)], AssignToArgName),
+ string.format("\t%s = %s ", [s(ArgName), s(Cast)], AssignToArgName),
AssignInput = [
raw_target_code(AssignToArgName, []),
target_code_input(ArgRval),
@@ -3117,15 +3369,15 @@
IsForeign = foreign.is_foreign_type(ExportedType),
(
(
- Lang = java,
+ Lang = lang_java,
IsForeign = no,
Cast = no
;
- Lang = c,
+ Lang = lang_c,
IsForeign = no,
Cast = no
;
- Lang = c,
+ Lang = lang_c,
IsForeign = yes(Assertions),
list.member(can_pass_as_mercury_type, Assertions),
Cast = yes
@@ -3164,7 +3416,7 @@
),
string.format(" = %s%s;\n", [s(RHS_Cast), s(ArgName)],
AssignFromArgName),
- string.format("\t%s\n", [s(LHS_Cast)], AssignTo),
+ string.format("\t%s ", [s(LHS_Cast)], AssignTo),
AssignOutput = [
raw_target_code(AssignTo, []),
target_code_output(ArgLval),
@@ -3501,4 +3753,3 @@
%-----------------------------------------------------------------------------%
:- end_module ml_code_gen.
%-----------------------------------------------------------------------------%
-
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.108
diff -u -b -r1.108 ml_code_util.m
--- compiler/ml_code_util.m 20 Apr 2006 05:36:54 -0000 1.108
+++ compiler/ml_code_util.m 5 Jun 2006 18:32:07 -0000
@@ -1298,8 +1298,9 @@
),
Signature = mlds_func_signature(ArgTypes, [])
),
- ProcLabel = qual(PredModule, module_qual, PredLabel - ProcId),
- FuncLabelRval = const(code_addr_const(internal(ProcLabel,
+ ProcLabel = mlds_proc_label(PredLabel, ProcId),
+ QualProcLabel = qual(PredModule, module_qual, ProcLabel),
+ FuncLabelRval = const(code_addr_const(internal(QualProcLabel,
FuncLabel, Signature))).
% Generate the mlds_pred_label and module name for a given procedure.
@@ -1344,8 +1345,8 @@
DefiningModule = TypeModule,
MaybeDeclaringModule = no
),
- MLDS_PredLabel = special_pred(PredName, MaybeDeclaringModule,
- TypeName, TypeArity)
+ MLDS_PredLabel = mlds_special_pred_label(PredName,
+ MaybeDeclaringModule, TypeName, TypeArity)
;
string.append_list(["ml_gen_pred_label:\n",
"cannot make label for special pred `",
@@ -1377,7 +1378,7 @@
NonOutputFunc = no
),
determinism_to_code_model(Detism, CodeModel),
- MLDS_PredLabel = pred(PredOrFunc, MaybeDeclaringModule,
+ MLDS_PredLabel = mlds_user_pred_label(PredOrFunc, MaybeDeclaringModule,
PredName, PredArity, CodeModel, NonOutputFunc)
),
MLDS_Module = mercury_module_name_to_mlds(DefiningModule).
@@ -1822,7 +1823,8 @@
yes(SeqNum), _), _, _, mlds_function(_, _, defined_here(_), _))
->
% We call the proxy function.
- QualProcLabel = qual(MLDS_Module, module_qual, PredLabel - ProcId),
+ ProcLabel = mlds_proc_label(PredLabel, ProcId),
+ QualProcLabel = qual(MLDS_Module, module_qual, ProcLabel),
ProxyFuncRval = const(code_addr_const(
internal(QualProcLabel, SeqNum, ProxySignature))),
@@ -1894,7 +1896,7 @@
(
GC = accurate,
MLDS_DeclType = mercury_type_to_mlds_type(ModuleInfo, DeclType),
- ml_type_might_contain_pointers(MLDS_DeclType) = yes,
+ ml_type_might_contain_pointers_for_gc(MLDS_DeclType) = yes,
% don't generate GC tracing code in no_type_info_builtins
ml_gen_info_get_pred_id(!.Info, PredId),
predicate_id(ModuleInfo, PredId, PredModule, PredName, PredArity),
@@ -1942,31 +1944,34 @@
% Similarly, the only pointers in type_ctor_infos and base_typeclass_infos
% are to static code and/or static data, which do not need to be traced.
%
-:- func ml_type_might_contain_pointers(mlds_type) = bool.
+:- func ml_type_might_contain_pointers_for_gc(mlds_type) = bool.
-ml_type_might_contain_pointers(mercury_type(_Type, TypeCategory, _)) =
+ml_type_might_contain_pointers_for_gc(mercury_type(_Type, TypeCategory, _)) =
ml_type_category_might_contain_pointers(TypeCategory).
-ml_type_might_contain_pointers(mlds_mercury_array_type(_)) = yes.
-ml_type_might_contain_pointers(mlds_native_int_type) = no.
-ml_type_might_contain_pointers(mlds_native_float_type) = no.
-ml_type_might_contain_pointers(mlds_native_bool_type) = no.
-ml_type_might_contain_pointers(mlds_native_char_type) = no.
-ml_type_might_contain_pointers(mlds_foreign_type(_)) = no.
+ml_type_might_contain_pointers_for_gc(mlds_mercury_array_type(_)) = yes.
+ml_type_might_contain_pointers_for_gc(mlds_native_int_type) = no.
+ml_type_might_contain_pointers_for_gc(mlds_native_float_type) = no.
+ml_type_might_contain_pointers_for_gc(mlds_native_bool_type) = no.
+ml_type_might_contain_pointers_for_gc(mlds_native_char_type) = no.
+ml_type_might_contain_pointers_for_gc(mlds_foreign_type(_)) = no.
% We assume that foreign types are not allowed to contain pointers
% to the Mercury heap. XXX is this requirement too strict?
-ml_type_might_contain_pointers(mlds_class_type(_, _, Category)) =
+ml_type_might_contain_pointers_for_gc(mlds_class_type(_, _, Category)) =
(if Category = mlds_enum then no else yes).
-ml_type_might_contain_pointers(mlds_ptr_type(_)) = yes.
-ml_type_might_contain_pointers(mlds_array_type(_)) = yes.
-ml_type_might_contain_pointers(mlds_func_type(_)) = no.
-ml_type_might_contain_pointers(mlds_generic_type) = yes.
-ml_type_might_contain_pointers(mlds_generic_env_ptr_type) = yes.
-ml_type_might_contain_pointers(mlds_type_info_type) = yes.
-ml_type_might_contain_pointers(mlds_pseudo_type_info_type) = yes.
-ml_type_might_contain_pointers(mlds_cont_type(_)) = no.
-ml_type_might_contain_pointers(mlds_commit_type) = no.
-ml_type_might_contain_pointers(mlds_rtti_type(_)) = yes.
-ml_type_might_contain_pointers(mlds_unknown_type) = yes.
+ml_type_might_contain_pointers_for_gc(mlds_ptr_type(_)) = yes.
+ml_type_might_contain_pointers_for_gc(mlds_array_type(_)) = yes.
+ml_type_might_contain_pointers_for_gc(mlds_func_type(_)) = no.
+ml_type_might_contain_pointers_for_gc(mlds_generic_type) = yes.
+ml_type_might_contain_pointers_for_gc(mlds_generic_env_ptr_type) = yes.
+ml_type_might_contain_pointers_for_gc(mlds_type_info_type) = yes.
+ml_type_might_contain_pointers_for_gc(mlds_pseudo_type_info_type) = yes.
+ml_type_might_contain_pointers_for_gc(mlds_cont_type(_)) = no.
+ml_type_might_contain_pointers_for_gc(mlds_commit_type) = no.
+ml_type_might_contain_pointers_for_gc(mlds_rtti_type(_)) = yes.
+ % Values of mlds_tabling_type types may contain pointers, but they won't
+ % exist if we are using accurate GC.
+ml_type_might_contain_pointers_for_gc(mlds_tabling_type(_)) = no.
+ml_type_might_contain_pointers_for_gc(mlds_unknown_type) = yes.
:- func ml_type_category_might_contain_pointers(type_category) = bool.
@@ -2089,16 +2094,18 @@
% Generate the address of `private_builtin.gc_trace/1#0'.
PredName = "gc_trace",
PredOrigArity = 1,
- Pred = pred((predicate), no, PredName, PredOrigArity, model_det, no),
+ PredLabel = mlds_user_pred_label((predicate), no, PredName, PredOrigArity,
+ model_det, no),
ProcId = hlds_pred.initial_proc_id,
mercury_private_builtin_module(PredModule),
MLDS_Module = mercury_module_name_to_mlds(PredModule),
- Proc = qual(MLDS_Module, module_qual, Pred - ProcId),
+ ProcLabel = mlds_proc_label(PredLabel, ProcId),
+ QualProcLabel = qual(MLDS_Module, module_qual, ProcLabel),
CPointerType = mercury_type(c_pointer_type, type_cat_user_ctor,
non_foreign_type(c_pointer_type)),
ArgTypes = [mlds_pseudo_type_info_type, CPointerType],
Signature = mlds_func_signature(ArgTypes, []),
- FuncAddr = const(code_addr_const(proc(Proc, Signature))),
+ FuncAddr = const(code_addr_const(proc(QualProcLabel, Signature))),
% Generate the call
% `private_builtin.gc_trace(TypeInfo, (MR_C_Pointer) &Var);'.
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.79
diff -u -b -r1.79 ml_elim_nested.m
--- compiler/ml_elim_nested.m 29 Mar 2006 08:07:03 -0000 1.79
+++ compiler/ml_elim_nested.m 5 Jun 2006 18:34:20 -0000
@@ -507,7 +507,7 @@
% (Doing so would just slow things down unnecessarily.)
\+ (
Name = function(PredLabel, _, _, _),
- PredLabel = pred(_, _, "gc_trace", 1, _, _),
+ PredLabel = mlds_user_pred_label(_, _, "gc_trace", 1, _, _),
mercury_private_builtin_module(PrivateBuiltin),
ModuleName = mercury_module_name_to_mlds(PrivateBuiltin)
)
@@ -996,8 +996,9 @@
),
NewSeqNum = SeqNum + 100000,
GCTraceFuncName = function(PredLabel, ProcId, yes(NewSeqNum), PredId),
- ProcLabel = qual(PredModule, module_qual, PredLabel - ProcId),
- GCTraceFuncAddr = internal(ProcLabel, NewSeqNum, Signature)
+ ProcLabel = mlds_proc_label(PredLabel, ProcId),
+ QualProcLabel = qual(PredModule, module_qual, ProcLabel),
+ GCTraceFuncAddr = internal(QualProcLabel, NewSeqNum, Signature)
;
unexpected(this_file, "gen_gc_trace_func: not a function")
),
@@ -1129,7 +1130,7 @@
ml_make_env_ptr_type(Globals, EnvType) = EnvPtrType :-
globals.lookup_bool_option(Globals, put_nondet_env_on_heap, OnHeap),
globals.get_target(Globals, Target),
- ( Target = il, OnHeap = yes ->
+ ( Target = target_il, OnHeap = yes ->
% For IL, a class type is already a pointer (object reference).
EnvPtrType = EnvType
;
@@ -1276,8 +1277,8 @@
:- func ml_pred_label_name(mlds_pred_label) = string.
-ml_pred_label_name(pred(PredOrFunc, MaybeDefiningModule, Name, Arity,
- _CodeModel, _NonOutputFunc)) = LabelName :-
+ml_pred_label_name(mlds_user_pred_label(PredOrFunc, MaybeDefiningModule,
+ Name, Arity, _CodeModel, _NonOutputFunc)) = LabelName :-
( PredOrFunc = predicate, Suffix = "p"
; PredOrFunc = function, Suffix = "f"
),
@@ -1291,7 +1292,7 @@
string.format("%s_%d_%s",
[s(Name), i(Arity), s(Suffix)], LabelName)
).
-ml_pred_label_name(special_pred(PredName, MaybeTypeModule,
+ml_pred_label_name(mlds_special_pred_label(PredName, MaybeTypeModule,
TypeName, TypeArity)) = LabelName :-
(
MaybeTypeModule = yes(TypeModule),
Index: compiler/ml_optimize.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_optimize.m,v
retrieving revision 1.38
diff -u -b -r1.38 ml_optimize.m
--- compiler/ml_optimize.m 29 Mar 2006 08:07:03 -0000 1.38
+++ compiler/ml_optimize.m 5 Jun 2006 18:52:40 -0000
@@ -255,10 +255,11 @@
% the --target asm back-end, whereas generating the
% appropriate MLDS instructions does.
%
- FuncRval = const(code_addr_const(proc(qual(ModName, module_qual,
- pred(predicate, _DefnModName, PredName, _Arity,
- _CodeModel, _NonOutputFunc) - _ProcId),
- _FuncSignature))),
+ FuncRval = const(code_addr_const(
+ proc(qual(ModName, module_qual, ProcLabel), _FuncSignature))),
+ ProcLabel = mlds_proc_label(PredLabel, _ProcId),
+ PredLabel = mlds_user_pred_label(predicate, _DefnModName, PredName,
+ _Arity, _CodeModel, _NonOutputFunc),
(
PredName = "mark_hp",
CallArgs = [mem_addr(Lval)],
@@ -448,11 +449,12 @@
:- func target_supports_break_and_continue_2(compilation_target) = bool.
-target_supports_break_and_continue_2(c) = yes.
-target_supports_break_and_continue_2(asm) = no. % asm means via gnu back-end
-target_supports_break_and_continue_2(il) = no.
-target_supports_break_and_continue_2(java) = yes.
-% target_supports_break_and_continue_2(c_sharp) = yes.
+target_supports_break_and_continue_2(target_c) = yes.
+target_supports_break_and_continue_2(target_asm) = no.
+ % asm means via gnu back-end
+target_supports_break_and_continue_2(target_il) = no.
+target_supports_break_and_continue_2(target_java) = yes.
+% target_supports_break_and_continue_2(target_c_sharp) = yes.
%-----------------------------------------------------------------------------%
Index: compiler/ml_switch_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_switch_gen.m,v
retrieving revision 1.24
diff -u -b -r1.24 ml_switch_gen.m
--- compiler/ml_switch_gen.m 29 Mar 2006 08:07:03 -0000 1.24
+++ compiler/ml_switch_gen.m 30 May 2006 05:17:39 -0000
@@ -271,30 +271,30 @@
:- func target_supports_goto_2(compilation_target) = bool.
:- func target_supports_computed_goto_2(compilation_target) = bool.
-target_supports_int_switch_2(c) = yes.
-target_supports_int_switch_2(asm) = yes. % asm means via gnu back-end
-target_supports_int_switch_2(il) = no.
-target_supports_int_switch_2(java) = yes.
+target_supports_int_switch_2(target_c) = yes.
+target_supports_int_switch_2(target_asm) = yes.
+target_supports_int_switch_2(target_il) = no.
+target_supports_int_switch_2(target_java) = yes.
% target_supports_int_switch_2(c_sharp) = yes.
-target_supports_string_switch_2(c) = no.
-target_supports_string_switch_2(asm) = no. % asm means via gnu back-end
-target_supports_string_switch_2(il) = no.
-target_supports_string_switch_2(java) = no.
+target_supports_string_switch_2(target_c) = no.
+target_supports_string_switch_2(target_asm) = no.
+target_supports_string_switch_2(target_il) = no.
+target_supports_string_switch_2(target_java) = no.
% target_supports_string_switch_2(c_sharp) = yes.
-target_supports_computed_goto_2(c) = yes.
-target_supports_computed_goto_2(asm) = no. % asm means via gnu back-end
+target_supports_computed_goto_2(target_c) = yes.
+target_supports_computed_goto_2(target_asm) = no.
% XXX for asm, it should be `yes', but currently
% computed gotos are not yet implemented in gcc.m.
-target_supports_computed_goto_2(il) = yes.
-target_supports_computed_goto_2(java) = no.
+target_supports_computed_goto_2(target_il) = yes.
+target_supports_computed_goto_2(target_java) = no.
% target_supports_computed_goto_2(c_sharp) = no.
-target_supports_goto_2(c) = yes.
-target_supports_goto_2(asm) = yes. % asm means via gnu back-end
-target_supports_goto_2(il) = yes.
-target_supports_goto_2(java) = no.
+target_supports_goto_2(target_c) = yes.
+target_supports_goto_2(target_asm) = yes.
+target_supports_goto_2(target_il) = yes.
+target_supports_goto_2(target_java) = no.
% target_supports_goto_2(c_sharp) = yes.
%-----------------------------------------------------------------------------%
Index: compiler/ml_tailcall.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_tailcall.m,v
retrieving revision 1.35
diff -u -b -r1.35 ml_tailcall.m
--- compiler/ml_tailcall.m 20 Apr 2006 05:36:55 -0000 1.35
+++ compiler/ml_tailcall.m 5 Jun 2006 18:35:22 -0000
@@ -488,7 +488,7 @@
% XXX we ignore the ModuleName -- that is safe, but might be
% overly conservative.
QualifiedProcLabel = qual(_ModuleName, _QualKind, ProcLabel),
- ProcLabel = PredLabel - ProcId,
+ ProcLabel = mlds_proc_label(PredLabel, ProcId),
some [Local] (
locals_member(Local, Locals),
Local = function(PredLabel, ProcId, MaybeSeqNum, _PredId)
@@ -576,7 +576,8 @@
CodeAddr = internal(QualProcLabel, SeqNum, _Sig),
MaybeSeqNum = yes(SeqNum)
),
- QualProcLabel = qual(CallerModule, module_qual, PredLabel - ProcId),
+ ProcLabel = mlds_proc_label(PredLabel, ProcId),
+ QualProcLabel = qual(CallerModule, module_qual, ProcLabel),
CallerFuncName = function(PredLabel, ProcId, MaybeSeqNum, _PredId),
% If so, construct an appropriate warning.
Warning = tailcall_warning(PredLabel, ProcId, Context).
@@ -587,7 +588,7 @@
report_nontailcall_warning(tailcall_warning(PredLabel, ProcId, Context),
!IO) :-
(
- PredLabel = pred(PredOrFunc, _MaybeModule, Name, Arity,
+ PredLabel = mlds_user_pred_label(PredOrFunc, _MaybeModule, Name, Arity,
_CodeModel, _NonOutputFunc),
SimpleCallId = simple_call_id(PredOrFunc, unqualified(Name), Arity),
proc_id_to_int(ProcId, ProcNumber0),
@@ -599,7 +600,7 @@
words("warning: recursive call is not tail recursive.")
], !IO)
;
- PredLabel = special_pred(_, _, _, _)
+ PredLabel = mlds_special_pred_label(_, _, _, _)
% Don't warn about these.
).
Index: compiler/ml_type_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_type_gen.m,v
retrieving revision 1.52
diff -u -b -r1.52 ml_type_gen.m
--- compiler/ml_type_gen.m 20 Apr 2006 05:36:55 -0000 1.52
+++ compiler/ml_type_gen.m 30 May 2006 05:09:42 -0000
@@ -718,17 +718,17 @@
:- func target_uses_constructors(compilation_target) = bool.
-target_uses_constructors(c) = no.
-target_uses_constructors(il) = yes.
-target_uses_constructors(java) = yes.
-target_uses_constructors(asm) = no.
+target_uses_constructors(target_c) = no.
+target_uses_constructors(target_il) = yes.
+target_uses_constructors(target_java) = yes.
+target_uses_constructors(target_asm) = no.
:- func target_uses_empty_base_classes(compilation_target) = bool.
-target_uses_empty_base_classes(c) = no.
-target_uses_empty_base_classes(il) = yes.
-target_uses_empty_base_classes(java) = yes.
-target_uses_empty_base_classes(asm) = no.
+target_uses_empty_base_classes(target_c) = no.
+target_uses_empty_base_classes(target_il) = yes.
+target_uses_empty_base_classes(target_java) = yes.
+target_uses_empty_base_classes(target_asm) = no.
% This should return yes if references to function parameters in
% constructor functions must be qualified with the module name,
@@ -740,10 +740,10 @@
%
:- func target_requires_module_qualified_params(compilation_target) = bool.
-target_requires_module_qualified_params(c) = no.
-target_requires_module_qualified_params(il) = no.
-target_requires_module_qualified_params(java) = yes.
-target_requires_module_qualified_params(asm) = no.
+target_requires_module_qualified_params(target_c) = no.
+target_requires_module_qualified_params(target_il) = no.
+target_requires_module_qualified_params(target_java) = yes.
+target_requires_module_qualified_params(target_asm) = no.
:- func gen_constructor_function(globals, mlds_class_id,
mlds_type, mlds_module_name, mlds_class_id, maybe(int), mlds_defns,
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.99
diff -u -b -r1.99 ml_unify_gen.m
--- compiler/ml_unify_gen.m 20 Apr 2006 05:36:55 -0000 1.99
+++ compiler/ml_unify_gen.m 5 Jun 2006 18:35:56 -0000
@@ -296,6 +296,7 @@
ml_gen_compound(Tag, ConsId, Var, Args, ArgModes, TakeAddr,
HowToConstruct, Context, Decls, Statements, !Info)
;
+ % Constants.
( Tag = int_constant(_)
; Tag = float_constant(_)
; Tag = string_constant(_)
@@ -304,19 +305,18 @@
; Tag = type_ctor_info_constant(_, _, _)
; Tag = base_typeclass_info_constant(_, _, _)
; Tag = deep_profiling_proc_layout_tag(_, _)
- ; Tag = tabling_pointer_constant(_, _)
+ ; Tag = tabling_info_constant(_, _)
; Tag = table_io_decl_tag(_, _)
),
(
- % Constants.
- Args = []
- ->
+ Args = [],
ml_gen_var(!.Info, Var, VarLval),
ml_gen_constant(Tag, Type, Rval, !Info),
Statement = ml_gen_assign(VarLval, Rval, Context),
Decls = [],
Statements = [Statement]
;
+ Args = [_ | _],
unexpected(this_file, "ml_gen_construct: bad constant term")
)
).
@@ -425,7 +425,7 @@
MLDS_Module = mercury_module_name_to_mlds(ModuleName),
RttiTypeCtor = rtti_type_ctor(ModuleName, TypeName, TypeArity),
DataAddr = data_addr(MLDS_Module,
- rtti(ctor_rtti_id(RttiTypeCtor, type_ctor_info))),
+ mlds_rtti(ctor_rtti_id(RttiTypeCtor, type_ctor_info))),
Rval = unop(cast(MLDS_VarType), const(data_addr_const(DataAddr))).
ml_gen_constant(base_typeclass_info_constant(ModuleName, ClassId, Instance),
@@ -433,16 +433,16 @@
ml_gen_type(!.Info, VarType, MLDS_VarType),
MLDS_Module = mercury_module_name_to_mlds(ModuleName),
TCName = generate_class_name(ClassId),
- DataAddr = data_addr(MLDS_Module, rtti(tc_rtti_id(TCName,
+ DataAddr = data_addr(MLDS_Module, mlds_rtti(tc_rtti_id(TCName,
base_typeclass_info(ModuleName, Instance)))),
Rval = unop(cast(MLDS_VarType), const(data_addr_const(DataAddr))).
-ml_gen_constant(tabling_pointer_constant(PredId, ProcId), VarType, Rval,
- !Info) :-
+ml_gen_constant(tabling_info_constant(PredId, ProcId), VarType, Rval, !Info) :-
ml_gen_type(!.Info, VarType, MLDS_VarType),
ml_gen_info_get_module_info(!.Info, ModuleInfo),
ml_gen_pred_label(ModuleInfo, PredId, ProcId, PredLabel, PredModule),
- DataAddr = data_addr(PredModule, tabling_pointer(PredLabel - ProcId)),
+ DataAddr = data_addr(PredModule,
+ mlds_tabling_ref(mlds_proc_label(PredLabel, ProcId), tabling_info)),
Rval = unop(cast(MLDS_VarType), const(data_addr_const(DataAddr))).
ml_gen_constant(deep_profiling_proc_layout_tag(_, _), _, _, !Info) :-
@@ -525,10 +525,10 @@
%
:- func target_supports_inheritence(compilation_target) = bool.
-target_supports_inheritence(c) = no.
-target_supports_inheritence(il) = yes.
-target_supports_inheritence(java) = yes.
-target_supports_inheritence(asm) = no.
+target_supports_inheritence(target_c) = no.
+target_supports_inheritence(target_il) = yes.
+target_supports_inheritence(target_java) = yes.
+target_supports_inheritence(target_asm) = no.
%-----------------------------------------------------------------------------%
@@ -1281,31 +1281,16 @@
% For constants, if the deconstruction is det, then we already know
% the value of the constant, so Statements = [].
(
- Tag = string_constant(_String),
- Statements = []
- ;
- Tag = int_constant(_Int),
- Statements = []
- ;
- Tag = float_constant(_Float),
- Statements = []
- ;
- Tag = pred_closure_tag(_, _, _),
- Statements = []
- ;
- Tag = type_ctor_info_constant(_, _, _),
- Statements = []
- ;
- Tag = base_typeclass_info_constant(_, _, _),
- Statements = []
- ;
- Tag = tabling_pointer_constant(_, _),
- Statements = []
- ;
- Tag = deep_profiling_proc_layout_tag(_, _),
- Statements = []
- ;
- Tag = table_io_decl_tag(_, _),
+ ( Tag = string_constant(_String)
+ ; Tag = int_constant(_Int)
+ ; Tag = float_constant(_Float)
+ ; Tag = pred_closure_tag(_, _, _)
+ ; Tag = type_ctor_info_constant(_, _, _)
+ ; Tag = base_typeclass_info_constant(_, _, _)
+ ; Tag = tabling_info_constant(_, _)
+ ; Tag = deep_profiling_proc_layout_tag(_, _)
+ ; Tag = table_io_decl_tag(_, _)
+ ),
Statements = []
;
Tag = no_tag,
@@ -1393,40 +1378,19 @@
% Just recurse on ThisTag.
ml_tag_offset_and_argnum(ThisTag, TagBits, OffSet, ArgNum)
;
- Tag = string_constant(_String),
- unexpected(this_file, "ml_tag_offset_and_argnum")
- ;
- Tag = int_constant(_Int),
- unexpected(this_file, "ml_tag_offset_and_argnum")
- ;
- Tag = float_constant(_Float),
- unexpected(this_file, "ml_tag_offset_and_argnum")
- ;
- Tag = pred_closure_tag(_, _, _),
- unexpected(this_file, "ml_tag_offset_and_argnum")
- ;
- Tag = type_ctor_info_constant(_, _, _),
- unexpected(this_file, "ml_tag_offset_and_argnum")
- ;
- Tag = base_typeclass_info_constant(_, _, _),
- unexpected(this_file, "ml_tag_offset_and_argnum")
- ;
- Tag = tabling_pointer_constant(_, _),
- unexpected(this_file, "ml_tag_offset_and_argnum")
- ;
- Tag = deep_profiling_proc_layout_tag(_, _),
- unexpected(this_file, "ml_tag_offset_and_argnum")
- ;
- Tag = table_io_decl_tag(_, _),
- unexpected(this_file, "ml_tag_offset_and_argnum")
- ;
- Tag = no_tag,
- unexpected(this_file, "ml_tag_offset_and_argnum")
- ;
- Tag = shared_local_tag(_Bits1, _Num1),
- unexpected(this_file, "ml_tag_offset_and_argnum")
- ;
- Tag = reserved_address(_),
+ ( Tag = string_constant(_String)
+ ; Tag = int_constant(_Int)
+ ; Tag = float_constant(_Float)
+ ; Tag = pred_closure_tag(_, _, _)
+ ; Tag = type_ctor_info_constant(_, _, _)
+ ; Tag = base_typeclass_info_constant(_, _, _)
+ ; Tag = tabling_info_constant(_, _)
+ ; Tag = deep_profiling_proc_layout_tag(_, _)
+ ; Tag = table_io_decl_tag(_, _)
+ ; Tag = no_tag
+ ; Tag = shared_local_tag(_Bits1, _Num1)
+ ; Tag = reserved_address(_)
+ ),
unexpected(this_file, "ml_tag_offset_and_argnum")
).
@@ -1705,8 +1669,8 @@
unexpected(this_file, "Attempted type_ctor_info unification").
ml_gen_tag_test_rval(base_typeclass_info_constant(_, _, _), _, _, _) = _ :-
unexpected(this_file, "Attempted base_typeclass_info unification").
-ml_gen_tag_test_rval(tabling_pointer_constant(_, _), _, _, _) = _ :-
- unexpected(this_file, "Attempted tabling_pointer unification").
+ml_gen_tag_test_rval(tabling_info_constant(_, _), _, _, _) = _ :-
+ unexpected(this_file, "Attempted tabling_info unification").
ml_gen_tag_test_rval(deep_profiling_proc_layout_tag(_, _), _, _, _) = _ :-
unexpected(this_file, "Attempted deep_profiling_proc_layout unification").
ml_gen_tag_test_rval(table_io_decl_tag(_, _), _, _, _) = _ :-
Index: compiler/ml_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_util.m,v
retrieving revision 1.45
diff -u -b -r1.45 ml_util.m
--- compiler/ml_util.m 20 Apr 2006 05:36:55 -0000 1.45
+++ compiler/ml_util.m 5 Jun 2006 18:36:43 -0000
@@ -17,9 +17,12 @@
:- interface.
:- import_module libs.globals. % for foreign_language
+:- import_module hlds.hlds_module.
+:- import_module hlds.hlds_data.
:- import_module ml_backend.mlds.
:- import_module parse_tree.prog_data.
+:- import_module bool.
:- import_module list.
:- import_module maybe.
@@ -160,6 +163,32 @@
type_ctor::in) is semidet.
%-----------------------------------------------------------------------------%
+%
+% Functions for generating initializers.
+%
+% This handles arrays, maybe, null pointers, strings, ints, and builtin enums.
+
+:- func gen_init_builtin_const(string) = mlds_initializer.
+
+:- func gen_init_array(func(T) = mlds_initializer, list(T)) = mlds_initializer.
+
+:- func gen_init_maybe(mlds_type, func(T) = mlds_initializer, maybe(T)) =
+ mlds_initializer.
+
+:- func gen_init_null_pointer(mlds_type) = mlds_initializer.
+
+:- func gen_init_string(string) = mlds_initializer.
+
+:- func gen_init_int(int) = mlds_initializer.
+
+:- func gen_init_bool(bool) = mlds_initializer.
+
+:- func gen_init_boxed_int(int) = mlds_initializer.
+
+:- func gen_init_reserved_address(module_info, reserved_address) =
+ mlds_initializer.
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
@@ -167,9 +196,10 @@
:- import_module backend_libs.rtti.
:- import_module check_hlds.type_util.
:- import_module mdbcomp.prim_data.
+:- import_module ml_backend.ml_unify_gen.
:- import_module parse_tree.prog_io.
-:- import_module parse_tree.prog_util.
:- import_module parse_tree.prog_type.
+:- import_module parse_tree.prog_util.
:- import_module bool.
:- import_module list.
@@ -182,7 +212,7 @@
list.member(Defn, Defns),
Defn = mlds_defn(Name, _, _, _),
Name = function(FuncName, _, _, _),
- FuncName = pred(predicate, _, "main", 2, _, _).
+ FuncName = mlds_user_pred_label(predicate, _, "main", 2, _, _).
can_optimize_tailcall(Name, Call) :-
Call = call(_Signature, FuncRval, MaybeObject, _CallArgs,
@@ -199,7 +229,8 @@
CodeAddr = internal(QualifiedProcLabel, SeqNum, _Sig),
MaybeSeqNum = yes(SeqNum)
),
- QualifiedProcLabel = qual(ModuleName, module_qual, PredLabel - ProcId),
+ ProcLabel = mlds_proc_label(PredLabel, ProcId),
+ QualifiedProcLabel = qual(ModuleName, module_qual, ProcLabel),
% Check that the module name matches.
Name = qual(ModuleName, module_qual, FuncName),
@@ -617,7 +648,7 @@
type_ctor_needs_lowlevel_rep(Target, TypeCtor).
% XXX Do we need to do the same for the Java back-end?
-type_ctor_needs_lowlevel_rep(il, type_ctor(TypeName, _Arity)) :-
+type_ctor_needs_lowlevel_rep(target_il, type_ctor(TypeName, _Arity)) :-
mercury_public_builtin_module(Builtin),
mercury_private_builtin_module(PrivateBuiltin),
RttiImplementation = unqualified("rtti_implementation"),
@@ -652,3 +683,37 @@
).
%-----------------------------------------------------------------------------%
+
+gen_init_builtin_const(Name) = init_obj(Rval) :-
+ mercury_private_builtin_module(PrivateBuiltin),
+ MLDS_Module = mercury_module_name_to_mlds(PrivateBuiltin),
+ % XXX These are actually enumeration constants.
+ % Perhaps we should be using an enumeration type here,
+ % rather than `mlds_native_int_type'.
+ Type = mlds_native_int_type,
+ Rval = lval(var(qual(MLDS_Module, module_qual, mlds_var_name(Name, no)),
+ Type)).
+
+gen_init_array(Conv, List) = init_array(list.map(Conv, List)).
+
+gen_init_maybe(_Type, Conv, yes(X)) = Conv(X).
+gen_init_maybe(Type, _Conv, no) = gen_init_null_pointer(Type).
+
+gen_init_null_pointer(Type) = init_obj(const(null(Type))).
+
+gen_init_string(String) = init_obj(const(string_const(String))).
+
+gen_init_int(Int) = init_obj(const(int_const(Int))).
+
+gen_init_bool(no) = init_obj(const(false)).
+gen_init_bool(yes) = init_obj(const(true)).
+
+gen_init_boxed_int(Int) =
+ init_obj(unop(box(mlds_native_int_type), const(int_const(Int)))).
+
+gen_init_reserved_address(ModuleInfo, ReservedAddress) =
+ % XXX using `mlds_generic_type' here is probably wrong
+ init_obj(ml_gen_reserved_address(ModuleInfo, ReservedAddress,
+ mlds_generic_type)).
+
+%-----------------------------------------------------------------------------%
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.132
diff -u -b -r1.132 mlds.m
--- compiler/mlds.m 20 Apr 2006 05:36:55 -0000 1.132
+++ compiler/mlds.m 6 Jun 2006 01:23:28 -0000
@@ -806,6 +806,8 @@
; mlds_rtti_type(rtti_id_maybe_element)
+ ; mlds_tabling_type(proc_tabling_struct_id)
+
; mlds_unknown_type.
% A type used by the ML code generator for references to variables
% that have yet to be declared. This occurs once in ml_code_util.m
@@ -1571,31 +1573,31 @@
---> var(mlds_var_name)
% Ordinary variables.
- ; common(int)
+ ; mlds_common(int)
% Compiler-introduced constants representing global constants.
% These are called "common" because they may be common
% subexpressions.
% Stuff for handling polymorphism/RTTI and type classes.
- ; rtti(rtti_id)
+ ; mlds_rtti(rtti_id)
% Stuff for handling debugging and accurate garbage collection.
% (Those features are not yet implemented for the MLDS back-end,
% so these data_names are not yet used.)
- ; module_layout
+ ; mlds_module_layout
% Layout information for the current module.
- ; proc_layout(mlds_proc_label)
+ ; mlds_proc_layout(mlds_proc_label)
% Layout structure for the given procedure.
- ; internal_layout(mlds_proc_label, mlds_func_sequence_num)
+ ; mlds_internal_layout(mlds_proc_label, mlds_func_sequence_num)
% Layout structure for the given internal MLDS func.
- % Stuff for tabling
+ % Stuff for tabling.
- ; tabling_pointer(mlds_proc_label).
+ ; mlds_tabling_ref(mlds_proc_label, proc_tabling_struct_id).
% A variable that contains a pointer that points to the table
% used to implement memoization, loopcheck or minimal model
% semantics for the given procedure.
@@ -1625,8 +1627,9 @@
:- type mlds_qualified_proc_label
== mlds_fully_qualified_name(mlds_proc_label).
+
:- type mlds_proc_label
- == pair(mlds_pred_label, proc_id).
+ ---> mlds_proc_label(mlds_pred_label, proc_id).
:- type mlds_qualified_pred_label
== mlds_fully_qualified_name(mlds_pred_label).
@@ -1641,7 +1644,7 @@
% from `.opt' files, the defining module's name is added as a
% qualifier to the pred name.
:- type mlds_pred_label
- ---> pred(
+ ---> mlds_user_pred_label(
pred_or_func, % predicate/function
maybe(mercury_module_name),
% The declaring module,
@@ -1652,8 +1655,7 @@
bool % Function without return value
% (i.e. non-default mode).
)
-
- ; special_pred(
+ ; mlds_special_pred_label(
string, % pred name
maybe(mercury_module_name),
% The module declaring the type,
@@ -1663,6 +1665,8 @@
arity % The type arity.
).
+:- func mlds_std_tabling_proc_label(mlds_proc_label) = mlds_proc_label.
+
%-----------------------------------------------------------------------------%
% Invert the case of the first letter of the string.
@@ -1743,7 +1747,7 @@
module_info_get_globals(ModuleInfo, Globals),
globals.get_target(Globals, Target),
(
- Target = c,
+ Target = target_c,
(
MaybeC = yes(Data),
Data = foreign_type_lang_data(CForeignType, _, _),
@@ -1755,7 +1759,7 @@
"mercury_type_to_mlds_type: No C foreign type")
)
;
- Target = il,
+ Target = target_il,
(
MaybeIL = yes(Data),
Data = foreign_type_lang_data(ILForeignType, _, _),
@@ -1767,7 +1771,7 @@
"mercury_type_to_mlds_type: No IL foreign type")
)
;
- Target = java,
+ Target = target_java,
(
MaybeJava = yes(Data),
Data = foreign_type_lang_data(JavaForeignType, _, _),
@@ -1779,7 +1783,7 @@
"mercury_type_to_mlds_type: no Java foreign type")
)
;
- Target = asm,
+ Target = target_asm,
(
MaybeC = yes(Data),
Data = foreign_type_lang_data(CForeignType, _, _),
@@ -1859,7 +1863,7 @@
% in order to match the usual Java conventions.
(
globals.get_target(Globals, CompilationTarget),
- CompilationTarget = java,
+ CompilationTarget = target_java,
QualKind = type_qual
->
AdjustedModule = flip_initial_case_of_final_part(Module)
@@ -1875,6 +1879,24 @@
wrapper_class_name = "mercury_code".
+mlds_std_tabling_proc_label(ProcLabel0) = ProcLabel :-
+ % We standardize the parts of PredLabel0 that aren't computable from
+ % the tabling pragma, because the code that creates the reset predicate
+ % in table_info_global_var_name in add_pragma.m doesn't have access to
+ % this information.
+ ProcLabel0 = mlds_proc_label(PredLabel0, ProcId),
+ (
+ PredLabel0 = mlds_user_pred_label(PorF, MaybeModuleName, Name,
+ Arity, _, _),
+ PredLabel = mlds_user_pred_label(PorF, MaybeModuleName, Name,
+ Arity, model_det, no)
+ ;
+ PredLabel0 = mlds_special_pred_label(_, _, _, _),
+ unexpected(this_file,
+ "mlds_std_tabling_proc_label: mlds_special_pred_label")
+ ),
+ ProcLabel = mlds_proc_label(PredLabel, ProcId).
+
flip_initial_case_of_final_part(unqualified(Name)) =
unqualified(flip_initial_case(Name)).
flip_initial_case_of_final_part(qualified(Qual, Name)) =
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.189
diff -u -b -r1.189 mlds_to_c.m
--- compiler/mlds_to_c.m 12 May 2006 08:32:07 -0000 1.189
+++ compiler/mlds_to_c.m 6 Jun 2006 02:12:54 -0000
@@ -29,6 +29,7 @@
:- interface.
:- import_module ml_backend.mlds.
+:- import_module backend_libs.rtti.
:- import_module io.
@@ -53,6 +54,9 @@
:- pred output_header_file(mlds::in, string::in,
io::di, io::uo) is det.
+:- func mlds_tabling_data_name(mlds_proc_label, proc_tabling_struct_id)
+ = string.
+
% output_c_file(MLDS, Suffix):
%
% Output C code for the specified MLDS module to the appropriate C file.
@@ -75,7 +79,6 @@
:- import_module backend_libs.c_util.
:- import_module backend_libs.foreign.
:- import_module backend_libs.name_mangle.
-:- import_module backend_libs.rtti. % for rtti.addr_to_string.
:- import_module check_hlds.type_util.
:- import_module hlds.code_model.
:- import_module hlds.hlds_pred. % for pred_proc_id.
@@ -198,7 +201,7 @@
mlds_output_src_imports(Indent, Imports, !IO) :-
globals.io_get_target(Target, !IO),
- ( Target = asm ->
+ ( Target = target_asm ->
% For --target asm, we don't create the header files for modules that
% don't contain C code, so we'd better not include them, since they
% might not exist.
@@ -334,7 +337,7 @@
% can be #included by C++ programs.
globals.io_get_target(Target, !IO),
- ( Target = c ->
+ ( Target = target_c ->
mlds_indent(Indent, !IO),
io.write_string("#ifdef __cplusplus\n", !IO),
mlds_indent(Indent, !IO),
@@ -428,7 +431,7 @@
mlds_output_hdr_end(Indent, ModuleName, !IO) :-
globals.io_get_target(Target, !IO),
- ( Target = c ->
+ ( Target = target_c ->
% Terminate the `extern "C"' wrapper.
mlds_indent(Indent, !IO),
io.write_string("#ifdef __cplusplus\n", !IO),
@@ -490,7 +493,7 @@
= mlds_foreign_code.
mlds_get_c_foreign_code(AllForeignCode) = ForeignCode :-
- ( map.search(AllForeignCode, c, ForeignCode0) ->
+ ( map.search(AllForeignCode, lang_c, ForeignCode0) ->
ForeignCode = ForeignCode0
;
% This can occur when compiling to a non-C target using
@@ -733,7 +736,7 @@
mlds_output_c_hdr_decl(_Indent, MaybeDesiredIsLocal, DeclCode, !IO) :-
DeclCode = foreign_decl_code(Lang, IsLocal, Code, Context),
% Only output C code in the C header file.
- ( Lang = c ->
+ ( Lang = lang_c ->
(
(
MaybeDesiredIsLocal = no
@@ -780,7 +783,7 @@
mlds_output_c_foreign_import_module(Indent, ForeignImport, !IO) :-
ForeignImport = foreign_import_module(Lang, Import, _),
- ( Lang = c ->
+ ( Lang = lang_c ->
mlds_output_src_import(Indent,
mercury_import(user_visible_interface,
mercury_module_name_to_mlds(Import)), !IO)
@@ -791,16 +794,17 @@
:- pred mlds_output_c_defn(indent::in, user_foreign_code::in,
io::di, io::uo) is det.
-mlds_output_c_defn(_Indent, user_foreign_code(c, Code, Context), !IO) :-
+mlds_output_c_defn(_Indent, user_foreign_code(lang_c, Code, Context), !IO) :-
output_context(mlds_make_context(Context), !IO),
io.write_string(Code, !IO).
-mlds_output_c_defn(_Indent, user_foreign_code(managed_cplusplus, _, _), !IO) :-
+mlds_output_c_defn(_Indent, user_foreign_code(lang_managed_cplusplus, _, _),
+ !IO) :-
sorry(this_file, "foreign code other than C").
-mlds_output_c_defn(_Indent, user_foreign_code(csharp, _, _), !IO) :-
+mlds_output_c_defn(_Indent, user_foreign_code(lang_csharp, _, _), !IO) :-
sorry(this_file, "foreign code other than C").
-mlds_output_c_defn(_Indent, user_foreign_code(il, _, _), !IO) :-
+mlds_output_c_defn(_Indent, user_foreign_code(lang_il, _, _), !IO) :-
sorry(this_file, "foreign code other than C").
-mlds_output_c_defn(_Indent, user_foreign_code(java, _, _), !IO) :-
+mlds_output_c_defn(_Indent, user_foreign_code(lang_java, _, _), !IO) :-
sorry(this_file, "foreign code other than C").
:- pred mlds_output_pragma_export_defn(mlds_module_name::in, indent::in,
@@ -847,11 +851,12 @@
io::di, io::uo) is det.
mlds_output_pragma_export_type(suffix, _Type, !IO).
-mlds_output_pragma_export_type(prefix, mlds_mercury_array_type(_ElemType), !IO) :-
+mlds_output_pragma_export_type(prefix, mlds_mercury_array_type(_ElemType),
+ !IO) :-
io.write_string("MR_ArrayPtr", !IO).
mlds_output_pragma_export_type(prefix, mercury_type(_, _, ExportedType),
!IO) :-
- io.write_string(foreign.to_type_string(c, ExportedType), !IO).
+ io.write_string(foreign.to_type_string(lang_c, ExportedType), !IO).
mlds_output_pragma_export_type(prefix, mlds_cont_type(_), !IO) :-
io.write_string("MR_Word", !IO).
mlds_output_pragma_export_type(prefix, mlds_commit_type, !IO) :-
@@ -866,7 +871,7 @@
io.write_string("MR_Char", !IO).
mlds_output_pragma_export_type(prefix, mlds_foreign_type(ForeignType), !IO) :-
(
- ForeignType = c(c(Name)),
+ ForeignType = c(c_type(Name)),
io.write_string(Name, !IO)
;
ForeignType = il(_),
@@ -894,6 +899,10 @@
io.write_string("MR_Word", !IO).
mlds_output_pragma_export_type(prefix, mlds_rtti_type(_), !IO) :-
io.write_string("MR_Word", !IO).
+mlds_output_pragma_export_type(prefix, mlds_tabling_type(_), !IO) :-
+ % These types should never occur in procedures exported to C, so the
+ % fact the could generate a more accurate type shouldn't matter.
+ io.write_string("MR_Word", !IO).
mlds_output_pragma_export_type(prefix, mlds_unknown_type, !IO) :-
unexpected(this_file, "mlds_output_pragma_export_type: unknown_type").
@@ -1781,9 +1790,10 @@
(
% Don't module-qualify main/2.
Name = function(PredLabel, _, _, _),
- PredLabel = pred(predicate, no, "main", 2, model_det, no)
+ PredLabel = mlds_user_pred_label(predicate, no, "main", 2,
+ model_det, no)
;
- Name = data(rtti(RttiId)),
+ Name = data(mlds_rtti(RttiId)),
module_qualify_name_of_rtti_id(RttiId) = no
;
% We don't module qualify pragma export names.
@@ -1802,8 +1812,9 @@
(
% Don't module-qualify main/2.
QualifiedName = qual(_ModuleName, _QualKind, Name),
- Name = PredLabel - _ProcId,
- PredLabel = pred(predicate, no, "main", 2, model_det, no)
+ Name = mlds_proc_label(PredLabel, _ProcId),
+ PredLabel = mlds_user_pred_label(predicate, no, "main", 2,
+ model_det, no)
->
mlds_output_proc_label(Name, !IO)
;
@@ -1850,10 +1861,13 @@
mlds_output_name(export(Name), !IO) :-
io.write_string(Name, !IO).
+ % mlds_output_pred_label should be kept in sync with
+ % mlds_pred_label_to_string.
+ %
:- pred mlds_output_pred_label(mlds_pred_label::in, io::di, io::uo) is det.
-mlds_output_pred_label(pred(PredOrFunc, MaybeDefiningModule, Name, Arity,
- _CodeModel, _NonOutputFunc), !IO) :-
+mlds_output_pred_label(mlds_user_pred_label(PredOrFunc, MaybeDefiningModule,
+ Name, Arity, _CodeModel, _NonOutputFunc), !IO) :-
( PredOrFunc = predicate, Suffix = "p"
; PredOrFunc = function, Suffix = "f"
),
@@ -1866,7 +1880,7 @@
;
MaybeDefiningModule = no
).
-mlds_output_pred_label(special_pred(PredName, MaybeTypeModule,
+mlds_output_pred_label(mlds_special_pred_label(PredName, MaybeTypeModule,
TypeName, TypeArity), !IO) :-
MangledPredName = name_mangle(PredName),
MangledTypeName = name_mangle(TypeName),
@@ -1883,25 +1897,62 @@
io.write_string("_", !IO),
io.write_int(TypeArity, !IO).
+ % mlds_pred_label_to_string should be kept in sync with
+ % mlds_output_pred_label.
+ %
+:- func mlds_pred_label_to_string(mlds_pred_label) = string.
+
+mlds_pred_label_to_string(mlds_user_pred_label(PredOrFunc, MaybeDefiningModule,
+ Name, Arity, _CodeModel, _NonOutputFunc)) = Str :-
+ ( PredOrFunc = predicate, Suffix = "p"
+ ; PredOrFunc = function, Suffix = "f"
+ ),
+ MangledName = name_mangle(Name),
+ MainStr = string.format("%s_%d_%s", [s(MangledName), i(Arity), s(Suffix)]),
+ (
+ MaybeDefiningModule = yes(DefiningModule),
+ Str = MainStr ++ "_in__" ++ sym_name_mangle(DefiningModule)
+ ;
+ MaybeDefiningModule = no,
+ Str = MainStr
+ ).
+mlds_pred_label_to_string(mlds_special_pred_label(PredName, MaybeTypeModule,
+ TypeName, TypeArity)) = Str :-
+ MangledPredName = name_mangle(PredName),
+ MangledTypeName = name_mangle(TypeName),
+ PrefixStr = MangledPredName ++ "__",
+ (
+ MaybeTypeModule = yes(TypeModule),
+ MidStr = sym_name_mangle(TypeModule) ++ "__"
+ ;
+ MaybeTypeModule = no,
+ MidStr = ""
+ ),
+ Str = PrefixStr ++ MidStr ++ MangledTypeName ++ "_" ++
+ int_to_string(TypeArity).
+
:- pred mlds_output_data_name(mlds_data_name::in, io::di, io::uo) is det.
mlds_output_data_name(var(Name), !IO) :-
mlds_output_mangled_name(ml_var_name_to_string(Name), !IO).
-mlds_output_data_name(common(Num), !IO) :-
+mlds_output_data_name(mlds_common(Num), !IO) :-
io.write_string("common_", !IO),
io.write_int(Num, !IO).
-mlds_output_data_name(rtti(RttiId), !IO) :-
+mlds_output_data_name(mlds_rtti(RttiId), !IO) :-
rtti.id_to_c_identifier(RttiId, RttiAddrName),
io.write_string(RttiAddrName, !IO).
-mlds_output_data_name(module_layout, !IO) :-
+mlds_output_data_name(mlds_module_layout, !IO) :-
sorry(this_file, "NYI: module_layout").
-mlds_output_data_name(proc_layout(_ProcLabel), !IO) :-
+mlds_output_data_name(mlds_proc_layout(_ProcLabel), !IO) :-
sorry(this_file, "NYI: proc_layout").
-mlds_output_data_name(internal_layout(_ProcLabel, _FuncSeqNum), !IO) :-
+mlds_output_data_name(mlds_internal_layout(_ProcLabel, _FuncSeqNum), !IO) :-
sorry(this_file, "NYI: internal_layout").
-mlds_output_data_name(tabling_pointer(ProcLabel), !IO) :-
- io.write_string("table_for_", !IO),
- mlds_output_proc_label(ProcLabel, !IO).
+mlds_output_data_name(mlds_tabling_ref(ProcLabel, Id), !IO) :-
+ io.write_string(mlds_tabling_data_name(ProcLabel, Id), !IO).
+
+mlds_tabling_data_name(ProcLabel, Id) =
+ tabling_info_id_str(Id) ++ "_for_" ++
+ mlds_proc_label_to_string(mlds_std_tabling_proc_label(ProcLabel)).
%-----------------------------------------------------------------------------%
%
@@ -2014,6 +2065,9 @@
mlds_output_type_prefix(mlds_rtti_type(RttiIdMaybeElement), !IO) :-
rtti_id_maybe_element_c_type(RttiIdMaybeElement, CType, _IsArray),
io.write_string(CType, !IO).
+mlds_output_type_prefix(mlds_tabling_type(TablingId), !IO) :-
+ tabling_id_c_type(TablingId, CType, _IsArray),
+ io.write_string(CType, !IO).
mlds_output_type_prefix(mlds_unknown_type, !IO) :-
unexpected(this_file, "prefix has unknown type").
@@ -2173,10 +2227,20 @@
).
mlds_output_type_suffix(mlds_commit_type, _, !IO).
mlds_output_type_suffix(mlds_rtti_type(RttiIdMaybeElement), ArraySize, !IO) :-
- ( rtti_id_maybe_element_has_array_type(RttiIdMaybeElement) = yes ->
+ IsArrayType = rtti_id_maybe_element_has_array_type(RttiIdMaybeElement),
+ (
+ IsArrayType = yes,
mlds_output_array_type_suffix(ArraySize, !IO)
;
- true
+ IsArrayType = no
+ ).
+mlds_output_type_suffix(mlds_tabling_type(TablingId), ArraySize, !IO) :-
+ IsArrayType = tabling_id_has_array_type(TablingId),
+ (
+ IsArrayType = yes,
+ mlds_output_array_type_suffix(ArraySize, !IO)
+ ;
+ IsArrayType = no
).
mlds_output_type_suffix(mlds_unknown_type, _, !IO) :-
unexpected(this_file, "mlds_output_type_suffix: unknown_type").
@@ -3050,10 +3114,10 @@
io.write_string(CodeString, !IO).
mlds_output_target_code_component(_Context, target_code_input(Rval), !IO) :-
mlds_output_rval(Rval, !IO),
- io.write_string("\n", !IO).
+ io.write_string(" ", !IO).
mlds_output_target_code_component(_Context, target_code_output(Lval), !IO) :-
mlds_output_lval(Lval, !IO),
- io.write_string("\n", !IO).
+ io.write_string(" ", !IO).
mlds_output_target_code_component(_Context, name(Name), !IO) :-
mlds_output_fully_qualified_name(Name, !IO),
io.write_string("\n", !IO).
@@ -3083,6 +3147,11 @@
% so we should never get here.
unexpected(this_file,
"type_needs_forwarding_pointer_space: rtti_type").
+type_needs_forwarding_pointer_space(mlds_tabling_type(_)) = _ :-
+ % These should all be statically allocated, not dynamically allocated,
+ % so we should never get here.
+ unexpected(this_file,
+ "type_needs_forwarding_pointer_space: tabling_type").
type_needs_forwarding_pointer_space(mlds_unknown_type) = _ :-
unexpected(this_file, "type_needs_forwarding_pointer_space: unknown_type").
@@ -3596,22 +3665,33 @@
:- pred mlds_output_proc_label(mlds_proc_label::in, io::di, io::uo) is det.
-mlds_output_proc_label(PredLabel - ProcId, !IO) :-
+mlds_output_proc_label(mlds_proc_label(PredLabel, ProcId), !IO) :-
mlds_output_pred_label(PredLabel, !IO),
proc_id_to_int(ProcId, ModeNum),
io.format("_%d", [i(ModeNum)], !IO).
+:- func mlds_proc_label_to_string(mlds_proc_label) = string.
+
+mlds_proc_label_to_string(mlds_proc_label(PredLabel, ProcId)) =
+ mlds_pred_label_to_string(PredLabel) ++
+ string.format("_%d", [i(proc_id_to_int(ProcId))]).
+
:- pred mlds_output_data_addr(mlds_data_addr::in, io::di, io::uo) is det.
mlds_output_data_addr(data_addr(ModuleName, DataName), !IO) :-
+ % If its an array type, then we just use the name, otherwise we must
+ % prefix the name with `&'.
(
- % If its an array type, then we just use the name,
- % otherwise we must prefix the name with `&'.
- DataName = rtti(RttiId),
+ DataName = mlds_rtti(RttiId),
rtti_id_has_array_type(RttiId) = yes
->
mlds_output_data_var_name(ModuleName, DataName, !IO)
;
+ DataName = mlds_tabling_ref(_, TablingId),
+ tabling_id_has_array_type(TablingId) = yes
+ ->
+ mlds_output_data_var_name(ModuleName, DataName, !IO)
+ ;
io.write_string("(&", !IO),
mlds_output_data_var_name(ModuleName, DataName, !IO),
io.write_string(")", !IO)
@@ -3622,7 +3702,7 @@
mlds_output_data_var_name(ModuleName, DataName, !IO) :-
(
- DataName = rtti(RttiId),
+ DataName = mlds_rtti(RttiId),
module_qualify_name_of_rtti_id(RttiId) = no
->
true
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.117
diff -u -b -r1.117 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 29 Mar 2006 08:07:05 -0000 1.117
+++ compiler/mlds_to_gcc.m 6 Jun 2006 01:10:23 -0000
@@ -255,7 +255,7 @@
{ list__filter(defn_contains_foreign_code(lang_asm), Defns0,
ForeignDefns, Defns) },
% We only handle C currently, so we just look up C
- { ForeignCode = map__lookup(AllForeignCode, c) },
+ { ForeignCode = map__lookup(AllForeignCode, lang_c) },
(
% Check if there is any C code from pragma foreign_code,
% pragma export, or pragma foreign_proc declarations.
@@ -1623,12 +1623,12 @@
% necessarily need to be unique.
%
(
- PredLabel = pred(_PorF, _ModuleName, PredName, _Arity,
- _CodeModel, _NonOutputFunc),
+ PredLabel = mlds_user_pred_label(_PorF, _ModuleName,
+ PredName, _Arity, _CodeModel, _NonOutputFunc),
FuncName = PredName
;
- PredLabel = special_pred(SpecialPredName, _ModuleName,
- TypeName, _Arity),
+ PredLabel = mlds_special_pred_label(SpecialPredName,
+ _ModuleName, TypeName, _Arity),
FuncName = SpecialPredName ++ TypeName
)
;
@@ -1640,8 +1640,8 @@
:- pred get_pred_label_name(mlds_pred_label, string).
:- mode get_pred_label_name(in, out) is det.
-get_pred_label_name(pred(PredOrFunc, MaybeDefiningModule, Name, Arity,
- _CodeMode, _NonOutputFunc), LabelName) :-
+get_pred_label_name(mlds_user_pred_label(PredOrFunc, MaybeDefiningModule, Name,
+ Arity, _CodeMode, _NonOutputFunc), LabelName) :-
( PredOrFunc = predicate, Suffix = "p"
; PredOrFunc = function, Suffix = "f"
),
@@ -1654,7 +1654,7 @@
;
LabelName = LabelName0
).
-get_pred_label_name(special_pred(PredName, MaybeTypeModule,
+get_pred_label_name(mlds_special_pred_label(PredName, MaybeTypeModule,
TypeName, TypeArity), LabelName) :-
MangledPredName = name_mangle(PredName),
MangledTypeName = name_mangle(TypeName),
@@ -1855,6 +1855,9 @@
build_type(mlds_rtti_type(RttiIdMaybeElement), InitializerSize, _GlobalInfo,
GCC_Type) -->
build_rtti_type(RttiIdMaybeElement, InitializerSize, GCC_Type).
+build_type(mlds_tabling_type(_TablingId), _InitializerSize, _GlobalInfo,
+ _GCC_Type) -->
+ { sorry(this_file, "NYI: tabling in the asm backend") }.
build_type(mlds_unknown_type, _, _, _) -->
{ unexpected(this_file, "build_type: unknown type") }.
@@ -2550,10 +2553,10 @@
% don't module-qualify main/2
%
Name = function(PredLabel, _, _, _),
- PredLabel = pred(predicate, no, "main", 2,
- model_det, no)
+ PredLabel = mlds_user_pred_label(predicate, no,
+ "main", 2, model_det, no)
;
- Name = data(rtti(RttiId)),
+ Name = data(mlds_rtti(RttiId)),
module_qualify_name_of_rtti_id(RttiId) = no
;
% We don't module qualify pragma export names.
@@ -2584,25 +2587,25 @@
:- func build_data_name(mlds_data_name) = string.
build_data_name(var(Name)) = name_mangle(ml_var_name_to_string(Name)).
-build_data_name(common(Num)) =
+build_data_name(mlds_common(Num)) =
string__format("common_%d", [i(Num)]).
-build_data_name(rtti(RttiId0)) = RttiAddrName :-
+build_data_name(mlds_rtti(RttiId0)) = RttiAddrName :-
RttiId = fixup_rtti_id(RttiId0),
rtti__id_to_c_identifier(RttiId, RttiAddrName).
-build_data_name(module_layout) = _ :-
- sorry(this_file, "module_layout").
-build_data_name(proc_layout(_ProcLabel)) = _ :-
- sorry(this_file, "proc_layout").
-build_data_name(internal_layout(_ProcLabel, _FuncSeqNum)) = _ :-
- sorry(this_file, "internal_layout").
-build_data_name(tabling_pointer(ProcLabel)) = TablingPointerName :-
+build_data_name(mlds_module_layout) = _ :-
+ sorry(this_file, "mlds_module_layout").
+build_data_name(mlds_proc_layout(_ProcLabel)) = _ :-
+ sorry(this_file, "mlds_proc_layout").
+build_data_name(mlds_internal_layout(_ProcLabel, _FuncSeqNum)) = _ :-
+ sorry(this_file, "mlds_internal_layout").
+build_data_name(mlds_tabling_ref(ProcLabel, Id)) = TablingPointerName :-
% convert the proc_label into an entity_name,
% so we can use get_func_name below
- ProcLabel = PredLabel - ProcId,
+ ProcLabel = mlds_proc_label(PredLabel, ProcId),
MaybeSeqNum = no,
Name = function(PredLabel, ProcId, MaybeSeqNum, invalid_pred_id),
get_func_name(Name, _FuncName, AsmFuncName),
- TablingPointerName = string__append("table_for_", AsmFuncName).
+ TablingPointerName = tabling_info_id_str(Id) ++ "_" ++ AsmFuncName.
:- func fixup_rtti_id(rtti_id) = rtti_id.
@@ -3672,7 +3675,8 @@
),
% convert the label into a entity_name,
% so we can use make_func_decl below
- { Label = qual(ModuleName, QualKind, PredLabel - ProcId) },
+ { Label = qual(ModuleName, QualKind,
+ mlds_proc_label(PredLabel, ProcId)) },
{ Name = qual(ModuleName, QualKind, function(PredLabel, ProcId,
MaybeSeqNum, invalid_pred_id)) },
% build a function declaration for the function,
@@ -3702,7 +3706,7 @@
build_data_var_name(ModuleName, DataName) =
ModuleQualifier ++ build_data_name(DataName) :-
(
- DataName = rtti(RttiId),
+ DataName = mlds_rtti(RttiId),
module_qualify_name_of_rtti_id(RttiId) = no
->
ModuleQualifier = ""
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.161
diff -u -b -r1.161 mlds_to_il.m
--- compiler/mlds_to_il.m 29 Mar 2006 08:07:05 -0000 1.161
+++ compiler/mlds_to_il.m 5 Jun 2006 18:42:13 -0000
@@ -312,7 +312,7 @@
IlInfo0, IlInfo),
list.filter(has_foreign_code_defined(ForeignCode),
- [managed_cplusplus, csharp], ForeignCodeLangs),
+ [lang_managed_cplusplus, lang_csharp], ForeignCodeLangs),
ForeignLangs = IlInfo ^ file_foreign_langs `union`
set.list_to_set(ForeignCodeLangs),
@@ -1101,7 +1101,7 @@
% C# file associated with this file. This is very hackish.
ForeignLangs = !.Info ^ file_foreign_langs,
!:Info = !.Info ^ file_foreign_langs :=
- set.insert(ForeignLangs, csharp),
+ set.insert(ForeignLangs, lang_csharp),
mangle_dataname_module(no, ModuleName, NewModuleName),
ClassName = mlds_module_name_to_class_name(NewModuleName),
@@ -1139,7 +1139,8 @@
% in the cctor of this module.
(
Name = function(PredLabel, _ProcId, MaybeSeqNum, _PredId),
- PredLabel = pred(predicate, no, "main", 2, model_det, no),
+ PredLabel = mlds_user_pred_label(predicate, no, "main", 2,
+ model_det, no),
MaybeSeqNum = no
->
EntryPoint = [entrypoint],
@@ -1327,18 +1328,18 @@
mangle_dataname(var(MLDSVarName))
= mangle_mlds_var_name(MLDSVarName).
-mangle_dataname(common(Int))
+mangle_dataname(mlds_common(Int))
= string.format("common_%d", [i(Int)]).
-mangle_dataname(rtti(RttiId)) = MangledName :-
+mangle_dataname(mlds_rtti(RttiId)) = MangledName :-
rtti.id_to_c_identifier(RttiId, MangledName).
-mangle_dataname(module_layout) = _MangledName :-
- unexpected(this_file, "unimplemented: mangling module_layout").
-mangle_dataname(proc_layout(_)) = _MangledName :-
- unexpected(this_file, "unimplemented: mangling proc_layout").
-mangle_dataname(internal_layout(_, _)) = _MangledName :-
- unexpected(this_file, "unimplemented: mangling internal_layout").
-mangle_dataname(tabling_pointer(_)) = _MangledName :-
- unexpected(this_file, "unimplemented: mangling tabling_pointer").
+mangle_dataname(mlds_module_layout) = _MangledName :-
+ unexpected(this_file, "unimplemented: mangling mlds_module_layout").
+mangle_dataname(mlds_proc_layout(_)) = _MangledName :-
+ unexpected(this_file, "unimplemented: mangling mlds_proc_layout").
+mangle_dataname(mlds_internal_layout(_, _)) = _MangledName :-
+ unexpected(this_file, "unimplemented: mangling mlds_internal_layout").
+mangle_dataname(mlds_tabling_ref(_, _)) = _MangledName :-
+ unexpected(this_file, "unimplemented: mangling mlds_tabling_ref").
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -1397,7 +1398,8 @@
Signature = mlds_func_signature(ArgTypes, RetTypes),
( UnqualName = function(PredLabel, ProcId, _MaybeSeq, _PredId) ->
CodeRval = const(code_addr_const(proc(
- qual(ModuleName, module_qual, PredLabel - ProcId), Signature)))
+ qual(ModuleName, module_qual, mlds_proc_label(PredLabel, ProcId)),
+ Signature)))
;
unexpected(this_file, "exported entity is not a function")
),
@@ -2013,7 +2015,7 @@
;
DataRep ^ highlevel_data = yes,
Type = mercury_type(MercuryType, type_cat_user_ctor, _),
- \+ type_needs_lowlevel_rep(il, MercuryType)
+ \+ type_needs_lowlevel_rep(target_il, MercuryType)
)
->
% If this is a class, we should call the constructor. (This is needed
@@ -3013,6 +3015,9 @@
mlds_type_to_ilds_type(_, mlds_rtti_type(_RttiName)) = il_object_array_type.
+ % This is a placeholder only.
+mlds_type_to_ilds_type(_, mlds_tabling_type(_Id)) = il_object_array_type.
+
mlds_type_to_ilds_type(DataRep, mlds_mercury_array_type(ElementType)) =
( ElementType = mercury_type(_, type_cat_variable, _) ->
il_generic_array_type
@@ -3067,7 +3072,7 @@
mlds_type_to_ilds_type(_, mlds_foreign_type(ForeignType))
= il_type([], Class) :-
(
- ForeignType = il(il(RefOrVal, Assembly, Type)),
+ ForeignType = il(il_type(RefOrVal, Assembly, Type)),
sym_name_to_class_name(Type, ForeignClassName),
(
RefOrVal = reference,
@@ -3126,7 +3131,7 @@
mlds_mercury_type_to_ilds_type(DataRep, MercuryType, type_cat_user_ctor) =
(
DataRep ^ highlevel_data = yes,
- \+ type_needs_lowlevel_rep(il, MercuryType)
+ \+ type_needs_lowlevel_rep(target_il, MercuryType)
->
mercury_type_to_highlevel_class_type(MercuryType)
;
@@ -3237,8 +3242,8 @@
% XXX I think that it may be possible to have conflicts with
% user names in the case where there is a <modulename>. - fjh
%
-predlabel_to_id(pred(PredOrFunc, MaybeModuleName, Name, Arity, CodeModel,
- NonOutputFunc), ProcId, MaybeSeqNum, Id) :-
+predlabel_to_id(mlds_user_pred_label(PredOrFunc, MaybeModuleName, Name, Arity,
+ CodeModel, NonOutputFunc), ProcId, MaybeSeqNum, Id) :-
(
MaybeModuleName = yes(ModuleName),
mlds_to_il.sym_name_to_string(ModuleName, MStr),
@@ -3280,8 +3285,8 @@
Id = UnMangledId.
% Id = name_mangle(UnMangledId).
-predlabel_to_id(special_pred(PredName, MaybeModuleName, TypeName, Arity),
- ProcId, MaybeSeqNum, Id) :-
+predlabel_to_id(mlds_special_pred_label(PredName, MaybeModuleName, TypeName,
+ Arity), ProcId, MaybeSeqNum, Id) :-
proc_id_to_int(ProcId, ProcIdInt),
(
MaybeModuleName = yes(ModuleName),
@@ -3371,7 +3376,7 @@
mlds_module_name::in, mlds_module_name::out) is det.
mangle_dataname_module(no, !ModuleName) :-
- mangle_foreign_code_module(csharp, !ModuleName).
+ mangle_foreign_code_module(lang_csharp, !ModuleName).
mangle_dataname_module(yes(DataName), !ModuleName) :-
(
@@ -3394,22 +3399,22 @@
mangle_dataname(var(MLDSVarName), Name) :-
Name = mangle_mlds_var_name(MLDSVarName).
-mangle_dataname(common(Int), MangledName) :-
+mangle_dataname(mlds_common(Int), MangledName) :-
string.format("common_%d", [i(Int)], MangledName).
-mangle_dataname(rtti(RttiId), MangledName) :-
+mangle_dataname(mlds_rtti(RttiId), MangledName) :-
rtti.id_to_c_identifier(RttiId, MangledName).
-mangle_dataname(module_layout, _MangledName) :-
- sorry(this_file, "unimplemented: mangling module_layout").
-mangle_dataname(proc_layout(_), _MangledName) :-
- sorry(this_file, "unimplemented: mangling proc_layout").
-mangle_dataname(internal_layout(_, _), _MangledName) :-
- sorry(this_file, "unimplemented: mangling internal_layout").
-mangle_dataname(tabling_pointer(_), _MangledName) :-
- sorry(this_file, "unimplemented: mangling tabling_pointer").
+mangle_dataname(mlds_module_layout, _MangledName) :-
+ sorry(this_file, "unimplemented: mangling mlds_module_layout").
+mangle_dataname(mlds_proc_layout(_), _MangledName) :-
+ sorry(this_file, "unimplemented: mangling mlds_proc_layout").
+mangle_dataname(mlds_internal_layout(_, _), _MangledName) :-
+ sorry(this_file, "unimplemented: mangling mlds_internal_layout").
+mangle_dataname(mlds_tabling_ref(_, _), _MangledName) :-
+ sorry(this_file, "unimplemented: mangling mlds_tabling_ref").
% We turn procedures into methods of classes.
-mangle_mlds_proc_label(qual(ModuleName, _, PredLabel - ProcId), MaybeSeqNum,
- ClassName, PredStr) :-
+mangle_mlds_proc_label(qual(ModuleName, _, mlds_proc_label(PredLabel, ProcId)),
+ MaybeSeqNum, ClassName, PredStr) :-
ClassName = mlds_module_name_to_class_name(ModuleName),
predlabel_to_id(PredLabel, ProcId, MaybeSeqNum, PredStr).
Index: compiler/mlds_to_ilasm.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_ilasm.m,v
retrieving revision 1.33
diff -u -b -r1.33 mlds_to_ilasm.m
--- compiler/mlds_to_ilasm.m 29 Mar 2006 08:07:06 -0000 1.33
+++ compiler/mlds_to_ilasm.m 30 May 2006 05:18:06 -0000
@@ -110,13 +110,14 @@
:- pred handle_foreign_lang(foreign_language::in,
pred(mlds, io, io)::out(pred(in, di, uo) is det)) is det.
-handle_foreign_lang(managed_cplusplus, output_managed_code(managed_cplusplus)).
-handle_foreign_lang(csharp, output_managed_code(csharp)).
-handle_foreign_lang(c, _) :-
+handle_foreign_lang(lang_managed_cplusplus,
+ output_managed_code(lang_managed_cplusplus)).
+handle_foreign_lang(lang_csharp, output_managed_code(lang_csharp)).
+handle_foreign_lang(lang_c, _) :-
sorry(this_file, "language C foreign code not supported").
-handle_foreign_lang(il, _) :-
+handle_foreign_lang(lang_il, _) :-
sorry(this_file, "language IL foreign code not supported").
-handle_foreign_lang(java, _) :-
+handle_foreign_lang(lang_java, _) :-
sorry(this_file, "language Java foreign code not supported").
% Generate the `.il' file.
Index: compiler/mlds_to_java.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_java.m,v
retrieving revision 1.76
diff -u -b -r1.76 mlds_to_java.m
--- compiler/mlds_to_java.m 29 Mar 2006 08:07:06 -0000 1.76
+++ compiler/mlds_to_java.m 6 Jun 2006 01:22:04 -0000
@@ -469,7 +469,7 @@
output_java_decl(Indent, DeclCode, !IO) :-
DeclCode = foreign_decl_code(Lang, _IsLocal, Code, Context),
- ( Lang = java ->
+ ( Lang = lang_java ->
indent_line(mlds_make_context(Context), Indent, !IO),
io.write_string(Code, !IO),
io.nl(!IO)
@@ -482,7 +482,7 @@
output_java_body_code(Indent, user_foreign_code(Lang, Code, Context), !IO) :-
% Only output Java code.
- ( Lang = java ->
+ ( Lang = lang_java ->
indent_line(mlds_make_context(Context), Indent, !IO),
io.write_string(Code, !IO),
io.nl(!IO)
@@ -496,7 +496,7 @@
= mlds_foreign_code.
mlds_get_java_foreign_code(AllForeignCode) = ForeignCode :-
- ( map.search(AllForeignCode, java, ForeignCode0) ->
+ ( map.search(AllForeignCode, lang_java, ForeignCode0) ->
ForeignCode = ForeignCode0
;
ForeignCode = mlds_foreign_code([], [], [], [])
@@ -760,7 +760,8 @@
CodeAddr = internal(ProcLabel, SeqNum, _FuncSig),
MaybeSeqNum = yes(SeqNum)
),
- ProcLabel = qual(ModuleQualifier, QualKind, PredLabel - ProcID),
+ ProcLabel = qual(ModuleQualifier, QualKind,
+ mlds_proc_label(PredLabel, ProcID)),
PredName = make_pred_name_string(PredLabel, ProcID, MaybeSeqNum),
% Create class components.
@@ -810,7 +811,7 @@
ProcID = initial_proc_id,
% Create new method name.
- Label = special_pred("call", no, "", 0),
+ Label = mlds_special_pred_label("call", no, "", 0),
MethodName = function(Label, ProcID, no, PredID),
% Create method argument and return type.
@@ -931,8 +932,8 @@
:- func pred_label_string(mlds_pred_label) = string.
-pred_label_string(pred(PredOrFunc, MaybeDefiningModule, Name, PredArity,
- _CodeModel, _NonOutputFunc)) = PredLabelStr :-
+pred_label_string(mlds_user_pred_label(PredOrFunc, MaybeDefiningModule, Name,
+ PredArity, _CodeModel, _NonOutputFunc)) = PredLabelStr :-
(
PredOrFunc = predicate,
Suffix = "p",
@@ -953,8 +954,8 @@
MaybeDefiningModule = no,
PredLabelStr = PredLabelStr0
).
-pred_label_string(special_pred(PredName, MaybeTypeModule, TypeName, TypeArity))
- = PredLabelStr :-
+pred_label_string(mlds_special_pred_label(PredName, MaybeTypeModule, TypeName,
+ TypeArity)) = PredLabelStr :-
MangledPredName = name_mangle(PredName),
MangledTypeName = name_mangle(TypeName),
PredLabelStr0 = MangledPredName ++ "__",
@@ -1385,6 +1386,7 @@
get_java_type_initializer(mlds_type_info_type) = "null".
get_java_type_initializer(mlds_pseudo_type_info_type) = "null".
get_java_type_initializer(mlds_rtti_type(_)) = "null".
+get_java_type_initializer(mlds_tabling_type(_)) = "null".
get_java_type_initializer(mlds_unknown_type) = _ :-
unexpected(this_file, "get_type_initializer: variable has unknown_type").
@@ -1674,7 +1676,7 @@
:- pred output_pred_label(mlds_pred_label::in, io::di, io::uo) is det.
-output_pred_label(pred(PredOrFunc, MaybeDefiningModule, Name,
+output_pred_label(mlds_user_pred_label(PredOrFunc, MaybeDefiningModule, Name,
PredArity, _, _), !IO) :-
(
PredOrFunc = predicate,
@@ -1695,8 +1697,8 @@
MaybeDefiningModule = no
).
-output_pred_label(special_pred(PredName, MaybeTypeModule, TypeName, TypeArity),
- !IO) :-
+output_pred_label(mlds_special_pred_label(PredName, MaybeTypeModule, TypeName,
+ TypeArity), !IO) :-
MangledPredName = name_mangle(PredName),
MangledTypeName = name_mangle(TypeName),
io.write_string(MangledPredName, !IO),
@@ -1714,21 +1716,22 @@
output_data_name(var(VarName), !IO) :-
output_mlds_var_name(VarName, !IO).
-output_data_name(common(Num), !IO) :-
+output_data_name(mlds_common(Num), !IO) :-
io.write_string("common_", !IO),
io.write_int(Num, !IO).
-output_data_name(rtti(RttiId), !IO) :-
+output_data_name(mlds_rtti(RttiId), !IO) :-
rtti.id_to_c_identifier(RttiId, RttiAddrName),
io.write_string(RttiAddrName, !IO).
-output_data_name(module_layout, !IO) :-
- unexpected(this_file, "NYI: module_layout").
-output_data_name(proc_layout(_ProcLabel), !IO) :-
- unexpected(this_file, "NYI: proc_layout").
-output_data_name(internal_layout(_ProcLabel, _FuncSeqNum), !IO) :-
- unexpected(this_file, "NYI: internal_layout").
-output_data_name(tabling_pointer(ProcLabel), !IO) :-
- io.write_string("table_for_", !IO),
- mlds_output_proc_label(ProcLabel, !IO).
+output_data_name(mlds_module_layout, !IO) :-
+ unexpected(this_file, "NYI: mlds_module_layout").
+output_data_name(mlds_proc_layout(_ProcLabel), !IO) :-
+ unexpected(this_file, "NYI: mlds_proc_layout").
+output_data_name(mlds_internal_layout(_ProcLabel, _FuncSeqNum), !IO) :-
+ unexpected(this_file, "NYI: mlds_internal_layout").
+output_data_name(mlds_tabling_ref(ProcLabel, Id), !IO) :-
+ Prefix = tabling_info_id_str(Id) ++ "_",
+ io.write_string(Prefix, !IO),
+ mlds_output_proc_label(mlds_std_tabling_proc_label(ProcLabel), !IO).
:- pred output_mlds_var_name(mlds_var_name::in, io::di, io::uo) is det.
@@ -1781,7 +1784,7 @@
io.write_string("char", !IO).
output_type(mlds_foreign_type(ForeignType), !IO) :-
(
- ForeignType = java(java(Name)),
+ ForeignType = java(java_type(Name)),
io.write_string(Name, !IO)
;
ForeignType = c(_),
@@ -1826,6 +1829,15 @@
;
IsArray = no
).
+output_type(mlds_tabling_type(TablingId), !IO) :-
+ tabling_id_java_type(TablingId, JavaTypeName, IsArray),
+ io.write_string(JavaTypeName, !IO),
+ (
+ IsArray = yes,
+ io.write_string("[]", !IO)
+ ;
+ IsArray = no
+ ).
output_type(mlds_unknown_type, !IO) :-
unexpected(this_file, "output_type: unknown type").
@@ -3248,7 +3260,7 @@
:- pred mlds_output_proc_label(mlds_proc_label::in, io::di, io::uo) is det.
-mlds_output_proc_label(PredLabel - ProcId, !IO) :-
+mlds_output_proc_label(mlds_proc_label(PredLabel, ProcId), !IO) :-
output_pred_label(PredLabel, !IO),
proc_id_to_int(ProcId, ModeNum),
io.format("_%d", [i(ModeNum)], !IO).
Index: compiler/mlds_to_managed.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_managed.m,v
retrieving revision 1.28
diff -u -b -r1.28 mlds_to_managed.m
--- compiler/mlds_to_managed.m 29 Mar 2006 08:07:06 -0000 1.28
+++ compiler/mlds_to_managed.m 30 May 2006 05:59:29 -0000
@@ -23,7 +23,7 @@
%-----------------------------------------------------------------------------%
-:- inst managed_lang == bound(csharp; managed_cplusplus).
+:- inst managed_lang == bound(lang_csharp; lang_managed_cplusplus).
% Convert the MLDS to the specified foreign language and write
% it to a file.
@@ -135,11 +135,11 @@
), !IO),
(
- Lang = csharp,
+ Lang = lang_csharp,
io.write_strings(["\npublic class " ++ wrapper_class_name, "{\n"],
!IO)
;
- Lang = managed_cplusplus,
+ Lang = lang_managed_cplusplus,
io.write_strings(["\n__gc public class " ++ wrapper_class_name,
"{\n", "public:\n"], !IO)
),
@@ -168,7 +168,8 @@
foreign_language::in(managed_lang), mercury_module_name::in,
mlds_imports::in, io::di, io::uo) is det.
-output_language_specific_header_code(csharp, _ModuleName, _Imports, !IO) :-
+output_language_specific_header_code(lang_csharp, _ModuleName, _Imports,
+ !IO) :-
get_il_data_rep(DataRep, !IO),
( DataRep = il_data_rep(yes, _) ->
io.write_string("#define MR_HIGHLEVEL_DATA\n", !IO)
@@ -189,8 +190,8 @@
;
SignAssembly = no
).
-output_language_specific_header_code(managed_cplusplus, ModuleName, Imports,
- !IO) :-
+output_language_specific_header_code(lang_managed_cplusplus, ModuleName,
+ Imports, !IO) :-
get_il_data_rep(DataRep, !IO),
( DataRep = il_data_rep(yes, _) ->
io.write_string("#define MR_HIGHLEVEL_DATA\n", !IO)
@@ -269,7 +270,7 @@
% source file. C# declares which assemblies it refers to via
% command line arguments to the C# compiler.
(
- Lang = managed_cplusplus,
+ Lang = lang_managed_cplusplus,
Imports = list.reverse(RevImports),
list.foldl(
(pred(ForeignImport::in, !.IO::di, !:IO::uo) is det :-
@@ -279,7 +280,7 @@
io.write_strings(["#using """, FileName, """\n"], !IO)
), Imports, !IO)
;
- Lang = csharp
+ Lang = lang_csharp
),
HeaderCode = list.reverse(RevHeaderCode),
@@ -304,11 +305,11 @@
% XXX We should consider what happens if we need to mangle
% the namespace name.
(
- Lang = csharp,
+ Lang = lang_csharp,
NameExt = "__csharp_code",
NameSpaceFmtStr = "namespace @%s {"
;
- Lang = managed_cplusplus,
+ Lang = lang_managed_cplusplus,
NameExt = "__cpp_code",
NameSpaceFmtStr = "namespace %s {"
),
@@ -374,10 +375,10 @@
predlabel_to_id(PredLabel, ProcId, MaybeSeqNum, Id),
(
- Lang = csharp,
+ Lang = lang_csharp,
io.write_string("public static ", !IO)
;
- Lang = managed_cplusplus,
+ Lang = lang_managed_cplusplus,
io.write_string("static ", !IO)
),
write_il_ret_type_as_foreign_type(Lang, ReturnType, !IO),
@@ -458,11 +459,11 @@
io.write_string(VarName, !IO),
% In C# give output variables a default value to avoid warnings.
(
- Lang = csharp,
+ Lang = lang_csharp,
io.write_string(" = ", !IO),
write_parameter_initializer(Lang, Type, !IO)
;
- Lang = managed_cplusplus
+ Lang = lang_managed_cplusplus
),
io.write_string(";\n", !IO).
write_outline_arg_init(_Lang, unused, !IO).
@@ -498,14 +499,13 @@
io.write_string(" ", !IO),
write_mlds_var_name_for_local(VarName, !IO),
- % In C# give output types a default value to
- % avoid warnings.
+ % In C# give output types a default value to avoid warnings.
(
- Lang = csharp,
+ Lang = lang_csharp,
io.write_string(" = ", !IO),
write_parameter_initializer(Lang, OutputType, !IO)
;
- Lang = managed_cplusplus
+ Lang = lang_managed_cplusplus
),
io.write_string(";\n", !IO)
)
@@ -534,9 +534,9 @@
not is_anonymous_variable(VarName)
->
(
- Lang = csharp
+ Lang = lang_csharp
;
- Lang = managed_cplusplus,
+ Lang = lang_managed_cplusplus,
io.write_string("*", !IO)
),
write_mlds_var_name_for_parameter(VarName, !IO),
@@ -651,10 +651,10 @@
sorry(this_file, "data_addr_const rval").
write_rval_const(Lang, null(_), !IO) :-
(
- Lang = csharp,
+ Lang = lang_csharp,
io.write_string("null", !IO)
;
- Lang = managed_cplusplus,
+ Lang = lang_managed_cplusplus,
io.write_string("NULL", !IO)
).
@@ -677,10 +677,10 @@
io.write_string("]", !IO).
write_lval(Lang, mem_ref(Rval, _), !IO) :-
(
- Lang = managed_cplusplus,
+ Lang = lang_managed_cplusplus,
io.write_string("*", !IO)
;
- Lang = csharp
+ Lang = lang_csharp
),
write_rval(Lang, Rval, !IO).
write_lval(_Lang, var(Var, _VarType), !IO) :-
@@ -690,9 +690,9 @@
:- pred write_field_selector(foreign_language::in(managed_lang),
io::di, io::uo) is det.
-write_field_selector(csharp, !IO) :-
+write_field_selector(lang_csharp, !IO) :-
io.write_string(".", !IO).
-write_field_selector(managed_cplusplus, !IO) :-
+write_field_selector(lang_managed_cplusplus, !IO) :-
io.write_string("->", !IO).
:- pred write_defn_decl(foreign_language::in(managed_lang), mlds_defn::in,
@@ -739,9 +739,9 @@
:- pred write_parameter_initializer(foreign_language::in(managed_lang),
mlds_type::in, io::di, io::uo) is det.
-write_parameter_initializer(managed_cplusplus, _Type, !IO) :-
+write_parameter_initializer(lang_managed_cplusplus, _Type, !IO) :-
unexpected(this_file, "initializer for MC++").
-write_parameter_initializer(csharp, Type, !IO) :-
+write_parameter_initializer(lang_csharp, Type, !IO) :-
get_il_data_rep(DataRep, !IO),
ILType = mlds_type_to_ilds_type(DataRep, Type),
ILType = il_type(_, ILSimpleType),
@@ -780,9 +780,9 @@
foreign_language::in(managed_lang),
simple_type::in, io::di, io::uo) is det.
-write_il_simple_type_as_foreign_type(csharp, Type, !IO) :-
+write_il_simple_type_as_foreign_type(lang_csharp, Type, !IO) :-
write_il_simple_type_as_foreign_type_cs(Type, !IO).
-write_il_simple_type_as_foreign_type(managed_cplusplus, Type, !IO) :-
+write_il_simple_type_as_foreign_type(lang_managed_cplusplus, Type, !IO) :-
write_il_simple_type_as_foreign_type_mcpp(Type, !IO).
:- pred write_il_simple_type_as_foreign_type_cs(
@@ -825,13 +825,13 @@
write_il_simple_type_as_foreign_type_cs(refany, !IO) :-
io.write_string("mercury.MR_RefAny", !IO).
write_il_simple_type_as_foreign_type_cs(class(ClassName), !IO) :-
- write_class_name(csharp, ClassName, !IO).
+ write_class_name(lang_csharp, ClassName, !IO).
write_il_simple_type_as_foreign_type_cs(valuetype(ClassName), !IO) :-
- write_class_name(csharp, ClassName, !IO).
+ write_class_name(lang_csharp, ClassName, !IO).
write_il_simple_type_as_foreign_type_cs(interface(_ClassName), !IO) :-
sorry(this_file, "interfaces").
write_il_simple_type_as_foreign_type_cs('[]'(Type, Bounds), !IO) :-
- write_il_type_as_foreign_type(csharp, Type, !IO),
+ write_il_type_as_foreign_type(lang_csharp, Type, !IO),
io.write_string("[]", !IO),
(
Bounds = []
@@ -842,9 +842,9 @@
write_il_simple_type_as_foreign_type_cs('&'(Type), !IO) :-
% XXX Is this always right?
io.write_string("ref ", !IO),
- write_il_type_as_foreign_type(csharp, Type, !IO).
+ write_il_type_as_foreign_type(lang_csharp, Type, !IO).
write_il_simple_type_as_foreign_type_cs('*'(Type), !IO) :-
- write_il_type_as_foreign_type(csharp, Type, !IO),
+ write_il_type_as_foreign_type(lang_csharp, Type, !IO),
io.write_string(" *", !IO).
:- pred write_il_simple_type_as_foreign_type_mcpp(
@@ -891,26 +891,26 @@
io.write_string("mercury::MR_Box", !IO)
;
io.write_string("public class ", !IO),
- write_class_name(managed_cplusplus, ClassName, !IO),
+ write_class_name(lang_managed_cplusplus, ClassName, !IO),
io.write_string(" *", !IO)
).
write_il_simple_type_as_foreign_type_mcpp(valuetype(ClassName), !IO) :-
io.write_string("__value class ", !IO),
- write_class_name(managed_cplusplus, ClassName, !IO).
+ write_class_name(lang_managed_cplusplus, ClassName, !IO).
% XXX this is not the right syntax
write_il_simple_type_as_foreign_type_mcpp(interface(ClassName), !IO) :-
io.write_string("interface ", !IO),
- write_class_name(managed_cplusplus, ClassName, !IO),
+ write_class_name(lang_managed_cplusplus, ClassName, !IO),
io.write_string(" *", !IO).
% XXX this needs more work
write_il_simple_type_as_foreign_type_mcpp('[]'(_Type, _Bounds), !IO) :-
io.write_string("mercury::MR_Word", !IO).
write_il_simple_type_as_foreign_type_mcpp('&'(Type), !IO) :-
io.write_string("MR_Ref(", !IO),
- write_il_type_as_foreign_type(managed_cplusplus, Type, !IO),
+ write_il_type_as_foreign_type(lang_managed_cplusplus, Type, !IO),
io.write_string(")", !IO).
write_il_simple_type_as_foreign_type_mcpp('*'(Type), !IO) :-
- write_il_type_as_foreign_type(managed_cplusplus, Type, !IO),
+ write_il_type_as_foreign_type(lang_managed_cplusplus, Type, !IO),
io.write_string(" *", !IO).
:- pred write_csharp_initializer(simple_type::in, io::di, io::uo) is det.
@@ -963,7 +963,7 @@
io.write_string("null", !IO).
write_csharp_initializer(valuetype(ClassName), !IO) :-
io.write_string("new ", !IO),
- write_class_name(csharp, ClassName, !IO),
+ write_class_name(lang_csharp, ClassName, !IO),
io.write_string("()", !IO).
:- pred write_class_name(foreign_language::in(managed_lang),
@@ -972,10 +972,10 @@
write_class_name(Lang, structured_name(_Asm, DottedName, NestedClasses),
!IO) :-
(
- Lang = csharp,
+ Lang = lang_csharp,
Sep = "."
;
- Lang = managed_cplusplus,
+ Lang = lang_managed_cplusplus,
Sep = "::"
),
io.write_list(DottedName ++ NestedClasses, Sep, io.write_string, !IO).
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.333
diff -u -b -r1.333 modes.m
--- compiler/modes.m 26 May 2006 04:03:02 -0000 1.333
+++ compiler/modes.m 26 May 2006 04:04:54 -0000
@@ -3375,7 +3375,7 @@
report_eval_method_requires_ground_args(ProcInfo, !ModuleInfo, !IO) :-
proc_info_get_eval_method(ProcInfo, EvalMethod),
proc_info_get_context(ProcInfo, Context),
- EvalMethodS = eval_method_to_one_string(EvalMethod),
+ EvalMethodS = eval_method_to_string(EvalMethod),
globals.io_lookup_bool_option(verbose_errors, VerboseErrors, !IO),
Pieces1 = [words("Sorry, not implemented:"),
fixed("`pragma " ++ EvalMethodS ++ "'"),
@@ -3400,7 +3400,7 @@
report_eval_method_destroys_uniqueness(ProcInfo, !ModuleInfo, !IO) :-
proc_info_get_eval_method(ProcInfo, EvalMethod),
proc_info_get_context(ProcInfo, Context),
- EvalMethodS = eval_method_to_one_string(EvalMethod),
+ EvalMethodS = eval_method_to_string(EvalMethod),
globals.io_lookup_bool_option(verbose_errors, VerboseErrors, !IO),
Pieces1 = [words("Error:"),
fixed("`pragma " ++ EvalMethodS ++ "'"),
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.135
diff -u -b -r1.135 module_qual.m
--- compiler/module_qual.m 5 Jun 2006 02:26:08 -0000 1.135
+++ compiler/module_qual.m 5 Jun 2006 03:20:19 -0000
@@ -1064,7 +1064,8 @@
PragmaVars0 = X ^ proc_vars,
qualify_pragma_vars(PragmaVars0, PragmaVars, !Info, !IO),
Y = X ^ proc_vars := PragmaVars.
-qualify_pragma(tabled(A, B, C, D, MModes0), tabled(A, B, C, D, MModes),
+qualify_pragma(tabled(EvalMethod, Name, Arity, PredOrFunc, MModes0, Attrs),
+ tabled(EvalMethod, Name, Arity, PredOrFunc, MModes, Attrs),
!Info, !IO) :-
(
MModes0 = yes(Modes0),
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.392
diff -u -b -r1.392 modules.m
--- compiler/modules.m 5 Jun 2006 02:26:08 -0000 1.392
+++ compiler/modules.m 5 Jun 2006 03:20:19 -0000
@@ -2116,7 +2116,7 @@
pragma_allowed_in_interface(source_file(_), yes).
% yes, but the parser will strip out `source_file' pragmas anyway...
pragma_allowed_in_interface(fact_table(_, _, _), no).
-pragma_allowed_in_interface(tabled(_, _, _, _, _), no).
+pragma_allowed_in_interface(tabled(_, _, _, _, _, _), no).
% `reserve_tag' must be in the interface iff the corresponding
% type definition is in the interface. This is checked in make_hlds.m.
pragma_allowed_in_interface(reserve_tag(_, _), yes).
@@ -2800,7 +2800,7 @@
contains_tabling_pragma([Item | Items]) :-
(
Item = pragma(_, Pragma) - _Context,
- Pragma = tabled(_, _, _, _, _)
+ Pragma = tabled(_, _, _, _, _, _)
;
contains_tabling_pragma(Items)
).
@@ -3219,7 +3219,7 @@
globals.io_get_target(CompilationTarget, !IO),
(
HighLevelCode = yes,
- CompilationTarget = c
+ CompilationTarget = target_c
->
% For --high-level-code with --target c, we need to make sure that
% we generate the header files for imported modules before
@@ -3343,7 +3343,7 @@
module_name_to_file_name(ModuleName, ".class", no, ClassFileName, !IO),
SubModules = submodules(ModuleName, AllDeps),
(
- Target = il,
+ Target = target_il,
SubModules = [_ | _]
->
io.write_strings(DepStream, [DllFileName, " : "], !IO),
@@ -3393,19 +3393,19 @@
;
ForeignImportedModules = [_ | _],
(
- Target = il,
+ Target = target_il,
ForeignImportTarget = DllFileName,
ForeignImportExt = ".dll"
;
- Target = java,
+ Target = target_java,
ForeignImportTarget = ClassFileName,
ForeignImportExt = ".java"
;
- Target = c,
+ Target = target_c,
ForeignImportTarget = ObjFileName,
ForeignImportExt = ".mh"
;
- Target = asm,
+ Target = target_asm,
ForeignImportTarget = ObjFileName,
ForeignImportExt = ".mh"
),
@@ -3418,7 +3418,7 @@
),
(
- Target = il,
+ Target = target_il,
not set.empty(LangSet)
->
Langs = set.to_sorted_list(LangSet),
@@ -3434,7 +3434,7 @@
% ILASM_KEYFLAG-<module> which is used to build the command line
% for ilasm.
(
- Target = il,
+ Target = target_il,
SignAssembly = yes
->
module_name_to_make_var_name(ModuleName, ModuleNameString),
@@ -3649,7 +3649,7 @@
io.write_strings(DepStream, [
ForeignFileName, " : ", IlFileName, "\n\n"], !IO),
- ( ForeignLang = csharp ->
+ ( ForeignLang = lang_csharp ->
% Store in the variable
% CSHARP_ASSEMBLY_REFS-foreign_code_name
% the command line argument to reference all the
@@ -4058,7 +4058,10 @@
% time, since that is simpler and probably more efficient anyway.
%
globals.io_get_target(Target, !IO),
- ( Target = java, Mode = output_all_dependencies ->
+ (
+ Target = target_java,
+ Mode = output_all_dependencies
+ ->
create_java_shell_script(ModuleName, _Succeeded, !IO)
;
true
@@ -4206,10 +4209,10 @@
),
globals.io_get_target(Target, !IO),
- ( Target = c, Lang = c
- ; Target = asm, Lang = c
- ; Target = java, Lang = java
- ; Target = il, Lang = il
+ ( Target = target_c, Lang = lang_c
+ ; Target = target_asm, Lang = lang_c
+ ; Target = target_java, Lang = lang_java
+ ; Target = target_il, Lang = lang_il
),
% Assume we need the `.mh' files for all imported modules
% (we will if they define foreign types).
@@ -4582,7 +4585,7 @@
io.write_string(DepStream, "\n", !IO),
globals.io_get_target(Target, !IO),
- ( Target = il ->
+ ( Target = target_il ->
ForeignModulesAndExts = foreign_modules(Modules, DepsMap)
;
ForeignModulesAndExts = []
@@ -4696,7 +4699,7 @@
% For --target asm, we only generate separate object files
% for top-level modules and separate sub-modules, not for
% nested sub-modules.
- Target = asm,
+ Target = target_asm,
list.filter(IsNested, Modules, NestedModules, MainModules),
NestedModules = [_ | _]
->
@@ -4895,7 +4898,7 @@
globals.io_lookup_bool_option(highlevel_code, HighLevelCode, !IO),
(
HighLevelCode = yes,
- ( ( Target = c ; Target = asm ) ->
+ ( ( Target = target_c ; Target = target_asm ) ->
% For the `--target c' MLDS back-end, we
% generate `.mih' files for every module.
% Likewise for the `--target asm' back-end.
@@ -4921,7 +4924,7 @@
io.write_string(DepStream, MakeVarName, !IO),
io.write_string(DepStream, ".mhs = ", !IO),
- ( ( Target = c ; Target = asm ) ->
+ ( ( Target = target_c ; Target = target_asm ) ->
write_compact_dependencies_list(Modules, "", ".mh",
Basis, DepStream, !IO)
;
@@ -5136,11 +5139,16 @@
MainRule ++ EndIf2 ++ EndIf
;
Gmake = no,
- ( Target = il ->
+ (
+ Target = target_il,
Rules = ILMainRule
- ; Target = java ->
+ ;
+ Target = target_java,
Rules = JavaMainRule
;
+ ( Target = target_c
+ ; Target = target_asm
+ ),
Rules = MainRule
)
),
@@ -5224,11 +5232,16 @@
LibRule ++ EndIf2 ++ EndIf
;
Gmake = no,
- ( Target = il ->
+ (
+ Target = target_il,
LibRules = ILLibRule
- ; Target = java ->
+ ;
+ Target = target_java,
LibRules = JavaLibRule
;
+ ( Target = target_c
+ ; Target = target_asm
+ ),
LibRules = LibRule
)
),
@@ -5671,7 +5684,7 @@
module_needs_header(DepsMap, Module) :-
map.lookup(DepsMap, Module, deps(_, ModuleImports)),
ModuleImports ^ foreign_code = contains_foreign_code(Langs),
- set.member(c, Langs).
+ set.member(lang_c, Langs).
% Succeed iff we need to generate a foreign language output file
% for the specified module.
@@ -5719,9 +5732,9 @@
% XXX currently we only support `C' foreign code.
%
(
- Target = asm,
+ Target = target_asm,
ModuleImports ^ foreign_code = contains_foreign_code(Langs),
- set.member(c, Langs)
+ set.member(lang_c, Langs)
->
sym_name_to_string(Module, ".", FileName),
NewLinkObjs = [(FileName ++ "__c_code") - Module | FactTableObjs]
@@ -5766,14 +5779,13 @@
% but we should handle the Java/IL backends here as well.
% (See do_get_item_foreign_code for details/5).
!:Info = !.Info ^ used_foreign_languages :=
- set.insert(!.Info ^ used_foreign_languages, c)
+ set.insert(!.Info ^ used_foreign_languages, lang_c)
; ( Item = initialise(_, _, _) ; Item = finalise(_, _, _) ) ->
% Intialise/finalise declarations introduce export pragmas, but
% again they won't have been expanded by the time we get here.
% XXX we don't currently support these on non-C backends.
- Lang = c,
!:Info = !.Info ^ used_foreign_languages :=
- set.insert(!.Info ^ used_foreign_languages, Lang),
+ set.insert(!.Info ^ used_foreign_languages, lang_c),
!:Info = !.Info ^ module_contains_foreign_export :=
contains_foreign_export
;
@@ -5819,8 +5831,7 @@
;
% is it one of the languages we support?
( list.member(NewLang, BackendLangs) ->
- Info = Info0 ^ foreign_proc_languages
- ^ elem(Name) := NewLang
+ Info = Info0 ^ foreign_proc_languages ^ elem(Name) := NewLang
;
Info = Info0
)
@@ -5834,10 +5845,10 @@
% we need to treat `pragma export' like the
% other pragmas for foreign code.
Pragma = export(_, _, _, _),
- list.member(c, BackendLangs)
+ list.member(lang_c, BackendLangs)
->
% XXX we assume lang = c for exports
- Lang = c,
+ Lang = lang_c,
Info1 = Info0 ^ used_foreign_languages :=
set.insert(Info0 ^ used_foreign_languages, Lang),
Info = Info1 ^ module_contains_foreign_export :=
@@ -5854,13 +5865,13 @@
% so we need to treat modules containing
% fact tables as if they contain foreign
% code.
- ( Target = asm
- ; Target = c
+ ( Target = target_asm
+ ; Target = target_c
),
Pragma = fact_table(_, _, _)
->
Info = Info0 ^ used_foreign_languages :=
- set.insert(Info0 ^ used_foreign_languages, c)
+ set.insert(Info0 ^ used_foreign_languages, lang_c)
;
Info = Info0
).
@@ -7353,7 +7364,7 @@
foreign_language(Lang).
% `:- pragma import' is only supported for C.
-item_needs_foreign_imports(pragma(_, import(_, _, _, _, _)), c).
+item_needs_foreign_imports(pragma(_, import(_, _, _, _, _)), lang_c).
item_needs_foreign_imports(Item @ type_defn(_, _, _, _, _), Lang) :-
Item ^ td_ctor_defn = foreign_type(ForeignType, _, _),
Lang = foreign_type_language(ForeignType).
@@ -7666,7 +7677,7 @@
; Pragma = promise_equivalent_clauses(_, _), Reorderable = yes
; Pragma = reserve_tag(_, _), Reorderable = yes
; Pragma = source_file(_), Reorderable = no
- ; Pragma = tabled(_, _, _, _, _), Reorderable = yes
+ ; Pragma = tabled(_, _, _, _, _, _), Reorderable = yes
; Pragma = terminates(_, _), Reorderable = yes
; Pragma = termination2_info(_, _, _, _, _, _), Reorderable = no
; Pragma = termination_info(_, _, _, _, _), Reorderable = yes
@@ -7747,7 +7758,7 @@
; Pragma = promise_equivalent_clauses(_, _), Reorderable = yes
; Pragma = reserve_tag(_, _), Reorderable = yes
; Pragma = source_file(_), Reorderable = no
- ; Pragma = tabled(_, _, _, _, _), Reorderable = yes
+ ; Pragma = tabled(_, _, _, _, _, _), Reorderable = yes
; Pragma = terminates(_, _), Reorderable = yes
; Pragma = termination2_info( _, _, _, _, _, _), Reorderable = no
; Pragma = termination_info(_, _, _, _, _), Reorderable = yes
Index: compiler/name_mangle.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/name_mangle.m,v
retrieving revision 1.19
diff -u -b -r1.19 name_mangle.m
--- compiler/name_mangle.m 20 Apr 2006 05:36:58 -0000 1.19
+++ compiler/name_mangle.m 5 Jun 2006 11:11:38 -0000
@@ -35,14 +35,19 @@
%-----------------------------------------------------------------------------%
- % Output a proc label.
+ % Output a proc label, with the usual mercury_label_prefix prefix.
%
:- pred output_proc_label(proc_label::in, io::di, io::uo) is det.
- % Output a proc label. The boolean controls whether
- % mercury_label_prefix is added to it.
+ % Output a proc label without the mercury_label_prefix prefix.
%
-:- pred output_proc_label(proc_label::in, bool::in, io::di, io::uo) is det.
+:- pred output_proc_label_no_prefix(proc_label::in, io::di, io::uo) is det.
+
+ % Output a proc label. The boolean controls whether mercury_label_prefix
+ % is added to it.
+ %
+:- pred output_proc_label_maybe_prefix(proc_label::in, bool::in,
+ io::di, io::uo) is det.
% Get a proc label string (used by procs which are exported to C).
% The boolean controls whether label_prefix is added to the string.
@@ -69,16 +74,17 @@
%
:- pred output_init_name(module_name::in, io::di, io::uo) is det.
- % Print out the name of the tabling variable for the specified
- % procedure.
- %
-:- pred output_tabling_pointer_var_name(proc_label::in, io::di, io::uo) is det.
-
% To ensure that Mercury labels don't clash with C symbols, we
- % prefix them with `mercury__'.
+ % prefix them with the string returned by this function.
%
:- func mercury_label_prefix = string.
+ % To ensure that the names of global variables generated by the Mercury
+ % compiler don't clash with C symbols, we prefix them with the string
+ % returned by this function.
+ %
+:- func mercury_var_prefix = string.
+
% All the C data structures we generate which are either fully static
% or static after initialization should have one of these yrefixes,
% to ensure that Mercury global variables don't clash with C symbols.
@@ -111,14 +117,19 @@
%-----------------------------------------------------------------------------%
output_proc_label(ProcLabel, !IO) :-
- output_proc_label(ProcLabel, yes, !IO).
+ output_proc_label_maybe_prefix(ProcLabel, yes, !IO).
+
+output_proc_label_no_prefix(ProcLabel, !IO) :-
+ output_proc_label_maybe_prefix(ProcLabel, no, !IO).
-output_proc_label(ProcLabel, AddPrefix, !IO) :-
+output_proc_label_maybe_prefix(ProcLabel, AddPrefix, !IO) :-
ProcLabelString = proc_label_to_c_string(ProcLabel, AddPrefix),
io.write_string(ProcLabelString, !IO).
-proc_label_to_c_string(proc(DefiningModule, PredOrFunc, PredModule,
- PredName, Arity, ModeInt), AddPrefix) = ProcLabelString :-
+proc_label_to_c_string(ProcLabel, AddPrefix) = ProcLabelString :-
+ (
+ ProcLabel = ordinary_proc_label(DefiningModule, PredOrFunc, PredModule,
+ PredName, Arity, ModeInt),
LabelName = make_pred_or_func_name(DefiningModule, PredOrFunc,
PredModule, PredName, Arity, AddPrefix),
( PredOrFunc = function ->
@@ -129,13 +140,13 @@
string.int_to_string(OrigArity, ArityString),
string.int_to_string(ModeInt, ModeNumString),
string.append_list([LabelName, "_", ArityString, "_", ModeNumString],
- ProcLabelString).
-
+ ProcLabelString)
+ ;
+ ProcLabel = special_proc_label(Module, SpecialPredId, TypeModule,
+ TypeName, TypeArity, ModeInt),
% For a special proc, output a label of the form:
% mercury____<PredName>___<TypeModule>__<TypeName>_<TypeArity>_<Mode>
- %
-proc_label_to_c_string(special_proc(Module, SpecialPredId, TypeModule,
- TypeName, TypeArity, ModeInt), AddPrefix) = ProcLabelString :-
+
% Figure out the LabelName.
DummyArity = -1, % not used by make_pred_or_func_name.
TypeCtor = type_ctor(qualified(TypeModule, TypeName), TypeArity),
@@ -164,8 +175,8 @@
% Join it all together.
string.append_list([LabelName, "_", FullyQualifiedMangledTypeName,
- "_", TypeArityString, "_", ModeNumString],
- ProcLabelString).
+ "_", TypeArityString, "_", ModeNumString], ProcLabelString)
+ ).
% Make a name identifying a predicate or a function, given the
% defining module, predicate or function indicator, declaring module,
@@ -270,14 +281,12 @@
InitName = make_init_name(ModuleName),
io.write_string(InitName, !IO).
-output_tabling_pointer_var_name(ProcLabel, !IO) :-
- io.write_string("mercury_var__table_root__", !IO),
- output_proc_label(ProcLabel, !IO).
-
%-----------------------------------------------------------------------------%
mercury_label_prefix = "mercury__".
+mercury_var_prefix = "mercury_var_".
+
mercury_data_prefix = "mercury_data_".
mercury_scalar_common_array_prefix = "mercury_common_".
mercury_vector_common_array_prefix = "mercury_vector_common_".
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.168
diff -u -b -r1.168 opt_debug.m
--- compiler/opt_debug.m 26 Apr 2006 03:05:37 -0000 1.168
+++ compiler/opt_debug.m 5 Jun 2006 12:22:25 -0000
@@ -351,8 +351,8 @@
dump_data_name(vector_common_ref(TypeNum, Offset)) =
"vector_common_ref(" ++ int_to_string(TypeNum) ++ ", "
++ int_to_string(Offset) ++ ")".
-dump_data_name(tabling_pointer(ProcLabel)) =
- "tabling_pointer(" ++ dump_proclabel(ProcLabel) ++ ")".
+dump_data_name(proc_tabling_ref(ProcLabel, Id)) =
+ tabling_info_id_str(Id) ++ "(" ++ dump_proclabel(ProcLabel) ++ ")".
dump_rtti_type_ctor(rtti_type_ctor(ModuleName, TypeName, Arity)) =
"rtti_type_ctor(" ++ sym_name_mangle(ModuleName) ++ ", "
@@ -485,12 +485,6 @@
"proc_static_call_sites(" ++ dump_rttiproclabel(RttiProcLabel) ++ ")".
dump_layout_name(table_io_decl(RttiProcLabel)) =
"table_io_decl(" ++ dump_rttiproclabel(RttiProcLabel) ++ ")".
-dump_layout_name(table_gen_info(RttiProcLabel)) =
- "table_gen_info(" ++ dump_rttiproclabel(RttiProcLabel) ++ ")".
-dump_layout_name(table_gen_enum_params(RttiProcLabel)) =
- "table_gen_enum_params(" ++ dump_rttiproclabel(RttiProcLabel) ++ ")".
-dump_layout_name(table_gen_steps(RttiProcLabel)) =
- "table_gen_steps(" ++ dump_rttiproclabel(RttiProcLabel) ++ ")".
dump_unop(mktag) = "mktag".
dump_unop(tag) = "tag".
@@ -596,8 +590,8 @@
dump_proclabel(ProcLabel) = Str :-
(
- ProcLabel = proc(Module, _PredOrFunc, PredModule, PredName,
- Arity, Mode),
+ ProcLabel = ordinary_proc_label(Module, _PredOrFunc, PredModule,
+ PredName, Arity, Mode),
( Module = PredModule ->
ExtraModule = ""
;
@@ -608,7 +602,7 @@
++ int_to_string(Arity) ++ "_" ++ int_to_string(Mode)
;
- ProcLabel = special_proc(Module, SpecialPredId, TypeModule,
+ ProcLabel = special_proc_label(Module, SpecialPredId, TypeModule,
TypeName, TypeArity, Mode),
TypeCtor = type_ctor(qualified(TypeModule, TypeName), TypeArity),
Str = sym_name_mangle(Module) ++ "_"
Index: compiler/opt_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/opt_util.m,v
retrieving revision 1.148
diff -u -b -r1.148 opt_util.m
--- compiler/opt_util.m 26 Apr 2006 03:05:38 -0000 1.148
+++ compiler/opt_util.m 17 May 2006 06:49:33 -0000
@@ -1514,9 +1514,10 @@
format_label(internal(_, ProcLabel)) = format_proc_label(ProcLabel).
format_label(entry(_, ProcLabel)) = format_proc_label(ProcLabel).
-format_proc_label(proc(_Module, _PredOrFunc, _, Name, Arity, Mode)) =
+format_proc_label(ordinary_proc_label(_Module, _PredOrFunc, _, Name,
+ Arity, Mode)) =
Name ++ "/" ++ int_to_string(Arity) ++ " mode " ++ int_to_string(Mode).
-format_proc_label(special_proc(_Module, SpecialPredId, TypeModule,
+format_proc_label(special_proc_label(_Module, SpecialPredId, TypeModule,
TypeName, TypeArity, Mode)) =
PredName ++ "_" ++ TypeName ++ "/" ++ int_to_string(TypeArity)
++ " mode " ++ int_to_string(Mode) :-
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.516
diff -u -b -r1.516 options.m
--- compiler/options.m 5 Jun 2006 02:26:09 -0000 1.516
+++ compiler/options.m 5 Jun 2006 03:20:19 -0000
@@ -197,7 +197,6 @@
; stack_trace_higher_order
; tabling_via_extra_args
- ; allow_table_reset
; generate_bytecode
; line_numbers
; auto_comments
@@ -428,6 +427,7 @@
% Code generation options
; low_level_debug
+ ; table_debug
; trad_passes
; polymorphism
; reclaim_heap_on_failure
@@ -941,7 +941,6 @@
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),
@@ -1097,6 +1096,7 @@
option_defaults_2(code_gen_option, [
% Code Generation Options
low_level_debug - bool(no),
+ table_debug - bool(no),
trad_passes - bool(yes),
polymorphism - bool(yes),
reclaim_heap_on_failure - bool_special,
@@ -1657,7 +1657,6 @@
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).
@@ -1805,6 +1804,7 @@
% code generation options
long_option("low-level-debug", low_level_debug).
+long_option("table-debug", table_debug).
long_option("polymorphism", polymorphism).
long_option("trad-passes", trad_passes).
long_option("reclaim-heap-on-failure", reclaim_heap_on_failure).
@@ -3741,13 +3741,17 @@
options_help_code_generation -->
io.write_string("\nCode generation options:\n"),
write_tabbed_lines([
- "--low-level-debug",
- "\tEnables various low-level debugging stuff, that was in",
- "\tthe distant past used to debug the low-level code generation.",
- "\tYou don't want to use this option unless you are hacking",
- "\tthe Mercury compiler itself (and probably not even then).",
- "\tCauses the generated code to become VERY big and VERY",
- "\tinefficient. Slows down compilation a LOT.",
+% "--low-level-debug",
+% "\tEnables various low-level debugging stuff, that was in",
+% "\tthe distant past used to debug the low-level code generation.",
+% "\tYou don't want to use this option unless you are hacking",
+% "\tthe Mercury compiler itself (and probably not even then).",
+% "\tCauses the generated code to become VERY big and VERY",
+% "\tinefficient. Slows down compilation a LOT.",
+
+% "--table-debug",
+% "\tEnables the generation of code that helps to debug tabling",
+% "\tprimitives.",
"--pic",
"\tGenerate position-independent code.",
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.298
diff -u -b -r1.298 polymorphism.m
--- compiler/polymorphism.m 30 Apr 2006 04:37:04 -0000 1.298
+++ compiler/polymorphism.m 6 Jun 2006 03:46:27 -0000
@@ -2230,7 +2230,7 @@
poly_info_get_varset(!.Info, VarSet0),
poly_info_get_var_types(!.Info, VarTypes0),
make_int_const_construction_alloc(SuperClassIndex, yes("SuperClassIndex"),
- IndexGoal, IndexVar, VarTypes0, VarTypes, VarSet0, VarSet),
+ IndexGoal, IndexVar, VarSet0, VarSet, VarTypes0, VarTypes),
poly_info_set_varset_and_types(VarSet, VarTypes, !Info),
% We extract the superclass typeclass_info by inserting a call
@@ -2580,7 +2580,7 @@
% we cannot use a one-cell representation for that type.
list.length(ArgTypeInfoVars, ActualArity),
make_int_const_construction_alloc(ActualArity, yes("ActualArity"),
- ArityGoal, ArityVar, !VarTypes, !VarSet),
+ ArityGoal, ArityVar, !VarSet, !VarTypes),
init_type_info_var(Type, [TypeCtorVar, ArityVar | ArgTypeInfoVars],
no, Var, TypeInfoGoal, !VarSet, !VarTypes, !RttiVarMaps),
ExtraGoals = ExtraGoals0 ++ [ArityGoal | ArgTypeInfoGoals]
@@ -2855,7 +2855,7 @@
gen_extract_type_info(TypeVar, Kind, TypeClassInfoVar, Index, ModuleInfo,
Goals, TypeInfoVar, !VarSet, !VarTypes, !RttiVarMaps) :-
make_int_const_construction_alloc(Index, yes("TypeInfoIndex"),
- IndexGoal, IndexVar, !VarTypes, !VarSet),
+ IndexGoal, IndexVar, !VarSet, !VarTypes),
Type = variable(TypeVar, Kind),
new_type_info_var_raw(Type, type_info, TypeInfoVar,
!VarSet, !VarTypes, !RttiVarMaps),
Index: compiler/pragma_c_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pragma_c_gen.m,v
retrieving revision 1.92
diff -u -b -r1.92 pragma_c_gen.m
--- compiler/pragma_c_gen.m 26 Apr 2006 03:05:39 -0000 1.92
+++ compiler/pragma_c_gen.m 30 May 2006 04:43:05 -0000
@@ -1206,7 +1206,7 @@
MaybeName = yes(Name),
(
BoxPolicy = native_if_possible,
- OrigTypeString = foreign.to_type_string(c, Module, OrigType)
+ OrigTypeString = foreign.to_type_string(lang_c, Module, OrigType)
;
BoxPolicy = always_boxed,
OrigTypeString = "MR_Word"
@@ -1284,7 +1284,7 @@
->
(
MaybeC = yes(Data),
- Data = foreign_type_lang_data(c(Name), _, Assertions),
+ Data = foreign_type_lang_data(c_type(Name), _, Assertions),
MaybeForeignTypeInfo = yes(pragma_c_foreign_type(Name, Assertions))
;
MaybeC = no,
Index: compiler/proc_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/proc_gen.m,v
retrieving revision 1.1
diff -u -b -r1.1 proc_gen.m
--- compiler/proc_gen.m 3 May 2006 07:45:19 -0000 1.1
+++ compiler/proc_gen.m 30 May 2006 06:53:36 -0000
@@ -5,10 +5,10 @@
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
-
+%
% File: code_gen.m.
% Main authors: conway, zs.
-
+%
% Code generation - convert from HLDS to LLDS.
%
% The two main tasks of this module are
@@ -26,7 +26,7 @@
% for switches by switch_gen and its subsidiary modules, for disjunctions
% by disj_gen, and for pragma_c_codes by pragma_c_gen. The only kind of goal
% handled directly by code_gen is the conjunction.
-
+%
%---------------------------------------------------------------------------%
:- module ll_backend.proc_gen.
@@ -91,6 +91,7 @@
:- import_module ll_backend.llds_out.
:- import_module ll_backend.middle_rec.
:- import_module ll_backend.pragma_c_gen.
+:- import_module ll_backend.stack_layout.
:- import_module ll_backend.trace.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.program_representation.
@@ -367,7 +368,7 @@
code_info.get_closure_layouts(CodeInfo, ClosureLayouts),
global_data_add_new_closure_layouts(ClosureLayouts, !GlobalData),
ProcLabel = make_proc_label(ModuleInfo, PredId, ProcId),
- maybe_add_tabling_pointer_var(ModuleInfo, PredId, ProcId, ProcInfo,
+ maybe_add_tabling_info_struct(ModuleInfo, PredId, ProcId, ProcInfo,
ProcLabel, !GlobalData),
Name = pred_info_name(PredInfo),
@@ -471,23 +472,65 @@
OldOutermostSlotNum),
DeepProfInfo = proc_layout_proc_static(HLDSProcStatic, DeepExcpSlots).
-:- pred maybe_add_tabling_pointer_var(module_info::in,
+:- pred maybe_add_tabling_info_struct(module_info::in,
pred_id::in, proc_id::in, proc_info::in, proc_label::in,
global_data::in, global_data::out) is det.
-maybe_add_tabling_pointer_var(ModuleInfo, PredId, ProcId, ProcInfo, ProcLabel,
+maybe_add_tabling_info_struct(ModuleInfo, PredId, ProcId, ProcInfo, ProcLabel,
!GlobalData) :-
proc_info_get_eval_method(ProcInfo, EvalMethod),
HasTablingPointer = eval_method_has_per_proc_tabling_pointer(EvalMethod),
(
HasTablingPointer = yes,
- module_info_get_name(ModuleInfo, ModuleName),
- Var = tabling_pointer_var(ModuleName, ProcLabel),
- global_data_add_new_proc_var(proc(PredId, ProcId), Var, !GlobalData)
+ add_tabling_info_struct(ModuleInfo, PredId, ProcId, ProcInfo,
+ ProcLabel, EvalMethod, !GlobalData)
;
HasTablingPointer = no
).
+:- pred add_tabling_info_struct(module_info::in, pred_id::in, proc_id::in,
+ proc_info::in, proc_label::in, eval_method::in,
+ global_data::in, global_data::out) is det.
+
+add_tabling_info_struct(ModuleInfo, PredId, ProcId, ProcInfo, ProcLabel,
+ EvalMethod, !GlobalData) :-
+ proc_info_get_maybe_proc_table_info(ProcInfo, MaybeTableInfo),
+ (
+ MaybeTableInfo = yes(TableInfo),
+ (
+ TableInfo = table_gen_info(NumInputs, NumOutputs,
+ InputSteps, MaybeOutputSteps, ArgInfos)
+ ;
+ TableInfo = table_io_decl_info(_),
+ unexpected(this_file, "add_tabling_info_struct: bad TableInfo")
+ )
+ ;
+ MaybeTableInfo = no,
+ unexpected(this_file, "add_tabling_info_struct: no TableInfo")
+ ),
+ global_data_get_static_cell_info(!.GlobalData, StaticCellInfo0),
+ convert_table_arg_info(ArgInfos, NumPTIs, PTIVectorRval,
+ TVarVectorRval, StaticCellInfo0, StaticCellInfo),
+ global_data_set_static_cell_info(StaticCellInfo, !GlobalData),
+ NumArgs = NumInputs + NumOutputs,
+ expect(unify(NumArgs, NumPTIs), this_file,
+ "add_tabling_info_struct: args mismatch"),
+
+ module_info_get_name(ModuleInfo, ModuleName),
+ proc_info_get_table_attributes(ProcInfo, MaybeAttributes),
+ (
+ MaybeAttributes = yes(Attributes)
+ ;
+ MaybeAttributes = no,
+ Attributes = default_memo_table_attributes
+ ),
+ MaybeSizeLimit = Attributes ^ table_attr_size_limit,
+ Statistics = Attributes ^ table_attr_statistics,
+ Var = tabling_info_struct(ModuleName, ProcLabel, EvalMethod,
+ NumInputs, NumOutputs, InputSteps, MaybeOutputSteps, PTIVectorRval,
+ TVarVectorRval, MaybeSizeLimit, Statistics),
+ global_data_add_new_proc_var(proc(PredId, ProcId), Var, !GlobalData).
+
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
Index: compiler/proc_label.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/proc_label.m,v
retrieving revision 1.19
diff -u -b -r1.19 proc_label.m
--- compiler/proc_label.m 20 Apr 2006 05:37:00 -0000 1.19
+++ compiler/proc_label.m 17 May 2006 06:47:31 -0000
@@ -96,7 +96,7 @@
DefiningModule = TypeModule
),
proc_id_to_int(ProcId, ProcIdInt),
- ProcLabel = special_proc(DefiningModule, SpecialPred,
+ ProcLabel = special_proc_label(DefiningModule, SpecialPred,
TypeModule, TypeName, TypeArity, ProcIdInt)
;
string.append_list(["make_proc_label:\n",
@@ -126,7 +126,7 @@
DefiningModule = PredModule
),
proc_id_to_int(ProcId, ProcIdInt),
- ProcLabel = proc(DefiningModule, PredOrFunc,
+ ProcLabel = ordinary_proc_label(DefiningModule, PredOrFunc,
PredModule, PredName, PredArity, ProcIdInt).
make_uni_label(ModuleInfo, TypeCtor, UniModeNum) = ProcLabel :-
@@ -138,7 +138,7 @@
Module = ModuleName
),
proc_id_to_int(UniModeNum, UniModeNumInt),
- ProcLabel = special_proc(Module, spec_pred_unify, TypeModule,
+ ProcLabel = special_proc_label(Module, spec_pred_unify, TypeModule,
TypeName, Arity, UniModeNumInt)
;
unexpected(this_file, "make_uni_label: unqualified type_ctor")
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.165
diff -u -b -r1.165 prog_data.m
--- compiler/prog_data.m 5 Jun 2006 02:26:09 -0000 1.165
+++ compiler/prog_data.m 5 Jun 2006 08:54:18 -0000
@@ -178,7 +178,7 @@
; java(java_foreign_type).
:- type il_foreign_type
- ---> il(
+ ---> il_type(
ref_or_val, % An indicator of whether the type is a
% reference of value type.
string, % The location of the .NET name (the assembly)
@@ -186,12 +186,12 @@
).
:- type c_foreign_type
- ---> c(
+ ---> c_type(
string % The C type name
).
:- type java_foreign_type
- ---> java(
+ ---> java_type(
string % The Java type name
).
@@ -213,8 +213,7 @@
:- type eval_method
---> eval_normal % normal mercury evaluation
; eval_loop_check % loop check only
- ; eval_memo(call_table_strictness)
- % memoing + loop check
+ ; eval_memo % memoing + loop check
; eval_table_io( % memoing I/O actions for debugging
table_io_is_decl,
table_io_is_unitize
@@ -222,6 +221,16 @@
; eval_minimal(eval_minimal_method).
% minimal model evaluation
+:- type table_attributes
+ ---> table_attributes(
+ table_attr_strictness :: call_table_strictness,
+ table_attr_size_limit :: maybe(int),
+ table_attr_statistics :: bool,
+ table_attr_allow_reset :: bool
+ ).
+
+:- func default_memo_table_attributes = table_attributes.
+
:- type call_table_strictness
---> all_strict
; all_fast_loose
@@ -373,23 +382,21 @@
:- type reuse_tuple
---> unconditional
; conditional(
+ % The set of datastructures pointing to the memory that becomes
+ % 'dead' and thus will be reused. This set is restricted to
+ % the head variables of the involved procedure.
reuse_nodes :: dead_datastructs,
- % The set of datastructures pointing to the memory that
- % becomes 'dead' and thus will be reused. This set is
- % restricted to the head variables of the involved
- % procedure.
- live_headvars :: live_datastructs,
% The set of datastructures inherently live at the moment
- % where the reuse_nodes become dead. This set is
- % restricted to the head variables of the procedure the
- % reuse condition refers to.
+ % where the reuse_nodes become dead. This set is restricted
+ % to the head variables of the procedure the reuse condition
+ % refers to.
+ live_headvars :: live_datastructs,
+ % Description of the structure sharing existing at the moment
+ % where the reuse_nodes become dead. The sharing is also
+ % restricted to the headvariables of the concerned procedure.
sharing_headvars :: structure_sharing_domain
- % Description of the structure sharing existing at the
- % moment where the reuse_nodes become dead. The sharing is
- % also restricted to the headvariables of the concerned
- % procedure.
).
:- type reuse_tuples == list(reuse_tuple).
@@ -907,10 +914,10 @@
; type_info_cell_constructor(type_ctor)
; typeclass_info_cell_constructor
- ; tabling_pointer_const(shrouded_pred_proc_id)
- % The address of the static variable that points to the table
- % that implements memoization, loop checking or the minimal
- % model semantics for the given procedure.
+ ; tabling_info_const(shrouded_pred_proc_id)
+ % The address of the static structure that holds information
+ % about the table that implements memoization, loop checking
+ % or the minimal model semantics for the given procedure.
; deep_profiling_proc_layout(shrouded_pred_proc_id)
% The Proc_Layout structure of a procedure. Its proc_static field
@@ -1436,6 +1443,8 @@
:- import_module string.
+default_memo_table_attributes = table_attributes(all_strict, no, no, no).
+
%-----------------------------------------------------------------------------%
%
% Some more stuff for the foreign language interface
Index: compiler/prog_foreign.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_foreign.m,v
retrieving revision 1.6
diff -u -b -r1.6 prog_foreign.m
--- compiler/prog_foreign.m 17 Mar 2006 01:40:36 -0000 1.6
+++ compiler/prog_foreign.m 30 May 2006 05:27:06 -0000
@@ -120,9 +120,9 @@
% we generate external files for foreign code.
%
:- inst lang_gen_ext_file
- ---> c
- ; managed_cplusplus
- ; csharp.
+ ---> lang_c
+ ; lang_managed_cplusplus
+ ; lang_csharp.
% The module name used for this foreign language.
% Not all foreign languages generate external modules
@@ -200,20 +200,20 @@
foreign_import_module_name(ImportModule) = ModuleName :-
ImportModule = foreign_import_module(Lang, ForeignImportModule, _),
(
- Lang = c,
+ Lang = lang_c,
ModuleName = ForeignImportModule
;
- Lang = il,
+ Lang = lang_il,
ModuleName = ForeignImportModule
;
- Lang = java,
+ Lang = lang_java,
ModuleName = ForeignImportModule
;
- Lang = managed_cplusplus,
+ Lang = lang_managed_cplusplus,
ModuleName = foreign_language_module_name(ForeignImportModule,
Lang)
;
- Lang = csharp,
+ Lang = lang_csharp,
ModuleName = foreign_language_module_name(ForeignImportModule, Lang)
).
@@ -223,22 +223,22 @@
ImportedForeignCodeModuleName1 = ModuleForeignImported ^
foreign_import_module_name,
(
- Lang = c,
+ Lang = lang_c,
ImportedForeignCodeModuleName = ImportedForeignCodeModuleName1
;
- Lang = il,
+ Lang = lang_il,
ImportedForeignCodeModuleName = handle_std_library(
CurrentModule, ImportedForeignCodeModuleName1)
;
- Lang = managed_cplusplus,
+ Lang = lang_managed_cplusplus,
ImportedForeignCodeModuleName = handle_std_library(
CurrentModule, ImportedForeignCodeModuleName1)
;
- Lang = csharp,
+ Lang = lang_csharp,
ImportedForeignCodeModuleName = handle_std_library(
CurrentModule, ImportedForeignCodeModuleName1)
;
- Lang = java,
+ Lang = lang_java,
ImportedForeignCodeModuleName = handle_std_library(
CurrentModule, ImportedForeignCodeModuleName1)
).
@@ -276,11 +276,11 @@
%-----------------------------------------------------------------------------%
-foreign_language_file_extension(c) = ".c".
-foreign_language_file_extension(managed_cplusplus) = ".cpp".
-foreign_language_file_extension(csharp) = ".cs".
-foreign_language_file_extension(java) = ".java".
-foreign_language_file_extension(il) = _ :-
+foreign_language_file_extension(lang_c) = ".c".
+foreign_language_file_extension(lang_managed_cplusplus) = ".cpp".
+foreign_language_file_extension(lang_csharp) = ".cs".
+foreign_language_file_extension(lang_java) = ".java".
+foreign_language_file_extension(lang_il) = _ :-
fail.
%-----------------------------------------------------------------------------%
@@ -289,26 +289,26 @@
% interfaces, but if we added appropriate options we might want
% to do this later.
%
-prefer_foreign_language(_Globals, c, Lang1, Lang2) =
+prefer_foreign_language(_Globals, target_c, Lang1, Lang2) =
% When compiling to C, C is always preferred over any other language.
- ( Lang2 = c, not Lang1 = c ->
+ ( Lang2 = lang_c, not Lang1 = lang_c ->
yes
;
no
).
-prefer_foreign_language(_Globals, asm, Lang1, Lang2) =
+prefer_foreign_language(_Globals, target_asm, Lang1, Lang2) =
% When compiling to asm, C is always preferred over any other language.
- ( Lang2 = c, not Lang1 = c ->
+ ( Lang2 = lang_c, not Lang1 = lang_c ->
yes
;
no
).
-prefer_foreign_language(_Globals, il, Lang1, Lang2) = Comp :-
+prefer_foreign_language(_Globals, target_il, Lang1, Lang2) = Comp :-
% Whe compiling to il, first we prefer il, then csharp, then
% managed_cplusplus, after that we don't care.
- PreferredList = [il, csharp, managed_cplusplus],
+ PreferredList = [lang_il, lang_csharp, lang_managed_cplusplus],
FindLangPriority = (func(L) = X :-
( list.nth_member_search(PreferredList, L, X0) ->
@@ -324,23 +324,23 @@
Comp = no
).
-prefer_foreign_language(_Globals, java, _Lang1, _Lang2) = no.
+prefer_foreign_language(_Globals, target_java, _Lang1, _Lang2) = no.
% Nothing useful to do here, but when we add Java as a foreign language,
% we should add it here.
%-----------------------------------------------------------------------------%
-foreign_language(c).
-foreign_language(java).
-foreign_language(csharp).
-foreign_language(managed_cplusplus).
-foreign_language(il).
+foreign_language(lang_c).
+foreign_language(lang_java).
+foreign_language(lang_csharp).
+foreign_language(lang_managed_cplusplus).
+foreign_language(lang_il).
%-----------------------------------------------------------------------------%
-foreign_type_language(il(_)) = il.
-foreign_type_language(c(_)) = c.
-foreign_type_language(java(_)) = java.
+foreign_type_language(il(_)) = lang_il.
+foreign_type_language(c(_)) = lang_c.
+foreign_type_language(java(_)) = lang_java.
%-----------------------------------------------------------------------------%
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.103
diff -u -b -r1.103 prog_io_pragma.m
--- compiler/prog_io_pragma.m 5 Jun 2006 02:26:10 -0000 1.103
+++ compiler/prog_io_pragma.m 6 Jun 2006 13:02:46 -0000
@@ -47,8 +47,10 @@
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_io.
:- import_module parse_tree.prog_io_goal.
+:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_util.
+:- import_module assoc_list.
:- import_module bool.
:- import_module int.
:- import_module map.
@@ -243,7 +245,7 @@
PragmaTerms = [ImportTerm],
sym_name_and_args(ImportTerm, Import, [])
->
- Result = ok(pragma(user, foreign_import_module(c, Import)))
+ Result = ok(pragma(user, foreign_import_module(lang_c, Import)))
;
Result = error("wrong number of arguments or invalid " ++
"module name in `:- pragma c_import_module' " ++
@@ -294,25 +296,31 @@
maybe1(foreign_language_type)::out) is det.
parse_foreign_language_type(InputTerm, Language, Result) :-
- ( Language = il ->
+ (
+ Language = lang_il,
( InputTerm = term.functor(term.string(ILTypeName), [], _) ->
parse_il_type_name(ILTypeName, InputTerm, Result)
;
Result = error("invalid backend specification term", InputTerm)
)
- ; Language = c ->
+ ;
+ Language = lang_c,
( InputTerm = term.functor(term.string(CTypeName), [], _) ->
- Result = ok(c(c(CTypeName)))
+ Result = ok(c(c_type(CTypeName)))
;
Result = error("invalid backend specification term", InputTerm)
)
- ; Language = java ->
+ ;
+ Language = lang_java,
( InputTerm = term.functor(term.string(JavaTypeName), [], _) ->
- Result = ok(java(java(JavaTypeName)))
+ Result = ok(java(java_type(JavaTypeName)))
;
Result = error("invalid backend specification term", InputTerm)
)
;
+ ( Language = lang_managed_cplusplus
+ ; Language = lang_csharp
+ ),
Result = error("unsupported language specified, " ++
"unable to parse backend type", InputTerm)
).
@@ -332,7 +340,7 @@
string.left(String1, Index, AssemblyName),
string.split(String1, Index + 1, _, TypeNameStr),
string_to_sym_name(TypeNameStr, ".", TypeSymName),
- ForeignType = ok(il(il(reference, AssemblyName, TypeSymName)))
+ ForeignType = ok(il(il_type(reference, AssemblyName, TypeSymName)))
;
string.append("valuetype [", String1, String0),
string.sub_string_search(String1, "]", Index)
@@ -340,7 +348,7 @@
string.left(String1, Index, AssemblyName),
string.split(String1, Index + 1, _, TypeNameStr),
string_to_sym_name(TypeNameStr, ".", TypeSymName),
- ForeignType = ok(il(il(value, AssemblyName, TypeSymName)))
+ ForeignType = ok(il(il_type(value, AssemblyName, TypeSymName)))
;
ForeignType = error("invalid foreign language type description",
ErrorTerm)
@@ -353,45 +361,45 @@
:- pred parse_special_il_type_name(string::in, il_foreign_type::out)
is semidet.
-parse_special_il_type_name("bool", il(value, "mscorlib",
+parse_special_il_type_name("bool", il_type(value, "mscorlib",
qualified(unqualified("System"), "Boolean"))).
-parse_special_il_type_name("char", il(value, "mscorlib",
+parse_special_il_type_name("char", il_type(value, "mscorlib",
qualified(unqualified("System"), "Char"))).
-parse_special_il_type_name("object", il(reference, "mscorlib",
+parse_special_il_type_name("object", il_type(reference, "mscorlib",
qualified(unqualified("System"), "Object"))).
-parse_special_il_type_name("string", il(reference, "mscorlib",
+parse_special_il_type_name("string", il_type(reference, "mscorlib",
qualified(unqualified("System"), "String"))).
-parse_special_il_type_name("float32", il(value, "mscorlib",
+parse_special_il_type_name("float32", il_type(value, "mscorlib",
qualified(unqualified("System"), "Single"))).
-parse_special_il_type_name("float64", il(value, "mscorlib",
+parse_special_il_type_name("float64", il_type(value, "mscorlib",
qualified(unqualified("System"), "Double"))).
-parse_special_il_type_name("int8", il(value, "mscorlib",
+parse_special_il_type_name("int8", il_type(value, "mscorlib",
qualified(unqualified("System"), "SByte"))).
-parse_special_il_type_name("int16", il(value, "mscorlib",
+parse_special_il_type_name("int16", il_type(value, "mscorlib",
qualified(unqualified("System"), "Int16"))).
-parse_special_il_type_name("int32", il(value, "mscorlib",
+parse_special_il_type_name("int32", il_type(value, "mscorlib",
qualified(unqualified("System"), "Int32"))).
-parse_special_il_type_name("int64", il(value, "mscorlib",
+parse_special_il_type_name("int64", il_type(value, "mscorlib",
qualified(unqualified("System"), "Int64"))).
-parse_special_il_type_name("natural int", il(value, "mscorlib",
+parse_special_il_type_name("natural int", il_type(value, "mscorlib",
qualified(unqualified("System"), "IntPtr"))).
-parse_special_il_type_name("native int", il(value, "mscorlib",
+parse_special_il_type_name("native int", il_type(value, "mscorlib",
qualified(unqualified("System"), "IntPtr"))).
-parse_special_il_type_name("natural unsigned int", il(value, "mscorlib",
+parse_special_il_type_name("natural unsigned int", il_type(value, "mscorlib",
qualified(unqualified("System"), "UIntPtr"))).
-parse_special_il_type_name("native unsigned int", il(value, "mscorlib",
+parse_special_il_type_name("native unsigned int", il_type(value, "mscorlib",
qualified(unqualified("System"), "UIntPtr"))).
-parse_special_il_type_name("refany", il(value, "mscorlib",
+parse_special_il_type_name("refany", il_type(value, "mscorlib",
qualified(unqualified("System"), "TypedReference"))).
-parse_special_il_type_name("typedref", il(value, "mscorlib",
+parse_special_il_type_name("typedref", il_type(value, "mscorlib",
qualified(unqualified("System"), "TypedReference"))).
-parse_special_il_type_name("unsigned int8", il(value, "mscorlib",
+parse_special_il_type_name("unsigned int8", il_type(value, "mscorlib",
qualified(unqualified("System"), "Byte"))).
-parse_special_il_type_name("unsigned int16", il(value, "mscorlib",
+parse_special_il_type_name("unsigned int16", il_type(value, "mscorlib",
qualified(unqualified("System"), "UInt16"))).
-parse_special_il_type_name("unsigned int32", il(value, "mscorlib",
+parse_special_il_type_name("unsigned int32", il_type(value, "mscorlib",
qualified(unqualified("System"), "UInt32"))).
-parse_special_il_type_name("unsigned int64", il(value, "mscorlib",
+parse_special_il_type_name("unsigned int64", il_type(value, "mscorlib",
qualified(unqualified("System"), "UInt64"))).
:- pred parse_maybe_foreign_type_assertions(maybe(term)::in,
@@ -708,7 +716,7 @@
parse_pragma_type(ModuleName, "import", PragmaTerms, ErrorTerm, _VarSet,
Result) :-
% XXX we assume all imports are C
- ForeignLanguage = c,
+ ForeignLanguage = lang_c,
(
(
PragmaTerms = [PredAndModesTerm, FlagsTerm, FunctionTerm],
@@ -800,14 +808,8 @@
parse_pragma_type(ModuleName, "memo", PragmaTerms, ErrorTerm, _VarSet,
Result) :-
- % The eval_memo(all_strict) could be converted to eval_memo(specified(_))
- % if the pragma specifies the ways to table the arguments.
- parse_tabling_pragma(ModuleName, "memo",
- eval_memo(all_strict), PragmaTerms, ErrorTerm, Result).
-parse_pragma_type(ModuleName, "fast_loose_memo", PragmaTerms, ErrorTerm,
- _VarSet, Result) :-
- parse_tabling_pragma(ModuleName, "fast_loose_memo",
- eval_memo(all_fast_loose), PragmaTerms, ErrorTerm, Result).
+ parse_tabling_pragma(ModuleName, "memo", eval_memo,
+ PragmaTerms, ErrorTerm, Result).
parse_pragma_type(ModuleName, "loop_check", PragmaTerms, ErrorTerm, _VarSet,
Result) :-
parse_tabling_pragma(ModuleName, "loop_check", eval_loop_check,
@@ -818,8 +820,8 @@
% own_stacks technique for computing minimal models. The decision
% depends on the grade, and is made in make_hlds.m; the stack_copy here
% is just a placeholder.
- parse_tabling_pragma(ModuleName, "minimal_model",
- eval_minimal(stack_copy), PragmaTerms, ErrorTerm, Result).
+ parse_tabling_pragma(ModuleName, "minimal_model", eval_minimal(stack_copy),
+ PragmaTerms, ErrorTerm, Result).
parse_pragma_type(ModuleName, "obsolete", PragmaTerms, ErrorTerm, _VarSet,
Result) :-
@@ -1450,10 +1452,10 @@
pragma_foreign_proc_attributes, term)
= maybe1(pragma_foreign_proc_attributes).
-check_required_attributes(c, Attrs, _Term) = ok(Attrs).
-check_required_attributes(managed_cplusplus, Attrs, _Term) = ok(Attrs).
-check_required_attributes(csharp, Attrs, _Term) = ok(Attrs).
-check_required_attributes(il, Attrs, Term) = Res :-
+check_required_attributes(lang_c, Attrs, _Term) = ok(Attrs).
+check_required_attributes(lang_managed_cplusplus, Attrs, _Term) = ok(Attrs).
+check_required_attributes(lang_csharp, Attrs, _Term) = ok(Attrs).
+check_required_attributes(lang_il, Attrs, Term) = Res :-
MaxStackAttrs = list.filter_map(
(func(X) = X is semidet :- X = max_stack_size(_)),
Attrs ^ extra_attributes),
@@ -1464,7 +1466,7 @@
MaxStackAttrs = [_ | _],
Res = ok(Attrs)
).
-check_required_attributes(java, Attrs, _Term) = ok(Attrs).
+check_required_attributes(lang_java, Attrs, _Term) = ok(Attrs).
:- pred parse_pragma_foreign_proc_attributes_term0(term::in,
list(collected_pragma_foreign_proc_attribute)::out) is semidet.
@@ -1710,38 +1712,45 @@
(
(
PragmaTerms = [PredAndModesTerm0],
- MaybeSpec = no
+ MaybeAttrs = no
;
- PragmaTerms = [PredAndModesTerm0, SpecListTerm0],
- TablingType = eval_memo(all_strict),
- MaybeSpec = yes(SpecListTerm0)
+ PragmaTerms = [PredAndModesTerm0, AttrListTerm0],
+ MaybeAttrs = yes(AttrListTerm0)
)
->
- string.append_list(["`:- pragma ", PragmaName, "' declaration"],
- ParseMsg),
+ ParseMsg = "`:- pragma " ++ PragmaName ++ "' declaration",
parse_arity_or_modes(ModuleName, PredAndModesTerm0, ErrorTerm,
ParseMsg, ArityModesResult),
(
ArityModesResult = ok(arity_or_modes(PredName, Arity,
MaybePredOrFunc, MaybeModes)),
(
- MaybeSpec = yes(SpecListTerm),
- convert_list(SpecListTerm, parse_arg_tabling_method,
- "expected argument tabling method", MaybeArgMethods),
- (
- MaybeArgMethods = ok(ArgMethods),
- Result = ok(pragma(user,
- tabled(eval_memo(specified(ArgMethods)),
- PredName, Arity, MaybePredOrFunc, MaybeModes)))
+ MaybeAttrs = no,
+ PragmaType = tabled(TablingType, PredName, Arity,
+ MaybePredOrFunc, MaybeModes, no),
+ Result = ok(pragma(user, PragmaType))
+ ;
+ MaybeAttrs = yes(AttrsListTerm),
+ convert_maybe_list(AttrsListTerm,
+ parse_tabling_attribute(TablingType),
+ "expected tabling attribute", MaybeAttributeList),
+ (
+ MaybeAttributeList = ok(AttributeList),
+ update_tabling_attributes(AttributeList,
+ default_memo_table_attributes, MaybeAttributes),
+ (
+ MaybeAttributes = ok(Attributes),
+ PragmaType = tabled(eval_memo, PredName, Arity,
+ MaybePredOrFunc, MaybeModes, yes(Attributes)),
+ Result = ok(pragma(user, PragmaType))
;
- MaybeArgMethods = error(Msg, Term),
+ MaybeAttributes = error(Msg, Term),
Result = error(Msg, Term)
)
;
- MaybeSpec = no,
- Result = ok(pragma(user,
- tabled(TablingType, PredName, Arity,
- MaybePredOrFunc, MaybeModes)))
+ MaybeAttributeList = error(Msg, Term),
+ Result = error(Msg, Term)
+ )
)
;
ArityModesResult = error(Msg, Term),
@@ -1753,6 +1762,141 @@
Result = error(ErrorMessage, ErrorTerm)
).
+:- type single_tabling_attribute
+ ---> attr_strictness(call_table_strictness)
+ ; attr_size_limit(int)
+ ; attr_statistics
+ ; attr_allow_reset.
+
+:- pred update_tabling_attributes(
+ assoc_list(term, single_tabling_attribute)::in,
+ table_attributes::in, maybe1(table_attributes)::out) is det.
+
+update_tabling_attributes([], Attributes, ok(Attributes)).
+update_tabling_attributes([Term - SingleAttr | TermSingleAttrs], !.Attributes,
+ MaybeAttributes) :-
+ (
+ SingleAttr = attr_strictness(Strictness),
+ ( !.Attributes ^ table_attr_strictness = all_strict ->
+ !:Attributes = !.Attributes ^ table_attr_strictness := Strictness,
+ update_tabling_attributes(TermSingleAttrs, !.Attributes,
+ MaybeAttributes)
+ ;
+ Msg = "duplicate argument tabling methods attribute"
+ ++ "in `:- pragma memo' declaration",
+ MaybeAttributes = error(Msg, Term)
+ )
+ ;
+ SingleAttr = attr_size_limit(Limit),
+ ( !.Attributes ^ table_attr_size_limit = no ->
+ !:Attributes = !.Attributes ^ table_attr_size_limit := yes(Limit),
+ update_tabling_attributes(TermSingleAttrs, !.Attributes,
+ MaybeAttributes)
+ ;
+ Msg = "duplicate size limits attribute"
+ ++ "in `:- pragma memo' declaration",
+ MaybeAttributes = error(Msg, Term)
+ )
+ ;
+ SingleAttr = attr_statistics,
+ ( !.Attributes ^ table_attr_statistics = no ->
+ !:Attributes = !.Attributes ^ table_attr_statistics := yes,
+ update_tabling_attributes(TermSingleAttrs, !.Attributes,
+ MaybeAttributes)
+ ;
+ Msg = "duplicate statistics attribute"
+ ++ "in `:- pragma memo' declaration",
+ MaybeAttributes = error(Msg, Term)
+ )
+ ;
+ SingleAttr = attr_allow_reset,
+ ( !.Attributes ^ table_attr_allow_reset = no ->
+ !:Attributes = !.Attributes ^ table_attr_allow_reset := yes,
+ update_tabling_attributes(TermSingleAttrs, !.Attributes,
+ MaybeAttributes)
+ ;
+ Msg = "duplicate allow_reset attribute"
+ ++ "in `:- pragma memo' declaration",
+ MaybeAttributes = error(Msg, Term)
+ )
+ ).
+
+:- pred parse_tabling_attribute(eval_method::in, term::in,
+ maybe1(pair(term, single_tabling_attribute))::out) is semidet.
+
+parse_tabling_attribute(EvalMethod, Term, MaybeTermAttribute) :-
+ Term = term.functor(term.atom(Functor), Args, _),
+ (
+ Functor = "fast_loose",
+ Args = [],
+ ( eval_method_allows_fast_loose(EvalMethod) = yes ->
+ Attribute = attr_strictness(all_fast_loose),
+ MaybeTermAttribute = ok(Term - Attribute)
+ ;
+ Msg = "evaluation method " ++ eval_method_to_string(EvalMethod) ++
+ " doesn't allow fast_loose tabling",
+ MaybeTermAttribute = error(Msg, Term)
+ )
+ ;
+ Functor = "specified",
+ Args = [Arg],
+ convert_list(Arg, parse_arg_tabling_method,
+ "expected argument tabling method", MaybeMaybeArgMethods),
+ (
+ MaybeMaybeArgMethods = ok(MaybeArgMethods),
+ ( eval_method_allows_fast_loose(EvalMethod) = yes ->
+ Attribute = attr_strictness(specified(MaybeArgMethods)),
+ MaybeTermAttribute = ok(Term - Attribute)
+ ;
+ Msg = "evaluation method " ++
+ eval_method_to_string(EvalMethod) ++
+ " doesn't allow specified tabling methods",
+ MaybeTermAttribute = error(Msg, Term)
+ )
+ ;
+ MaybeMaybeArgMethods = error(Msg, ErrorTerm),
+ MaybeTermAttribute = error(Msg, ErrorTerm)
+ )
+ ;
+ Functor = "size_limit",
+ Args = [Arg],
+ Arg = term.functor(term.integer(Limit), [], _),
+ ( eval_method_allows_size_limit(EvalMethod) = yes ->
+ Attribute = attr_size_limit(Limit),
+ MaybeTermAttribute = ok(Term - Attribute)
+ ;
+ Msg = "evaluation method " ++ eval_method_to_string(EvalMethod) ++
+ " doesn't allow size limits",
+ MaybeTermAttribute = error(Msg, Term)
+ )
+ ;
+ Functor = "statistics",
+ Args = [],
+ Attribute = attr_statistics,
+ MaybeTermAttribute = ok(Term - Attribute)
+ ;
+ Functor = "allow_reset",
+ Args = [],
+ Attribute = attr_allow_reset,
+ MaybeTermAttribute = ok(Term - Attribute)
+ ).
+
+:- func eval_method_allows_fast_loose(eval_method) = bool.
+
+eval_method_allows_fast_loose(eval_normal) = no.
+eval_method_allows_fast_loose(eval_loop_check) = yes.
+eval_method_allows_fast_loose(eval_memo) = yes.
+eval_method_allows_fast_loose(eval_table_io(_, _)) = no.
+eval_method_allows_fast_loose(eval_minimal(_)) = no.
+
+:- func eval_method_allows_size_limit(eval_method) = bool.
+
+eval_method_allows_size_limit(eval_normal) = no.
+eval_method_allows_size_limit(eval_loop_check) = yes.
+eval_method_allows_size_limit(eval_memo) = yes.
+eval_method_allows_size_limit(eval_table_io(_, _)) = no.
+eval_method_allows_size_limit(eval_minimal(_)) = no.
+
:- pred parse_arg_tabling_method(term::in, maybe(arg_tabling_method)::out)
is semidet.
@@ -1914,6 +2058,52 @@
Result = error("error in list", term.functor(Functor, Args, Context))
).
+ % convert_list(T, P, M) will convert a term T into a list of
+ % type X where P is a predicate that converts each element of
+ % the list into the correct type. M will hold the list if the
+ % conversion succeded for each element of M, otherwise it will
+ % hold the error.
+ %
+:- pred convert_maybe_list(term::in,
+ pred(term, maybe1(T))::(pred(in, out) is semidet),
+ string::in, maybe1(list(T))::out) is det.
+
+convert_maybe_list(term.variable(V), _, UnrecognizedMsg,
+ error(UnrecognizedMsg, term.variable(V))).
+convert_maybe_list(term.functor(Functor, Args, Context), Pred, UnrecognizedMsg,
+ Result) :-
+ (
+ Functor = term.atom("[|]"),
+ Args = [Term, RestTerm]
+ ->
+ ( call(Pred, Term, ElementResult) ->
+ (
+ ElementResult = ok(Element),
+ convert_maybe_list(RestTerm, Pred, UnrecognizedMsg,
+ RestResult),
+ (
+ RestResult = ok(List0),
+ Result = ok([Element | List0])
+ ;
+ RestResult = error(_, _),
+ Result = RestResult
+ )
+ ;
+ ElementResult = error(Msg, ErrorTerm),
+ Result = error(Msg, ErrorTerm)
+ )
+ ;
+ Result = error(UnrecognizedMsg, Term)
+ )
+ ;
+ Functor = term.atom("[]"),
+ Args = []
+ ->
+ Result = ok([])
+ ;
+ Result = error("error in list", term.functor(Functor, Args, Context))
+ ).
+
:- pred convert_type_spec_pair(term::in, pair(tvar, mer_type)::out) is semidet.
convert_type_spec_pair(Term, TypeSpec) :-
Index: compiler/prog_item.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_item.m,v
retrieving revision 1.15
diff -u -b -r1.15 prog_item.m
--- compiler/prog_item.m 5 Jun 2006 02:26:10 -0000 1.15
+++ compiler/prog_item.m 5 Jun 2006 03:20:20 -0000
@@ -80,6 +80,9 @@
% Solver types cause the compiler to create foreign procs for the
% init and representation functions.
+ ; pragma_memo_attribute
+ % This item was introduced for an attribute given in a pragma memo.
+
; foreign_imports.
% The compiler sometimes needs to insert additional foreign_import
% pragmas. XXX Why?
@@ -509,7 +512,8 @@
tabled_name :: sym_name,
tabled_arity :: int,
tabled_p_or_f :: maybe(pred_or_func),
- tabled_mode :: maybe(list(mer_mode))
+ tabled_mode :: maybe(list(mer_mode)),
+ tabled_attributes :: maybe(table_attributes)
% Tabling type, Predname, Arity, PredOrFunc?, Mode?
)
Index: compiler/prog_mutable.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_mutable.m,v
retrieving revision 1.10
diff -u -b -r1.10 prog_mutable.m
--- compiler/prog_mutable.m 27 Apr 2006 07:34:31 -0000 1.10
+++ compiler/prog_mutable.m 16 May 2006 03:49:03 -0000
@@ -175,10 +175,14 @@
InstVarSet = varset.init,
ExistQVars = [],
Constraints = constraints([], []),
+ ArgDecls = [],
+ WithType = no,
+ WithInst = no,
+ Condition = true,
InitPredDecl = pred_or_func(VarSet, InstVarSet, ExistQVars,
predicate, mutable_init_pred_sym_name(ModuleName, Name),
- [], no /* with_type */, no /* with_inst */, yes(det),
- true /* condition */, purity_impure, Constraints).
+ ArgDecls, WithType, WithInst, yes(det), Condition, purity_impure,
+ Constraints).
%-----------------------------------------------------------------------------%
Index: compiler/prog_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_out.m,v
retrieving revision 1.71
diff -u -b -r1.71 prog_out.m
--- compiler/prog_out.m 20 Apr 2006 05:37:00 -0000 1.71
+++ compiler/prog_out.m 12 May 2006 04:05:16 -0000
@@ -29,7 +29,6 @@
:- import_module io.
:- import_module list.
:- import_module maybe.
-:- import_module pair.
:- pred maybe_report_stats(bool::in, io::di, io::uo) is det.
:- pred maybe_write_string(bool::in, string::in, io::di, io::uo) is det.
@@ -148,16 +147,9 @@
:- pred write_purity_prefix(purity::in, io::di, io::uo) is det.
:- func purity_prefix_to_string(purity) = string.
- % Convert an eval_method to a string giving the name of the pragma,
- % and if the eval_method specifies tabling methods for individual
- % arguments, a description of those argument tabling methods.
- %
-:- func eval_method_to_string(eval_method) = pair(string, maybe(string)).
-
- % Convert an eval_method to a single string. This is suitable for use
- % in error messages, but not for generating valid Mercury code.
+ % Convert an eval_method to a string giving the name of the pragma.
%
-:- func eval_method_to_one_string(eval_method) = string.
+:- func eval_method_to_string(eval_method) = string.
:- func maybe_arg_tabling_method_to_string(maybe(arg_tabling_method)) = string.
@@ -173,6 +165,7 @@
:- import_module parse_tree.prog_util.
:- import_module int.
+:- import_module pair.
:- import_module string.
:- import_module term.
:- import_module term_io.
@@ -209,8 +202,7 @@
write_message(Message, !IO),
write_messages(Messages, !IO).
-:- pred write_message(pair(string, term)::in,
- io::di, io::uo) is det.
+:- pred write_message(pair(string, term)::in, io::di, io::uo) is det.
write_message(Msg - Term, !IO) :-
( Term = term.functor(_Functor, _Args, Context0) ->
@@ -423,24 +415,10 @@
purity_name(purity_semipure, "semipure").
purity_name(purity_impure, "impure").
-eval_method_to_one_string(EvalMethod) = Str :-
- BaseStr - MaybeArgsStr = eval_method_to_string(EvalMethod),
- (
- MaybeArgsStr = yes(ArgsStr),
- Str = BaseStr ++ "(" ++ ArgsStr ++ ")"
- ;
- MaybeArgsStr = no,
- Str = BaseStr
- ).
-
-eval_method_to_string(eval_normal) = "normal" - no.
-eval_method_to_string(eval_loop_check) = "loop_check" - no.
-eval_method_to_string(eval_memo(all_strict)) = "memo" - no.
-eval_method_to_string(eval_memo(all_fast_loose)) = "fast_loose_memo" - no.
-eval_method_to_string(eval_memo(specified(Args))) = "memo" - yes(ArgsStr) :-
- ArgStrs = list.map(maybe_arg_tabling_method_to_string, Args),
- ArgsStr = "[" ++ string.join_list(", ", ArgStrs) ++ "]".
-eval_method_to_string(eval_minimal(MinimalMethod)) = Str - 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(MinimalMethod)) = Str :-
(
MinimalMethod = own_stacks,
Str = "minimal_model_own_stacks"
@@ -448,7 +426,7 @@
MinimalMethod = stack_copy,
Str = "minimal_model_stack_copy"
).
-eval_method_to_string(eval_table_io(IsDecl, IsUnitize)) = Str - no :-
+eval_method_to_string(eval_table_io(IsDecl, IsUnitize)) = Str :-
(
IsDecl = table_io_decl,
DeclStr = "decl, "
Index: compiler/prog_rep.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_rep.m,v
retrieving revision 1.45
diff -u -b -r1.45 prog_rep.m
--- compiler/prog_rep.m 29 Mar 2006 08:07:18 -0000 1.45
+++ compiler/prog_rep.m 5 Jun 2006 12:27:33 -0000
@@ -367,8 +367,8 @@
"$type_info_cell_constructor".
cons_id_to_string(typeclass_info_cell_constructor) =
"$typeclass_info_cell_constructor".
-cons_id_to_string(tabling_pointer_const(_)) =
- "$tabling_pointer_const".
+cons_id_to_string(tabling_info_const(_)) =
+ "$tabling_info_const".
cons_id_to_string(deep_profiling_proc_layout(_)) =
"$deep_profiling_procedure_data".
cons_id_to_string(table_io_decl(_)) =
Index: compiler/prog_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_util.m,v
retrieving revision 1.87
diff -u -b -r1.87 prog_util.m
--- compiler/prog_util.m 20 Apr 2006 05:37:00 -0000 1.87
+++ compiler/prog_util.m 5 Jun 2006 12:28:56 -0000
@@ -590,9 +590,9 @@
cons_id_arity(typeclass_info_cell_constructor) =
unexpected(this_file, "cons_id_arity: " ++
"can't get arity of typeclass_info_cell_constructor").
-cons_id_arity(tabling_pointer_const(_)) =
+cons_id_arity(tabling_info_const(_)) =
unexpected(this_file,
- "cons_id_arity: can't get arity of tabling_pointer_const").
+ "cons_id_arity: can't get arity of tabling_info_const").
cons_id_arity(deep_profiling_proc_layout(_)) =
unexpected(this_file, "cons_id_arity: " ++
"can't get arity of deep_profiling_proc_layout").
@@ -608,7 +608,7 @@
cons_id_maybe_arity(base_typeclass_info_const(_, _, _, _)) = no.
cons_id_maybe_arity(type_info_cell_constructor(_)) = no.
cons_id_maybe_arity(typeclass_info_cell_constructor) = no.
-cons_id_maybe_arity(tabling_pointer_const(_)) = no.
+cons_id_maybe_arity(tabling_info_const(_)) = no.
cons_id_maybe_arity(deep_profiling_proc_layout(_)) = no.
cons_id_maybe_arity(table_io_decl(_)) = no.
Index: compiler/recompilation.version.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/recompilation.version.m,v
retrieving revision 1.46
diff -u -b -r1.46 recompilation.version.m
--- compiler/recompilation.version.m 5 Jun 2006 02:26:10 -0000 1.46
+++ compiler/recompilation.version.m 5 Jun 2006 03:20:20 -0000
@@ -584,7 +584,7 @@
yes(yes(PredOrFunc) - Name / Arity)).
is_pred_pragma(fact_table(Name, Arity, _), yes(no - Name / Arity)).
is_pred_pragma(reserve_tag(_TypeName, _TypeArity), no).
-is_pred_pragma(tabled(_, Name, Arity, MaybePredOrFunc, _),
+is_pred_pragma(tabled(_, Name, Arity, MaybePredOrFunc, _, _Attrs),
yes(MaybePredOrFunc - Name / Arity)).
is_pred_pragma(promise_pure(Name, Arity), yes(no - Name / Arity)).
is_pred_pragma(promise_semipure(Name, Arity), yes(no - Name / Arity)).
Index: compiler/rtti.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rtti.m,v
retrieving revision 1.71
diff -u -b -r1.71 rtti.m
--- compiler/rtti.m 20 Apr 2006 05:37:01 -0000 1.71
+++ compiler/rtti.m 5 Jun 2006 17:46:52 -0000
@@ -831,6 +831,92 @@
is semidet.
%----------------------------------------------------------------------------%
+
+:- type proc_tabling_struct_id
+ ---> tabling_info
+ % A reference to the main structure containing the call table
+ % used to implement memoization, loop checking or minimal model
+ % semantics for the given procedure.
+
+ ; tabling_input_steps
+ % A reference to the part of the tabling structure for the given
+ % procedure that gives the nature of each step in the call table.
+
+ ; tabling_output_steps
+ % A reference to the part of the tabling structure for the given
+ % procedure that gives the nature of each step in the answer table
+ % (if any).
+
+ ; tabling_input_enum_params
+ % A reference to the part of the tabling structure for the given
+ % procedure that gives parameters for the call table steps
+ % corresponding to enums.
+
+ ; tabling_output_enum_params
+ % A reference to the part of the tabling structure for the given
+ % procedure that gives parameters for the answer table steps
+ % (if any) corresponding to enums.
+
+ ; tabling_ptis
+ % A reference to the part of the tabling structure for the given
+ % procedure that contains pointers to the pseudotypeinfos
+ % describing the procedure's arguments.
+
+ ; tabling_type_param_locns
+ % A reference to the part of the tabling structure for the given
+ % procedure that contains pointers to the locations of the
+ % typeinfos that give the parameters of the pseudotypeinfos
+ % in the tabling_ptis array.
+
+ ; tabling_root_node
+ % A reference to the part of the tabling structure for the given
+ % procedure that contains the root of the call table.
+
+ ; tabling_call_stats
+ % A reference to the part of the tabling structure for the given
+ % procedure that refers to the current cumulative statistics
+ % about operations on the call table.
+
+ ; tabling_prev_call_stats
+ % A reference to the part of the tabling structure for the given
+ % procedure that refers to the previous snapshot of statistics
+ % about operations on the call table.
+
+ ; tabling_answer_stats
+ % A reference to the part of the tabling structure for the given
+ % procedure that refers to the current cumulative statistics
+ % about operations on the answer table.
+
+ ; tabling_prev_answer_stats
+ % A reference to the part of the tabling structure for the given
+ % procedure that refers to the previous snapshot of statistics
+ % about operations on the answer table.
+
+ ; tabling_tips.
+ % A reference to the part of the tabling structure for the given
+ % procedure that contains pointers to the current set of call table
+ % tips, for use as a pool of replacements with limited size tables.
+
+:- func tabling_info_id_str(proc_tabling_struct_id) = string.
+
+ % tabling_id_c_type(TablingId, Type, IsArray):
+ %
+ % To declare a variable of the type specified by TablingId, put Type
+ % before the name of the variable; if IsArray is true, also put "[]"
+ % after the name.
+ %
+:- pred tabling_id_c_type(proc_tabling_struct_id::in, string::out,
+ bool::out) is det.
+
+:- pred tabling_id_java_type(proc_tabling_struct_id::in, string::out,
+ bool::out) is det.
+
+:- func tabling_id_has_array_type(proc_tabling_struct_id) = bool.
+
+:- pred table_trie_step_to_c(table_trie_step::in, string::out, maybe(int)::out)
+ is det.
+
+%----------------------------------------------------------------------------%
%----------------------------------------------------------------------------%
:- implementation.
@@ -1703,7 +1789,7 @@
ctor_rtti_name_c_type(RttiName, CTypeName, IsArray) :-
ctor_rtti_name_type(RttiName, GenTypeName, IsArray),
- CTypeName = string.append("MR_", GenTypeName).
+ CTypeName = "MR_" ++ GenTypeName.
tc_rtti_name_c_type(TCRttiName, CTypeName, IsArray) :-
tc_rtti_name_type(TCRttiName, GenTypeName, IsArray),
@@ -1927,6 +2013,71 @@
%-----------------------------------------------------------------------------%
+tabling_info_id_str(tabling_info) = "table_info".
+tabling_info_id_str(tabling_input_steps) = "table_input_steps".
+tabling_info_id_str(tabling_output_steps) = "table_output_steps".
+tabling_info_id_str(tabling_input_enum_params) = "table_input_enum_params".
+tabling_info_id_str(tabling_output_enum_params) = "table_output_enum_params".
+tabling_info_id_str(tabling_ptis) = "table_ptis".
+tabling_info_id_str(tabling_type_param_locns) = "tabling_type_param_locns".
+tabling_info_id_str(tabling_root_node) = "table_root_node".
+tabling_info_id_str(tabling_call_stats) = "table_call_stats".
+tabling_info_id_str(tabling_prev_call_stats) = "table_prev_call_stats".
+tabling_info_id_str(tabling_answer_stats) = "table_answer_stats".
+tabling_info_id_str(tabling_prev_answer_stats) = "table_prev_answer_stats".
+tabling_info_id_str(tabling_tips) = "table_tips".
+
+tabling_id_c_type(Id, JavaTypeName, IsArray) :-
+ % Since tabling is not yet implemented for Java, this is only provisional.
+ tabling_id_base_type(Id, CTypeName, IsArray),
+ JavaTypeName = "MR_" ++ CTypeName.
+
+tabling_id_java_type(Id, JavaTypeName, IsArray) :-
+ % Since tabling is not yet implemented for Java, this is only provisional.
+ tabling_id_base_type(Id, CTypeName, IsArray),
+ JavaTypeName = "mercury.runtime." ++ CTypeName.
+
+:- pred tabling_id_base_type(proc_tabling_struct_id::in, string::out,
+ bool::out) is det.
+
+tabling_id_base_type(tabling_info, "ProcTableInfo", no).
+tabling_id_base_type(tabling_input_steps, "TableTrieStep", yes).
+tabling_id_base_type(tabling_output_steps, "TableTrieStep", yes).
+tabling_id_base_type(tabling_input_enum_params, "Integer", yes).
+tabling_id_base_type(tabling_output_enum_params, "Integer", yes).
+tabling_id_base_type(tabling_ptis, "PseudoTypeInfo", yes).
+tabling_id_base_type(tabling_type_param_locns, "MR_Type_Param_Locns", yes).
+tabling_id_base_type(tabling_root_node, "TableNode", no).
+tabling_id_base_type(tabling_call_stats, "TableStepStats", yes).
+tabling_id_base_type(tabling_prev_call_stats, "TableStepStats", yes).
+tabling_id_base_type(tabling_answer_stats, "TableStepStats", yes).
+tabling_id_base_type(tabling_prev_answer_stats, "TableStepStats", yes).
+tabling_id_base_type(tabling_tips, "TrieNode", yes).
+
+tabling_id_has_array_type(Id) = IsArray :-
+ tabling_id_base_type(Id, _, IsArray).
+
+table_trie_step_to_c(table_trie_step_dummy, "MR_TABLE_STEP_DUMMY", no).
+table_trie_step_to_c(table_trie_step_int, "MR_TABLE_STEP_INT", no).
+table_trie_step_to_c(table_trie_step_char, "MR_TABLE_STEP_CHAR", no).
+table_trie_step_to_c(table_trie_step_string, "MR_TABLE_STEP_STRING", no).
+table_trie_step_to_c(table_trie_step_float, "MR_TABLE_STEP_FLOAT", no).
+table_trie_step_to_c(table_trie_step_enum(EnumRange), "MR_TABLE_STEP_ENUM",
+ yes(EnumRange)).
+table_trie_step_to_c(table_trie_step_user(_), "MR_TABLE_STEP_USER", no).
+table_trie_step_to_c(table_trie_step_user_fast_loose(_),
+ "MR_TABLE_STEP_USER_FAST_LOOSE", no).
+table_trie_step_to_c(table_trie_step_poly, "MR_TABLE_STEP_POLY", no).
+table_trie_step_to_c(table_trie_step_poly_fast_loose,
+ "MR_TABLE_STEP_POLY_FAST_LOOSE", no).
+table_trie_step_to_c(table_trie_step_typeinfo, "MR_TABLE_STEP_TYPEINFO", no).
+table_trie_step_to_c(table_trie_step_typeclassinfo,
+ "MR_TABLE_STEP_TYPECLASSINFO", no).
+table_trie_step_to_c(table_trie_step_promise_implied,
+ "MR_TABLE_STEP_PROMISE_IMPLIED", no).
+
+%-----------------------------------------------------------------------------%
+
:- func this_file = string.
this_file = "rtti.m".
Index: compiler/rtti_to_mlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rtti_to_mlds.m,v
retrieving revision 1.70
diff -u -b -r1.70 rtti_to_mlds.m
--- compiler/rtti_to_mlds.m 29 Mar 2006 08:07:21 -0000 1.70
+++ compiler/rtti_to_mlds.m 5 Jun 2006 18:45:04 -0000
@@ -69,6 +69,7 @@
:- import_module ml_backend.ml_closure_gen.
:- import_module ml_backend.ml_code_util.
:- import_module ml_backend.ml_unify_gen.
+:- import_module ml_backend.ml_util.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_type.
@@ -102,7 +103,7 @@
mlds_defn_is_potentially_duplicated(MLDS_Defn) :-
MLDS_Defn = mlds_defn(EntityName, _, _, _),
EntityName = data(DataName),
- DataName = rtti(ctor_rtti_id(_, RttiName)),
+ DataName = mlds_rtti(ctor_rtti_id(_, RttiName)),
( RttiName = type_info(_)
; RttiName = pseudo_type_info(_)
).
@@ -118,7 +119,7 @@
MLDS_Defns = []
;
rtti_data_to_id(RttiData, RttiId),
- Name = data(rtti(RttiId)),
+ Name = data(mlds_rtti(RttiId)),
gen_init_rtti_data_defn(RttiData, RttiId, ModuleInfo,
Initializer, ExtraDefns),
rtti_entity_name_and_init_to_defn(Name, RttiId, Initializer,
@@ -137,7 +138,7 @@
mlds_defn::out) is det.
rtti_id_and_init_to_defn(RttiId, Initializer, MLDS_Defn) :-
- Name = data(rtti(RttiId)),
+ Name = data(mlds_rtti(RttiId)),
rtti_entity_name_and_init_to_defn(Name, RttiId, Initializer, MLDS_Defn).
:- pred rtti_entity_name_and_init_to_defn(mlds_entity_name::in, rtti_id::in,
@@ -1111,7 +1112,7 @@
SrcType = mlds_rtti_type(item_type(tc_rtti_id(TCName,
base_typeclass_info(InstanceModuleName, InstanceString)))),
MLDS_ModuleName = mercury_module_name_to_mlds(InstanceModuleName),
- MLDS_DataName = rtti(tc_rtti_id(TCName,
+ MLDS_DataName = mlds_rtti(tc_rtti_id(TCName,
base_typeclass_info(InstanceModuleName, InstanceString))),
DataAddr = data_addr(MLDS_ModuleName, MLDS_DataName),
Rval = const(data_addr_const(DataAddr)),
@@ -1224,7 +1225,7 @@
)
),
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
- MLDS_DataName = rtti(ctor_rtti_id(RttiTypeCtor, RttiName)),
+ MLDS_DataName = mlds_rtti(ctor_rtti_id(RttiTypeCtor, RttiName)),
DataAddr = data_addr(MLDS_ModuleName, MLDS_DataName),
Rval = const(data_addr_const(DataAddr)).
@@ -1268,7 +1269,7 @@
TCRttiName = type_class_instance_methods(_Types),
MLDS_ModuleName = mlds_module_name_from_tc_name(TCName)
),
- MLDS_DataName = rtti(tc_rtti_id(TCName, TCRttiName)),
+ MLDS_DataName = mlds_rtti(tc_rtti_id(TCName, TCRttiName)),
DataAddr = data_addr(MLDS_ModuleName, MLDS_DataName),
Rval = const(data_addr_const(DataAddr)).
@@ -1398,7 +1399,8 @@
% (this is similar to ml_gen_proc_addr_rval).
ml_gen_pred_label_from_rtti(ModuleInfo, RttiProcId, PredLabel, PredModule),
ProcId = RttiProcId ^ proc_id,
- QualifiedProcLabel = qual(PredModule, module_qual, PredLabel - ProcId),
+ QualifiedProcLabel = qual(PredModule, module_qual,
+ mlds_proc_label(PredLabel, ProcId)),
Params = ml_gen_proc_params_from_rtti(ModuleInfo, RttiProcId),
Signature = mlds_get_func_signature(Params),
ProcAddrRval = const(code_addr_const(proc(QualifiedProcLabel, Signature))),
@@ -1462,65 +1464,6 @@
gen_init_type_ctor_rep(TypeCtorData) = gen_init_builtin_const(Name) :-
rtti.type_ctor_rep_to_string(TypeCtorData, Name).
-:- func gen_init_builtin_const(string) = mlds_initializer.
-
-gen_init_builtin_const(Name) = init_obj(Rval) :-
- mercury_private_builtin_module(PrivateBuiltin),
- MLDS_Module = mercury_module_name_to_mlds(PrivateBuiltin),
- % XXX These are actually enumeration constants.
- % Perhaps we should be using an enumeration type here,
- % rather than `mlds_native_int_type'.
- Type = mlds_native_int_type,
- Rval = lval(var(qual(MLDS_Module, module_qual, mlds_var_name(Name, no)),
- Type)).
-
-%-----------------------------------------------------------------------------%
-%
-% Conversion functions for the basic types.
-%
-% This handles arrays, maybe, null pointers, strings, and ints.
-
-:- func gen_init_array(func(T) = mlds_initializer, list(T)) =
- mlds_initializer.
-
-gen_init_array(Conv, List) = init_array(list.map(Conv, List)).
-
-:- func gen_init_maybe(mlds_type, func(T) = mlds_initializer, maybe(T)) =
- mlds_initializer.
-
-gen_init_maybe(_Type, Conv, yes(X)) = Conv(X).
-gen_init_maybe(Type, _Conv, no) = gen_init_null_pointer(Type).
-
-:- func gen_init_null_pointer(mlds_type) = mlds_initializer.
-
-gen_init_null_pointer(Type) = init_obj(const(null(Type))).
-
-:- func gen_init_string(string) = mlds_initializer.
-
-gen_init_string(String) = init_obj(const(string_const(String))).
-
-:- func gen_init_int(int) = mlds_initializer.
-
-gen_init_int(Int) = init_obj(const(int_const(Int))).
-
-:- func gen_init_bool(bool) = mlds_initializer.
-
-gen_init_bool(no) = init_obj(const(false)).
-gen_init_bool(yes) = init_obj(const(true)).
-
-:- func gen_init_boxed_int(int) = mlds_initializer.
-
-gen_init_boxed_int(Int) =
- init_obj(unop(box(mlds_native_int_type), const(int_const(Int)))).
-
-:- func gen_init_reserved_address(module_info, reserved_address) =
- mlds_initializer.
-
-gen_init_reserved_address(ModuleInfo, ReservedAddress) =
- % XXX using `mlds_generic_type' here is probably wrong
- init_obj(ml_gen_reserved_address(ModuleInfo, ReservedAddress,
- mlds_generic_type)).
-
%-----------------------------------------------------------------------------%
:- func this_file = string.
Index: compiler/size_prof.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/size_prof.m,v
retrieving revision 1.38
diff -u -b -r1.38 size_prof.m
--- compiler/size_prof.m 20 Apr 2006 05:37:01 -0000 1.38
+++ compiler/size_prof.m 6 Jun 2006 03:48:03 -0000
@@ -5,10 +5,10 @@
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-
+%
% File: size_prof.m
% Author: zs.
-
+%
% This module performs a source-to-source program transformation that
% implements term size profiling. The objective of the transformation is to
% make it possible to find out the size of every term in constant time, i.e.
@@ -818,7 +818,7 @@
VarTypes0 = !.Info ^ vartypes,
make_int_const_construction_alloc(KnownSize,
yes("KnownSize"), KnownSizeGoal, KnownSizeVar,
- VarTypes0, VarTypes1, VarSet0, VarSet1),
+ VarSet0, VarSet1, VarTypes0, VarTypes1),
!:Info = !.Info ^ varset := VarSet1,
!:Info = !.Info ^ vartypes := VarTypes1,
get_new_var(int_type, "FinalSizeVar", SizeVar, !Info),
@@ -882,7 +882,7 @@
!:Info = !.Info ^ rtti_varmaps := RttiVarMaps
),
make_int_const_construction_alloc(Slot, yes("TypeClassInfoSlot"),
- SlotGoal, SlotVar, VarTypes1, VarTypes, VarSet1, VarSet),
+ SlotGoal, SlotVar, VarSet1, VarSet, VarTypes1, VarTypes),
!:Info = !.Info ^ varset := VarSet,
!:Info = !.Info ^ vartypes := VarTypes,
PrivateBuiltin = mercury_private_builtin_module,
@@ -922,7 +922,7 @@
VarSet0 = !.Info ^ varset,
VarTypes0 = !.Info ^ vartypes,
make_int_const_construction_alloc(Arity, yes("TupleArity"), ArityGoal,
- ArityVar, VarTypes0, VarTypes1, VarSet0, VarSet1),
+ ArityVar, VarSet0, VarSet1, VarTypes0, VarTypes1),
!:Info = !.Info ^ varset := VarSet1,
!:Info = !.Info ^ vartypes := VarTypes1,
FrontGoals = list.append(TypeCtorGoals, [ArityGoal]),
Index: compiler/special_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/special_pred.m,v
retrieving revision 1.61
diff -u -b -r1.61 special_pred.m
--- compiler/special_pred.m 20 Apr 2006 05:37:02 -0000 1.61
+++ compiler/special_pred.m 30 May 2006 04:38:56 -0000
@@ -302,7 +302,7 @@
compiler_generated_rtti_for_builtins(ModuleInfo) :-
module_info_get_globals(ModuleInfo, Globals),
globals.get_target(Globals, Target),
- ( Target = il ; Target = java ).
+ ( Target = target_il ; Target = target_java ).
%-----------------------------------------------------------------------------%
Index: compiler/stack_layout.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/stack_layout.m,v
retrieving revision 1.117
diff -u -b -r1.117 stack_layout.m
--- compiler/stack_layout.m 8 May 2006 03:36:02 -0000 1.117
+++ compiler/stack_layout.m 5 Jun 2006 08:43:45 -0000
@@ -55,6 +55,9 @@
static_cell_info::in, static_cell_info::out,
assoc_list(rval, llds_type)::out, layout_data::out) is det.
+:- pred convert_table_arg_info(table_arg_infos::in, int::out,
+ rval::out, rval::out, static_cell_info::in, static_cell_info::out) is det.
+
% Construct a representation of a variable location as a 32-bit
% integer.
%
@@ -74,6 +77,7 @@
:- implementation.
+:- import_module backend_libs.proc_label.
:- import_module backend_libs.rtti.
:- import_module check_hlds.type_util.
:- import_module hlds.code_model.
@@ -182,10 +186,10 @@
EntryLabel = ProcLayoutInfo ^ entry_label,
ProcLabel = get_proc_label(EntryLabel),
(
- ProcLabel = proc(_, _, DeclModule, Name, Arity, _),
+ ProcLabel = ordinary_proc_label(_, _, DeclModule, Name, Arity, _),
\+ no_type_info_builtin(DeclModule, Name, Arity)
;
- ProcLabel = special_proc(_, _, _, _, _, _)
+ ProcLabel = special_proc_label(_, _, _, _, _, _)
).
%---------------------------------------------------------------------------%
@@ -565,10 +569,10 @@
;
MaybeTableInfo = yes(TableInfo),
get_static_cell_info(!.Info, StaticCellInfo0),
- make_table_data(RttiProcLabel, Kind, TableInfo, TableData,
+ make_table_data(RttiProcLabel, Kind, TableInfo, MaybeTableData,
StaticCellInfo0, StaticCellInfo),
set_static_cell_info(StaticCellInfo, !Info),
- add_table_data(TableData, !Info)
+ add_table_data(MaybeTableData, !Info)
).
:- pred construct_trace_layout(rtti_proc_label::in,
@@ -617,21 +621,24 @@
label_has_var_info),
(
MaybeTableInfo = no,
- MaybeTableName = no
+ MaybeTableDataAddr = no
;
MaybeTableInfo = yes(TableInfo),
(
TableInfo = table_io_decl_info(_),
- MaybeTableName = yes(table_io_decl(RttiProcLabel))
+ MaybeTableDataAddr = yes(layout_addr(table_io_decl(RttiProcLabel)))
;
- TableInfo = table_gen_info(_, _, _, _),
- MaybeTableName = yes(table_gen_info(RttiProcLabel))
+ TableInfo = table_gen_info(_, _, _, _, _),
+ module_info_get_name(ModuleInfo, ModuleName),
+ ProcLabel = make_proc_label_from_rtti(RttiProcLabel),
+ MaybeTableDataAddr = yes(data_addr(ModuleName,
+ proc_tabling_ref(ProcLabel, tabling_info)))
)
),
encode_exec_trace_flags(ModuleInfo, HeadVars, ArgModes, VarTypes,
0, Flags),
ExecTrace = proc_layout_exec_trace(CallLabelLayout, ProcBytes,
- MaybeTableName, HeadVarNumVector, VarNameVector,
+ MaybeTableDataAddr, HeadVarNumVector, VarNameVector,
MaxVarNum, MaxTraceReg, MaybeFromFullSlot, MaybeIoSeqSlot,
MaybeTrailSlots, MaybeMaxfrSlot, EvalMethod,
MaybeCallTableSlot, EffTraceLevel, Flags).
@@ -1225,9 +1232,8 @@
RvalsTypes, Data) :-
DataAddr = layout_addr(
closure_proc_id(CallerProcLabel, SeqNo, ClosureProcLabel)),
- Data = closure_proc_id_data(CallerProcLabel, SeqNo,
- ClosureProcLabel, ModuleName, FileName, LineNumber, Origin,
- GoalPath),
+ Data = closure_proc_id_data(CallerProcLabel, SeqNo, ClosureProcLabel,
+ ModuleName, FileName, LineNumber, Origin, GoalPath),
ProcIdRvalType = const(data_addr_const(DataAddr, no)) - data_ptr,
ClosureLayoutInfo = closure_layout_info(ClosureArgs, TVarLocnMap),
construct_closure_arg_rvals(ClosureArgs,
@@ -1267,33 +1273,25 @@
%---------------------------------------------------------------------------%
:- pred make_table_data(rtti_proc_label::in,
- proc_layout_kind::in, proc_table_info::in, layout_data::out,
+ proc_layout_kind::in, proc_table_info::in, maybe(layout_data)::out,
static_cell_info::in, static_cell_info::out) is det.
-make_table_data(RttiProcLabel, Kind, TableInfo, TableData,
+make_table_data(RttiProcLabel, Kind, TableInfo, MaybeTableData,
!StaticCellInfo) :-
(
TableInfo = table_io_decl_info(TableArgInfo),
convert_table_arg_info(TableArgInfo, NumPTIs, PTIVectorRval,
TVarVectorRval, !StaticCellInfo),
TableData = table_io_decl_data(RttiProcLabel, Kind,
- NumPTIs, PTIVectorRval, TVarVectorRval)
+ NumPTIs, PTIVectorRval, TVarVectorRval),
+ MaybeTableData = yes(TableData)
;
- TableInfo = table_gen_info(NumInputs, NumOutputs, Steps,
- TableArgInfo),
- convert_table_arg_info(TableArgInfo, NumPTIs, PTIVectorRval,
- TVarVectorRval, !StaticCellInfo),
- NumArgs = NumInputs + NumOutputs,
- expect(unify(NumArgs, NumPTIs), this_file,
- "make_table_data: args mismatch"),
- TableData = table_gen_data(RttiProcLabel, NumInputs, NumOutputs, Steps,
- PTIVectorRval, TVarVectorRval)
+ TableInfo = table_gen_info(_NumInputs, _NumOutputs,
+ _InputSteps, _MaybeOutputSteps, _TableArgInfo),
+ % This structure is generated in add_tabling_info_struct in proc_gen.m.
+ MaybeTableData = no
).
-:- pred convert_table_arg_info(table_arg_infos::in,
- int::out, rval::out, rval::out,
- static_cell_info::in, static_cell_info::out) is det.
-
convert_table_arg_info(TableArgInfos, NumPTIs,
PTIVectorRval, TVarVectorRval, !StaticCellInfo) :-
TableArgInfos = table_arg_infos(Args, TVarSlotMap),
@@ -1660,13 +1658,18 @@
counter.allocate(LabelNum, Counter0, Counter),
!:LI = !.LI ^ label_counter := Counter.
-:- pred add_table_data(layout_data::in,
+:- pred add_table_data(maybe(layout_data)::in,
stack_layout_info::in, stack_layout_info::out) is det.
-add_table_data(TableIoDeclData, !LI) :-
+add_table_data(MaybeTableIoDeclData, !LI) :-
+ (
+ MaybeTableIoDeclData = yes(TableIoDeclData),
TableIoDecls0 = !.LI ^ table_infos,
TableIoDecls = [TableIoDeclData | TableIoDecls0],
- !:LI = !.LI ^ table_infos := TableIoDecls.
+ !:LI = !.LI ^ table_infos := TableIoDecls
+ ;
+ MaybeTableIoDeclData = no
+ ).
:- pred add_proc_layout_data(layout_data::in, layout_name::in, label::in,
stack_layout_info::in, stack_layout_info::out) is det.
Index: compiler/switch_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_util.m,v
retrieving revision 1.30
diff -u -b -r1.30 switch_util.m
--- compiler/switch_util.m 29 Mar 2006 08:07:23 -0000 1.30
+++ compiler/switch_util.m 5 Jun 2006 12:52:21 -0000
@@ -282,7 +282,7 @@
switch_priority(pred_closure_tag(_, _, _)) = 6.
switch_priority(type_ctor_info_constant(_, _, _)) = 6.
switch_priority(base_typeclass_info_constant(_, _, _)) = 6.
-switch_priority(tabling_pointer_constant(_, _)) = 6.
+switch_priority(tabling_info_constant(_, _)) = 6.
switch_priority(deep_profiling_proc_layout_tag(_, _)) = 6.
switch_priority(table_io_decl_tag(_, _)) = 6.
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.108
diff -u -b -r1.108 table_gen.m
--- compiler/table_gen.m 20 Apr 2006 05:37:02 -0000 1.108
+++ compiler/table_gen.m 8 Jun 2006 02:37:48 -0000
@@ -45,7 +45,7 @@
%-----------------------------------------------------------------------------%
-:- pred table_gen.process_module(module_info::in, module_info::out,
+:- pred table_gen_process_module(module_info::in, module_info::out,
io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
@@ -114,53 +114,53 @@
% of this code that is able to handle passing a module_info to
% polymorphism and getting an updated module_info back.
%
-table_gen.process_module(!ModuleInfo, !IO) :-
+table_gen_process_module(!ModuleInfo, !IO) :-
module_info_preds(!.ModuleInfo, Preds0),
map.keys(Preds0, PredIds),
map.init(GenMap0),
- table_gen.process_preds(PredIds, !ModuleInfo, GenMap0, _, !IO).
+ table_gen_process_preds(PredIds, !ModuleInfo, GenMap0, _, !IO).
-:- pred table_gen.process_preds(list(pred_id)::in,
+:- pred table_gen_process_preds(list(pred_id)::in,
module_info::in, module_info::out,
generator_map::in, generator_map::out, io::di, io::uo) is det.
-table_gen.process_preds([], !ModuleInfo, !GenMap, !IO).
-table_gen.process_preds([PredId | PredIds], !ModuleInfo, !GenMap, !IO) :-
- table_gen.process_pred(PredId, !ModuleInfo, !GenMap, !IO),
- table_gen.process_preds(PredIds, !ModuleInfo, !GenMap, !IO).
+table_gen_process_preds([], !ModuleInfo, !GenMap, !IO).
+table_gen_process_preds([PredId | PredIds], !ModuleInfo, !GenMap, !IO) :-
+ table_gen_process_pred(PredId, !ModuleInfo, !GenMap, !IO),
+ table_gen_process_preds(PredIds, !ModuleInfo, !GenMap, !IO).
-:- pred table_gen.process_pred(pred_id::in, module_info::in, module_info::out,
+:- pred table_gen_process_pred(pred_id::in, module_info::in, module_info::out,
generator_map::in, generator_map::out, io::di, io::uo) is det.
-table_gen.process_pred(PredId, !ModuleInfo, !GenMap, !IO) :-
+table_gen_process_pred(PredId, !ModuleInfo, !GenMap, !IO) :-
module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
ProcIds = pred_info_procids(PredInfo),
- table_gen.process_procs(PredId, ProcIds, !ModuleInfo, !GenMap, !IO).
+ table_gen_process_procs(PredId, ProcIds, !ModuleInfo, !GenMap, !IO).
-:- pred table_gen.process_procs(pred_id::in, list(proc_id)::in,
+:- pred table_gen_process_procs(pred_id::in, list(proc_id)::in,
module_info::in, module_info::out,
generator_map::in, generator_map::out, io::di, io::uo) is det.
-table_gen.process_procs(_PredId, [], !ModuleInfo, !GenMap, !IO).
-table_gen.process_procs(PredId, [ProcId | ProcIds], !ModuleInfo, !GenMap,
+table_gen_process_procs(_PredId, [], !ModuleInfo, !GenMap, !IO).
+table_gen_process_procs(PredId, [ProcId | ProcIds], !ModuleInfo, !GenMap,
!IO) :-
module_info_preds(!.ModuleInfo, PredTable),
map.lookup(PredTable, PredId, PredInfo),
pred_info_get_procedures(PredInfo, ProcTable),
map.lookup(ProcTable, ProcId, ProcInfo0),
- table_gen.process_proc(PredId, ProcId, ProcInfo0, PredInfo,
+ table_gen_process_proc(PredId, ProcId, ProcInfo0, PredInfo,
!ModuleInfo, !GenMap, !IO),
- table_gen.process_procs(PredId, ProcIds, !ModuleInfo, !GenMap, !IO).
+ table_gen_process_procs(PredId, ProcIds, !ModuleInfo, !GenMap, !IO).
-:- pred table_gen.process_proc(pred_id::in, proc_id::in, proc_info::in,
+:- pred table_gen_process_proc(pred_id::in, proc_id::in, proc_info::in,
pred_info::in, module_info::in, module_info::out,
generator_map::in, generator_map::out, io::di, io::uo) is det.
-table_gen.process_proc(PredId, ProcId, ProcInfo0, PredInfo0, !ModuleInfo,
+table_gen_process_proc(PredId, ProcId, ProcInfo0, PredInfo0, !ModuleInfo,
!GenMap, !IO) :-
proc_info_get_eval_method(ProcInfo0, EvalMethod),
( eval_method_requires_tabling_transform(EvalMethod) = yes ->
- table_gen.transform_proc_if_possible(EvalMethod, PredId,
+ table_gen_transform_proc_if_possible(EvalMethod, PredId,
ProcId, ProcInfo0, _, PredInfo0, _, !ModuleInfo, !GenMap, !IO)
;
module_info_get_globals(!.ModuleInfo, Globals),
@@ -206,7 +206,7 @@
),
TableIoMethod = eval_table_io(Decl, Unitize),
proc_info_set_eval_method(TableIoMethod, ProcInfo0, ProcInfo1),
- table_gen.transform_proc_if_possible(TableIoMethod,
+ table_gen_transform_proc_if_possible(TableIoMethod,
PredId, ProcId, ProcInfo1, _, PredInfo0, _, !ModuleInfo,
!GenMap, !IO)
)
@@ -352,52 +352,51 @@
%-----------------------------------------------------------------------------%
-:- pred table_gen.transform_proc_if_possible(eval_method::in,
+:- pred table_gen_transform_proc_if_possible(eval_method::in,
pred_id::in, proc_id::in, proc_info::in, proc_info::out,
pred_info::in, pred_info::out, module_info::in, module_info::out,
generator_map::in, generator_map::out, io::di, io::uo) is det.
-table_gen.transform_proc_if_possible(EvalMethod, PredId, ProcId,
+table_gen_transform_proc_if_possible(EvalMethod, PredId, ProcId,
!ProcInfo, !PredInfo, !ModuleInfo, !GenMap, !IO) :-
globals.io_get_target(Target, !IO),
globals.io_get_gc_method(GC_Method, !IO),
- ( Target = c, GC_Method \= accurate ->
- table_gen.transform_proc(EvalMethod, PredId, ProcId,
+ ( Target = target_c, GC_Method \= accurate ->
+ table_gen_transform_proc(EvalMethod, PredId, ProcId,
!ProcInfo, !PredInfo, !ModuleInfo, !GenMap, !IO)
;
- % We don't want to increment the error count, since that
- % would combine with --halt-at-warn to prevent the clean
- % compilation of the library.
+ % We don't want to increment the error count, since that would combine
+ % with --halt-at-warn to prevent the clean compilation of the library.
pred_info_context(!.PredInfo, Context),
ProcPieces = describe_one_proc_name(!.ModuleInfo,
should_module_qualify, proc(PredId, ProcId)),
- EvalMethodStr = eval_method_to_one_string(EvalMethod),
+ EvalMethodStr = eval_method_to_string(EvalMethod),
Msg = [words("Ignoring the pragma"), fixed(EvalMethodStr),
words("for")] ++ ProcPieces ++
[words("due to lack of support on this back end."), nl],
error_util.write_error_pieces(Context, 0, Msg, !IO),
- %
+
% XXX We set the evaluation method to eval_normal here to prevent
% problems in the ml code generator if we are compiling in a grade
% that does not support tabling. (See ml_gen_maybe_add_table_var/6
% in ml_code_gen.m for further details.)
%
% We do this here rather than when processing the tabling pragmas
- % (in add_pragma.m) so that we can still generate error message
+ % (in add_pragma.m) so that we can still generate error messages
% for misuses of the tabling pragmas.
- %
+
proc_info_set_eval_method(eval_normal, !ProcInfo),
module_info_set_pred_proc_info(PredId, ProcId, !.PredInfo,
!.ProcInfo, !ModuleInfo)
).
-:- pred table_gen.transform_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, proc_info::out, pred_info::in, pred_info::out,
module_info::in, module_info::out,
generator_map::in, generator_map::out, io::di, io::uo) is det.
-table_gen.transform_proc(EvalMethod, PredId, ProcId, !ProcInfo, !PredInfo,
+table_gen_transform_proc(EvalMethod, PredId, ProcId, !ProcInfo, !PredInfo,
!ModuleInfo, !GenMap, !IO) :-
table_info_init(!.ModuleInfo, !.PredInfo, !.ProcInfo, TableInfo0),
@@ -409,21 +408,35 @@
proc_info_get_vartypes(!.ProcInfo, VarTypes0),
proc_info_get_goal(!.ProcInfo, OrigGoal),
proc_info_get_argmodes(!.ProcInfo, ArgModes),
+ proc_info_get_table_attributes(!.ProcInfo, MaybeAttributes),
+ (
+ MaybeAttributes = yes(Attributes)
+ ;
+ MaybeAttributes = no,
+ Attributes = default_memo_table_attributes
+ ),
(
EvalMethod = eval_normal,
% This should have been caught by our caller.
- unexpected(this_file, "table_gen.transform_proc: eval_normal")
+ unexpected(this_file, "table_gen_transform_proc: eval_normal")
;
EvalMethod = eval_table_io(_, _),
+ expect(unify(MaybeAttributes, no), this_file,
+ "table_gen_transform_proc: eval_table_io and Attributes"),
% Since we don't actually create a call table for I/O tabled
% procedures, the value of MaybeSpecMethod doesn't really matter.
- MaybeSpecMethod = all_same(arg_value)
- ;
- EvalMethod = eval_loop_check,
- MaybeSpecMethod = all_same(arg_value)
- ;
- EvalMethod = eval_memo(CallStrictness),
+ MaybeSpecMethod = all_same(arg_value),
+ Statistics = no,
+ MaybeSizeLimit = no
+ ;
+ ( EvalMethod = eval_loop_check
+ ; EvalMethod = eval_memo
+ ; EvalMethod = eval_minimal(_)
+ ),
+ CallStrictness = Attributes ^ table_attr_strictness,
+ Statistics = Attributes ^ table_attr_statistics,
+ MaybeSizeLimit = Attributes ^ table_attr_size_limit,
(
CallStrictness = all_strict,
MaybeSpecMethod = all_same(arg_value)
@@ -433,16 +446,20 @@
;
CallStrictness = specified(ArgMethods),
MaybeSpecMethod = specified(ArgMethods)
- )
+ ),
+ ( EvalMethod = eval_minimal(_) ->
+ expect(unify(MaybeSizeLimit, no), this_file,
+ "eval_minimal with size limit"),
+ expect(unify(MaybeSpecMethod, all_same(arg_value)), this_file,
+ "eval_minimal without all_strict")
;
- EvalMethod = eval_minimal(_),
- MaybeSpecMethod = all_same(arg_value)
+ true
+ )
),
get_input_output_vars(HeadVars, ArgModes, !.ModuleInfo, MaybeSpecMethod, _,
InputVarModeMethods, OutputVarModeMethods),
allocate_slot_numbers(InputVarModeMethods, 0, NumberedInputVars),
allocate_slot_numbers(OutputVarModeMethods, 0, NumberedOutputVars),
- tabling_via_extra_args(!.ModuleInfo, TablingViaExtraArgs),
% The case EvalMethod = eval_normal was caught by the code above.
(
EvalMethod = eval_table_io(Decl, Unitize),
@@ -450,39 +467,39 @@
globals.lookup_bool_option(Globals, trace_table_io_states,
TableIoStates),
assoc_list.from_corresponding_lists(HeadVars, ArgModes, HeadVarModes),
- table_gen.create_new_io_goal(OrigGoal, Decl, Unitize,
- TableIoStates, PredId, ProcId, TablingViaExtraArgs,
- HeadVarModes, NumberedInputVars, NumberedOutputVars,
- VarTypes0, VarTypes, VarSet0, VarSet,
+ create_new_io_goal(OrigGoal, Decl, Unitize, TableIoStates,
+ PredId, ProcId, HeadVarModes, NumberedInputVars,
+ NumberedOutputVars, VarSet0, VarSet, VarTypes0, VarTypes,
TableInfo0, TableInfo, Goal, MaybeProcTableInfo),
MaybeCallTableTip = no
;
EvalMethod = eval_loop_check,
- table_gen.create_new_loop_goal(Detism, OrigGoal, PredId, ProcId,
- TablingViaExtraArgs, HeadVars,
- NumberedInputVars, NumberedOutputVars,
- VarTypes0, VarTypes, VarSet0, VarSet,
- TableInfo0, TableInfo, CallTableTip, Goal, Steps),
- generate_gen_proc_table_info(TableInfo, Steps,
+ create_new_loop_goal(Detism, OrigGoal, Statistics,
+ PredId, ProcId, HeadVars, NumberedInputVars, NumberedOutputVars,
+ VarSet0, VarSet, VarTypes0, VarTypes,
+ TableInfo0, TableInfo, CallTableTip, Goal, InputSteps),
+ generate_gen_proc_table_info(TableInfo, InputSteps, no,
InputVarModeMethods, OutputVarModeMethods, ProcTableInfo),
MaybeCallTableTip = yes(CallTableTip),
MaybeProcTableInfo = yes(ProcTableInfo)
;
- EvalMethod = eval_memo(_CallStrictness),
+ EvalMethod = eval_memo,
( CodeModel = model_non ->
- table_gen.create_new_memo_non_goal(Detism,
- OrigGoal, PredId, ProcId, HeadVars,
- NumberedInputVars, NumberedOutputVars,
- VarTypes0, VarTypes, VarSet0, VarSet, TableInfo0, TableInfo,
- CallTableTip, Goal, Steps)
+ create_new_memo_non_goal(Detism, OrigGoal, Statistics,
+ MaybeSizeLimit, PredId, ProcId,
+ HeadVars, NumberedInputVars, NumberedOutputVars,
+ VarSet0, VarSet, VarTypes0, VarTypes, TableInfo0, TableInfo,
+ CallTableTip, Goal, InputSteps, OutputSteps),
+ MaybeOutputSteps = yes(OutputSteps)
;
- table_gen.create_new_memo_goal(Detism,
- OrigGoal, PredId, ProcId, TablingViaExtraArgs,
+ create_new_memo_goal(Detism, OrigGoal, Statistics, MaybeSizeLimit,
+ PredId, ProcId,
HeadVars, NumberedInputVars, NumberedOutputVars,
- VarTypes0, VarTypes, VarSet0, VarSet,
- TableInfo0, TableInfo, CallTableTip, Goal, Steps)
+ VarSet0, VarSet, VarTypes0, VarTypes,
+ TableInfo0, TableInfo, CallTableTip, Goal, InputSteps),
+ MaybeOutputSteps = no
),
- generate_gen_proc_table_info(TableInfo, Steps,
+ generate_gen_proc_table_info(TableInfo, InputSteps, MaybeOutputSteps,
InputVarModeMethods, OutputVarModeMethods, ProcTableInfo),
MaybeCallTableTip = yes(CallTableTip),
MaybeProcTableInfo = yes(ProcTableInfo)
@@ -490,30 +507,30 @@
EvalMethod = eval_minimal(MinimalMethod),
(
CodeModel = model_det,
- unexpected(this_file, "table_gen.transform_proc: minimal det")
+ unexpected(this_file, "table_gen_transform_proc: minimal det")
;
CodeModel = model_semi,
- unexpected(this_file, "table_gen.transform_proc: minimal semi")
+ unexpected(this_file, "table_gen_transform_proc: minimal semi")
;
CodeModel = model_non,
MinimalMethod = stack_copy,
- table_gen.create_new_mm_goal(Detism, OrigGoal,
- PredId, ProcId, TablingViaExtraArgs,
+ create_new_mm_goal(Detism, OrigGoal, Statistics, PredId, ProcId,
HeadVars, NumberedInputVars, NumberedOutputVars,
- VarTypes0, VarTypes, VarSet0, VarSet,
- TableInfo0, TableInfo, CallTableTip, Goal, Steps),
+ VarSet0, VarSet, VarTypes0, VarTypes, TableInfo0, TableInfo,
+ CallTableTip, Goal, InputSteps, OutputSteps),
MaybeCallTableTip = yes(CallTableTip)
;
CodeModel = model_non,
MinimalMethod = own_stacks,
- table_gen.do_own_stack_transform(Detism, OrigGoal,
+ do_own_stack_transform(Detism, OrigGoal, Statistics,
PredId, ProcId, !.PredInfo, !.ProcInfo,
HeadVars, NumberedInputVars, NumberedOutputVars,
- VarTypes0, VarTypes, VarSet0, VarSet,
- TableInfo0, TableInfo, !GenMap, Goal, Steps),
+ VarSet0, VarSet, VarTypes0, VarTypes, TableInfo0, TableInfo,
+ !GenMap, Goal, InputSteps, OutputSteps),
MaybeCallTableTip = no
),
- generate_gen_proc_table_info(TableInfo, Steps,
+ MaybeOutputSteps = yes(OutputSteps),
+ generate_gen_proc_table_info(TableInfo, InputSteps, MaybeOutputSteps,
InputVarModeMethods, OutputVarModeMethods, ProcTableInfo),
MaybeProcTableInfo = yes(ProcTableInfo)
),
@@ -632,14 +649,14 @@
% ).
:- pred create_new_loop_goal(determinism::in, hlds_goal::in,
- pred_id::in, proc_id::in, bool::in, list(prog_var)::in,
+ bool::in, pred_id::in, proc_id::in, list(prog_var)::in,
list(var_mode_pos_method)::in, list(var_mode_pos_method)::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
table_info::in, table_info::out, prog_var::out, hlds_goal::out,
list(table_trie_step)::out) is det.
-create_new_loop_goal(Detism, OrigGoal, PredId, ProcId, TablingViaExtraArgs,
- HeadVars, NumberedInputVars, NumberedOutputVars, !VarTypes, !VarSet,
+create_new_loop_goal(Detism, OrigGoal, Statistics, PredId, ProcId,
+ HeadVars, NumberedInputVars, NumberedOutputVars, !VarSet, !VarTypes,
!TableInfo, TableTipVar, Goal, Steps) :-
% Even if the original goal doesn't use all of the headvars,
% the code generated by the tabling transformation does,
@@ -652,48 +669,45 @@
ModuleInfo = !.TableInfo ^ table_module_info,
generate_simple_call_table_lookup_goal(loop_status_type,
- "table_loop_setup", NumberedInputVars, PredId, ProcId,
- TablingViaExtraArgs, Context, !VarTypes, !VarSet, !TableInfo,
- TableTipVar, StatusVar, LookUpGoal, Steps),
+ "table_loop_setup_shortcut", "MR_tbl_loop_setup",
+ NumberedInputVars, PredId, ProcId, Statistics, Context,
+ !VarSet, !VarTypes, !TableInfo, TableTipVar, StatusVar,
+ LookUpGoal, Steps),
generate_error_goal(!.TableInfo, Context, infinite_recursion_msg,
- !VarTypes, !VarSet, ActiveGoal),
+ !VarSet, !VarTypes, ActiveGoal),
- MarkInactivePred = "table_loop_mark_as_inactive",
- MarkInactiveFailPred = "table_loop_mark_as_inactive_and_fail",
- MarkActiveFailPred = "table_loop_mark_as_active_and_fail",
- (
- TablingViaExtraArgs = no,
- generate_call(MarkInactivePred, det, [TableTipVar],
- impure_code, [], ModuleInfo, Context, MarkInactiveGoal),
- generate_call(MarkInactiveFailPred, failure, [TableTipVar],
- impure_code, [], ModuleInfo, Context, MarkInactiveFailGoal),
- generate_call(MarkActiveFailPred, failure, [TableTipVar],
- impure_code, [], ModuleInfo, Context, MarkActiveFailGoal)
- ;
- TablingViaExtraArgs = yes,
TableTipArg = foreign_arg(TableTipVar,
yes(cur_table_node_name - in_mode), trie_node_type,
native_if_possible),
- MarkInactiveCode = "\tMR_" ++ MarkInactivePred ++
- "(" ++ cur_table_node_name ++ ");\n",
- MarkInactiveFailCode = "\tMR_" ++ MarkInactiveFailPred ++
- "(" ++ cur_table_node_name ++ ");\n",
- MarkActiveFailCode = "\tMR_" ++ MarkActiveFailPred ++
- "(" ++ cur_table_node_name ++ ");\n",
- table_generate_foreign_proc(MarkInactivePred, det,
+
+ MarkInactivePredName = "table_loop_mark_as_inactive",
+ MarkInactiveMacroName = "MR_tbl_loop_mark_as_inactive",
+ MarkInactiveFailPredName = "table_loop_mark_as_inactive_and_fail",
+ MarkInactiveFailMacroName = "MR_tbl_loop_mark_as_inactive_and_fail",
+ MarkActiveFailPredName = "table_loop_mark_as_active_and_fail",
+ MarkActiveFailMacroName = "MR_tbl_loop_mark_as_active_and_fail",
+
+ DebugArgStr = get_debug_arg_string(!.TableInfo),
+ MarkInactiveCode = "\t" ++ MarkInactiveMacroName ++
+ "(" ++ DebugArgStr ++ ", " ++ cur_table_node_name ++ ");\n",
+ MarkInactiveFailCode = "\t" ++ MarkInactiveFailMacroName ++
+ "(" ++ DebugArgStr ++ ", " ++ cur_table_node_name ++ ");\n",
+ MarkActiveFailCode = "\t" ++ MarkActiveFailMacroName ++
+ "(" ++ DebugArgStr ++ ", " ++ cur_table_node_name ++ ");\n",
+
+ table_generate_foreign_proc(MarkInactivePredName, det,
tabling_c_attributes, [TableTipArg], [],
- "", MarkInactiveCode, "", impure_code, [],
+ MarkInactiveCode, impure_code, [],
ModuleInfo, Context, MarkInactiveGoal),
- table_generate_foreign_proc(MarkInactiveFailPred, failure,
+ table_generate_foreign_proc(MarkInactiveFailPredName, failure,
tabling_c_attributes, [TableTipArg], [],
- "", MarkInactiveFailCode, "", impure_code, [],
+ MarkInactiveFailCode, impure_code, [],
ModuleInfo, Context, MarkInactiveFailGoal),
- table_generate_foreign_proc(MarkActiveFailPred, failure,
+ table_generate_foreign_proc(MarkActiveFailPredName, failure,
tabling_c_attributes, [TableTipArg], [],
- "", MarkActiveFailCode, "", impure_code, [],
- ModuleInfo, Context, MarkActiveFailGoal)
- ),
+ MarkActiveFailCode, impure_code, [],
+ ModuleInfo, Context, MarkActiveFailGoal),
determinism_to_code_model(Detism, CodeModel),
set.list_to_set([TableTipVar | HeadVars], InactiveNonLocals),
@@ -705,7 +719,7 @@
;
CodeModel = model_semi,
goal_info_get_instmap_delta(OrigGoalInfo, InstMapDelta),
- create_renaming(OutputVars, InstMapDelta, !VarTypes, !VarSet,
+ create_renaming(OutputVars, InstMapDelta, !VarSet, !VarTypes,
Unifies, NewVars, Renaming),
rename_vars_in_goal(Renaming, OrigGoal, RenamedOrigGoal),
@@ -875,15 +889,15 @@
% and filling it in, we call table_memo_mark_as_succeeded.
:- pred create_new_memo_goal(determinism::in, hlds_goal::in,
- pred_id::in, proc_id::in, bool::in, list(prog_var)::in,
+ bool::in, maybe(int)::in, pred_id::in, proc_id::in, list(prog_var)::in,
list(var_mode_pos_method)::in, list(var_mode_pos_method)::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
table_info::in, table_info::out, prog_var::out, hlds_goal::out,
list(table_trie_step)::out) is det.
-create_new_memo_goal(Detism, OrigGoal, PredId, ProcId,
- TablingViaExtraArgs, HeadVars, NumberedInputVars, NumberedOutputVars,
- !VarTypes, !VarSet, !TableInfo, TableTipVar, Goal, Steps) :-
+create_new_memo_goal(Detism, OrigGoal, Statistics, _MaybeSizeLimit,
+ PredId, ProcId, HeadVars, NumberedInputVars, NumberedOutputVars,
+ !VarSet, !VarTypes, !TableInfo, TableTipVar, Goal, Steps) :-
% Even if the original goal doesn't use all of the headvars,
% the code generated by the tabling transformation does,
% so we need to compute the nonlocals from the headvars rather
@@ -898,30 +912,31 @@
(
CodeModel = model_det,
StatusType = memo_det_status_type,
- SetupPred = "table_memo_det_setup"
+ SetupPredName = "table_memo_det_setup_shortcut",
+ SetupMacroName = "MR_tbl_memo_det_setup"
;
CodeModel = model_semi,
StatusType = memo_semi_status_type,
- SetupPred = "table_memo_semi_setup"
+ SetupPredName = "table_memo_semi_setup_shortcut",
+ SetupMacroName = "MR_tbl_memo_semi_setup"
;
CodeModel = model_non,
unexpected(this_file, "create_new_memo_goal: model_non")
),
- generate_simple_call_table_lookup_goal(StatusType, SetupPred,
- NumberedInputVars, PredId, ProcId, TablingViaExtraArgs,
- Context, !VarTypes, !VarSet, !TableInfo, TableTipVar, StatusVar,
- LookUpGoal, Steps),
+ generate_simple_call_table_lookup_goal(StatusType,
+ SetupPredName, SetupMacroName, NumberedInputVars,
+ PredId, ProcId, Statistics, Context, !VarSet, !VarTypes,
+ !TableInfo, TableTipVar, StatusVar, LookUpGoal, Steps),
generate_error_goal(!.TableInfo, Context, infinite_recursion_msg,
- !VarTypes, !VarSet, ActiveGoal),
+ !VarSet, !VarTypes, ActiveGoal),
list.length(NumberedOutputVars, BlockSize),
- generate_memo_save_goals(NumberedOutputVars, TableTipVar, BlockSize,
- TablingViaExtraArgs, Context, !VarTypes, !VarSet, !TableInfo,
- SaveAnswerGoals),
+ generate_memo_save_goal(NumberedOutputVars, TableTipVar, BlockSize,
+ Context, !VarSet, !VarTypes, !TableInfo, SaveAnswerGoals),
generate_memo_restore_goal(NumberedOutputVars, OrigInstMapDelta,
- TableTipVar, ModuleInfo, TablingViaExtraArgs, Context,
- !VarTypes, !VarSet, RestoreAnswerGoal),
+ TableTipVar, Context, !VarSet, !VarTypes, !.TableInfo,
+ RestoreAnswerGoal),
SucceededGoal = RestoreAnswerGoal,
set.list_to_set([TableTipVar | HeadVars], InactiveNonLocals),
@@ -944,34 +959,29 @@
]
;
CodeModel = model_semi,
- create_renaming(OutputVars, OrigInstMapDelta, !VarTypes, !VarSet,
+ create_renaming(OutputVars, OrigInstMapDelta, !VarSet, !VarTypes,
Unifies, NewVars, Renaming),
rename_vars_in_goal(Renaming, OrigGoal, RenamedOrigGoal),
ThenGoalExpr = conj(plain_conj, Unifies ++ SaveAnswerGoals),
- list.append([TableTipVar | OutputVars], NewVars, ThenVars),
+ ThenVars = [TableTipVar | OutputVars] ++ NewVars,
set.list_to_set(ThenVars, ThenNonLocals),
goal_info_init_hide(ThenNonLocals, InactiveInstmapDelta,
det, purity_impure, Context, ThenGoalInfo),
ThenGoal = ThenGoalExpr - ThenGoalInfo,
- MarkAsFailedPred = "table_memo_mark_as_failed",
- (
- TablingViaExtraArgs = yes,
+ MarkAsFailedPredName = "table_memo_mark_as_failed",
+ MarkAsFailedMacroName = "MR_tbl_memo_mark_as_failed",
TableTipArg = foreign_arg(TableTipVar,
yes(cur_table_node_name - in_mode), trie_node_type,
native_if_possible),
- MarkAsFailedCode = "MR_" ++ MarkAsFailedPred ++
- "(" ++ cur_table_node_name ++ ");",
- table_generate_foreign_proc(MarkAsFailedPred, failure,
+ DebugArgStr = get_debug_arg_string(!.TableInfo),
+ MarkAsFailedCode = MarkAsFailedMacroName ++
+ "(" ++ DebugArgStr ++ ", " ++ cur_table_node_name ++ ");",
+ table_generate_foreign_proc(MarkAsFailedPredName, failure,
tabling_c_attributes, [TableTipArg], [],
- "", MarkAsFailedCode, "", impure_code, [],
- ModuleInfo, Context, ElseGoal)
- ;
- TablingViaExtraArgs = no,
- generate_call("table_memo_mark_as_failed", failure, [TableTipVar],
- impure_code, [], ModuleInfo, Context, ElseGoal)
- ),
+ MarkAsFailedCode, impure_code, [],
+ ModuleInfo, Context, ElseGoal),
InactiveGoalExpr = if_then_else([], RenamedOrigGoal,
ThenGoal, ElseGoal),
goal_info_init_hide(InactiveNonLocals, InactiveInstmapDelta, Detism,
@@ -1000,15 +1010,16 @@
Goal = GoalExpr - GoalInfo.
:- pred create_new_memo_non_goal(determinism::in, hlds_goal::in,
- pred_id::in, proc_id::in, list(prog_var)::in,
+ bool::in, maybe(int)::in, pred_id::in, proc_id::in, list(prog_var)::in,
list(var_mode_pos_method)::in, list(var_mode_pos_method)::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
table_info::in, table_info::out, prog_var::out, hlds_goal::out,
- list(table_trie_step)::out) is det.
+ list(table_trie_step)::out, list(table_trie_step)::out) is det.
-create_new_memo_non_goal(Detism, OrigGoal, PredId, ProcId,
- HeadVars, NumberedInputVars, NumberedOutputVars, !VarTypes, !VarSet,
- !TableInfo, RecordVar, Goal, Steps) :-
+create_new_memo_non_goal(Detism, OrigGoal, Statistics, _MaybeSizeLimit,
+ PredId, ProcId, HeadVars, NumberedInputVars, NumberedOutputVars,
+ !VarSet, !VarTypes, !TableInfo, RecordVar, Goal,
+ InputSteps, OutputSteps) :-
% Even if the original goal doesn't use all of the headvars,
% the code generated by the tabling transformation does,
% so we need to compute the nonlocals from the headvars rather
@@ -1022,44 +1033,52 @@
list.length(NumberedOutputVars, BlockSize),
generate_error_goal(!.TableInfo, Context, infinite_recursion_msg,
- !VarTypes, !VarSet, InfiniteRecursionGoal),
+ !VarSet, !VarTypes, InfiniteRecursionGoal),
generate_error_goal(!.TableInfo, Context, need_minimal_model_msg,
- !VarTypes, !VarSet, NeedMinModelGoal),
+ !VarSet, !VarTypes, NeedMinModelGoal),
generate_memo_non_call_table_lookup_goal(NumberedInputVars,
- PredId, ProcId, Context, !VarTypes, !VarSet, !TableInfo,
- RecordVar, StatusVar, LookUpGoal, Steps),
- generate_memo_non_save_goals(NumberedOutputVars, RecordVar,
- BlockSize, Context, !VarTypes, !VarSet, !TableInfo, SaveAnswerGoals),
+ PredId, ProcId, Statistics, Context, !VarSet, !VarTypes,
+ !TableInfo, RecordVar, StatusVar, LookUpGoal, InputSteps),
+ generate_memo_non_save_goals(NumberedOutputVars, PredId, ProcId,
+ RecordVar, BlockSize, Statistics, Context, !VarSet, !VarTypes,
+ !TableInfo, OutputSteps, SaveAnswerGoals),
generate_memo_non_restore_goal(Detism, NumberedOutputVars,
- OrigInstMapDelta, RecordVar, ModuleInfo, Context,
- !VarTypes, !VarSet, RestoreAllAnswerGoal),
+ OrigInstMapDelta, RecordVar, Context,
+ !VarSet, !VarTypes, !.TableInfo, RestoreAllAnswerGoal),
RecordVarName = memo_non_record_name,
RecordArg = foreign_arg(RecordVar,
yes(RecordVarName - in_mode), memo_non_record_type,
native_if_possible),
- MarkIncompletePred = "table_memo_mark_as_incomplete",
- MarkActivePred = "table_memo_mark_as_active_and_fail",
- MarkCompletePred = "table_memo_mark_as_complete_and_fail",
- MarkIncompleteCode = "MR_" ++ MarkIncompletePred ++ "(" ++
- RecordVarName ++ ");\n",
- MarkActiveCode = "MR_" ++ MarkActivePred ++ "(" ++
- RecordVarName ++ ");\n",
- MarkCompleteCode = "MR_" ++ MarkCompletePred ++ "(" ++
- RecordVarName ++ ");\n",
- table_generate_foreign_proc(MarkIncompletePred, det,
+
+ MarkIncompletePredName = "table_memo_mark_as_incomplete",
+ MarkIncompleteMacroName = "MR_tbl_memo_mark_as_incomplete",
+ MarkActivePredName = "table_memo_mark_as_active_and_fail",
+ MarkActiveMacroName = "MR_tbl_memo_mark_as_active_and_fail",
+ MarkCompletePredName = "table_memo_mark_as_complete_and_fail",
+ MarkCompleteMacroName = "MR_tbl_memo_mark_as_complete_and_fail",
+
+ DebugArgStr = get_debug_arg_string(!.TableInfo),
+ MarkIncompleteCode = MarkIncompleteMacroName ++
+ "(" ++ DebugArgStr ++ ", " ++ RecordVarName ++ ");\n",
+ MarkActiveCode = MarkActiveMacroName ++
+ "(" ++ DebugArgStr ++ ", " ++ RecordVarName ++ ");\n",
+ MarkCompleteCode = MarkCompleteMacroName ++
+ "(" ++ DebugArgStr ++ ", " ++ RecordVarName ++ ");\n",
+
+ table_generate_foreign_proc(MarkIncompletePredName, det,
tabling_c_attributes, [RecordArg], [],
- "", MarkIncompleteCode, "", impure_code, [],
+ MarkIncompleteCode, impure_code, [],
ModuleInfo, Context, MarkIncompleteGoal),
- table_generate_foreign_proc(MarkActivePred, failure,
+ table_generate_foreign_proc(MarkActivePredName, failure,
tabling_c_attributes, [RecordArg], [],
- "", MarkActiveCode, "", impure_code, [],
+ MarkActiveCode, impure_code, [],
ModuleInfo, Context, MarkActiveGoal),
- table_generate_foreign_proc(MarkCompletePred, failure,
+ table_generate_foreign_proc(MarkCompletePredName, failure,
tabling_c_attributes, [RecordArg], [],
- "", MarkCompleteCode, "", impure_code, [],
+ MarkCompleteCode, impure_code, [],
ModuleInfo, Context, MarkCompleteGoal),
OrigSaveExpr = conj(plain_conj, [OrigGoal | SaveAnswerGoals]),
@@ -1175,18 +1194,17 @@
% generate will fill in the slots containing this extra information before
% it executes the original goal.
-:- pred table_gen.create_new_io_goal(hlds_goal::in, table_io_is_decl::in,
- table_io_is_unitize::in, bool::in, pred_id::in, proc_id::in, bool::in,
+:- pred create_new_io_goal(hlds_goal::in, table_io_is_decl::in,
+ table_io_is_unitize::in, bool::in, pred_id::in, proc_id::in,
assoc_list(prog_var, mer_mode)::in,
list(var_mode_pos_method)::in, list(var_mode_pos_method)::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
table_info::in, table_info::out,
hlds_goal::out, maybe(proc_table_info)::out) is det.
-table_gen.create_new_io_goal(OrigGoal, TableDecl, Unitize, TableIoStates,
- PredId, ProcId, TablingViaExtraArgs, HeadVarModes,
- OrigInputVars, OrigOutputVars, !VarTypes, !VarSet,
- !TableInfo, Goal, MaybeProcTableInfo) :-
+create_new_io_goal(OrigGoal, TableDecl, Unitize, TableIoStates,
+ PredId, ProcId, HeadVarModes, OrigInputVars, OrigOutputVars,
+ !VarSet, !VarTypes, !TableInfo, Goal, MaybeProcTableInfo) :-
OrigGoal = _ - OrigGoalInfo,
ModuleInfo0 = !.TableInfo ^ table_module_info,
module_info_pred_info(ModuleInfo0, PredId, PredInfo),
@@ -1220,26 +1238,26 @@
SavedHeadVars = HeadVarModes
;
TableIoStates = no,
- list.filter(table_gen.var_mode_pos_is_io_state(!.VarTypes),
+ list.filter(var_mode_pos_is_io_state(!.VarTypes),
OrigOutputVars, IoStateAssignToVars, MisNumberedSavedOutputVars),
reallocate_slot_numbers(MisNumberedSavedOutputVars, 0,
SavedOutputVars),
- list.filter(table_gen.var_mode_pos_is_io_state(!.VarTypes),
+ list.filter(var_mode_pos_is_io_state(!.VarTypes),
OrigInputVars, IoStateAssignFromVars, _MisNumberedSavedInputVars),
- list.filter(table_gen.var_mode_is_io_state(!.VarTypes),
+ list.filter(var_mode_is_io_state(!.VarTypes),
HeadVarModes, _, SavedHeadVars)
),
- generate_new_table_var("TableVar", trie_node_type, !VarTypes, !VarSet,
+ generate_new_table_var("TableVar", trie_node_type, !VarSet, !VarTypes,
TableVar),
- generate_new_table_var("CounterVar", int_type, !VarTypes, !VarSet,
+ generate_new_table_var("CounterVar", int_type, !VarSet, !VarTypes,
CounterVar),
- generate_new_table_var("StartVar", int_type, !VarTypes, !VarSet,
+ generate_new_table_var("StartVar", int_type, !VarSet, !VarTypes,
StartVar),
generate_call("table_io_in_range", semidet,
[TableVar, CounterVar, StartVar], impure_code,
ground_vars([TableVar, CounterVar, StartVar]),
ModuleInfo, Context, InRangeGoal),
- generate_new_table_var("TipVar", trie_node_type, !VarTypes, !VarSet,
+ generate_new_table_var("TipVar", trie_node_type, !VarSet, !VarTypes,
TipVar),
generate_call("table_lookup_insert_start_int", det,
[TableVar, StartVar, CounterVar, TipVar], impure_code,
@@ -1252,7 +1270,7 @@
TableIoDeclConsId = table_io_decl(ShroudedPredProcId),
make_const_construction_alloc(TableIoDeclConsId, c_pointer_type,
yes("TableIoDeclPtr"), TableIoDeclGoal, TableIoDeclPtrVar,
- !VarTypes, !VarSet),
+ !VarSet, !VarTypes),
allocate_plain_slot_numbers(SavedHeadVars, 1, NumberedSavedHeadVars),
NumberedSaveVars = [
var_mode_pos_method(TableIoDeclPtrVar, in_mode, 0, unit)
@@ -1279,8 +1297,7 @@
list.length(NumberedSaveVars, BlockSize),
goal_info_get_instmap_delta(OrigGoalInfo, OrigInstMapDelta),
generate_memo_restore_goal(NumberedRestoreVars, OrigInstMapDelta, TipVar,
- ModuleInfo, TablingViaExtraArgs, Context, !VarTypes, !VarSet,
- RestoreAnswerGoal0),
+ Context, !VarSet, !VarTypes, !.TableInfo, RestoreAnswerGoal0),
(
TableIoStates = yes,
RestoreAnswerGoal = RestoreAnswerGoal0
@@ -1294,7 +1311,7 @@
IoStateAssignToVar = project_var(IoStateAssignToVarPrime)
;
% The call to proc_info_has_io_state_pair in
- % table_gen.process_procs should ensure that we never get here.
+ % table_gen_process_procs should ensure that we never get here.
unexpected(this_file,
"create_new_io_goal: one in / one out violation")
),
@@ -1320,16 +1337,15 @@
RestoreAnswerGoalInfo),
RestoreAnswerGoal = RestoreAnswerGoalExpr - RestoreAnswerGoalInfo
),
- generate_memo_save_goals(NumberedSaveVars, TipVar, BlockSize,
- TablingViaExtraArgs, Context, !VarTypes, !VarSet, !TableInfo,
- SaveAnswerGoals),
+ generate_memo_save_goal(NumberedSaveVars, TipVar, BlockSize,
+ Context, !VarSet, !VarTypes, !TableInfo, SaveAnswerGoals),
(
Unitize = table_io_alone,
CallSaveAnswerGoalList = [NewGoal, TableIoDeclGoal | SaveAnswerGoals]
;
Unitize = table_io_unitize,
generate_new_table_var("SavedTraceEnabled", int_type,
- !VarTypes, !VarSet, SavedTraceEnabledVar),
+ !VarSet, !VarTypes, SavedTraceEnabledVar),
generate_call("table_io_left_bracket_unitized_goal", det,
[SavedTraceEnabledVar], impure_code,
ground_vars([SavedTraceEnabledVar]),
@@ -1437,16 +1453,16 @@
% )
% ).
-:- pred table_gen.create_new_mm_goal(determinism::in,
- hlds_goal::in, pred_id::in, proc_id::in, bool::in, list(prog_var)::in,
+:- pred create_new_mm_goal(determinism::in, hlds_goal::in,
+ bool::in, pred_id::in, proc_id::in, list(prog_var)::in,
list(var_mode_pos_method)::in, list(var_mode_pos_method)::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
table_info::in, table_info::out, prog_var::out, hlds_goal::out,
- list(table_trie_step)::out) is det.
+ list(table_trie_step)::out, list(table_trie_step)::out) is det.
-table_gen.create_new_mm_goal(Detism, OrigGoal, PredId, ProcId,
- TablingViaExtraArgs, HeadVars, NumberedInputVars, NumberedOutputVars,
- !VarTypes, !VarSet, !TableInfo, SubgoalVar, Goal, Steps) :-
+create_new_mm_goal(Detism, OrigGoal, Statistics, PredId, ProcId,
+ HeadVars, NumberedInputVars, NumberedOutputVars, !VarSet, !VarTypes,
+ !TableInfo, SubgoalVar, Goal, InputSteps, OutputSteps) :-
% Even if the original goal doesn't use all of the headvars,
% the code generated by the tabling transformation does,
% so we need to compute the nonlocals from the headvars rather
@@ -1459,17 +1475,16 @@
ModuleInfo = !.TableInfo ^ table_module_info,
list.length(NumberedOutputVars, BlockSize),
generate_mm_call_table_lookup_goal(NumberedInputVars, PredId, ProcId,
- TablingViaExtraArgs, Context, !VarTypes, !VarSet, !TableInfo,
- SubgoalVar, StatusVar, LookUpGoal, Steps),
- generate_mm_save_goals(NumberedOutputVars, SubgoalVar, BlockSize,
- TablingViaExtraArgs, Context, !VarTypes, !VarSet, !TableInfo,
- SaveAnswerGoals),
+ Statistics, Context, !VarSet, !VarTypes, !TableInfo,
+ SubgoalVar, StatusVar, LookUpGoal, InputSteps),
+ generate_mm_save_goals(NumberedOutputVars, SubgoalVar, PredId, ProcId,
+ BlockSize, Statistics, Context, !VarSet, !VarTypes, !TableInfo,
+ OutputSteps, SaveAnswerGoals),
generate_mm_restore_goal(Detism, NumberedOutputVars, OrigInstMapDelta,
- SubgoalVar, ModuleInfo, TablingViaExtraArgs, Context,
- !VarTypes, !VarSet, RestoreAllAnswerGoal),
+ SubgoalVar, Context, !VarSet, !VarTypes, !.TableInfo,
+ RestoreAllAnswerGoal),
generate_mm_suspend_goal(NumberedOutputVars, OrigInstMapDelta,
- SubgoalVar, ModuleInfo, TablingViaExtraArgs, Context,
- !VarTypes, !VarSet, SuspendGoal),
+ SubgoalVar, Context, !VarSet, !VarTypes, !.TableInfo, SuspendGoal),
MainExpr = conj(plain_conj, [OrigGoal | SaveAnswerGoals]),
set.insert_list(OrigNonLocals, [SubgoalVar, StatusVar], MainNonLocals),
@@ -1546,16 +1561,18 @@
% impure table_mmos_consume_next_answer_nondet(Consumer, AnswerBlock),
% impure table_restore_int_ans(AnswerBlock, 0, B).
-:- pred table_gen.do_own_stack_transform(determinism::in, hlds_goal::in,
+:- pred do_own_stack_transform(determinism::in, hlds_goal::in, bool::in,
pred_id::in, proc_id::in, pred_info::in, proc_info::in, list(prog_var)::in,
list(var_mode_pos_method)::in, list(var_mode_pos_method)::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
table_info::in, table_info::out, generator_map::in, generator_map::out,
- hlds_goal::out, list(table_trie_step)::out) is det.
+ hlds_goal::out, list(table_trie_step)::out, list(table_trie_step)::out)
+ is det.
-table_gen.do_own_stack_transform(Detism, OrigGoal, PredId, ProcId,
+do_own_stack_transform(Detism, OrigGoal, Statistics, PredId, ProcId,
PredInfo0, ProcInfo0, HeadVars, NumberedInputVars, NumberedOutputVars,
- !VarTypes, !VarSet, !TableInfo, !GenMap, Goal, Steps) :-
+ !VarSet, !VarTypes, !TableInfo, !GenMap, Goal,
+ InputSteps, OutputSteps) :-
PredName = pred_info_name(PredInfo0),
( map.search(!.GenMap, PredId, GeneratorPredIdPrime) ->
GeneratorPredId = GeneratorPredIdPrime
@@ -1583,19 +1600,19 @@
GeneratorPredType = c_pointer_type,
generate_new_table_var("GeneratorPredVar", GeneratorPredType,
- !VarTypes, !VarSet, GeneratorPredVar),
- generate_new_table_var("Consumer", consumer_type, !VarTypes, !VarSet,
- ConsumerVar),
+ !VarSet, !VarTypes, GeneratorPredVar),
+ generate_new_table_var("Consumer", consumer_type,
+ !VarSet, !VarTypes, ConsumerVar),
ShroudedPredProcId = shroud_pred_proc_id(proc(GeneratorPredId, ProcId)),
GeneratorConsId = pred_const(ShroudedPredProcId, lambda_normal),
make_const_construction(GeneratorPredVar, GeneratorConsId,
MakeGeneratorVarGoal),
- generate_call_table_lookup_goals(NumberedInputVars,
- PredId, ProcId, Context, !VarTypes, !VarSet, !TableInfo, _TableTipVar,
- _LookupGoals, Steps, PredTableVar, LookupForeignArgs,
- LookupPrefixGoals, LookupCodeStr),
+ generate_call_table_lookup_goals(NumberedInputVars, PredId, ProcId,
+ Statistics, Context, !VarSet, !VarTypes, !TableInfo, InputSteps,
+ _TableTipVar, _TableTipArg, InfoArg, LookupForeignArgs,
+ LookupPrefixGoals, LookupCodeStr, _CallTableTipAssignStr),
InputVarModes = list.map(project_mode, NumberedInputVars),
assoc_list.from_corresponding_lists(LookupForeignArgs, InputVarModes,
@@ -1605,10 +1622,7 @@
GeneratorPredVarName = generator_pred_name,
ConsumerVarName = consumer_name,
- PredTableVarName = pred_table_name,
- PredTableArg = foreign_arg(PredTableVar,
- yes(PredTableVarName - in_mode), trie_node_type, native_if_possible),
GeneratorPredArg = foreign_arg(GeneratorPredVar,
yes(generator_pred_name - in_mode), GeneratorPredType,
native_if_possible),
@@ -1619,15 +1633,14 @@
"\tMR_TrieNode " ++ cur_table_node_name ++ ";\n" ++
"\tMR_TrieNode " ++ next_table_node_name ++ ";\n" ++
"\tMR_GeneratorPtr " ++ generator_name ++ ";\n\n" ++
- "\t" ++ cur_table_node_name ++ " = " ++ PredTableVarName ++ ";\n" ++
LookupCodeStr,
- SetupPred = "table_mmos_setup_consumer",
+ SetupPredName = "table_mmos_setup_consumer",
SetupCode = "\t" ++ generator_name ++ " = " ++
cur_table_node_name ++ "->MR_generator;\n" ++
"\tif (" ++ generator_name ++ " == NULL) {\n" ++
SaveInputVarCode ++
- "\t\t" ++ generator_name ++ " = MR_table_mmos_setup_generator(" ++
+ "\t\t" ++ generator_name ++ " = MR_tbl_mmos_setup_generator(" ++
cur_table_node_name ++ ",\n\t\t\t"
++ int_to_string(NumInputVars) ++ ", "
++ GeneratorPredVarName ++ ", " ++
@@ -1635,24 +1648,24 @@
"\t\tMR_mmos_new_generator = " ++ generator_name ++ ";\n" ++
"\t}\n" ++
"\t" ++ consumer_name ++ " = " ++
- "MR_table_mmos_setup_consumer(" ++ generator_name ++
+ "MR_tbl_mmos_setup_consumer(" ++ generator_name ++
", """ ++ PredName ++ """);\n",
- table_generate_foreign_proc(SetupPred, det, make_generator_c_attributes,
- [PredTableArg, GeneratorPredArg, ConsumerArg], LookupForeignArgs,
- LookupDeclCodeStr, SetupCode, "", impure_code,
+ table_generate_foreign_proc(SetupPredName, det,
+ make_generator_c_attributes,
+ [InfoArg, GeneratorPredArg, ConsumerArg], LookupForeignArgs,
+ LookupDeclCodeStr ++ SetupCode, impure_code,
ground_vars([ConsumerVar]), ModuleInfo, Context, SetupGoal),
% We don't attach the call_table_tip attribute to the setup goal, since
% retrying across the creation of the generator should not require undoing
% the creation of the generator. Of course, for this to work *properly*,
% the runtime system and the debugger will need to cooperate to effectively
% present to the user a distinct sequence of trace events for each context.
- % In any case,
% attach_call_table_tip(SetupGoal0, SetupGoal),
LookupSetupGoals = [MakeGeneratorVarGoal | LookupPrefixGoals]
++ [SetupGoal],
generate_new_table_var("AnswerBlock", answer_block_type,
- !VarTypes, !VarSet, AnswerBlockVar),
+ !VarSet, !VarTypes, AnswerBlockVar),
( Detism = multidet ->
ConsumePredName = "table_mmos_consume_next_answer_multi"
; Detism = nondet ->
@@ -1664,16 +1677,17 @@
generate_call(ConsumePredName, Detism, [ConsumerVar, AnswerBlockVar],
impure_code, ground_vars([AnswerBlockVar]), ModuleInfo, Context,
GetNextAnswerGoal),
+ DebugArgStr = get_debug_arg_string(!.TableInfo),
generate_restore_goals(NumberedOutputVars, OrigInstMapDelta,
- AnswerBlockVar, ModuleInfo, Context, !VarTypes, !VarSet, _RestoreGoals,
- RestoreInstMapDeltaSrc, RestoreArgs, RestoreCodeStr),
+ DebugArgStr, ModuleInfo, !VarSet, !VarTypes, RestoreInstMapDeltaSrc,
+ RestoreArgs, RestoreCodeStr),
AnswerBlockArg = foreign_arg(AnswerBlockVar,
yes(answer_block_name - in_mode), answer_block_type,
native_if_possible),
RestoreAllPredName = "table_mmos_restore_answers",
table_generate_foreign_proc(RestoreAllPredName, det, tabling_c_attributes,
- [AnswerBlockArg], RestoreArgs, "", "", RestoreCodeStr,
- impure_code, RestoreInstMapDeltaSrc, ModuleInfo, Context, RestoreGoal),
+ [AnswerBlockArg], RestoreArgs, RestoreCodeStr, impure_code,
+ RestoreInstMapDeltaSrc, ModuleInfo, Context, RestoreGoal),
GoalExpr = conj(plain_conj,
LookupSetupGoals ++ [GetNextAnswerGoal, RestoreGoal]),
@@ -1685,11 +1699,11 @@
table_info_init(ModuleInfo, GeneratorPredInfo, ProcInfo0,
GeneratorTableInfo0),
do_own_stack_create_generator(GeneratorPredId, ProcId, GeneratorPredInfo,
- ProcInfo0, Context, GeneratorPredVar,
+ ProcInfo0, Statistics, Context, GeneratorPredVar,
PickupInputVarCode, PickupForeignArgs,
NumberedInputVars, NumberedOutputVars,
OrigNonLocals, OrigInstMapDelta, !.VarTypes, !.VarSet,
- GeneratorTableInfo0, GeneratorTableInfo),
+ GeneratorTableInfo0, GeneratorTableInfo, OutputSteps),
!:TableInfo = !.TableInfo ^ table_module_info :=
GeneratorTableInfo ^ table_module_info.
@@ -1720,16 +1734,18 @@
PickupArgs, SaveVarCodes, PickupVarCodes).
:- pred do_own_stack_create_generator(pred_id::in, proc_id::in,
- pred_info::in, proc_info::in, term.context::in, prog_var::in, string::in,
- list(foreign_arg)::in,
+ pred_info::in, proc_info::in, bool::in, term.context::in,
+ prog_var::in, string::in, list(foreign_arg)::in,
list(var_mode_pos_method)::in, list(var_mode_pos_method)::in,
set(prog_var)::in, instmap_delta::in,
- vartypes::in, prog_varset::in, table_info::in, table_info::out) is det.
+ vartypes::in, prog_varset::in, table_info::in, table_info::out,
+ list(table_trie_step)::out) is det.
-do_own_stack_create_generator(PredId, ProcId, !.PredInfo, !.ProcInfo, Context,
- GeneratorVar, PickupVarCode, PickupForeignArgs,
- NumberedInputVars, NumberedOutputVars,
- OrigNonLocals, OrigInstMapDelta, !.VarTypes, !.VarSet, !TableInfo) :-
+do_own_stack_create_generator(PredId, ProcId, !.PredInfo, !.ProcInfo,
+ Statistics, Context, GeneratorVar, PickupVarCode,
+ PickupForeignArgs, NumberedInputVars, NumberedOutputVars,
+ OrigNonLocals, OrigInstMapDelta, !.VarTypes, !.VarSet, !TableInfo,
+ OutputSteps) :-
ModuleInfo0 = !.TableInfo ^ table_module_info,
proc_info_set_headvars(list.map(project_var, NumberedOutputVars),
@@ -1746,12 +1762,13 @@
yes(generator_name - out_mode), generator_type, native_if_possible),
table_generate_foreign_proc("table_mmos_pickup_inputs", det,
tabling_c_attributes, [PickupGeneratorArg], PickupForeignArgs,
- "", PickupGeneratorCode, PickupVarCode, semipure_code,
+ PickupGeneratorCode ++ PickupVarCode, semipure_code,
PickupInstMapDeltaSrc, ModuleInfo0, Context, PickupGoal),
list.length(NumberedOutputVars, BlockSize),
- generate_own_stack_save_goal(NumberedOutputVars, GeneratorVar, BlockSize,
- Context, !VarTypes, !VarSet, !TableInfo, SaveAnswerGoals),
+ generate_own_stack_save_goal(NumberedOutputVars, GeneratorVar,
+ PredId, ProcId, BlockSize, Statistics, Context, !VarSet, !VarTypes,
+ !TableInfo, OutputSteps, SaveAnswerGoals),
proc_info_get_goal(!.ProcInfo, OrigGoal),
GoalExpr = conj(plain_conj, [PickupGoal, OrigGoal | SaveAnswerGoals]),
@@ -1842,10 +1859,9 @@
proc_info_get_inferred_determinism(ProcInfo, ProcDetism),
proc_info_get_goal(ProcInfo, ProcGoal),
proc_info_get_rtti_varmaps(ProcInfo, ProcRttiVarMaps),
- proc_info_create(ProcContext, ProcVarSet, ProcVarTypes,
- ProcHeadVars, ProcInstVarSet, ProcHeadModes,
- ProcDetism, ProcGoal, ProcRttiVarMaps, address_is_not_taken,
- NewProcInfo),
+ proc_info_create(ProcContext, ProcVarSet, ProcVarTypes, ProcHeadVars,
+ ProcInstVarSet, ProcHeadModes, ProcDetism, ProcGoal, ProcRttiVarMaps,
+ address_is_not_taken, NewProcInfo),
ModuleName = pred_info_module(PredInfo),
OrigPredName = pred_info_name(PredInfo),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
@@ -1859,9 +1875,9 @@
pred_info_get_assertions(PredInfo, PredAssertions),
pred_info_get_markers(PredInfo, Markers),
pred_info_create(ModuleName, NewPredName, PredOrFunc, PredContext,
- created(io_tabling), local, Markers, PredArgTypes,
- PredTypeVarSet, PredExistQVars, PredClassContext,
- PredAssertions, NewProcInfo, NewProcId, NewPredInfo),
+ created(io_tabling), local, Markers, PredArgTypes, PredTypeVarSet,
+ PredExistQVars, PredClassContext, PredAssertions,
+ NewProcInfo, NewProcId, NewPredInfo),
module_info_get_predicate_table(!.ModuleInfo, PredicateTable0),
predicate_table_insert(NewPredInfo, NewPredId,
PredicateTable0, PredicateTable),
@@ -1913,98 +1929,69 @@
%-----------------------------------------------------------------------------%
-:- pred generate_gen_proc_table_info(table_info::in, list(table_trie_step)::in,
+:- pred generate_gen_proc_table_info(table_info::in,
+ list(table_trie_step)::in, maybe(list(table_trie_step))::in,
list(var_mode_method)::in, list(var_mode_method)::in,
proc_table_info::out) is det.
-generate_gen_proc_table_info(TableInfo, Steps, InputVars, OutputVars,
- ProcTableInfo) :-
+generate_gen_proc_table_info(TableInfo, InputSteps, MaybeOutputSteps,
+ InputVars, OutputVars, ProcTableInfo) :-
ProcInfo = TableInfo ^ table_cur_proc_info,
- list.append(InputVars, OutputVars, InOutHeadVars),
+ InOutHeadVars = InputVars ++ OutputVars,
allocate_slot_numbers(InOutHeadVars, 1, NumberedInOutHeadVars),
ArgInfos = list.map(project_var_pos, NumberedInOutHeadVars),
continuation_info.generate_table_arg_type_info(ProcInfo, ArgInfos,
TableArgTypeInfo),
NumInputs = list.length(InputVars),
NumOutputs = list.length(OutputVars),
- ProcTableInfo = table_gen_info(NumInputs, NumOutputs, Steps,
- TableArgTypeInfo).
+ ProcTableInfo = table_gen_info(NumInputs, NumOutputs, InputSteps,
+ MaybeOutputSteps, TableArgTypeInfo).
%-----------------------------------------------------------------------------%
% Generate a goal for doing lookups in call tables for
% loopcheck and memo predicates.
%
-:- pred generate_simple_call_table_lookup_goal(mer_type::in, string::in,
- list(var_mode_pos_method)::in, pred_id::in, proc_id::in, bool::in,
- term.context::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
+:- pred generate_simple_call_table_lookup_goal(mer_type::in,
+ string::in, string::in, list(var_mode_pos_method)::in,
+ pred_id::in, proc_id::in, bool::in, term.context::in,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
table_info::in, table_info::out, prog_var::out, prog_var::out,
hlds_goal::out, list(table_trie_step)::out) is det.
-generate_simple_call_table_lookup_goal(StatusType, SetupPred,
- NumberedVars, PredId, ProcId, TablingViaExtraArgs, Context,
- !VarTypes, !VarSet, !TableInfo, TableTipVar, StatusVar, Goal, Steps) :-
- generate_call_table_lookup_goals(NumberedVars, PredId, ProcId, Context,
- !VarTypes, !VarSet, !TableInfo, TableTipVar, LookupGoals, Steps,
- PredTableVar, LookupForeignArgs, LookupPrefixGoals, LookupCodeStr),
- generate_new_table_var("Status", StatusType, !VarTypes, !VarSet,
+generate_simple_call_table_lookup_goal(StatusType, PredName,
+ SetupMacroName, NumberedVars, PredId, ProcId, Statistics, Context,
+ !VarSet, !VarTypes, !TableInfo, TableTipVar, StatusVar, Goal, Steps) :-
+ generate_call_table_lookup_goals(NumberedVars, PredId, ProcId,
+ Statistics, Context, !VarSet, !VarTypes, !TableInfo, Steps,
+ TableTipVar, TableTipArg, InfoArg, LookupForeignArgs,
+ LookupPrefixGoals, LookupCodeStr, CallTableTipAssignStr),
+ generate_new_table_var("Status", StatusType, !VarSet, !VarTypes,
StatusVar),
ModuleInfo = !.TableInfo ^ table_module_info,
- (
- TablingViaExtraArgs = yes,
- PredTableVarName = pred_table_name,
- TableTipVarName = table_tip_node_name,
+
StatusVarName = status_name,
- PredTableArg = foreign_arg(PredTableVar,
- yes(PredTableVarName - in_mode), trie_node_type,
- native_if_possible),
- TableTipArg = foreign_arg(TableTipVar,
- yes(TableTipVarName - out_mode), trie_node_type,
- native_if_possible),
StatusArg = foreign_arg(StatusVar,
yes(StatusVarName - out_mode), StatusType, native_if_possible),
- MainPredCodeStr = "\tMR_" ++ SetupPred ++ "(" ++
+ DebugArgStr = get_debug_arg_string(!.TableInfo),
+ BackArgStr = get_back_arg_string(!.TableInfo),
+ MainPredCodeStr = "\t" ++ SetupMacroName ++ "(" ++
+ DebugArgStr ++ ", " ++ BackArgStr ++ ", " ++
cur_table_node_name ++ ", " ++ StatusVarName ++ ");\n",
- (
- NumberedVars = [_ | _],
- Args = [PredTableArg, TableTipArg, StatusArg],
+ Args = [InfoArg, TableTipArg, StatusArg],
BoundVars = [TableTipVar, StatusVar],
- CalledPred = SetupPred ++ "_shortcut",
- TableTipAssignStr = MainPredCodeStr ++ "\t" ++ TableTipVarName ++
- " = " ++ cur_table_node_name ++ ";\n",
- PredCodeStr = "\tMR_" ++ CalledPred ++ "(" ++
- cur_table_node_name ++ ", " ++ TableTipVarName ++ ", " ++
- StatusVarName ++ ");\n"
- ;
- NumberedVars = [],
- Args = [PredTableArg, StatusArg],
- BoundVars = [StatusVar],
- CalledPred = SetupPred,
- TableTipAssignStr = "",
- PredCodeStr = MainPredCodeStr
- ),
- LookupDeclCodeStr =
+ CodeStr =
"\tMR_TrieNode " ++ cur_table_node_name ++ ";\n" ++
- "\tMR_TrieNode " ++ next_table_node_name ++ ";\n" ++
- "\t" ++ cur_table_node_name ++ " = " ++
- PredTableVarName ++ ";\n" ++
+ "\tMR_TrieNode " ++ next_table_node_name ++ ";\n\n" ++
LookupCodeStr ++
- TableTipAssignStr,
- table_generate_foreign_proc(CalledPred, det, tabling_c_attributes,
- Args, LookupForeignArgs, LookupDeclCodeStr,
- PredCodeStr, "", impure_code, ground_vars(BoundVars),
- ModuleInfo, Context, SetupGoal0),
- attach_call_table_tip(SetupGoal0, SetupGoal),
- list.append(LookupPrefixGoals, [SetupGoal], LookupSetupGoals)
- ;
- TablingViaExtraArgs = no,
- generate_call(SetupPred, det, [TableTipVar, StatusVar],
- impure_code, ground_vars([StatusVar]),
+ CallTableTipAssignStr ++
+ MainPredCodeStr,
+ table_generate_foreign_proc(PredName, det, tabling_c_attributes,
+ Args, LookupForeignArgs, CodeStr, impure_code, ground_vars(BoundVars),
ModuleInfo, Context, SetupGoal0),
attach_call_table_tip(SetupGoal0, SetupGoal),
- list.append(LookupGoals, [SetupGoal], LookupSetupGoals)
- ),
+ LookupSetupGoals = LookupPrefixGoals ++ [SetupGoal],
+
GoalExpr = conj(plain_conj, LookupSetupGoals),
Vars = list.map(project_var, NumberedVars),
set.list_to_set([StatusVar, TableTipVar | Vars], NonLocals),
@@ -2016,49 +2003,50 @@
% model_non memo predicates.
%
:- pred generate_memo_non_call_table_lookup_goal(list(var_mode_pos_method)::in,
- pred_id::in, proc_id::in, term.context::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
+ pred_id::in, proc_id::in, bool::in, term.context::in,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
table_info::in, table_info::out, prog_var::out, prog_var::out,
hlds_goal::out, list(table_trie_step)::out) is det.
-generate_memo_non_call_table_lookup_goal(NumberedVars,
- PredId, ProcId, Context, !VarTypes, !VarSet, !TableInfo,
+generate_memo_non_call_table_lookup_goal(NumberedVars, PredId, ProcId,
+ Statistics, Context, !VarSet, !VarTypes, !TableInfo,
RecordVar, StatusVar, Goal, Steps) :-
- generate_call_table_lookup_goals(NumberedVars,
- PredId, ProcId, Context, !VarTypes, !VarSet, !TableInfo,
- _TableTipVar, _LookupGoals, Steps, PredTableVar,
- LookupForeignArgs, LookupPrefixGoals, LookupCodeStr),
+ generate_call_table_lookup_goals(NumberedVars, PredId, ProcId,
+ Statistics, Context, !VarSet, !VarTypes, !TableInfo, Steps,
+ _TableTipVar, _TableTipArg, InfoArg, LookupForeignArgs,
+ LookupPrefixGoals, LookupCodeStr, _CallTableTipAssignStr),
ModuleInfo = !.TableInfo ^ table_module_info,
- generate_new_table_var("Record", memo_non_record_type, !VarTypes, !VarSet,
+ generate_new_table_var("Record", memo_non_record_type, !VarSet, !VarTypes,
RecordVar),
- generate_new_table_var("Status", memo_non_status_type, !VarTypes, !VarSet,
+ generate_new_table_var("Status", memo_non_status_type, !VarSet, !VarTypes,
StatusVar),
- SetupPred = "table_memo_non_setup",
+ SetupPredName = "table_memo_non_setup",
+ SetupMacroName = "MR_tbl_memo_non_setup",
BoundVars = [RecordVar, StatusVar],
- PredTableVarName = pred_table_name,
RecordVarName = memo_non_record_name,
StatusVarName = status_name,
- PredTableArg = foreign_arg(PredTableVar,
- yes(PredTableVarName - in_mode), trie_node_type, native_if_possible),
RecordArg = foreign_arg(RecordVar,
yes(RecordVarName - out_mode), memo_non_record_type,
native_if_possible),
StatusArg = foreign_arg(StatusVar,
yes(StatusVarName - out_mode), memo_non_status_type,
native_if_possible),
- Args = [PredTableArg, RecordArg, StatusArg],
+ Args = [InfoArg, RecordArg, StatusArg],
LookupDeclCodeStr =
"\tMR_TrieNode " ++ cur_table_node_name ++ ";\n" ++
- "\tMR_TrieNode " ++ next_table_node_name ++ ";\n" ++
- "\t" ++ cur_table_node_name ++ " = " ++ PredTableVarName ++ ";\n" ++
+ "\tMR_TrieNode " ++ next_table_node_name ++ ";\n\n" ++
LookupCodeStr,
- PredCodeStr = "\tMR_" ++ SetupPred ++ "(" ++ cur_table_node_name ++ ", " ++
- RecordVarName ++ ", " ++ StatusVarName ++ ");\n",
- table_generate_foreign_proc(SetupPred, det, tabling_c_attributes, Args,
- LookupForeignArgs, LookupDeclCodeStr, PredCodeStr, "", impure_code,
+ DebugArgStr = get_debug_arg_string(!.TableInfo),
+ BackArgStr = get_back_arg_string(!.TableInfo),
+ PredCodeStr = "\t" ++ SetupMacroName ++ "(" ++
+ DebugArgStr ++ ", " ++ BackArgStr ++ ", " ++
+ cur_table_node_name ++ ", " ++ RecordVarName ++ ", " ++
+ StatusVarName ++ ");\n",
+ table_generate_foreign_proc(SetupPredName, det, tabling_c_attributes, Args,
+ LookupForeignArgs, LookupDeclCodeStr ++ PredCodeStr, impure_code,
ground_vars(BoundVars), ModuleInfo, Context, SetupGoal0),
attach_call_table_tip(SetupGoal0, SetupGoal),
- list.append(LookupPrefixGoals, [SetupGoal], LookupSetupGoals),
+ LookupSetupGoals = LookupPrefixGoals ++ [SetupGoal],
GoalExpr = conj(plain_conj, LookupSetupGoals),
Vars = list.map(project_var, NumberedVars),
@@ -2072,60 +2060,49 @@
%
:- pred generate_mm_call_table_lookup_goal(list(var_mode_pos_method)::in,
pred_id::in, proc_id::in, bool::in, term.context::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
table_info::in, table_info::out, prog_var::out, prog_var::out,
hlds_goal::out, list(table_trie_step)::out) is det.
generate_mm_call_table_lookup_goal(NumberedVars, PredId, ProcId,
- TablingViaExtraArgs, Context, !VarTypes, !VarSet, !TableInfo,
+ Statistics, Context, !VarSet, !VarTypes, !TableInfo,
SubgoalVar, StatusVar, Goal, Steps) :-
generate_call_table_lookup_goals(NumberedVars, PredId, ProcId,
- Context, !VarTypes, !VarSet, !TableInfo, TableTipVar, LookupGoals,
- Steps, PredTableVar, LookupForeignArgs, LookupPrefixGoals,
- LookupCodeStr),
- ModuleInfo = !.TableInfo ^ table_module_info,
- generate_new_table_var("Subgoal", subgoal_type, !VarTypes, !VarSet,
+ Statistics, Context, !VarSet, !VarTypes, !TableInfo, Steps,
+ _TableTipVar, _TableTipArg, InfoArg, LookupForeignArgs,
+ LookupPrefixGoals, LookupCodeStr, _CallTableTipAssignStr),
+ generate_new_table_var("Subgoal", subgoal_type, !VarSet, !VarTypes,
SubgoalVar),
- generate_new_table_var("Status", mm_status_type, !VarTypes, !VarSet,
+ generate_new_table_var("Status", mm_status_type, !VarSet, !VarTypes,
StatusVar),
- SetupPred = "table_mm_setup",
+ SetupPredName = "table_mm_setup",
+ SetupMacroName = "MR_tbl_mm_setup",
BoundVars = [SubgoalVar, StatusVar],
- (
- TablingViaExtraArgs = yes,
- PredTableVarName = pred_table_name,
+
SubgoalVarName = subgoal_name,
StatusVarName = status_name,
- PredTableArg = foreign_arg(PredTableVar,
- yes(PredTableVarName - in_mode), trie_node_type,
- native_if_possible),
SubgoalArg = foreign_arg(SubgoalVar,
yes(SubgoalVarName - out_mode), subgoal_type, native_if_possible),
StatusArg = foreign_arg(StatusVar,
yes(StatusVarName - out_mode), mm_status_type, native_if_possible),
- Args = [PredTableArg, SubgoalArg, StatusArg],
- LookupDeclCodeStr =
+ Args = [InfoArg, SubgoalArg, StatusArg],
+ LookupDeclStr =
"\tMR_TrieNode " ++ cur_table_node_name ++ ";\n" ++
- "\tMR_TrieNode " ++ next_table_node_name ++ ";\n" ++
- "\t" ++ cur_table_node_name ++ " = " ++
- PredTableVarName ++ ";\n" ++
- LookupCodeStr,
- PredCodeStr = "\tMR_" ++ SetupPred ++ "(" ++
+ "\tMR_TrieNode " ++ next_table_node_name ++ ";\n\n",
+ DebugArgStr = get_debug_arg_string(!.TableInfo),
+ BackArgStr = get_back_arg_string(!.TableInfo),
+ SetupCodeStr = "\t" ++ SetupMacroName ++ "(" ++
+ DebugArgStr ++ ", " ++ BackArgStr ++ ", " ++
cur_table_node_name ++ ", " ++ SubgoalVarName ++ ", " ++
StatusVarName ++ ");\n",
- table_generate_foreign_proc(SetupPred, det, tabling_c_attributes,
- Args, LookupForeignArgs, LookupDeclCodeStr,
- PredCodeStr, "", impure_code, ground_vars(BoundVars),
- ModuleInfo, Context, SetupGoal0),
- attach_call_table_tip(SetupGoal0, SetupGoal),
- list.append(LookupPrefixGoals, [SetupGoal], LookupSetupGoals)
- ;
- TablingViaExtraArgs = no,
- generate_call(SetupPred, det,
- [TableTipVar, SubgoalVar, StatusVar], impure_code,
+ CodeStr = LookupDeclStr ++ LookupCodeStr ++ SetupCodeStr,
+ ModuleInfo = !.TableInfo ^ table_module_info,
+ table_generate_foreign_proc(SetupPredName, det, tabling_c_attributes,
+ Args, LookupForeignArgs, CodeStr, impure_code,
ground_vars(BoundVars), ModuleInfo, Context, SetupGoal0),
attach_call_table_tip(SetupGoal0, SetupGoal),
- list.append(LookupGoals, [SetupGoal], LookupSetupGoals)
- ),
+ LookupSetupGoals = LookupPrefixGoals ++ [SetupGoal],
+
GoalExpr = conj(plain_conj, LookupSetupGoals),
Vars = list.map(project_var, NumberedVars),
set.list_to_set([StatusVar, SubgoalVar | Vars], NonLocals),
@@ -2135,37 +2112,116 @@
%-----------------------------------------------------------------------------%
-% Utility predicates used when creating call table lookup goals.
+% Utility predicates used when creating table lookup goals.
:- pred generate_call_table_lookup_goals(list(var_mode_pos_method)::in,
- pred_id::in, proc_id::in, term.context::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
- table_info::in, table_info::out, prog_var::out,
- list(hlds_goal)::out, list(table_trie_step)::out, prog_var::out,
- list(foreign_arg)::out, list(hlds_goal)::out, string::out) is det.
+ pred_id::in, proc_id::in, bool::in, term.context::in,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
+ table_info::in, table_info::out, list(table_trie_step)::out,
+ prog_var::out, foreign_arg::out, foreign_arg::out, list(foreign_arg)::out,
+ list(hlds_goal)::out, string::out, string::out) is det.
generate_call_table_lookup_goals(NumberedVars, PredId, ProcId,
- Context, !VarTypes, !VarSet, !TableInfo, TableTipVar, Goals, Steps,
- PredTableVar, ForeignArgs, PrefixGoals, CodeStr) :-
- generate_get_table_goal(PredId, ProcId, !VarTypes, !VarSet,
- PredTableVar, GetTableGoal),
- generate_table_lookup_goals(NumberedVars, "CallTableNode",
- Context, PredTableVar, TableTipVar, !VarTypes, !VarSet, !TableInfo,
- LookupGoals, Steps, ForeignArgs, LookupPrefixGoals, CodeStr),
- Goals = [GetTableGoal | LookupGoals],
- PrefixGoals = [GetTableGoal | LookupPrefixGoals].
+ Statistics, Context, !VarSet, !VarTypes, !TableInfo, InputSteps,
+ CallTableTipVar, CallTableTipArg, InfoArg, LookupArgs,
+ PrefixGoals, MainCodeStr, CallTableTipVarCodeStr) :-
+ InfoToPtrCodeStr = "\t" ++ cur_table_node_name ++ " = " ++
+ "&" ++ proc_table_info_name ++ "->MR_pt_tablenode;\n",
+ generate_get_table_info_goal(PredId, ProcId, !VarSet, !VarTypes,
+ proc_table_info_name, InfoArg, GetTableInfoGoal),
+ DebugArgStr = get_debug_arg_string(!.TableInfo),
+ BackArgStr = get_back_arg_string(!.TableInfo),
+ generate_table_lookup_goals(NumberedVars, Statistics, call_table,
+ DebugArgStr, BackArgStr, Context, !VarSet, !VarTypes, !TableInfo,
+ InputSteps, LookupArgs, LookupPrefixGoals, LookupCodeStr),
+ PrefixGoals = [GetTableInfoGoal] ++ LookupPrefixGoals,
+ % We ignore _StatsPrefixGoals and _StatsExtraArgs because we always
+ % include ProcTableInfoVar in the arguments.
+ maybe_lookup_not_dupl_code_args(PredId, ProcId,
+ proc_table_info_name, cur_table_node_name,
+ Statistics, call_table, !VarSet, !VarTypes,
+ _StatsPrefixGoals, _StatsExtraArgs, StatsCodeStr),
+ MainCodeStr = InfoToPtrCodeStr ++ LookupCodeStr ++ StatsCodeStr,
+ CallTableTipVarName = "CallTableTipVar",
+ generate_new_table_var(CallTableTipVarName, trie_node_type,
+ !VarSet, !VarTypes, CallTableTipVar),
+ CallTableTipArg = foreign_arg(CallTableTipVar,
+ yes(CallTableTipVarName - out_mode), trie_node_type,
+ native_if_possible),
+ CallTableTipVarCodeStr =
+ "\t" ++ CallTableTipVarName ++ " = " ++ cur_table_node_name ++ ";\n".
-:- pred generate_get_table_goal(pred_id::in, proc_id::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
- prog_var::out, hlds_goal::out) is det.
+:- pred generate_answer_table_lookup_goals(list(var_mode_pos_method)::in,
+ pred_id::in, proc_id::in, bool::in, term.context::in,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
+ table_info::in, table_info::out, list(table_trie_step)::out,
+ list(foreign_arg)::out, list(hlds_goal)::out, string::out) is det.
-generate_get_table_goal(PredId, ProcId, !VarTypes, !VarSet, PredTableVar,
- Goal) :-
- generate_new_table_var("PredTable", trie_node_type, !VarTypes, !VarSet,
- PredTableVar),
+generate_answer_table_lookup_goals(NumberedVars, PredId, ProcId, Statistics,
+ Context, !VarSet, !VarTypes, !TableInfo, OutputSteps, ForeignArgs,
+ PrefixGoals, CodeStr) :-
+ DebugArgStr = get_debug_arg_string(!.TableInfo),
+ BackArgStr = "MR_FALSE",
+ generate_table_lookup_goals(NumberedVars, Statistics, answer_table,
+ DebugArgStr, BackArgStr, Context, !VarSet, !VarTypes, !TableInfo,
+ OutputSteps, LookupArgs, LookupPrefixGoals, LookupCodeStr),
+ maybe_lookup_not_dupl_code_args(PredId, ProcId,
+ proc_table_info_name, cur_table_node_name,
+ Statistics, call_table, !VarSet, !VarTypes,
+ StatsPrefixGoals, StatsExtraArgs, StatsCodeStr),
+ CodeStr = LookupCodeStr ++ StatsCodeStr,
+ ForeignArgs = StatsExtraArgs ++ LookupArgs,
+ PrefixGoals = StatsPrefixGoals ++ LookupPrefixGoals.
+
+:- pred maybe_lookup_not_dupl_code_args(pred_id::in, proc_id::in,
+ string::in, string::in, bool::in, call_or_answer_table::in,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
+ list(hlds_goal)::out, list(foreign_arg)::out, string::out) is det.
+
+maybe_lookup_not_dupl_code_args(PredId, ProcId, InfoVarName, TipVarName,
+ Statistics, Kind, !VarSet, !VarTypes, PrefixGoals, Args, CodeStr) :-
+ (
+ Statistics = no,
+ PrefixGoals = [],
+ Args = [],
+ CodeStr = ""
+ ;
+ Statistics = yes,
+ generate_get_table_info_goal(PredId, ProcId, !VarSet, !VarTypes,
+ InfoVarName, Arg, Goal),
+ PrefixGoals = [Goal],
+ Args = [Arg],
+ CodeStr = lookup_not_dupl_code(InfoVarName, TipVarName, Kind)
+ ).
+
+:- func lookup_not_dupl_code(string, string, call_or_answer_table) = string.
+
+lookup_not_dupl_code(InfoVar, TipVar, call_table) =
+ "\t" ++ InfoVar ++ "->MR_pt_call_table_lookups++;\n" ++
+ "\tif (" ++ TipVar ++ "->MR_integer != 0) {\n" ++
+ "\t\t" ++ InfoVar ++ "->MR_pt_call_table_not_dupl++;\n" ++
+ "\t}\n".
+lookup_not_dupl_code(InfoVar, TipVar, answer_table) =
+ "\t" ++ InfoVar ++ "->MR_pt_answer_table_lookups++;\n" ++
+ "\tif (" ++ TipVar ++ "->MR_integer != 0) {\n" ++
+ "\t\t" ++ InfoVar ++ "->MR_pt_answer_table_not_dupl++;\n" ++
+ "\t}\n".
+
+:- pred generate_get_table_info_goal(pred_id::in, proc_id::in,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
+ string::in, foreign_arg::out, hlds_goal::out) is det.
+
+generate_get_table_info_goal(PredId, ProcId, !VarSet, !VarTypes,
+ InfoVarName, Arg, Goal) :-
+ generate_new_table_var("ProcTableInfo", proc_table_info_type,
+ !VarSet, !VarTypes, ProcTableInfoVar),
+ Arg = foreign_arg(ProcTableInfoVar,
+ yes(InfoVarName - in_mode), proc_table_info_type,
+ native_if_possible),
ShroudedPredProcId = shroud_pred_proc_id(proc(PredId, ProcId)),
- ConsId = tabling_pointer_const(ShroudedPredProcId),
- make_const_construction(PredTableVar, ConsId, GoalExpr - GoalInfo0),
+ InfoConsId = tabling_info_const(ShroudedPredProcId),
+ make_const_construction(ProcTableInfoVar, InfoConsId,
+ GoalExpr - GoalInfo0),
goal_info_add_feature(impure_goal, GoalInfo0, GoalInfo),
Goal = GoalExpr - GoalInfo.
@@ -2182,18 +2238,18 @@
% The generated code is used for lookups in both call tables
% and answer tables.
%
-:- pred generate_table_lookup_goals(list(var_mode_pos_method)::in, string::in,
- term.context::in, prog_var::in, prog_var::out,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
- table_info::in, table_info::out, list(hlds_goal)::out,
- list(table_trie_step)::out, list(foreign_arg)::out,
- list(hlds_goal)::out, string::out) is det.
+:- pred generate_table_lookup_goals(list(var_mode_pos_method)::in,
+ bool::in, call_or_answer_table::in,
+ string::in, string::in, term.context::in,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
+ table_info::in, table_info::out, list(table_trie_step)::out,
+ list(foreign_arg)::out, list(hlds_goal)::out, string::out) is det.
-generate_table_lookup_goals([], _, _, !TableVar, !VarTypes, !VarSet,
- !TableInfo, [], [], [], [], "").
-generate_table_lookup_goals([VarModePos | NumberedVars],
- Prefix, Context, !TableVar, !VarTypes, !VarSet, !TableInfo,
- Goals ++ RestGoals, [Step | Steps], ForeignArgs ++ RestForeignArgs,
+generate_table_lookup_goals([], _, _, _, _, _, !VarSet, !VarTypes, !TableInfo,
+ [], [], [], "").
+generate_table_lookup_goals([VarModePos | NumberedVars], Statistics,
+ Kind, DebugArgStr, BackArgStr, Context, !VarSet, !VarTypes, !TableInfo,
+ [Step | Steps], ForeignArgs ++ RestForeignArgs,
PrefixGoals ++ RestPrefixGoals, CodeStr ++ RestCodeStr) :-
VarModePos = var_mode_pos_method(Var, _, VarSeqNum, ArgMethod),
ModuleInfo = !.TableInfo ^ table_module_info,
@@ -2201,41 +2257,36 @@
classify_type(ModuleInfo, VarType) = TypeCat,
(
ArgMethod = arg_promise_implied,
- Goals = [],
Step = table_trie_step_promise_implied,
ForeignArgs = [],
PrefixGoals = [],
CodeStr = "\t/* promise_implied for " ++ arg_name(VarSeqNum) ++ " */\n"
;
- ArgMethod = arg_value,
- gen_lookup_call_for_type(ArgMethod, TypeCat, VarType, Var,
- Prefix, VarSeqNum, Context, !VarTypes, !VarSet, !TableInfo,
- !TableVar, Goals, Step, ForeignArgs, PrefixGoals, CodeStr)
- ;
- ArgMethod = arg_addr,
- gen_lookup_call_for_type(ArgMethod, TypeCat, VarType, Var,
- Prefix, VarSeqNum, Context, !VarTypes, !VarSet, !TableInfo,
- !TableVar, Goals, Step, ForeignArgs, PrefixGoals, CodeStr)
+ ( ArgMethod = arg_value
+ ; ArgMethod = arg_addr
),
- generate_table_lookup_goals(NumberedVars, Prefix, Context,
- !TableVar, !VarTypes, !VarSet, !TableInfo, RestGoals, Steps,
- RestForeignArgs, RestPrefixGoals, RestCodeStr).
+ gen_lookup_call_for_type(ArgMethod, TypeCat, VarType, Var,
+ VarSeqNum, Statistics, Kind, DebugArgStr, BackArgStr, Context,
+ !VarSet, !VarTypes, !TableInfo, Step, ForeignArgs,
+ PrefixGoals, CodeStr)
+ ),
+ generate_table_lookup_goals(NumberedVars, Statistics, Kind,
+ DebugArgStr, BackArgStr, Context, !VarSet, !VarTypes, !TableInfo,
+ Steps, RestForeignArgs, RestPrefixGoals, RestCodeStr).
:- pred gen_lookup_call_for_type(arg_tabling_method::in, type_category::in,
- mer_type::in, prog_var::in, string::in, int::in, term.context::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
- table_info::in, table_info::out, prog_var::in, prog_var::out,
- list(hlds_goal)::out, table_trie_step::out,
- list(foreign_arg)::out, list(hlds_goal)::out, string::out) is det.
+ mer_type::in, prog_var::in, int::in, bool::in, call_or_answer_table::in,
+ string::in, string::in, term.context::in,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
+ table_info::in, table_info::out,
+ table_trie_step::out, list(foreign_arg)::out, list(hlds_goal)::out,
+ string::out) is det.
-gen_lookup_call_for_type(ArgTablingMethod, TypeCat, Type, ArgVar, Prefix,
- VarSeqNum, Context, !VarTypes, !VarSet, !TableInfo, TableVar,
- NextTableVar, Goals, Step, ExtraArgs, PrefixGoals, CodeStr) :-
+gen_lookup_call_for_type(ArgTablingMethod, TypeCat, Type, ArgVar,
+ VarSeqNum, Statistics, Kind, DebugArgStr, BackArgStr, Context,
+ !VarSet, !VarTypes, !TableInfo, Step, ExtraArgs, PrefixGoals,
+ CodeStr) :-
ModuleInfo = !.TableInfo ^ table_module_info,
- VarName = Prefix ++ int_to_string(VarSeqNum),
- generate_new_table_var(VarName, trie_node_type, !VarTypes, !VarSet,
- NextTableVar),
- BindNextTableVar = ground_vars([NextTableVar]),
ArgName = arg_name(VarSeqNum),
ForeignArg = foreign_arg(ArgVar, yes(ArgName - in_mode), Type,
native_if_possible),
@@ -2254,18 +2305,13 @@
unexpected(this_file,
"gen_lookup_call_for_type: enum type is not du_type?")
),
- gen_int_construction("RangeVar", EnumRange, !VarTypes,
- !VarSet, RangeVar, RangeUnifyGoal),
- LookupPredName = "table_lookup_insert_enum",
- generate_call(LookupPredName, det,
- [TableVar, RangeVar, ArgVar, NextTableVar],
- impure_code, BindNextTableVar,
- ModuleInfo, Context, LookupGoal),
- Goals = [RangeUnifyGoal, LookupGoal],
+ LookupMacroName = "MR_tbl_lookup_insert_enum",
Step = table_trie_step_enum(EnumRange),
PrefixGoals = [],
ExtraArgs = [ForeignArg],
- CodeStr0 = "\tMR_" ++ LookupPredName ++ "(" ++
+ StatsArgStr = stats_arg(Statistics, Kind, VarSeqNum),
+ CodeStr0 = "\t" ++ LookupMacroName ++ "(" ++ StatsArgStr ++ ", " ++
+ DebugArgStr ++ ", " ++ BackArgStr ++ ", " ++
cur_table_node_name ++ ", " ++ int_to_string(EnumRange) ++
", " ++ ArgName ++ ", " ++ next_table_node_name ++ ");\n"
;
@@ -2273,9 +2319,6 @@
"gen_lookup_call_for_type: unexpected enum type")
)
; TypeCat = type_cat_dummy ->
- generate_call("unify", det, [TableVar, NextTableVar],
- impure_code, BindNextTableVar, ModuleInfo, Context, SetEqualGoal),
- Goals = [SetEqualGoal],
Step = table_trie_step_dummy,
PrefixGoals = [],
ExtraArgs = [],
@@ -2290,22 +2333,22 @@
ArgTablingMethod = arg_value,
(
TypeVars = [],
- LookupPredName = "table_lookup_insert_user",
+ LookupMacroName = "MR_tbl_lookup_insert_user",
Step = table_trie_step_user(Type)
;
TypeVars = [_ | _],
- LookupPredName = "table_lookup_insert_poly",
+ LookupMacroName = "MR_tbl_lookup_insert_poly",
Step = table_trie_step_poly
)
;
ArgTablingMethod = arg_addr,
(
TypeVars = [],
- LookupPredName = "table_lookup_insert_user_fast_loose",
+ LookupMacroName = "MR_tbl_lookup_insert_user_addr",
Step = table_trie_step_user_fast_loose(Type)
;
TypeVars = [_ | _],
- LookupPredName = "table_lookup_insert_poly_fast_loose",
+ LookupMacroName = "MR_tbl_lookup_insert_poly_addr",
Step = table_trie_step_poly_fast_loose
)
;
@@ -2313,32 +2356,27 @@
unexpected(this_file,
"gen_lookup_call_for_type: arg_promise_implied")
),
- make_type_info_var(Type, Context, !VarTypes, !VarSet,
- !TableInfo, TypeInfoVar, ExtraGoals),
- generate_call(LookupPredName, det,
- [TypeInfoVar, TableVar, ArgVar, NextTableVar],
- impure_code, BindNextTableVar, ModuleInfo, Context, CallGoal),
- Goals = ExtraGoals ++ [CallGoal],
- PrefixGoals = ExtraGoals,
+ table_gen_make_type_info_var(Type, Context, !VarSet, !VarTypes,
+ !TableInfo, TypeInfoVar, PrefixGoals),
TypeInfoArgName = "input_typeinfo" ++ int_to_string(VarSeqNum),
map.lookup(!.VarTypes, TypeInfoVar, TypeInfoType),
ForeignTypeInfoArg = foreign_arg(TypeInfoVar,
yes(TypeInfoArgName - in_mode), TypeInfoType,
native_if_possible),
ExtraArgs = [ForeignTypeInfoArg, ForeignArg],
- CodeStr0 = "\tMR_" ++ LookupPredName ++ "(" ++
+ StatsArgStr = stats_arg(Statistics, Kind, VarSeqNum),
+ CodeStr0 = "\t" ++ LookupMacroName ++ "(" ++ StatsArgStr ++ ", " ++
+ DebugArgStr ++ ", " ++ BackArgStr ++ ", " ++
cur_table_node_name ++ ", " ++ TypeInfoArgName ++ ", " ++
ArgName ++ ", " ++ next_table_node_name ++ ");\n"
;
MaybeCatStringStep = yes(CatString - Step),
- LookupPredName = "table_lookup_insert_" ++ CatString,
- generate_call(LookupPredName, det,
- [TableVar, ArgVar, NextTableVar],
- impure_code, BindNextTableVar, ModuleInfo, Context, Goal),
- Goals = [Goal],
+ LookupMacroName = "MR_tbl_lookup_insert_" ++ CatString,
PrefixGoals = [],
ExtraArgs = [ForeignArg],
- CodeStr0 = "\tMR_" ++ LookupPredName ++ "(" ++
+ StatsArgStr = stats_arg(Statistics, Kind, VarSeqNum),
+ CodeStr0 = "\t" ++ LookupMacroName ++ "(" ++ StatsArgStr ++ ", " ++
+ DebugArgStr ++ ", " ++ BackArgStr ++ ", " ++
cur_table_node_name ++ ", " ++ ArgName ++ ", " ++
next_table_node_name ++ ");\n"
)
@@ -2351,143 +2389,123 @@
% Generate a goal for saving the output arguments in an answer block
% in memo predicates.
%
-:- pred generate_memo_save_goals(list(var_mode_pos_method(T))::in,
- prog_var::in, int::in, bool::in, term.context::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
+:- pred generate_memo_save_goal(list(var_mode_pos_method(T))::in,
+ prog_var::in, int::in, term.context::in,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
table_info::in, table_info::out, list(hlds_goal)::out) is det.
-generate_memo_save_goals(NumberedSaveVars, TableTipVar, BlockSize,
- TablingViaExtraArgs, Context, !VarTypes, !VarSet, !TableInfo, Goals) :-
+generate_memo_save_goal(NumberedSaveVars, TableTipVar, BlockSize,
+ Context, !VarSet, !VarTypes, !TableInfo, Goals) :-
ModuleInfo = !.TableInfo ^ table_module_info,
+ TipVarName = cur_table_node_name,
+ TableArg = foreign_arg(TableTipVar, yes(TipVarName - in_mode),
+ trie_node_type, native_if_possible),
( BlockSize > 0 ->
- CreatePredName = "table_memo_create_answer_block",
- ShortcutPredName = "table_memo_fill_answer_block_shortcut",
- generate_all_save_goals(NumberedSaveVars, TableTipVar, trie_node_type,
- base_name, BlockSize, CreatePredName, ShortcutPredName,
- TablingViaExtraArgs, Context, !VarTypes, !VarSet, !TableInfo,
- Goals, _, _)
- ;
- MarkAsSucceededPred = "table_memo_mark_as_succeeded",
- (
- TablingViaExtraArgs = yes,
- TableArg = foreign_arg(TableTipVar,
- yes(cur_table_node_name - in_mode), trie_node_type,
- native_if_possible),
- MarkAsSucceededCode = "MR_" ++ MarkAsSucceededPred ++
+ CreatePredName = "table_memo_fill_answer_block_shortcut",
+ CreateMacroName = "MR_tbl_memo_create_answer_block",
+ generate_all_save_goals(NumberedSaveVars, TipVarName,
+ BlockSize, CreateMacroName, Context, !VarSet, !VarTypes,
+ !TableInfo, SaveArgs, SavePrefixGoals, SaveDeclCode, SaveCode),
+ table_generate_foreign_proc(CreatePredName, det,
+ tabling_c_attributes, [TableArg], SaveArgs,
+ SaveDeclCode ++ SaveCode, impure_code, [],
+ ModuleInfo, Context, SaveGoal),
+ Goals = SavePrefixGoals ++ [SaveGoal]
+ ;
+ MarkAsSucceededPredName = "table_memo_mark_as_succeeded",
+ MarkAsSucceededMacroName = "MR_tbl_memo_mark_as_succeeded",
+ MarkAsSucceededCode = MarkAsSucceededMacroName ++
"(" ++ cur_table_node_name ++ ");",
- table_generate_foreign_proc(MarkAsSucceededPred, det,
+ table_generate_foreign_proc(MarkAsSucceededPredName, det,
tabling_c_attributes, [TableArg], [],
- "", MarkAsSucceededCode, "", impure_code, [],
- ModuleInfo, Context, Goal)
- ;
- TablingViaExtraArgs = no,
- generate_call(MarkAsSucceededPred, det, [TableTipVar],
- impure_code, [], ModuleInfo, Context, Goal)
- ),
- Goals = [Goal]
+ MarkAsSucceededCode, impure_code, [],
+ ModuleInfo, Context, SaveGoal),
+ Goals = [SaveGoal]
).
% Generate a goal for saving the output arguments in an answer block
% in model_non memo predicates.
%
:- pred generate_memo_non_save_goals(list(var_mode_pos_method)::in,
- prog_var::in, int::in, term.context::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
- table_info::in, table_info::out, list(hlds_goal)::out) is det.
-
-generate_memo_non_save_goals(NumberedSaveVars, RecordVar,
- BlockSize, Context, !VarTypes, !VarSet, !TableInfo, Goals) :-
+ pred_id::in, proc_id::in, prog_var::in, int::in,
+ bool::in, term.context::in, prog_varset::in, prog_varset::out,
+ vartypes::in, vartypes::out, table_info::in, table_info::out,
+ list(table_trie_step)::out, list(hlds_goal)::out) is det.
+
+generate_memo_non_save_goals(NumberedSaveVars, PredId, ProcId,
+ RecordVar, BlockSize, Statistics, Context, !VarSet, !VarTypes,
+ !TableInfo, OutputSteps, Goals) :-
ModuleInfo = !.TableInfo ^ table_module_info,
- generate_new_table_var("AnswerTableVar", trie_node_type,
- !VarTypes, !VarSet, AnswerTableVar),
RecordName = memo_non_record_name,
- AnswerTableName = "AnswerTableVar",
RecordArg = foreign_arg(RecordVar,
yes(RecordName - in_mode), memo_non_record_type, native_if_possible),
- AnswerTableArg = foreign_arg(AnswerTableVar,
- yes(AnswerTableName - in_mode), trie_node_type, native_if_possible),
- GetPredName = "table_memo_non_get_answer_table",
- GetPredCode = "\tMR_" ++ GetPredName ++ "(" ++
- RecordName ++ ", " ++ AnswerTableName ++ ");\n",
- table_generate_foreign_proc(GetPredName, det, tabling_c_attributes,
- [RecordArg, AnswerTableArg], [], "", GetPredCode, "",
- semipure_code, ground_vars([AnswerTableVar]),
- ModuleInfo, Context, GetAnswerTableGoal),
- generate_table_lookup_goals(NumberedSaveVars,
- "AnswerTableNode", Context, AnswerTableVar, _AnswerTableTipVar,
- !VarTypes, !VarSet, !TableInfo, _LookupAnswerGoals, _,
+
+ generate_answer_table_lookup_goals(NumberedSaveVars, PredId, ProcId,
+ Statistics, Context, !VarSet, !VarTypes, !TableInfo, OutputSteps,
LookupForeignArgs, LookupPrefixGoals, LookupCodeStr),
- CreateAnswerBlockPred = "table_memo_non_create_answer_block",
- CreateAnswerBlockPredShortcut = CreateAnswerBlockPred ++ "_shortcut",
- generate_all_save_goals(NumberedSaveVars, RecordVar,
- memo_non_record_type, memo_non_record_name, BlockSize,
- CreateAnswerBlockPred, CreateAnswerBlockPredShortcut, yes,
- Context, !VarTypes, !VarSet, !TableInfo, _SaveGoals,
- SaveDeclCode, CreateSaveCode),
-
- GetPredName = "table_memo_non_get_answer_table",
- DuplCheckPredName = "table_memo_non_answer_is_not_duplicate",
- DuplCheckPredNameShortcut = DuplCheckPredName ++ "_shortcut",
+ CreateAnswerBlockMacroName = "MR_tbl_memo_non_create_answer_block",
+ generate_all_save_goals(NumberedSaveVars, memo_non_record_name, BlockSize,
+ CreateAnswerBlockMacroName, Context, !VarSet, !VarTypes, !TableInfo,
+ _SaveForeignArgs, _SavePrefixGoals, SaveDeclCodeStr, CreateSaveCode),
+
+ GetMacroName = "MR_tbl_memo_non_get_answer_table",
+ DuplCheckPredName = "table_memo_non_answer_is_not_duplicate_shortcut",
+ DuplCheckMacroName = "MR_tbl_memo_non_answer_is_not_duplicate",
+ DebugArgStr = get_debug_arg_string(!.TableInfo),
SuccName = "succeeded",
LookupDeclCodeStr =
"\tMR_TrieNode " ++ cur_table_node_name ++ ";\n" ++
"\tMR_TrieNode " ++ next_table_node_name ++ ";\n" ++
"\tMR_bool " ++ SuccName ++ ";\n",
- GetLookupCodeStr =
- "\tMR_" ++ GetPredName ++ "(" ++ RecordName ++ ", " ++
- cur_table_node_name ++ ");\n" ++
+ GetCodeStr =
+ "\t" ++ GetMacroName ++ "(" ++ DebugArgStr ++ ", " ++
+ RecordName ++ ", " ++ cur_table_node_name ++ ");\n" ++
LookupCodeStr,
DuplCheckCodeStr =
- "\tMR_" ++ DuplCheckPredName ++ "(" ++
+ "\t" ++ DuplCheckMacroName ++ "(" ++ DebugArgStr ++ ", " ++
cur_table_node_name ++ ", " ++ SuccName ++ ");\n",
AssignSuccessCodeStr =
"\t" ++ success_indicator_name ++ " = " ++ SuccName ++ ";\n",
- PreStr = LookupDeclCodeStr ++ SaveDeclCode ++ GetLookupCodeStr,
- PostStr = "\tif (" ++ SuccName ++ ") {\n" ++ CreateSaveCode ++ "\t}\n" ++
+ CodeStr = LookupDeclCodeStr ++ SaveDeclCodeStr ++ "\n" ++
+ GetCodeStr ++ LookupCodeStr ++
+ DuplCheckCodeStr ++
+ "\tif (" ++ SuccName ++ ") {\n" ++ CreateSaveCode ++ "\t}\n" ++
AssignSuccessCodeStr,
- table_generate_foreign_proc(DuplCheckPredNameShortcut, semidet,
- tabling_c_attributes, [RecordArg], LookupForeignArgs,
- PreStr, DuplCheckCodeStr, PostStr, impure_code, [],
- ModuleInfo, Context, DuplicateCheckSaveGoal),
- Goals = [GetAnswerTableGoal | LookupPrefixGoals] ++
- [DuplicateCheckSaveGoal].
+ table_generate_foreign_proc(DuplCheckPredName, semidet,
+ tabling_c_attributes, [RecordArg], LookupForeignArgs, CodeStr,
+ impure_code, [], ModuleInfo, Context, DuplicateCheckSaveGoal),
+ Goals = LookupPrefixGoals ++ [DuplicateCheckSaveGoal].
% Generate a goal for saving the output arguments in an answer block
% in minimal model predicates.
%
:- pred generate_mm_save_goals(list(var_mode_pos_method)::in,
- prog_var::in, int::in, bool::in, term.context::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
- table_info::in, table_info::out, list(hlds_goal)::out) is det.
-
-generate_mm_save_goals(NumberedSaveVars, SubgoalVar, BlockSize,
- TablingViaExtraArgs, Context, !VarTypes, !VarSet, !TableInfo, Goals) :-
+ prog_var::in, pred_id::in, proc_id::in, int::in,
+ bool::in, term.context::in, prog_varset::in, prog_varset::out,
+ vartypes::in, vartypes::out, table_info::in, table_info::out,
+ list(table_trie_step)::out, list(hlds_goal)::out) is det.
+
+generate_mm_save_goals(NumberedSaveVars, SubgoalVar, PredId, ProcId, BlockSize,
+ Statistics, Context, !VarSet, !VarTypes, !TableInfo, OutputSteps,
+ Goals) :-
ModuleInfo = !.TableInfo ^ table_module_info,
- generate_new_table_var("AnswerTableVar", trie_node_type,
- !VarTypes, !VarSet, AnswerTableVar),
- GetPredName = "table_mm_get_answer_table",
- generate_call(GetPredName, det, [SubgoalVar, AnswerTableVar],
- semipure_code, ground_vars([AnswerTableVar]),
- ModuleInfo, Context, GetAnswerTableGoal),
- generate_table_lookup_goals(NumberedSaveVars,
- "AnswerTableNode", Context, AnswerTableVar, AnswerTableTipVar,
- !VarTypes, !VarSet, !TableInfo, LookupAnswerGoals, _,
+ DebugArgStr = get_debug_arg_string(!.TableInfo),
+
+ generate_answer_table_lookup_goals(NumberedSaveVars, PredId, ProcId,
+ Statistics, Context, !VarSet, !VarTypes, !TableInfo, OutputSteps,
LookupForeignArgs, LookupPrefixGoals, LookupCodeStr),
- CreatePredName = "table_mm_create_answer_block",
- ShortcutCreatePredName = "table_mm_fill_answer_block_shortcut",
- generate_all_save_goals(NumberedSaveVars,
- SubgoalVar, subgoal_type, subgoal_name, BlockSize,
- CreatePredName, ShortcutCreatePredName, TablingViaExtraArgs,
- Context, !VarTypes, !VarSet, !TableInfo, SaveGoals,
- SaveDeclCode, CreateSaveCode),
+ GetMacroName = "MR_tbl_mm_get_answer_table",
+ CreateMacroName = "MR_tbl_mm_create_answer_block",
+ DuplCheckPredName = "table_mm_answer_is_not_duplicate_shortcut",
+ DuplCheckMacroName = "MR_tbl_mm_answer_is_not_duplicate",
+
+ generate_all_save_goals(NumberedSaveVars, subgoal_name, BlockSize,
+ CreateMacroName, Context, !VarSet, !VarTypes, !TableInfo,
+ _SaveArgs, _SavePrefixGoals, SaveDeclCode, CreateSaveCode),
- DuplCheckPredName = "table_mm_answer_is_not_duplicate",
- DuplCheckPredNameShortCut = DuplCheckPredName ++ "_shortcut",
- (
- TablingViaExtraArgs = yes,
SubgoalName = subgoal_name,
Args = [foreign_arg(SubgoalVar, yes(SubgoalName - in_mode),
subgoal_type, native_if_possible)],
@@ -2496,222 +2514,167 @@
"\tMR_TrieNode " ++ cur_table_node_name ++ ";\n" ++
"\tMR_TrieNode " ++ next_table_node_name ++ ";\n" ++
"\tMR_bool " ++ SuccName ++ ";\n",
- GetLookupCodeStr =
- "\tMR_" ++ GetPredName ++ "(" ++ SubgoalName ++ ", " ++
- cur_table_node_name ++ ");\n" ++
- LookupCodeStr,
+ GetCodeStr =
+ "\t" ++ GetMacroName ++ "(" ++ DebugArgStr ++ ", " ++
+ SubgoalName ++ ", " ++ cur_table_node_name ++ ");\n",
DuplCheckCodeStr =
- "\tMR_" ++ DuplCheckPredName ++ "(" ++
+ "\t" ++ DuplCheckMacroName ++ "(" ++ DebugArgStr ++ ", " ++
cur_table_node_name ++ ", " ++ SuccName ++ ");\n",
+ CondSaveStr = "\tif (" ++ SuccName ++ ") {\n" ++
+ CreateSaveCode ++ "\t}\n",
AssignSuccessCodeStr =
"\t" ++ success_indicator_name ++ " = " ++ SuccName ++ ";\n",
- PreStr = LookupDeclCodeStr ++ SaveDeclCode ++ GetLookupCodeStr,
- PostStr = "\tif (" ++ SuccName ++ ") {\n" ++
- CreateSaveCode ++ "\t}\n" ++
- AssignSuccessCodeStr,
- table_generate_foreign_proc(DuplCheckPredNameShortCut, semidet,
+ CodeStr = LookupDeclCodeStr ++ SaveDeclCode ++
+ GetCodeStr ++ LookupCodeStr ++ DuplCheckCodeStr ++
+ CondSaveStr ++ AssignSuccessCodeStr,
+ table_generate_foreign_proc(DuplCheckPredName, semidet,
tabling_c_attributes, Args, LookupForeignArgs,
- PreStr, DuplCheckCodeStr, PostStr, impure_code, [],
+ CodeStr, impure_code, [],
ModuleInfo, Context, DuplicateCheckSaveGoal),
- list.append(LookupPrefixGoals, [DuplicateCheckSaveGoal], Goals)
- ;
- TablingViaExtraArgs = no,
- generate_call(DuplCheckPredName, semidet, [AnswerTableTipVar],
- impure_code, [], ModuleInfo, Context, DuplicateCheckGoal),
- list.append([GetAnswerTableGoal | LookupAnswerGoals],
- [DuplicateCheckGoal], LookupCheckGoals),
- list.append(LookupCheckGoals, SaveGoals, Goals)
- ).
+ Goals = LookupPrefixGoals ++ [DuplicateCheckSaveGoal].
% Generate a save goal for the given variables.
%
:- pred generate_all_save_goals(list(var_mode_pos_method(T))::in,
- prog_var::in, mer_type::in, string::in, int::in, string::in, string::in,
- bool::in, term.context::in, vartypes::in, vartypes::out,
- prog_varset::in, prog_varset::out, table_info::in, table_info::out,
+ string::in, int::in, string::in, term.context::in,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
+ table_info::in, table_info::out, list(foreign_arg)::out,
list(hlds_goal)::out, string::out, string::out) is det.
-generate_all_save_goals(NumberedSaveVars, BaseVar, BaseVarType, BaseVarName,
- BlockSize, CreatePredName, ShortcutPredName,
- TablingViaExtraArgs, Context, !VarTypes, !VarSet, !TableInfo,
- Goals, SaveDeclCodeStr, CreateSaveCodeStr) :-
- generate_new_table_var("AnswerBlock", answer_block_type,
- !VarTypes, !VarSet, AnswerBlockVar),
- generate_save_goals(NumberedSaveVars, AnswerBlockVar, Context,
- !VarTypes, !VarSet, !TableInfo, SaveGoals,
- SaveArgs, SavePrefixGoals, SaveCodeStr),
- ModuleInfo = !.TableInfo ^ table_module_info,
- (
- TablingViaExtraArgs = yes,
- TableArg = foreign_arg(BaseVar, yes(BaseVarName - in_mode),
- BaseVarType, native_if_possible),
- Args = [TableArg],
+generate_all_save_goals(NumberedSaveVars, BaseVarName, BlockSize,
+ CreateMacroName, Context, !VarSet, !VarTypes, !TableInfo,
+ SaveArgs, SavePrefixGoals, SaveDeclCodeStr, CreateSaveCodeStr) :-
+ DebugArgStr = get_debug_arg_string(!.TableInfo),
+ generate_save_goals(NumberedSaveVars, DebugArgStr, Context,
+ !VarSet, !VarTypes, !TableInfo, SaveArgs,
+ SavePrefixGoals, SaveCodeStr),
SaveDeclCodeStr = "\tMR_AnswerBlock " ++ answer_block_name ++ ";\n",
- CreateCodeStr = "\tMR_" ++ CreatePredName ++ "(" ++
+ CreateCodeStr = "\t" ++ CreateMacroName ++ "(" ++ DebugArgStr ++ ", " ++
BaseVarName ++ ", " ++ int_to_string(BlockSize) ++ ", " ++
answer_block_name ++ ");\n",
- CreateSaveCodeStr = CreateCodeStr ++ SaveCodeStr,
- ShortcutStr = "\tMR_" ++ ShortcutPredName ++ "(" ++
- BaseVarName ++ ");\n",
- table_generate_foreign_proc(ShortcutPredName, det,
- tabling_c_attributes, Args, SaveArgs,
- SaveDeclCodeStr ++ CreateSaveCodeStr, ShortcutStr, "",
- impure_code, [], ModuleInfo, Context, ShortcutGoal),
- list.append(SavePrefixGoals, [ShortcutGoal], Goals)
- ;
- TablingViaExtraArgs = no,
- gen_int_construction("BlockSize", BlockSize, !VarTypes,
- !VarSet, BlockSizeVar, BlockSizeVarUnifyGoal),
- generate_call(CreatePredName, det,
- [BaseVar, BlockSizeVar, AnswerBlockVar],
- impure_code, ground_vars([AnswerBlockVar]),
- ModuleInfo, Context, CreateAnswerBlockGoal),
- Goals = [BlockSizeVarUnifyGoal, CreateAnswerBlockGoal | SaveGoals],
- SaveDeclCodeStr = "",
- CreateSaveCodeStr = ""
- ).
+ CreateSaveCodeStr = CreateCodeStr ++ SaveCodeStr.
%-----------------------------------------------------------------------------%
% Generate a sequence of save goals for the given variables.
%
:- pred generate_own_stack_save_goal(list(var_mode_pos_method)::in,
- prog_var::in, int::in, term.context::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
- table_info::in, table_info::out, list(hlds_goal)::out) is det.
-
-generate_own_stack_save_goal(NumberedOutputVars, GeneratorVar, BlockSize,
- Context, !VarTypes, !VarSet, !TableInfo, Goals) :-
- ModuleInfo = !.TableInfo ^ table_module_info,
- generate_new_table_var("AnswerTableVar", trie_node_type,
- !VarTypes, !VarSet, AnswerTableVar),
+ prog_var::in, pred_id::in, proc_id::in, int::in,
+ bool::in, term.context::in, prog_varset::in, prog_varset::out,
+ vartypes::in, vartypes::out, table_info::in, table_info::out,
+ list(table_trie_step)::out, list(hlds_goal)::out) is det.
+
+generate_own_stack_save_goal(NumberedOutputVars, GeneratorVar, PredId, ProcId,
+ BlockSize, Statistics, Context, !VarSet, !VarTypes, !TableInfo,
+ OutputSteps, Goals) :-
GeneratorName = generator_name,
GeneratorArg = foreign_arg(GeneratorVar, yes(GeneratorName - in_mode),
generator_type, native_if_possible),
- generate_table_lookup_goals(NumberedOutputVars,
- "AnswerTableNode", Context, AnswerTableVar, _AnswerTableTipVar,
- !VarTypes, !VarSet, !TableInfo, _LookupAnswerGoals, _Steps,
+ DebugArgStr = get_debug_arg_string(!.TableInfo),
+
+ generate_answer_table_lookup_goals(NumberedOutputVars, PredId, ProcId,
+ Statistics, Context, !VarSet, !VarTypes, !TableInfo, OutputSteps,
LookupForeignArgs, LookupPrefixGoals, LookupCodeStr),
- CreatePredName = "table_mm_create_answer_block",
- generate_new_table_var("AnswerBlock", answer_block_type,
- !VarTypes, !VarSet, AnswerBlockVar),
- generate_save_goals(NumberedOutputVars, AnswerBlockVar, Context,
- !VarTypes, !VarSet, !TableInfo, _SaveGoals,
- _SaveArgs, SavePrefixGoals, SaveCodeStr),
+ generate_save_goals(NumberedOutputVars, DebugArgStr, Context,
+ !VarSet, !VarTypes, !TableInfo, _SaveArgs,
+ SavePrefixGoals, SaveCodeStr),
+
+ GetMacroName = "MR_tbl_mmos_get_answer_table",
+ CreateMacroName = "MR_tbl_mm_create_answer_block",
+ DuplCheckPredName = "table_mmos_answer_is_not_duplicate_shortcut",
+ DuplCheckMacroName = "MR_tbl_mmos_answer_is_not_duplicate",
- DuplCheckPredName = "table_mmos_answer_is_not_duplicate",
- DuplCheckPredNameShortCut = DuplCheckPredName ++ "_shortcut",
Args = [GeneratorArg],
SuccName = "succeeded",
LookupSaveDeclCodeStr =
"\tMR_TrieNode " ++ cur_table_node_name ++ ";\n" ++
"\tMR_TrieNode " ++ next_table_node_name ++ ";\n" ++
"\tMR_AnswerBlock " ++ answer_block_name ++ ";\n" ++
- "\tMR_bool " ++ SuccName ++ ";\n",
- GetPredName = "table_mmos_get_answer_table",
- GetLookupCodeStr = "\t" ++ cur_table_node_name ++ " = " ++
- "MR_" ++ GetPredName ++ "(" ++ GeneratorName ++ ");\n" ++
- LookupCodeStr,
+ "\tMR_bool " ++ SuccName ++ ";\n\n",
+ GetCodeStr = "\t" ++ cur_table_node_name ++ " = " ++
+ GetMacroName ++ "(" ++ DebugArgStr ++ ", " ++
+ GeneratorName ++ ");\n",
DuplCheckCodeStr =
- "\tMR_" ++ DuplCheckPredName ++ "(" ++
- cur_table_node_name ++ ", " ++ SuccName ++ ");\n",
+ "\t" ++ DuplCheckMacroName ++ "(" ++ cur_table_node_name ++ ", " ++
+ SuccName ++ ");\n",
AssignSuccessCodeStr =
"\t" ++ success_indicator_name ++ " = " ++ SuccName ++ ";\n",
- CreateCodeStr = "\tMR_" ++ CreatePredName ++ "(" ++
+ CreateCodeStr = "\t" ++ CreateMacroName ++ "(" ++ DebugArgStr ++ ", " ++
GeneratorName ++ ", " ++ int_to_string(BlockSize) ++ ", " ++
answer_block_name ++ ");\n",
CreateSaveCodeStr = CreateCodeStr ++ SaveCodeStr,
- PreStr = LookupSaveDeclCodeStr ++ GetLookupCodeStr,
- PostStr = "\tif (" ++ SuccName ++ ") {\n" ++
- CreateSaveCodeStr ++ "\t}\n" ++
- AssignSuccessCodeStr,
- table_generate_foreign_proc(DuplCheckPredNameShortCut, semidet,
+ CondSaveCodeStr = "\tif (" ++ SuccName ++ ") {\n" ++
+ CreateSaveCodeStr ++ "\t}\n",
+ CodeStr = LookupSaveDeclCodeStr ++ GetCodeStr ++ LookupCodeStr ++
+ DuplCheckCodeStr ++ CondSaveCodeStr ++ AssignSuccessCodeStr,
+ ModuleInfo = !.TableInfo ^ table_module_info,
+ table_generate_foreign_proc(DuplCheckPredName, semidet,
tabling_c_attributes, Args, LookupForeignArgs,
- PreStr, DuplCheckCodeStr, PostStr, impure_code, [],
+ CodeStr, impure_code, [],
ModuleInfo, Context, DuplicateCheckSaveGoal),
Goals = LookupPrefixGoals ++ SavePrefixGoals ++ [DuplicateCheckSaveGoal].
-:- pred generate_save_goals(list(var_mode_pos_method(T))::in, prog_var::in,
- term.context::in, vartypes::in, vartypes::out,
- prog_varset::in, prog_varset::out, table_info::in, table_info::out,
- list(hlds_goal)::out, list(foreign_arg)::out, list(hlds_goal)::out,
- string::out) is det.
+:- pred generate_save_goals(list(var_mode_pos_method(T))::in, string::in,
+ term.context::in, prog_varset::in, prog_varset::out,
+ vartypes::in, vartypes::out, table_info::in, table_info::out,
+ list(foreign_arg)::out, list(hlds_goal)::out, string::out) is det.
-generate_save_goals([], _, _, !VarTypes, !VarSet, !TableInfo, [],
- [], [], "").
-generate_save_goals([NumberedVar | NumberedRest], TableVar, Context,
- !VarTypes, !VarSet, !TableInfo, Goals, Args ++ RestArgs,
+generate_save_goals([], _, _, !VarSet, !VarTypes, !TableInfo, [], [], "").
+generate_save_goals([NumberedVar | NumberedRest], DebugArgStr, Context,
+ !VarSet, !VarTypes, !TableInfo, Args ++ RestArgs,
PrefixGoals ++ RestPrefixGoals, CodeStr ++ RestCodeStr) :-
NumberedVar = var_mode_pos_method(Var, _Mode, Offset, _),
- gen_int_construction("OffsetVar", Offset, !VarTypes, !VarSet,
- OffsetVar, OffsetUnifyGoal),
ModuleInfo = !.TableInfo ^ table_module_info,
map.lookup(!.VarTypes, Var, VarType),
classify_type(ModuleInfo, VarType) = TypeCat,
- gen_save_call_for_type(TypeCat, VarType, TableVar, Var,
- Offset, OffsetVar, Context, !VarTypes, !VarSet, !TableInfo,
- SaveGoals, Args, PrefixGoals, CodeStr),
- generate_save_goals(NumberedRest, TableVar, Context,
- !VarTypes, !VarSet, !TableInfo, RestGoals,
- RestArgs, RestPrefixGoals, RestCodeStr),
- Goals = [OffsetUnifyGoal | SaveGoals ++ RestGoals].
+ gen_save_call_for_type(TypeCat, VarType, Var, Offset, DebugArgStr, Context,
+ !VarSet, !VarTypes, !TableInfo, Args, PrefixGoals, CodeStr),
+ generate_save_goals(NumberedRest, DebugArgStr, Context, !VarSet, !VarTypes,
+ !TableInfo, RestArgs, RestPrefixGoals, RestCodeStr).
:- pred gen_save_call_for_type(type_category::in, mer_type::in,
- prog_var::in, prog_var::in, int::in, prog_var::in, term.context::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
- table_info::in, table_info::out, list(hlds_goal)::out,
- list(foreign_arg)::out, list(hlds_goal)::out, string::out) is det.
+ prog_var::in, int::in, string::in, term.context::in,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
+ table_info::in, table_info::out, list(foreign_arg)::out,
+ list(hlds_goal)::out, string::out) is det.
-gen_save_call_for_type(TypeCat, Type, TableVar, Var, Offset, OffsetVar,
- Context, !VarTypes, !VarSet, !TableInfo, Goals,
- Args, PrefixGoals, CodeStr) :-
- ModuleInfo = !.TableInfo ^ table_module_info,
+gen_save_call_for_type(TypeCat, Type, Var, Offset, DebugArgStr, Context,
+ !VarSet, !VarTypes, !TableInfo, Args, PrefixGoals, CodeStr) :-
Name = arg_name(Offset),
ForeignArg = foreign_arg(Var, yes(Name - in_mode), Type,
native_if_possible),
( type_is_io_state(Type) ->
- SavePredName = "table_save_io_state_answer",
- generate_call(SavePredName, det, [TableVar, OffsetVar, Var],
- impure_code, [], ModuleInfo, Context, Goal),
- Goals = [Goal],
+ SaveMacroName = "MR_tbl_save_io_state_answer",
Args = [ForeignArg],
PrefixGoals = [],
- CodeStr = "\tMR_" ++ SavePredName ++ "(" ++
- answer_block_name ++ ", " ++ int_to_string(Offset) ++ ", " ++
- Name ++ ");\n"
+ CodeStr = "\t" ++ SaveMacroName ++ "(" ++ DebugArgStr ++ ", " ++
+ answer_block_name ++ ", " ++ int_to_string(Offset) ++ ", "
+ ++ Name ++ ");\n"
; builtin_type(TypeCat) = no ->
% If we used ForeignArg instead of GenericForeignArg, then
% Var would be unboxed when assigned to Name, which we don't want.
GenericForeignArg = foreign_arg(Var, yes(Name - in_mode),
dummy_type_var, native_if_possible),
- make_type_info_var(Type, Context, !VarTypes, !VarSet,
- !TableInfo, TypeInfoVar, ExtraGoals),
+ table_gen_make_type_info_var(Type, Context, !VarSet, !VarTypes,
+ !TableInfo, TypeInfoVar, PrefixGoals),
TypeInfoName = "save_arg_typeinfo" ++ int_to_string(Offset),
map.lookup(!.VarTypes, TypeInfoVar, TypeInfoType),
TypeInfoForeignArg = foreign_arg(TypeInfoVar,
yes(TypeInfoName - in_mode), TypeInfoType, native_if_possible),
- SavePredName = "table_save_any_answer",
- generate_call(SavePredName, det,
- [TypeInfoVar, TableVar, OffsetVar, Var],
- impure_code, [], ModuleInfo, Context, CallGoal),
- Goals = ExtraGoals ++ [CallGoal],
+ SaveMacroName = "MR_tbl_save_any_answer",
Args = [GenericForeignArg, TypeInfoForeignArg],
- PrefixGoals = ExtraGoals,
- CodeStr = "\tMR_" ++ SavePredName ++ "(" ++
+ CodeStr = "\t" ++ SaveMacroName ++ "(" ++ DebugArgStr ++ ", " ++
answer_block_name ++ ", " ++ int_to_string(Offset) ++ ", " ++
TypeInfoName ++ ", " ++ Name ++ ");\n"
;
type_save_category(TypeCat, CatString),
- SavePredName = "table_save_" ++ CatString ++ "_answer",
- generate_call(SavePredName, det, [TableVar, OffsetVar, Var],
- impure_code, [], ModuleInfo, Context, Goal),
- Goals = [Goal],
+ SaveMacroName = "MR_tbl_save_" ++ CatString ++ "_answer",
Args = [ForeignArg],
PrefixGoals = [],
- CodeStr = "\tMR_" ++ SavePredName ++ "(" ++
- answer_block_name ++ ", " ++ int_to_string(Offset) ++ ", " ++
- Name ++ ");\n"
+ CodeStr = "\t" ++ SaveMacroName ++ "(" ++ DebugArgStr ++ ", " ++
+ answer_block_name ++ ", " ++ int_to_string(Offset) ++ ", "
+ ++ Name ++ ");\n"
).
%-----------------------------------------------------------------------------%
@@ -2720,51 +2683,35 @@
% an answer block in memo predicates.
%
:- pred generate_memo_restore_goal(list(var_mode_pos_method(T))::in,
- instmap_delta::in, prog_var::in, module_info::in, bool::in,
- term.context::in, vartypes::in, vartypes::out,
- prog_varset::in, prog_varset::out, hlds_goal::out) is det.
+ instmap_delta::in, prog_var::in, term.context::in,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
+ table_info::in, hlds_goal::out) is det.
generate_memo_restore_goal(NumberedOutputVars, OrigInstMapDelta, TipVar,
- ModuleInfo, TablingViaExtraArgs, Context, !VarTypes, !VarSet, Goal) :-
+ Context, !VarSet, !VarTypes, TableInfo, Goal) :-
(
NumberedOutputVars = [_ | _],
- OutputVars = list.map(project_var, NumberedOutputVars),
- GetPredName = "table_memo_get_answer_block",
- generate_new_table_var("RestoreBlockVar", answer_block_type,
- !VarTypes, !VarSet, RestoreBlockVar),
+ DebugArgStr = get_debug_arg_string(TableInfo),
+ ModuleInfo = TableInfo ^ table_module_info,
generate_restore_goals(NumberedOutputVars, OrigInstMapDelta,
- RestoreBlockVar, ModuleInfo, Context, !VarTypes, !VarSet,
- RestoreGoals, RestoreInstMapDeltaSrc, RestoreArgs, RestoreCodeStr),
- (
- TablingViaExtraArgs = yes,
+ DebugArgStr, ModuleInfo, !VarSet, !VarTypes,
+ RestoreInstMapDeltaSrc, RestoreArgs, RestoreCodeStr),
BaseVarName = base_name,
Arg = foreign_arg(TipVar, yes(BaseVarName - in_mode),
trie_node_type, native_if_possible),
Args = [Arg],
+ GetPredName = "table_memo_get_answer_block_shortcut",
+ GetMacroName = "MR_tbl_memo_get_answer_block",
DeclCodeStr = "\tMR_AnswerBlock " ++ answer_block_name ++ ";\n",
- ShortcutPredName = GetPredName ++ "_shortcut",
- ShortcutStr = "\tMR_" ++ ShortcutPredName ++ "(" ++
- BaseVarName ++ ");\n",
- GetRestoreCodeStr = "\tMR_" ++ GetPredName ++ "(" ++
- BaseVarName ++ ", " ++ answer_block_name ++ ");\n" ++
+ GetRestoreCodeStr = "\t" ++ GetMacroName ++ "(" ++
+ DebugArgStr ++ ", " ++ BaseVarName ++ ", " ++
+ answer_block_name ++ ");\n" ++
RestoreCodeStr,
- table_generate_foreign_proc(ShortcutPredName, det,
- tabling_c_attributes, Args, RestoreArgs, DeclCodeStr,
- ShortcutStr, GetRestoreCodeStr, impure_code,
+ table_generate_foreign_proc(GetPredName, det, tabling_c_attributes,
+ Args, RestoreArgs, DeclCodeStr ++ GetRestoreCodeStr, impure_code,
RestoreInstMapDeltaSrc, ModuleInfo, Context, ShortcutGoal),
Goal = ShortcutGoal
;
- TablingViaExtraArgs = no,
- generate_call(GetPredName, det, [TipVar, RestoreBlockVar],
- semipure_code, ground_vars([RestoreBlockVar]),
- ModuleInfo, Context, GetBlockGoal),
- GoalExpr = conj(plain_conj, [GetBlockGoal | RestoreGoals]),
- set.list_to_set([TipVar | OutputVars], NonLocals),
- goal_info_init_hide(NonLocals, OrigInstMapDelta,
- det, purity_semipure, Context, GoalInfo),
- Goal = GoalExpr - GoalInfo
- )
- ;
NumberedOutputVars = [],
Goal = true_goal
).
@@ -2774,11 +2721,11 @@
%
:- pred generate_memo_non_restore_goal(determinism::in,
list(var_mode_pos_method)::in, instmap_delta::in, prog_var::in,
- module_info::in, term.context::in, vartypes::in, vartypes::out,
- prog_varset::in, prog_varset::out, hlds_goal::out) is det.
+ term.context::in, prog_varset::in, prog_varset::out,
+ vartypes::in, vartypes::out, table_info::in, hlds_goal::out) is det.
generate_memo_non_restore_goal(Detism, NumberedOutputVars, OrigInstMapDelta,
- RecordVar, ModuleInfo, Context, !VarTypes, !VarSet, Goal) :-
+ RecordVar, Context, !VarSet, !VarTypes, TableInfo, Goal) :-
( Detism = multidet ->
ReturnAllAns = "table_memo_return_all_answers_multi"
; Detism = nondet ->
@@ -2787,22 +2734,22 @@
unexpected(this_file, "generate_mm_restore_goal: invalid determinism")
),
generate_new_table_var("AnswerBlock", answer_block_type,
- !VarTypes, !VarSet, AnswerBlockVar),
+ !VarSet, !VarTypes, AnswerBlockVar),
+ ModuleInfo = TableInfo ^ table_module_info,
generate_call(ReturnAllAns, Detism, [RecordVar, AnswerBlockVar],
semipure_code, ground_vars([AnswerBlockVar]), ModuleInfo,
Context, ReturnAnswerBlocksGoal),
+ DebugArgStr = get_debug_arg_string(TableInfo),
generate_restore_goals(NumberedOutputVars, OrigInstMapDelta,
- AnswerBlockVar, ModuleInfo, Context, !VarTypes, !VarSet,
- _RestoreGoals, RestoreInstMapDeltaSrc, RestoreArgs, RestoreCodeStr),
+ DebugArgStr, ModuleInfo, !VarSet, !VarTypes, RestoreInstMapDeltaSrc,
+ RestoreArgs, RestoreCodeStr),
OutputVars = list.map(project_var, NumberedOutputVars),
Arg = foreign_arg(AnswerBlockVar, yes(answer_block_name - in_mode),
answer_block_type, native_if_possible),
Args = [Arg],
- ShortcutPredName = "table_memo_non_return_all_shortcut",
- ShortcutStr = "\tMR_" ++ ShortcutPredName ++ "(" ++
- answer_block_name ++ ");\n",
- table_generate_foreign_proc(ShortcutPredName, det, tabling_c_attributes,
- Args, RestoreArgs, "", ShortcutStr, RestoreCodeStr, impure_code,
+ PredName = "table_memo_non_return_all_shortcut",
+ table_generate_foreign_proc(PredName, det, tabling_c_attributes,
+ Args, RestoreArgs, RestoreCodeStr, impure_code,
RestoreInstMapDeltaSrc, ModuleInfo, Context, ShortcutGoal),
GoalExpr = conj(plain_conj, [ReturnAnswerBlocksGoal, ShortcutGoal]),
@@ -2816,13 +2763,11 @@
%
:- pred generate_mm_restore_goal(determinism::in,
list(var_mode_pos_method)::in, instmap_delta::in, prog_var::in,
- module_info::in, bool::in, term.context::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
- hlds_goal::out) is det.
+ term.context::in, prog_varset::in, prog_varset::out,
+ vartypes::in, vartypes::out, table_info::in, hlds_goal::out) is det.
generate_mm_restore_goal(Detism, NumberedOutputVars, OrigInstMapDelta,
- SubgoalVar, ModuleInfo, TablingViaExtraArgs, Context,
- !VarTypes, !VarSet, Goal) :-
+ SubgoalVar, Context, !VarSet, !VarTypes, TableInfo, Goal) :-
( Detism = multidet ->
ReturnAllAns = "table_mm_return_all_multi"
; Detism = nondet ->
@@ -2831,24 +2776,22 @@
unexpected(this_file, "generate_mm_restore_goal: invalid determinism")
),
generate_mm_restore_or_suspend_goal(ReturnAllAns, Detism, purity_semipure,
- NumberedOutputVars, OrigInstMapDelta, SubgoalVar, ModuleInfo,
- TablingViaExtraArgs, Context, !VarTypes, !VarSet, Goal).
+ NumberedOutputVars, OrigInstMapDelta, SubgoalVar, Context,
+ !VarSet, !VarTypes, TableInfo, Goal).
% Generate a goal for restoring the output arguments from
% an answer block in minimal model predicates after a suspension.
%
:- pred generate_mm_suspend_goal(list(var_mode_pos_method)::in,
- instmap_delta::in, prog_var::in, module_info::in,
- bool::in, term.context::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
- hlds_goal::out) is det.
+ instmap_delta::in, prog_var::in, term.context::in,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
+ table_info::in, hlds_goal::out) is det.
generate_mm_suspend_goal(NumberedOutputVars, OrigInstMapDelta, SubgoalVar,
- ModuleInfo, TablingViaExtraArgs, Context, !VarTypes, !VarSet, Goal) :-
+ Context, !VarSet, !VarTypes, TableInfo, Goal) :-
generate_mm_restore_or_suspend_goal("table_mm_suspend_consumer",
nondet, purity_impure, NumberedOutputVars, OrigInstMapDelta,
- SubgoalVar, ModuleInfo, TablingViaExtraArgs, Context,
- !VarTypes, !VarSet, Goal).
+ SubgoalVar, Context, !VarSet, !VarTypes, TableInfo, Goal).
% Generate a goal for restoring the output arguments from
% an answer block in minimal model predicates. Whether the restore
@@ -2856,40 +2799,33 @@
%
:- pred generate_mm_restore_or_suspend_goal(string::in, determinism::in,
purity::in, list(var_mode_pos_method)::in, instmap_delta::in,
- prog_var::in, module_info::in, bool::in, term.context::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
- hlds_goal::out) is det.
+ prog_var::in, term.context::in, prog_varset::in, prog_varset::out,
+ vartypes::in, vartypes::out, table_info::in, hlds_goal::out) is det.
generate_mm_restore_or_suspend_goal(PredName, Detism, Purity,
- NumberedOutputVars, OrigInstMapDelta, SubgoalVar, ModuleInfo,
- TablingViaExtraArgs, Context, !VarTypes, !VarSet, Goal) :-
+ NumberedOutputVars, OrigInstMapDelta, SubgoalVar, Context,
+ !VarSet, !VarTypes, TableInfo, Goal) :-
generate_new_table_var("AnswerBlock", answer_block_type,
- !VarTypes, !VarSet, AnswerBlockVar),
+ !VarSet, !VarTypes, AnswerBlockVar),
+ ModuleInfo = TableInfo ^ table_module_info,
generate_call(PredName, Detism, [SubgoalVar, AnswerBlockVar],
semipure_code, ground_vars([AnswerBlockVar]), ModuleInfo,
Context, ReturnAnswerBlocksGoal),
+ DebugArgStr = get_debug_arg_string(TableInfo),
generate_restore_goals(NumberedOutputVars, OrigInstMapDelta,
- AnswerBlockVar, ModuleInfo, Context, !VarTypes, !VarSet,
- RestoreGoals, RestoreInstMapDeltaSrc, RestoreArgs, RestoreCodeStr),
+ DebugArgStr, ModuleInfo, !VarSet, !VarTypes, RestoreInstMapDeltaSrc,
+ RestoreArgs, RestoreCodeStr),
OutputVars = list.map(project_var, NumberedOutputVars),
- (
- TablingViaExtraArgs = yes,
- Arg = foreign_arg(AnswerBlockVar,
- yes(answer_block_name - in_mode), answer_block_type,
- native_if_possible),
+
+ Arg = foreign_arg(AnswerBlockVar, yes(answer_block_name - in_mode),
+ answer_block_type, native_if_possible),
Args = [Arg],
- ShortcutPredName = "table_mm_return_all_shortcut",
- ShortcutStr = "\tMR_" ++ ShortcutPredName ++ "(" ++
- answer_block_name ++ ");\n",
- table_generate_foreign_proc(ShortcutPredName, det,
- tabling_c_attributes, Args, RestoreArgs, "", ShortcutStr,
- RestoreCodeStr, impure_code, RestoreInstMapDeltaSrc, ModuleInfo,
- Context, ShortcutGoal),
- GoalExpr = conj(plain_conj, [ReturnAnswerBlocksGoal, ShortcutGoal])
- ;
- TablingViaExtraArgs = no,
- GoalExpr = conj(plain_conj, [ReturnAnswerBlocksGoal | RestoreGoals])
- ),
+ ReturnAllPredName = "table_mm_return_all_shortcut",
+ table_generate_foreign_proc(ReturnAllPredName, det, tabling_c_attributes,
+ Args, RestoreArgs, RestoreCodeStr, impure_code, RestoreInstMapDeltaSrc,
+ ModuleInfo, Context, ReturnAllGoal),
+ GoalExpr = conj(plain_conj, [ReturnAnswerBlocksGoal, ReturnAllGoal]),
+
set.list_to_set([SubgoalVar | OutputVars], NonLocals),
goal_info_init_hide(NonLocals, OrigInstMapDelta, Detism, Purity,
Context, GoalInfo),
@@ -2900,46 +2836,39 @@
% Generate a sequence of restore goals for the given variables.
%
:- pred generate_restore_goals(list(var_mode_pos_method(T))::in,
- instmap_delta::in, prog_var::in, module_info::in, term.context::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
- list(hlds_goal)::out, assoc_list(prog_var, mer_inst)::out,
- list(foreign_arg)::out, string::out) is det.
+ instmap_delta::in, string::in, module_info::in,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
+ assoc_list(prog_var, mer_inst)::out, list(foreign_arg)::out,
+ string::out) is det.
-generate_restore_goals([], _, _, _, _, !VarTypes, !VarSet, [], [], [], "").
+generate_restore_goals([], _, _, _, !VarSet, !VarTypes, [], [], "").
generate_restore_goals([NumberedVar | NumberedRest], OrigInstmapDelta,
- AnswerBlockVar, ModuleInfo, Context, !VarTypes, !VarSet,
- [OffsetUnifyGoal, CallGoal | RestGoals], [VarInst | VarInsts],
+ DebugArgStr, ModuleInfo, !VarSet, !VarTypes, [VarInst | VarInsts],
[Arg | Args], CodeStr ++ RestCodeStr) :-
NumberedVar = var_mode_pos_method(Var, _Mode, Offset, _),
- gen_int_construction("OffsetVar", Offset, !VarTypes, !VarSet,
- OffsetVar, OffsetUnifyGoal),
map.lookup(!.VarTypes, Var, VarType),
classify_type(ModuleInfo, VarType) = TypeCat,
- gen_restore_call_for_type(TypeCat, VarType, OrigInstmapDelta,
- AnswerBlockVar, Var, Offset, OffsetVar, ModuleInfo, Context,
- CallGoal, VarInst, Arg, CodeStr),
- generate_restore_goals(NumberedRest, OrigInstmapDelta, AnswerBlockVar,
- ModuleInfo, Context, !VarTypes, !VarSet, RestGoals, VarInsts,
- Args, RestCodeStr).
-
-:- pred gen_restore_call_for_type(type_category::in, mer_type::in,
- instmap_delta::in, prog_var::in, prog_var::in, int::in, prog_var::in,
- module_info::in, term.context::in, hlds_goal::out,
+ gen_restore_call_for_type(DebugArgStr, TypeCat, VarType, OrigInstmapDelta,
+ Var, Offset, VarInst, Arg, CodeStr),
+ generate_restore_goals(NumberedRest, OrigInstmapDelta, DebugArgStr,
+ ModuleInfo, !VarSet, !VarTypes, VarInsts, Args, RestCodeStr).
+
+:- pred gen_restore_call_for_type(string::in, type_category::in, mer_type::in,
+ instmap_delta::in, prog_var::in, int::in,
pair(prog_var, mer_inst)::out, foreign_arg::out, string::out) is det.
-gen_restore_call_for_type(TypeCat, Type, OrigInstmapDelta, TableVar, Var,
- Offset, OffsetVar, ModuleInfo, Context, Goal, Var - Inst, Arg,
- CodeStr) :-
+gen_restore_call_for_type(DebugArgStr, TypeCat, Type, OrigInstmapDelta, Var,
+ Offset, Var - Inst, Arg, CodeStr) :-
Name = "restore_arg" ++ int_to_string(Offset),
( type_is_io_state(Type) ->
- RestorePredName = "table_restore_io_state_answer",
+ RestoreMacroName = "MR_tbl_restore_io_state_answer",
ArgType = Type
; builtin_type(TypeCat) = no ->
- RestorePredName = "table_restore_any_answer",
+ RestoreMacroName = "MR_tbl_restore_any_answer",
ArgType = dummy_type_var
;
type_save_category(TypeCat, CatString),
- RestorePredName = "table_restore_" ++ CatString ++ "_answer",
+ RestoreMacroName = "MR_tbl_restore_" ++ CatString ++ "_answer",
ArgType = Type
),
( instmap_delta_search_var(OrigInstmapDelta, Var, InstPrime) ->
@@ -2949,10 +2878,9 @@
),
Arg = foreign_arg(Var, yes(Name - (free -> Inst)), ArgType,
native_if_possible),
- CodeStr = "\tMR_" ++ RestorePredName ++ "(" ++ answer_block_name ++ ", "
- ++ int_to_string(Offset) ++ ", " ++ Name ++ ");\n",
- generate_call(RestorePredName, det, [TableVar, OffsetVar, Var],
- semipure_code, [Var - Inst], ModuleInfo, Context, Goal).
+ CodeStr = "\t" ++ RestoreMacroName ++ "(" ++ DebugArgStr ++ ", " ++
+ answer_block_name ++ ", " ++ int_to_string(Offset) ++ ", " ++
+ Name ++ ");\n".
%-----------------------------------------------------------------------------%
@@ -2964,11 +2892,11 @@
need_minimal_model_msg = "detected need for minimal model".
-:- pred generate_error_goal(table_info::in, term.context::in,
- string::in, vartypes::in, vartypes::out,
- prog_varset::in, prog_varset::out, hlds_goal::out) is det.
+:- pred generate_error_goal(table_info::in, term.context::in, string::in,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
+ hlds_goal::out) is det.
-generate_error_goal(TableInfo, Context, Msg, !VarTypes, !VarSet, Goal) :-
+generate_error_goal(TableInfo, Context, Msg, !VarSet, !VarTypes, Goal) :-
ModuleInfo = TableInfo ^ table_module_info,
PredInfo = TableInfo ^ table_cur_pred_info,
@@ -2982,7 +2910,7 @@
Message = Msg ++ " in " ++ PredOrFuncStr ++ " " ++ NameStr
++ "/" ++ ArityStr,
- gen_string_construction("Message", Message, !VarTypes, !VarSet,
+ gen_string_construction("Message", Message, !VarSet, !VarTypes,
MessageVar, MessageStrGoal),
generate_call("table_error", erroneous, [MessageVar], pure_code, [],
ModuleInfo, Context, CallGoal),
@@ -2995,10 +2923,10 @@
%-----------------------------------------------------------------------------%
:- pred generate_new_table_var(string::in, mer_type::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
prog_var::out) is det.
-generate_new_table_var(Name, Type, !VarTypes, !VarSet, Var) :-
+generate_new_table_var(Name, Type, !VarSet, !VarTypes, Var) :-
varset.new_named_var(!.VarSet, Name, Var, !:VarSet),
map.set(!.VarTypes, Var, Type, !:VarTypes).
@@ -3020,8 +2948,8 @@
impure_or_semipure::in, assoc_list(prog_var, mer_inst)::in,
module_info::in, term.context::in, hlds_goal::out) is det.
-generate_call(PredName, Detism, Args, Purity, InstMapSrc,
- ModuleInfo, Context, Goal) :-
+generate_call(PredName, Detism, Args, Purity, InstMapSrc, ModuleInfo, Context,
+ Goal) :-
mercury_table_builtin_module(BuiltinModule),
Features0 = impure_or_semipure_to_features(Purity),
( Detism = failure ->
@@ -3035,13 +2963,12 @@
:- pred table_generate_foreign_proc(string::in, determinism::in,
pragma_foreign_proc_attributes::in,
- list(foreign_arg)::in, list(foreign_arg)::in, string::in, string::in,
- string::in, impure_or_semipure::in, assoc_list(prog_var, mer_inst)::in,
+ list(foreign_arg)::in, list(foreign_arg)::in, string::in,
+ impure_or_semipure::in, assoc_list(prog_var, mer_inst)::in,
module_info::in, term.context::in, hlds_goal::out) is det.
table_generate_foreign_proc(PredName, Detism, Attributes, Args, ExtraArgs,
- PrefixCode, Code, SuffixCode, Purity, InstMapSrc,
- ModuleInfo, Context, Goal) :-
+ Code, Purity, InstMapSrc, ModuleInfo, Context, Goal) :-
mercury_table_builtin_module(BuiltinModule),
Features0 = impure_or_semipure_to_features(Purity),
( Detism = failure ->
@@ -3050,9 +2977,8 @@
Features = Features0
),
goal_util.generate_foreign_proc(BuiltinModule, PredName, predicate,
- only_mode, Detism, Attributes, Args, ExtraArgs,
- PrefixCode, Code, SuffixCode, Features, InstMapSrc,
- ModuleInfo, Context, Goal).
+ only_mode, Detism, Attributes, Args, ExtraArgs, Code, Features,
+ InstMapSrc, ModuleInfo, Context, Goal).
:- pred append_fail(hlds_goal::in, hlds_goal::out) is det.
@@ -3066,21 +2992,22 @@
GoalAndThenFail = conj(plain_conj, [Goal, fail_goal]) - ConjGoalInfo.
:- pred gen_int_construction(string::in, int::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
prog_var::out, hlds_goal::out) is det.
-gen_int_construction(VarName, VarValue, !VarTypes, !VarSet, Var, Goal) :-
+gen_int_construction(VarName, VarValue, !VarSet, !VarTypes, Var, Goal) :-
make_int_const_construction_alloc(VarValue, yes(VarName), Goal, Var,
- !VarTypes, !VarSet).
+ !VarSet, !VarTypes).
:- pred gen_string_construction(string::in, string::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
prog_var::out, hlds_goal::out) is det.
-gen_string_construction(VarName, VarValue, !VarTypes, !VarSet, Var, Goal) :-
+gen_string_construction(VarName, VarValue, !VarSet, !VarTypes, Var, Goal) :-
make_string_const_construction_alloc(VarValue, yes(VarName), Goal, Var,
- !VarTypes, !VarSet).
+ !VarSet, !VarTypes).
+:- func proc_table_info_type = mer_type.
:- func trie_node_type = mer_type.
:- func memo_non_record_type = mer_type.
:- func subgoal_type = mer_type.
@@ -3091,6 +3018,11 @@
:- func memo_non_status_type = mer_type.
:- func mm_status_type = mer_type.
+proc_table_info_type = Type :-
+ mercury_table_builtin_module(TB),
+ construct_type(type_ctor(qualified(TB, "ml_proc_table_info"), 0),
+ [], Type).
+
trie_node_type = Type :-
mercury_table_builtin_module(TB),
construct_type(type_ctor(qualified(TB, "ml_trie_node"), 0), [], Type).
@@ -3440,28 +3372,87 @@
%-----------------------------------------------------------------------------%
-:- pred table_gen.make_type_info_var(mer_type::in, term.context::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
+:- func get_debug_arg_string(table_info) = string.
+
+get_debug_arg_string(TableInfo) = DebugArgStr :-
+ ModuleInfo = TableInfo ^ table_module_info,
+ module_info_get_globals(ModuleInfo, Globals),
+ globals.lookup_bool_option(Globals, table_debug, TableDebug),
+ (
+ TableDebug = yes,
+ DebugArgStr = "MR_TRUE"
+ ;
+ TableDebug = no,
+ DebugArgStr = "MR_FALSE"
+ ).
+
+:- func get_back_arg_string(table_info) = string.
+
+get_back_arg_string(TableInfo) = BackArgStr :-
+ ProcInfo = TableInfo ^ table_cur_proc_info,
+ proc_info_get_table_attributes(ProcInfo, MaybeAttributes),
+ (
+ MaybeAttributes = yes(Attributes),
+ MaybeSizeLimit = Attributes ^ table_attr_size_limit,
+ (
+ MaybeSizeLimit = yes(_),
+ BackArgStr = "MR_TRUE"
+ ;
+ MaybeSizeLimit = no,
+ BackArgStr = "MR_FALSE"
+ )
+ ;
+ MaybeAttributes = no,
+ BackArgStr = "MR_FALSE"
+ ).
+
+:- type call_or_answer_table
+ ---> call_table
+ ; answer_table.
+
+:- func stats_arg(bool, call_or_answer_table, int) = string.
+
+stats_arg(Statistics, Kind, SeqNum) = ArgStr :-
+ (
+ Statistics = no,
+ ArgStr = "NULL"
+ ;
+ Statistics = yes,
+ (
+ Kind = call_table,
+ ArgStr = "&" ++ proc_table_info_name ++
+ "->MR_pt_call_table_stats[" ++ int_to_string(SeqNum) ++ "]"
+ ;
+ Kind = answer_table,
+ ArgStr = "&" ++ proc_table_info_name ++
+ "->MR_pt_answer_table_stats[" ++ int_to_string(SeqNum) ++ "]"
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred table_gen_make_type_info_var(mer_type::in, term.context::in,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
table_info::in, table_info::out, prog_var::out,
list(hlds_goal)::out) is det.
-table_gen.make_type_info_var(Type, Context, !VarTypes, !VarSet, !TableInfo,
+table_gen_make_type_info_var(Type, Context, !VarSet, !VarTypes, !TableInfo,
TypeInfoVar, TypeInfoGoals) :-
- table_gen.make_type_info_vars([Type], Context, !VarTypes, !VarSet,
+ table_gen_make_type_info_vars([Type], Context, !VarSet, !VarTypes,
!TableInfo, TypeInfoVars, TypeInfoGoals),
( TypeInfoVars = [TypeInfoVar0] ->
TypeInfoVar = TypeInfoVar0
;
unexpected(this_file,
- "table_gen.make_type_info_var: list length != 1")
+ "table_gen_make_type_info_var: list length != 1")
).
-:- pred table_gen.make_type_info_vars(list(mer_type)::in, term.context::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
+:- pred table_gen_make_type_info_vars(list(mer_type)::in, term.context::in,
+ prog_varset::in, prog_varset::out, vartypes::in, vartypes::out,
table_info::in, table_info::out, list(prog_var)::out,
list(hlds_goal)::out) is det.
-table_gen.make_type_info_vars(Types, Context, !VarTypes, !VarSet, !TableInfo,
+table_gen_make_type_info_vars(Types, Context, !VarSet, !VarTypes, !TableInfo,
TypeInfoVars, TypeInfoGoals) :-
% Extract the information from table_info.
table_info_extract(!.TableInfo, ModuleInfo0, PredInfo0, ProcInfo0),
@@ -3488,43 +3479,36 @@
%-----------------------------------------------------------------------------%
-:- pred table_gen.var_mode_pos_is_io_state(vartypes::in,
+:- pred var_mode_pos_is_io_state(vartypes::in,
var_mode_pos_method::in) is semidet.
-table_gen.var_mode_pos_is_io_state(VarTypes, VarModePosMethod) :-
- table_gen.var_is_io_state(VarTypes, project_var(VarModePosMethod)).
+var_mode_pos_is_io_state(VarTypes, VarModePosMethod) :-
+ var_is_io_state(VarTypes, project_var(VarModePosMethod)).
-:- pred table_gen.var_mode_is_io_state(vartypes::in,
- pair(prog_var, mer_mode)::in) is semidet.
+:- pred var_mode_is_io_state(vartypes::in, pair(prog_var, mer_mode)::in)
+ is semidet.
-table_gen.var_mode_is_io_state(VarTypes, Var - _) :-
- table_gen.var_is_io_state(VarTypes, Var).
+var_mode_is_io_state(VarTypes, Var - _) :-
+ var_is_io_state(VarTypes, Var).
-:- pred table_gen.var_is_io_state(vartypes::in, prog_var::in) is semidet.
+:- pred var_is_io_state(vartypes::in, prog_var::in) is semidet.
-table_gen.var_is_io_state(VarTypes, Var) :-
+var_is_io_state(VarTypes, Var) :-
map.lookup(VarTypes, Var, VarType),
type_is_io_state(VarType).
%-----------------------------------------------------------------------------%
-:- pred tabling_via_extra_args(module_info::in, bool::out) is det.
-
-tabling_via_extra_args(ModuleInfo, TablingViaExtraArgs) :-
- module_info_get_globals(ModuleInfo, Globals),
- globals.lookup_bool_option(Globals, tabling_via_extra_args,
- TablingViaExtraArgs).
-
:- func tabling_c_attributes = pragma_foreign_proc_attributes.
tabling_c_attributes = Attrs :-
- Attrs0 = default_attributes(c),
+ Attrs0 = default_attributes(lang_c),
set_may_call_mercury(will_not_call_mercury, Attrs0, Attrs).
:- func make_generator_c_attributes = pragma_foreign_proc_attributes.
make_generator_c_attributes = Attrs :-
- Attrs0 = default_attributes(c),
+ Attrs0 = default_attributes(lang_c),
set_may_call_mercury(may_call_mercury, Attrs0, Attrs).
:- func dummy_type_var = mer_type.
@@ -3536,7 +3520,7 @@
%-----------------------------------------------------------------------------%
-:- func pred_table_name = string.
+:- func proc_table_info_name = string.
:- func cur_table_node_name = string.
:- func next_table_node_name = string.
:- func table_tip_node_name = string.
@@ -3554,7 +3538,7 @@
:- func generator_name = string.
:- func generator_pred_name = string.
-pred_table_name = "pred_table".
+proc_table_info_name = "proc_table_info".
cur_table_node_name = "cur_node".
next_table_node_name = "next_node".
table_tip_node_name = "table_tip".
Index: compiler/transform_llds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/transform_llds.m,v
retrieving revision 1.24
diff -u -b -r1.24 transform_llds.m
--- compiler/transform_llds.m 8 May 2006 03:36:02 -0000 1.24
+++ compiler/transform_llds.m 17 May 2006 06:49:56 -0000
@@ -117,8 +117,8 @@
ProcId = hlds_pred.initial_proc_id,
PredId = hlds_pred.initial_pred_id,
PredName = "ACCURATE_GC_END_LABEL",
- ProcLabel = proc(ModuleName, predicate, ModuleName, PredName,
- Arity, proc_id_to_int(ProcId)),
+ ProcLabel = ordinary_proc_label(ModuleName, predicate, ModuleName,
+ PredName, Arity, proc_id_to_int(ProcId)),
Instrs = [label(entry(local, ProcLabel)) -
"label to indicate end of previous procedure"],
DummyProc = c_procedure(PredName, Arity, proc(PredId, ProcId), model_det,
Index: compiler/tupling.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/tupling.m,v
retrieving revision 1.23
diff -u -b -r1.23 tupling.m
--- compiler/tupling.m 20 Apr 2006 05:37:02 -0000 1.23
+++ compiler/tupling.m 17 May 2006 06:50:15 -0000
@@ -937,7 +937,7 @@
module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
PredInfo, ProcInfo),
% XXX: Different declaring vs defining modules not handled.
- ProcLabel = proc(pred_info_module(PredInfo),
+ ProcLabel = ordinary_proc_label(pred_info_module(PredInfo),
pred_info_is_pred_or_func(PredInfo),
pred_info_module(PredInfo),
pred_info_name(PredInfo),
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.77
diff -u -b -r1.77 type_ctor_info.m
--- compiler/type_ctor_info.m 20 Apr 2006 05:37:02 -0000 1.77
+++ compiler/type_ctor_info.m 5 Jun 2006 12:52:33 -0000
@@ -757,7 +757,7 @@
; ConsTag = pred_closure_tag(_, _, _)
; ConsTag = type_ctor_info_constant(_, _, _)
; ConsTag = base_typeclass_info_constant(_, _, _)
- ; ConsTag = tabling_pointer_constant(_, _)
+ ; ConsTag = tabling_info_constant(_, _)
; ConsTag = deep_profiling_proc_layout_tag(_, _)
; ConsTag = table_io_decl_tag(_, _)
),
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_gen.m,v
retrieving revision 1.166
diff -u -b -r1.166 unify_gen.m
--- compiler/unify_gen.m 20 Apr 2006 05:37:04 -0000 1.166
+++ compiler/unify_gen.m 5 Jun 2006 08:48:09 -0000
@@ -289,8 +289,8 @@
ConsTag = base_typeclass_info_constant(_, _, _),
unexpected(this_file, "Attempted base_typeclass_info unification")
;
- ConsTag = tabling_pointer_constant(_, _),
- unexpected(this_file, "Attempted tabling_pointer unification")
+ ConsTag = tabling_info_constant(_, _),
+ unexpected(this_file, "Attempted tabling_info unification")
;
ConsTag = deep_profiling_proc_layout_tag(_, _),
unexpected(this_file,
@@ -452,13 +452,14 @@
base_typeclass_info(ModuleName, Instance))), no)), !CI),
Code = empty
;
- ConsTag = tabling_pointer_constant(PredId, ProcId),
+ ConsTag = tabling_info_constant(PredId, ProcId),
expect(unify(Args, []), this_file,
- "generate_construction_2: tabling_pointer constant has args"),
+ "generate_construction_2: tabling_info constant has args"),
code_info.get_module_info(!.CI, ModuleInfo),
ProcLabel = make_proc_label(ModuleInfo, PredId, ProcId),
module_info_get_name(ModuleInfo, ModuleName),
- DataAddr = data_addr(ModuleName, tabling_pointer(ProcLabel)),
+ DataAddr = data_addr(ModuleName,
+ proc_tabling_ref(ProcLabel, tabling_info)),
code_info.assign_const_to_var(Var,
const(data_addr_const(DataAddr, no)), !CI),
Code = empty
@@ -873,28 +874,17 @@
% For constants, if the deconstruction is det, then we already know
% the value of the constant, so Code = empty.
(
- Tag = string_constant(_String),
- Code = empty
- ;
- Tag = int_constant(_Int),
- Code = empty
- ;
- Tag = float_constant(_Float),
- Code = empty
- ;
- Tag = pred_closure_tag(_, _, _),
- Code = empty
- ;
- Tag = type_ctor_info_constant(_, _, _),
- Code = empty
- ;
- Tag = base_typeclass_info_constant(_, _, _),
- Code = empty
- ;
- Tag = tabling_pointer_constant(_, _),
- Code = empty
- ;
- Tag = deep_profiling_proc_layout_tag(_, _),
+ ( Tag = string_constant(_String)
+ ; Tag = int_constant(_Int)
+ ; Tag = float_constant(_Float)
+ ; Tag = pred_closure_tag(_, _, _)
+ ; Tag = type_ctor_info_constant(_, _, _)
+ ; Tag = base_typeclass_info_constant(_, _, _)
+ ; Tag = tabling_info_constant(_, _)
+ ; Tag = deep_profiling_proc_layout_tag(_, _)
+ ; Tag = shared_local_tag(_Ptag, _Sectag2)
+ ; Tag = reserved_address(_RA)
+ ),
Code = empty
;
Tag = table_io_decl_tag(_, _),
@@ -949,12 +939,6 @@
var_types(!.CI, Args, ArgTypes),
generate_unify_args(Fields, ArgVars, Modes, ArgTypes, Code, !CI)
;
- Tag = shared_local_tag(_Ptag, _Sectag2),
- Code = empty
- ;
- Tag = reserved_address(_RA),
- Code = empty
- ;
% For shared_with_reserved_address, the sharing is only important
% for tag tests, not for det deconstructions, so here we just recurse
% on the real representation.
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.353
diff -u -b -r1.353 reference_manual.texi
--- doc/reference_manual.texi 7 Jun 2006 14:37:37 -0000 1.353
+++ doc/reference_manual.texi 8 Jun 2006 02:08:27 -0000
@@ -1,3 +1,4 @@
+ at c vim: expandtab
\input texinfo
@setfilename mercury_ref.info
@settitle The Mercury Language Reference Manual
@@ -9187,33 +9188,64 @@
For some procedures, this recomputation can be very wasteful.
With tabled evaluation, the implementation keeps a table containing the
-previously computed results of the specified procedure; at each
-procedure call, the implementation will search the table to check
-whether the answer(s) have already been computed and if so, the answers
-will be returned directly from the tables rather than being recomputed.
+previously computed results of the specified procedure;
+this table is sometimes called the memo table
+(since it ``remembers'' previous answers).
+At each procedure call, the implementation will search the memo table
+to check whether the answer(s) have already been computed,
+and if so, the answers will be returned directly from the memo table
+rather than being recomputed.
This can result in much faster execution, at the cost of additional
space to record answers in the table.
-The implementation can optionally also check at runtime for the situation
+The implementation can also check at runtime for the situation
where a procedure calls itself recursively with the same arguments,
which would normally result in a infinite loop;
if this situation is encountered, it can (at the programmer's option)
either throw an exception, or avoid the infinite loop
-by computing solutions using the ``minimal model'' semantics.
+by computing solutions using a ``minimal model'' semantics.
+(Specifically, the minimal model computed by our implementation
+is the perfect model.)
-The current Mercury implementation thus supports
+The current Mercury implementation supports
three different pragmas for tabling, to cover these three cases:
- at samp{pragma memo} does no loop checking,
- at samp{pragma loop_check} checks for loops
-and throws an exception if a loop is detected,
-while @samp{pragma minimal_model} computes the ``minimal model'' semantics.
+ at samp{loop_check}, @samp{memo}, and @samp{minimal_model}.
+The @samp{loop_check} pragma asks only for loop checking.
+With this pragma, the memo table will map each distinct set of input arguments
+only to a single boolean saying whether
+a call with those arguments is currently active or not;
+the pragma's only effect is to cause the predicate to throw an exception
+if this boolean says that the current call has the same arguments
+as one of its ancestors, which indicates an infinite recursive loop.
+The @samp{memo} pragma asks for both loop checking and memoization.
+With this pragma, the memo table will map each distinct set of input arguments
+either to the set of results computed previously for those arguments,
+or to an indication that the call is still active
+and thus those results are still being computed.
+This predicate will thus look for infinite recursive loops
+(and throw an exception if and when it finds one)
+but it will also record all its solutions in the memo table,
+and will avoid recomputing solutions
+that are already available in the memo table.
+The @samp{minimal_model} pragma asks for the computation
+of a ``minimal model'' semantics.
+These differs from the @samp{memo} pragma in that
+the detection of what appears to be an infinite recursive loop is not fatal.
+The implementation will consider the apparently infinitely recursive calls
+to fail if the call concerned has no way of computing any solutions
+it hasn't already computed and recorded,
+and it does have such a way, then it switches the execution to explore
+those ways before coming back to the apparently infinitely recursive call.
The syntax for each of these declarations is
@example
:- pragma memo(@var{Name}/@var{Arity}).
+:- pragma memo(@var{Name}/@var{Arity}, [@var{list of tabling attributes}]).
:- pragma loop_check(@var{Name}/@var{Arity}).
+:- pragma loop_check(@var{Name}/@var{Arity}, [@var{list of tabling attributes}]).
:- pragma minimal_model(@var{Name}/@var{Arity}).
+:- pragma minimal_model(@var{Name}/@var{Arity}, [@var{list of tabling attributes}]).
@end example
@noindent
@@ -9229,46 +9261,93 @@
@example
:- pragma memo(@var{Name}(in, in, out)).
+:- pragma memo(@var{Name}(in, in, out), [@var{list of tabling attributes}]).
:- pragma loop_check(@var{Name}(in, out)).
+:- pragma loop_check(@var{Name}(in, out), [@var{list of tabling attributes}]).
:- pragma minimal_model(@var{Name}(in, in, out, out)).
+:- pragma minimal_model(@var{Name}(in, in, out, out), [@var{list of tabling attributes}]).
@end example
-We also support two faster variants of @samp{pragma memo}
-that may be applicable in some circumstances.
-The implementation of @samp{pragma memo}
-looks up the value of each input argument in the call table,
+Because all variants of tabling record the values of input arguments,
+and all except @samp{loop_check} also record the values of output arguments,
+you cannot apply any of these pragmas to procedures
+whose arguments' modes include any unique component.
+
+The optional list of attributes allows programmers
+to control some aspects of the management of the memo table(s)
+of the procedure(s) affected by the pragma.
+
+The @samp{allow_reset} attribute asks the compiler
+to define a predicate that, when called, resets the memo table.
+The name of this predicate will be ``table_reset_for'',
+followed by the name of the tabled predicate, followed by its arity,
+and (if the predicate has more than one mode) by the mode number
+(the first declared mode is mode 0, the second is mode 1, and so on).
+These three or four components are separated by underscores.
+The reset predicate takes a di/uo pair of I/O states as arguments.
+The presence of these I/O state arguments in the reset predicate,
+and the fact that tabled predicates cannot have unique arguments
+together imply that a memo table cannot be reset
+while a call using that memo table is active.
+
+The @samp{statistics} attribute asks the compiler
+to define a predicate that, when called,
+returns statistics about the memo table.
+The name of this predicate will be ``table_statistics_for'',
+followed by the name of the tabled predicate, followed by its arity,
+and (if the predicate has more than one mode) by the mode number
+(the first declared mode is mode 0, the second is mode 1, and so on).
+These three or four components are separated by underscores.
+The reset predicate takes three arguments.
+The second and third are a di/uo pair of I/O states as arguments,
+while the first is a output argument which contains information
+about accesses to and modifications of the procedure's memo table,
+both since the creation of the table,
+and since the last call to this predicate.
+The type of this argument is defined in the file table_builtin.m
+in the Mercury standard library.
+That module also contains a predicate for printing out this information
+in a programmer-friendly format.
+
+The remaining two attributes, @samp{fast_loose} and @samp{specified},
+control how arguments are looked up in the memo table.
+The default implementation
+looks up the @emph{value} of each input argument,
and thus requires time proportional to
-the number of function symbols in the input arguments
-to look up the current call in the call table.
-The @samp{pragma fast_loose_memo} variant
-looks up only the address of each input argument in the call table,
+the number of function symbols in the input arguments.
+This is the only implementation allowed for minimal model tabling,
+but for predicates tabled with the @samp{loop_check} and @samp{memo} pragmas,
+programmers can also choose some other tabling methods.
+
+The @samp{fast_loose_memo} attribute asks the compiler to generate code
+that looks up only the @emph{address} of each input argument in the memo table,
which means that the time required
-to look up the current call in the call table
-is linear only in the number of input arguments.
+is linear only in the @emph{number} of input arguments, not their @emph{size}.
The tradeoff is that @samp{fast_loose_memo} does not recognize
calls as duplicates if they involve input arguments that are logically equal
but are stored at different locations in memory.
-The following declarations call for this variant of tabling.
+The following declaration calls for this variant of tabling.
@example
-:- pragma fast_loose_memo(@var{Name}/@var{Arity}).
-:- pragma fast_loose_memo(@var{Name}(in, in, out)).
+:- pragma memo(@var{Name}(in, in, in, out),
+ [allow_reset, statistics, fast_loose]).
@end example
-The second variant of @samp{pragma memo} allows programmers to choose
-individually for each input argument whether that argument
-should be looked up in the call table by value or by address,
+The @samp{specified} attribute allows programmers to choose
+individually, for each input argument, whether that argument
+should be looked up in the memo table by value or by address,
or whether it should be looked up at all:
@example
-:- pragma memo(@var{Name}(in, in, in, out),
- [value, addr, promise_implied, output]).
+:- pragma memo(@var{Name}(in, in, in, out), [allow_reset, statistics,
+ specified([value, addr, promise_implied, output])]).
@end example
-The second argument of this form of @samp{pragma memo} should be a list
-with an element for each argument of the predicate or function concerned
-(if a function, last element is for the return value).
-For output arguments, the list element should be @samp{output};
+The @samp{specified} attribute should have an argument which is a list,
+and this list should contain one element
+for each argument of the predicate or function concerned
+(if a function, the last element is for the return value).
+For output arguments, the list element should be @samp{output}.
For input arguments, the list element may be
@samp{value}, @samp{addr} or @samp{promise_implied}.
The first calls for tabling the argument by value,
@@ -9291,29 +9370,30 @@
then this declaration can also be specified without giving the argument modes:
@example
-:- pragma memo(@var{Name}/@var{Arity},
- [value, addr, promise_implied, output]).
+:- pragma memo(@var{Name}/@var{Arity}, [allow_reset, statistics,
+ specified([value, addr, promise_implied, output])]).
@end example
Note that a @samp{pragma minimal_model} declaration
changes the declarative semantics of the specified predicate or function:
instead of using the completion of the clauses as the basis for the semantics,
as is normally the case in Mercury,
-the declarative semantics that is used is the ``minimal model'' semantics.
+the declarative semantics that is used is a ``minimal model'' semantics,
+specifically, the perfect model semantics.
Anything which is true or false in the completion semantics
-is also true or false (respectively) in the minimal model semantics,
-but there are goals for which the minimal model specifies
+is also true or false (respectively) in the perfect model semantics,
+but there are goals for which the perfect model specifies
that the result is true or false,
whereas the completion semantics leaves the result unspecified.
For these goals, the usual Mercury semantics requires the
implementation to either loop or report an error message,
-but the minimal model semantics requires a particular answer to be returned.
-In particular, the minimal model semantics says that
+but the perfect model semantics requires a particular answer to be returned.
+In particular, the perfect model semantics says that
any call that is not true in @emph{all} models is false.
Programmers should therefore use a @samp{pragma minimal_model} declaration
only in cases where their intended interpretation for a procedure
-coincides with the minimal model for that procedure.
+coincides with the perfect model for that procedure.
Fortunately, however, this is usually what programmers intend.
@c XXX give an example
@@ -9329,15 +9409,13 @@
the execution mechanism required by minimal model tabling is quite complicated,
requiring the ability to delay goals and then wake them up again.
The Mercury implementation uses a technique based on
-copying relevant parts of the stack to the heap when delaying goals,
-similar to the one described in
- at c XXX this citation doesn't come out properly in DVI format
- at cite{CAT: the copying approach to tabling},
-by B. Demoen and K. Sagonas. @xref{[5]}.
-This ensures that code which does not use tabling
-does not pay any runtime overheads
-from the more complicated execution mechanism
-required by (minimal model) tabling.
+copying relevant parts of the stack to the heap when delaying goals.
+It is described in
+ at c XXX this citation may not come out properly in DVI format
+ at cite{Tabling in Mercury: design and implementation}
+by Z. Somogyi and K. Sagonas,
+Proceedings of the Eight International Symposium
+on Practical Aspects of Declarative Languages.
@cartouche
@strong{Please note:}
cvs diff: Diffing extras
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/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
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/solver_types
cvs diff: Diffing extras/solver_types/library
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/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
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
Index: library/robdd.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/robdd.m,v
retrieving revision 1.10
diff -u -b -r1.10 robdd.m
--- library/robdd.m 19 Apr 2006 05:17:55 -0000 1.10
+++ library/robdd.m 21 May 2006 17:31:34 -0000
@@ -507,7 +507,7 @@
(int) V);
").
-:- pragma memo(vars_entailed/1).
+% :- pragma memo(vars_entailed/1).
vars_entailed(R) =
( R = one ->
@@ -525,7 +525,7 @@
)
).
-:- pragma memo(vars_disentailed/1).
+% :- pragma memo(vars_disentailed/1).
vars_disentailed(R) =
( R = one ->
@@ -544,7 +544,7 @@
)
).
-:- pragma memo(definite_vars/3).
+% :- pragma memo(definite_vars/3).
definite_vars(R, T, F) :-
( R = one ->
@@ -577,7 +577,7 @@
:- func equivalent_vars_2(robdd(T)) =
entailment_result(leader_to_eqvclass(T)).
-:- pragma memo(equivalent_vars_2/1).
+% :- pragma memo(equivalent_vars_2/1).
equivalent_vars_2(R) = EQ :-
( R = one ->
@@ -650,7 +650,7 @@
:- type imp_res_2(T) ---> imps(map(var(T), vars_entailed_result(T))).
:- func implications_2(robdd(T)) = implication_result(T).
-:- pragma memo(implications_2/1).
+% :- pragma memo(implications_2/1).
implications_2(R) = implication_result(Imps, RevImps, DisImps, RevDisImps) :-
( R = one ->
@@ -858,7 +858,7 @@
%------------------------------------------------------------------------%
-:- pragma memo(dnf/1).
+% :- pragma memo(dnf/1).
dnf(R) =
( R = zero ->
@@ -958,7 +958,7 @@
(MR_ROBDD_node *) F);
").
-:- pragma memo(rename_vars/2).
+% :- pragma memo(rename_vars/2).
rename_vars(Subst, F) =
( is_terminal(F) ->
@@ -1043,7 +1043,7 @@
), list.reverse(to_sorted_list(Vars)),
OneOf0, R, NoneOf0, _).
-:- pragma memo(var_restrict_true/2).
+% :- pragma memo(var_restrict_true/2).
var_restrict_true(V, F0) = F :-
( is_terminal(F0) ->
@@ -1064,7 +1064,7 @@
)
).
-:- pragma memo(var_restrict_false/2).
+% :- pragma memo(var_restrict_false/2).
var_restrict_false(V, F0) = F :-
( is_terminal(F0) ->
Index: library/table_builtin.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/table_builtin.m,v
retrieving revision 1.53
diff -u -b -r1.53 table_builtin.m
--- library/table_builtin.m 19 Apr 2006 05:17:58 -0000 1.53
+++ library/table_builtin.m 6 Jun 2006 06:17:08 -0000
@@ -31,6 +31,9 @@
:- module table_builtin.
:- interface.
+:- import_module maybe.
+:- import_module list.
+
% This section of the module contains the predicates that are
% automatically inserted by the table_gen pass of the compiler
% into predicates that use tabling, and the types they use.
@@ -106,17 +109,70 @@
%
:- type ml_trie_node.
- % This type represents the blocks we use to store sets of output
- % arguments.
+ % This type represents the blocks we use to store sets of output arguments.
%
:- type ml_answer_block.
+ % This type represents the data structure the implementation uses to store
+ % information related to a given procedure.
+ %
+:- type ml_proc_table_info.
+
+:- type proc_table_statistics
+ ---> proc_table_statistics(
+ call_table_stats :: table_stats_pair,
+ maybe_answer_table_stats :: maybe(table_stats_pair)
+ ).
+
+:- type table_stats_pair
+ ---> table_stats_pair(
+ overall_stats :: table_stats,
+ stats_since_last :: table_stats
+ ).
+
+:- type table_stats
+ ---> table_stats(
+ num_lookups :: int,
+ num_lookups_not_duplicate :: int,
+ step_statistics :: list(table_step_stats)
+ ).
+
+:- type table_step_kind
+ ---> table_step_dummy
+ ; table_step_int
+ ; table_step_char
+ ; table_step_string
+ ; table_step_float
+ ; table_step_enum
+ ; table_step_user
+ ; table_step_user_fast_loose
+ ; table_step_poly
+ ; table_step_poly_fast_loose
+ ; table_step_typeinfo
+ ; table_step_typeclassinfo
+ ; table_step_promise_implied.
+
+:- type table_step_stats
+ ---> table_step_stats(
+ table_step_kind :: table_step_kind,
+ step_num_allocs :: int,
+ step_num_inserts :: int,
+ step_num_lookups :: int,
+ step_num_insert_probes :: int,
+ step_num_lookup_probes :: int,
+ step_num_resizes :: int,
+ step_num_resizes_old_entries :: int,
+ step_num_resizes_new_entries :: int
+ ).
+
% N.B. interface continued below
%-----------------------------------------------------------------------------%
:- implementation.
+:- import_module int.
+
% This type represents the interior pointers of both call
% tables and answer tables.
%
@@ -133,6 +189,255 @@
[can_pass_as_mercury_type]).
:- pragma foreign_type(il, ml_answer_block, "class [mscorlib]System.Object").
+:- type ml_proc_table_info ---> ml_proc_table_info(c_pointer).
+:- pragma foreign_type("C", ml_proc_table_info, "MR_ProcTableInfoPtr",
+ [can_pass_as_mercury_type]).
+:- pragma foreign_type(il, ml_proc_table_info,
+ "class [mscorlib]System.Object").
+
+:- pred get_tabling_stats(ml_proc_table_info::in, proc_table_statistics::out,
+ io::di, io::uo) is det.
+:- pragma export(get_tabling_stats(in, out, di, uo), "MR_get_tabling_stats").
+
+get_tabling_stats(Info, Statistics, !IO) :-
+ get_direct_fields(Info, AnswerTable, NumInputs, NumOutputs,
+ CallTableLookups, CallTableNotDupl,
+ PrevCallTableLookups, PrevCallTableNotDupl,
+ AnswerTableLookups, AnswerTableNotDupl,
+ PrevAnswerTableLookups, PrevAnswerTableNotDupl, !IO),
+ get_all_input_step_stats(Info, NumInputs - 1,
+ [], CurCallTableStepStats, [], PrevCallTableStepStats, !IO),
+ CurCallTableStats = table_stats(CallTableLookups,
+ CallTableNotDupl, CurCallTableStepStats),
+ PrevCallTableStats = table_stats(PrevCallTableLookups,
+ PrevCallTableNotDupl, PrevCallTableStepStats),
+ CallTableStats = table_stats_pair(CurCallTableStats, PrevCallTableStats),
+ ( AnswerTable > 0 ->
+ get_all_output_step_stats(Info, NumOutputs - 1,
+ [], CurAnswerTableStepStats, [], PrevAnswerTableStepStats, !IO),
+ CurAnswerTableStats = table_stats(AnswerTableLookups,
+ AnswerTableNotDupl, CurAnswerTableStepStats),
+ PrevAnswerTableStats = table_stats(PrevAnswerTableLookups,
+ PrevAnswerTableNotDupl, PrevAnswerTableStepStats),
+ AnswerTableStats = table_stats_pair(CurAnswerTableStats,
+ PrevAnswerTableStats),
+ MaybeAnswerTableStats = yes(AnswerTableStats)
+ ;
+ MaybeAnswerTableStats = no
+ ),
+ Statistics = proc_table_statistics(CallTableStats, MaybeAnswerTableStats),
+ copy_current_stats_to_prev(Info, !IO).
+
+:- pred get_direct_fields(ml_proc_table_info::in, int::out, int::out, int::out,
+ int::out, int::out, int::out, int::out,
+ int::out, int::out, int::out, int::out,
+ io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ get_direct_fields(Info::in, AnswerTable::out, Inputs::out, Outputs::out,
+ CallTableLookups::out, CallTableNotDupl::out,
+ PrevCallTableLookups::out, PrevCallTableNotDupl::out,
+ AnswerTableLookups::out, AnswerTableNotDupl::out,
+ PrevAnswerTableLookups::out, PrevAnswerTableNotDupl::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ AnswerTable = ( Info->MR_pt_has_answer_table ? 1 : 0 );
+ Inputs = Info->MR_pt_num_inputs;
+ Outputs = Info->MR_pt_num_outputs;
+ CallTableLookups = Info->MR_pt_call_table_lookups;
+ PrevCallTableLookups = Info->MR_pt_prev_call_table_lookups;
+ CallTableNotDupl = Info->MR_pt_call_table_not_dupl;
+ PrevCallTableNotDupl = Info->MR_pt_prev_call_table_not_dupl;
+ AnswerTableLookups = Info->MR_pt_answer_table_lookups;
+ PrevAnswerTableLookups = Info->MR_pt_prev_answer_table_lookups;
+ AnswerTableNotDupl = Info->MR_pt_answer_table_not_dupl;
+ PrevAnswerTableNotDupl = Info->MR_pt_prev_answer_table_not_dupl;
+").
+
+:- pred get_all_input_step_stats(ml_proc_table_info::in, int::in,
+ list(table_step_stats)::in, list(table_step_stats)::out,
+ list(table_step_stats)::in, list(table_step_stats)::out,
+ io::di, io::uo) is det.
+
+get_all_input_step_stats(Info, CurSlot, !CurStepStats, !PrevStepStats, !IO) :-
+ ( CurSlot < 0 ->
+ true
+ ;
+ get_input_step_stats(Info, CurSlot, Kind,
+ NumAllocs, NumInserts, NumLookups,
+ NumInsertProbes, NumLookupProbes,
+ NumResizes, NumResizesOld, NumResizesNew,
+ PrevNumAllocs, PrevNumInserts, PrevNumLookups,
+ PrevNumInsertProbes, PrevNumLookupProbes,
+ PrevNumResizes, PrevNumResizesOld, PrevNumResizesNew, !IO),
+ Cur = table_step_stats(Kind, NumAllocs,
+ NumInserts, NumLookups,
+ NumInsertProbes, NumLookupProbes,
+ NumResizes, NumResizesOld, NumResizesNew),
+ Prev = table_step_stats(Kind, PrevNumAllocs,
+ PrevNumInserts, PrevNumLookups,
+ PrevNumInsertProbes, PrevNumLookupProbes,
+ PrevNumResizes, PrevNumResizesOld, PrevNumResizesNew),
+ !:CurStepStats = [Cur | !.CurStepStats],
+ !:PrevStepStats = [Prev | !.PrevStepStats],
+ get_all_input_step_stats(Info, CurSlot - 1,
+ !CurStepStats, !PrevStepStats, !IO)
+ ).
+
+:- pred get_all_output_step_stats(ml_proc_table_info::in, int::in,
+ list(table_step_stats)::in, list(table_step_stats)::out,
+ list(table_step_stats)::in, list(table_step_stats)::out,
+ io::di, io::uo) is det.
+
+get_all_output_step_stats(Info, CurSlot, !CurStepStats, !PrevStepStats, !IO) :-
+ ( CurSlot < 0 ->
+ true
+ ;
+ get_output_step_stats(Info, CurSlot, Kind,
+ NumAllocs, NumInserts, NumLookups,
+ NumInsertProbes, NumLookupProbes,
+ NumResizes, NumResizesOld, NumResizesNew,
+ PrevNumAllocs, PrevNumInserts, PrevNumLookups,
+ PrevNumInsertProbes, PrevNumLookupProbes,
+ PrevNumResizes, PrevNumResizesOld, PrevNumResizesNew, !IO),
+ Cur = table_step_stats(Kind, NumAllocs,
+ NumInserts, NumLookups,
+ NumInsertProbes, NumLookupProbes,
+ NumResizes, NumResizesOld, NumResizesNew),
+ Prev = table_step_stats(Kind, PrevNumAllocs,
+ PrevNumInserts, PrevNumLookups,
+ PrevNumInsertProbes, PrevNumLookupProbes,
+ PrevNumResizes, PrevNumResizesOld, PrevNumResizesNew),
+ !:CurStepStats = [Cur | !.CurStepStats],
+ !:PrevStepStats = [Prev | !.PrevStepStats],
+ get_all_output_step_stats(Info, CurSlot - 1,
+ !CurStepStats, !PrevStepStats, !IO)
+ ).
+
+:- pred get_input_step_stats(ml_proc_table_info::in, int::in,
+ table_step_kind::out,
+ int::out, int::out, int::out, int::out, int::out,
+ int::out, int::out, int::out,
+ int::out, int::out, int::out, int::out, int::out,
+ int::out, int::out, int::out,
+ io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ get_input_step_stats(Info::in, ArgNum::in, Kind::out,
+ NumAllocs::out, NumInserts::out, NumLookups::out,
+ NumInsertProbes::out, NumLookupProbes::out,
+ NumResizes::out, NumResizesOld::out, NumResizesNew::out,
+ PrevNumAllocs::out, PrevNumInserts::out, PrevNumLookups::out,
+ PrevNumInsertProbes::out, PrevNumLookupProbes::out,
+ PrevNumResizes::out, PrevNumResizesOld::out, PrevNumResizesNew::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ MR_TableStepStats *cur;
+ MR_TableStepStats *prev;
+
+ Kind = Info->MR_pt_input_steps[ArgNum];
+
+ cur = &Info->MR_pt_call_table_stats[ArgNum];
+ prev = &Info->MR_pt_prev_call_table_stats[ArgNum];
+
+ NumAllocs = cur->MR_tss_num_allocs;
+ NumInserts = cur->MR_tss_num_inserts;
+ NumLookups = cur->MR_tss_num_lookups;
+ NumInsertProbes = cur->MR_tss_num_insert_probes;
+ NumLookupProbes = cur->MR_tss_num_lookup_probes;
+ NumResizes = cur->MR_tss_num_resizes;
+ NumResizesOld = cur->MR_tss_num_resizes_old_entries;
+ NumResizesNew = cur->MR_tss_num_resizes_new_entries;
+
+ PrevNumAllocs = prev->MR_tss_num_allocs;
+ PrevNumInserts = prev->MR_tss_num_inserts;
+ PrevNumLookups = prev->MR_tss_num_lookups;
+ PrevNumInsertProbes = prev->MR_tss_num_insert_probes;
+ PrevNumLookupProbes = prev->MR_tss_num_lookup_probes;
+ PrevNumResizes = prev->MR_tss_num_resizes;
+ PrevNumResizesOld = prev->MR_tss_num_resizes_old_entries;
+ PrevNumResizesNew = prev->MR_tss_num_resizes_new_entries;
+").
+
+:- pred get_output_step_stats(ml_proc_table_info::in, int::in,
+ table_step_kind::out,
+ int::out, int::out, int::out, int::out, int::out,
+ int::out, int::out, int::out,
+ int::out, int::out, int::out, int::out, int::out,
+ int::out, int::out, int::out,
+ io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ get_output_step_stats(Info::in, ArgNum::in, Kind::out,
+ NumAllocs::out, NumInserts::out, NumLookups::out,
+ NumInsertProbes::out, NumLookupProbes::out,
+ NumResizes::out, NumResizesOld::out, NumResizesNew::out,
+ PrevNumAllocs::out, PrevNumInserts::out, PrevNumLookups::out,
+ PrevNumInsertProbes::out, PrevNumLookupProbes::out,
+ PrevNumResizes::out, PrevNumResizesOld::out, PrevNumResizesNew::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ MR_TableStepStats *cur;
+ MR_TableStepStats *prev;
+
+ Kind = Info->MR_pt_output_steps[ArgNum];
+
+ cur = &Info->MR_pt_answer_table_stats[ArgNum];
+ prev = &Info->MR_pt_prev_answer_table_stats[ArgNum];
+
+ NumAllocs = cur->MR_tss_num_allocs;
+ NumInserts = cur->MR_tss_num_inserts;
+ NumLookups = cur->MR_tss_num_lookups;
+ NumInsertProbes = cur->MR_tss_num_insert_probes;
+ NumLookupProbes = cur->MR_tss_num_lookup_probes;
+ NumResizes = cur->MR_tss_num_resizes;
+ NumResizesOld = cur->MR_tss_num_resizes_old_entries;
+ NumResizesNew = cur->MR_tss_num_resizes_new_entries;
+
+ PrevNumAllocs = prev->MR_tss_num_allocs;
+ PrevNumInserts = prev->MR_tss_num_inserts;
+ PrevNumLookups = prev->MR_tss_num_lookups;
+ PrevNumInsertProbes = prev->MR_tss_num_insert_probes;
+ PrevNumLookupProbes = prev->MR_tss_num_lookup_probes;
+ PrevNumResizes = prev->MR_tss_num_resizes;
+ PrevNumResizesOld = prev->MR_tss_num_resizes_old_entries;
+ PrevNumResizesNew = prev->MR_tss_num_resizes_new_entries;
+").
+
+:- pred copy_current_stats_to_prev(ml_proc_table_info::in,
+ io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ copy_current_stats_to_prev(Info::in, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ int i;
+ MR_TableStepStats *cur;
+ MR_TableStepStats *prev;
+
+ Info->MR_pt_prev_call_table_lookups = Info->MR_pt_call_table_lookups;
+ Info->MR_pt_prev_call_table_not_dupl = Info->MR_pt_call_table_not_dupl;
+ Info->MR_pt_prev_answer_table_lookups = Info->MR_pt_answer_table_lookups;
+ Info->MR_pt_prev_answer_table_not_dupl = Info->MR_pt_answer_table_not_dupl;
+
+ for (i = 0; i < Info->MR_pt_num_inputs; i++) {
+ cur = &Info->MR_pt_call_table_stats[i];
+ prev = &Info->MR_pt_prev_call_table_stats[i];
+ MR_copy_table_step_stats(prev, cur);
+ }
+
+ if (Info->MR_pt_has_answer_table) {
+ for (i = 0; i < Info->MR_pt_num_outputs; i++) {
+ cur = &Info->MR_pt_answer_table_stats[i];
+ prev = &Info->MR_pt_prev_answer_table_stats[i];
+ MR_copy_table_step_stats(prev, cur);
+ }
+ }
+").
+
%-----------------------------------------------------------------------------%
:- interface.
@@ -179,35 +484,35 @@
table_loop_setup(T::in, Status::out),
[will_not_call_mercury],
"
- MR_table_loop_setup(T, Status);
+ MR_tbl_loop_setup(MR_TABLE_DEBUG_BOOL, MR_FALSE, T, Status);
").
:- pragma foreign_proc("C",
table_loop_setup_shortcut(T0::in, T::out, Status::out),
[will_not_call_mercury],
"
- MR_table_loop_setup_shortcut(T0, T, Status);
+ MR_tbl_loop_setup_shortcut(T0, T, Status);
").
:- pragma foreign_proc("C",
table_loop_mark_as_inactive(T::in),
[will_not_call_mercury],
"
- MR_table_loop_mark_as_inactive(T);
+ MR_tbl_loop_mark_as_inactive(MR_TABLE_DEBUG_BOOL, T);
").
:- pragma foreign_proc("C",
table_loop_mark_as_inactive_and_fail(T::in),
[will_not_call_mercury],
"
- MR_table_loop_mark_as_inactive_and_fail(T);
+ MR_tbl_loop_mark_as_inactive_and_fail(MR_TABLE_DEBUG_BOOL, T);
").
:- pragma foreign_proc("C",
table_loop_mark_as_active_and_fail(T::in),
[will_not_call_mercury],
"
- MR_table_loop_mark_as_active_and_fail(T);
+ MR_tbl_loop_mark_as_active_and_fail(MR_TABLE_DEBUG_BOOL, T);
").
table_loop_setup(_, _) :-
@@ -372,119 +677,121 @@
table_memo_det_setup(T::in, Status::out),
[will_not_call_mercury],
"
- MR_table_memo_det_setup(T, Status);
+ MR_tbl_memo_det_setup(MR_TABLE_DEBUG_BOOL, MR_FALSE, T, Status);
").
:- pragma foreign_proc("C",
table_memo_det_setup_shortcut(T0::in, T::out, Status::out),
[will_not_call_mercury],
"
- MR_table_memo_det_setup_shortcut(T0, T, Status);
+ MR_tbl_memo_det_setup_shortcut(T0, T, Status);
").
:- pragma foreign_proc("C",
table_memo_semi_setup(T::in, Status::out),
[will_not_call_mercury],
"
- MR_table_memo_semi_setup(T, Status);
+ MR_tbl_memo_semi_setup(MR_TABLE_DEBUG_BOOL, MR_FALSE, T, Status);
").
:- pragma foreign_proc("C",
table_memo_semi_setup_shortcut(T0::in, T::out, Status::out),
[will_not_call_mercury],
"
- MR_table_memo_semi_setup_shortcut(T0, T, Status);
+ MR_tbl_memo_semi_setup_shortcut(T0, T, Status);
").
:- pragma foreign_proc("C",
table_memo_non_setup(T0::in, Record::out, Status::out),
[will_not_call_mercury],
"
- MR_table_memo_non_setup(T0, Record, Status);
+ MR_tbl_memo_non_setup(MR_TABLE_DEBUG_BOOL, MR_FALSE, T0, Record, Status);
").
:- pragma foreign_proc("C",
table_memo_mark_as_failed(T::in),
[will_not_call_mercury],
"
- MR_table_memo_mark_as_failed(T);
+ MR_tbl_memo_mark_as_failed(MR_TABLE_DEBUG_BOOL, T);
").
:- pragma foreign_proc("C",
table_memo_mark_as_succeeded(T::in),
[will_not_call_mercury],
"
- MR_table_memo_mark_as_succeeded(T);
+ MR_tbl_memo_mark_as_succeeded(MR_TABLE_DEBUG_BOOL, T);
").
:- pragma foreign_proc("C",
table_memo_mark_as_incomplete(R::in),
[will_not_call_mercury],
"
- MR_table_memo_mark_as_incomplete(R);
+ MR_tbl_memo_mark_as_incomplete(MR_TABLE_DEBUG_BOOL, R);
").
:- pragma foreign_proc("C",
table_memo_mark_as_active_and_fail(R::in),
[will_not_call_mercury],
"
- MR_table_memo_mark_as_active_and_fail(R);
+ MR_tbl_memo_mark_as_active_and_fail(MR_TABLE_DEBUG_BOOL, R);
").
:- pragma foreign_proc("C",
table_memo_mark_as_complete_and_fail(R::in),
[will_not_call_mercury],
"
- MR_table_memo_mark_as_complete_and_fail(R);
+ MR_tbl_memo_mark_as_complete_and_fail(MR_TABLE_DEBUG_BOOL, R);
").
:- pragma foreign_proc("C",
table_memo_create_answer_block(T::in, Size::in, AnswerBlock::out),
[will_not_call_mercury],
"
- MR_table_memo_create_answer_block(T, Size, AnswerBlock);
+ MR_tbl_memo_create_answer_block(MR_TABLE_DEBUG_BOOL,
+ T, Size, AnswerBlock);
").
:- pragma foreign_proc("C",
table_memo_fill_answer_block_shortcut(T::in),
[will_not_call_mercury],
"
- MR_table_memo_fill_answer_block_shortcut(T);
+ MR_tbl_memo_fill_answer_block_shortcut(T);
").
:- pragma foreign_proc("C",
table_memo_get_answer_block(T::in, AnswerBlock::out),
[will_not_call_mercury, promise_semipure],
"
- MR_table_memo_get_answer_block(T, AnswerBlock);
+ MR_tbl_memo_get_answer_block(MR_TABLE_DEBUG_BOOL, T, AnswerBlock);
").
:- pragma foreign_proc("C",
table_memo_get_answer_block_shortcut(T::in),
[will_not_call_mercury, promise_semipure],
"
- MR_table_memo_get_answer_block_shortcut(T);
+ MR_tbl_memo_get_answer_block_shortcut(T);
").
:- pragma foreign_proc("C",
table_memo_non_get_answer_table(R::in, AT::out),
[will_not_call_mercury, promise_semipure],
"
- MR_table_memo_non_get_answer_table(R, AT);
+ MR_tbl_memo_non_get_answer_table(MR_TABLE_DEBUG_BOOL, R, AT);
").
:- pragma foreign_proc("C",
table_memo_non_answer_is_not_duplicate(T::in),
[will_not_call_mercury],
"
- MR_table_memo_non_answer_is_not_duplicate(T, SUCCESS_INDICATOR);
+ MR_tbl_memo_non_answer_is_not_duplicate(MR_TABLE_DEBUG_BOOL,
+ T, SUCCESS_INDICATOR);
").
:- pragma foreign_proc("C",
table_memo_non_answer_is_not_duplicate_shortcut(R::in),
[will_not_call_mercury],
"
- MR_table_memo_non_answer_is_not_duplicate_shortcut(R,
+ MR_tbl_memo_non_answer_is_not_duplicate_shortcut(R,
SUCCESS_INDICATOR);
").
@@ -492,14 +799,14 @@
table_memo_non_create_answer_block_shortcut(R::in),
[will_not_call_mercury],
"
- MR_table_memo_non_create_answer_block_shortcut(R::in);
+ MR_tbl_memo_non_create_answer_block_shortcut(R::in);
").
:- pragma foreign_proc("C",
table_memo_non_return_all_shortcut(R::in),
[will_not_call_mercury, promise_semipure],
"
- MR_table_memo_non_return_all_shortcut(R);
+ MR_tbl_memo_non_return_all_shortcut(R);
").
:- external(table_memo_return_all_answers_nondet/2).
@@ -718,6 +1025,7 @@
% program.
:- pragma foreign_decl("C", "
+ #include ""mercury_tabling.h"" /* for MR_copy_table_steps */
#include ""mercury_trace_base.h"" /* for MR_io_tabling_* */
").
@@ -725,14 +1033,15 @@
table_io_in_range(T::out, Counter::out, Start::out),
[will_not_call_mercury],
"
- MR_table_io_in_range(T, Counter, Start, SUCCESS_INDICATOR);
+ MR_tbl_io_in_range(MR_TABLE_DEBUG_BOOL, T, Counter, Start,
+ SUCCESS_INDICATOR);
").
:- pragma foreign_proc("C",
table_io_has_occurred(T::in),
[will_not_call_mercury],
"
- MR_table_io_has_occurred(T, SUCCESS_INDICATOR);
+ MR_tbl_io_has_occurred(MR_TABLE_DEBUG_BOOL, T, SUCCESS_INDICATOR);
").
table_io_copy_io_state(IO, IO).
@@ -741,14 +1050,14 @@
table_io_left_bracket_unitized_goal(TraceEnabled::out),
[will_not_call_mercury],
"
- MR_table_io_left_bracket_unitized_goal(TraceEnabled);
+ MR_tbl_io_left_bracket_unitized_goal(TraceEnabled);
").
:- pragma foreign_proc("C",
table_io_right_bracket_unitized_goal(TraceEnabled::in),
[will_not_call_mercury],
"
- MR_table_io_right_bracket_unitized_goal(TraceEnabled);
+ MR_tbl_io_right_bracket_unitized_goal(TraceEnabled);
").
table_io_in_range(_, _, _) :-
@@ -874,7 +1183,7 @@
table_mm_setup(T::in, Subgoal::out, Status::out),
[will_not_call_mercury],
"
- MR_table_mm_setup(T, Subgoal, Status);
+ MR_tbl_mm_setup(MR_TABLE_DEBUG_BOOL, MR_FALSE, T, Subgoal, Status);
").
% The definitions of these two predicates are in the runtime system,
@@ -889,21 +1198,22 @@
table_mm_return_all_shortcut(AnswerBlock::in),
[will_not_call_mercury, promise_semipure],
"
- MR_table_mm_return_all_shortcut(AnswerBlock);
+ MR_tbl_mm_return_all_shortcut(AnswerBlock);
").
:- pragma foreign_proc("C",
table_mm_get_answer_table(Subgoal::in, AnswerTable::out),
[will_not_call_mercury, promise_semipure],
"
- MR_table_mm_get_answer_table(Subgoal, AnswerTable);
+ MR_tbl_mm_get_answer_table(MR_TABLE_DEBUG_BOOL, Subgoal, AnswerTable);
").
:- pragma foreign_proc("C",
table_mm_answer_is_not_duplicate(TrieNode::in),
[will_not_call_mercury],
"
- MR_table_mm_answer_is_not_duplicate(TrieNode, SUCCESS_INDICATOR);
+ MR_tbl_mm_answer_is_not_duplicate(MR_TABLE_DEBUG_BOOL, TrieNode,
+ SUCCESS_INDICATOR);
").
:- pragma foreign_proc("C",
@@ -923,14 +1233,15 @@
table_mm_create_answer_block(Subgoal::in, Size::in, AnswerBlock::out),
[will_not_call_mercury],
"
- MR_table_mm_create_answer_block(Subgoal, Size, AnswerBlock);
+ MR_tbl_mm_create_answer_block(MR_TABLE_DEBUG_BOOL,
+ Subgoal, Size, AnswerBlock);
").
:- pragma foreign_proc("C",
table_mm_fill_answer_block_shortcut(Subgoal::in),
[will_not_call_mercury],
"
- MR_table_mm_fill_answer_block_shortcut(Subgoal);
+ MR_tbl_mm_fill_answer_block_shortcut(Subgoal);
").
table_mm_return_all_shortcut(_) :-
@@ -1147,7 +1458,7 @@
[will_not_call_mercury, promise_semipure],
"
/*
- MR_table_mmos_get_answer_table(Generator, TrieNode);
+ MR_tbl_mmos_get_answer_table(Generator, TrieNode);
*/
").
@@ -1170,7 +1481,7 @@
[will_not_call_mercury],
"
/*
- MR_table_mmos_create_answer_block(Generator, BlockSize, AnswerBlock);
+ MR_tbl_mmos_create_answer_block(Generator, BlockSize, AnswerBlock);
*/
").
@@ -1179,7 +1490,7 @@
[will_not_call_mercury],
"
/*
- MR_table_mmos_return_answer(Generator, AnswerBlock);
+ MR_tbl_mmos_return_answer(Generator, AnswerBlock);
*/
").
@@ -1188,7 +1499,7 @@
[will_not_call_mercury],
"
/*
- MR_table_mmos_completion(Generator);
+ MR_tbl_mmos_completion(Generator);
*/
").
@@ -1404,84 +1715,91 @@
table_lookup_insert_int(T0::in, V::in, T::out),
[will_not_call_mercury],
"
- MR_table_lookup_insert_int(T0, V, T);
+ MR_tbl_lookup_insert_int(NULL, MR_TABLE_DEBUG_BOOL, MR_FALSE, T0, V, T);
").
:- pragma foreign_proc("C",
table_lookup_insert_start_int(T0::in, S::in, V::in, T::out),
[will_not_call_mercury],
"
- MR_table_lookup_insert_start_int(T0, S, V, T);
+ MR_tbl_lookup_insert_start_int(NULL, MR_TABLE_DEBUG_BOOL, MR_FALSE,
+ T0, S, V, T);
").
:- pragma foreign_proc("C",
table_lookup_insert_char(T0::in, V::in, T::out),
[will_not_call_mercury],
"
- MR_table_lookup_insert_char(T0, V, T);
+ MR_tbl_lookup_insert_char(NULL, MR_TABLE_DEBUG_BOOL, MR_FALSE, T0, V, T);
").
:- pragma foreign_proc("C",
table_lookup_insert_string(T0::in, V::in, T::out),
[will_not_call_mercury],
"
- MR_table_lookup_insert_string(T0, V, T);
+ MR_tbl_lookup_insert_string(NULL, MR_TABLE_DEBUG_BOOL, MR_FALSE, T0, V, T);
").
:- pragma foreign_proc("C",
table_lookup_insert_float(T0::in, V::in, T::out),
[will_not_call_mercury],
"
- MR_table_lookup_insert_float(T0, V, T);
+ MR_tbl_lookup_insert_float(NULL, MR_TABLE_DEBUG_BOOL, MR_FALSE, T0, V, T);
").
:- pragma foreign_proc("C",
table_lookup_insert_enum(T0::in, R::in, V::in, T::out),
[will_not_call_mercury],
"
- MR_table_lookup_insert_enum(T0, R, V, T);
+ MR_tbl_lookup_insert_enum(NULL, MR_TABLE_DEBUG_BOOL, MR_FALSE, T0,
+ R, V, T);
").
:- pragma foreign_proc("C",
table_lookup_insert_user(T0::in, V::in, T::out),
[will_not_call_mercury],
"
- MR_table_lookup_insert_user(T0, TypeInfo_for_T, V, T);
+ MR_tbl_lookup_insert_user(NULL, MR_TABLE_DEBUG_BOOL, MR_FALSE, T0,
+ TypeInfo_for_T, V, T);
").
:- pragma foreign_proc("C",
table_lookup_insert_user_fast_loose(T0::in, V::in, T::out),
[will_not_call_mercury],
"
- MR_table_lookup_insert_user_fast_loose(T0, TypeInfo_for_T, V, T);
+ MR_tbl_lookup_insert_user_addr(NULL, MR_TABLE_DEBUG_BOOL, MR_FALSE, T0,
+ TypeInfo_for_T, V, T);
").
:- pragma foreign_proc("C",
table_lookup_insert_poly(T0::in, V::in, T::out),
[will_not_call_mercury],
"
- MR_table_lookup_insert_poly(T0, TypeInfo_for_T, V, T);
+ MR_tbl_lookup_insert_poly(NULL, MR_TABLE_DEBUG_BOOL, MR_FALSE, T0,
+ TypeInfo_for_T, V, T);
").
:- pragma foreign_proc("C",
table_lookup_insert_poly_fast_loose(T0::in, V::in, T::out),
[will_not_call_mercury],
"
- MR_table_lookup_insert_poly_fast_loose(T0, TypeInfo_for_T, V, T);
+ MR_tbl_lookup_insert_poly_addr(NULL, MR_TABLE_DEBUG_BOOL, MR_FALSE, T0,
+ TypeInfo_for_T, V, T);
").
:- pragma foreign_proc("C",
table_lookup_insert_typeinfo(T0::in, V::in, T::out),
[will_not_call_mercury],
"
- MR_table_lookup_insert_typeinfo(T0, V, T);
+ MR_tbl_lookup_insert_typeinfo(NULL, MR_TABLE_DEBUG_BOOL, MR_FALSE, T0, V, T);
").
:- pragma foreign_proc("C",
table_lookup_insert_typeclassinfo(T0::in, V::in, T::out),
[will_not_call_mercury],
"
- MR_table_lookup_insert_typeclassinfo(T0, V, T);
+ MR_tbl_lookup_insert_typeclassinfo(NULL, MR_TABLE_DEBUG_BOOL, MR_FALSE,
+ T0, V, T);
").
%-----------------------------------------------------------------------------%
@@ -1490,84 +1808,85 @@
table_save_int_answer(AB::in, Offset::in, V::in),
[will_not_call_mercury],
"
- MR_table_save_int_answer(AB, Offset, V);
+ MR_tbl_save_int_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],
"
- MR_table_save_char_answer(AB, Offset, V);
+ MR_tbl_save_char_answer(MR_TABLE_DEBUG_BOOL, AB, Offset, V);
").
:- pragma foreign_proc("C",
table_save_string_answer(AB::in, Offset::in, V::in),
[will_not_call_mercury],
"
- MR_table_save_string_answer(AB, Offset, V);
+ MR_tbl_save_string_answer(MR_TABLE_DEBUG_BOOL, AB, Offset, V);
").
:- pragma foreign_proc("C",
table_save_float_answer(AB::in, Offset::in, V::in),
[will_not_call_mercury],
"
- MR_table_save_float_answer(AB, Offset, V);
+ MR_tbl_save_float_answer(MR_TABLE_DEBUG_BOOL, AB, Offset, V);
").
:- pragma foreign_proc("C",
table_save_io_state_answer(AB::in, Offset::in, V::ui),
[will_not_call_mercury],
"
- MR_table_save_io_state_answer(AB, Offset, V);
+ MR_tbl_save_io_state_answer(MR_TABLE_DEBUG_BOOL, AB, Offset, V);
").
:- pragma foreign_proc("C",
table_save_any_answer(AB::in, Offset::in, V::in),
[will_not_call_mercury],
"
- MR_table_save_any_answer(AB, Offset, TypeInfo_for_T, V);
+ MR_tbl_save_any_answer(MR_TABLE_DEBUG_BOOL, AB, Offset,
+ TypeInfo_for_T, V);
").
:- pragma foreign_proc("C",
table_restore_int_answer(AB::in, Offset::in, V::out),
[will_not_call_mercury, promise_semipure],
"
- MR_table_restore_int_answer(AB, Offset, V);
+ MR_tbl_restore_int_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],
"
- MR_table_restore_char_answer(AB, Offset, V);
+ MR_tbl_restore_char_answer(MR_TABLE_DEBUG_BOOL, AB, Offset, V);
").
:- pragma foreign_proc("C",
table_restore_string_answer(AB::in, Offset::in, V::out),
[will_not_call_mercury, promise_semipure],
"
- MR_table_restore_string_answer(AB, Offset, V);
+ MR_tbl_restore_string_answer(MR_TABLE_DEBUG_BOOL, AB, Offset, V);
").
:- pragma foreign_proc("C",
table_restore_float_answer(AB::in, Offset::in, V::out),
[will_not_call_mercury, promise_semipure],
"
- MR_table_restore_float_answer(AB, Offset, V);
+ MR_tbl_restore_float_answer(MR_TABLE_DEBUG_BOOL, AB, Offset, V);
").
:- pragma foreign_proc("C",
table_restore_io_state_answer(AB::in, Offset::in, V::uo),
[will_not_call_mercury, promise_semipure],
"
- MR_table_restore_io_state_answer(AB, Offset, V);
+ MR_tbl_restore_io_state_answer(MR_TABLE_DEBUG_BOOL, AB, Offset, V);
").
:- pragma foreign_proc("C",
table_restore_any_answer(AB::in, Offset::in, V::out),
[will_not_call_mercury, promise_semipure],
"
- MR_table_restore_any_answer(AB, Offset, V);
+ MR_tbl_restore_any_answer(MR_TABLE_DEBUG_BOOL, AB, Offset, V);
").
table_error(Message) :-
cvs diff: Diffing mdbcomp
Index: mdbcomp/mdbcomp.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/mdbcomp/mdbcomp.m,v
retrieving revision 1.4
diff -u -b -r1.4 mdbcomp.m
--- mdbcomp/mdbcomp.m 19 Oct 2005 05:39:08 -0000 1.4
+++ mdbcomp/mdbcomp.m 17 May 2006 06:25:28 -0000
@@ -20,7 +20,7 @@
:- interface.
-:- pred mdbcomp__version(string::out) is det.
+:- pred mdbcomp.version(string::out) is det.
:- include_module prim_data.
:- include_module program_representation.
@@ -33,7 +33,7 @@
% See library/library.m for why we implement this predicate this way.
:- pragma foreign_proc("C",
- mdbcomp__version(Version::out),
+ mdbcomp.version(Version::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
MR_ConstString version_string;
@@ -46,6 +46,6 @@
Version = (MR_String) (MR_Word) version_string;
").
-mdbcomp__version("unknown version").
+mdbcomp.version("unknown version").
%---------------------------------------------------------------------------%
Index: mdbcomp/prim_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/mdbcomp/prim_data.m,v
retrieving revision 1.10
diff -u -b -r1.10 prim_data.m
--- mdbcomp/prim_data.m 24 Feb 2006 07:11:19 -0000 1.10
+++ mdbcomp/prim_data.m 17 May 2006 06:54:53 -0000
@@ -51,7 +51,7 @@
% was in compiler/prog_data.m
- % The order that the sym_name function symbols appear in is significant
+ % The order that the sym_name function symbols appear in can be significant
% for module dependency ordering.
:- type sym_name
---> unqualified(string)
@@ -70,7 +70,7 @@
% from `.opt' files, the defining module's name may need to be added
% as a qualifier to the label.
:- type proc_label
- ---> proc(
+ ---> ordinary_proc_label(
ord_defining_module :: module_name,
ord_p_or_f :: pred_or_func,
ord_declaring_module :: module_name,
@@ -78,7 +78,7 @@
ord_arity :: int,
ord_mode_number :: int
)
- ; special_proc(
+ ; special_proc_label(
spec_defining_module :: module_name,
spec_spec_id :: special_pred_id,
% The special_pred_id indirectly
@@ -228,19 +228,19 @@
:- import_module string.
string_to_sym_name(String, ModuleSeparator, Result) :-
- % This would be simpler if we had a string__rev_sub_string_search/3 pred.
+ % This would be simpler if we had a string.rev_sub_string_search/3 pred.
% With that, we could search for underscores right-to-left, and construct
% the resulting symbol directly. Instead, we search for them left-to-right,
% and then call insert_module_qualifier to fix things up.
(
- string__sub_string_search(String, ModuleSeparator, LeftLength),
+ string.sub_string_search(String, ModuleSeparator, LeftLength),
LeftLength > 0
->
- string__left(String, LeftLength, ModuleName),
- string__length(String, StringLength),
- string__length(ModuleSeparator, SeparatorLength),
+ string.left(String, LeftLength, ModuleName),
+ string.length(String, StringLength),
+ string.length(ModuleSeparator, SeparatorLength),
RightLength = StringLength - LeftLength - SeparatorLength,
- string__right(String, RightLength, Name),
+ string.right(String, RightLength, Name),
string_to_sym_name(Name, ModuleSeparator, NameSym),
insert_module_qualifier(ModuleName, NameSym, Result)
;
@@ -265,7 +265,7 @@
sym_name_to_string(unqualified(Name), _Separator, Name).
sym_name_to_string(qualified(ModuleSym, Name), Separator, QualName) :-
sym_name_to_string(ModuleSym, Separator, ModuleName),
- string__append_list([ModuleName, Separator, Name], QualName).
+ string.append_list([ModuleName, Separator, Name], QualName).
is_submodule(SymName, SymName).
is_submodule(qualified(SymNameA, _), SymNameB) :-
Index: mdbcomp/program_representation.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/mdbcomp/program_representation.m,v
retrieving revision 1.12
diff -u -b -r1.12 program_representation.m
--- mdbcomp/program_representation.m 29 Mar 2006 08:07:51 -0000 1.12
+++ mdbcomp/program_representation.m 17 May 2006 06:25:38 -0000
@@ -427,22 +427,22 @@
).
path_from_string(GoalPathStr, GoalPath) :-
- StepStrs = string__words(is_path_separator, GoalPathStr),
- list__map(path_step_from_string, StepStrs, GoalPath).
+ StepStrs = string.words(is_path_separator, GoalPathStr),
+ list.map(path_step_from_string, StepStrs, GoalPath).
path_step_from_string(String, Step) :-
- string__first_char(String, First, Rest),
+ string.first_char(String, First, Rest),
path_step_from_string_2(First, Rest, Step).
:- pred path_step_from_string_2(char::in, string::in, goal_path_step::out)
is semidet.
path_step_from_string_2('c', NStr, conj(N)) :-
- string__to_int(NStr, N).
+ string.to_int(NStr, N).
path_step_from_string_2('d', NStr, disj(N)) :-
- string__to_int(NStr, N).
+ string.to_int(NStr, N).
path_step_from_string_2('s', NStr, switch(N)) :-
- string__to_int(NStr, N).
+ string.to_int(NStr, N).
path_step_from_string_2('?', "", ite_cond).
path_step_from_string_2('t', "", ite_then).
path_step_from_string_2('e', "", ite_else).
Index: mdbcomp/rtti_access.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/mdbcomp/rtti_access.m,v
retrieving revision 1.5
diff -u -b -r1.5 rtti_access.m
--- mdbcomp/rtti_access.m 29 Mar 2006 08:07:51 -0000 1.5
+++ mdbcomp/rtti_access.m 17 May 2006 06:21:49 -0000
@@ -140,19 +140,19 @@
),
string_to_sym_name(DefModule, ".", SymDefModule),
string_to_sym_name(TypeModule, ".", SymTypeModule),
- ProcLabel = special_proc(SymDefModule, SpecialId,
+ ProcLabel = special_proc_label(SymDefModule, SpecialId,
SymTypeModule, TypeName, TypeArity, ModeNum)
;
proc_layout_get_non_uci_fields(Layout, PredOrFunc,
DeclModule, DefModule, PredName, Arity, ModeNum),
string_to_sym_name(DefModule, ".", SymDefModule),
string_to_sym_name(DeclModule, ".", SymDeclModule),
- ProcLabel = proc(SymDefModule, PredOrFunc, SymDeclModule, PredName,
- Arity, ModeNum)
+ ProcLabel = ordinary_proc_label(SymDefModule, PredOrFunc,
+ SymDeclModule, PredName, Arity, ModeNum)
).
-get_proc_name(proc(_, _, _, ProcName, _, _)) = ProcName.
-get_proc_name(special_proc(_, _, _, ProcName , _, _)) = ProcName.
+get_proc_name(ordinary_proc_label(_, _, _, ProcName, _, _)) = ProcName.
+get_proc_name(special_proc_label(_, _, _, ProcName , _, _)) = ProcName.
:- pred proc_layout_is_uci(proc_layout::in) is semidet.
Index: mdbcomp/slice_and_dice.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/mdbcomp/slice_and_dice.m,v
retrieving revision 1.5
diff -u -b -r1.5 slice_and_dice.m
--- mdbcomp/slice_and_dice.m 29 Mar 2006 08:07:51 -0000 1.5
+++ mdbcomp/slice_and_dice.m 17 May 2006 06:28:24 -0000
@@ -406,7 +406,7 @@
;
ModuleFilteredLabelCounts = LabelCounts
),
- ( string__append("z", SortStrPrime, SortStr0) ->
+ ( string.append("z", SortStrPrime, SortStr0) ->
SortStr = SortStrPrime,
list.filter(slice_label_count_is_zero,
ModuleFilteredLabelCounts, FilteredLabelCounts)
@@ -669,17 +669,17 @@
suspicion_ratio(ExecCount1 ^ pass_count,
ExecCount1 ^ fail_count))
; C = 'd' ->
- % using - instead of int__minus is ambiguous
- Diff1 = int__minus(ExecCount1 ^ pass_count,
+ % using - instead of int.minus is ambiguous.
+ Diff1 = int.minus(ExecCount1 ^ pass_count,
ExecCount1 ^ fail_count),
- Diff2 = int__minus(ExecCount2 ^ pass_count,
+ Diff2 = int.minus(ExecCount2 ^ pass_count,
ExecCount2 ^ fail_count),
builtin.compare(Result0, Diff1, Diff2)
; C = 'D' ->
- % using - instead of int__minus is ambiguous
- Diff1 = int__minus(ExecCount1 ^ pass_count,
+ % using - instead of int.minus is ambiguous.
+ Diff1 = int.minus(ExecCount1 ^ pass_count,
ExecCount1 ^ fail_count),
- Diff2 = int__minus(ExecCount2 ^ pass_count,
+ Diff2 = int.minus(ExecCount2 ^ pass_count,
ExecCount2 ^ fail_count),
builtin.compare(Result0, Diff2, Diff1)
;
@@ -843,9 +843,9 @@
proc_label_is_for_module(Module, ProcLabel) :-
(
- ProcLabel = proc(_, _, ProcSymModule, _, _, _)
+ ProcLabel = ordinary_proc_label(_, _, ProcSymModule, _, _, _)
;
- ProcLabel = special_proc(_, _, ProcSymModule, _, _, _)
+ ProcLabel = special_proc_label(_, _, ProcSymModule, _, _, _)
),
string_to_sym_name(Module, ".", SymModule),
is_submodule(ProcSymModule, SymModule).
@@ -854,7 +854,8 @@
format_proc_label(ProcLabel) = Str :-
(
- ProcLabel = proc(_, PredOrFunc, SymModule, Name, Arity, ModeNo),
+ ProcLabel = ordinary_proc_label(_, PredOrFunc, SymModule, Name, Arity,
+ ModeNo),
Module = sym_name_to_string(SymModule),
(
PredOrFunc = function,
@@ -868,7 +869,7 @@
Str = PredOrFuncStr ++ " " ++ Module ++ "." ++ Name ++
"/" ++ ArityStr ++ "-" ++ int_to_string(ModeNo)
;
- ProcLabel = special_proc(_, SpecialPredId, SymModule, TypeName,
+ ProcLabel = special_proc_label(_, SpecialPredId, SymModule, TypeName,
_, _),
Module = sym_name_to_string(SymModule),
special_pred_name_arity(SpecialPredId, Name, _, Arity),
Index: mdbcomp/trace_counts.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/mdbcomp/trace_counts.m,v
retrieving revision 1.10
diff -u -b -r1.10 trace_counts.m
--- mdbcomp/trace_counts.m 29 Mar 2006 08:07:51 -0000 1.10
+++ mdbcomp/trace_counts.m 17 May 2006 06:25:00 -0000
@@ -77,8 +77,8 @@
---> ok(trace_count_file_type, trace_counts)
; syntax_error(string)
; error_message(string)
- ; open_error(io__error)
- ; io_error(io__error).
+ ; open_error(io.error)
+ ; io_error(io.error).
% read_trace_counts(FileName, Result, !IO):
%
@@ -341,19 +341,19 @@
% and having to recreate it again. Unfortunately, we don't have any
% facilities equivalent to popen in Unix, and I don't know how to
% write one in a way that is portable to Windows. zs.
- ( string__remove_suffix(FileName, ".gz", BaseName) ->
- io__call_system("gunzip " ++ FileName, _UnzipResult, !IO),
+ ( string.remove_suffix(FileName, ".gz", BaseName) ->
+ io.call_system("gunzip " ++ FileName, _UnzipResult, !IO),
ActualFileName = BaseName,
GzipCmd = "gzip " ++ BaseName
;
ActualFileName = FileName,
GzipCmd = ""
),
- io__open_input(ActualFileName, Result, !IO),
+ io.open_input(ActualFileName, Result, !IO),
(
Result = ok(FileStream),
- io__set_input_stream(FileStream, OldInputStream, !IO),
- io__read_line_as_string(IdReadResult, !IO),
+ io.set_input_stream(FileStream, OldInputStream, !IO),
+ io.read_line_as_string(IdReadResult, !IO),
(
IdReadResult = ok(FirstLine),
string.rstrip(FirstLine) = trace_count_file_id
@@ -363,8 +363,8 @@
;
ReadResult = syntax_error("no trace count file id")
),
- io__set_input_stream(OldInputStream, _, !IO),
- io__close_input(FileStream, !IO)
+ io.set_input_stream(OldInputStream, _, !IO),
+ io.close_input(FileStream, !IO)
;
Result = error(IOError),
ReadResult = open_error(IOError)
@@ -372,7 +372,7 @@
( GzipCmd = "" ->
true
;
- io__call_system(GzipCmd, _ZipResult, !IO)
+ io.call_system(GzipCmd, _ZipResult, !IO)
).
:- func trace_count_file_id = string.
@@ -383,13 +383,13 @@
io::di, io::uo) is cc_multi.
read_trace_counts_from_cur_stream(ReadResult, !IO) :-
- io__read_line_as_string(IdResult, !IO),
+ io.read_line_as_string(IdResult, !IO),
(
IdResult = ok(IdStr),
IdStrNoNL = string.rstrip(IdStr),
string_to_file_type(IdStrNoNL, FileType)
->
- try_io(read_trace_counts_setup(map__init), Result, !IO),
+ try_io(read_trace_counts_setup(map.init), Result, !IO),
(
Result = succeeded(TraceCounts),
ReadResult = ok(FileType, TraceCounts)
@@ -414,8 +414,8 @@
io::di, io::uo) is det.
read_trace_counts_setup(!TraceCounts, !IO) :-
- io__get_line_number(LineNumber, !IO),
- io__read_line_as_string(Result, !IO),
+ io.get_line_number(LineNumber, !IO),
+ io.read_line_as_string(Result, !IO),
(
Result = ok(Line),
CurFileName = "",
@@ -436,7 +436,7 @@
read_proc_trace_counts(HeaderLineNumber, HeaderLine, CurFileName, !TraceCounts,
!IO) :-
- lexer__string_get_token_list(HeaderLine, string__length(HeaderLine),
+ lexer.string_get_token_list(HeaderLine, string.length(HeaderLine),
TokenList, posn(HeaderLineNumber, 1, 0), _),
(
TokenList =
@@ -444,10 +444,10 @@
token_cons(name(NextFileName), _,
token_nil))
->
- io__read_line_as_string(Result, !IO),
+ io.read_line_as_string(Result, !IO),
(
Result = ok(Line),
- io__get_line_number(LineNumber, !IO),
+ io.get_line_number(LineNumber, !IO),
read_proc_trace_counts(LineNumber, Line, NextFileName,
!TraceCounts, !IO)
;
@@ -472,21 +472,21 @@
string_to_sym_name(DeclModuleStr, ".", DeclModuleName),
% At the moment runtime/mercury_trace_base.c doesn't
% write out data for unify, compare, index or init procedures.
- ProcLabel = proc(DefModuleName, PredOrFunc, DeclModuleName,
- Name, Arity, Mode),
+ ProcLabel = ordinary_proc_label(DefModuleName, PredOrFunc,
+ DeclModuleName, Name, Arity, Mode),
ProcLabelAndFile = proc_label_and_filename(ProcLabel, CurFileName),
% For whatever reason some of the trace counts for a single
% procedure or function can be split over multiple spans.
% We collate them as if they appeared in a single span.
- ( svmap__remove(ProcLabelAndFile, ProbeCounts, !TraceCounts) ->
+ ( svmap.remove(ProcLabelAndFile, ProbeCounts, !TraceCounts) ->
StartCounts = ProbeCounts
;
- StartCounts = map__init
+ StartCounts = map.init
),
read_proc_trace_counts_2(ProcLabelAndFile, StartCounts,
!TraceCounts, !IO)
;
- string__format("parse error on line %d of execution trace",
+ string.format("parse error on line %d of execution trace",
[i(HeaderLineNumber)], Message),
throw(trace_count_syntax_error(Message))
).
@@ -497,7 +497,7 @@
read_proc_trace_counts_2(ProcLabelAndFile, ProcCounts0, !TraceCounts, !IO) :-
CurFileName = ProcLabelAndFile ^ filename,
- io__read_line_as_string(Result, !IO),
+ io.read_line_as_string(Result, !IO),
(
Result = ok(Line),
(
@@ -506,18 +506,18 @@
->
LineNoAndCount = line_no_and_count(LineNumber, ExecCount,
NumTests),
- map__det_insert(ProcCounts0, PathPort, LineNoAndCount, ProcCounts),
+ map.det_insert(ProcCounts0, PathPort, LineNoAndCount, ProcCounts),
read_proc_trace_counts_2(ProcLabelAndFile, ProcCounts,
!TraceCounts, !IO)
;
- svmap__det_insert(ProcLabelAndFile, ProcCounts0, !TraceCounts),
- io__get_line_number(LineNumber, !IO),
+ svmap.det_insert(ProcLabelAndFile, ProcCounts0, !TraceCounts),
+ io.get_line_number(LineNumber, !IO),
read_proc_trace_counts(LineNumber, Line, CurFileName, !TraceCounts,
!IO)
)
;
Result = eof,
- svmap__det_insert(ProcLabelAndFile, ProcCounts0, !TraceCounts)
+ svmap.det_insert(ProcLabelAndFile, ProcCounts0, !TraceCounts)
;
Result = error(Error),
throw(Error)
@@ -527,7 +527,7 @@
int::out) is semidet.
parse_path_port_line(Line, PathPort, LineNumber, ExecCount, NumTests) :-
- Words = string__words(Line),
+ Words = string.words(Line),
(
(
Words = [Word1, ExecCountStr, LineNumberStr],
@@ -542,9 +542,9 @@
;
fail
),
- string__to_int(ExecCountStr, ExecCount0),
- string__to_int(NumTestsStr, NumTests0),
- string__to_int(LineNumberStr, LineNumber0)
+ string.to_int(ExecCountStr, ExecCount0),
+ string.to_int(NumTestsStr, NumTests0),
+ string.to_int(LineNumberStr, LineNumber0)
->
PathPort = PathPort0,
ExecCount = ExecCount0,
@@ -561,9 +561,9 @@
string_to_trace_port(PortStr, Port),
Path = string_to_goal_path(PathStr),
PathPort = port_and_path(Port, Path),
- string__to_int(ExecCountStr, ExecCount),
- string__to_int(NumTestsStr, NumTests),
- string__to_int(LineNumberStr, LineNumber)
+ string.to_int(ExecCountStr, ExecCount),
+ string.to_int(NumTestsStr, NumTests),
+ string.to_int(LineNumberStr, LineNumber)
).
:- pred string_to_pred_or_func(string, pred_or_func).
@@ -592,10 +592,10 @@
:- func string_to_goal_path(string) = goal_path is semidet.
string_to_goal_path(String) = Path :-
- string__prefix(String, "<"),
- string__suffix(String, ">"),
- string__length(String, Length),
- string__substring(String, 1, Length-2, SubString),
+ string.prefix(String, "<"),
+ string.suffix(String, ">"),
+ string.length(String, Length),
+ string.substring(String, 1, Length-2, SubString),
path_from_string(SubString, Path).
% This function should be kept in sync with the MR_named_count_port array
@@ -620,7 +620,7 @@
%-----------------------------------------------------------------------------%
write_trace_counts_to_file(FileType, TraceCounts, FileName, Res, !IO) :-
- io__open_output(FileName, Result, !IO),
+ io.open_output(FileName, Result, !IO),
(
Result = ok(FileStream),
Res = ok,
@@ -655,8 +655,10 @@
:- pred write_proc_label(proc_label::in, io::di, io::uo) is det.
-write_proc_label(proc(DefModuleSym, PredOrFunc, DeclModuleSym, Name, Arity,
- Mode), !IO) :-
+write_proc_label(ProcLabel, !IO) :-
+ (
+ ProcLabel = ordinary_proc_label(DefModuleSym, PredOrFunc,
+ DeclModuleSym, Name, Arity, Mode),
sym_name_to_string(DefModuleSym, DefModuleStr),
sym_name_to_string(DeclModuleSym, DeclModuleStr),
string_to_pred_or_func(PredOrFuncStr, PredOrFunc),
@@ -672,11 +674,12 @@
io.write_int(Arity, !IO),
io.write_string(" ", !IO),
io.write_int(Mode, !IO),
- io.nl(!IO).
-
+ io.nl(!IO)
+ ;
+ ProcLabel = special_proc_label(_, _, _, _, _, _),
% We don't record special preds in trace counts.
-write_proc_label(special_proc(_, _, _, _, _, _), !IO) :-
- error("write_proc_label: special_pred").
+ error("write_proc_label: special_pred_label")
+ ).
:- pred write_path_port_count(path_port::in, line_no_and_count::in,
io::di, io::uo) is det.
@@ -733,16 +736,16 @@
%-----------------------------------------------------------------------------%
restrict_trace_counts_to_module(ModuleName, TraceCounts0, TraceCounts) :-
- map__foldl(restrict_trace_counts_2(ModuleName), TraceCounts0,
- map__init, TraceCounts).
+ map.foldl(restrict_trace_counts_2(ModuleName), TraceCounts0,
+ map.init, TraceCounts).
:- pred restrict_trace_counts_2(module_name::in, proc_label_and_filename::in,
proc_trace_counts::in, trace_counts::in, trace_counts::out) is det.
restrict_trace_counts_2(ModuleName, ProcLabelAndFile, ProcCounts, Acc0, Acc) :-
ProcLabel = ProcLabelAndFile ^ proc_label,
- (if ProcLabel = proc(ModuleName, _, _, _, _, _) then
- map__det_insert(Acc0, ProcLabelAndFile, ProcCounts, Acc)
+ (if ProcLabel = ordinary_proc_label(ModuleName, _, _, _, _, _) then
+ map.det_insert(Acc0, ProcLabelAndFile, ProcCounts, Acc)
else
Acc = Acc0
).
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/Mmakefile,v
retrieving revision 1.132
diff -u -b -r1.132 Mmakefile
--- runtime/Mmakefile 30 Mar 2006 06:13:48 -0000 1.132
+++ runtime/Mmakefile 6 Jun 2006 14:58:06 -0000
@@ -121,6 +121,13 @@
mercury_ml_deconstruct_body.h \
mercury_ml_expand_body.h \
mercury_ml_functor_body.h \
+ mercury_table_int_fix_index_body.h \
+ mercury_table_int_start_index_body.h \
+ mercury_table_typeinfo_body.h \
+ mercury_table_type_body.h \
+ mercury_tabling_stats_defs.h \
+ mercury_tabling_stats_nodefs.h \
+ mercury_tabling_stats_undefs.h \
mercury_unify_compare_body.h
MACHHDRS = machdeps/no_regs.h \
@@ -279,6 +286,12 @@
mercury_type_info.$(EXT_FOR_PIC_OBJECTS): mercury_make_type_info_body.h
mercury_ho_call.$(EXT_FOR_PIC_OBJECTS): mercury_unify_compare_body.h
+# These files depend on several of the files in $(BODY_HDRS), and it is
+# easier to depend on them all than to specifically list only the ones
+# we mercury_tabling.c actually includes.
+mercury_tabling.$(O): $(BODY_HDRS)
+mercury_tabling.$(EXT_FOR_PIC_OBJECTS): $(BODY_HDRS)
+
# ../tools/make_port_code makes both the .c and the .h file of the
# mercury_profiling_builtin module.
mercury_profiling_builtin.c: mercury_profiling_builtin.h
Index: runtime/mercury_bootstrap.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_bootstrap.h,v
retrieving revision 1.37
diff -u -b -r1.37 mercury_bootstrap.h
--- runtime/mercury_bootstrap.h 20 Jul 2004 04:41:20 -0000 1.37
+++ runtime/mercury_bootstrap.h 17 May 2006 13:10:39 -0000
@@ -12,6 +12,8 @@
** will go away eventually, so don't use them!
*/
+#define MR_Table_Trie_Step MR_TableTrieStep
+
#ifndef MERCURY_BOOTSTRAP_H
#define MERCURY_BOOTSTRAP_H
@@ -49,9 +51,11 @@
typedef MR_String String;
typedef MR_ConstString ConstString;
+#if 0
#ifndef MR_HIGHLEVEL_CODE
typedef MR_Context Context;
#endif
+#endif
/*
** MR_Bool is the C representation for the Mercury type bool__bool.
Index: runtime/mercury_grade.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_grade.h,v
retrieving revision 1.62
diff -u -b -r1.62 mercury_grade.h
--- runtime/mercury_grade.h 27 Sep 2005 06:20:51 -0000 1.62
+++ runtime/mercury_grade.h 20 May 2006 04:30:57 -0000
@@ -61,7 +61,7 @@
*/
#define MR_GRADE_PART_0 v14_
-#define MR_GRADE_EXEC_TRACE_VERSION_NO 4
+#define MR_GRADE_EXEC_TRACE_VERSION_NO 5
#define MR_GRADE_DEEP_PROF_VERSION_NO 1
#ifdef MR_HIGHLEVEL_CODE
Index: runtime/mercury_hash_lookup_or_add_body.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_hash_lookup_or_add_body.h,v
retrieving revision 1.1
diff -u -b -r1.1 mercury_hash_lookup_or_add_body.h
--- runtime/mercury_hash_lookup_or_add_body.h 31 May 2004 04:34:46 -0000 1.1
+++ runtime/mercury_hash_lookup_or_add_body.h 20 May 2006 05:12:52 -0000
@@ -29,7 +29,7 @@
table = t->MR_hash_table; /* Deref the table pointer */
}
- /* Rehash the table if it has grown too full */
+ /* Rehash the table if it has grown too full. */
if (table->value_count > table->threshold) {
MR_HashTableSlotPtr *old_hash_table;
MR_HashTableSlotPtr *new_hash_table;
Index: runtime/mercury_stack_layout.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_stack_layout.h,v
retrieving revision 1.98
diff -u -b -r1.98 mercury_stack_layout.h
--- runtime/mercury_stack_layout.h 27 Mar 2006 05:05:46 -0000 1.98
+++ runtime/mercury_stack_layout.h 6 Jun 2006 13:20:16 -0000
@@ -35,6 +35,8 @@
#include "mercury_type_info.h" /* for MR_PseudoTypeInfo */
#include "mercury_proc_id.h" /* for MR_Proc_Id */
#include "mercury_goto.h" /* for MR_PROC_LAYOUT etc */
+#include "mercury_tabling.h" /* for MR_TableTrieStep etc */
+#include "mercury_bootstrap.h" /* for MR_Table_Trie_Step */
/*-------------------------------------------------------------------------*/
/*
@@ -597,67 +599,22 @@
} MR_Table_Io_Decl;
/*
-** The MR_Table_Gen structure.
-**
-** To enable debugging (especially performance debugging) of tabled predicates,
-** the compiler generates one of these structures for each tabled predicate
-** (except I/O primitives, for which it generates an MR_Table_Io_Decl
-** structure.)
-**
-** Each argument of a tabled predicate is an input or an output. Inputs are put
-** into the call trie, which has one level per input argument. The structure of
-** each level depends on what kind of type the corresponding input argument is;
-** this is recorded in the input_steps field, which points to an array of size
-** num_inputs. If the type is an enum, we cannot interpret the data structures
-** used on that level without also knowing how many alternatives the type has;
-** this is recorded in the corresponding element of the enum_params array,
-** which is likewise of size num_inputs. (Elements of the enum_params array
-** that correspond to arguments whose types are not enums are not meaningful.)
-**
-** The ptis field points to an array of pseudotypeinfos of size num_inputs +
-** num_outputs. The first num_inputs elements give the types of the input
-** arguments, while the remaining num_outputs elements give the types of the
-** output arguments.
-*/
-
-typedef enum {
- MR_TABLE_STEP_DUMMY,
- MR_TABLE_STEP_INT,
- MR_TABLE_STEP_CHAR,
- MR_TABLE_STEP_STRING,
- MR_TABLE_STEP_FLOAT,
- MR_TABLE_STEP_ENUM,
- MR_TABLE_STEP_USER,
- MR_TABLE_STEP_USER_FAST_LOOSE,
- MR_TABLE_STEP_POLY,
- MR_TABLE_STEP_POLY_FAST_LOOSE,
- MR_TABLE_STEP_TYPEINFO,
- MR_TABLE_STEP_TYPECLASSINFO,
- MR_TABLE_STEP_PROMISE_IMPLIED
-} MR_Table_Trie_Step;
-
-typedef struct MR_Table_Gen_Struct {
- int MR_table_gen_num_inputs;
- int MR_table_gen_num_outputs;
- const MR_Table_Trie_Step *MR_table_gen_input_steps;
- const MR_Integer *MR_table_gen_enum_params;
- const MR_PseudoTypeInfo *MR_table_gen_ptis;
- const MR_Type_Param_Locns *MR_table_gen_type_params;
-} MR_Table_Gen;
-
-/*
** MR_Table_Info: compiler generated information describing the tabling
** data structures used by a procedure.
**
** For I/O tabled procedures, the information is in the io_decl field.
** For other kinds of tabled procedures, it is in the gen field.
** The init field is used for initialization only.
+**
+** The MR_table_proc field is not const because the structure it points to
+** has fields containing statistics, which are updated at runtime.
*/
typedef union {
const void *MR_table_init;
const MR_Table_Io_Decl *MR_table_io_decl;
const MR_Table_Gen *MR_table_gen;
+ MR_ProcTableInfo *MR_table_proc;
} MR_Table_Info;
/*
@@ -772,12 +729,14 @@
** arguments.
*/
+#define MR_EVAL_METHOD_MEMO_STRICT MR_EVAL_METHOD_MEMO
+#define MR_EVAL_METHOD_MEMO_FAST_LOOSE MR_EVAL_METHOD_MEMO
+#define MR_EVAL_METHOD_MEMO_SPECIFIED MR_EVAL_METHOD_MEMO
+
typedef enum {
MR_EVAL_METHOD_NORMAL,
MR_EVAL_METHOD_LOOP_CHECK,
- MR_EVAL_METHOD_MEMO_STRICT,
- MR_EVAL_METHOD_MEMO_FAST_LOOSE,
- MR_EVAL_METHOD_MEMO_SPECIFIED,
+ MR_EVAL_METHOD_MEMO,
MR_EVAL_METHOD_MINIMAL_STACK_COPY,
MR_EVAL_METHOD_MINIMAL_OWN_STACKS,
MR_EVAL_METHOD_TABLE_IO,
@@ -801,7 +760,7 @@
const MR_Label_Layout *MR_exec_call_label;
const MR_Module_Layout *MR_exec_module_layout;
const MR_uint_least8_t *MR_exec_body_bytes;
- MR_TrieNode MR_exec_tabling_pointer;
+ MR_Word MR_exec_unused;
MR_Table_Info MR_exec_table_info;
const MR_uint_least16_t *MR_exec_head_var_nums;
const MR_uint_least32_t *MR_exec_used_var_names;
Index: runtime/mercury_table_int_fix_index_body.h
===================================================================
RCS file: runtime/mercury_table_int_fix_index_body.h
diff -N runtime/mercury_table_int_fix_index_body.h
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ runtime/mercury_table_int_fix_index_body.h 21 May 2006 10:49:30 -0000
@@ -0,0 +1,30 @@
+/*
+** vim: ts=4 sw=4 expandtab
+*/
+/*
+** Copyright (C) 2006 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** This files defines the bodies of the variants of the
+** MR_int_fix_index_lookup_or_add() function.
+**
+** NOTE: changes to this function will probably also have to be reflected
+** in the places listed in mercury_type_info.h.
+*/
+
+ if (t->MR_fix_table == NULL) {
+ record_alloc();
+ t->MR_fix_table = MR_TABLE_NEW_ARRAY(MR_TableNode, range);
+ memset(t->MR_fix_table, 0, sizeof(MR_TableNode) * range);
+ }
+
+#ifdef MR_TABLE_DEBUG
+ if (key >= range) {
+ MR_fatal_error("MR_int_fix_index_lookup_or_add: key out of range");
+ }
+#endif
+
+ return &t->MR_fix_table[key];
Index: runtime/mercury_table_int_start_index_body.h
===================================================================
RCS file: runtime/mercury_table_int_start_index_body.h
diff -N runtime/mercury_table_int_start_index_body.h
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ runtime/mercury_table_int_start_index_body.h 21 May 2006 10:58:43 -0000
@@ -0,0 +1,55 @@
+/*
+** vim: ts=4 sw=4 expandtab
+*/
+/*
+** Copyright (C) 2006 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** This files defines the bodies of the variants of the
+** MR_int_start_index_lookup_or_add() function.
+*/
+
+ MR_Integer diff, size;
+
+ diff = key - start;
+
+#ifdef MR_TABLE_DEBUG
+ if (key < start) {
+ MR_fatal_error("MR_int_start_index_lookup_or_add: too small key");
+ }
+#endif
+
+ if (table->MR_start_table == NULL) {
+ record_alloc();
+ size = MR_max(MR_START_TABLE_INIT_SIZE, diff + 1);
+ table->MR_start_table = MR_TABLE_NEW_ARRAY(MR_TableNode, size + 1);
+ memset(table->MR_start_table + 1, 0, sizeof(MR_TableNode) * size);
+ table->MR_start_table[0].MR_integer = size;
+ } else {
+ size = table->MR_start_table[0].MR_integer;
+ }
+
+ if (diff >= size) {
+ MR_TableNode *new_array;
+ MR_Integer new_size, i;
+
+ new_size = MR_max(2 * size, diff + 1);
+ new_array = MR_TABLE_NEW_ARRAY(MR_TableNode, new_size + 1);
+
+ new_array[0].MR_integer = new_size;
+
+ for (i = 0; i < size; i++) {
+ new_array[i + 1] = table->MR_start_table[i + 1];
+ }
+
+ for (; i < new_size; i++) {
+ new_array[i + 1].MR_integer = 0;
+ }
+
+ table->MR_start_table = new_array;
+ }
+
+ return &table->MR_start_table[diff + 1];
Index: runtime/mercury_table_type_body.h
===================================================================
RCS file: runtime/mercury_table_type_body.h
diff -N runtime/mercury_table_type_body.h
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ runtime/mercury_table_type_body.h 6 Jun 2006 06:03:34 -0000
@@ -0,0 +1,461 @@
+/*
+** vim: ts=4 sw=4 expandtab
+*/
+/*
+** Copyright (C) 2006 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** This files defines the bodies of the various variants of the
+** MR_table_type() function.
+**
+** NOTE: Any changes to this function will probably also have to be reflected
+** in the places listed in mercury_type_info.h.
+*/
+
+ MR_TypeCtorInfo type_ctor_info;
+ MR_DuTypeLayout du_type_layout;
+ MR_TrieNode table_next;
+
+ type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
+
+ if (DEBUG && MR_tabledebug) {
+ printf("ENTRY %p %x, data rep: %d\n",
+ table, data, MR_type_ctor_rep(type_ctor_info));
+ }
+
+ if (! MR_type_ctor_has_valid_rep(type_ctor_info)) {
+ MR_fatal_error("MR_table_type: term of unknown representation");
+ }
+
+ switch (MR_type_ctor_rep(type_ctor_info)) {
+ case MR_TYPECTOR_REP_ENUM:
+ case MR_TYPECTOR_REP_ENUM_USEREQ:
+ MR_TABLE_ENUM(STATS, DEBUG, BACK, table_next, table,
+ MR_type_ctor_num_functors(type_ctor_info), data);
+ table = table_next;
+ return table;
+
+ case MR_TYPECTOR_REP_DUMMY:
+ /*
+ ** If we are ever asked to table a value of a dummy type, we treat
+ ** it mostly as an enum, with the exception being that we ignore
+ ** the actual value to be table (since it contains garbage) and
+ ** substitute the constant zero, which ought to be the enum value
+ ** assigned to the type's only function symbol.
+ **
+ ** It would of course be preferable for the compiler to simply
+ ** not insert any arguments of dummy types into tables.
+ */
+ MR_TABLE_ENUM(STATS, DEBUG, BACK, table_next, table, 1, 0);
+ table = table_next;
+ return table;
+
+ case MR_TYPECTOR_REP_RESERVED_ADDR:
+ case MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ:
+ {
+ int i;
+ MR_ReservedAddrTypeLayout ra_layout;
+
+ ra_layout = MR_type_ctor_layout(type_ctor_info).
+ MR_layout_reserved_addr;
+
+ /*
+ ** First check if this value is one of
+ ** the numeric reserved addresses.
+ */
+ if ((MR_Unsigned) data <
+ (MR_Unsigned) ra_layout->MR_ra_num_res_numeric_addrs)
+ {
+ MR_TABLE_ENUM(STATS, DEBUG, BACK, table_next, table,
+ MR_type_ctor_num_functors(type_ctor_info),
+ ra_layout->MR_ra_constants[data]->
+ MR_ra_functor_ordinal);
+ table = table_next;
+ break;
+ }
+
+ /*
+ ** Next check if this value is one of the
+ ** the symbolic reserved addresses.
+ */
+ for (i = 0; i < ra_layout->MR_ra_num_res_symbolic_addrs; i++) {
+ if (data == (MR_Word)
+ ra_layout->MR_ra_res_symbolic_addrs[i])
+ {
+ int offset;
+
+ offset = i + ra_layout->MR_ra_num_res_numeric_addrs;
+ MR_TABLE_ENUM(STATS, DEBUG, BACK, table_next, table,
+ MR_type_ctor_num_functors(type_ctor_info),
+ ra_layout->MR_ra_constants[offset]->
+ MR_ra_functor_ordinal);
+ table = table_next;
+ /* "break" here would just exit the "for" loop */
+ return table;
+ }
+ }
+
+ /*
+ ** Otherwise, it is not one of the reserved addresses,
+ ** so handle it like a normal DU type.
+ */
+ du_type_layout = ra_layout->MR_ra_other_functors;
+ goto du_type;
+ }
+
+ case MR_TYPECTOR_REP_DU:
+ case MR_TYPECTOR_REP_DU_USEREQ:
+ du_type_layout = MR_type_ctor_layout(type_ctor_info).MR_layout_du;
+ /* fall through */
+
+ /*
+ ** This label handles both the DU case and the second half of the
+ ** RESERVED_ADDR case. `du_type_layout' must be set before
+ ** this code is entered.
+ */
+ du_type:
+ {
+ MR_MemoryList allocated_memory_cells = NULL;
+ const MR_DuPtagLayout *ptag_layout;
+ const MR_DuFunctorDesc *functor_desc;
+ const MR_DuExistInfo *exist_info;
+ MR_TypeInfo arg_type_info;
+ int ptag;
+ MR_Word sectag;
+ MR_Word *arg_vector;
+ int meta_args;
+ int i;
+
+ ptag = MR_tag(data);
+ ptag_layout = &du_type_layout[ptag];
+
+ switch (ptag_layout->MR_sectag_locn) {
+
+ case MR_SECTAG_NONE:
+ functor_desc = ptag_layout->MR_sectag_alternatives[0];
+ arg_vector = (MR_Word *) MR_body(data, ptag);
+ break;
+
+ case MR_SECTAG_LOCAL:
+ sectag = MR_unmkbody(data);
+ functor_desc = ptag_layout->MR_sectag_alternatives[sectag];
+ assert(functor_desc->MR_du_functor_orig_arity == 0);
+ assert(functor_desc->MR_du_functor_exist_info == NULL);
+ arg_vector = NULL;
+ break;
+
+ case MR_SECTAG_REMOTE:
+ sectag = MR_field(ptag, data, 0);
+ functor_desc = ptag_layout->MR_sectag_alternatives[sectag];
+ arg_vector = (MR_Word *) MR_body(data, ptag) + 1;
+ break;
+
+ case MR_SECTAG_VARIABLE:
+ MR_fatal_error("MR_table_type(): unexpected variable");
+
+ default:
+ MR_fatal_error("MR_table_type(): unknown sectag_locn");
+
+ }
+
+ MR_TABLE_ENUM(STATS, DEBUG, BACK, table_next, table,
+ MR_type_ctor_num_functors(type_ctor_info),
+ functor_desc->MR_du_functor_ordinal);
+ table = table_next;
+
+ exist_info = functor_desc->MR_du_functor_exist_info;
+ if (exist_info != NULL) {
+ int num_ti_plain;
+ int num_ti_in_tci;
+ int num_tci;
+ const MR_DuExistLocn *locns;
+
+ num_ti_plain = exist_info->MR_exist_typeinfos_plain;
+ num_ti_in_tci = exist_info->MR_exist_typeinfos_in_tci;
+ num_tci = exist_info->MR_exist_tcis;
+ locns = exist_info->MR_exist_typeinfo_locns;
+
+ for (i = 0; i < num_ti_plain + num_ti_in_tci; i++) {
+ if (locns[i].MR_exist_offset_in_tci < 0) {
+ MR_TABLE_TYPEINFO(STATS, DEBUG, BACK,
+ table_next, table, (MR_TypeInfo)
+ arg_vector[locns[i].MR_exist_arg_num]);
+ table = table_next;
+ } else {
+ MR_TABLE_TYPEINFO(STATS, DEBUG, BACK,
+ table_next, table, (MR_TypeInfo)
+ MR_typeclass_info_param_type_info(
+ arg_vector[locns[i].MR_exist_arg_num],
+ locns[i].MR_exist_offset_in_tci));
+ table = table_next;
+ }
+ }
+ meta_args = num_ti_plain + num_tci;
+ } else {
+ meta_args = 0;
+ }
+
+ for (i = 0; i < functor_desc->MR_du_functor_orig_arity; i++) {
+ if (MR_arg_type_may_contain_var(functor_desc, i)) {
+ arg_type_info = MR_make_type_info_maybe_existq(
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
+ functor_desc->MR_du_functor_arg_types[i],
+ arg_vector, functor_desc, &allocated_memory_cells);
+ } else {
+ arg_type_info = MR_pseudo_type_info_is_ground(
+ functor_desc->MR_du_functor_arg_types[i]);
+ }
+
+ MR_TABLE_ANY(STATS, DEBUG, BACK, table_next, table,
+ arg_type_info, arg_vector[meta_args + i]);
+ table = table_next;
+ }
+
+ MR_deallocate(allocated_memory_cells);
+ }
+ return table;
+
+ case MR_TYPECTOR_REP_NOTAG:
+ case MR_TYPECTOR_REP_NOTAG_USEREQ:
+ {
+ MR_MemoryList allocated_memory_cells = NULL;
+ MR_TypeInfo eqv_type_info;
+
+ eqv_type_info = MR_make_type_info(
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
+ MR_type_ctor_layout(type_ctor_info).MR_layout_notag->
+ MR_notag_functor_arg_type, &allocated_memory_cells);
+ MR_TABLE_ANY(STATS, DEBUG, BACK, table_next, table,
+ eqv_type_info, data);
+ table = table_next;
+ MR_deallocate(allocated_memory_cells);
+ }
+ return table;
+
+ case MR_TYPECTOR_REP_NOTAG_GROUND:
+ case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
+ MR_TABLE_ANY(STATS, DEBUG, BACK, table_next, table,
+ MR_pseudo_type_info_is_ground(
+ MR_type_ctor_layout(type_ctor_info).MR_layout_notag->
+ MR_notag_functor_arg_type), data);
+ table = table_next;
+ return table;
+
+ case MR_TYPECTOR_REP_EQUIV:
+ {
+ MR_MemoryList allocated_memory_cells = NULL;
+ MR_TypeInfo eqv_type_info;
+
+ eqv_type_info = MR_make_type_info(
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
+ MR_type_ctor_layout(type_ctor_info).MR_layout_equiv,
+ &allocated_memory_cells);
+ MR_TABLE_ANY(STATS, DEBUG, BACK, table_next, table,
+ eqv_type_info, data);
+ table = table_next;
+ MR_deallocate(allocated_memory_cells);
+ }
+
+ return table;
+
+ case MR_TYPECTOR_REP_EQUIV_GROUND:
+ MR_TABLE_ANY(STATS, DEBUG, BACK, table_next, table,
+ MR_pseudo_type_info_is_ground(
+ MR_type_ctor_layout(type_ctor_info).MR_layout_equiv),
+ data);
+ table = table_next;
+ return table;
+
+ case MR_TYPECTOR_REP_INT:
+ MR_TABLE_INT(STATS, DEBUG, BACK, table_next, table, data);
+ table = table_next;
+ return table;
+
+ case MR_TYPECTOR_REP_CHAR:
+ MR_TABLE_CHAR(STATS, DEBUG, BACK, table_next, table, data);
+ table = table_next;
+ return table;
+
+ case MR_TYPECTOR_REP_FLOAT:
+ MR_TABLE_FLOAT(STATS, DEBUG, BACK, table_next, table, data);
+ table = table_next;
+ return table;
+
+ case MR_TYPECTOR_REP_STRING:
+ MR_TABLE_STRING(STATS, DEBUG, BACK, table_next, table,
+ (MR_String) data);
+ table = table_next;
+ return table;
+
+ case MR_TYPECTOR_REP_FUNC:
+ case MR_TYPECTOR_REP_PRED:
+ {
+ /*
+ ** XXX tabling of the closures by tabling their code address
+ ** and arguments is not yet implemented, due to the overhead
+ ** of figuring out the closure argument types.
+ */
+ #if 0
+ MR_closure closure;
+ MR_Word num_hidden_args;
+ int i;
+
+ closure = (MR_Closure *) data;
+ num_hidden_args = closure->MR_closure_num_hidden_args;
+ MR_TABLE_INT(STATS, DEBUG, BACK, table_next, table,
+ closure->MR_closure_code);
+ table = table_next;
+ for (i = 1; i <= num_hidden_args; i++) {
+ MR_TABLE_ANY(STATS, DEBUG, BACK, table_next, table,
+ <type_info for hidden closure argument number i>,
+ closure->MR_closure_hidden_args(i));
+ table = table_next;
+ }
+ #else
+ /*
+ ** Instead, we use the following rather simplistic means of
+ ** tabling closures: we just table based on the closure
+ ** address.
+ */
+ MR_TABLE_INT(STATS, DEBUG, BACK, table_next, table, data);
+ table = table_next;
+ #endif
+
+ return table;
+ }
+
+ case MR_TYPECTOR_REP_TUPLE:
+ {
+ MR_Word *data_value;
+ MR_TypeInfo *arg_type_info_vector;
+ int arity;
+ int i;
+
+ data_value = (MR_Word *) data;
+ arity = MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info);
+ arg_type_info_vector =
+ MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info);
+ for (i = 0; i < arity; i++) {
+ /* type_infos are counted starting at one */
+ MR_TABLE_ANY(STATS, DEBUG, BACK, table_next, table,
+ arg_type_info_vector[i + 1], data_value[i]);
+ table = table_next;
+ }
+
+ return table;
+ }
+
+ case MR_TYPECTOR_REP_SUBGOAL:
+ MR_fatal_error("Cannot table a subgoal");
+
+ case MR_TYPECTOR_REP_VOID:
+ MR_fatal_error("Cannot table a void type");
+
+ case MR_TYPECTOR_REP_C_POINTER:
+ MR_fatal_error("Attempt to table a C_POINTER");
+
+ case MR_TYPECTOR_REP_STABLE_C_POINTER:
+ /*
+ ** This works because a stable C pointer guarantees that the
+ ** data structures pointed to, indirectly as well as directly,
+ ** will remain stable until the program exits.
+ */
+ MR_TABLE_INT(STATS, DEBUG, BACK, table_next, table, data);
+ table = table_next;
+ return table;
+
+ case MR_TYPECTOR_REP_STABLE_FOREIGN:
+ /*
+ ** This works because a stable foreign type guarantees that the
+ ** data structures pointed to, indirectly as well as directly,
+ ** will remain stable until the program exits.
+ */
+ MR_TABLE_INT(STATS, DEBUG, BACK, table_next, table, data);
+ table = table_next;
+ return table;
+
+ case MR_TYPECTOR_REP_TYPEINFO:
+ case MR_TYPECTOR_REP_TYPEDESC:
+ MR_TABLE_TYPEINFO(STATS, DEBUG, BACK, table_next, table,
+ (MR_TypeInfo) data);
+ table = table_next;
+ return table;
+
+ case MR_TYPECTOR_REP_PSEUDOTYPEDESC:
+ MR_fatal_error("Attempt to table a pseudo_type_desc");
+
+ case MR_TYPECTOR_REP_TYPECTORINFO:
+ MR_fatal_error("Attempt to table a type_ctor_info");
+
+ case MR_TYPECTOR_REP_TYPECTORDESC:
+ MR_fatal_error("Attempt to table a type_ctor_desc");
+
+ case MR_TYPECTOR_REP_TYPECLASSINFO:
+ MR_fatal_error("Attempt to table a type_class_info");
+
+ case MR_TYPECTOR_REP_BASETYPECLASSINFO:
+ MR_fatal_error("Attempt to table a base_type_class_info");
+
+ case MR_TYPECTOR_REP_ARRAY:
+ {
+ MR_TypeInfo new_type_info;
+ MR_MemoryList allocated_memory_cells = NULL;
+ MR_ArrayType *array;
+ MR_Integer array_size;
+ int i;
+
+ array = (MR_ArrayType *) data;
+ array_size = array->size;
+
+ new_type_info = MR_make_type_info(
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
+ (MR_PseudoTypeInfo) 1, &allocated_memory_cells);
+
+ for (i = 0; i < array_size; i++) {
+ MR_TABLE_ANY(STATS, DEBUG, BACK, table_next, table,
+ new_type_info, array->elements[i]);
+ table = table_next;
+ }
+
+ MR_deallocate(allocated_memory_cells);
+ return table;
+ }
+
+ case MR_TYPECTOR_REP_SUCCIP:
+ MR_fatal_error("Attempt to table a saved succip");
+
+ case MR_TYPECTOR_REP_HP:
+ MR_fatal_error("Attempt to table a saved hp");
+
+ case MR_TYPECTOR_REP_CURFR:
+ MR_fatal_error("Attempt to table a saved curfr");
+
+ case MR_TYPECTOR_REP_MAXFR:
+ MR_fatal_error("Attempt to table a saved maxfr");
+
+ case MR_TYPECTOR_REP_REDOFR:
+ MR_fatal_error("Attempt to table a saved redofr");
+
+ case MR_TYPECTOR_REP_REDOIP:
+ MR_fatal_error("Attempt to table a saved redoip");
+
+ case MR_TYPECTOR_REP_TRAIL_PTR:
+ MR_fatal_error("Attempt to table a saved trail pointer");
+
+ case MR_TYPECTOR_REP_TICKET:
+ MR_fatal_error("Attempt to table a saved ticket");
+
+ case MR_TYPECTOR_REP_FOREIGN:
+ MR_fatal_error("Attempt to table a value of a foreign type");
+
+ case MR_TYPECTOR_REP_REFERENCE:
+ MR_fatal_error("Attempt to table a value of a reference type");
+
+ case MR_TYPECTOR_REP_UNKNOWN: /* fallthru */
+ MR_fatal_error("Unknown layout tag in table_any");
+ }
+
+ MR_fatal_error(func ": unexpected fallthrough");
Index: runtime/mercury_table_typeinfo_body.h
===================================================================
RCS file: runtime/mercury_table_typeinfo_body.h
diff -N runtime/mercury_table_typeinfo_body.h
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ runtime/mercury_table_typeinfo_body.h 21 May 2006 11:09:40 -0000
@@ -0,0 +1,51 @@
+/*
+** vim: ts=4 sw=4 expandtab
+*/
+/*
+** Copyright (C) 2006 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** This files defines the bodies of the variants of the
+** MR_type_info_lookup_or_add() function.
+*/
+
+ MR_TypeCtorInfo type_ctor_info;
+ MR_TrieNode node;
+ MR_TypeInfo *arg_vector;
+ int arity;
+ int i;
+
+ /* XXX memory allocation here should be optimized */
+ type_info = MR_collapse_equivalences(type_info);
+
+ type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
+ node = tci_call(table, (MR_Integer) type_ctor_info);
+
+ /*
+ ** All calls to MR_type_info_lookup_or_add that have the same value
+ ** of node at this point agree on the type_ctor_info of the type
+ ** being tabled. They must therefore also agree on its arity.
+ ** This is why looping over all the arguments works.
+ **
+ ** If type_info has a zero-arity type_ctor, then it may be stored
+ ** using a one-cell type_info, and type_info_args does not make sense.
+ ** This is OK, because in that case it will never be used.
+ */
+
+ if (MR_type_ctor_has_variable_arity(type_ctor_info)) {
+ arity = MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info);
+ arg_vector = MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info);
+ node = MR_int_hash_lookup_or_add(node, arity);
+ } else {
+ arity = type_ctor_info->MR_type_ctor_arity;
+ arg_vector = MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info);
+ }
+
+ for (i = 1; i <= arity; i++) {
+ node = rec_call(node, arg_vector[i]);
+ }
+
+ return node;
Index: runtime/mercury_tabling.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_tabling.c,v
retrieving revision 1.70
diff -u -b -r1.70 mercury_tabling.c
--- runtime/mercury_tabling.c 28 Oct 2005 02:34:14 -0000 1.70
+++ runtime/mercury_tabling.c 6 Jun 2006 06:03:35 -0000
@@ -197,54 +197,14 @@
** The first group optionally records statistics about the number of successful
** and unsuccessful searches, and the number of probes they needed. From this
** information, one can compute the average successful and unsuccessful
-** search lengths.
+** search lengths. These macros are defined and undefined in the files
+** mercury_tabling_stats_{defs,nodefs,undefs}.h.
**
** The second optionally prints debugging messages.
**
** The third implements the initial creation of the hash table.
*/
-#ifdef MR_TABLE_STATISTICS
-static MR_Unsigned MR_table_hash_resizes = 0;
-static MR_Unsigned MR_table_hash_resize_old_entries = 0;
-static MR_Unsigned MR_table_hash_resize_new_entries = 0;
-static MR_Unsigned MR_table_hash_allocs = 0;
-static MR_Unsigned MR_table_hash_lookups = 0;
-static MR_Unsigned MR_table_hash_inserts = 0;
-static MR_Unsigned MR_table_hash_lookup_probes = 0;
-static MR_Unsigned MR_table_hash_insert_probes = 0;
-#endif
-
-#ifdef MR_TABLE_STATISTICS
- #define DECLARE_PROBE_COUNT MR_Integer probe_count = 0;
- #define record_probe_count() do { probe_count++; } while (0)
- #define record_lookup_count() do { \
- MR_table_hash_lookup_probes += \
- probe_count; \
- MR_table_hash_lookups++; \
- } while (0)
- #define record_insert_count() do { \
- MR_table_hash_insert_probes += \
- probe_count; \
- MR_table_hash_inserts++; \
- } while (0)
- #define record_resize_count(old, new) \
- do { \
- MR_table_hash_resizes++; \
- MR_table_hash_resize_old_entries += (old);\
- MR_table_hash_resize_new_entries += (new);\
- } while (0)
- #define record_alloc_count() do { MR_table_hash_allocs++; } while (0)
-#else
- #define DECLARE_PROBE_COUNT
- #define record_probe_count() ((void) 0)
- #define record_lookup_count() ((void) 0)
- #define record_insert_count() ((void) 0)
- #define record_resize_count(old, new) \
- ((void) 0)
- #define record_alloc_count() ((void) 0)
-#endif
-
#ifdef MR_TABLE_DEBUG
#define debug_key_msg(keyvalue, keyformat, keycast) \
do { \
@@ -306,10 +266,13 @@
** MR_CREATE_HASH_TABLE implement the bodies of the following functions:
**
** MR_int_hash_lookup_or_add
-** MR_float_hash_lookup_or_add
-** MR_string_hash_lookup_or_add
+** MR_int_hash_lookup_or_add_stats
** MR_int_hash_lookup
+** MR_float_hash_lookup_or_add
+** MR_float_hash_lookup_or_add_stats
** MR_float_hash_lookup
+** MR_string_hash_lookup_or_add
+** MR_string_hash_lookup_or_add_stats
** MR_string_hash_lookup
*/
@@ -347,7 +310,32 @@
#define hash(key) (key)
#define equal_keys(k1, k2) ((k1) == (k2))
#define lookup_only MR_FALSE
+#include "mercury_tabling_stats_nodefs.h"
#include "mercury_hash_lookup_or_add_body.h"
+#include "mercury_tabling_stats_undefs.h"
+#undef key_format
+#undef key_cast
+#undef table_type
+#undef table_field
+#undef hash
+#undef equal_keys
+#undef lookup_only
+}
+
+MR_TrieNode
+MR_int_hash_lookup_or_add_stats(MR_TableStepStats *stats,
+ MR_TrieNode t, MR_Integer key)
+{
+#define key_format "%ld"
+#define key_cast long
+#define table_type MR_IntHashTableSlot
+#define table_field int_slot_ptr
+#define hash(key) (key)
+#define equal_keys(k1, k2) ((k1) == (k2))
+#define lookup_only MR_FALSE
+#include "mercury_tabling_stats_defs.h"
+#include "mercury_hash_lookup_or_add_body.h"
+#include "mercury_tabling_stats_undefs.h"
#undef key_format
#undef key_cast
#undef table_type
@@ -367,7 +355,9 @@
#define hash(key) (key)
#define equal_keys(k1, k2) ((k1) == (k2))
#define lookup_only MR_TRUE
+#include "mercury_tabling_stats_nodefs.h"
#include "mercury_hash_lookup_or_add_body.h"
+#include "mercury_tabling_stats_undefs.h"
#undef key_format
#undef key_cast
#undef table_type
@@ -393,7 +383,32 @@
#define hash(key) (MR_hash_float(key))
#define equal_keys(k1, k2) (memcmp(&(k1), &(k2), sizeof(MR_Float)) == 0)
#define lookup_only MR_FALSE
+#include "mercury_tabling_stats_nodefs.h"
+#include "mercury_hash_lookup_or_add_body.h"
+#include "mercury_tabling_stats_undefs.h"
+#undef key_format
+#undef key_cast
+#undef table_type
+#undef table_field
+#undef hash
+#undef equal_keys
+#undef lookup_only
+}
+
+MR_TrieNode
+MR_float_hash_lookup_or_add_stats(MR_TableStepStats *stats,
+ MR_TrieNode t, MR_Float key)
+{
+#define key_format "%f"
+#define key_cast double
+#define table_type MR_FloatHashTableSlot
+#define table_field float_slot_ptr
+#define hash(key) (MR_hash_float(key))
+#define equal_keys(k1, k2) (memcmp(&(k1), &(k2), sizeof(MR_Float)) == 0)
+#define lookup_only MR_FALSE
+#include "mercury_tabling_stats_defs.h"
#include "mercury_hash_lookup_or_add_body.h"
+#include "mercury_tabling_stats_undefs.h"
#undef key_format
#undef key_cast
#undef table_type
@@ -413,7 +428,9 @@
#define hash(key) (MR_hash_float(key))
#define equal_keys(k1, k2) (memcmp(&(k1), &(k2), sizeof(MR_Float)) == 0)
#define lookup_only MR_TRUE
+#include "mercury_tabling_stats_nodefs.h"
#include "mercury_hash_lookup_or_add_body.h"
+#include "mercury_tabling_stats_undefs.h"
#undef key_format
#undef key_cast
#undef table_type
@@ -433,7 +450,32 @@
#define hash(key) (MR_hash_string(key))
#define equal_keys(k1, k2) (MR_strtest((k1), (k2)) == 0)
#define lookup_only MR_FALSE
+#include "mercury_tabling_stats_nodefs.h"
+#include "mercury_hash_lookup_or_add_body.h"
+#include "mercury_tabling_stats_undefs.h"
+#undef key_format
+#undef key_cast
+#undef table_type
+#undef table_field
+#undef hash
+#undef equal_keys
+#undef lookup_only
+}
+
+MR_TrieNode
+MR_string_hash_lookup_or_add_stats(MR_TableStepStats *stats,
+ MR_TrieNode t, MR_ConstString key)
+{
+#define key_format "%s"
+#define key_cast const char *
+#define table_type MR_StringHashTableSlot
+#define table_field string_slot_ptr
+#define hash(key) (MR_hash_string(key))
+#define equal_keys(k1, k2) (MR_strtest((k1), (k2)) == 0)
+#define lookup_only MR_FALSE
+#include "mercury_tabling_stats_defs.h"
#include "mercury_hash_lookup_or_add_body.h"
+#include "mercury_tabling_stats_undefs.h"
#undef key_format
#undef key_cast
#undef table_type
@@ -453,7 +495,9 @@
#define hash(key) (MR_hash_string(key))
#define equal_keys(k1, k2) (MR_strtest((k1), (k2)) == 0)
#define lookup_only MR_TRUE
+#include "mercury_tabling_stats_nodefs.h"
#include "mercury_hash_lookup_or_add_body.h"
+#include "mercury_tabling_stats_undefs.h"
#undef key_format
#undef key_cast
#undef table_type
@@ -473,7 +517,32 @@
#define hash(key) ((long) (key))
#define equal_keys(k1, k2) ((k1) == (k2))
#define lookup_only MR_FALSE
+#include "mercury_tabling_stats_nodefs.h"
#include "mercury_hash_lookup_or_add_body.h"
+#include "mercury_tabling_stats_undefs.h"
+#undef key_format
+#undef key_cast
+#undef table_type
+#undef table_field
+#undef hash
+#undef equal_keys
+#undef lookup_only
+}
+
+MR_TrieNode
+MR_word_hash_lookup_or_add_stats(MR_TableStepStats *stats,
+ MR_TrieNode t, MR_Word key)
+{
+#define key_format "%d"
+#define key_cast MR_Word
+#define table_type MR_WordHashTableSlot
+#define table_field word_slot_ptr
+#define hash(key) ((long) (key))
+#define equal_keys(k1, k2) ((k1) == (k2))
+#define lookup_only MR_FALSE
+#include "mercury_tabling_stats_defs.h"
+#include "mercury_hash_lookup_or_add_body.h"
+#include "mercury_tabling_stats_undefs.h"
#undef key_format
#undef key_cast
#undef table_type
@@ -493,7 +562,9 @@
#define hash(key) ((long) (key))
#define equal_keys(k1, k2) ((k1) == (k2))
#define lookup_only MR_TRUE
+#include "mercury_tabling_stats_nodefs.h"
#include "mercury_hash_lookup_or_add_body.h"
+#include "mercury_tabling_stats_undefs.h"
#undef key_format
#undef key_cast
#undef table_type
@@ -638,18 +709,18 @@
MR_TrieNode
MR_int_fix_index_lookup_or_add(MR_TrieNode t, MR_Integer range, MR_Integer key)
{
- if (t->MR_fix_table == NULL) {
- t->MR_fix_table = MR_TABLE_NEW_ARRAY(MR_TableNode, range);
- memset(t->MR_fix_table, 0, sizeof(MR_TableNode) * range);
- }
-
-#ifdef MR_TABLE_DEBUG
- if (key >= range) {
- MR_fatal_error("MR_int_fix_index_lookup_or_add: key out of range");
- }
-#endif
+#define record_alloc() ((void) 0)
+#include "mercury_table_int_fix_index_body.h"
+#undef record_alloc
+}
- return &t->MR_fix_table[key];
+MR_TrieNode
+MR_int_fix_index_lookup_or_add_stats(MR_TableStepStats *stats,
+ MR_TrieNode t, MR_Integer range, MR_Integer key)
+{
+#define record_alloc() do { stats->MR_tss_num_allocs++; } while(0)
+#include "mercury_table_int_fix_index_body.h"
+#undef record_alloc
}
/*---------------------------------------------------------------------------*/
@@ -668,46 +739,18 @@
MR_int_start_index_lookup_or_add(MR_TrieNode table, MR_Integer start,
MR_Integer key)
{
- MR_Integer diff, size;
-
- diff = key - start;
-
-#ifdef MR_TABLE_DEBUG
- if (key < start) {
- MR_fatal_error("MR_int_start_index_lookup_or_add: small too key");
- }
-#endif
-
- if (table->MR_start_table == NULL) {
- size = MR_max(MR_START_TABLE_INIT_SIZE, diff + 1);
- table->MR_start_table = MR_TABLE_NEW_ARRAY(MR_TableNode, size + 1);
- memset(table->MR_start_table + 1, 0, sizeof(MR_TableNode) * size);
- table->MR_start_table[0].MR_integer = size;
- } else {
- size = table->MR_start_table[0].MR_integer;
- }
-
- if (diff >= size) {
- MR_TableNode *new_array;
- MR_Integer new_size, i;
-
- new_size = MR_max(2 * size, diff + 1);
- new_array = MR_TABLE_NEW_ARRAY(MR_TableNode, new_size + 1);
-
- new_array[0].MR_integer = new_size;
-
- for (i = 0; i < size; i++) {
- new_array[i + 1] = table->MR_start_table[i + 1];
- }
-
- for (; i < new_size; i++) {
- new_array[i + 1].MR_integer = 0;
- }
-
- table->MR_start_table = new_array;
- }
+#define record_alloc() ((void) 0)
+#include "mercury_table_int_start_index_body.h"
+#undef record_alloc
+}
- return &table->MR_start_table[diff + 1];
+MR_TrieNode
+MR_int_start_index_lookup_or_add_stats(MR_TableStepStats *stats,
+ MR_TrieNode table, MR_Integer start, MR_Integer key)
+{
+#define record_alloc() do { stats->MR_tss_num_allocs++; } while(0)
+#include "mercury_table_int_start_index_body.h"
+#undef record_alloc
}
/*---------------------------------------------------------------------------*/
@@ -715,43 +758,22 @@
MR_TrieNode
MR_type_info_lookup_or_add(MR_TrieNode table, MR_TypeInfo type_info)
{
- MR_TypeCtorInfo type_ctor_info;
- MR_TrieNode node;
- MR_TypeInfo *arg_vector;
- int arity;
- int i;
-
- /* XXX memory allocation here should be optimized */
- type_info = MR_collapse_equivalences(type_info);
-
- type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
- node = MR_int_hash_lookup_or_add(table, (MR_Integer) type_ctor_info);
-
- /*
- ** All calls to MR_type_info_lookup_or_add that have the same value
- ** of node at this point agree on the type_ctor_info of the type
- ** being tabled. They must therefore also agree on its arity.
- ** This is why looping over all the arguments works.
- **
- ** If type_info has a zero-arity type_ctor, then it may be stored
- ** using a one-cell type_info, and type_info_args does not make
- ** sense. This is OK, because in that case it will never be used.
- */
-
- if (MR_type_ctor_has_variable_arity(type_ctor_info)) {
- arity = MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info);
- arg_vector = MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info);
- node = MR_int_hash_lookup_or_add(node, arity);
- } else {
- arity = type_ctor_info->MR_type_ctor_arity;
- arg_vector = MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info);
- }
-
- for (i = 1; i <= arity; i++) {
- node = MR_type_info_lookup_or_add(node, arg_vector[i]);
- }
+#define tci_call(n, tci) MR_int_hash_lookup_or_add((n), (tci))
+#define rec_call(n, ti) MR_type_info_lookup_or_add((n), (ti))
+#include "mercury_table_typeinfo_body.h"
+#undef tci_call
+#undef rec_call
+}
- return node;
+MR_TrieNode
+MR_type_info_lookup_or_add_stats(MR_TableStepStats *stats,
+ MR_TrieNode table, MR_TypeInfo type_info)
+{
+#define tci_call(n, tci) MR_int_hash_lookup_or_add_stats(stats, (n), (tci))
+#define rec_call(n, ti) MR_type_info_lookup_or_add_stats(stats, (n), (ti))
+#include "mercury_table_typeinfo_body.h"
+#undef tci_call
+#undef rec_call
}
MR_TrieNode
@@ -761,424 +783,131 @@
return NULL;
}
-/*---------------------------------------------------------------------------*/
+MR_TrieNode
+MR_type_class_info_lookup_or_add_stats(MR_TableStepStats *stats,
+ MR_TrieNode table, MR_Word *type_class_info)
+{
+ MR_fatal_error("tabling of typeclass_infos not yet implemented");
+ return NULL;
+}
-/*
-** This part defines the MR_table_type() function.
-**
-** NOTE: changes to this function will probably also have to be reflected
-** in the places listed in mercury_type_info.h.
-*/
+/*---------------------------------------------------------------------------*/
MR_TrieNode
MR_table_type(MR_TrieNode table, MR_TypeInfo type_info, MR_Word data)
{
- MR_TypeCtorInfo type_ctor_info;
- MR_DuTypeLayout du_type_layout;
-
- type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
-
-#ifdef MR_TABLE_DEBUG
- if (MR_tabledebug) {
- printf("ENTRY %p %x, data rep: %d\n",
- table, data, MR_type_ctor_rep(type_ctor_info));
- }
-#endif /* MR_TABLE_DEBUG */
-
- if (! MR_type_ctor_has_valid_rep(type_ctor_info)) {
- MR_fatal_error("MR_table_type: term of unknown representation");
- }
-
- switch (MR_type_ctor_rep(type_ctor_info)) {
- case MR_TYPECTOR_REP_ENUM:
- case MR_TYPECTOR_REP_ENUM_USEREQ:
- MR_DEBUG_TABLE_ENUM(table,
- MR_type_ctor_num_functors(type_ctor_info), data);
- return table;
-
- case MR_TYPECTOR_REP_DUMMY:
- /*
- ** If we are ever asked to table a value of a dummy type, we treat
- ** it mostly as an enum, with the exception being that we ignore
- ** the actual value to be table (since it contains garbage) and
- ** substitute the constant zero, which ought to be the enum value
- ** assigned to the type's only function symbol.
- **
- ** It would of course be preferable for the compiler to simply
- ** not insert any arguments of dummy types into tables.
- */
- MR_DEBUG_TABLE_ENUM(table, 1, 0);
- return table;
-
- case MR_TYPECTOR_REP_RESERVED_ADDR:
- case MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ:
- {
- int i;
- MR_ReservedAddrTypeLayout ra_layout;
-
- ra_layout = MR_type_ctor_layout(type_ctor_info).
- MR_layout_reserved_addr;
-
- /*
- ** First check if this value is one of
- ** the numeric reserved addresses.
- */
- if ((MR_Unsigned) data <
- (MR_Unsigned) ra_layout->MR_ra_num_res_numeric_addrs)
- {
- MR_DEBUG_TABLE_ENUM(table,
- MR_type_ctor_num_functors(type_ctor_info),
- ra_layout->MR_ra_constants[data]->
- MR_ra_functor_ordinal);
- break;
- }
-
- /*
- ** Next check if this value is one of the
- ** the symbolic reserved addresses.
- */
- for (i = 0; i < ra_layout->MR_ra_num_res_symbolic_addrs; i++) {
- if (data == (MR_Word)
- ra_layout->MR_ra_res_symbolic_addrs[i])
- {
- int offset = i + ra_layout->MR_ra_num_res_numeric_addrs;
- MR_DEBUG_TABLE_ENUM(table,
- MR_type_ctor_num_functors(type_ctor_info),
- ra_layout->MR_ra_constants[offset]->
- MR_ra_functor_ordinal);
- /* "break" here would just exit the "for" loop */
- return table;
- }
- }
-
- /*
- ** Otherwise, it is not one of the reserved addresses,
- ** so handle it like a normal DU type.
- */
- du_type_layout = ra_layout->MR_ra_other_functors;
- goto du_type;
- }
-
- case MR_TYPECTOR_REP_DU:
- case MR_TYPECTOR_REP_DU_USEREQ:
- du_type_layout = MR_type_ctor_layout(type_ctor_info).MR_layout_du;
- /* fall through */
-
- /*
- ** This label handles both the DU case and the second half of the
- ** RESERVED_ADDR case. `du_type_layout' must be set before
- ** this code is entered.
- */
- du_type:
- {
- MR_MemoryList allocated_memory_cells = NULL;
- const MR_DuPtagLayout *ptag_layout;
- const MR_DuFunctorDesc *functor_desc;
- const MR_DuExistInfo *exist_info;
- MR_TypeInfo arg_type_info;
- int ptag;
- MR_Word sectag;
- MR_Word *arg_vector;
- int meta_args;
- int i;
-
- ptag = MR_tag(data);
- ptag_layout = &du_type_layout[ptag];
-
- switch (ptag_layout->MR_sectag_locn) {
-
- case MR_SECTAG_NONE:
- functor_desc = ptag_layout->MR_sectag_alternatives[0];
- arg_vector = (MR_Word *) MR_body(data, ptag);
- break;
-
- case MR_SECTAG_LOCAL:
- sectag = MR_unmkbody(data);
- functor_desc = ptag_layout->MR_sectag_alternatives[sectag];
- assert(functor_desc->MR_du_functor_orig_arity == 0);
- assert(functor_desc->MR_du_functor_exist_info == NULL);
- arg_vector = NULL;
- break;
-
- case MR_SECTAG_REMOTE:
- sectag = MR_field(ptag, data, 0);
- functor_desc = ptag_layout->MR_sectag_alternatives[sectag];
- arg_vector = (MR_Word *) MR_body(data, ptag) + 1;
- break;
-
- case MR_SECTAG_VARIABLE:
- MR_fatal_error("MR_table_type(): unexpected variable");
-
- default:
- MR_fatal_error("MR_table_type(): unknown sectag_locn");
-
- }
-
- MR_DEBUG_TABLE_ENUM(table,
- MR_type_ctor_num_functors(type_ctor_info),
- functor_desc->MR_du_functor_ordinal);
-
- exist_info = functor_desc->MR_du_functor_exist_info;
- if (exist_info != NULL) {
- int num_ti_plain;
- int num_ti_in_tci;
- int num_tci;
- const MR_DuExistLocn *locns;
-
- num_ti_plain = exist_info->MR_exist_typeinfos_plain;
- num_ti_in_tci = exist_info->MR_exist_typeinfos_in_tci;
- num_tci = exist_info->MR_exist_tcis;
- locns = exist_info->MR_exist_typeinfo_locns;
-
- for (i = 0; i < num_ti_plain + num_ti_in_tci; i++) {
- if (locns[i].MR_exist_offset_in_tci < 0) {
- MR_DEBUG_TABLE_TYPEINFO(table, (MR_TypeInfo)
- arg_vector[locns[i].MR_exist_arg_num]);
- } else {
- MR_DEBUG_TABLE_TYPEINFO(table, (MR_TypeInfo)
- MR_typeclass_info_param_type_info(
- arg_vector[locns[i].MR_exist_arg_num],
- locns[i].MR_exist_offset_in_tci));
- }
- }
- meta_args = num_ti_plain + num_tci;
- } else {
- meta_args = 0;
- }
-
- for (i = 0; i < functor_desc->MR_du_functor_orig_arity; i++) {
- if (MR_arg_type_may_contain_var(functor_desc, i)) {
- arg_type_info = MR_make_type_info_maybe_existq(
- MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
- functor_desc->MR_du_functor_arg_types[i],
- arg_vector, functor_desc, &allocated_memory_cells);
- } else {
- arg_type_info = MR_pseudo_type_info_is_ground(
- functor_desc->MR_du_functor_arg_types[i]);
- }
-
- MR_DEBUG_TABLE_ANY(table, arg_type_info,
- arg_vector[meta_args + i]);
- }
-
- MR_deallocate(allocated_memory_cells);
- }
- return table;
-
- case MR_TYPECTOR_REP_NOTAG:
- case MR_TYPECTOR_REP_NOTAG_USEREQ:
- {
- MR_MemoryList allocated_memory_cells = NULL;
- MR_TypeInfo eqv_type_info;
-
- eqv_type_info = MR_make_type_info(
- MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
- MR_type_ctor_layout(type_ctor_info).MR_layout_notag->
- MR_notag_functor_arg_type, &allocated_memory_cells);
- MR_DEBUG_TABLE_ANY(table, eqv_type_info, data);
- MR_deallocate(allocated_memory_cells);
- }
- return table;
-
- case MR_TYPECTOR_REP_NOTAG_GROUND:
- case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
- MR_DEBUG_TABLE_ANY(table, MR_pseudo_type_info_is_ground(
- MR_type_ctor_layout(type_ctor_info).MR_layout_notag->
- MR_notag_functor_arg_type), data);
- return table;
-
- case MR_TYPECTOR_REP_EQUIV:
- {
- MR_MemoryList allocated_memory_cells = NULL;
- MR_TypeInfo eqv_type_info;
-
- eqv_type_info = MR_make_type_info(
- MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
- MR_type_ctor_layout(type_ctor_info).MR_layout_equiv,
- &allocated_memory_cells);
- MR_DEBUG_TABLE_ANY(table, eqv_type_info, data);
- MR_deallocate(allocated_memory_cells);
- }
-
- return table;
-
- case MR_TYPECTOR_REP_EQUIV_GROUND:
- MR_DEBUG_TABLE_ANY(table, MR_pseudo_type_info_is_ground(
- MR_type_ctor_layout(type_ctor_info).MR_layout_equiv), data);
- return table;
-
- case MR_TYPECTOR_REP_INT:
- MR_DEBUG_TABLE_INT(table, data);
- return table;
-
- case MR_TYPECTOR_REP_CHAR:
- MR_DEBUG_TABLE_CHAR(table, data);
- return table;
-
- case MR_TYPECTOR_REP_FLOAT:
- MR_DEBUG_TABLE_FLOAT(table, data);
- return table;
-
- case MR_TYPECTOR_REP_STRING:
- MR_DEBUG_TABLE_STRING(table, (MR_String) data);
- return table;
-
- case MR_TYPECTOR_REP_FUNC:
- case MR_TYPECTOR_REP_PRED:
- {
- /*
- ** XXX tabling of the closures by tabling their code address
- ** and arguments is not yet implemented, due to the overhead
- ** of figuring out the closure argument types.
- */
- #if 0
- MR_closure closure;
- MR_Word num_hidden_args;
- int i;
-
- closure = (MR_Closure *) data;
- num_hidden_args = closure->MR_closure_num_hidden_args;
- MR_DEBUG_TABLE_INT(table, closure->MR_closure_code);
- for (i = 1; i <= num_hidden_args; i++) {
- MR_DEBUG_TABLE_ANY(table,
- <type_info for hidden closure argument number i>,
- closure->MR_closure_hidden_args(i));
- }
- #else
- /*
- ** Instead, we use the following rather simplistic means of
- ** tabling closures: we just table based on the closure address.
- */
- MR_DEBUG_TABLE_INT(table, data);
- #endif
-
- return table;
- }
-
- case MR_TYPECTOR_REP_TUPLE:
- {
- MR_Word *data_value;
- MR_TypeInfo *arg_type_info_vector;
- int arity;
- int i;
-
- data_value = (MR_Word *) data;
- arity = MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info);
- arg_type_info_vector =
- MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info);
- for (i = 0; i < arity; i++) {
- /* type_infos are counted starting at one */
- MR_DEBUG_TABLE_ANY(table, arg_type_info_vector[i + 1],
- data_value[i]);
- }
-
- return table;
- }
-
- case MR_TYPECTOR_REP_SUBGOAL:
- MR_fatal_error("Cannot table a subgoal");
-
- case MR_TYPECTOR_REP_VOID:
- MR_fatal_error("Cannot table a void type");
-
- case MR_TYPECTOR_REP_C_POINTER:
- MR_fatal_error("Attempt to table a C_POINTER");
-
- case MR_TYPECTOR_REP_STABLE_C_POINTER:
- /*
- ** This works because a stable C pointer guarantees that the
- ** data structures pointed to, indirectly as well as directly,
- ** will remain stable until the program exits.
- */
- MR_DEBUG_TABLE_INT(table, data);
-
- case MR_TYPECTOR_REP_STABLE_FOREIGN:
- /*
- ** This works because a stable foreign type guarantees that the
- ** data structures pointed to, indirectly as well as directly,
- ** will remain stable until the program exits.
- */
- MR_DEBUG_TABLE_INT(table, data);
-
- case MR_TYPECTOR_REP_TYPEINFO:
- case MR_TYPECTOR_REP_TYPEDESC:
- MR_DEBUG_TABLE_TYPEINFO(table, (MR_TypeInfo) data);
- return table;
-
- case MR_TYPECTOR_REP_PSEUDOTYPEDESC:
- MR_fatal_error("Attempt to table a pseudo_type_desc");
-
- case MR_TYPECTOR_REP_TYPECTORINFO:
- MR_fatal_error("Attempt to table a type_ctor_info");
-
- case MR_TYPECTOR_REP_TYPECTORDESC:
- MR_fatal_error("Attempt to table a type_ctor_desc");
-
- case MR_TYPECTOR_REP_TYPECLASSINFO:
- MR_fatal_error("Attempt to table a type_class_info");
-
- case MR_TYPECTOR_REP_BASETYPECLASSINFO:
- MR_fatal_error("Attempt to table a base_type_class_info");
-
- case MR_TYPECTOR_REP_ARRAY:
- {
- MR_TypeInfo new_type_info;
- MR_MemoryList allocated_memory_cells = NULL;
- MR_ArrayType *array;
- MR_Integer array_size;
- int i;
-
- array = (MR_ArrayType *) data;
- array_size = array->size;
-
- new_type_info = MR_make_type_info(
- MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
- (MR_PseudoTypeInfo) 1, &allocated_memory_cells);
-
- for (i = 0; i < array_size; i++) {
- MR_DEBUG_TABLE_ANY(table, new_type_info,
- array->elements[i]);
- }
-
- MR_deallocate(allocated_memory_cells);
- return table;
- }
-
- case MR_TYPECTOR_REP_SUCCIP:
- MR_fatal_error("Attempt to table a saved succip");
-
- case MR_TYPECTOR_REP_HP:
- MR_fatal_error("Attempt to table a saved hp");
-
- case MR_TYPECTOR_REP_CURFR:
- MR_fatal_error("Attempt to table a saved curfr");
-
- case MR_TYPECTOR_REP_MAXFR:
- MR_fatal_error("Attempt to table a saved maxfr");
-
- case MR_TYPECTOR_REP_REDOFR:
- MR_fatal_error("Attempt to table a saved redofr");
+#define func "MR_table_type"
+#define STATS NULL
+#define DEBUG MR_FALSE
+#define BACK MR_FALSE
+#include "mercury_table_type_body.h"
+#undef func
+#undef STATS
+#undef DEBUG
+#undef BACK
+}
- case MR_TYPECTOR_REP_REDOIP:
- MR_fatal_error("Attempt to table a saved redoip");
+MR_TrieNode
+MR_table_type_debug(MR_TrieNode table, MR_TypeInfo type_info, MR_Word data)
+{
+#define func "MR_table_type_debug"
+#define STATS NULL
+#define DEBUG MR_TRUE
+#define BACK MR_FALSE
+#include "mercury_table_type_body.h"
+#undef func
+#undef STATS
+#undef DEBUG
+#undef BACK
+}
- case MR_TYPECTOR_REP_TRAIL_PTR:
- MR_fatal_error("Attempt to table a saved trail pointer");
+MR_TrieNode
+MR_table_type_stats(MR_TableStepStats *stats, MR_TrieNode table,
+ MR_TypeInfo type_info, MR_Word data)
+{
+#define func "MR_table_type_stats"
+#define STATS stats
+#define DEBUG MR_FALSE
+#define BACK MR_FALSE
+#include "mercury_table_type_body.h"
+#undef func
+#undef STATS
+#undef DEBUG
+#undef BACK
+}
- case MR_TYPECTOR_REP_TICKET:
- MR_fatal_error("Attempt to table a saved ticket");
+MR_TrieNode
+MR_table_type_stats_debug(MR_TableStepStats *stats, MR_TrieNode table,
+ MR_TypeInfo type_info, MR_Word data)
+{
+#define func "MR_table_type_stats_debug"
+#define STATS stats
+#define DEBUG MR_TRUE
+#define BACK MR_FALSE
+#include "mercury_table_type_body.h"
+#undef func
+#undef STATS
+#undef DEBUG
+#undef BACK
+}
- case MR_TYPECTOR_REP_FOREIGN:
- MR_fatal_error("Attempt to table a value of a foreign type");
+MR_TrieNode
+MR_table_type_back(MR_TrieNode table, MR_TypeInfo type_info, MR_Word data)
+{
+#define func "MR_table_type"
+#define STATS NULL
+#define DEBUG MR_FALSE
+#define BACK MR_TRUE
+#include "mercury_table_type_body.h"
+#undef func
+#undef STATS
+#undef DEBUG
+#undef BACK
+}
- case MR_TYPECTOR_REP_REFERENCE:
- MR_fatal_error("Attempt to table a value of a reference type");
+MR_TrieNode
+MR_table_type_debug_back(MR_TrieNode table, MR_TypeInfo type_info,
+ MR_Word data)
+{
+#define func "MR_table_type_debug"
+#define STATS NULL
+#define DEBUG MR_TRUE
+#define BACK MR_TRUE
+#include "mercury_table_type_body.h"
+#undef func
+#undef STATS
+#undef DEBUG
+#undef BACK
+}
- case MR_TYPECTOR_REP_UNKNOWN: /* fallthru */
- MR_fatal_error("Unknown layout tag in table_any");
- }
+MR_TrieNode
+MR_table_type_stats_back(MR_TableStepStats *stats, MR_TrieNode table,
+ MR_TypeInfo type_info, MR_Word data)
+{
+#define func "MR_table_type_stats"
+#define STATS stats
+#define DEBUG MR_FALSE
+#define BACK MR_TRUE
+#include "mercury_table_type_body.h"
+#undef func
+#undef STATS
+#undef DEBUG
+#undef BACK
+}
- MR_fatal_error("MR_table_type: unexpected fallthrough");
+MR_TrieNode
+MR_table_type_stats_debug_back(MR_TableStepStats *stats, MR_TrieNode table,
+ MR_TypeInfo type_info, MR_Word data)
+{
+#define func "MR_table_type_stats_debug"
+#define STATS stats
+#define DEBUG MR_TRUE
+#define BACK MR_TRUE
+#include "mercury_table_type_body.h"
+#undef func
+#undef STATS
+#undef DEBUG
+#undef BACK
}
/*---------------------------------------------------------------------------*/
@@ -1186,47 +915,13 @@
void
MR_table_report_statistics(FILE *fp)
{
- fprintf(fp, "hash table search/insert statistics:\n");
-
-#ifdef MR_TABLE_STATISTICS
- if (MR_table_hash_lookups == 0) {
- fprintf(fp, "no successful probes\n");
- } else {
- fprintf(fp, "successful %8d, with an average of %6.3f comparisons\n",
- MR_table_hash_lookups,
- (float) MR_table_hash_lookup_probes /
- (float) MR_table_hash_lookups);
- }
-
- if (MR_table_hash_inserts == 0) {
- fprintf(fp, "no unsuccessful probes\n");
- } else {
- fprintf(fp, "unsuccessful %8d, with an average of %6.3f comparisons\n",
- MR_table_hash_inserts,
- (float) MR_table_hash_insert_probes /
- (float) MR_table_hash_inserts);
- }
-
- fprintf(fp, "rehash operations: %d, per search: %6.3f%%\n",
- MR_table_hash_resizes,
- (float) (100 * MR_table_hash_resizes) /
- (float) (MR_table_hash_lookups + MR_table_hash_inserts));
- fprintf(fp, "slots rehashed by rehash operations: %d\n",
- MR_table_hash_resize_old_entries);
- fprintf(fp, "slots initialized by rehash operations: %d\n",
- MR_table_hash_resize_new_entries);
- fprintf(fp, "chunk allocations: %d\n", MR_table_hash_allocs);
-
- #ifdef MR_USE_MINIMAL_MODEL_STACK_COPY
- fprintf(fp, "\n");
+#ifdef MR_USE_MINIMAL_MODEL_STACK_COPY
+ #ifdef MR_TABLE_STATISTICS
MR_minimal_model_report_stats(fp);
#endif
- #ifdef MR_USE_MINIMAL_MODEL_OWN_STACKS
- fprintf(fp, "\n");
+#endif
+#ifdef MR_USE_MINIMAL_MODEL_OWN_STACKS
MR_mm_own_stacks_report_stats(fp);
- #endif
-#else
- fprintf(fp, "not enabled\n");
#endif
}
@@ -1380,12 +1075,10 @@
int num_outputs;
int i;
- num_inputs = proc->MR_sle_table_info.MR_table_gen->
- MR_table_gen_num_inputs;
- num_outputs = proc->MR_sle_table_info.MR_table_gen->
- MR_table_gen_num_outputs;
+ num_inputs = proc->MR_sle_table_info.MR_table_proc->MR_pt_num_inputs;
+ num_outputs = proc->MR_sle_table_info.MR_table_proc->MR_pt_num_outputs;
- ptis = proc->MR_sle_table_info.MR_table_gen->MR_table_gen_ptis;
+ ptis = proc->MR_sle_table_info.MR_table_proc->MR_pt_ptis;
ptis += num_inputs;
for (i = 0; i < num_outputs; i++) {
@@ -1405,8 +1098,7 @@
} else if (tci == &MR_TYPE_CTOR_INFO_NAME(builtin, float, 0)) {
fprintf(fp, "%f",
#ifdef MR_HIGHLEVEL_CODE
- (double) MR_unbox_float(
- (MR_Box) answer_block[i]));
+ (double) MR_unbox_float((MR_Box) answer_block[i]));
#else
(double) MR_word_to_float(answer_block[i]));
#endif
Index: runtime/mercury_tabling.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_tabling.h,v
retrieving revision 1.40
diff -u -b -r1.40 mercury_tabling.h
--- runtime/mercury_tabling.h 10 Jun 2005 07:12:51 -0000 1.40
+++ runtime/mercury_tabling.h 6 Jun 2006 06:04:51 -0000
@@ -21,7 +21,7 @@
#include "mercury_reg_workarounds.h"
#include "mercury_dlist.h"
#include "mercury_goto.h" /* for MR_declare_entry */
-#include "mercury_stack_layout.h" /* for MR_Proc_Layout */
+#include "mercury_tags.h" /* for `MR_DEFINE_BUILTIN_ENUM_CONST' */
#ifndef MR_CONSERVATIVE_GC
#include "mercury_deep_copy.h"
@@ -29,6 +29,12 @@
#include <stdio.h>
+#ifdef MR_TABLE_DEBUG
+#define MR_TABLE_DEBUG_BOOL MR_TRUE
+#else
+#define MR_TABLE_DEBUG_BOOL MR_FALSE
+#endif
+
/*---------------------------------------------------------------------------*/
/*
@@ -169,6 +175,160 @@
MR_AnswerList *MR_mn_answer_list_tail;
};
+/*
+** The MR_ProcTableInfo structure.
+**
+** To enable debugging (especially performance debugging) of tabled predicates,
+** the compiler generates one of these structures for each tabled predicate
+** (except I/O primitives, for which it generates an MR_Table_Io_Decl
+** structure).
+**
+** Each argument of a tabled predicate is an input or an output. Inputs are put
+** into the call trie (stored in the tablenode field), which has one level
+** per input argument. The structure of each level depends on what kind of type
+** the corresponding input argument is; this is recorded in the input_steps
+** field, which points to an array of size num_inputs. If the type is an enum,
+** we cannot interpret the data structures on that level without also knowing
+** how many alternatives the type has; this is recorded in the corresponding
+** element of the enum_params array, which is likewise of size num_inputs.
+** (Elements of the enum_params array that correspond to arguments whose types
+** are not enums are not meaningful.)
+**
+** The ptis field points to an array of pseudotypeinfos of size num_inputs +
+** num_outputs. The first num_inputs elements give the types of the input
+** arguments, while the remaining num_outputs elements give the types of the
+** output arguments. The type_params field describes where any typeinfos
+** among the input arguments are at call, since without this information
+** the debugger cannot turn the pseudotypeinfos pointed to by ptis field info
+** typeinfos.
+**
+** If the collection of statistics was not enabled for this table, then the
+** stats field will point to an array num_inputs MR_TableStepStats structures,
+** one for each input argument. Each element of this array contains statistics
+** about the corresponding level of the trie.
+**
+** Users can use the stats field to retrieve statistics derived from the
+** entire lifetime of the table so far. To enable users to derive information
+** derived only since the last such lookup, we record the information retrieved
+** on each lookup in the prev_stats field (which will be NULL until the first
+** such lookup).
+**
+** If there is no size limit on the table, then the size_limit field will be
+** zero and the call_table_tips, num_call_table_tips and next_to_evict fields
+** are not meaningful. If there is a size limit on the table, then the
+** size_limit field says how many call table tips are allowed to exist at
+** any one time, the num_call_table_tips field says how many exist at this time
+** (this number will be between zero and size_limit, both inclusive),
+** the call_table_tips field will point to an array of size_limit call table
+** tips, of which the first num_call_table_tips will be meaningful. The
+** next_to_evict field says which one of these entries is scheduled to be
+** evicted next under the FIFO replacement strategy.
+**
+** XXX We need other fields (e.g. in hash tables and tries) to allow us
+** to delete internal nodes of the trie that become empty after evictions.
+*/
+
+typedef enum {
+ MR_DEFINE_BUILTIN_ENUM_CONST(MR_TABLE_TYPE_LOOPCHECK),
+ MR_DEFINE_BUILTIN_ENUM_CONST(MR_TABLE_TYPE_MEMO),
+ MR_DEFINE_BUILTIN_ENUM_CONST(MR_TABLE_TYPE_MINIMAL_MODEL_STACK_COPY),
+ MR_DEFINE_BUILTIN_ENUM_CONST(MR_TABLE_TYPE_MINIMAL_MODEL_OWN_STACKS)
+} MR_TableType;
+
+/*
+** The definition of this type should correspond to the type table_step_kind
+** in library/table_builtin.m.
+*/
+
+typedef enum {
+ MR_DEFINE_BUILTIN_ENUM_CONST(MR_TABLE_STEP_DUMMY),
+ MR_DEFINE_BUILTIN_ENUM_CONST(MR_TABLE_STEP_INT),
+ MR_DEFINE_BUILTIN_ENUM_CONST(MR_TABLE_STEP_CHAR),
+ MR_DEFINE_BUILTIN_ENUM_CONST(MR_TABLE_STEP_STRING),
+ MR_DEFINE_BUILTIN_ENUM_CONST(MR_TABLE_STEP_FLOAT),
+ MR_DEFINE_BUILTIN_ENUM_CONST(MR_TABLE_STEP_ENUM),
+ MR_DEFINE_BUILTIN_ENUM_CONST(MR_TABLE_STEP_USER),
+ MR_DEFINE_BUILTIN_ENUM_CONST(MR_TABLE_STEP_USER_FAST_LOOSE),
+ MR_DEFINE_BUILTIN_ENUM_CONST(MR_TABLE_STEP_POLY),
+ MR_DEFINE_BUILTIN_ENUM_CONST(MR_TABLE_STEP_POLY_FAST_LOOSE),
+ 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_TableTrieStep;
+
+typedef MR_Unsigned MR_Counter;
+
+struct MR_TableStepStats_Struct {
+ MR_Counter MR_tss_num_allocs;
+ MR_Counter MR_tss_num_inserts;
+ MR_Counter MR_tss_num_lookups;
+ MR_Counter MR_tss_num_insert_probes;
+ MR_Counter MR_tss_num_lookup_probes;
+ MR_Counter MR_tss_num_resizes;
+ MR_Counter MR_tss_num_resizes_old_entries;
+ MR_Counter MR_tss_num_resizes_new_entries;
+};
+
+#define MR_copy_table_step_stats(prev, cur) \
+ do { \
+ prev->MR_tss_num_allocs = cur->MR_tss_num_allocs; \
+ prev->MR_tss_num_inserts = cur->MR_tss_num_inserts; \
+ prev->MR_tss_num_lookups = cur->MR_tss_num_lookups; \
+ prev->MR_tss_num_insert_probes = \
+ cur->MR_tss_num_insert_probes; \
+ prev->MR_tss_num_lookup_probes = \
+ cur->MR_tss_num_lookup_probes; \
+ prev->MR_tss_num_resizes = cur->MR_tss_num_resizes; \
+ prev->MR_tss_num_resizes_old_entries = \
+ cur->MR_tss_num_resizes_old_entries; \
+ prev->MR_tss_num_resizes_new_entries = \
+ cur->MR_tss_num_resizes_new_entries; \
+ } while (0)
+
+struct MR_ProcTableInfo_Struct {
+ MR_TableType MR_pt_table_type;
+ int MR_pt_num_inputs;
+ int MR_pt_num_outputs;
+ int MR_pt_has_answer_table;
+ const MR_TableTrieStep *MR_pt_input_steps;
+ const MR_Integer *MR_pt_input_enum_params;
+ const MR_TableTrieStep *MR_pt_output_steps;
+ const MR_Integer *MR_pt_output_enum_params;
+ const MR_PseudoTypeInfo *MR_pt_ptis;
+ const MR_Type_Param_Locns *MR_pt_type_params;
+
+ MR_TableNode MR_pt_tablenode;
+
+ MR_Counter MR_pt_call_table_lookups;
+ MR_Counter MR_pt_call_table_not_dupl;
+ MR_TableStepStats *MR_pt_call_table_stats;
+ MR_Counter MR_pt_prev_call_table_lookups;
+ MR_Counter MR_pt_prev_call_table_not_dupl;
+ MR_TableStepStats *MR_pt_prev_call_table_stats;
+
+ MR_Counter MR_pt_answer_table_lookups;
+ MR_Counter MR_pt_answer_table_not_dupl;
+ MR_TableStepStats *MR_pt_answer_table_stats;
+ MR_Counter MR_pt_prev_answer_table_lookups;
+ MR_Counter MR_pt_prev_answer_table_not_dupl;
+ MR_TableStepStats *MR_pt_prev_answer_table_stats;
+
+ MR_Unsigned MR_pt_size_limit;
+ MR_TrieNode *MR_pt_call_table_tips;
+ MR_Unsigned MR_pt_num_call_table_tips;
+ MR_Unsigned MR_pt_next_to_evict;
+};
+
+/* This type is only for backward compatibility */
+typedef struct MR_Table_Gen_Struct {
+ int MR_table_gen_num_inputs;
+ int MR_table_gen_num_outputs;
+ const MR_TableTrieStep *MR_table_gen_input_steps;
+ const MR_Integer *MR_table_gen_enum_params;
+ const MR_PseudoTypeInfo *MR_table_gen_ptis;
+ const MR_Type_Param_Locns *MR_table_gen_type_params;
+} MR_Table_Gen;
+
/*---------------------------------------------------------------------------*/
/*
@@ -187,12 +347,24 @@
extern MR_TrieNode MR_int_hash_lookup_or_add(MR_TrieNode table,
MR_Integer key);
+extern MR_TrieNode MR_int_hash_lookup_or_add_stats(
+ MR_TableStepStats *stats, MR_TrieNode table,
+ MR_Integer key);
extern MR_TrieNode MR_float_hash_lookup_or_add(MR_TrieNode table,
MR_Float key);
+extern MR_TrieNode MR_float_hash_lookup_or_add_stats(
+ MR_TableStepStats *stats, MR_TrieNode table,
+ MR_Float key);
extern MR_TrieNode MR_string_hash_lookup_or_add(MR_TrieNode table,
MR_ConstString key);
+extern MR_TrieNode MR_string_hash_lookup_or_add_stats(
+ MR_TableStepStats *stats, MR_TrieNode table,
+ MR_ConstString key);
extern MR_TrieNode MR_word_hash_lookup_or_add(MR_TrieNode table,
MR_Word key);
+extern MR_TrieNode MR_word_hash_lookup_or_add_stats(
+ MR_TableStepStats *stats, MR_TrieNode table,
+ MR_Word key);
/*
** This function assumes that the table is a statically sized array,
@@ -201,6 +373,9 @@
extern MR_TrieNode MR_int_fix_index_lookup_or_add(MR_TrieNode table,
MR_Integer range, MR_Integer key);
+extern MR_TrieNode MR_int_fix_index_lookup_or_add_stats(
+ MR_TableStepStats *stats, MR_TrieNode table,
+ MR_Integer range, MR_Integer key);
/*
** This function assumes that the table is an expandable array,
@@ -209,6 +384,9 @@
extern MR_TrieNode MR_int_start_index_lookup_or_add(MR_TrieNode table,
MR_Integer start, MR_Integer key);
+extern MR_TrieNode MR_int_start_index_lookup_or_add_stats(
+ MR_TableStepStats *stats, MR_TrieNode table,
+ MR_Integer start, MR_Integer key);
/*
** This function tables type_infos in a hash table.
@@ -216,6 +394,9 @@
extern MR_TrieNode MR_type_info_lookup_or_add(MR_TrieNode table,
MR_TypeInfo type_info);
+extern MR_TrieNode MR_type_info_lookup_or_add_stats(
+ MR_TableStepStats *stats, MR_TrieNode table,
+ MR_TypeInfo type_info);
/*
** This function tables typeclass_infos in a hash table.
@@ -223,6 +404,9 @@
extern MR_TrieNode MR_type_class_info_lookup_or_add(MR_TrieNode table,
MR_Word *type_class_info);
+extern MR_TrieNode MR_type_class_info_lookup_or_add_stats(
+ MR_TableStepStats *stats, MR_TrieNode table,
+ MR_Word *type_class_info);
/*
** This function tables values of arbitrary types; the form of the data
@@ -234,6 +418,24 @@
extern MR_TrieNode MR_table_type(MR_TrieNode table,
MR_TypeInfo type_info, MR_Word data_value);
+extern MR_TrieNode MR_table_type_debug(MR_TrieNode table,
+ MR_TypeInfo type_info, MR_Word data_value);
+extern MR_TrieNode MR_table_type_stats(
+ MR_TableStepStats *stats, MR_TrieNode table,
+ MR_TypeInfo type_info, MR_Word data_value);
+extern MR_TrieNode MR_table_type_stats_debug(
+ MR_TableStepStats *stats, MR_TrieNode table,
+ MR_TypeInfo type_info, MR_Word data_value);
+extern MR_TrieNode MR_table_type_back(MR_TrieNode table,
+ MR_TypeInfo type_info, MR_Word data_value);
+extern MR_TrieNode MR_table_type_debug_back(MR_TrieNode table,
+ MR_TypeInfo type_info, MR_Word data_value);
+extern MR_TrieNode MR_table_type_stats_back(
+ MR_TableStepStats *stats, MR_TrieNode table,
+ MR_TypeInfo type_info, MR_Word data_value);
+extern MR_TrieNode MR_table_type_stats_debug_back(
+ MR_TableStepStats *stats, MR_TrieNode table,
+ MR_TypeInfo type_info, MR_Word data_value);
/*
** These functions look to see if the given key is in the given table.
@@ -435,4 +637,7 @@
#include "mercury_tabling_macros.h"
#include "mercury_tabling_preds.h"
+#include "mercury_stack_layout.h" /* for MR_Proc_Layout and */
+ /* MR_Type_Param_Locns */
+
#endif /* not MERCURY_TABLING_H */
Index: runtime/mercury_tabling_macros.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_tabling_macros.h,v
retrieving revision 1.12
diff -u -b -r1.12 mercury_tabling_macros.h
--- runtime/mercury_tabling_macros.h 7 Jun 2005 03:00:04 -0000 1.12
+++ runtime/mercury_tabling_macros.h 6 Jun 2006 05:55:32 -0000
@@ -1,4 +1,7 @@
/*
+** vim: ts=4 sw=4
+*/
+/*
** Copyright (C) 1997-2000,2002-2005 The University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
@@ -19,441 +22,279 @@
#define MR_RAW_TABLE_ANY(table, type_info, value) \
MR_table_type((table), (type_info), (value))
-#define MR_RAW_TABLE_ANY_FAST_LOOSE(table, type_info, value) \
+#define MR_RAW_TABLE_ANY_DEBUG(table, type_info, value) \
+ MR_table_type_debug((table), (type_info), (value))
+
+#define MR_RAW_TABLE_ANY_STATS(stats, table, type_info, value) \
+ MR_table_type_stats((stats), (table), (type_info), (value))
+
+#define MR_RAW_TABLE_ANY_STATS_DEBUG(stats, table, type_info, value) \
+ MR_table_type_stats_debug((stats), (table), (type_info), (value))
+
+#define MR_RAW_TABLE_ANY_ADDR(table, type_info, value) \
MR_word_hash_lookup_or_add((table), (value))
+#define MR_RAW_TABLE_ANY_ADDR_STATS(stats, table, type_info, value) \
+ MR_word_hash_lookup_or_add_stats((stats), (table), (value))
+
#define MR_RAW_TABLE_TAG(table, tag) \
MR_int_fix_index_lookup_or_add((table), 1 << MR_TAGBITS, (tag))
+#define MR_RAW_TABLE_TAG_STATS(stats, table, tag) \
+ MR_int_fix_index_lookup_or_add_stats((stats), (table), \
+ 1 << MR_TAGBITS, (tag))
+
#define MR_RAW_TABLE_ENUM(table, range, value) \
MR_int_fix_index_lookup_or_add((table), (range), (value))
+#define MR_RAW_TABLE_ENUM_STATS(stats, table, range, value) \
+ MR_int_fix_index_lookup_or_add_stats((stats), (table), \
+ (range), (value))
+
#define MR_RAW_TABLE_START_INT(table, start, value) \
MR_int_start_index_lookup_or_add((table), (start), (value));
+#define MR_RAW_TABLE_START_INT_STATS(stats, table, start, value) \
+ MR_int_start_index_lookup_or_add_stats((stats), (table), \
+ (start), (value));
+
#define MR_RAW_TABLE_WORD(table, value) \
MR_int_hash_lookup_or_add((table), (value));
+#define MR_RAW_TABLE_WORD_STATS(stats, table, value) \
+ MR_int_hash_lookup_or_add_stats((stats), (table), (value));
+
#define MR_RAW_TABLE_INT(table, value) \
MR_int_hash_lookup_or_add((table), (value));
+#define MR_RAW_TABLE_INT_STATS(stats, table, value) \
+ MR_int_hash_lookup_or_add_stats((stats), (table), (value));
+
#define MR_RAW_TABLE_CHAR(table, value) \
MR_int_hash_lookup_or_add((table), (value));
+#define MR_RAW_TABLE_CHAR_STATS(stats, table, value) \
+ MR_int_hash_lookup_or_add_stats((stats), (table), (value));
+
#define MR_RAW_TABLE_FLOAT(table, value) \
MR_float_hash_lookup_or_add((table), (value));
+#define MR_RAW_TABLE_FLOAT_STATS(stats, table, value) \
+ MR_float_hash_lookup_or_add_stats((stats), (table), (value));
+
#define MR_RAW_TABLE_STRING(table, value) \
MR_string_hash_lookup_or_add((table), (value));
+#define MR_RAW_TABLE_STRING_STATS(stats, table, value) \
+ MR_string_hash_lookup_or_add_stats((stats), (table), (value));
+
#define MR_RAW_TABLE_TYPEINFO(table, type_info) \
MR_type_info_lookup_or_add((table), (type_info))
+#define MR_RAW_TABLE_TYPEINFO_STATS(stats, table, type_info) \
+ MR_type_info_lookup_or_add_stats((stats), (table), (type_info))
+
#define MR_RAW_TABLE_TYPECLASSINFO(table, typeclass_info) \
MR_type_class_info_lookup_or_add((table), (typeclass_info))
-#ifdef MR_TABLE_DEBUG
+#define MR_RAW_TABLE_TYPECLASSINFO_STATS(stats, table, typeclass_info) \
+ MR_type_class_info_lookup_or_add_stats((stats), (table), (typeclass_info))
-#define MR_DEBUG_NEW_TABLE_ANY(table, table0, type_info, value) \
- do { \
- (table) = MR_RAW_TABLE_ANY((table0), (type_info), \
- (value)); \
- if (MR_tabledebug) { \
- printf("TABLE %p: any %x type %p => %p\n", \
- (table0), (value), (type_info), (table));\
- } \
- } while (0)
-#define MR_DEBUG_TABLE_ANY(table, type_info, value) \
+/***********************************************************************/
+
+#define MR_TABLE_ANY(stats, debug, back, t, t0, type_info, value) \
do { \
- MR_TrieNode prev_table = (table); \
- (table) = MR_RAW_TABLE_ANY((table), \
+ if (stats != NULL) { \
+ (t) = MR_RAW_TABLE_ANY_STATS((stats), (t0), \
(type_info), (value)); \
- if (MR_tabledebug) { \
- printf("TABLE %p: any %x type %p => %p\n", \
- prev_table, (value), (type_info), \
- (table)); \
+ } else { \
+ (t) = MR_RAW_TABLE_ANY((t0), (type_info), (value)); \
} \
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_ANY_FAST_LOOSE(table, table0, type_info, value) \
- do { \
- (table) = MR_RAW_TABLE_ANY_FAST_LOOSE((table0), (type_info), \
- (value)); \
- if (MR_tabledebug) { \
+ if (debug && MR_tabledebug) { \
printf("TABLE %p: any %x type %p => %p\n", \
- (table0), (value), (type_info), (table));\
+ (t0), (value), (type_info), (t)); \
} \
} while (0)
-#define MR_DEBUG_TABLE_ANY_FAST_LOOSE(table, type_info, value) \
+
+#define MR_TABLE_ANY_ADDR(stats, debug, back, t, t0, type_info, value) \
do { \
- MR_TrieNode prev_table = (table); \
- (table) = MR_RAW_TABLE_ANY_FAST_LOOSE((table), \
+ if (stats != NULL) { \
+ (t) = MR_RAW_TABLE_ANY_ADDR_STATS((stats), (t0), \
(type_info), (value)); \
- if (MR_tabledebug) { \
+ } else { \
+ (t) = MR_RAW_TABLE_ANY_ADDR((t0), (type_info), (value)); \
+ } \
+ if (debug && MR_tabledebug) { \
printf("TABLE %p: any %x type %p => %p\n", \
- prev_table, (value), (type_info), \
- (table)); \
+ (t0), (value), (type_info), (t)); \
} \
} while (0)
-#define MR_DEBUG_NEW_TABLE_TAG(table, table0, value) \
+#define MR_TABLE_TAG(stats, debug, back, t, t0, value) \
do { \
- (table) = MR_RAW_TABLE_TAG((table0), (value)); \
- if (MR_tabledebug) { \
- printf("TABLE %p: tag %d => %p\n", \
- (table0), (value), (table)) \
+ if (stats != NULL) { \
+ (t) = MR_RAW_TABLE_TAG_STATS((stats), (t0), (value)); \
+ } else { \
+ (t) = MR_RAW_TABLE_TAG((t0), (value)); \
} \
- } while (0)
-#define MR_DEBUG_TABLE_TAG(table, value) \
- do { \
- MR_TrieNode prev_table = (table); \
- (table) = MR_RAW_TABLE_TAG((table), (value)); \
- if (MR_tabledebug) { \
+ if (debug && MR_tabledebug) { \
printf("TABLE %p: tag %d => %p\n", \
- prev_table, (value), (table)); \
+ (t0), (value), (t)) \
} \
} while (0)
-#define MR_DEBUG_NEW_TABLE_ENUM(table, table0, count, value) \
+#define MR_TABLE_ENUM(stats, debug, back, t, t0, count, value) \
do { \
- (table) = MR_RAW_TABLE_ENUM((table0), (count), (value));\
- if (MR_tabledebug) { \
- printf("TABLE %p: enum %d of %d => %p\n", \
- (table0), (value), (count), (table)); \
+ if (stats != NULL) { \
+ (t) = MR_RAW_TABLE_ENUM_STATS((stats), (t0), (count), (value)); \
+ } else { \
+ (t) = MR_RAW_TABLE_ENUM((t0), (count), (value)); \
} \
- } while (0)
-#define MR_DEBUG_TABLE_ENUM(table, count, value) \
- do { \
- MR_TrieNode prev_table = (table); \
- (table) = MR_RAW_TABLE_ENUM((table), (count), (value)); \
- if (MR_tabledebug) { \
+ if (debug && MR_tabledebug) { \
printf("TABLE %p: enum %d of %d => %p\n", \
- prev_table, (value), (count), (table)); \
+ (t0), (value), (count), (t)); \
} \
} while (0)
-#define MR_DEBUG_NEW_TABLE_START_INT(table, table0, start, value) \
+#define MR_TABLE_START_INT(stats, debug, back, t, t0, start, value) \
do { \
- (table) = MR_RAW_TABLE_START_INT((table0), (start), (value));\
- if (MR_tabledebug) { \
- printf("TABLE %p: int %d - %d => %p\n", \
- (table0), (value), (start), (table)); \
+ if (stats != NULL) { \
+ (t) = MR_RAW_TABLE_START_INT_STATS((stats), (t0), \
+ (start), (value)); \
+ } else { \
+ (t) = MR_RAW_TABLE_START_INT((t0), (start), (value)); \
} \
- } while (0)
-#define MR_DEBUG_TABLE_START_INT(table, start, value) \
- do { \
- MR_TrieNode prev_table = (table); \
- (table) = MR_RAW_TABLE_START_INT((table), (start), (value));\
- if (MR_tabledebug) { \
+ if (debug && MR_tabledebug) { \
printf("TABLE %p: int %d - %d => %p\n", \
- prev_table, (value), (start), (table)); \
+ (t0), (value), (start), (t)); \
} \
} while (0)
-#define MR_DEBUG_NEW_TABLE_WORD(table, table0, value) \
+#define MR_TABLE_WORD(stats, debug, back, t, t0, value) \
do { \
- (table) = MR_RAW_TABLE_WORD((table0), (value)); \
- if (MR_tabledebug) { \
- printf("TABLE %p: word %d => %p\n", \
- (table0), (value), (table)); \
+ if (stats != NULL) { \
+ (t) = MR_RAW_TABLE_WORD_STATS((stats), (t0), (value)); \
+ } else { \
+ (t) = MR_RAW_TABLE_WORD((t0), (value)); \
} \
- } while (0)
-#define MR_DEBUG_TABLE_WORD(table, value) \
- do { \
- MR_TrieNode prev_table = (table); \
- (table) = MR_RAW_TABLE_WORD((table), (value)); \
- if (MR_tabledebug) { \
+ if (debug && MR_tabledebug) { \
printf("TABLE %p: word %d => %p\n", \
- prev_table, (value), (table)); \
+ (t0), (value), (t)); \
} \
} while (0)
-#define MR_DEBUG_NEW_TABLE_INT(table, table0, value) \
+#define MR_TABLE_INT(stats, debug, back, t, t0, value) \
do { \
- (table) = MR_RAW_TABLE_INT((table0), (value)); \
- if (MR_tabledebug) { \
- printf("TABLE %p: int %d => %p\n", \
- (table0), (value), (table)); \
+ if (stats != NULL) { \
+ (t) = MR_RAW_TABLE_INT_STATS((stats), (t0), (value)); \
+ } else { \
+ (t) = MR_RAW_TABLE_INT((t0), (value)); \
} \
- } while (0)
-#define MR_DEBUG_TABLE_INT(table, value) \
- do { \
- MR_TrieNode prev_table = (table); \
- (table) = MR_RAW_TABLE_INT((table), (value)); \
if (MR_tabledebug) { \
printf("TABLE %p: int %d => %p\n", \
- prev_table, (value), (table)); \
+ (t0), (value), (t)); \
} \
} while (0)
-#define MR_DEBUG_NEW_TABLE_CHAR(table, table0, value) \
+#define MR_TABLE_CHAR(stats, debug, back, t, t0, value) \
do { \
- (table) = MR_RAW_TABLE_CHAR((table0), (value)); \
- if (MR_tabledebug) { \
- printf("TABLE %p: char `%c'/%d => %p\n", \
- (table0), (int) (value), \
- (int) (value), (table)); \
+ if (stats != NULL) { \
+ (t) = MR_RAW_TABLE_CHAR_STATS((stats), (t0), (value)); \
+ } else { \
+ (t) = MR_RAW_TABLE_CHAR((t0), (value)); \
} \
- } while (0)
-#define MR_DEBUG_TABLE_CHAR(table, value) \
- do { \
- MR_TrieNode prev_table = (table); \
- (table) = MR_RAW_TABLE_CHAR((table), (value)); \
- if (MR_tabledebug) { \
+ if (debug && MR_tabledebug) { \
printf("TABLE %p: char `%c'/%d => %p\n", \
- prev_table, (int) (value), \
- (int) (value), (table)); \
+ (t0), (int) (value), (int) (value), (t)); \
} \
} while (0)
-#define MR_DEBUG_NEW_TABLE_FLOAT(table, table0, value) \
+#define MR_TABLE_FLOAT(stats, debug, back, t, t0, value) \
do { \
- (table) = MR_RAW_TABLE_FLOAT((table0), (value)); \
- if (MR_tabledebug) { \
- printf("TABLE %p: float %f => %p\n", \
- (table0), (double) (value), (table)); \
+ if (stats != NULL) { \
+ (t) = MR_RAW_TABLE_FLOAT_STATS((stats), (t0), (value)); \
+ } else { \
+ (t) = MR_RAW_TABLE_FLOAT((t0), (value)); \
} \
- } while (0)
-#define MR_DEBUG_TABLE_FLOAT(table, value) \
- do { \
- MR_TrieNode prev_table = (table); \
- (table) = MR_RAW_TABLE_FLOAT((table), (value)); \
- if (MR_tabledebug) { \
+ if (debug && MR_tabledebug) { \
printf("TABLE %p: float %f => %p\n", \
- prev_table, (double) value, (table)); \
+ (t0), (double) (value), (t)); \
} \
} while (0)
-#define MR_DEBUG_NEW_TABLE_STRING(table, table0, value) \
+#define MR_TABLE_STRING(stats, debug, back, t, t0, value) \
do { \
- (table) = MR_RAW_TABLE_STRING((table0), (value)); \
- if (MR_tabledebug) { \
- printf("TABLE %p: string `%s' => %p\n", \
- (table), (char *) (value), (table)); \
+ if (stats != NULL) { \
+ (t) = MR_RAW_TABLE_STRING_STATS((stats), (t0), (value)); \
+ } else { \
+ (t) = MR_RAW_TABLE_STRING((t0), (value)); \
} \
- } while (0)
-#define MR_DEBUG_TABLE_STRING(table, value) \
- do { \
- MR_TrieNode prev_table = (table); \
- (table) = MR_RAW_TABLE_STRING((table), (value)); \
- if (MR_tabledebug) { \
+ if (debug && MR_tabledebug) { \
printf("TABLE %p: string `%s' => %p\n", \
- prev_table, (char *) (value), (table)); \
+ (t0), (char *) (value), (t)); \
} \
} while (0)
-#define MR_DEBUG_NEW_TABLE_TYPEINFO(table, table0, value) \
+#define MR_TABLE_TYPEINFO(stats, debug, back, t, t0, value) \
do { \
- (table) = MR_RAW_TABLE_TYPEINFO((table0), (value)); \
- if (MR_tabledebug) { \
- printf("TABLE %p: typeinfo %p => %p\n", \
- (table), (value), (table)); \
+ if (stats != NULL) { \
+ (t) = MR_RAW_TABLE_TYPEINFO_STATS((stats), (t0), (value)); \
+ } else { \
+ (t) = MR_RAW_TABLE_TYPEINFO((t0), (value)); \
} \
- } while (0)
-#define MR_DEBUG_TABLE_TYPEINFO(table, value) \
- do { \
- MR_TrieNode prev_table = (table); \
- (table) = MR_RAW_TABLE_TYPEINFO((table), (value)); \
- if (MR_tabledebug) { \
+ if (debug && MR_tabledebug) { \
printf("TABLE %p: typeinfo %p => %p\n", \
- prev_table, (value), (table)); \
+ (t0), (value), (t)); \
} \
} while (0)
-#define MR_DEBUG_NEW_TABLE_TYPECLASSINFO(table, table0, value) \
+#define MR_TABLE_TYPECLASSINFO(stats, debug, back, t, t0, value) \
do { \
- (table) = MR_RAW_TABLE_TYPECLASSINFO((table0), (value));\
- if (MR_tabledebug) { \
- printf("TABLE %p: typeclassinfo %p => %p\n", \
- (table), (value), (table)); \
+ if (stats != NULL) { \
+ (t) = MR_RAW_TABLE_TYPECLASSINFO_STATS((stats), (t0), (value)); \
+ } else { \
+ (t) = MR_RAW_TABLE_TYPECLASSINFO((t0), (value)); \
} \
- } while (0)
-#define MR_DEBUG_TABLE_TYPECLASSINFO(table, value) \
- do { \
- MR_TrieNode prev_table = (table); \
- (table) = MR_RAW_TABLE_TYPECLASSINFO((table), (value)); \
- if (MR_tabledebug) { \
+ if (debug && MR_tabledebug) { \
printf("TABLE %p: typeclassinfo %p => %p\n", \
- prev_table, (value), (table)); \
+ (t0), (value), (t)); \
} \
} while (0)
-#else /* not MR_TABLE_DEBUG */
-
-#define MR_DEBUG_NEW_TABLE_ANY(table, table0, type_info, value) \
- do { \
- (table) = MR_RAW_TABLE_ANY((table0), (type_info), (value));\
- } while (0)
-#define MR_DEBUG_TABLE_ANY(table, type_info, value) \
- do { \
- (table) = MR_RAW_TABLE_ANY((table), (type_info), (value));\
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_ANY_FAST_LOOSE(table, table0, type_info, value) \
- do { \
- (table) = MR_RAW_TABLE_ANY_FAST_LOOSE((table0), (type_info), \
- (value)); \
- } while (0)
-#define MR_DEBUG_TABLE_ANY_FAST_LOOSE(table, type_info, value) \
- do { \
- (table) = MR_RAW_TABLE_ANY_FAST_LOOSE((table), (type_info), \
- (value)); \
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_TAG(table, table0, value) \
- do { \
- (table) = MR_RAW_TABLE_TAG((table0), (value)); \
- } while (0)
-#define MR_DEBUG_TABLE_TAG(table, value) \
- do { \
- (table) = MR_RAW_TABLE_TAG((table), (value)); \
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_ENUM(table, table0, count, value) \
- do { \
- (table) = MR_RAW_TABLE_ENUM((table0), (count), (value));\
- } while (0)
-#define MR_DEBUG_TABLE_ENUM(table, count, value) \
- do { \
- (table) = MR_RAW_TABLE_ENUM((table), (count), (value)); \
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_START_INT(table, table0, start, value) \
- do { \
- (table) = MR_RAW_TABLE_START_INT((table0), (start), (value));\
- } while (0)
-#define MR_DEBUG_TABLE_START_INT(table, start, value) \
- do { \
- (table) = MR_RAW_TABLE_START_INT((table), (start), (value));\
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_WORD(table, table0, value) \
- do { \
- (table) = MR_RAW_TABLE_WORD((table0), (value)); \
- } while (0)
-#define MR_DEBUG_TABLE_WORD(table, value) \
- do { \
- (table) = MR_RAW_TABLE_WORD((table), (value));\
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_INT(table, table0, value) \
- do { \
- (table) = MR_RAW_TABLE_INT((table0), (value)); \
- } while (0)
-#define MR_DEBUG_TABLE_INT(table, value) \
- do { \
- (table) = MR_RAW_TABLE_INT((table), (value)); \
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_CHAR(table, table0, value) \
- do { \
- (table) = MR_RAW_TABLE_CHAR((table0), (value)); \
- } while (0)
-#define MR_DEBUG_TABLE_CHAR(table, value) \
- do { \
- (table) = MR_RAW_TABLE_CHAR((table), (value)); \
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_FLOAT(table, table0, value) \
- do { \
- (table) = MR_RAW_TABLE_FLOAT((table0), (value)); \
- } while (0)
-#define MR_DEBUG_TABLE_FLOAT(table, value) \
- do { \
- (table) = MR_RAW_TABLE_FLOAT((table), (value)); \
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_STRING(table, table0, value) \
- do { \
- (table) = MR_RAW_TABLE_STRING((table0), (value)); \
- } while (0)
-#define MR_DEBUG_TABLE_STRING(table, value) \
- do { \
- (table) = MR_RAW_TABLE_STRING((table), (value)); \
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_TYPEINFO(table, table0, value) \
- do { \
- (table) = MR_RAW_TABLE_TYPEINFO((table0), (value)); \
- } while (0)
-#define MR_DEBUG_TABLE_TYPEINFO(table, value) \
- do { \
- (table) = MR_RAW_TABLE_TYPEINFO((table), (value)); \
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_TYPECLASSINFO(table, table0, value) \
- do { \
- (table) = MR_RAW_TABLE_TYPECLASSINFO((table0), (value));\
- } while (0)
-#define MR_DEBUG_TABLE_TYPECLASSINFO(table, value) \
- do { \
- (table) = MR_RAW_TABLE_TYPECLASSINFO((table), (value)); \
- } while (0)
-
-#endif /* MR_TABLE_DEBUG */
-
/***********************************************************************/
-#ifdef MR_TABLE_DEBUG
-
-#define MR_TABLE_CREATE_ANSWER_BLOCK(table, num_slots) \
+#define MR_TABLE_CREATE_ANSWER_BLOCK(debug, table, num_slots) \
do { \
- (table)->MR_answerblock = MR_TABLE_NEW_ARRAY(MR_Word, \
- (num_slots)); \
- if (MR_tabledebug) \
- printf("allocated answer block %p -> %p, %d words\n",\
- (table), (table)->MR_answerblock, \
- (int) (num_slots)); \
+ (table)->MR_answerblock = MR_TABLE_NEW_ARRAY(MR_Word, (num_slots)); \
+ if (debug && MR_tabledebug) { \
+ printf("allocated answer block %p -> %p, %d words\n", \
+ (table), (table)->MR_answerblock, (int) (num_slots)); \
+ } \
} while(0)
-#define MR_TABLE_CREATE_NODE_ANSWER_BLOCK(block_ptr, num_slots) \
+#define MR_TABLE_CREATE_NODE_ANSWER_BLOCK(debug, block_ptr, num_slots) \
do { \
*block_ptr = MR_TABLE_NEW_ARRAY(MR_Word, (num_slots)); \
- if (MR_tabledebug) \
- printf("allocated node block %p -> %p, %d words\n",\
- block_ptr, *block_ptr, \
- (int) (num_slots)); \
+ if (debug && MR_tabledebug) { \
+ printf("allocated node block %p -> %p, %d words\n", \
+ block_ptr, *block_ptr, (int) (num_slots)); \
+ } \
} while(0)
-#define MR_TABLE_GET_ANSWER(ab, offset) \
- (( MR_tabledebug ? \
- printf("using answer block: %p, slot %d\n", \
- (ab), (int) (offset)) \
+#define MR_TABLE_GET_ANSWER(debug, ab, offset) \
+ (( (debug && MR_tabledebug) ? \
+ printf("using answer block: %p, slot %d\n", (ab), (int) (offset)) \
: \
(void) 0 /* do nothing */ \
), \
(ab)[(offset)])
-#define MR_TABLE_SAVE_ANSWER(ab, offset, value, type_info) \
+#define MR_TABLE_SAVE_ANSWER(debug, ab, offset, value, type_info) \
do { \
- if (MR_tabledebug) \
- printf("saving to answer block: %p, " \
- "slot %d = %lx\n", \
+ if (debug && MR_tabledebug) { \
+ printf("saving to answer block: %p, slot %d = %lx\n", \
(ab), (int) (offset), (long) (value)); \
- (ab)[offset] = MR_make_permanent((value), \
- (MR_TypeInfo) (type_info)); \
- } while(0)
-
-#else
-
-#define MR_TABLE_CREATE_ANSWER_BLOCK(table, num_slots) \
- do { \
- (table)->MR_answerblock = MR_TABLE_NEW_ARRAY(MR_Word, \
- (num_slots)); \
- } while(0)
-
-#define MR_TABLE_CREATE_NODE_ANSWER_BLOCK(block_ptr, num_slots) \
- do { \
- *block_ptr = MR_TABLE_NEW_ARRAY(MR_Word, (num_slots)); \
- } while(0)
-
-#define MR_TABLE_GET_ANSWER(ab, offset) \
- (ab)[(offset)]
-
-#define MR_TABLE_SAVE_ANSWER(ab, offset, value, type_info) \
- do { \
- (ab)[offset] = MR_make_permanent((value), \
- (MR_TypeInfo) (type_info)); \
+ } \
+ (ab)[offset] = \
+ MR_make_permanent((value), (MR_TypeInfo) (type_info)); \
} while(0)
-
-#endif
Index: runtime/mercury_tabling_preds.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_tabling_preds.h,v
retrieving revision 1.8
diff -u -b -r1.8 mercury_tabling_preds.h
--- runtime/mercury_tabling_preds.h 10 Jun 2005 09:01:25 -0000 1.8
+++ runtime/mercury_tabling_preds.h 6 Jun 2006 06:17:45 -0000
@@ -19,155 +19,271 @@
#define MR_table_unbox_float(W) MR_word_to_float(W)
#endif
+#ifndef MR_ALLOW_RESET
+#define MR_table_lookup_insert_int(a, b, c) \
+ MR_tbl_lookup_insert_int(NULL, MR_FALSE, MR_FALSE, a, b, c)
+#define MR_table_lookup_insert_start_int(a, b, c, d) \
+ MR_tbl_lookup_insert_start_int(NULL, MR_FALSE, MR_FALSE, a, b, c, d)
+#define MR_table_lookup_insert_char(a, b, c) \
+ MR_tbl_lookup_insert_char(NULL, MR_FALSE, MR_FALSE, a, b, c)
+#define MR_table_lookup_insert_string(a, b, c) \
+ MR_tbl_lookup_insert_string(NULL, MR_FALSE, MR_FALSE, a, b, c)
+#define MR_table_lookup_insert_float(a, b, c) \
+ MR_tbl_lookup_insert_float(NULL, MR_FALSE, MR_FALSE, a, b, c)
+#define MR_table_lookup_insert_enum(a, b, c, d) \
+ MR_tbl_lookup_insert_enum(NULL, MR_FALSE, MR_FALSE, a, b, c, d)
+#define MR_table_lookup_insert_user(a, b, c, d) \
+ MR_tbl_lookup_insert_user(NULL, MR_FALSE, MR_FALSE, a, b, c, d)
+#define MR_table_lookup_insert_user_addr(a, b, c, d) \
+ MR_tbl_lookup_insert_user_addr(NULL, MR_FALSE, MR_FALSE, a, b, c, d)
+#define MR_table_lookup_insert_poly(a, b, c, d) \
+ MR_tbl_lookup_insert_poly_addr(NULL, MR_FALSE, MR_FALSE, a, b, c, d)
+#define MR_table_lookup_insert_poly_addr(a, b, c, d) \
+ MR_tbl_lookup_insert_poly(NULL, MR_FALSE, MR_FALSE, a, b, c, d)
+#define MR_table_lookup_insert_typeinfo(a, b, c) \
+ MR_tbl_lookup_insert_typeinfo(NULL, MR_FALSE, MR_FALSE, a, b, c)
+#define MR_table_lookup_insert_typeclassinfo(a, b, c) \
+ MR_tbl_lookup_insert_typeclassinfo(NULL, MR_FALSE, MR_FALSE, a, b, c)
+
+#define MR_table_save_int_answer(a, b, c) \
+ MR_tbl_save_any_answer(MR_FALSE, a, b, c)
+#define MR_table_save_char_answer(a, b, c) \
+ MR_tbl_save_char_answer(MR_FALSE, a, b, c)
+#define MR_table_save_string_answer(a, b, c) \
+ MR_tbl_save_string_answer(MR_FALSE, a, b, c)
+#define MR_table_save_float_answer(a, b, c) \
+ MR_tbl_save_float_answer(MR_FALSE, a, b, c)
+#define MR_table_save_io_state_answer(a, b, c) \
+ MR_tbl_save_io_state_answer(MR_FALSE, a, b, c)
+#define MR_table_save_any_answer(a, b, c, d) \
+ MR_tbl_save_any_answer(MR_FALSE, a, b, c, d)
+
+#define MR_table_restore_int_answer(a, b, c) \
+ MR_tbl_restore_any_answer(MR_FALSE, a, b, c)
+#define MR_table_restore_char_answer(a, b, c) \
+ MR_tbl_restore_char_answer(MR_FALSE, a, b, c)
+#define MR_table_restore_string_answer(a, b, c) \
+ MR_tbl_restore_string_answer(MR_FALSE, a, b, c)
+#define MR_table_restore_float_answer(a, b, c) \
+ MR_tbl_restore_float_answer(MR_FALSE, a, b, c)
+#define MR_table_restore_io_state_answer(a, b, c) \
+ MR_tbl_restore_io_state_answer(MR_FALSE, a, b, c)
+#define MR_table_restore_any_answer(a, b, c) \
+ MR_tbl_restore_any_answer(MR_FALSE, a, b, c)
+
+#define MR_table_loop_setup(a, b) \
+ MR_tbl_loop_setup(MR_FALSE, MR_FALSE, a, b)
+#define MR_table_loop_setup_shortcut(a, b, c) \
+ MR_tbl_loop_setup_shortcut(a, b, c)
+#define MR_table_loop_mark_as_inactive(a) \
+ MR_tbl_loop_mark_as_inactive(MR_FALSE, a)
+#define MR_table_loop_mark_as_inactive_and_fail(a) \
+ MR_tbl_loop_mark_as_inactive_and_fail(MR_FALSE, a)
+#define MR_table_loop_mark_as_active_and_fail(a) \
+ MR_tbl_loop_mark_as_active_and_fail(MR_FALSE, a)
+
+#define MR_table_memo_det_setup(a, b) \
+ MR_tbl_memo_det_setup(MR_FALSE, MR_FALSE, a, b)
+#define MR_table_memo_semi_setup(a, b) \
+ MR_tbl_memo_semi_setup(MR_FALSE, MR_FALSE, a, b)
+#define MR_table_memo_non_setup(a, b, c) \
+ MR_tbl_memo_non_setup(MR_FALSE, MR_FALSE, a, b, c)
+#define MR_table_memo_det_setup_shortcut(a, b, c) \
+ MR_tbl_memo_det_setup_shortcut(a, b, c)
+#define MR_table_memo_semi_setup_shortcut(a, b, c) \
+ MR_tbl_memo_semi_setup_shortcut(a, b, c)
+#define MR_table_memo_non_setup_shortcut(a, b, c, d) \
+ MR_tbl_memo_non_setup_shortcut(a, b, c, d)
+
+#define MR_table_memo_mark_as_succeeded(a) \
+ MR_tbl_memo_mark_as_succeeded(MR_FALSE, a)
+#define MR_table_memo_mark_as_failed(a) \
+ MR_tbl_memo_mark_as_failed(MR_FALSE, a)
+#define MR_table_memo_mark_as_incomplete(a) \
+ MR_tbl_memo_mark_as_incomplete(MR_FALSE, a)
+#define MR_table_memo_mark_as_active_and_fail(a) \
+ MR_tbl_memo_mark_as_active_and_fail(MR_FALSE, a)
+#define MR_table_memo_mark_as_complete_and_fail(a) \
+ MR_tbl_memo_mark_as_complete_and_fail(MR_FALSE, a)
+
+#define MR_table_memo_create_answer_block(a, b, c) \
+ MR_tbl_memo_create_answer_block(MR_FALSE, a, b, c)
+#define MR_table_memo_fill_answer_block_shortcut(a) \
+ MR_tbl_memo_fill_answer_block_shortcut(a)
+
+#define MR_table_memo_get_answer_block(a, b) \
+ MR_tbl_memo_get_answer_block(MR_FALSE, a, b)
+#define MR_table_memo_get_answer_block_shortcut(a) \
+ MR_tbl_memo_get_answer_block_shortcut(a)
+
+#define MR_table_memo_non_get_answer_table(a, b) \
+ MR_tbl_memo_non_get_answer_table(MR_FALSE, a, b)
+
+#define MR_table_memo_non_create_answer_block(a, b, c) \
+ MR_tbl_memo_non_create_answer_block(MR_FALSE, a, b, c)
+#define MR_table_memo_non_create_answer_block_shortcut(a) \
+ MR_tbl_memo_non_create_answer_block_shortcut(a)
+
+#define MR_table_memo_non_return_all_shortcut(a) \
+ MR_tbl_memo_non_return_all_shortcut(a)
+
+#define MR_table_memo_non_answer_is_not_duplicate(a, b) \
+ MR_tbl_memo_non_answer_is_not_duplicate(MR_FALSE, a, b)
+#define MR_table_memo_non_answer_is_not_duplicate_shortcut(a, b) \
+ MR_tbl_memo_non_answer_is_not_duplicate_shortcut(a, b)
+
+#define MR_table_io_in_range(a, b, c, d) \
+ MR_tbl_io_in_range(MR_FALSE, a, b, c, d)
+#define MR_table_io_has_occurred(a, b) \
+ MR_tbl_io_has_occurred(MR_FALSE, a, b)
+#define MR_table_io_left_bracket_unitized_goal(a) \
+ MR_tbl_io_left_bracket_unitized_goal(a)
+#define MR_table_io_right_bracket_unitized_goal(a) \
+ MR_tbl_io_right_bracket_unitized_goal(a)
+
+#endif
+
/***********************************************************************/
-#define MR_table_lookup_insert_int(T0, V, T) \
+#define MR_tbl_lookup_insert_int(stats, debug, back, T0, V, T) \
do { \
- MR_DEBUG_NEW_TABLE_INT(T, T0, (MR_Integer) V); \
+ MR_TABLE_INT(stats, debug, back, T, T0, (MR_Integer) V); \
} while(0)
-#define MR_table_lookup_insert_start_int(T0, S, V, T) \
+#define MR_tbl_lookup_insert_start_int(stats, debug, back, T0, S, V, T) \
do { \
- MR_DEBUG_NEW_TABLE_START_INT(T, T0, (MR_Integer) S, (MR_Integer) V); \
+ MR_TABLE_START_INT(stats, debug, back, T, T0, \
+ (MR_Integer) S, (MR_Integer) V); \
} while(0)
-#define MR_table_lookup_insert_char(T0, V, T) \
+#define MR_tbl_lookup_insert_char(stats, debug, back, T0, V, T) \
do { \
- MR_DEBUG_NEW_TABLE_CHAR(T, T0, (MR_Integer) V); \
+ MR_TABLE_CHAR(stats, debug, back, T, T0, (MR_Integer) V); \
} while(0)
-#define MR_table_lookup_insert_string(T0, V, T) \
+#define MR_tbl_lookup_insert_string(stats, debug, back, T0, V, T) \
do { \
- MR_DEBUG_NEW_TABLE_STRING(T, T0, (MR_String) V); \
+ MR_TABLE_STRING(stats, debug, back, T, T0, (MR_String) V); \
} while(0)
-#define MR_table_lookup_insert_float(T0, V, T) \
+#define MR_tbl_lookup_insert_float(stats, debug, back, T0, V, T) \
do { \
- MR_DEBUG_NEW_TABLE_FLOAT(T, T0, V); \
+ MR_TABLE_FLOAT(stats, debug, back, T, T0, V); \
} while(0)
-#define MR_table_lookup_insert_enum(T0, R, V, T) \
+#define MR_tbl_lookup_insert_enum(stats, debug, back, T0, R, V, T) \
do { \
- MR_DEBUG_NEW_TABLE_ENUM(T, T0, R, V); \
+ MR_TABLE_ENUM(stats, debug, back, T, T0, R, V); \
} while(0)
-#define MR_table_lookup_insert_user(T0, TI, V, T) \
+#define MR_tbl_lookup_insert_user(stats, debug, back, T0, TI, V, T) \
do { \
- MR_DEBUG_NEW_TABLE_ANY(T, T0, (MR_TypeInfo) TI, V); \
+ MR_TABLE_ANY(stats, debug, back, T, T0, (MR_TypeInfo) TI, V); \
} while(0)
-#define MR_table_lookup_insert_user_fast_loose(T0, TI, V, T) \
+#define MR_tbl_lookup_insert_user_addr(stats, debug, back, T0, TI, V, T) \
do { \
- MR_DEBUG_NEW_TABLE_ANY_FAST_LOOSE(T, T0, (MR_TypeInfo) TI, V); \
+ MR_TABLE_ANY_ADDR(stats, debug, back, T, T0, (MR_TypeInfo) TI, V); \
} while(0)
-#define MR_table_lookup_insert_poly(T0, TI, V, T) \
+#define MR_tbl_lookup_insert_poly(stats, debug, back, T0, TI, V, T) \
do { \
- MR_DEBUG_NEW_TABLE_ANY(T, T0, (MR_TypeInfo) TI, V); \
+ MR_TABLE_ANY(stats, debug, back, T, T0, (MR_TypeInfo) TI, V); \
} while(0)
-#define MR_table_lookup_insert_poly_fast_loose(T0, TI, V, T) \
+#define MR_tbl_lookup_insert_poly_addr(stats, debug, back, T0, TI, V, T) \
do { \
- MR_DEBUG_NEW_TABLE_ANY_FAST_LOOSE(T, T0, (MR_TypeInfo) TI, V); \
+ MR_TABLE_ANY_ADDR(stats, debug, back, T, T0, (MR_TypeInfo) TI, V); \
} while(0)
-#define MR_table_lookup_insert_typeinfo(T0, TI, T) \
+#define MR_tbl_lookup_insert_typeinfo(stats, debug, back, T0, TI, T) \
do { \
- MR_DEBUG_NEW_TABLE_TYPEINFO(T, T0, (MR_TypeInfo) TI); \
+ MR_TABLE_TYPEINFO(stats, debug, back, T, T0, (MR_TypeInfo) TI); \
} while(0)
-#define MR_table_lookup_insert_typeclassinfo(T0, TCI, T) \
+#define MR_tbl_lookup_insert_typeclassinfo(stats, debug, back, T0, TCI, T) \
do { \
- MR_DEBUG_NEW_TABLE_TYPECLASSINFO(T, T0, (MR_Word *) TCI); \
+ MR_TABLE_TYPECLASSINFO(stats, debug, back, T, T0, (MR_Word *) TCI); \
} while(0)
/***********************************************************************/
-#define MR_table_save_int_answer(AB, Offset, V) \
+#define MR_tbl_save_int_answer(debug, AB, Offset, V) \
do { \
- MR_TABLE_SAVE_ANSWER(AB, Offset, V, \
+ MR_TABLE_SAVE_ANSWER(debug, AB, Offset, V, \
&MR_TYPE_CTOR_INFO_NAME(builtin, int, 0)); \
} while(0)
-#define MR_table_save_char_answer(AB, Offset, V) \
+#define MR_tbl_save_char_answer(debug, AB, Offset, V) \
do { \
- MR_TABLE_SAVE_ANSWER(AB, Offset, V, \
+ MR_TABLE_SAVE_ANSWER(debug, AB, Offset, V, \
&MR_TYPE_CTOR_INFO_NAME(builtin, character, 0)); \
} while(0)
-#define MR_table_save_string_answer(AB, Offset, V) \
+#define MR_tbl_save_string_answer(debug, AB, Offset, V) \
do { \
- MR_TABLE_SAVE_ANSWER(AB, Offset, (MR_Word) V, \
+ MR_TABLE_SAVE_ANSWER(debug, AB, Offset, (MR_Word) V, \
&MR_TYPE_CTOR_INFO_NAME(builtin, string, 0)); \
} while(0)
-#define MR_table_save_float_answer(AB, Offset, V) \
+#define MR_tbl_save_float_answer(debug, AB, Offset, V) \
do { \
- MR_TABLE_SAVE_ANSWER(AB, Offset, MR_table_box_float(V), \
+ MR_TABLE_SAVE_ANSWER(debug, AB, Offset, MR_table_box_float(V), \
&MR_TYPE_CTOR_INFO_NAME(builtin, float, 0)); \
} while(0)
-#define MR_table_save_io_state_answer(AB, Offset, V) \
+#define MR_tbl_save_io_state_answer(debug, AB, Offset, V) \
do { \
- MR_TABLE_SAVE_ANSWER(AB, Offset, (MR_Word) V, \
+ MR_TABLE_SAVE_ANSWER(debug, AB, Offset, (MR_Word) V, \
&MR_TYPE_CTOR_INFO_NAME(io, state, 0)); \
} while(0)
-#define MR_table_save_any_answer(AB, Offset, TI, V) \
+#define MR_tbl_save_any_answer(debug, AB, Offset, TI, V) \
do { \
- MR_TABLE_SAVE_ANSWER(AB, Offset, (MR_Word) V, (MR_TypeInfo) TI);\
+ MR_TABLE_SAVE_ANSWER(debug, AB, Offset, (MR_Word) V, (MR_TypeInfo) TI);\
} while(0)
/***********************************************************************/
-#define MR_table_restore_int_answer(AB, Offset, V) \
+#define MR_tbl_restore_int_answer(debug, AB, Offset, V) \
do { \
- V = (MR_Integer) MR_TABLE_GET_ANSWER(AB, Offset); \
+ V = (MR_Integer) MR_TABLE_GET_ANSWER(debug, AB, Offset); \
} while(0)
-#define MR_table_restore_char_answer(AB, Offset, V) \
+#define MR_tbl_restore_char_answer(debug, AB, Offset, V) \
do { \
- V = (MR_Char) MR_TABLE_GET_ANSWER(AB, Offset); \
+ V = (MR_Char) MR_TABLE_GET_ANSWER(debug, AB, Offset); \
} while(0)
-#define MR_table_restore_string_answer(AB, Offset, V) \
+#define MR_tbl_restore_string_answer(debug, AB, Offset, V) \
do { \
- V = (MR_String) MR_TABLE_GET_ANSWER(AB, Offset); \
+ V = (MR_String) MR_TABLE_GET_ANSWER(debug, AB, Offset); \
} while(0)
-#define MR_table_restore_float_answer(AB, Offset, V) \
+#define MR_tbl_restore_float_answer(debug, AB, Offset, V) \
do { \
- V = MR_table_unbox_float(MR_TABLE_GET_ANSWER(AB, Offset)); \
+ V = MR_table_unbox_float(MR_TABLE_GET_ANSWER(debug, AB, Offset)); \
} while(0)
-#define MR_table_restore_io_state_answer(AB, Offset, V) \
+#define MR_tbl_restore_io_state_answer(debug, AB, Offset, V) \
do { \
- V = (MR_Word) MR_TABLE_GET_ANSWER(AB, Offset); \
+ V = (MR_Word) MR_TABLE_GET_ANSWER(debug, AB, Offset); \
} while(0)
-#define MR_table_restore_any_answer(AB, Offset, V) \
+#define MR_tbl_restore_any_answer(debug, AB, Offset, V) \
do { \
- V = (MR_Word) MR_TABLE_GET_ANSWER(AB, Offset); \
+ V = (MR_Word) MR_TABLE_GET_ANSWER(debug, AB, Offset); \
} while(0)
/***********************************************************************/
-#ifdef MR_TABLE_DEBUG
- #define MR_table_loop_setup_msg(T) \
+#define MR_tbl_loop_setup(debug, back, T, Status) \
do { \
- if (MR_tabledebug) { \
+ if (debug && MR_tabledebug) { \
printf("status of loop table %p: %ld (%lx)\n", \
T, (long) T->MR_loop_status, \
(long) T->MR_loop_status); \
} \
- } while(0)
-#else
- #define MR_table_loop_setup_msg(T) ((void) 0)
-#endif
-
-#define MR_table_loop_setup(T, Status) \
- do { \
- MR_table_loop_setup_msg(T); \
Status = T->MR_loop_status; \
if (Status == MR_LOOP_INACTIVE) { \
T->MR_loop_status = MR_LOOP_ACTIVE; \
@@ -175,80 +291,46 @@
Status = MR_CONVERT_C_ENUM_CONSTANT(Status); \
} while (0)
-#define MR_table_loop_setup_shortcut(T0, T, Status) ((void) 0)
+#define MR_tbl_loop_setup_shortcut(T0, T, Status) ((void) 0)
/***********************************************************************/
-#ifdef MR_TABLE_DEBUG
- #define MR_table_loop_mark_as_inactive_msg(T) \
+#define MR_tbl_loop_mark_as_inactive(debug, T) \
do { \
- if (MR_tabledebug) { \
+ if (debug && MR_tabledebug) { \
printf("marking %p as inactive\n", T); \
} \
- } while (0)
- #define MR_table_loop_mark_as_active_msg(T) \
- do { \
- if (MR_tabledebug) { \
- printf("marking %p as active\n", T); \
- } \
- } while (0)
-#else
- #define MR_table_loop_mark_as_inactive_msg(T) ((void) 0)
- #define MR_table_loop_mark_as_active_msg(T) ((void) 0)
-#endif
-
-#define MR_table_loop_mark_as_inactive(T) \
- do { \
- MR_table_loop_mark_as_inactive_msg(T); \
+ \
T->MR_loop_status = MR_LOOP_INACTIVE; \
} while (0)
-#define MR_table_loop_mark_as_inactive_and_fail(T) \
+#define MR_tbl_loop_mark_as_inactive_and_fail(debug, T) \
do { \
- MR_table_loop_mark_as_inactive_msg(T); \
+ if (debug && MR_tabledebug) { \
+ printf("marking %p as inactive\n", T); \
+ } \
+ \
T->MR_loop_status = MR_LOOP_INACTIVE; \
} while (0)
-#define MR_table_loop_mark_as_active_and_fail(T) \
+#define MR_tbl_loop_mark_as_active_and_fail(debug, T) \
do { \
- MR_table_loop_mark_as_active_msg(T); \
+ if (debug && MR_tabledebug) { \
+ printf("marking %p as active\n", T); \
+ } \
+ \
T->MR_loop_status = MR_LOOP_ACTIVE; \
} while (0)
/***********************************************************************/
-#ifdef MR_TABLE_DEBUG
- #define MR_table_memo_setup_msg(T) \
+#define MR_tbl_memo_setup(debug, back, T, Status) \
do { \
- if (MR_tabledebug) { \
+ if (debug && MR_tabledebug) { \
printf("status of memo table %p: %ld (%lx)\n", \
- T, (long) T->MR_memo_status, \
- (long) T->MR_memo_status); \
+ T, (long) T->MR_memo_status, (long) T->MR_memo_status); \
} \
- } while(0)
- #define MR_table_memo_non_setup_msg(T) \
- do { \
- if (MR_tabledebug) { \
- printf("setting up of memo non table for %p\n", T); \
- } \
- } while(0)
- #define MR_table_memo_non_status_msg(R) \
- do { \
- if (MR_tabledebug) { \
- printf("status of memo non table %p -> %p: %s\n", \
- R->MR_mn_back_ptr, R, \
- MR_memo_non_status(R->MR_mn_status)); \
- } \
- } while(0)
-#else
- #define MR_table_memo_setup_msg(T) ((void) 0)
- #define MR_table_memo_non_setup_msg(T) ((void) 0)
- #define MR_table_memo_non_status_msg(R) ((void) 0)
-#endif
-
-#define MR_table_memo_setup(T, Status) \
- do { \
- MR_table_memo_setup_msg(T); \
+ \
if (T->MR_integer >= MR_MEMO_BLOCK) { \
Status = MR_MEMO_SUCCEEDED; \
} else { \
@@ -260,17 +342,20 @@
Status = MR_CONVERT_C_ENUM_CONSTANT(Status); \
} while (0)
-#define MR_table_memo_det_setup(T, Status) \
- MR_table_memo_setup(T, Status)
+#define MR_tbl_memo_det_setup(debug, back, T, Status) \
+ MR_tbl_memo_setup(debug, back, T, Status)
-#define MR_table_memo_semi_setup(T, Status) \
- MR_table_memo_setup(T, Status)
+#define MR_tbl_memo_semi_setup(debug, back, T, Status) \
+ MR_tbl_memo_setup(debug, back, T, Status)
-#define MR_table_memo_non_setup(T, Record, Status) \
+#define MR_tbl_memo_non_setup(debug, back, T, Record, Status) \
do { \
MR_save_transient_registers(); \
if (T->MR_memo_non_record == NULL) { \
- MR_table_memo_non_setup_msg(T); \
+ if (debug && MR_tabledebug) { \
+ printf("setting up of memo non table for %p\n", T); \
+ } \
+ \
Status = MR_MEMO_NON_INACTIVE; \
Record = MR_TABLE_NEW(MR_MemoNonRecord); \
Record->MR_mn_back_ptr = T; \
@@ -278,187 +363,128 @@
Record->MR_mn_num_answers = 0; \
Record->MR_mn_answer_table.MR_integer = 0; \
Record->MR_mn_answer_list = NULL; \
- Record->MR_mn_answer_list_tail = &Record->MR_mn_answer_list;\
+ Record->MR_mn_answer_list_tail = &Record->MR_mn_answer_list; \
T->MR_memo_non_record = Record; \
} else { \
Record = T->MR_memo_non_record; \
Status = Record->MR_mn_status; \
} \
- MR_table_memo_non_status_msg(Record); \
+ \
+ if (debug && MR_tabledebug) { \
+ printf("status of memo non table %p -> %p: %s\n", \
+ Record->MR_mn_back_ptr, Record, \
+ MR_memo_non_status(Record->MR_mn_status)); \
+ } \
+ \
MR_restore_transient_registers(); \
Status = MR_CONVERT_C_ENUM_CONSTANT(Status); \
} while(0)
-#define MR_table_memo_det_setup_shortcut(T0, T, Status) ((void) 0)
+#define MR_tbl_memo_det_setup_shortcut(T0, T, Status) ((void) 0)
-#define MR_table_memo_semi_setup_shortcut(T0, T, Status) ((void) 0)
+#define MR_tbl_memo_semi_setup_shortcut(T0, T, Status) ((void) 0)
-#define MR_table_memo_non_setup_shortcut(T0, T, R, Status) ((void) 0)
+#define MR_tbl_memo_non_setup_shortcut(T0, T, R, Status) ((void) 0)
/***********************************************************************/
-#ifdef MR_TABLE_DEBUG
- #define MR_table_memo_mark_as_succeeded_msg(T) \
+#define MR_tbl_memo_mark_as_succeeded(debug, T) \
do { \
- if (MR_tabledebug) { \
+ if (debug && MR_tabledebug) { \
printf("marking %p as succeeded\n", T); \
} \
- } while(0)
-#else
- #define MR_table_memo_mark_as_succeeded_msg(T) ((void) 0)
-#endif
-
-#define MR_table_memo_mark_as_succeeded(T) \
- do { \
- MR_table_memo_mark_as_succeeded_msg(T); \
+ \
T->MR_memo_status = MR_MEMO_SUCCEEDED; \
} while(0)
/***********************************************************************/
-#ifdef MR_TABLE_DEBUG
- #define MR_table_memo_mark_as_failed_msg(T) \
+#define MR_tbl_memo_mark_as_failed(debug, T) \
do { \
- if (MR_tabledebug) { \
+ if (debug && MR_tabledebug) { \
printf("marking %p as failed\n", T); \
} \
- } while(0)
-#else
- #define MR_table_memo_mark_as_failed_msg(T) ((void) 0)
-#endif
-
-#define MR_table_memo_mark_as_failed(T) \
- do { \
- MR_table_memo_mark_as_failed_msg(T); \
T->MR_memo_status = MR_MEMO_FAILED; \
} while(0)
/***********************************************************************/
-#ifdef MR_TABLE_DEBUG
- #define MR_table_memo_mark_as_complete_msg(R) \
+#define MR_tbl_memo_mark_as_incomplete(debug, R) \
do { \
- if (MR_tabledebug) { \
- printf("marking %p as complete\n", R); \
- } \
- } while (0)
- #define MR_table_memo_mark_as_incomplete_msg(R) \
- do { \
- if (MR_tabledebug) { \
+ if (debug && MR_tabledebug) { \
printf("marking %p as incomplete\n", R); \
} \
- } while (0)
- #define MR_table_memo_mark_as_active_msg(R) \
- do { \
- if (MR_tabledebug) { \
- printf("marking %p as active\n", R); \
- } \
- } while (0)
-#else
- #define MR_table_memo_mark_as_complete_msg(R) ((void) 0)
- #define MR_table_memo_mark_as_incomplete_msg(R) ((void) 0)
- #define MR_table_memo_mark_as_active_msg(R) ((void) 0)
-#endif
-
-#define MR_table_memo_mark_as_incomplete(R) \
- do { \
- MR_table_memo_mark_as_incomplete_msg(R); \
+ \
R->MR_mn_status = MR_MEMO_NON_INCOMPLETE; \
} while (0)
-#define MR_table_memo_mark_as_active_and_fail(R) \
+#define MR_tbl_memo_mark_as_active_and_fail(debug, R) \
do { \
- MR_table_memo_mark_as_active_msg(R); \
+ if (debug && MR_tabledebug) { \
+ printf("marking %p as active\n", R); \
+ } \
+ \
R->MR_mn_status = MR_MEMO_NON_ACTIVE; \
} while (0)
-#define MR_table_memo_mark_as_complete_and_fail(R) \
+#define MR_tbl_memo_mark_as_complete_and_fail(debug, R) \
do { \
- MR_table_memo_mark_as_complete_msg(R); \
+ if (debug && MR_tabledebug) { \
+ printf("marking %p as complete\n", R); \
+ } \
+ \
R->MR_mn_status = MR_MEMO_NON_COMPLETE; \
} while (0)
/***********************************************************************/
-#define MR_table_memo_create_answer_block(T, Size, AnswerBlock) \
+#define MR_tbl_memo_create_answer_block(debug, T, Size, AnswerBlock) \
do { \
- MR_TABLE_CREATE_ANSWER_BLOCK(T, Size); \
+ MR_TABLE_CREATE_ANSWER_BLOCK(debug, T, Size); \
AnswerBlock = T->MR_answerblock; \
} while(0)
/***********************************************************************/
-#define MR_table_memo_fill_answer_block_shortcut(T) ((void) 0)
+#define MR_tbl_memo_fill_answer_block_shortcut(T) ((void) 0)
/***********************************************************************/
-#ifdef MR_TABLE_DEBUG
- #define MR_table_memo_get_answer_block_msg(T) \
+#define MR_tbl_memo_get_answer_block(debug, T, AnswerBlock) \
do { \
+ if (debug) { \
if (MR_tabledebug) { \
printf("getting answer block %p -> %p\n", \
T, T->MR_answerblock); \
} \
\
if (T->MR_memo_status < MR_MEMO_BLOCK) { \
- MR_fatal_error("table_memo_get_answer_block: " \
- "no block"); \
+ MR_fatal_error("table_memo_get_answer_block: no block"); \
} \
- } while(0)
-#else
- #define MR_table_memo_get_answer_block_msg(T) ((void) 0)
-#endif
-
-#define MR_table_memo_get_answer_block(T, AnswerBlock) \
- do { \
- MR_table_memo_get_answer_block_msg(T); \
+ } \
+ \
AnswerBlock = T->MR_answerblock; \
} while(0)
/***********************************************************************/
-#define MR_table_memo_get_answer_block_shortcut(T) ((void) 0)
+#define MR_tbl_memo_get_answer_block_shortcut(T) ((void) 0)
/***********************************************************************/
-#ifdef MR_TABLE_DEBUG
- #define MR_table_memo_non_get_answer_table_msg(Record) \
+#define MR_tbl_memo_non_get_answer_table(debug, Record, AnswerTable) \
do { \
- if (MR_tabledebug) { \
+ if (debug && MR_tabledebug) { \
printf("getting answer table %p -> %p\n", \
- Record, \
- &(Record->MR_mn_answer_table)); \
+ Record, &(Record->MR_mn_answer_table)); \
} \
- } while(0)
-#else
- #define MR_table_memo_non_get_answer_table_msg(Record) ((void) 0)
-#endif
-
-#define MR_table_memo_non_get_answer_table(Record, AnswerTable) \
- do { \
- MR_table_memo_non_get_answer_table_msg(Record); \
+ \
AnswerTable = &(Record->MR_mn_answer_table); \
} while(0)
/***********************************************************************/
-#ifdef MR_TABLE_DEBUG
- #define MR_table_memo_non_create_answer_block_msg(Record, answer_node)\
- do { \
- if (MR_tabledebug) { \
- printf("new answer slot %d at %p(%p)\n", \
- Record->MR_mn_num_answers, answer_node, \
- &answer_node->MR_aln_answer_block); \
- printf("\tstoring into %p\n", \
- Record->MR_mn_answer_list_tail); \
- } \
- } while(0)
-#else
- #define MR_table_memo_non_create_answer_block_msg(Record, answer_node)\
- ((void) 0)
-#endif
-
-#define MR_table_memo_non_create_answer_block(Record, Size, AnswerBlock)\
+#define MR_tbl_memo_non_create_answer_block(debug, Record, Size, AnswerBlock) \
do { \
MR_AnswerListNode *answer_node; \
MR_Word **Slot; \
@@ -476,78 +502,60 @@
answer_node->MR_aln_answer_block = NULL; \
answer_node->MR_aln_next_answer = NULL; \
\
- MR_table_memo_non_create_answer_block_msg(Record, answer_node); \
+ if (debug && MR_tabledebug) { \
+ printf("new answer slot %d at %p(%p)\n", \
+ Record->MR_mn_num_answers, answer_node, \
+ &answer_node->MR_aln_answer_block); \
+ printf("\tstoring into %p\n", \
+ Record->MR_mn_answer_list_tail); \
+ } \
+ \
*(Record->MR_mn_answer_list_tail) = answer_node; \
- Record->MR_mn_answer_list_tail = \
- &(answer_node->MR_aln_next_answer); \
+ Record->MR_mn_answer_list_tail = &(answer_node->MR_aln_next_answer);\
Slot = &(answer_node->MR_aln_answer_block); \
- MR_TABLE_CREATE_NODE_ANSWER_BLOCK(Slot, Size); \
+ MR_TABLE_CREATE_NODE_ANSWER_BLOCK(debug, Slot, Size); \
AnswerBlock = *Slot; \
} while(0)
-#define MR_table_memo_non_create_answer_block_shortcut(Record) \
+#define MR_tbl_memo_non_create_answer_block_shortcut(Record) \
((void) 0)
/***********************************************************************/
-#define MR_table_memo_non_return_all_shortcut(Record) \
+#define MR_tbl_memo_non_return_all_shortcut(Record) \
((void) 0)
/***********************************************************************/
-#ifdef MR_TABLE_DEBUG
- #define MR_table_memo_non_answer_is_not_duplicate_msg(T) \
+#define MR_tbl_memo_non_answer_is_not_duplicate(debug, T, succ) \
do { \
- if (MR_tabledebug) { \
+ MR_bool is_new_answer; \
+ \
+ if (debug && MR_tabledebug) { \
printf("checking if %p is a duplicate answer: %ld\n", \
T, (long) T->MR_integer); \
} \
- } while(0)
-#else
- #define MR_table_memo_non_answer_is_not_duplicate_msg(T) ((void) 0)
-#endif
-
-#define MR_table_memo_non_answer_is_not_duplicate(T, succ) \
- do { \
- MR_bool is_new_answer; \
- MR_table_memo_non_answer_is_not_duplicate_msg(T); \
+ \
is_new_answer = (T->MR_integer == 0); \
T->MR_integer = 1; /* any nonzero value will do */ \
succ = is_new_answer; \
} while(0)
-#define MR_table_memo_non_answer_is_not_duplicate_shortcut(R, succ) \
+#define MR_tbl_memo_non_answer_is_not_duplicate_shortcut(R, succ) \
((void) 0)
/***********************************************************************/
-#ifdef MR_DEBUG_RETRY
- #define MR_table_io_in_range_check_msg \
- if (MR_io_tabling_debug) { \
- printf("checking table_io_in_range: " \
- "prev %d, start %d, hwm %d", \
- MR_io_tabling_counter, MR_io_tabling_start, \
- MR_io_tabling_counter_hwm); \
- }
- #define MR_table_io_in_range_in_range_msg \
- if (MR_io_tabling_debug) { \
- printf(" in range\n"); \
- }
- #define MR_table_io_in_range_not_in_range_msg \
- if (MR_io_tabling_debug) { \
- printf(" not in range\n"); \
- }
-#else
- #define MR_table_io_in_range_check_msg ((void) 0)
- #define MR_table_io_in_range_in_range_msg ((void) 0)
- #define MR_table_io_in_range_not_in_range_msg ((void) 0)
-#endif
-
-#define MR_table_io_in_range(T, Counter, Start, Succ) \
+#define MR_tbl_io_in_range(debug, T, Counter, Start, Succ) \
if (MR_io_tabling_enabled) { \
MR_Unsigned old_counter; \
\
- MR_table_io_in_range_check_msg; \
+ if (debug && MR_io_tabling_debug) { \
+ printf("checking table_io_in_range: prev %d, start %d, hwm %d", \
+ MR_io_tabling_counter, MR_io_tabling_start, \
+ MR_io_tabling_counter_hwm); \
+ } \
+ \
old_counter = MR_io_tabling_counter; \
MR_io_tabling_counter++; \
\
@@ -562,10 +570,16 @@
MR_io_tabling_counter_hwm = MR_io_tabling_counter; \
} \
\
- MR_table_io_in_range_in_range_msg; \
+ if (debug && MR_io_tabling_debug) { \
+ printf(" in range\n"); \
+ } \
+ \
Succ = MR_TRUE; \
} else { \
- MR_table_io_in_range_not_in_range_msg; \
+ if (debug && MR_io_tabling_debug) { \
+ printf(" not in range\n"); \
+ } \
+ \
Succ = MR_FALSE; \
} \
} else { \
@@ -574,27 +588,19 @@
/***********************************************************************/
-#ifdef MR_TABLE_DEBUG
- #define MR_table_io_has_occurred_msg(T) \
+#define MR_tbl_io_has_occurred(debug, T, Succ) \
do { \
- if (MR_tabledebug) { \
+ if (debug && MR_tabledebug) { \
printf("checking %p for previous execution: %p\n", \
T, T->MR_answerblock); \
} \
- } while(0)
-#else
- #define MR_table_io_has_occurred_msg(T) ((void) 0)
-#endif
-
-#define MR_table_io_has_occurred(T, Succ) \
- do { \
- MR_table_io_has_occurred_msg(T); \
+ \
Succ = (T->MR_answerblock != NULL); \
} while(0)
/***********************************************************************/
-#define MR_table_io_left_bracket_unitized_goal(TraceEnabled) \
+#define MR_tbl_io_left_bracket_unitized_goal(TraceEnabled) \
do { \
TraceEnabled = MR_debug_enabled; \
MR_debug_enabled = MR_FALSE; \
@@ -604,7 +610,7 @@
/***********************************************************************/
-#define MR_table_io_right_bracket_unitized_goal(TraceEnabled) \
+#define MR_tbl_io_right_bracket_unitized_goal(TraceEnabled) \
do { \
MR_io_tabling_enabled = MR_TRUE; \
MR_debug_enabled = TraceEnabled; \
@@ -617,7 +623,7 @@
/***********************************************************************/
-#define MR_table_mm_setup(T, Subgoal, Status) \
+#define MR_tbl_mm_setup(debug, back, T, Subgoal, Status) \
do { \
MR_save_transient_registers(); \
Subgoal = MR_setup_subgoal(T); \
@@ -631,93 +637,46 @@
Status = MR_CONVERT_C_ENUM_CONSTANT(Status); \
} while(0)
-#define MR_table_mm_setup_shortcut(Subgoal, Status) \
+#define MR_tbl_mm_setup_shortcut(Subgoal, Status) \
do { \
- MR_fatal_error("MR_table_mm_setup_shortcut"); \
+ MR_fatal_error("MR_tbl_mm_setup_shortcut"); \
} while(0)
/***********************************************************************/
-#define MR_table_mm_return_all_shortcut(AnswerBlock) ((void) 0)
+#define MR_tbl_mm_return_all_shortcut(AnswerBlock) ((void) 0)
/***********************************************************************/
-#ifdef MR_TABLE_DEBUG
- #define MR_table_mm_get_answer_table_msg(Subgoal) \
+#define MR_tbl_mm_get_answer_table(debug, Subgoal, AnswerTable) \
do { \
- if (MR_tabledebug) { \
+ if (debug && MR_tabledebug) { \
printf("getting answer table %p -> %p\n", \
- Subgoal, \
- &(Subgoal->MR_sg_answer_table)); \
+ Subgoal, &(Subgoal->MR_sg_answer_table)); \
} \
- } while(0)
-#else
- #define MR_table_mm_get_answer_table_msg(Subgoal) ((void) 0)
-#endif
-
-#define MR_table_mm_get_answer_table(Subgoal, AnswerTable) \
- do { \
- MR_table_mm_get_answer_table_msg(Subgoal); \
+ \
AnswerTable = &(Subgoal->MR_sg_answer_table); \
} while(0)
/***********************************************************************/
-#ifdef MR_TABLE_DEBUG
- #define MR_table_mm_answer_is_not_duplicate_msg(T) \
+#define MR_tbl_mm_answer_is_not_duplicate(debug, T, succ) \
do { \
- if (MR_tabledebug) { \
+ MR_bool is_new_answer; \
+ \
+ if (debug && MR_tabledebug) { \
printf("checking if %p is a duplicate answer: %ld\n", \
T, (long) T->MR_integer); \
} \
- } while(0)
-#else
- #define MR_table_mm_answer_is_not_duplicate_msg(T) ((void) 0)
-#endif
-
-#ifdef MR_TABLE_STATISTICS
- #define MR_table_mm_answer_is_not_duplicate_stats(T, is_new_answer) \
- do { \
- MR_minmodel_stats_cnt_dupl_check++; \
- if (is_new_answer) { \
- MR_minmodel_stats_cnt_dupl_check_not_dupl++; \
- } \
- } while(0)
-#else
- #define MR_table_mm_answer_is_not_duplicate_stats(T, is_new_answer) \
- ((void) 0)
-#endif
-
-#define MR_table_mm_answer_is_not_duplicate(T, succ) \
- do { \
- MR_bool is_new_answer; \
- MR_table_mm_answer_is_not_duplicate_msg(T); \
+ \
is_new_answer = (T->MR_integer == 0); \
- MR_table_mm_answer_is_not_duplicate_stats(T, is_new_answer); \
T->MR_integer = 1; /* any nonzero value will do */ \
succ = is_new_answer; \
} while(0)
/***********************************************************************/
-#ifdef MR_TABLE_DEBUG
- #define MR_table_mm_create_answer_block_msg(Subgoal, answer_node) \
- do { \
- if (MR_tabledebug) { \
- printf("%s: new answer slot %d at %p(%p)\n", \
- MR_subgoal_addr_name(Subgoal), \
- Subgoal->MR_sg_num_ans, answer_node, \
- &answer_node->MR_aln_answer_block); \
- printf("\tstoring into %p\n", \
- Subgoal->MR_sg_answer_list_tail); \
- } \
- } while(0)
-#else
- #define MR_table_mm_create_answer_block_msg(Subgoal, answer_node) \
- ((void) 0)
-#endif
-
-#define MR_table_mm_create_answer_block(Subgoal, Size, AnswerBlock) \
+#define MR_tbl_mm_create_answer_block(debug, Subgoal, Size, AnswerBlock) \
do { \
MR_AnswerListNode *answer_node; \
MR_Word **Slot; \
@@ -735,18 +694,26 @@
answer_node->MR_aln_answer_block = NULL; \
answer_node->MR_aln_next_answer = NULL; \
\
- MR_table_mm_create_answer_block_msg(Subgoal, answer_node); \
+ if (debug && MR_tabledebug) { \
+ printf("%s: new answer slot %d at %p(%p)\n", \
+ MR_subgoal_addr_name(Subgoal), \
+ Subgoal->MR_sg_num_ans, answer_node, \
+ &answer_node->MR_aln_answer_block); \
+ printf("\tstoring into %p\n", \
+ Subgoal->MR_sg_answer_list_tail); \
+ } \
+ \
*(Subgoal->MR_sg_answer_list_tail) = answer_node; \
Subgoal->MR_sg_answer_list_tail = \
&(answer_node->MR_aln_next_answer); \
Slot = &(answer_node->MR_aln_answer_block); \
- MR_TABLE_CREATE_NODE_ANSWER_BLOCK(Slot, Size); \
+ MR_TABLE_CREATE_NODE_ANSWER_BLOCK(debug, Slot, Size); \
AnswerBlock = *Slot; \
} while(0)
/***********************************************************************/
-#define MR_table_mm_fill_answer_block_shortcut(Subgoal) ((void) 0)
+#define MR_tbl_mm_fill_answer_block_shortcut(Subgoal) ((void) 0)
/***********************************************************************/
@@ -755,68 +722,47 @@
#define MR_MMSC_ERROR \
"stack copy minimal model code entered when not enabled"
-#define MR_table_mm_setup(T, Subgoal, Status) \
+#define MR_tbl_mm_setup(debug, back, T, Subgoal, Status) \
do { \
MR_fatal_error(MR_MMSC_ERROR); \
} while(0)
-#define MR_table_mm_setup_shortcut(Subgoal, Status) \
+#define MR_tbl_mm_setup_shortcut(Subgoal, Status) \
do { \
MR_fatal_error(MR_MMSC_ERROR); \
} while(0)
-#define MR_table_mm_return_all_shortcut(AnswerBlock) \
+#define MR_tbl_mm_return_all_shortcut(AnswerBlock) \
do { \
MR_fatal_error(MR_MMSC_ERROR); \
} while(0)
-#define MR_table_mm_get_answer_table(Subgoal, AnswerTable) \
+#define MR_tbl_mm_get_answer_table(debug, Subgoal, AnswerTable) \
do { \
MR_fatal_error(MR_MMSC_ERROR); \
} while(0)
-#define MR_table_mm_answer_is_not_duplicate(T, Succ) \
+#define MR_tbl_mm_answer_is_not_duplicate(debug, T, Succ) \
do { \
MR_fatal_error(MR_MMSC_ERROR); \
} while(0)
-#define MR_table_mm_create_answer_block(Subgoal, Size, AnswerBlock) \
+#define MR_tbl_mm_create_answer_block(debug, Subgoal, Size, AnswerBlock) \
do { \
MR_fatal_error(MR_MMSC_ERROR); \
} while(0)
-#define MR_table_mm_fill_answer_block_shortcut(Subgoal) \
+#define MR_tbl_mm_fill_answer_block_shortcut(Subgoal) \
do { \
MR_fatal_error(MR_MMSC_ERROR); \
} while(0)
/***********************************************************************/
-#ifdef MR_TABLE_DEBUG
- #define MR_table_mmos_answer_is_not_duplicate_msg(T) \
+#define MR_tbl_mmos_answer_is_not_duplicate(debug, T, succ) \
do { \
- if (MR_tabledebug) { \
+ MR_bool is_new_answer; \
+ \
+ if (debug && MR_tabledebug) { \
printf("checking if %p is a duplicate answer: %ld\n", \
T, (long) T->MR_integer); \
} \
- } while(0)
-#else
- #define MR_table_mmos_answer_is_not_duplicate_msg(T) ((void) 0)
-#endif
-
-#ifdef MR_TABLE_STATISTICS
- #define MR_table_mmos_answer_is_not_duplicate_stats(T, is_new_answer) \
- do { \
- MR_mmos_stats_cnt_dupl_check++; \
- if (is_new_answer) { \
- MR_mmos_stats_cnt_dupl_check_not_dupl++; \
- } \
- } while(0)
-#else
- #define MR_table_mmos_answer_is_not_duplicate_stats(T, is_new_answer) \
- ((void) 0)
-#endif
-
-#define MR_table_mmos_answer_is_not_duplicate(T, succ) \
- do { \
- MR_bool is_new_answer; \
- MR_table_mmos_answer_is_not_duplicate_msg(T); \
+ \
is_new_answer = (T->MR_integer == 0); \
- MR_table_mmos_answer_is_not_duplicate_stats(T, is_new_answer); \
T->MR_integer = 1; /* any nonzero value will do */ \
succ = is_new_answer; \
} while(0)
@@ -835,27 +781,27 @@
#define MR_MMOS_ERROR \
"own stack minimal model code entered when not enabled"
-#define MR_table_mmos_save_inputs_shortcut(num_inputs) \
+#define MR_tbl_mmos_save_inputs_shortcut(num_inputs) \
do { \
MR_fatal_error(MR_MMOS_ERROR); \
} while(0)
-#define MR_table_mmos_consume_next_answer_nondet(consumer, answerblock, succ) \
+#define MR_tbl_mmos_consume_next_answer_nondet(consumer, answerblock, succ) \
do { \
MR_fatal_error(MR_MMOS_ERROR); \
} while(0)
-#define MR_table_mmos_get_answer_table(generator, trienode) \
+#define MR_tbl_mmos_get_answer_table(generator, trienode) \
do { \
MR_fatal_error(MR_MMOS_ERROR); \
} while(0)
-#define MR_table_mmos_create_answer_block(generator, blocksize, answerblock) \
+#define MR_tbl_mmos_create_answer_block(generator, blocksize, answerblock) \
do { \
MR_fatal_error(MR_MMOS_ERROR); \
} while(0)
-#define MR_table_mmos_return_answer(generator, answerblock) \
+#define MR_tbl_mmos_return_answer(generator, answerblock) \
do { \
MR_fatal_error(MR_MMOS_ERROR); \
} while(0)
-#define MR_table_mmos_completion(generator) \
+#define MR_tbl_mmos_completion(generator) \
do { \
MR_fatal_error(MR_MMOS_ERROR); \
} while(0)
Index: runtime/mercury_tabling_stats_defs.h
===================================================================
RCS file: runtime/mercury_tabling_stats_defs.h
diff -N runtime/mercury_tabling_stats_defs.h
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ runtime/mercury_tabling_stats_defs.h 20 May 2006 04:41:22 -0000
@@ -0,0 +1,31 @@
+/*
+** vim: ts=4 sw=4 expandtab
+*/
+/*
+** Copyright (C) 2006 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+#define DECLARE_PROBE_COUNT MR_Integer probe_count = 0;
+#define record_probe_count() do { probe_count++; } while (0)
+#define record_lookup_count() \
+ do { \
+ stats->MR_tss_num_lookup_probes += probe_count; \
+ stats->MR_tss_num_lookups++; \
+ } while (0)
+#define record_insert_count() \
+ do { \
+ stats->MR_tss_num_insert_probes += probe_count; \
+ stats->MR_tss_num_inserts++; \
+ } while (0)
+#define record_resize_count(old, new) \
+ do { \
+ stats->MR_tss_num_resizes++; \
+ stats->MR_tss_num_resizes_old_entries += (old); \
+ stats->MR_tss_num_resizes_new_entries += (new); \
+ } while (0)
+#define record_alloc_count() \
+ do { \
+ stats->MR_tss_num_allocs++; \
+ } while (0)
Index: runtime/mercury_tabling_stats_nodefs.h
===================================================================
RCS file: runtime/mercury_tabling_stats_nodefs.h
diff -N runtime/mercury_tabling_stats_nodefs.h
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ runtime/mercury_tabling_stats_nodefs.h 20 May 2006 04:42:36 -0000
@@ -0,0 +1,15 @@
+/*
+** vim: ts=4 sw=4 expandtab
+*/
+/*
+** Copyright (C) 2006 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+#define DECLARE_PROBE_COUNT
+#define record_probe_count() ((void) 0)
+#define record_lookup_count() ((void) 0)
+#define record_insert_count() ((void) 0)
+#define record_resize_count(old, new) ((void) 0)
+#define record_alloc_count() ((void) 0)
Index: runtime/mercury_tabling_stats_undefs.h
===================================================================
RCS file: runtime/mercury_tabling_stats_undefs.h
diff -N runtime/mercury_tabling_stats_undefs.h
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ runtime/mercury_tabling_stats_undefs.h 20 May 2006 04:43:16 -0000
@@ -0,0 +1,15 @@
+/*
+** vim: ts=4 sw=4 expandtab
+*/
+/*
+** Copyright (C) 2006 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+#undef DECLARE_PROBE_COUNT
+#undef record_probe_count
+#undef record_lookup_count
+#undef record_insert_count
+#undef record_resize_count
+#undef record_alloc_count
Index: runtime/mercury_tags.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_tags.h,v
retrieving revision 1.24
diff -u -b -r1.24 mercury_tags.h
--- runtime/mercury_tags.h 1 Sep 2005 07:36:28 -0000 1.24
+++ runtime/mercury_tags.h 5 Jun 2006 17:40:47 -0000
@@ -335,7 +335,6 @@
#endif
-
/*
** For each enumeration constant defined in the runtime (not in Mercury)
** that we need the compiler to be able to generate, we define it using two
Index: runtime/mercury_trace_base.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_trace_base.c,v
retrieving revision 1.71
diff -u -b -r1.71 mercury_trace_base.c
--- runtime/mercury_trace_base.c 1 Sep 2005 07:36:28 -0000 1.71
+++ runtime/mercury_trace_base.c 6 Jun 2006 05:58:33 -0000
@@ -762,8 +762,8 @@
return MR_FALSE;
}
- MR_DEBUG_NEW_TABLE_START_INT(answer_block_trie,
- (MR_TrieNode) &MR_io_tabling_pointer,
+ MR_TABLE_START_INT(NULL, MR_tabledebug, MR_FALSE,
+ answer_block_trie, (MR_TrieNode) &MR_io_tabling_pointer,
MR_io_tabling_start, action_number);
answer_block = answer_block_trie->MR_answerblock;
@@ -998,9 +998,8 @@
num_entries = 0;
for (i = MR_io_tabling_start; i < MR_io_tabling_counter_hwm; i++) {
- MR_DEBUG_NEW_TABLE_START_INT(answer_block_trie,
- (MR_TrieNode) &MR_io_tabling_pointer,
- MR_io_tabling_start, i);
+ MR_TABLE_START_INT(NULL, MR_FALSE, MR_FALSE, answer_block_trie,
+ (MR_TrieNode) &MR_io_tabling_pointer, MR_io_tabling_start, i);
answer_block = answer_block_trie->MR_answerblock;
if (answer_block == NULL) {
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.119
diff -u -b -r1.119 mercury_type_info.h
--- runtime/mercury_type_info.h 28 Mar 2006 08:07:28 -0000 1.119
+++ runtime/mercury_type_info.h 21 May 2006 10:02:33 -0000
@@ -42,7 +42,7 @@
** that traverses type_infos and type_ctor_infos:
**
** runtime/mercury_deep_copy_body.h
-** runtime/mercury_tabling.c
+** runtime/mercury_table_type_body.h
** runtime/mercury_type_info.c
** library/type_desc.m
**
Index: runtime/mercury_types.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_types.h,v
retrieving revision 1.43
diff -u -b -r1.43 mercury_types.h
--- runtime/mercury_types.h 1 Sep 2005 07:36:28 -0000 1.43
+++ runtime/mercury_types.h 18 May 2006 04:40:02 -0000
@@ -268,4 +268,8 @@
typedef MR_Consumer *MR_ConsumerPtr;
typedef MR_Generator *MR_GeneratorPtr;
+typedef struct MR_TableStepStats_Struct MR_TableStepStats;
+typedef struct MR_ProcTableInfo_Struct MR_ProcTableInfo;
+typedef MR_ProcTableInfo *MR_ProcTableInfoPtr;
+
#endif /* not MERCURY_TYPES_H */
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 slice
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.17
diff -u -b -r1.17 Mercury.options
--- tests/debugger/Mercury.options 10 Feb 2006 22:41:19 -0000 1.17
+++ tests/debugger/Mercury.options 24 May 2006 13:36:04 -0000
@@ -51,5 +51,3 @@
GRADEFLAGS-interactive = --pic-reg
MLFLAGS-interactive = --shared
MERCURY_LINKAGE-interactive = shared
-
-MCFLAGS-fib = --allow-table-reset
Index: tests/debugger/fib.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/fib.exp,v
retrieving revision 1.2
diff -u -b -r1.2 fib.exp
--- tests/debugger/fib.exp 9 Mar 2005 03:57:49 -0000 1.2
+++ tests/debugger/fib.exp 6 Jun 2006 07:54:20 -0000
@@ -37,7 +37,7 @@
<23>: succeeded <46368>
end of table (24 entries)
mdb> step 2
- E4: C3 EXIT pred fib.reset/2-0 (det)
+ E4: C3 EXIT pred fib.table_reset_for_mfib_2/2-0 (det)
mdb> table mfib
memo table for pred fib.mfib/2-0 (det):
end of table (0 entries)
Index: tests/debugger/fib.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/fib.m,v
retrieving revision 1.2
diff -u -b -r1.2 fib.m
--- tests/debugger/fib.m 9 Mar 2005 03:57:49 -0000 1.2
+++ tests/debugger/fib.m 24 May 2006 13:35:49 -0000
@@ -12,7 +12,7 @@
main(!IO) :-
perform_trial(23, !IO),
- reset(!IO),
+ table_reset_for_mfib_2(!IO),
perform_trial(23, !IO).
:- pred perform_trial(int::in, io::di, io::uo) is det.
@@ -40,7 +40,7 @@
).
:- pred mfib(int::in, int::out) is det.
-:- pragma memo(mfib/2).
+:- pragma memo(mfib/2, [allow_reset]).
mfib(N, F) :-
( N < 2 ->
@@ -50,14 +50,3 @@
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();
-").
Index: tests/debugger/print_table.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/print_table.m,v
retrieving revision 1.5
diff -u -b -r1.5 print_table.m
--- tests/debugger/print_table.m 29 Mar 2006 08:07:55 -0000 1.5
+++ tests/debugger/print_table.m 24 May 2006 13:37:36 -0000
@@ -4,7 +4,7 @@
:- import_module io.
-:- pred main(io__state::di, io__state::uo) is det.
+:- pred main(io.state::di, io.state::uo) is det.
:- implementation.
@@ -37,48 +37,48 @@
{ solutions(u(1, 2, 2), U12) },
{ solutions(u(2, 2, 2), U22) },
{ udone },
- io__write_int(P55),
- io__nl,
- io__write_int(P43),
- io__nl,
- io__write_int(P22),
- io__nl,
- io__write_int(P10),
- io__nl,
- io__write(MaybeQ32),
- io__nl,
- io__write(MaybeQ42),
- io__nl,
- io__write_int(R3),
- io__nl,
- io__write_string(SA),
- io__write_string(" "),
- io__write_float(TA),
- io__nl,
- io__write_string(SB),
- io__write_string(" "),
- io__write_float(TB),
- io__nl,
- io__write_string(SC),
- io__write_string(" "),
- io__write_float(TC),
- io__nl,
- io__write_string(SD),
- io__write_string(" "),
- io__write_float(TD),
- io__nl,
- io__write_string(SE),
- io__write_string(" "),
- io__write_float(TE),
- io__nl,
- io__write(T12),
- io__nl,
- io__write(T22),
- io__nl,
- io__write(U12),
- io__nl,
- io__write(U22),
- io__nl.
+ io.write_int(P55),
+ io.nl,
+ io.write_int(P43),
+ io.nl,
+ io.write_int(P22),
+ io.nl,
+ io.write_int(P10),
+ io.nl,
+ io.write(MaybeQ32),
+ io.nl,
+ io.write(MaybeQ42),
+ io.nl,
+ io.write_int(R3),
+ io.nl,
+ io.write_string(SA),
+ io.write_string(" "),
+ io.write_float(TA),
+ io.nl,
+ io.write_string(SB),
+ io.write_string(" "),
+ io.write_float(TB),
+ io.nl,
+ io.write_string(SC),
+ io.write_string(" "),
+ io.write_float(TC),
+ io.nl,
+ io.write_string(SD),
+ io.write_string(" "),
+ io.write_float(TD),
+ io.nl,
+ io.write_string(SE),
+ io.write_string(" "),
+ io.write_float(TE),
+ io.nl,
+ io.write(T12),
+ io.nl,
+ io.write(T22),
+ io.nl,
+ io.write(U12),
+ io.nl,
+ io.write(U22),
+ io.nl.
:- pred p(int::in, int::in, int::out) is det.
:- pragma memo(p/3).
@@ -146,7 +146,7 @@
tdone.
:- pred u(int::in, int::in, int::in, int::out) is nondet.
-:- pragma memo(u/4, [value, value, promise_implied, output]).
+:- pragma memo(u/4, [specified([value, value, promise_implied, output])]).
u(A, B, Bcopy, C) :-
( A = 1 ->
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
Index: tests/invalid/specified.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/specified.err_exp,v
retrieving revision 1.2
diff -u -b -r1.2 specified.err_exp
--- tests/invalid/specified.err_exp 14 Sep 2005 05:26:51 -0000 1.2
+++ tests/invalid/specified.err_exp 6 Jun 2006 05:38:45 -0000
@@ -1,15 +1,15 @@
-specified.m:167: Error: expected argument tabling method: implied.
-specified.m:152: Error in `pragma memo([addr, promise_implied, addr])'
-specified.m:152: declaration for predicate `specified.ap_lp_fib/3':
-specified.m:152: argument 3: argument tabling method `addr' is not compatible
-specified.m:152: with output modes.
-specified.m:182: Error in `pragma memo([addr, promise_implied])' declaration
-specified.m:182: for predicate `specified.ap_li_fib/3':
-specified.m:182: not enough argument tabling methods specified.
-specified.m:220: Error in `pragma memo([output, value, promise_implied])'
-specified.m:220: declaration for predicate `specified.vp_ll_fib/3':
-specified.m:220: argument 1: argument tabling method `output' is not
-specified.m:220: compatible with input modes.
-specified.m:239: Error in `pragma memo([value, value, output, output])'
-specified.m:239: declaration for predicate `specified.vv_ll_fib/3':
-specified.m:239: too many argument tabling methods specified.
+specified.m:155: Error: expected argument tabling method: implied.
+specified.m:138: Error in `pragma memo' declaration for predicate
+specified.m:138: `specified.ap_lp_fib/3':
+specified.m:138: argument 3: argument tabling method `addr' is not compatible
+specified.m:138: with output modes.
+specified.m:170: Error in `pragma memo' declaration for predicate
+specified.m:170: `specified.ap_li_fib/3':
+specified.m:170: not enough argument tabling methods specified.
+specified.m:210: Error in `pragma memo' declaration for predicate
+specified.m:210: `specified.vp_ll_fib/3':
+specified.m:210: argument 1: argument tabling method `output' is not
+specified.m:210: compatible with input modes.
+specified.m:230: Error in `pragma memo' declaration for predicate
+specified.m:230: `specified.vv_ll_fib/3':
+specified.m:230: too many argument tabling methods specified.
Index: tests/invalid/specified.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/specified.m,v
retrieving revision 1.2
diff -u -b -r1.2 specified.m
--- tests/invalid/specified.m 29 Mar 2006 08:08:06 -0000 1.2
+++ tests/invalid/specified.m 23 May 2006 03:48:37 -0000
@@ -93,27 +93,13 @@
benchmark_det(vp_li_fib_test, ListN - IntN, MRes, 1, MTime)
;
TrialType = vvll_vs_vpll,
- reset_tables(!IO),
+ table_reset_for_vv_ll_fib_3(!IO),
+ table_reset_for_vp_ll_fib_3(!IO),
benchmark_det(vv_ll_fib_test, ListN - ListN, Res, 1, Time),
benchmark_det(vp_ll_fib_test, ListN - ListN, MRes, 1, MTime)
),
require(unify(Res, MRes), "tabling produces wrong answer").
-:- pred reset_tables(io::di, io::uo) is det.
-
-:- pragma foreign_decl("C",
-"
-extern void mercury__specified__reset_tables(void);
-").
-
-:- pragma foreign_proc("C",
- reset_tables(IO0::di, IO::uo),
- [will_not_call_mercury, promise_pure],
-"
- /* Mention IO0, IO */
- mercury__specified__reset_tables();
-").
-
%-----------------------------------------------------------------------------%
:- pred ap_lp_fib_test(pair(list(int), T)::in, list(int)::out) is det.
@@ -149,7 +135,8 @@
%-----------------------------------------------------------------------------%
:- pred ap_lp_fib(list(int)::in, T::in, list(int)::out) is det.
-:- pragma memo(ap_lp_fib(in, in, out), [addr, promise_implied, addr]).
+:- pragma memo(ap_lp_fib(in, in, out),
+ [allow_reset, statistics, specified([addr, promise_implied, addr])]).
ap_lp_fib(N, Dummy, F) :-
RawN = digits_to_num(N),
@@ -164,7 +151,8 @@
).
:- pred vp_lp_fib(list(int)::in, T::in, list(int)::out) is det.
-:- pragma memo(vp_lp_fib/3, [value, implied, output]).
+:- pragma memo(vp_lp_fib/3,
+ [allow_reset, statistics, specified([value, implied, output])]).
vp_lp_fib(N, Dummy, F) :-
RawN = digits_to_num(N),
@@ -179,7 +167,8 @@
).
:- pred ap_li_fib(list(int)::in, int::in, list(int)::out) is det.
-:- pragma memo(ap_li_fib(in, in, out), [addr, promise_implied]).
+:- pragma memo(ap_li_fib(in, in, out),
+ [allow_reset, statistics, specified([addr, promise_implied])]).
ap_li_fib(N, CopyN, F) :-
RawN = digits_to_num(N),
@@ -198,7 +187,8 @@
).
:- pred vp_li_fib(list(int)::in, int::in, list(int)::out) is det.
-:- pragma memo(vp_li_fib/3, [value, promise_implied, output]).
+:- pragma memo(vp_li_fib/3,
+ [allow_reset, statistics, specified([value, promise_implied, output])]).
vp_li_fib(N, CopyN, F) :-
RawN = digits_to_num(N),
@@ -217,7 +207,8 @@
).
:- pred vp_ll_fib(list(int)::in, list(int)::in, list(int)::out) is det.
-:- pragma memo(vp_ll_fib/3, [output, value, promise_implied]).
+:- pragma memo(vp_ll_fib/3,
+ [allow_reset, statistics, specified([output, value, promise_implied])]).
vp_ll_fib(N, CopyN, F) :-
RawN = digits_to_num(N),
@@ -236,7 +227,8 @@
).
:- pred vv_ll_fib(list(int)::in, list(int)::in, list(int)::out) is det.
-:- pragma memo(vv_ll_fib/3, [value, value, output, output]).
+:- pragma memo(vv_ll_fib/3,
+ [allow_reset, statistics, specified([value, value, output, output])]).
vv_ll_fib(N, CopyN, F) :-
RawN = digits_to_num(N),
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
Index: tests/tabling/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/tabling/Mercury.options,v
retrieving revision 1.2
diff -u -b -r1.2 Mercury.options
--- tests/tabling/Mercury.options 14 Aug 2005 03:20:57 -0000 1.2
+++ tests/tabling/Mercury.options 17 May 2006 08:26:50 -0000
@@ -2,6 +2,3 @@
# tc_minimal works on some machines even in the presence of a known bug
# if inlining is turned on, so we turn inlining off to make the test tougher.
MCFLAGS-tc_minimal = --no-inlining
-
-# The specified test case needs to reset some tables between trials.
-MCFLAGS-specified = --allow-table-reset
Index: tests/tabling/fast_loose.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/tabling/fast_loose.m,v
retrieving revision 1.1
diff -u -b -r1.1 fast_loose.m
--- tests/tabling/fast_loose.m 7 Jun 2005 03:00:07 -0000 1.1
+++ tests/tabling/fast_loose.m 15 May 2006 02:50:02 -0000
@@ -71,7 +71,7 @@
fast_loose_sum(iota(N), R).
:- pred fast_loose_sum(list(int)::in, int::out) is det.
-:- pragma fast_loose_memo(fast_loose_sum/2).
+:- pragma memo(fast_loose_sum/2, [fast_loose]).
fast_loose_sum([], 0).
fast_loose_sum([H | T], H + TS) :-
Index: tests/tabling/specified.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/tabling/specified.m,v
retrieving revision 1.2
diff -u -b -r1.2 specified.m
--- tests/tabling/specified.m 29 Mar 2006 08:08:08 -0000 1.2
+++ tests/tabling/specified.m 24 May 2006 12:23:21 -0000
@@ -28,6 +28,9 @@
perform_trials(aplp_vs_vplp, [1, 4], 14, 3, 0, 0, !IO),
perform_trials(apli_vs_vpli, [1, 4], 14, 3, 0, 0, !IO),
perform_trials(vvll_vs_vpll, [4, 4, 4], 444, 30, 0, 0, !IO).
+ % table_statistics_for_vv_ll_fib_3(Stats, !IO),
+ % io.write(Stats, !IO),
+ % io.nl(!IO).
:- type trial_type
---> aplp_vs_vplp
@@ -102,27 +105,13 @@
benchmark_det(vp_li_fib_test, ListN - IntN, MRes, 1, MTime)
;
TrialType = vvll_vs_vpll,
- reset_tables(!IO),
+ table_reset_for_vv_ll_fib_3(!IO),
+ table_reset_for_vp_ll_fib_3(!IO),
benchmark_det(vv_ll_fib_test, ListN - ListN, Res, 1, Time),
benchmark_det(vp_ll_fib_test, ListN - ListN, MRes, 1, MTime)
),
require(unify(Res, MRes), "tabling produces wrong answer").
-:- pred reset_tables(io::di, io::uo) is det.
-
-:- pragma foreign_decl("C",
-"
-extern void mercury__specified__reset_tables(void);
-").
-
-:- pragma foreign_proc("C",
- reset_tables(IO0::di, IO::uo),
- [will_not_call_mercury, promise_pure],
-"
- /* Mention IO0, IO */
- mercury__specified__reset_tables();
-").
-
%-----------------------------------------------------------------------------%
:- pred ap_lp_fib_test(pair(list(int), T)::in, list(int)::out) is det.
@@ -158,7 +147,8 @@
%-----------------------------------------------------------------------------%
:- pred ap_lp_fib(list(int)::in, T::in, list(int)::out) is det.
-:- pragma memo(ap_lp_fib(in, in, out), [addr, promise_implied, output]).
+:- pragma memo(ap_lp_fib(in, in, out),
+ [allow_reset, statistics, specified([addr, promise_implied, output])]).
ap_lp_fib(N, Dummy, F) :-
RawN = digits_to_num(N),
@@ -173,7 +163,8 @@
).
:- pred vp_lp_fib(list(int)::in, T::in, list(int)::out) is det.
-:- pragma memo(vp_lp_fib/3, [value, promise_implied, output]).
+:- pragma memo(vp_lp_fib/3,
+ [allow_reset, statistics, specified([value, promise_implied, output])]).
vp_lp_fib(N, Dummy, F) :-
RawN = digits_to_num(N),
@@ -188,7 +179,8 @@
).
:- pred ap_li_fib(list(int)::in, int::in, list(int)::out) is det.
-:- pragma memo(ap_li_fib(in, in, out), [addr, promise_implied, output]).
+:- pragma memo(ap_li_fib(in, in, out),
+ [allow_reset, statistics, specified([addr, promise_implied, output])]).
ap_li_fib(N, CopyN, F) :-
RawN = digits_to_num(N),
@@ -207,7 +199,8 @@
).
:- pred vp_li_fib(list(int)::in, int::in, list(int)::out) is det.
-:- pragma memo(vp_li_fib/3, [value, promise_implied, output]).
+:- pragma memo(vp_li_fib/3,
+ [allow_reset, statistics, specified([value, promise_implied, output])]).
vp_li_fib(N, CopyN, F) :-
RawN = digits_to_num(N),
@@ -226,7 +219,8 @@
).
:- pred vp_ll_fib(list(int)::in, list(int)::in, list(int)::out) is det.
-:- pragma memo(vp_ll_fib/3, [value, promise_implied, output]).
+:- pragma memo(vp_ll_fib/3,
+ [allow_reset, statistics, specified([value, promise_implied, output])]).
vp_ll_fib(N, CopyN, F) :-
RawN = digits_to_num(N),
@@ -245,7 +239,8 @@
).
:- pred vv_ll_fib(list(int)::in, list(int)::in, list(int)::out) is det.
-:- pragma memo(vv_ll_fib/3, [value, value, output]).
+:- pragma memo(vv_ll_fib/3,
+ [allow_reset, statistics, specified([value, value, output])]).
vv_ll_fib(N, CopyN, F) :-
RawN = digits_to_num(N),
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
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/mercury/mercury1/repository/mercury/trace/mercury_trace.c,v
retrieving revision 1.94
diff -u -b -r1.94 mercury_trace.c
--- trace/mercury_trace.c 8 Feb 2006 21:54:32 -0000 1.94
+++ trace/mercury_trace.c 25 May 2006 00:27:31 -0000
@@ -1566,9 +1566,7 @@
/* nothing to do */
return;
- case MR_EVAL_METHOD_MEMO_STRICT:
- case MR_EVAL_METHOD_MEMO_FAST_LOOSE:
- case MR_EVAL_METHOD_MEMO_SPECIFIED:
+ case MR_EVAL_METHOD_MEMO:
case MR_EVAL_METHOD_LOOP_CHECK:
if (MR_DETISM_DET_STACK(level_layout->MR_sle_detism)) {
call_table = (MR_TrieNode) MR_based_stackvar(base_sp,
Index: trace/mercury_trace_cmd_developer.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_cmd_developer.c,v
retrieving revision 1.1
diff -u -b -r1.1 mercury_trace_cmd_developer.c
--- trace/mercury_trace_cmd_developer.c 4 Apr 2006 07:37:28 -0000 1.1
+++ trace/mercury_trace_cmd_developer.c 6 Jun 2006 13:21:18 -0000
@@ -23,6 +23,7 @@
#include "mercury_std.h"
#include "mercury_getopt.h"
#include "mercury_types.h"
+#include "mercury_tabling.h"
#include "mercury_trace_base.h"
#include "mercury_trace_internal.h"
@@ -64,7 +65,7 @@
** reach after following the current values of the previous arguments through
** the call table.
**
-** The MR_{Int,Float,String}_Table_Arg_Values structs have the same fields and
+** The MR_{Int,Float,String}TableArgValues structs have the same fields and
** the same meanings, differing only in the types of the values they store.
** Each struct is used for one of two things.
**
@@ -94,34 +95,34 @@
int MR_ctai_value_next;
int MR_ctai_cur_index;
MR_Integer MR_ctai_cur_value;
-} MR_Int_Table_Arg_Values;
+} MR_IntTableArgValues;
typedef struct {
MR_Float *MR_ctaf_values;
int MR_ctaf_value_next;
int MR_ctaf_cur_index;
MR_Float MR_ctaf_cur_value;
-} MR_Float_Table_Arg_Values;
+} MR_FloatTableArgValues;
typedef struct {
MR_ConstString *MR_ctas_values;
int MR_ctas_value_next;
int MR_ctas_cur_index;
MR_ConstString MR_ctas_cur_value;
-} MR_String_Table_Arg_Values;
+} MR_StringTableArgValues;
typedef union {
- MR_Int_Table_Arg_Values MR_cta_values_int;
- MR_Float_Table_Arg_Values MR_cta_values_float;
- MR_String_Table_Arg_Values MR_cta_values_string;
-} MR_Table_Arg_Values;
+ MR_IntTableArgValues MR_cta_values_int;
+ MR_FloatTableArgValues MR_cta_values_float;
+ MR_StringTableArgValues MR_cta_values_string;
+} MR_TableArgValues;
typedef struct {
- MR_Table_Trie_Step MR_cta_step;
+ MR_TableTrieStep MR_cta_step;
int MR_cta_unfiltered_arg_num;
MR_TrieNode MR_cta_start_node;
MR_bool MR_cta_valid;
- MR_Table_Arg_Values MR_cta_arg_values;
+ MR_TableArgValues MR_cta_arg_values;
} MR_Call_Table_Arg;
#define MR_cta_int_values MR_cta_arg_values.MR_cta_values_int.\
@@ -738,7 +739,7 @@
MR_Call_Table_Arg *call_table_args;
const MR_Proc_Layout *proc;
MR_Proc_Spec spec;
- const MR_Table_Gen *table_gen;
+ MR_ProcTableInfo *pt;
MR_TrieNode table_cur;
int num_inputs;
int filtered_num_inputs;
@@ -769,9 +770,7 @@
return KEEP_INTERACTING;
case MR_EVAL_METHOD_LOOP_CHECK:
- case MR_EVAL_METHOD_MEMO_STRICT:
- case MR_EVAL_METHOD_MEMO_FAST_LOOSE:
- case MR_EVAL_METHOD_MEMO_SPECIFIED:
+ case MR_EVAL_METHOD_MEMO:
case MR_EVAL_METHOD_MINIMAL_STACK_COPY:
case MR_EVAL_METHOD_MINIMAL_OWN_STACKS:
break;
@@ -788,15 +787,14 @@
/*
** words[0] is the command, words[1] is the procedure spec;
** words[2] is the first argument. We step over the command and the
- ** procedure spec, to leave words[] containing only the argument
- ** values.
+ ** procedure spec, to leave words[] containing only the argument values.
*/
words += 2;
word_count -= 2;
- table_gen = proc->MR_sle_table_info.MR_table_gen;
- num_inputs = table_gen->MR_table_gen_num_inputs;
+ pt = proc->MR_sle_table_info.MR_table_proc;
+ num_inputs = pt->MR_pt_num_inputs;
if (word_count > num_inputs) {
fprintf(MR_mdb_out, "There are only %d input arguments.\n",
@@ -810,22 +808,22 @@
"couldn't allocate call_table_args");
}
- table_cur = proc->MR_sle_tabling_pointer;
+ table_cur = &pt->MR_pt_tablenode;
for (cur_arg = 0, filtered_cur_arg = 0; cur_arg < num_inputs; cur_arg++) {
- switch (table_gen->MR_table_gen_input_steps[cur_arg]) {
+ switch (pt->MR_pt_input_steps[cur_arg]) {
case MR_TABLE_STEP_INT:
case MR_TABLE_STEP_FLOAT:
case MR_TABLE_STEP_STRING:
- /* these are OK */
+ /* These are OK. */
call_table_args[filtered_cur_arg].MR_cta_step =
- table_gen->MR_table_gen_input_steps[filtered_cur_arg];
+ pt->MR_pt_input_steps[filtered_cur_arg];
call_table_args[filtered_cur_arg].MR_cta_valid = MR_FALSE;
call_table_args[filtered_cur_arg].MR_cta_unfiltered_arg_num =
cur_arg;
filtered_cur_arg++;
case MR_TABLE_STEP_PROMISE_IMPLIED:
- /* this argument doesn't exist in the table */
+ /* This argument doesn't exist in the table. */
break;
default:
@@ -846,8 +844,8 @@
}
/*
- ** Set up the values of the input arguments supplied on the command
- ** line, to enable us to print them out in each call table entry.
+ ** Set up the values of the input arguments supplied on the command line,
+ ** to enable us to print them out in each call table entry.
*/
for (filtered_cur_arg = 0;
@@ -911,9 +909,7 @@
fprintf(MR_mdb_out, ":\n");
break;
- case MR_EVAL_METHOD_MEMO_STRICT:
- case MR_EVAL_METHOD_MEMO_FAST_LOOSE:
- case MR_EVAL_METHOD_MEMO_SPECIFIED:
+ case MR_EVAL_METHOD_MEMO:
fprintf(MR_mdb_out, "memo table for ");
MR_print_proc_id(MR_mdb_out, proc);
fprintf(MR_mdb_out, ":\n");
@@ -1713,9 +1709,7 @@
}
break;
- case MR_EVAL_METHOD_MEMO_STRICT:
- case MR_EVAL_METHOD_MEMO_FAST_LOOSE:
- case MR_EVAL_METHOD_MEMO_SPECIFIED:
+ case MR_EVAL_METHOD_MEMO:
{
MR_Determinism detism;
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