[m-dev.] for review: move tabling builtins into new module
Fergus Henderson
fjh at cs.mu.OZ.AU
Tue Sep 19 19:27:28 AEDT 2000
For review by Zoltan.
----------
Estimated hours taken: 4
(a) Move the tabling builtins, which are currently in private_builtin.m,
into a different module which is only imported if the source contains
a tabling pragma.
(b) Improve the infrastructure for automatically importing modules to
make it easy to automatically import a module only if a certain option
is set. The idea is to eventually use this to put the simplified HLDS
representation used for declarative debugging in a module which is
only imported if the appropriate declarative debugging option is
enabled.
compiler/modules.m:
Change add_implicit_imports so that it takes the list of
items, for (a) above, and an io__state pair, for (b) above.
Change its callers to pass the new parameters.
Add a new predicate get_implicit_dependencies
(implemented using add_implicit_imports).
compiler/hlds_module.m:
compiler/module_qual.m:
Call get_implicit_dependencies rather than duplicating the code.
compiler/make_hlds.m:
compiler/hlds_module.m:
Pass the item_list to module_info_init, since it's needed by
get_implicit_dependencies.
compiler/prog_out.m:
Add new predicates mercury_table_builtin_module/1 (which
returns the name of the "table_builtin" module) and
any_mercury_builtin_module (which checks whether any of
mercury_{table,public,private}_builtin_module hold).
compiler/termination.m:
Call any_mercury_builtin_module rather than checking
for mercury_{public,private}_builtin_module.
compiler/table_gen.m:
Change the module for tabling builtins from private_builtin to
table_builtin.
compiler/hlds_pred.m:
Add table_builtin to the builtin_mod enumeration,
and change the module for tabling builtins from
private_builtin to table_builtin.
compiler/dead_proc_elim.m:
Add a comment about the treatment of builtin modules.
compiler/mode_util.m:
When stripping out builtin module qualifiers, only strip
qualifiers from "builtin:", not from "private_builtin:".
library/table_builtin.m:
library/private_builtin.m:
Move the tabling builtins from private_builtin.m
into a new module table_builtin.m.
library/library.m:
Add table_builtin.m to the list of imported modules.
(Likewise for builtin.m and private_builtin.m; it's not
strictly necessary for those, since they're implicitly
imported anyway, but importing them explicitly is clearer.)
library/io.m:
Change private_builtin to table_builtin in the call to
private_builtin__report_tabling_stats.
doc/Mmakefile:
Don't include the documentation for table_builtin.m
in the library reference manual.
Workspace: /home/pgrad/fjh/ws/hg
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.59
diff -u -d -r1.59 dead_proc_elim.m
--- compiler/dead_proc_elim.m 2000/08/09 07:46:22 1.59
+++ compiler/dead_proc_elim.m 2000/09/19 05:37:45
@@ -790,6 +790,9 @@
% Don't eliminate preds from builtin.m or
% private_builtin.m, since polymorphism.m
% needs unify/2 and friends.
+ % (Should the same apply for other builtin
+ % modules, such as table_builtin?
+ % I don't think so...)
mercury_public_builtin_module(PredModule)
;
mercury_private_builtin_module(PredModule)
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.59
diff -u -d -r1.59 hlds_module.m
--- compiler/hlds_module.m 2000/08/11 08:19:04 1.59
+++ compiler/hlds_module.m 2000/09/19 06:47:02
@@ -111,11 +111,14 @@
% Various predicates for manipulating the module_info data structure
% Create an empty module_info for a given module name (and the
- % global options).
-
-:- pred module_info_init(module_name, globals, partial_qualifier_info,
- module_info).
-:- mode module_info_init(in, in, in, out) is det.
+ % global options). The item_list is passed so that we can
+ % call get_implicit_dependencies to figure out whether to
+ % import `table_builtin', but the items are not inserted into
+ % the module_info.
+ %
+:- pred module_info_init(module_name, item_list, globals,
+ partial_qualifier_info, module_info).
+:- mode module_info_init(in, in, in, in, out) is det.
:- pred module_info_get_predicate_table(module_info, predicate_table).
:- mode module_info_get_predicate_table(in, out) is det.
@@ -502,7 +505,7 @@
% A predicate which creates an empty module
-module_info_init(Name, Globals, QualifierInfo, ModuleInfo) :-
+module_info_init(Name, Items, Globals, QualifierInfo, ModuleInfo) :-
predicate_table_init(PredicateTable),
unify_proc__init_requests(Requests),
map__init(UnifyPredMap),
@@ -525,9 +528,8 @@
map__init(SuperClassTable),
% the builtin modules are automatically imported
- mercury_public_builtin_module(PublicBuiltin),
- mercury_private_builtin_module(PrivateBuiltin),
- set__list_to_set([PublicBuiltin, PrivateBuiltin], ImportedModules),
+ get_implicit_dependencies(Items, Globals, ImportDeps, UseDeps),
+ set__list_to_set(ImportDeps `list__append` UseDeps, ImportedModules),
set__init(IndirectlyImportedModules),
assertion_table_init(AssertionTable),
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.81
diff -u -d -r1.81 hlds_pred.m
--- compiler/hlds_pred.m 2000/08/24 06:43:40 1.81
+++ compiler/hlds_pred.m 2000/09/19 07:49:59
@@ -1870,9 +1870,12 @@
;
ModuleNameType = private_builtin,
mercury_private_builtin_module(ModuleName)
+ ;
+ ModuleNameType = table_builtin,
+ mercury_table_builtin_module(ModuleName)
).
-:- type builtin_mod ---> builtin ; private_builtin.
+:- type builtin_mod ---> builtin ; private_builtin ; table_builtin.
:- pred no_type_info_builtin_2(builtin_mod::out, string::in, int::in)
is semidet.
@@ -1885,8 +1888,8 @@
no_type_info_builtin_2(private_builtin, "type_info_from_typeclass_info", 3).
no_type_info_builtin_2(private_builtin,
"unconstrained_type_info_from_typeclass_info", 3).
-no_type_info_builtin_2(private_builtin, "table_restore_any_ans", 3).
-no_type_info_builtin_2(private_builtin, "table_lookup_insert_enum", 4).
+no_type_info_builtin_2(table_builtin, "table_restore_any_ans", 3).
+no_type_info_builtin_2(table_builtin, "table_lookup_insert_enum", 4).
%-----------------------------------------------------------------------------%
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.349
diff -u -d -r1.349 make_hlds.m
--- compiler/make_hlds.m 2000/09/15 05:18:39 1.349
+++ compiler/make_hlds.m 2000/09/19 06:03:43
@@ -108,7 +108,7 @@
UndefTypes, UndefModes) -->
globals__io_get_globals(Globals),
{ mq_info_get_partial_qualifier_info(MQInfo0, PQInfo) },
- { module_info_init(Name, Globals, PQInfo, Module0) },
+ { module_info_init(Name, Items, Globals, PQInfo, Module0) },
add_item_list_decls_pass_1(Items,
item_status(local, may_be_unqualified), Module0, Module1),
globals__io_lookup_bool_option(statistics, Statistics),
Index: compiler/mode_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_util.m,v
retrieving revision 1.129
diff -u -d -r1.129 mode_util.m
--- compiler/mode_util.m 2000/09/18 11:51:32 1.129
+++ compiler/mode_util.m 2000/09/19 04:54:16
@@ -1506,9 +1506,7 @@
strip_builtin_qualifier_from_sym_name(SymName0, SymName) :-
(
SymName0 = qualified(Module, Name),
- ( mercury_public_builtin_module(Module)
- ; mercury_private_builtin_module(Module)
- )
+ mercury_public_builtin_module(Module)
->
SymName = unqualified(Name)
;
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.58
diff -u -d -r1.58 module_qual.m
--- compiler/module_qual.m 2000/09/18 11:51:34 1.58
+++ compiler/module_qual.m 2000/09/19 06:48:09
@@ -107,7 +107,8 @@
module_qual__module_qualify_items(Items0, Items, ModuleName, ReportErrors,
Info, NumErrors, UndefTypes, UndefModes) -->
- { init_mq_info(ReportErrors, Info0) },
+ globals__io_get_globals(Globals),
+ { init_mq_info(Items0, Globals, ReportErrors, Info0) },
{ collect_mq_info(Items0, Info0, Info1) },
do_module_qualify_items(Items0, Items, Info1, Info),
{ mq_info_get_type_error_flag(Info, UndefTypes) },
@@ -1387,16 +1388,15 @@
%-----------------------------------------------------------------------------%
% Access and initialisation predicates.
-:- pred init_mq_info(bool::in, mq_info::out) is det.
+:- pred init_mq_info(item_list::in, globals::in, bool::in, mq_info::out)
+ is det.
-init_mq_info(ReportErrors, Info0) :-
+init_mq_info(Items, Globals, ReportErrors, Info0) :-
term__context_init(Context),
ErrorContext = type(unqualified("") - 0) - Context,
set__init(InterfaceModules0),
- mercury_public_builtin_module(BuiltinModule),
- mercury_private_builtin_module(PrivateBuiltinModule),
- set__list_to_set([BuiltinModule, PrivateBuiltinModule],
- ImportedModules),
+ get_implicit_dependencies(Items, Globals, ImportDeps, UseDeps),
+ set__list_to_set(ImportDeps `list__append` UseDeps, ImportedModules),
id_set_init(Empty),
Info0 = mq_info(ImportedModules, Empty, Empty, Empty, Empty,
Empty, InterfaceModules0, not_exported, 0, no, no,
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.132
diff -u -d -r1.132 modules.m
--- compiler/modules.m 2000/08/09 07:47:29 1.132
+++ compiler/modules.m 2000/09/19 07:59:44
@@ -39,7 +39,7 @@
:- interface.
-:- import_module prog_data, prog_io.
+:- import_module prog_data, prog_io, globals.
:- import_module std_util, bool, list, set, io.
%-----------------------------------------------------------------------------%
@@ -432,17 +432,32 @@
:- mode generate_file_dependencies(in, di, uo) is det.
% get_dependencies(Items, ImportDeps, UseDeps).
- % Get the list of modules that a list of items depends on.
- % ImportDeps is the list of modules imported using
+ % Get the list of modules that a list of items (explicitly)
+ % depends on. ImportDeps is the list of modules imported using
% `:- import_module', UseDeps is the list of modules imported
% using `:- use_module'.
% N.B. Typically you also need to consider the module's
- % parent modules (see get_ancestors/2) and possibly
+ % implicit dependencies (see get_implicit_dependencies/3),
+ % its parent modules (see get_ancestors/2) and possibly
% also the module's child modules (see get_children/2).
+ % You may also need to consider indirect dependencies.
%
:- pred get_dependencies(item_list, list(module_name), list(module_name)).
:- mode get_dependencies(in, out, out) is det.
+ % get_implicit_dependencies(Items, Globals, ImportDeps, UseDeps):
+ % Get the list of builtin modules (e.g. "public_builtin",
+ % "private_builtin") that a list of items may implicitly
+ % depend on. ImportDeps is the list of modules which
+ % should be automatically implicitly imported as if via
+ % `:- import_module', and UseDeps is the list which should
+ % be automatically implicitly imported as if via
+ % `:- use_module'.
+ %
+:- pred get_implicit_dependencies(item_list, globals,
+ list(module_name), list(module_name)).
+:- mode get_implicit_dependencies(in, in, out, out) is det.
+
% get_ancestors(ModuleName, ParentDeps):
% ParentDeps is the list of ancestor modules for this
% module, oldest first; e.g. if the ModuleName is
@@ -491,7 +506,7 @@
:- implementation.
:- import_module llds_out, passes_aux, prog_out, prog_util, mercury_to_mercury.
-:- import_module prog_io_util, globals, options, module_qual.
+:- import_module prog_io_util, options, module_qual.
:- import_module string, map, term, varset, dir, library.
:- import_module assoc_list, relation, char, require.
@@ -549,6 +564,7 @@
mercury_std_library_module("std_util").
mercury_std_library_module("store").
mercury_std_library_module("string").
+mercury_std_library_module("table_builtin").
mercury_std_library_module("term").
mercury_std_library_module("term_io").
mercury_std_library_module("time").
@@ -1207,7 +1223,9 @@
% Add `builtin' and `private_builtin' to the
% list of imported modules
- { add_implicit_imports(IntImportedModules1, IntUsedModules1,
+ globals__io_get_globals(Globals),
+ { add_implicit_imports(Items0, Globals,
+ IntImportedModules1, IntUsedModules1,
IntImportedModules2, IntUsedModules2) },
% Process the ancestor modules
@@ -1269,7 +1287,8 @@
{ append_pseudo_decl(Module0, imported(interface), Module1) },
% Add `builtin' and `private_builtin' to the imported modules.
- { add_implicit_imports(IntImportDeps0, IntUseDeps0,
+ globals__io_get_globals(Globals),
+ { add_implicit_imports(Items0, Globals, IntImportDeps0, IntUseDeps0,
IntImportDeps1, IntUseDeps1) },
%
@@ -1380,18 +1399,40 @@
%-----------------------------------------------------------------------------%
-:- pred add_implicit_imports(list(module_name), list(module_name),
+get_implicit_dependencies(Items, Globals, ImportDeps, UseDeps) :-
+ add_implicit_imports(Items, Globals, [], [], ImportDeps, UseDeps).
+
+:- pred add_implicit_imports(item_list, globals,
+ list(module_name), list(module_name),
list(module_name), list(module_name)).
-:- mode add_implicit_imports(in, in, out, out) is det.
+:- mode add_implicit_imports(in, in, in, in, out, out) is det.
-add_implicit_imports(ImportDeps0, UseDeps0, ImportDeps, UseDeps) :-
+add_implicit_imports(Items, _Globals, ImportDeps0, UseDeps0,
+ ImportDeps, UseDeps) :-
mercury_public_builtin_module(MercuryPublicBuiltin),
mercury_private_builtin_module(MercuryPrivateBuiltin),
+ mercury_table_builtin_module(MercuryTableBuiltin),
ImportDeps = [MercuryPublicBuiltin | ImportDeps0],
- ( MercuryPrivateBuiltin = MercuryPublicBuiltin ->
- UseDeps = UseDeps0
+ UseDeps1 = [MercuryPrivateBuiltin | UseDeps0],
+ (
+ %
+ % we should include MercuryTableBuiltin iff
+ % the Items contain a tabling pragma
+ %
+ contains_tabling_pragma(Items)
+ ->
+ UseDeps = [MercuryTableBuiltin | UseDeps1]
;
- UseDeps = [MercuryPrivateBuiltin | UseDeps0]
+ UseDeps = UseDeps1
+ ).
+
+:- pred contains_tabling_pragma(item_list).
+contains_tabling_pragma([Item|Items]) :-
+ (
+ Item = pragma(Pragma) - _Context,
+ Pragma = tabled(_, _, _, _, _)
+ ;
+ contains_tabling_pragma(Items)
).
:- pred warn_if_import_self_or_ancestor(module_name, list(module_name),
@@ -2130,8 +2171,9 @@
Items, Error, ModuleName),
{ string__append(FileName, ".m", SourceFileName) },
split_into_submodules(ModuleName, Items, SubModuleList),
- { list__map(init_dependencies(SourceFileName, Error), SubModuleList,
- ModuleImportsList) },
+ globals__io_get_globals(Globals),
+ { list__map(init_dependencies(SourceFileName, Error, Globals),
+ SubModuleList, ModuleImportsList) },
{ map__init(DepsMap0) },
{ list__foldl(insert_into_deps_map, ModuleImportsList,
DepsMap0, DepsMap1) },
@@ -3312,25 +3354,28 @@
{ Items = Items0 },
split_into_submodules(ModuleName, Items, SubModuleList)
),
- { list__map(init_dependencies(FileName, Error), SubModuleList,
+ globals__io_get_globals(Globals),
+ { list__map(init_dependencies(FileName, Error, Globals), SubModuleList,
ModuleImportsList) }.
-:- pred init_dependencies(file_name, module_error,
+:- pred init_dependencies(file_name, module_error, globals,
pair(module_name, item_list), module_imports).
-:- mode init_dependencies(in, in, in, out) is det.
+:- mode init_dependencies(in, in, in, in, out) is det.
-init_dependencies(FileName, Error, ModuleName - Items, ModuleImports) :-
+init_dependencies(FileName, Error, Globals, ModuleName - Items,
+ ModuleImports) :-
get_ancestors(ModuleName, ParentDeps),
get_dependencies(Items, ImplImportDeps0, ImplUseDeps0),
- add_implicit_imports(ImplImportDeps0, ImplUseDeps0,
+ add_implicit_imports(Items, Globals, ImplImportDeps0, ImplUseDeps0,
ImplImportDeps, ImplUseDeps),
list__append(ImplImportDeps, ImplUseDeps, ImplementationDeps),
get_interface(Items, no, InterfaceItems),
get_dependencies(InterfaceItems, InterfaceImportDeps0,
InterfaceUseDeps0),
- add_implicit_imports(InterfaceImportDeps0, InterfaceUseDeps0,
+ add_implicit_imports(InterfaceItems, Globals,
+ InterfaceImportDeps0, InterfaceUseDeps0,
InterfaceImportDeps, InterfaceUseDeps),
list__append(InterfaceImportDeps, InterfaceUseDeps,
InterfaceDeps),
@@ -3838,7 +3883,8 @@
% get_dependencies(Items, IntImportDeps, IntUseDeps,
% ImpImportDeps, ImpUseDeps).
- % Get the list of modules that a list of items depends on.
+ % Get the list of modules that a list of items (explicitly)
+ % depends on.
% IntImportDeps is the list of modules imported using `:-
% import_module' in the interface, and ImpImportDeps those
% modules imported in the implementation. IntUseDeps is the
@@ -3846,9 +3892,12 @@
% interface, and ImpUseDeps those modules imported in the
% implementation.
% N.B. Typically you also need to consider the module's
- % parent modules (see get_ancestors/2) and possibly
+ % implicit dependencies (see get_implicit_dependencies/3),
+ % its parent modules (see get_ancestors/2) and possibly
% also the module's child modules (see get_children/2).
- % N.B This predicate assumes that any declaration between
+ % You may also need to consider indirect dependencies.
+ %
+ % N.B This predicate assumes that any declarations between
% the `:- module' and the first `:- interface' or
% `:- implementation' are in the implementation.
%
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.22
diff -u -d -r1.22 table_gen.m
--- compiler/table_gen.m 2000/09/18 11:51:46 1.22
+++ compiler/table_gen.m 2000/09/19 07:51:57
@@ -9,7 +9,8 @@
%
% This module transforms HLDS code to implement loop detection, memoing
% or minimal model evaluation. The transformation involves adding calls to
-% predicates defined in private_builtin.m and in mercury_tabling.c.
+% predicates defined in library/table_builtin.m and in
+% runtime/mercury_tabling.c.
%
% The loop detection transformation adds code to a procedure that allows
% early detection of infinite loops. If such loops are detected the program
@@ -1196,7 +1197,7 @@
generate_call(PredName, Args, Detism, Feature, InstMap, Module, Context,
CallGoal) :-
list__length(Args, Arity),
- mercury_private_builtin_module(BuiltinModule),
+ mercury_table_builtin_module(BuiltinModule),
module_info_get_predicate_table(Module, PredTable),
(
predicate_table_search_pred_m_n_a(PredTable,
Index: compiler/termination.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/termination.m,v
retrieving revision 1.20
diff -u -d -r1.20 termination.m
--- compiler/termination.m 2000/02/07 00:12:41 1.20
+++ compiler/termination.m 2000/09/19 05:04:02
@@ -479,9 +479,7 @@
(
special_pred_name_arity(SpecPredId0, Name, _, Arity),
pred_info_module(PredInfo, ModuleName),
- ( mercury_private_builtin_module(ModuleName)
- ; mercury_public_builtin_module(ModuleName)
- )
+ any_mercury_builtin_module(ModuleName)
->
SpecialPredId = SpecPredId0
;
Index: doc/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/Mmakefile,v
retrieving revision 1.22
diff -u -d -r1.22 Mmakefile
--- doc/Mmakefile 2000/02/17 01:15:05 1.22
+++ doc/Mmakefile 2000/09/19 07:45:06
@@ -173,6 +173,8 @@
case $$filename in \
$(LIBRARY_DIR)/private_builtin.m) \
;; \
+ $(LIBRARY_DIR)/table_builtin.m) \
+ ;; \
*) \
echo "* `basename $$filename .m`::"; \
;; \
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.205
diff -u -d -r1.205 io.m
--- library/io.m 2000/09/19 04:37:28 1.205
+++ library/io.m 2000/09/19 08:01:27
@@ -1093,6 +1093,7 @@
:- implementation.
:- import_module map, dir, term, term_io, varset, require, benchmarking, array.
:- import_module int, parser, exception.
+:- use_module table_builtin.
:- type io__state ---> io__state(c_pointer).
% Values of type `io__state' are never really used:
@@ -2539,7 +2540,7 @@
; Selector = "full_memory_stats" ->
impure report_full_memory_stats
; Selector = "tabling" ->
- impure private_builtin__table_report_statistics
+ impure table_builtin__table_report_statistics
;
string__format(
"io__report_stats: selector `%s' not understood",
Index: library/library.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/library.m,v
retrieving revision 1.49
diff -u -d -r1.49 library.m
--- library/library.m 2000/05/15 03:33:06 1.49
+++ library/library.m 2000/09/19 07:54:33
@@ -39,6 +39,8 @@
:- import_module time.
:- import_module pprint.
+:- import_module builtin, private_builtin, table_builtin.
+
% library__version must be implemented using pragma c_code,
% so we can get at the MR_VERSION and MR_FULLARCH configuration
% parameters. We can't just generate library.m from library.m.in
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.55
diff -u -d -r1.55 private_builtin.m
--- library/private_builtin.m 2000/09/18 11:52:18 1.55
+++ library/private_builtin.m 2000/09/19 08:23:17
@@ -5,13 +5,15 @@
%---------------------------------------------------------------------------%
% File: private_builtin.m.
-% Main authors: fjh, ohutch, zs.
+% Main authors: fjh, zs.
% Stability: low.
% This file is automatically imported, as if via `use_module', into every
% module. It is intended for builtins that are just implementation details,
% such as procedures that the compiler generates implicit calls to when
-% implementing polymorphism, unification, compare/3, tabling, etc.
+% implementing polymorphism, unification, compare/3, etc.
+% Note that the builtins used for tabling are in a separate module
+% (table_builtin.m).
% This module is a private part of the Mercury implementation;
% user modules should never explicitly import this module.
@@ -108,6 +110,8 @@
:- pred typed_compare(comparison_result, T1, T2).
:- mode typed_compare(uo, in, in) is det.
+ % N.B. interface continued below.
+
%-----------------------------------------------------------------------------%
:- implementation.
@@ -308,6 +312,8 @@
typeclass_info(_), int, typeclass_info(_)).
:- mode instance_constraint_from_typeclass_info(in, in, out) is det.
+ % N.B. interface continued below.
+
%-----------------------------------------------------------------------------%
:- implementation.
@@ -475,925 +481,6 @@
% the following is never executed
true
).
-
-%-----------------------------------------------------------------------------%
-
-:- interface.
-
-% 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.
-%
-% The predicates fall into three categories:
-%
-% (1) Predicates that manage the tabling of simple subgoals.
-% A subgoal is simple if its predicate is model_det or model_semi,
-% which means that its evaluation method must be something
-% other than minimal model.
-%
-% (2) Predicates that manage the tabling of model_non subgoals,
-% which usually means that its evaluation method is minimal model.
-%
-% (3) Utility predicates that are needed in the tabling of both
-% simple and nondet subgoals.
-%
-% The utility predicates that handle tries are combined lookup/insert
-% operations; if the item being searched for is not already in the trie,
-% they insert it. These predicates are used to implement both subgoal tables,
-% in which case the items inserted are input arguments of a tabled predicate,
-% and answer tables, in which case the items inserted are output arguments
-% of a tabled predicate.
-%
-% The subgoal table trie is used for detecting duplicate calls,
-% while the answer table trie is used for detecting duplicate answers.
-% However, storing answers only in the answer table trie is not sufficient,
-% for two reasons. First, while the trie encodes the values of the output
-% arguments, this encoding is not in the form of the native Mercury
-% representations of those arguments. Second, for model_non subgoals we
-% want a chronological list of answers, to allow us to separate out
-% answers we have returned already from answers we have not yet returned.
-% To handle the first problem, we save each answer not only in the
-% answer table trie but also in an answer block, which is a vector of N
-% elements, where N is the number of output arguments of the procedure
-% concerned. To handle the second problem, for model_non procedures
-% we chain these answer blocks together in a chronological list.
-%
-% For simple goals, the word at the end of the subgoal table trie is used
-% first as a status indication (of type MR_SimpletableStatus), and later on
-% as a pointer to an answer block (if the goal succeeded). This is OK, because
-% we can distinguish the two, and because an answer block pointer can be
-% associated with only one status value.
-%
-% For nondet goals, the word at the end of the subgoal table trie always
-% points to a subgoal structure, with several fields. The status of the
-% subgoal and the list of answers are two of these fields. Other fields,
-% described in runtime/mercury_tabling.h, are used in the implementation
-% of the minimal model.
-%
-% All of the predicates here with the impure declaration modify the tabling
-% structures. Because the structures are persistent through backtracking,
-% this causes the predicates to become impure. The predicates with the semipure
-% directive only examine the tabling structures, but do not modify them.
-
- % This type is used as a generic table: it can in fact represent two
- % types, either a subgoal_table or an answer_table. The subgoal_table
- % and answer_table types are differentiated by what they have at the
- % table nodes but not by the actual underlying trie structure.
-:- type ml_table.
-
- % This type is used in contexts where a node of a subgoal table is
- % expected.
-:- type ml_subgoal_table_node.
-
- % This type is used in contexts where a node of an answer table is
- % expected.
-:- type ml_answer_table_node.
-
- % This type is used in contexts where an answer slot is expected.
-:- type ml_answer_slot.
-
- % This type is used in contexts where an answer block is expected.
-:- type ml_answer_block.
-
- % These equivalences should be local to private_builtin. However,
- % at the moment table_gen.m assumes that it can use a single variable
- % sometimes as an ml_table and other times as an ml_subgoal_table_node
- % (e.g. by giving the output of table_lookup_insert_int as input to
- % table_have_all_ans). The proper fix would be for table_gen.m to
- % use additional variables and insert unsafe casts. However, this
- % would require significant work for no real gain, so for now
- % we fix the problem by exposing the equivalences to code generated
- % by table_gen.m.
-:- type ml_subgoal_table_node == ml_table.
-:- type ml_answer_table_node == ml_table.
-:- type ml_answer_slot == ml_table.
-:- type ml_answer_block == ml_table.
-:- type ml_table == c_pointer.
-
-:- implementation.
-
-% This equivalence should be private. However, polymorphism gets an
-% internal error when compiling tests/tabling/boyer.m if it is.
-% :- type ml_table == c_pointer.
-
-%-----------------------------------------------------------------------------%
-
-:- interface.
-
-%
-% Predicates that manage the tabling of simple subgoals.
-%
-
- % Return true if the subgoal represented by the given table has an
- % answer.
-:- semipure pred table_simple_is_complete(ml_subgoal_table_node::in)
- is semidet.
-
- % Return true if the subgoal represented by the given table has a
- % true answer.
-:- semipure pred table_simple_has_succeeded(ml_subgoal_table_node::in)
- is semidet.
-
- % Return true if the subgoal represented by the given table has
- % failed.
-:- semipure pred table_simple_has_failed(ml_subgoal_table_node::in) is semidet.
-
- % Return true if the subgoal represented by the given table is
- % currently being evaluated (working on an answer).
-:- semipure pred table_simple_is_active(ml_subgoal_table_node::in) is semidet.
-
- % Return false if the subgoal represented by the given table is
- % currently being evaluated (working on an answer).
-:- semipure pred table_simple_is_inactive(ml_subgoal_table_node::in)
- is semidet.
-
- % Save the fact the the subgoal has succeeded in the given table.
-:- impure pred table_simple_mark_as_succeeded(ml_subgoal_table_node::in)
- is det.
-
- % Save the fact the the subgoal has failed in the given table.
-:- impure pred table_simple_mark_as_failed(ml_subgoal_table_node::in) is det.
-
- % Mark the subgoal represented by the given table as currently
- % being evaluated (working on an answer).
-:- impure pred table_simple_mark_as_active(ml_subgoal_table_node::in) is det.
-
- % Mark the subgoal represented by the given table as currently
- % not being evaluated (working on an answer).
-:- impure pred table_simple_mark_as_inactive(ml_subgoal_table_node::in) is det.
-
-%-----------------------------------------------------------------------------%
-
-:- implementation.
-
-:- pragma c_code(table_simple_is_complete(T::in), will_not_call_mercury, "
- MR_TrieNode table;
-
- table = (MR_TrieNode) T;
-
-#ifdef MR_TABLE_DEBUG
- if (MR_tabledebug) {
- printf(""checking if simple %p is complete: %ld (%lx)\\n"",
- table, (long) table->MR_simpletable_status,
- (long) table->MR_simpletable_status);
- }
-#endif
- SUCCESS_INDICATOR =
- ((table->MR_simpletable_status == MR_SIMPLETABLE_FAILED)
- || (table->MR_simpletable_status >= MR_SIMPLETABLE_SUCCEEDED));
-").
-
-:- pragma c_code(table_simple_has_succeeded(T::in), will_not_call_mercury, "
- MR_TrieNode table;
-
- table = (MR_TrieNode) T;
-
-#ifdef MR_TABLE_DEBUG
- if (MR_tabledebug) {
- printf(""checking if simple %p is succeeded: %ld (%lx)\\n"",
- table, (long) table->MR_simpletable_status,
- (long) table->MR_simpletable_status);
- }
-#endif
- SUCCESS_INDICATOR =
- (table->MR_simpletable_status >= MR_SIMPLETABLE_SUCCEEDED);
-").
-
-:- pragma c_code(table_simple_has_failed(T::in), will_not_call_mercury, "
- MR_TrieNode table;
-
- table = (MR_TrieNode) T;
-
-#ifdef MR_TABLE_DEBUG
- if (MR_tabledebug) {
- printf(""checking if simple %p is failed: %ld (%lx)\\n"",
- table, (long) table->MR_simpletable_status,
- (long) table->MR_simpletable_status);
- }
-#endif
- SUCCESS_INDICATOR =
- (table->MR_simpletable_status == MR_SIMPLETABLE_FAILED);
-").
-
-:- pragma c_code(table_simple_is_active(T::in), will_not_call_mercury, "
- MR_TrieNode table;
-
- table = (MR_TrieNode) T;
-
-#ifdef MR_TABLE_DEBUG
- if (MR_tabledebug) {
- printf(""checking if simple %p is active: %ld (%lx)\\n"",
- table, (long) table->MR_simpletable_status,
- (long) table->MR_simpletable_status);
- }
-#endif
- SUCCESS_INDICATOR =
- (table->MR_simpletable_status == MR_SIMPLETABLE_WORKING);
-").
-
-:- pragma c_code(table_simple_is_inactive(T::in), will_not_call_mercury, "
- MR_TrieNode table;
-
- table = (MR_TrieNode) T;
-
-#ifdef MR_TABLE_DEBUG
- if (MR_tabledebug) {
- printf(""checking if simple %p is inactive: %ld (%lx)\\n"",
- table, (long) table->MR_simpletable_status,
- (long) table->MR_simpletable_status);
- }
-#endif
- SUCCESS_INDICATOR =
- (table->MR_simpletable_status != MR_SIMPLETABLE_WORKING);
-").
-
-:- pragma c_code(table_simple_mark_as_succeeded(T::in), will_not_call_mercury, "
- MR_TrieNode table;
-
- table = (MR_TrieNode) T;
-
-#ifdef MR_TABLE_DEBUG
- if (MR_tabledebug) {
- printf(""marking %p as succeeded\\n"", table);
- }
-#endif
- table->MR_simpletable_status = MR_SIMPLETABLE_SUCCEEDED;
-").
-
-:- pragma c_code(table_simple_mark_as_failed(T::in), will_not_call_mercury, "
- MR_TrieNode table;
-
- table = (MR_TrieNode) T;
-
-#ifdef MR_TABLE_DEBUG
- if (MR_tabledebug) {
- printf(""marking %p as failed\\n"", table);
- }
-#endif
- table->MR_simpletable_status = MR_SIMPLETABLE_FAILED;
-").
-
-:- pragma c_code(table_simple_mark_as_active(T::in), will_not_call_mercury, "
- MR_TrieNode table;
-
- table = (MR_TrieNode) T;
-
-#ifdef MR_TABLE_DEBUG
- if (MR_tabledebug) {
- printf(""marking %p as working\\n"", table);
- }
-#endif
- table->MR_simpletable_status = MR_SIMPLETABLE_WORKING;
-").
-
-:- pragma c_code(table_simple_mark_as_inactive(T::in), will_not_call_mercury, "
- MR_TrieNode table;
-
- table = (MR_TrieNode) T;
-
-#ifdef MR_TABLE_DEBUG
- if (MR_tabledebug) {
- printf(""marking %p as uninitialized\\n"", table);
- }
-#endif
- table->MR_simpletable_status = MR_SIMPLETABLE_UNINITIALIZED;
-").
-
-%-----------------------------------------------------------------------------%
-
-:- interface.
-
-%
-% Predicates that manage the tabling of model_non subgoals.
-%
-
- % Save the information that will be needed later about this
- % nondet subgoal in a data structure. If we have already seen
- % this subgoal before, do nothing.
-:- impure pred table_nondet_setup(ml_subgoal_table_node::in,
- ml_subgoal_table_node::out) is det.
-
- % Save the state of the current subgoal and fail. Sometime later,
- % when the subgoal has some solutions, table_nondet_resume will
- % restore the saved state. At the time, table_nondet_suspend will
- % succeed, and return an answer block as its second argument.
-:- impure pred table_nondet_suspend(ml_subgoal_table_node::in,
- ml_answer_block::out) is nondet.
-
- % Resume all suspended subgoal calls. This predicate will resume each
- % of the suspended subgoals that depend on it in turn until it reaches
- % a fixed point, at which all depended suspended subgoals have had
- % all available answers returned to them.
-:- impure pred table_nondet_resume(ml_subgoal_table_node::in) is det.
-
- % Succeed if we have finished generating all answers for
- % the given nondet subgoal.
-:- semipure pred table_nondet_is_complete(ml_subgoal_table_node::in)
- is semidet.
-
- % Succeed if the given nondet subgoal is active,
- % i.e. the process of computing all its answers is not yet complete.
-:- semipure pred table_nondet_is_active(ml_subgoal_table_node::in) is semidet.
-
- % Mark a table as being active.
-:- impure pred table_nondet_mark_as_active(ml_subgoal_table_node::in) is det.
-
- % Return the table of answers already return to the given nondet
- % table.
-:- impure pred table_nondet_get_ans_table(ml_subgoal_table_node::in,
- ml_table::out) is det.
-
- % If the answer represented by the given answer table
- % has not been generated before by this subgoal,
- % succeed and remember the answer as having been generated.
- % If the answer has been generated before, fail.
-:- impure pred table_nondet_answer_is_not_duplicate(ml_answer_table_node::in)
- is semidet.
-
- % Create a new slot in the answer list.
-:- impure pred table_nondet_new_ans_slot(ml_subgoal_table_node::in,
- ml_answer_slot::out) is det.
-
- % Return all of the answer blocks stored in the given table.
-:- semipure pred table_nondet_return_all_ans(ml_subgoal_table_node::in,
- ml_answer_block::out) is nondet.
-:- semipure pred table_multi_return_all_ans(ml_subgoal_table_node::in,
- ml_answer_block::out) is multi.
-
-%-----------------------------------------------------------------------------%
-
-:- implementation.
-
-:- pragma c_code(table_nondet_setup(T0::in, T::out), will_not_call_mercury, "
-#ifndef MR_USE_MINIMAL_MODEL
- MR_fatal_error(""minimal model code entered when not enabled"");
-#else
-#ifdef MR_THREAD_SAFE
-#error ""Sorry, not yet implemented: mixing minimal model tabling and threads""
-#endif
- MR_TrieNode table;
-
- table = (MR_TrieNode) T0;
-
- /*
- ** Initialize the subgoal if this is the first time we see it.
- ** If the subgoal structure already exists but is marked inactive,
- ** then it was left by a previous generator that couldn't
- ** complete the evaluation of the subgoal due to a commit.
- ** In that case, we want to forget all about the old generator.
- */
-
- if (table->MR_subgoal == NULL) {
- MR_Subgoal *subgoal;
-
- subgoal = MR_TABLE_NEW(MR_Subgoal);
-
- subgoal->status = MR_SUBGOAL_INACTIVE;
- subgoal->leader = NULL;
- subgoal->followers = MR_TABLE_NEW(MR_SubgoalListNode);
- subgoal->followers->item = subgoal;
- subgoal->followers->next = NULL;
- subgoal->followers_tail = &(subgoal->followers->next);
- subgoal->answer_table = (Word) NULL;
- subgoal->num_ans = 0;
- subgoal->answer_list = NULL;
- subgoal->answer_list_tail = &subgoal->answer_list;
- subgoal->consumer_list = NULL;
- subgoal->consumer_list_tail = &subgoal->consumer_list;
-
-#ifdef MR_TABLE_DEBUG
- if (MR_tabledebug) {
- printf(""setting up table %p -> %p, answer slot %p\\n"",
- table, subgoal, subgoal->answer_list_tail);
- }
-
- if (MR_maxfr != MR_curfr) {
- MR_fatal_error(
- ""MR_maxfr != MR_curfr at table setup\\n"");
- }
-#endif
-#ifdef MR_HIGHLEVEL_CODE
- MR_fatal_error(""sorry, not implemented: ""
- ""minimal_model tabling with --high-level-code"");
-#else
- subgoal->generator_maxfr = MR_prevfr_slot(MR_maxfr);
- subgoal->generator_sp = MR_sp;
-#endif
- table->MR_subgoal = subgoal;
- }
- T = T0;
-#endif /* MR_USE_MINIMAL_MODEL */
-").
-
- % The definitions of these two predicates are in the runtime system,
- % in runtime/mercury_tabling.c.
-:- external(table_nondet_suspend/2).
-:- external(table_nondet_resume/1).
-
-:- pragma c_code(table_nondet_is_complete(T::in),"
-#ifdef MR_USE_MINIMAL_MODEL
- MR_TrieNode table;
-
- table = (MR_TrieNode) T;
-
- SUCCESS_INDICATOR = (table->MR_subgoal->status == MR_SUBGOAL_COMPLETE);
-#else
- MR_fatal_error(""minimal model code entered when not enabled"");
-#endif
-").
-
-:- pragma c_code(table_nondet_is_active(T::in), will_not_call_mercury, "
-#ifdef MR_USE_MINIMAL_MODEL
- MR_TrieNode table;
-
- table = (MR_TrieNode) T;
-
- SUCCESS_INDICATOR = (table->MR_subgoal->status == MR_SUBGOAL_ACTIVE);
-#else
- MR_fatal_error(""minimal model code entered when not enabled"");
-#endif
-").
-
-:- pragma c_code(table_nondet_mark_as_active(T::in), will_not_call_mercury, "
-#ifdef MR_USE_MINIMAL_MODEL
- MR_TrieNode table;
-
- table = (MR_TrieNode) T;
-
- MR_push_generator(MR_curfr, table);
- MR_register_generator_ptr(table);
- table->MR_subgoal->status = MR_SUBGOAL_ACTIVE;
-#else
- MR_fatal_error(""minimal model code entered when not enabled"");
-#endif
-").
-
-:- pragma c_code(table_nondet_get_ans_table(T::in, AT::out),
- will_not_call_mercury, "
-#ifdef MR_USE_MINIMAL_MODEL
- MR_TrieNode table;
-
- table = (MR_TrieNode) T;
-
- AT = (Word) &(table->MR_subgoal->answer_table);
-#else
- MR_fatal_error(""minimal model code entered when not enabled"");
-#endif
-").
-
-:- pragma c_code(table_nondet_answer_is_not_duplicate(T::in),
- will_not_call_mercury, "
-#ifndef MR_USE_MINIMAL_MODEL
- MR_fatal_error(""minimal model code entered when not enabled"");
-#else
- MR_TrieNode table;
- bool is_new_answer;
-
- table = (MR_TrieNode) T;
-
-#ifdef MR_TABLE_DEBUG
- if (MR_tabledebug) {
- printf(""checking if %p is a duplicate answer: %ld\\n"",
- table, (long) table->MR_integer);
- }
-#endif
-
- is_new_answer = (table->MR_integer == 0);
- table->MR_integer = 1; /* any nonzero value will do */
- SUCCESS_INDICATOR = is_new_answer;
-#endif
-").
-
-:- pragma c_code(table_nondet_new_ans_slot(T::in, Slot::out),
- will_not_call_mercury, "
-#ifndef MR_USE_MINIMAL_MODEL
- MR_fatal_error(""minimal model code entered when not enabled"");
-#else
- MR_TrieNode table;
- MR_Subgoal *subgoal;
- MR_AnswerListNode *answer_node;
-
- table = (MR_TrieNode) T;
- subgoal = table->MR_subgoal;
- subgoal->num_ans++;
-
- /*
- **
- ** We fill in the answer_data slot with a dummy value.
- ** This slot will be filled in by the next piece of code
- ** to be executed after we return, which is why we return its address.
- */
-
- answer_node = MR_TABLE_NEW(MR_AnswerListNode);
- answer_node->answer_num = subgoal->num_ans;
- answer_node->answer_data.MR_integer = 0;
- answer_node->next_answer = NULL;
-
-#ifdef MR_TABLE_DEBUG
- if (MR_tabledebug) {
- printf(""new answer slot %d at %p(%p), storing into %p\\n"",
- subgoal->num_ans, answer_node,
- &answer_node->answer_data, subgoal->answer_list_tail);
- }
-#endif
-
- *(subgoal->answer_list_tail) = answer_node;
- subgoal->answer_list_tail = &(answer_node->next_answer);
-
- Slot = (Word) &(answer_node->answer_data);
-#endif
-").
-
-/*
-** Note that the code for this is identical to the code for
-** table_multi_return_all_ans/2 (below).
-** Any changes to this code should also be made there.
-*/
-:- pragma c_code(table_nondet_return_all_ans(T::in, A::out),
- will_not_call_mercury,
- local_vars("
-#ifdef MR_USE_MINIMAL_MODEL
- MR_AnswerList cur_node;
-#else
- /* ensure local var struct is non-empty */
- char bogus;
-#endif
- "),
- first_code("
-#ifdef MR_USE_MINIMAL_MODEL
- MR_TrieNode table;
-
- table = (MR_TrieNode) T;
- LOCALS->cur_node = table->MR_subgoal->answer_list;
-
- #ifdef MR_TABLE_DEBUG
- if (MR_tabledebug) {
- printf(""restoring all answers in %p -> %p\\n"",
- table, table->MR_subgoal);
- }
- #endif
-#endif
- "),
- retry_code("
- "),
- shared_code("
-#ifdef MR_USE_MINIMAL_MODEL
- if (LOCALS->cur_node == NULL) {
- FAIL;
- } else {
- A = (Word) &LOCALS->cur_node->answer_data;
- LOCALS->cur_node = LOCALS->cur_node->next_answer;
- SUCCEED;
- }
-#else
- MR_fatal_error(""minimal model code entered when not enabled"");
-#endif
- ")
-).
-
-/*
-** Note that the code for this is identical to the code for
-** table_nondet_return_all_ans/2 (above).
-** Any changes to this code should also be made there.
-*/
-:- pragma c_code(table_multi_return_all_ans(T::in, A::out),
- will_not_call_mercury,
- local_vars("
-#ifdef MR_USE_MINIMAL_MODEL
- MR_AnswerList cur_node;
-#else
- /* ensure local var struct is non-empty */
- char bogus;
-#endif
- "),
- first_code("
-#ifdef MR_USE_MINIMAL_MODEL
- MR_TrieNode table;
-
- table = (MR_TrieNode) T;
- LOCALS->cur_node = table->MR_subgoal->answer_list;
-
- #ifdef MR_TABLE_DEBUG
- if (MR_tabledebug) {
- printf(""restoring all answers in %p -> %p\\n"",
- table, table->MR_subgoal);
- }
- #endif
-#endif
- "),
- retry_code("
- "),
- shared_code("
-#ifdef MR_USE_MINIMAL_MODEL
- if (LOCALS->cur_node == NULL) {
- FAIL;
- } else {
- A = (Word) &LOCALS->cur_node->answer_data;
- LOCALS->cur_node = LOCALS->cur_node->next_answer;
- SUCCEED;
- }
-#else
- MR_fatal_error(""minimal model code entered when not enabled"");
-#endif
- ")
-).
-%-----------------------------------------------------------------------------%
-
-:- interface.
-
-%
-% Utility predicates that are needed in the tabling of both
-% simple and nondet subgoals.
-%
-
-%
-% The following table_lookup_insert... predicates lookup or insert the second
-% argument into the trie pointed to by the first argument. The value returned
-% is a pointer to the leaf of the trie reached by the lookup. From the
-% returned leaf another trie may be connected.
-%
- % Lookup or insert an integer in the given table.
-:- impure pred table_lookup_insert_int(ml_table::in, int::in, ml_table::out)
- is det.
-
- % Lookup or insert a character in the given trie.
-:- impure pred table_lookup_insert_char(ml_table::in, character::in,
- ml_table::out) is det.
-
- % Lookup or insert a string in the given trie.
-:- impure pred table_lookup_insert_string(ml_table::in, string::in,
- ml_table::out) is det.
-
- % Lookup or insert a float in the current trie.
-:- impure pred table_lookup_insert_float(ml_table::in, float::in,
- ml_table::out) is det.
-
- % Lookup or inert an enumeration type in the given trie.
-:- impure pred table_lookup_insert_enum(ml_table::in, int::in, T::in,
- ml_table::out) is det.
-
- % Lookup or insert a monomorphic user defined type in the given trie.
-:- impure pred table_lookup_insert_user(ml_table::in, T::in, ml_table::out)
- is det.
-
- % Lookup or insert a polymorphic user defined type in the given trie.
-:- impure pred table_lookup_insert_poly(ml_table::in, T::in, ml_table::out)
- is det.
-
- % Save an integer answer in the given answer block at the given
- % offset.
-:- impure pred table_save_int_ans(ml_answer_block::in, int::in, int::in)
- is det.
-
- % Save a character answer in the given answer block at the given
- % offset.
-:- impure pred table_save_char_ans(ml_answer_block::in, int::in, character::in)
- is det.
-
- % Save a string answer in the given answer block at the given
- % offset.
-:- impure pred table_save_string_ans(ml_answer_block::in, int::in, string::in)
- is det.
-
- % Save a float answer in the given answer block at the given
- % offset.
-:- impure pred table_save_float_ans(ml_answer_block::in, int::in, float::in)
- is det.
-
- % Save any type of answer in the given answer block at the given
- % offset.
-:- impure pred table_save_any_ans(ml_answer_block::in, int::in, T::in) is det.
-
- % Restore an integer answer from the given answer block at the
- % given offset.
-:- semipure pred table_restore_int_ans(ml_answer_block::in, int::in, int::out)
- is det.
-
- % Restore a character answer from the given answer block at the
- % given offset.
-:- semipure pred table_restore_char_ans(ml_answer_block::in, int::in,
- character::out) is det.
-
- % Restore a string answer from the given answer block at the
- % given offset.
-:- semipure pred table_restore_string_ans(ml_answer_block::in, int::in,
- string::out) is det.
-
- % Restore a float answer from the given answer block at the
- % given offset.
-:- semipure pred table_restore_float_ans(ml_answer_block::in, int::in,
- float::out) is det.
-
- % Restore any type of answer from the given answer block at the
- % given offset.
-:- semipure pred table_restore_any_ans(ml_answer_block::in, int::in, T::out)
- is det.
-
- % Report an error message about the current subgoal looping.
-:- pred table_loopcheck_error(string::in) is erroneous.
-
- % Create an answer block with the given number of slots and add it
- % to the given table.
-:- impure pred table_create_ans_block(ml_subgoal_table_node::in, int::in,
- ml_answer_block::out) is det.
-
- % Report statistics on the operation of the tabling system to stderr.
-:- impure pred table_report_statistics is det.
-
-%-----------------------------------------------------------------------------%
-
-:- implementation.
-
-:- pragma c_header_code("
-
-#include ""mercury_misc.h"" /* for MR_fatal_error(); */
-#include ""mercury_type_info.h"" /* for MR_TypeCtorInfo_Struct; */
-#include ""mercury_tabling.h"" /* for MR_TrieNode, etc. */
-
-extern MR_STATIC_CODE_CONST struct MR_TypeCtorInfo_Struct
- mercury_data___type_ctor_info_int_0;
-extern MR_STATIC_CODE_CONST struct MR_TypeCtorInfo_Struct
- mercury_data___type_ctor_info_string_0;
-extern MR_STATIC_CODE_CONST struct MR_TypeCtorInfo_Struct
- mercury_data___type_ctor_info_float_0;
-extern MR_STATIC_CODE_CONST struct MR_TypeCtorInfo_Struct
- mercury_data___type_ctor_info_character_0;
-
-").
-
-:- pragma c_code(table_lookup_insert_int(T0::in, I::in, T::out),
- will_not_call_mercury, "
- MR_TrieNode table0, table;
-
- table0 = (MR_TrieNode) T0;
- MR_DEBUG_NEW_TABLE_INT(table, table0, (Integer) I);
- T = (Word) table;
-").
-
-:- pragma c_code(table_lookup_insert_char(T0::in, C::in, T::out),
- will_not_call_mercury, "
- MR_TrieNode table0, table;
-
- table0 = (MR_TrieNode) T0;
- MR_DEBUG_NEW_TABLE_CHAR(table, table0, (Integer) C);
- T = (Word) table;
-").
-
-:- pragma c_code(table_lookup_insert_string(T0::in, S::in, T::out),
- will_not_call_mercury, "
- MR_TrieNode table0, table;
-
- table0 = (MR_TrieNode) T0;
- MR_DEBUG_NEW_TABLE_STRING(table, table0, (String) S);
- T = (Word) table;
-").
-
-:- pragma c_code(table_lookup_insert_float(T0::in, F::in, T::out),
- will_not_call_mercury, "
- MR_TrieNode table0, table;
-
- table0 = (MR_TrieNode) T0;
- MR_DEBUG_NEW_TABLE_FLOAT(table, table0, F);
- T = (Word) table;
-").
-
-:- pragma c_code(table_lookup_insert_enum(T0::in, R::in, V::in, T::out),
- will_not_call_mercury, "
- MR_TrieNode table0, table;
-
- table0 = (MR_TrieNode) T0;
- MR_DEBUG_NEW_TABLE_ENUM(table, table0, R, V);
- T = (Word) table;
-").
-
-:- pragma c_code(table_lookup_insert_user(T0::in, V::in, T::out),
- will_not_call_mercury, "
- MR_TrieNode table0, table;
-
- table0 = (MR_TrieNode) T0;
- MR_DEBUG_NEW_TABLE_ANY(table, table0, (MR_TypeInfo) TypeInfo_for_T, V);
- T = (Word) table;
-").
-
-:- pragma c_code(table_lookup_insert_poly(T0::in, V::in, T::out),
- will_not_call_mercury, "
- MR_TrieNode table0, table;
-
- table0 = (MR_TrieNode) T0;
- MR_DEBUG_NEW_TABLE_ANY(table, table0, (MR_TypeInfo) TypeInfo_for_T, V);
- T = (Word) table;
-").
-
-:- pragma c_code(table_save_int_ans(T::in, Offset::in, I::in),
- will_not_call_mercury, "
- MR_TrieNode table;
-
- table = (MR_TrieNode) T;
- MR_TABLE_SAVE_ANSWER(table, Offset, I,
- &mercury_data___type_ctor_info_int_0);
-").
-
-:- pragma c_code(table_save_char_ans(T::in, Offset::in, C::in),
- will_not_call_mercury, "
- MR_TrieNode table;
-
- table = (MR_TrieNode) T;
- MR_TABLE_SAVE_ANSWER(table, Offset, C,
- &mercury_data___type_ctor_info_character_0);
-").
-
-:- pragma c_code(table_save_string_ans(T::in, Offset::in, S::in),
- will_not_call_mercury, "
- MR_TrieNode table;
-
- table = (MR_TrieNode) T;
- MR_TABLE_SAVE_ANSWER(table, Offset, (Word) S,
- &mercury_data___type_ctor_info_string_0);
-").
-
-:- pragma c_code(table_save_float_ans(T::in, Offset::in, F::in),
- will_not_call_mercury, "
- MR_TrieNode table;
-
- table = (MR_TrieNode) T;
-#ifdef MR_HIGHLEVEL_CODE
- MR_TABLE_SAVE_ANSWER(table, Offset,
- (Word) MR_box_float(F),
- &mercury_data___type_ctor_info_float_0);
-#else
- MR_TABLE_SAVE_ANSWER(table, Offset,
- float_to_word(F),
- &mercury_data___type_ctor_info_float_0);
-#endif
-").
-
-:- pragma c_code(table_save_any_ans(T::in, Offset::in, V::in),
- will_not_call_mercury, "
- MR_TrieNode table;
-
- table = (MR_TrieNode) T;
- MR_TABLE_SAVE_ANSWER(table, Offset, V, TypeInfo_for_T);
-").
-
-:- pragma c_code(table_restore_int_ans(T::in, Offset::in, I::out),
- will_not_call_mercury, "
- MR_TrieNode table;
-
- table = (MR_TrieNode) T;
- I = (Integer) MR_TABLE_GET_ANSWER(table, Offset);
-").
-
-:- pragma c_code(table_restore_char_ans(T::in, Offset::in, C::out),
- will_not_call_mercury, "
- MR_TrieNode table;
-
- table = (MR_TrieNode) T;
- C = (Char) MR_TABLE_GET_ANSWER(table, Offset);
-").
-
-:- pragma c_code(table_restore_string_ans(T::in, Offset::in, S::out),
- will_not_call_mercury, "
- MR_TrieNode table;
-
- table = (MR_TrieNode) T;
- S = (String) MR_TABLE_GET_ANSWER(table, Offset);
-").
-
-:- pragma c_code(table_restore_float_ans(T::in, Offset::in, F::out),
- will_not_call_mercury, "
- MR_TrieNode table;
-
- table = (MR_TrieNode) T;
-#ifdef MR_HIGHLEVEL_CODE
- F = MR_unbox_float(MR_TABLE_GET_ANSWER(table, Offset));
-#else
- F = word_to_float(MR_TABLE_GET_ANSWER(table, Offset));
-#endif
-").
-
-:- pragma c_code(table_restore_any_ans(T::in, Offset::in, V::out),
- will_not_call_mercury, "
- MR_TrieNode table;
-
- table = (MR_TrieNode) T;
- V = (Word) MR_TABLE_GET_ANSWER(table, Offset);
-").
-
-:- pragma c_code(table_create_ans_block(T0::in, Size::in, T::out),
- will_not_call_mercury, "
- MR_TrieNode table0;
-
- table0 = (MR_TrieNode) T0;
- MR_TABLE_CREATE_ANSWER_BLOCK(table0, Size);
- T = T0;
-").
-
-table_loopcheck_error(Message) :-
- error(Message).
-
-:- pragma c_code(table_report_statistics, will_not_call_mercury, "
- MR_table_report_statistics(stderr);
-").
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: library/table_builtin.m
===================================================================
RCS file: table_builtin.m
diff -N table_builtin.m
--- /dev/null Thu Mar 30 14:06:13 2000
+++ table_builtin.m Tue Sep 19 19:09:19 2000
@@ -0,0 +1,955 @@
+%---------------------------------------------------------------------------%
+% Copyright (C) 1998-2000 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.
+%---------------------------------------------------------------------------%
+
+% File: table_builtin.m.
+% Main authors: fjh, ohutch, zs.
+% Stability: low.
+
+% This file is automatically imported, as if via `use_module', into every
+% module that contains a tabling pragma (`pragma memo', `pragma loopcheck',
+% or `pragma minimal_model'). It is intended for the builtin procedures
+% that the compiler generates implicit calls to when implementing tabling.
+% This is separated from private_builtin.m, partly for modularity, but
+% mostly to improve compilation speed for programs that don't use tabling.
+
+% This module is a private part of the Mercury implementation;
+% user modules should never explicitly import this module.
+% The interface for this module does not get included in the
+% Mercury library reference manual.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- module table_builtin.
+
+%-----------------------------------------------------------------------------%
+
+:- interface.
+
+% 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.
+%
+% The predicates fall into three categories:
+%
+% (1) Predicates that manage the tabling of simple subgoals.
+% A subgoal is simple if its predicate is model_det or model_semi,
+% which means that its evaluation method must be something
+% other than minimal model.
+%
+% (2) Predicates that manage the tabling of model_non subgoals,
+% which usually means that its evaluation method is minimal model.
+%
+% (3) Utility predicates that are needed in the tabling of both
+% simple and nondet subgoals.
+%
+% The utility predicates that handle tries are combined lookup/insert
+% operations; if the item being searched for is not already in the trie,
+% they insert it. These predicates are used to implement both subgoal tables,
+% in which case the items inserted are input arguments of a tabled predicate,
+% and answer tables, in which case the items inserted are output arguments
+% of a tabled predicate.
+%
+% The subgoal table trie is used for detecting duplicate calls,
+% while the answer table trie is used for detecting duplicate answers.
+% However, storing answers only in the answer table trie is not sufficient,
+% for two reasons. First, while the trie encodes the values of the output
+% arguments, this encoding is not in the form of the native Mercury
+% representations of those arguments. Second, for model_non subgoals we
+% want a chronological list of answers, to allow us to separate out
+% answers we have returned already from answers we have not yet returned.
+% To handle the first problem, we save each answer not only in the
+% answer table trie but also in an answer block, which is a vector of N
+% elements, where N is the number of output arguments of the procedure
+% concerned. To handle the second problem, for model_non procedures
+% we chain these answer blocks together in a chronological list.
+%
+% For simple goals, the word at the end of the subgoal table trie is used
+% first as a status indication (of type MR_SimpletableStatus), and later on
+% as a pointer to an answer block (if the goal succeeded). This is OK, because
+% we can distinguish the two, and because an answer block pointer can be
+% associated with only one status value.
+%
+% For nondet goals, the word at the end of the subgoal table trie always
+% points to a subgoal structure, with several fields. The status of the
+% subgoal and the list of answers are two of these fields. Other fields,
+% described in runtime/mercury_tabling.h, are used in the implementation
+% of the minimal model.
+%
+% All of the predicates here with the impure declaration modify the tabling
+% structures. Because the structures are persistent through backtracking,
+% this causes the predicates to become impure. The predicates with the semipure
+% directive only examine the tabling structures, but do not modify them.
+
+ % This type is used as a generic table: it can in fact represent two
+ % types, either a subgoal_table or an answer_table. The subgoal_table
+ % and answer_table types are differentiated by what they have at the
+ % table nodes but not by the actual underlying trie structure.
+:- type ml_table.
+
+ % This type is used in contexts where a node of a subgoal table is
+ % expected.
+:- type ml_subgoal_table_node.
+
+ % This type is used in contexts where a node of an answer table is
+ % expected.
+:- type ml_answer_table_node.
+
+ % This type is used in contexts where an answer slot is expected.
+:- type ml_answer_slot.
+
+ % This type is used in contexts where an answer block is expected.
+:- type ml_answer_block.
+
+ % These equivalences should be local to private_builtin. However,
+ % at the moment table_gen.m assumes that it can use a single variable
+ % sometimes as an ml_table and other times as an ml_subgoal_table_node
+ % (e.g. by giving the output of table_lookup_insert_int as input to
+ % table_have_all_ans). The proper fix would be for table_gen.m to
+ % use additional variables and insert unsafe casts. However, this
+ % would require significant work for no real gain, so for now
+ % we fix the problem by exposing the equivalences to code generated
+ % by table_gen.m.
+:- type ml_subgoal_table_node == ml_table.
+:- type ml_answer_table_node == ml_table.
+:- type ml_answer_slot == ml_table.
+:- type ml_answer_block == ml_table.
+:- type ml_table == c_pointer.
+
+ % N.B. interface continued below
+
+:- implementation.
+
+% This equivalence should be private. However, polymorphism gets an
+% internal error when compiling tests/tabling/boyer.m if it is.
+% :- type ml_table == c_pointer.
+
+%-----------------------------------------------------------------------------%
+
+:- interface.
+
+%
+% Predicates that manage the tabling of simple subgoals.
+%
+
+ % Return true if the subgoal represented by the given table has an
+ % answer.
+:- semipure pred table_simple_is_complete(ml_subgoal_table_node::in)
+ is semidet.
+
+ % Return true if the subgoal represented by the given table has a
+ % true answer.
+:- semipure pred table_simple_has_succeeded(ml_subgoal_table_node::in)
+ is semidet.
+
+ % Return true if the subgoal represented by the given table has
+ % failed.
+:- semipure pred table_simple_has_failed(ml_subgoal_table_node::in) is semidet.
+
+ % Return true if the subgoal represented by the given table is
+ % currently being evaluated (working on an answer).
+:- semipure pred table_simple_is_active(ml_subgoal_table_node::in) is semidet.
+
+ % Return false if the subgoal represented by the given table is
+ % currently being evaluated (working on an answer).
+:- semipure pred table_simple_is_inactive(ml_subgoal_table_node::in)
+ is semidet.
+
+ % Save the fact the the subgoal has succeeded in the given table.
+:- impure pred table_simple_mark_as_succeeded(ml_subgoal_table_node::in)
+ is det.
+
+ % Save the fact the the subgoal has failed in the given table.
+:- impure pred table_simple_mark_as_failed(ml_subgoal_table_node::in) is det.
+
+ % Mark the subgoal represented by the given table as currently
+ % being evaluated (working on an answer).
+:- impure pred table_simple_mark_as_active(ml_subgoal_table_node::in) is det.
+
+ % Mark the subgoal represented by the given table as currently
+ % not being evaluated (working on an answer).
+:- impure pred table_simple_mark_as_inactive(ml_subgoal_table_node::in) is det.
+
+ % N.B. interface continued below
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- pragma c_code(table_simple_is_complete(T::in), will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""checking if simple %p is complete: %ld (%lx)\\n"",
+ table, (long) table->MR_simpletable_status,
+ (long) table->MR_simpletable_status);
+ }
+#endif
+ SUCCESS_INDICATOR =
+ ((table->MR_simpletable_status == MR_SIMPLETABLE_FAILED)
+ || (table->MR_simpletable_status >= MR_SIMPLETABLE_SUCCEEDED));
+").
+
+:- pragma c_code(table_simple_has_succeeded(T::in), will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""checking if simple %p is succeeded: %ld (%lx)\\n"",
+ table, (long) table->MR_simpletable_status,
+ (long) table->MR_simpletable_status);
+ }
+#endif
+ SUCCESS_INDICATOR =
+ (table->MR_simpletable_status >= MR_SIMPLETABLE_SUCCEEDED);
+").
+
+:- pragma c_code(table_simple_has_failed(T::in), will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""checking if simple %p is failed: %ld (%lx)\\n"",
+ table, (long) table->MR_simpletable_status,
+ (long) table->MR_simpletable_status);
+ }
+#endif
+ SUCCESS_INDICATOR =
+ (table->MR_simpletable_status == MR_SIMPLETABLE_FAILED);
+").
+
+:- pragma c_code(table_simple_is_active(T::in), will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""checking if simple %p is active: %ld (%lx)\\n"",
+ table, (long) table->MR_simpletable_status,
+ (long) table->MR_simpletable_status);
+ }
+#endif
+ SUCCESS_INDICATOR =
+ (table->MR_simpletable_status == MR_SIMPLETABLE_WORKING);
+").
+
+:- pragma c_code(table_simple_is_inactive(T::in), will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""checking if simple %p is inactive: %ld (%lx)\\n"",
+ table, (long) table->MR_simpletable_status,
+ (long) table->MR_simpletable_status);
+ }
+#endif
+ SUCCESS_INDICATOR =
+ (table->MR_simpletable_status != MR_SIMPLETABLE_WORKING);
+").
+
+:- pragma c_code(table_simple_mark_as_succeeded(T::in), will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""marking %p as succeeded\\n"", table);
+ }
+#endif
+ table->MR_simpletable_status = MR_SIMPLETABLE_SUCCEEDED;
+").
+
+:- pragma c_code(table_simple_mark_as_failed(T::in), will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""marking %p as failed\\n"", table);
+ }
+#endif
+ table->MR_simpletable_status = MR_SIMPLETABLE_FAILED;
+").
+
+:- pragma c_code(table_simple_mark_as_active(T::in), will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""marking %p as working\\n"", table);
+ }
+#endif
+ table->MR_simpletable_status = MR_SIMPLETABLE_WORKING;
+").
+
+:- pragma c_code(table_simple_mark_as_inactive(T::in), will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""marking %p as uninitialized\\n"", table);
+ }
+#endif
+ table->MR_simpletable_status = MR_SIMPLETABLE_UNINITIALIZED;
+").
+
+%-----------------------------------------------------------------------------%
+
+:- interface.
+
+%
+% Predicates that manage the tabling of model_non subgoals.
+%
+
+ % Save the information that will be needed later about this
+ % nondet subgoal in a data structure. If we have already seen
+ % this subgoal before, do nothing.
+:- impure pred table_nondet_setup(ml_subgoal_table_node::in,
+ ml_subgoal_table_node::out) is det.
+
+ % Save the state of the current subgoal and fail. Sometime later,
+ % when the subgoal has some solutions, table_nondet_resume will
+ % restore the saved state. At the time, table_nondet_suspend will
+ % succeed, and return an answer block as its second argument.
+:- impure pred table_nondet_suspend(ml_subgoal_table_node::in,
+ ml_answer_block::out) is nondet.
+
+ % Resume all suspended subgoal calls. This predicate will resume each
+ % of the suspended subgoals that depend on it in turn until it reaches
+ % a fixed point, at which all depended suspended subgoals have had
+ % all available answers returned to them.
+:- impure pred table_nondet_resume(ml_subgoal_table_node::in) is det.
+
+ % Succeed if we have finished generating all answers for
+ % the given nondet subgoal.
+:- semipure pred table_nondet_is_complete(ml_subgoal_table_node::in)
+ is semidet.
+
+ % Succeed if the given nondet subgoal is active,
+ % i.e. the process of computing all its answers is not yet complete.
+:- semipure pred table_nondet_is_active(ml_subgoal_table_node::in) is semidet.
+
+ % Mark a table as being active.
+:- impure pred table_nondet_mark_as_active(ml_subgoal_table_node::in) is det.
+
+ % Return the table of answers already return to the given nondet
+ % table.
+:- impure pred table_nondet_get_ans_table(ml_subgoal_table_node::in,
+ ml_table::out) is det.
+
+ % If the answer represented by the given answer table
+ % has not been generated before by this subgoal,
+ % succeed and remember the answer as having been generated.
+ % If the answer has been generated before, fail.
+:- impure pred table_nondet_answer_is_not_duplicate(ml_answer_table_node::in)
+ is semidet.
+
+ % Create a new slot in the answer list.
+:- impure pred table_nondet_new_ans_slot(ml_subgoal_table_node::in,
+ ml_answer_slot::out) is det.
+
+ % Return all of the answer blocks stored in the given table.
+:- semipure pred table_nondet_return_all_ans(ml_subgoal_table_node::in,
+ ml_answer_block::out) is nondet.
+:- semipure pred table_multi_return_all_ans(ml_subgoal_table_node::in,
+ ml_answer_block::out) is multi.
+
+ % N.B. interface continued below
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- pragma c_code(table_nondet_setup(T0::in, T::out), will_not_call_mercury, "
+#ifndef MR_USE_MINIMAL_MODEL
+ MR_fatal_error(""minimal model code entered when not enabled"");
+#else
+#ifdef MR_THREAD_SAFE
+#error ""Sorry, not yet implemented: mixing minimal model tabling and threads""
+#endif
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T0;
+
+ /*
+ ** Initialize the subgoal if this is the first time we see it.
+ ** If the subgoal structure already exists but is marked inactive,
+ ** then it was left by a previous generator that couldn't
+ ** complete the evaluation of the subgoal due to a commit.
+ ** In that case, we want to forget all about the old generator.
+ */
+
+ if (table->MR_subgoal == NULL) {
+ MR_Subgoal *subgoal;
+
+ subgoal = MR_TABLE_NEW(MR_Subgoal);
+
+ subgoal->status = MR_SUBGOAL_INACTIVE;
+ subgoal->leader = NULL;
+ subgoal->followers = MR_TABLE_NEW(MR_SubgoalListNode);
+ subgoal->followers->item = subgoal;
+ subgoal->followers->next = NULL;
+ subgoal->followers_tail = &(subgoal->followers->next);
+ subgoal->answer_table = (Word) NULL;
+ subgoal->num_ans = 0;
+ subgoal->answer_list = NULL;
+ subgoal->answer_list_tail = &subgoal->answer_list;
+ subgoal->consumer_list = NULL;
+ subgoal->consumer_list_tail = &subgoal->consumer_list;
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""setting up table %p -> %p, answer slot %p\\n"",
+ table, subgoal, subgoal->answer_list_tail);
+ }
+
+ if (MR_maxfr != MR_curfr) {
+ MR_fatal_error(
+ ""MR_maxfr != MR_curfr at table setup\\n"");
+ }
+#endif
+#ifdef MR_HIGHLEVEL_CODE
+ MR_fatal_error(""sorry, not implemented: ""
+ ""minimal_model tabling with --high-level-code"");
+#else
+ subgoal->generator_maxfr = MR_prevfr_slot(MR_maxfr);
+ subgoal->generator_sp = MR_sp;
+#endif
+ table->MR_subgoal = subgoal;
+ }
+ T = T0;
+#endif /* MR_USE_MINIMAL_MODEL */
+").
+
+ % The definitions of these two predicates are in the runtime system,
+ % in runtime/mercury_tabling.c.
+:- external(table_nondet_suspend/2).
+:- external(table_nondet_resume/1).
+
+:- pragma c_code(table_nondet_is_complete(T::in),"
+#ifdef MR_USE_MINIMAL_MODEL
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
+ SUCCESS_INDICATOR = (table->MR_subgoal->status == MR_SUBGOAL_COMPLETE);
+#else
+ MR_fatal_error(""minimal model code entered when not enabled"");
+#endif
+").
+
+:- pragma c_code(table_nondet_is_active(T::in), will_not_call_mercury, "
+#ifdef MR_USE_MINIMAL_MODEL
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
+ SUCCESS_INDICATOR = (table->MR_subgoal->status == MR_SUBGOAL_ACTIVE);
+#else
+ MR_fatal_error(""minimal model code entered when not enabled"");
+#endif
+").
+
+:- pragma c_code(table_nondet_mark_as_active(T::in), will_not_call_mercury, "
+#ifdef MR_USE_MINIMAL_MODEL
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
+ MR_push_generator(MR_curfr, table);
+ MR_register_generator_ptr(table);
+ table->MR_subgoal->status = MR_SUBGOAL_ACTIVE;
+#else
+ MR_fatal_error(""minimal model code entered when not enabled"");
+#endif
+").
+
+:- pragma c_code(table_nondet_get_ans_table(T::in, AT::out),
+ will_not_call_mercury, "
+#ifdef MR_USE_MINIMAL_MODEL
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
+ AT = (Word) &(table->MR_subgoal->answer_table);
+#else
+ MR_fatal_error(""minimal model code entered when not enabled"");
+#endif
+").
+
+:- pragma c_code(table_nondet_answer_is_not_duplicate(T::in),
+ will_not_call_mercury, "
+#ifndef MR_USE_MINIMAL_MODEL
+ MR_fatal_error(""minimal model code entered when not enabled"");
+#else
+ MR_TrieNode table;
+ bool is_new_answer;
+
+ table = (MR_TrieNode) T;
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""checking if %p is a duplicate answer: %ld\\n"",
+ table, (long) table->MR_integer);
+ }
+#endif
+
+ is_new_answer = (table->MR_integer == 0);
+ table->MR_integer = 1; /* any nonzero value will do */
+ SUCCESS_INDICATOR = is_new_answer;
+#endif
+").
+
+:- pragma c_code(table_nondet_new_ans_slot(T::in, Slot::out),
+ will_not_call_mercury, "
+#ifndef MR_USE_MINIMAL_MODEL
+ MR_fatal_error(""minimal model code entered when not enabled"");
+#else
+ MR_TrieNode table;
+ MR_Subgoal *subgoal;
+ MR_AnswerListNode *answer_node;
+
+ table = (MR_TrieNode) T;
+ subgoal = table->MR_subgoal;
+ subgoal->num_ans++;
+
+ /*
+ **
+ ** We fill in the answer_data slot with a dummy value.
+ ** This slot will be filled in by the next piece of code
+ ** to be executed after we return, which is why we return its address.
+ */
+
+ answer_node = MR_TABLE_NEW(MR_AnswerListNode);
+ answer_node->answer_num = subgoal->num_ans;
+ answer_node->answer_data.MR_integer = 0;
+ answer_node->next_answer = NULL;
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""new answer slot %d at %p(%p), storing into %p\\n"",
+ subgoal->num_ans, answer_node,
+ &answer_node->answer_data, subgoal->answer_list_tail);
+ }
+#endif
+
+ *(subgoal->answer_list_tail) = answer_node;
+ subgoal->answer_list_tail = &(answer_node->next_answer);
+
+ Slot = (Word) &(answer_node->answer_data);
+#endif
+").
+
+/*
+** Note that the code for this is identical to the code for
+** table_multi_return_all_ans/2 (below).
+** Any changes to this code should also be made there.
+*/
+:- pragma c_code(table_nondet_return_all_ans(T::in, A::out),
+ will_not_call_mercury,
+ local_vars("
+#ifdef MR_USE_MINIMAL_MODEL
+ MR_AnswerList cur_node;
+#else
+ /* ensure local var struct is non-empty */
+ char bogus;
+#endif
+ "),
+ first_code("
+#ifdef MR_USE_MINIMAL_MODEL
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+ LOCALS->cur_node = table->MR_subgoal->answer_list;
+
+ #ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""restoring all answers in %p -> %p\\n"",
+ table, table->MR_subgoal);
+ }
+ #endif
+#endif
+ "),
+ retry_code("
+ "),
+ shared_code("
+#ifdef MR_USE_MINIMAL_MODEL
+ if (LOCALS->cur_node == NULL) {
+ FAIL;
+ } else {
+ A = (Word) &LOCALS->cur_node->answer_data;
+ LOCALS->cur_node = LOCALS->cur_node->next_answer;
+ SUCCEED;
+ }
+#else
+ MR_fatal_error(""minimal model code entered when not enabled"");
+#endif
+ ")
+).
+
+/*
+** Note that the code for this is identical to the code for
+** table_nondet_return_all_ans/2 (above).
+** Any changes to this code should also be made there.
+*/
+:- pragma c_code(table_multi_return_all_ans(T::in, A::out),
+ will_not_call_mercury,
+ local_vars("
+#ifdef MR_USE_MINIMAL_MODEL
+ MR_AnswerList cur_node;
+#else
+ /* ensure local var struct is non-empty */
+ char bogus;
+#endif
+ "),
+ first_code("
+#ifdef MR_USE_MINIMAL_MODEL
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+ LOCALS->cur_node = table->MR_subgoal->answer_list;
+
+ #ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""restoring all answers in %p -> %p\\n"",
+ table, table->MR_subgoal);
+ }
+ #endif
+#endif
+ "),
+ retry_code("
+ "),
+ shared_code("
+#ifdef MR_USE_MINIMAL_MODEL
+ if (LOCALS->cur_node == NULL) {
+ FAIL;
+ } else {
+ A = (Word) &LOCALS->cur_node->answer_data;
+ LOCALS->cur_node = LOCALS->cur_node->next_answer;
+ SUCCEED;
+ }
+#else
+ MR_fatal_error(""minimal model code entered when not enabled"");
+#endif
+ ")
+).
+%-----------------------------------------------------------------------------%
+
+:- interface.
+
+%
+% Utility predicates that are needed in the tabling of both
+% simple and nondet subgoals.
+%
+
+%
+% The following table_lookup_insert... predicates lookup or insert the second
+% argument into the trie pointed to by the first argument. The value returned
+% is a pointer to the leaf of the trie reached by the lookup. From the
+% returned leaf another trie may be connected.
+%
+ % Lookup or insert an integer in the given table.
+:- impure pred table_lookup_insert_int(ml_table::in, int::in, ml_table::out)
+ is det.
+
+ % Lookup or insert a character in the given trie.
+:- impure pred table_lookup_insert_char(ml_table::in, character::in,
+ ml_table::out) is det.
+
+ % Lookup or insert a string in the given trie.
+:- impure pred table_lookup_insert_string(ml_table::in, string::in,
+ ml_table::out) is det.
+
+ % Lookup or insert a float in the current trie.
+:- impure pred table_lookup_insert_float(ml_table::in, float::in,
+ ml_table::out) is det.
+
+ % Lookup or inert an enumeration type in the given trie.
+:- impure pred table_lookup_insert_enum(ml_table::in, int::in, T::in,
+ ml_table::out) is det.
+
+ % Lookup or insert a monomorphic user defined type in the given trie.
+:- impure pred table_lookup_insert_user(ml_table::in, T::in, ml_table::out)
+ is det.
+
+ % Lookup or insert a polymorphic user defined type in the given trie.
+:- impure pred table_lookup_insert_poly(ml_table::in, T::in, ml_table::out)
+ is det.
+
+ % Save an integer answer in the given answer block at the given
+ % offset.
+:- impure pred table_save_int_ans(ml_answer_block::in, int::in, int::in)
+ is det.
+
+ % Save a character answer in the given answer block at the given
+ % offset.
+:- impure pred table_save_char_ans(ml_answer_block::in, int::in, character::in)
+ is det.
+
+ % Save a string answer in the given answer block at the given
+ % offset.
+:- impure pred table_save_string_ans(ml_answer_block::in, int::in, string::in)
+ is det.
+
+ % Save a float answer in the given answer block at the given
+ % offset.
+:- impure pred table_save_float_ans(ml_answer_block::in, int::in, float::in)
+ is det.
+
+ % Save any type of answer in the given answer block at the given
+ % offset.
+:- impure pred table_save_any_ans(ml_answer_block::in, int::in, T::in) is det.
+
+ % Restore an integer answer from the given answer block at the
+ % given offset.
+:- semipure pred table_restore_int_ans(ml_answer_block::in, int::in, int::out)
+ is det.
+
+ % Restore a character answer from the given answer block at the
+ % given offset.
+:- semipure pred table_restore_char_ans(ml_answer_block::in, int::in,
+ character::out) is det.
+
+ % Restore a string answer from the given answer block at the
+ % given offset.
+:- semipure pred table_restore_string_ans(ml_answer_block::in, int::in,
+ string::out) is det.
+
+ % Restore a float answer from the given answer block at the
+ % given offset.
+:- semipure pred table_restore_float_ans(ml_answer_block::in, int::in,
+ float::out) is det.
+
+ % Restore any type of answer from the given answer block at the
+ % given offset.
+:- semipure pred table_restore_any_ans(ml_answer_block::in, int::in, T::out)
+ is det.
+
+ % Report an error message about the current subgoal looping.
+:- pred table_loopcheck_error(string::in) is erroneous.
+
+ % Create an answer block with the given number of slots and add it
+ % to the given table.
+:- impure pred table_create_ans_block(ml_subgoal_table_node::in, int::in,
+ ml_answer_block::out) is det.
+
+ % Report statistics on the operation of the tabling system to stderr.
+:- impure pred table_report_statistics is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+:- import_module require.
+
+:- pragma c_header_code("
+
+#include ""mercury_misc.h"" /* for MR_fatal_error(); */
+#include ""mercury_type_info.h"" /* for MR_TypeCtorInfo_Struct; */
+#include ""mercury_tabling.h"" /* for MR_TrieNode, etc. */
+
+extern MR_STATIC_CODE_CONST struct MR_TypeCtorInfo_Struct
+ mercury_data___type_ctor_info_int_0;
+extern MR_STATIC_CODE_CONST struct MR_TypeCtorInfo_Struct
+ mercury_data___type_ctor_info_string_0;
+extern MR_STATIC_CODE_CONST struct MR_TypeCtorInfo_Struct
+ mercury_data___type_ctor_info_float_0;
+extern MR_STATIC_CODE_CONST struct MR_TypeCtorInfo_Struct
+ mercury_data___type_ctor_info_character_0;
+
+").
+
+:- pragma c_code(table_lookup_insert_int(T0::in, I::in, T::out),
+ will_not_call_mercury, "
+ MR_TrieNode table0, table;
+
+ table0 = (MR_TrieNode) T0;
+ MR_DEBUG_NEW_TABLE_INT(table, table0, (Integer) I);
+ T = (Word) table;
+").
+
+:- pragma c_code(table_lookup_insert_char(T0::in, C::in, T::out),
+ will_not_call_mercury, "
+ MR_TrieNode table0, table;
+
+ table0 = (MR_TrieNode) T0;
+ MR_DEBUG_NEW_TABLE_CHAR(table, table0, (Integer) C);
+ T = (Word) table;
+").
+
+:- pragma c_code(table_lookup_insert_string(T0::in, S::in, T::out),
+ will_not_call_mercury, "
+ MR_TrieNode table0, table;
+
+ table0 = (MR_TrieNode) T0;
+ MR_DEBUG_NEW_TABLE_STRING(table, table0, (String) S);
+ T = (Word) table;
+").
+
+:- pragma c_code(table_lookup_insert_float(T0::in, F::in, T::out),
+ will_not_call_mercury, "
+ MR_TrieNode table0, table;
+
+ table0 = (MR_TrieNode) T0;
+ MR_DEBUG_NEW_TABLE_FLOAT(table, table0, F);
+ T = (Word) table;
+").
+
+:- pragma c_code(table_lookup_insert_enum(T0::in, R::in, V::in, T::out),
+ will_not_call_mercury, "
+ MR_TrieNode table0, table;
+
+ table0 = (MR_TrieNode) T0;
+ MR_DEBUG_NEW_TABLE_ENUM(table, table0, R, V);
+ T = (Word) table;
+").
+
+:- pragma c_code(table_lookup_insert_user(T0::in, V::in, T::out),
+ will_not_call_mercury, "
+ MR_TrieNode table0, table;
+
+ table0 = (MR_TrieNode) T0;
+ MR_DEBUG_NEW_TABLE_ANY(table, table0, (MR_TypeInfo) TypeInfo_for_T, V);
+ T = (Word) table;
+").
+
+:- pragma c_code(table_lookup_insert_poly(T0::in, V::in, T::out),
+ will_not_call_mercury, "
+ MR_TrieNode table0, table;
+
+ table0 = (MR_TrieNode) T0;
+ MR_DEBUG_NEW_TABLE_ANY(table, table0, (MR_TypeInfo) TypeInfo_for_T, V);
+ T = (Word) table;
+").
+
+:- pragma c_code(table_save_int_ans(T::in, Offset::in, I::in),
+ will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+ MR_TABLE_SAVE_ANSWER(table, Offset, I,
+ &mercury_data___type_ctor_info_int_0);
+").
+
+:- pragma c_code(table_save_char_ans(T::in, Offset::in, C::in),
+ will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+ MR_TABLE_SAVE_ANSWER(table, Offset, C,
+ &mercury_data___type_ctor_info_character_0);
+").
+
+:- pragma c_code(table_save_string_ans(T::in, Offset::in, S::in),
+ will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+ MR_TABLE_SAVE_ANSWER(table, Offset, (Word) S,
+ &mercury_data___type_ctor_info_string_0);
+").
+
+:- pragma c_code(table_save_float_ans(T::in, Offset::in, F::in),
+ will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+#ifdef MR_HIGHLEVEL_CODE
+ MR_TABLE_SAVE_ANSWER(table, Offset,
+ (Word) MR_box_float(F),
+ &mercury_data___type_ctor_info_float_0);
+#else
+ MR_TABLE_SAVE_ANSWER(table, Offset,
+ float_to_word(F),
+ &mercury_data___type_ctor_info_float_0);
+#endif
+").
+
+:- pragma c_code(table_save_any_ans(T::in, Offset::in, V::in),
+ will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+ MR_TABLE_SAVE_ANSWER(table, Offset, V, TypeInfo_for_T);
+").
+
+:- pragma c_code(table_restore_int_ans(T::in, Offset::in, I::out),
+ will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+ I = (Integer) MR_TABLE_GET_ANSWER(table, Offset);
+").
+
+:- pragma c_code(table_restore_char_ans(T::in, Offset::in, C::out),
+ will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+ C = (Char) MR_TABLE_GET_ANSWER(table, Offset);
+").
+
+:- pragma c_code(table_restore_string_ans(T::in, Offset::in, S::out),
+ will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+ S = (String) MR_TABLE_GET_ANSWER(table, Offset);
+").
+
+:- pragma c_code(table_restore_float_ans(T::in, Offset::in, F::out),
+ will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+#ifdef MR_HIGHLEVEL_CODE
+ F = MR_unbox_float(MR_TABLE_GET_ANSWER(table, Offset));
+#else
+ F = word_to_float(MR_TABLE_GET_ANSWER(table, Offset));
+#endif
+").
+
+:- pragma c_code(table_restore_any_ans(T::in, Offset::in, V::out),
+ will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+ V = (Word) MR_TABLE_GET_ANSWER(table, Offset);
+").
+
+:- pragma c_code(table_create_ans_block(T0::in, Size::in, T::out),
+ will_not_call_mercury, "
+ MR_TrieNode table0;
+
+ table0 = (MR_TrieNode) T0;
+ MR_TABLE_CREATE_ANSWER_BLOCK(table0, Size);
+ T = T0;
+").
+
+table_loopcheck_error(Message) :-
+ error(Message).
+
+:- pragma c_code(table_report_statistics, will_not_call_mercury, "
+ MR_table_report_statistics(stderr);
+").
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh> | of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3 | -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list