[m-dev.] diff: minimal model tabling, part 2
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Apr 19 16:22:29 AEST 1999
cvs diff: Diffing library
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.18
diff -u -b -u -r1.18 private_builtin.m
--- private_builtin.m 1999/04/08 08:42:02 1.18
+++ private_builtin.m 1999/04/11 23:50:06
@@ -5,7 +5,7 @@
%---------------------------------------------------------------------------%
% File: private_builtin.m.
-% Main authors: fjh, ohutch.
+% Main authors: fjh, ohutch, zs.
% Stability: low.
% This file is automatically imported, as if via `use_module', into every
@@ -16,27 +16,28 @@
% 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 library reference manual.
+% Mercury library reference manual.
+% Many of the predicates defined in this module are builtin -
+% they do not have definitions because the compiler generates code
+% for them inline. Some others are implemented in the runtime.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- module private_builtin.
-:- interface.
%-----------------------------------------------------------------------------%
- % unsafe_type_cast/2 is used internally by the compiler. Bad things
- % will happen if this is used in programs. This is generated inline
- % by the compiler.
+:- interface.
-:- pred unsafe_type_cast(T1, T2).
-:- mode unsafe_type_cast(in, out) is det.
+
+ % This section of the module contains predicates that are used
+ % by the compiler, to implement polymorphism. These predicates
+ % should not be used by user programs directly.
-% The following are used by the compiler, to implement polymorphism.
-% They should not be used in programs.
-% Changes here may also require changes in compiler/polymorphism.m,
-% compiler/higher_order.m and runtime/mercury_type_info.{c,h}.
+ % Changes here may also require changes in compiler/polymorphism.m,
+ % compiler/higher_order.m and runtime/mercury_type_info.{c,h}.
:- pred builtin_unify_int(int::in, int::in) is semidet.
:- pred builtin_index_int(int::in, int::out) is det.
@@ -62,361 +63,33 @@
:- pred builtin_compare_pred(comparison_result::uo, (pred)::in, (pred)::in)
is det.
-% The following two preds are used for index/1 or compare/3 on
-% non-canonical types (types for which there is a `where equality is ...'
-% declaration).
+ % The following two preds are used for index/1 or compare/3
+ % on non-canonical types (types for which there is a
+ % `where equality is ...' declaration).
:- pred builtin_index_non_canonical_type(T::in, int::out) is det.
:- pred builtin_compare_non_canonical_type(comparison_result::uo,
T::in, T::in) is det.
-:- pred unused is det.
-
- % compare_error is used in the code generated for compare/3 preds
+ % Compare_error is used in the code generated for compare/3 preds.
:- pred compare_error is erroneous.
-
- % The code generated by polymorphism.m always requires
- % the existence of a type_info functor, and requires
- % the existence of a type_ctor_info functor as well
- % when using --type-info {shared-,}one-or-two-cell.
- %
- % The actual arities of these two function symbols are variable;
- % they depend on the number of type parameters of the type represented
- % by the type_info, and how many predicates we associate with each
- % type.
- %
- % Note that, since these types look to the compiler as though they
- % are candidates to become no_tag types, special code is required in
- % type_util:type_is_no_tag_type/3.
-
-:- type type_info(T) ---> type_info(type_ctor_info(T) /*, ... */).
-:- type type_ctor_info(T) ---> type_ctor_info(int /*, ... */).
-
- % The type variable in these types isn't really a type variable,
- % it's a place for polymorphism.m to put a representation of the
- % class constraint about which the typeclass_info carries information.
- %
- % Note that, since these types look to the compiler as though they
- % are candidates to become no_tag types, special code is required in
- % type_util:type_is_no_tag_type/3.
-
-:- type typeclass_info(T) ---> typeclass_info(base_typeclass_info(T)
- /*, ... */).
-:- type base_typeclass_info(_) ---> typeclass_info(int /*, ... */).
-
- % type_info_from_typeclass_info(TypeClassInfo, Index, TypeInfo)
- % extracts TypeInfo from TypeClassInfo, where TypeInfo is the Indexth
- % type_info in the typeclass_info
- %
- % Note: Index must be equal to the number of the desired type_info
- % plus the number of superclasses for this class.
-:- pred type_info_from_typeclass_info(typeclass_info(_), int, type_info(T)).
-:- mode type_info_from_typeclass_info(in, in, out) is det.
-
- % superclass_from_typeclass_info(TypeClassInfo, Index, SuperClass)
- % extracts SuperClass from TypeClassInfo where TypeInfo is the Indexth
- % superclass of the class.
-:- pred superclass_from_typeclass_info(typeclass_info(_),
- int, typeclass_info(_)).
-:- mode superclass_from_typeclass_info(in, in, out) is det.
- % the builtin < operator on ints, used in the code generated
- % for compare/3 preds
+ % The builtin < operator on ints, used in the code generated
+ % for compare/3 preds.
:- pred builtin_int_lt(int, int).
:- mode builtin_int_lt(in, in) is semidet.
:- external(builtin_int_lt/2).
- % the builtin > operator on ints, used in the code generated
- % for compare/3 preds
+ % The builtin > operator on ints, used in the code generated
+ % for compare/3 preds.
:- pred builtin_int_gt(int, int).
:- mode builtin_int_gt(in, in) is semidet.
:- external(builtin_int_gt/2).
%-----------------------------------------------------------------------------%
-%
-% The following predicates are used in code transformed by the table_gen pass
-% of the compiler. The predicates fall into three categories :
-%
-% 1) Predicates to do lookups or insertions into the tables. This group
-% also contains function to create and initialise tables. There are
-% currently two types of table used by the tabling system. 1) A subgoal
-% table, this is a table containing all of the subgoal calls that have
-% or are being processed for a given predicate. 2) An answer table,
-% this is a table of all the answers a subgoal has returned. It is used
-% for duplicate answer elimination in the minimal model tabling
-% scheme.
-%
-% 2) Predicates to test and set the status of the tables. These predicates
-% expect either a subgoal or answer table node depending on their
-% functionality.
-%
-% 3) Predicates to save answers into the tables. Answers are saved in
-% an answer block, which is a vector of n elements where n is the number
-% of output arguments of the predicate it belongs to. For det and
-% semidet tabling the answer block is connected directly to subgoal
-% table nodes. In the case of nondet tabling answer blocks are connected
-% to answered slots which are strung together to form a list.
-%
-% All of the predicates with the impure declaration modify the table
-% structures. Because the tables are persistent through backtracking, this
-% causes the predicates to become impure. The predicates with the semipure
-% directive only examine the trees but do not have any side effects.
-%
-
- % 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.
-
- % Save important information in nondet table and initialise all of
- % its fields. If called on an already initialised table do nothing.
-:- impure pred table_setup(ml_subgoal_table_node, ml_subgoal_table_node).
-:- mode table_setup(in, out) is det.
-
- % Return all of the answer blocks stored in the given table.
-:- semipure pred table_return_all_ans(ml_subgoal_table_node, ml_answer_block).
-:- mode table_return_all_ans(in, out) is nondet.
-
- % Returns true if the given nondet table has returned some of its
- % answers.
-:- semipure pred table_have_some_ans(ml_subgoal_table_node).
-:- mode table_have_some_ans(in) is semidet.
-
- % Return true if the given nondet table has returned all of its
- % answers.
-:- semipure pred table_have_all_ans(ml_subgoal_table_node).
-:- mode table_have_all_ans(in) is semidet.
-
- % Mark a table as having some answers.
-:- impure pred table_mark_have_some_ans(ml_subgoal_table_node).
-:- mode table_mark_have_some_ans(in) is det.
-
- % Make a table as having all of its answers.
-:- impure pred table_mark_have_all_ans(ml_subgoal_table_node).
-:- mode table_mark_have_all_ans(in) is det.
-
- % currently being evaluated (working on an answer).
-:- semipure pred table_working_on_ans(ml_subgoal_table_node).
-:- mode table_working_on_ans(in) is semidet.
-
- % Return false if the subgoal represented by the given table is
- % currently being evaluated (working on an answer).
-:- semipure pred table_not_working_on_ans(ml_subgoal_table_node).
-:- mode table_not_working_on_ans(in) is semidet.
-
- % Mark the subgoal represented by the given table as currently
- % being evaluated (working on an answer).
-:- impure pred table_mark_as_working(ml_subgoal_table_node).
-:- mode table_mark_as_working(in) is det.
-
- % Mark the subgoal represented by the given table as currently
- % not being evaluated (working on an answer).
-:- impure pred table_mark_done_working(ml_subgoal_table_node).
-:- mode table_mark_done_working(in) is det.
-
- % Report an error message about the current subgoal looping.
-:- pred table_loopcheck_error(string).
-:- mode table_loopcheck_error(in) is erroneous.
-
-%
-% 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, int, ml_table).
-:- mode table_lookup_insert_int(in, in, out) is det.
-
- % Lookup or insert a character in the given trie.
-:- impure pred table_lookup_insert_char(ml_table, character, ml_table).
-:- mode table_lookup_insert_char(in, in, out) is det.
-
- % Lookup or insert a string in the given trie.
-:- impure pred table_lookup_insert_string(ml_table, string, ml_table).
-:- mode table_lookup_insert_string(in, in, out) is det.
-
- % Lookup or insert a float in the current trie.
-:- impure pred table_lookup_insert_float(ml_table, float, ml_table).
-:- mode table_lookup_insert_float(in, in, out) is det.
-
- % Lookup or inert an enumeration type in the given trie.
-:- impure pred table_lookup_insert_enum(ml_table, int, T, ml_table).
-:- mode table_lookup_insert_enum(in, in, in, out) is det.
-
- % Lookup or insert a monomorphic user defined type in the given trie.
-:- impure pred table_lookup_insert_user(ml_table, T, ml_table).
-:- mode table_lookup_insert_user(in, in, out) is det.
-
- % Lookup or insert a polymorphic user defined type in the given trie.
-:- impure pred table_lookup_insert_poly(ml_table, T, ml_table).
-:- mode table_lookup_insert_poly(in, in, out) is det.
-
- % Return true if the subgoal represented by the given table has an
- % answer. NOTE : this is only used for det and semidet procedures.
-:- semipure pred table_have_ans(ml_subgoal_table_node).
-:- mode table_have_ans(in) is semidet.
-
- % Save the fact the the subgoal has succeeded in the given table.
-:- impure pred table_mark_as_succeeded(ml_subgoal_table_node).
-:- mode table_mark_as_succeeded(in) is det.
-
- % Save the fact the the subgoal has failed in the given table.
-:- impure pred table_mark_as_failed(ml_subgoal_table_node).
-:- mode table_mark_as_failed(in) is det.
-
- % Return true if the subgoal represented by the given table has a
- % true answer. NOTE : this is only used for det and semidet
- % procedures.
-:- semipure pred table_has_succeeded(ml_subgoal_table_node).
-:- mode table_has_succeeded(in) is semidet.
-
- % Return true if the subgoal represented by the given table has
- % failed. NOTE : this is only used for semidet procedures.
-:- semipure pred table_has_failed(ml_subgoal_table_node).
-:- mode table_has_failed(in) is semidet.
-
- % 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, int,
- ml_answer_block).
-:- mode table_create_ans_block(in, in, out) is det.
-
- % Create a new slot in the answer list.
-:- impure pred table_new_ans_slot(ml_subgoal_table_node, ml_answer_slot).
-:- mode table_new_ans_slot(in, 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, int, int).
-:- mode table_save_int_ans(in, in, 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, int, character).
-:- mode table_save_char_ans(in, in, 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, int, string).
-:- mode table_save_string_ans(in, in, 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, int, float).
-:- mode table_save_float_ans(in, in, 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, int, T).
-:- mode table_save_any_ans(in, in, 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, int, int).
-:- mode table_restore_int_ans(in, in, 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, int, character).
-:- mode table_restore_char_ans(in, in, 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, int, string).
-:- mode table_restore_string_ans(in, in, 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, int, float).
-:- mode table_restore_float_ans(in, in, 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, int, T).
-:- mode table_restore_any_ans(in, in, out) is det.
-
- % Return the table of answers already return to the given nondet
- % table.
-:- impure pred table_get_ans_table(ml_subgoal_table_node, ml_table).
-:- mode table_get_ans_table(in, out) is det.
-
- % Return true if the answer represented by the given answer
- % table has not been returned to its parent nondet table.
-:- semipure pred table_has_not_returned(ml_answer_table_node).
-:- mode table_has_not_returned(in) is semidet.
-
- % Make the answer represented by the given answer table as
- % having been return to its parent nondet table.
-:- impure pred table_mark_as_returned(ml_answer_table_node).
-:- mode table_mark_as_returned(in) is det.
-
- % Save the state of the current subgoal and fail. When this subgoal
- % is resumed answers are returned through the second argument.
- % The saved state will be used by table_resume/1 to resume the
- % subgoal.
-:- impure pred table_suspend(ml_subgoal_table_node, ml_answer_block).
-:- mode table_suspend(in, out) is nondet.
-
- % Resume all suspended subgoal calls. This predicate will resume each
- % of the suspended subgoals in turn until it reaches a fixed point at
- % which all suspended subgoals have had all available answers returned
- % to them.
-:- impure pred table_resume(ml_subgoal_table_node).
-:- mode table_resume(in) is det.
-
- % 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_table == c_pointer.
-:- type ml_subgoal_table_node == c_pointer.
-:- type ml_answer_table_node == c_pointer.
-:- type ml_answer_slot == c_pointer.
-:- type ml_answer_block == c_pointer.
-
-%-----------------------------------------------------------------------------%
:- implementation.
:- import_module require, string, std_util, int, float, char, string, list.
-% Many of the predicates defined in this module are builtin -
-% the compiler generates code for them inline.
-
-:- pragma c_code(type_info_from_typeclass_info(TypeClassInfo::in, Index::in,
- TypeInfo::out), will_not_call_mercury,
-"
- TypeInfo = MR_typeclass_info_type_info(TypeClassInfo, Index);
-").
-
-:- pragma c_code(superclass_from_typeclass_info(TypeClassInfo0::in, Index::in,
- TypeClassInfo::out), will_not_call_mercury,
-"
- TypeClassInfo =
- MR_typeclass_info_superclass_info(TypeClassInfo0, Index);
-").
-
-%-----------------------------------------------------------------------------%
-
builtin_unify_int(X, X).
builtin_index_int(X, X).
@@ -480,6 +153,10 @@
will_not_call_mercury,
"Res = strcmp(S1, S2);").
+:- external(builtin_unify_pred/2).
+:- external(builtin_index_pred/2).
+:- external(builtin_compare_pred/3).
+
builtin_index_non_canonical_type(_, -1).
builtin_compare_non_canonical_type(Res, X, _Y) :-
@@ -496,18 +173,6 @@
Res = (<)
).
-:- external(builtin_unify_pred/2).
-:- external(builtin_index_pred/2).
-:- external(builtin_compare_pred/3).
-
-unused :-
- ( semidet_succeed ->
- error("attempted use of dead predicate")
- ;
- % the following is never executed
- true
- ).
-
% This is used by the code that the compiler generates for compare/3.
compare_error :-
error("internal error in compare/3").
@@ -515,98 +180,61 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- pragma c_header_code("
+:- interface.
-#include ""mercury_deep_copy.h""
-#include ""mercury_type_info.h""
+ % This section of the module handles the runtime representation of
+ % type information.
- /* Used to mark the status of the table */
-#define ML_UNINITIALIZED 0
-#define ML_WORKING_ON_ANS 1
-#define ML_FAILED 2
- /* The values 3..TYPE_CTOR_LAYOUT_MAX_VARINT are reserved for future use */
-#define ML_SUCCEEDED TYPE_CTOR_LAYOUT_MAX_VARINT
- /* This or any greater value indicate that the subgoal has
- ** succeeded. */
+ % The code generated by polymorphism.m always requires
+ % the existence of a type_info functor, and requires
+ % the existence of a type_ctor_info functor as well
+ % when using --type-info {shared-,}one-or-two-cell.
+ %
+ % The actual arities of these two function symbols are variable;
+ % they depend on the number of type parameters of the type represented
+ % by the type_info, and how many predicates we associate with each
+ % type.
+ %
+ % Note that, since these types look to the compiler as though they
+ % are candidates to become no_tag types, special code is required
+ % to handle them in type_util:type_is_no_tag_type/3.
-").
+:- type type_info(T) ---> type_info(type_ctor_info(T) /*, ... */).
+:- type type_ctor_info(T) ---> type_ctor_info(int /*, ... */).
-:- pragma c_code(table_working_on_ans(T::in), will_not_call_mercury, "
- SUCCESS_INDICATOR = (*((Word *) T) == ML_WORKING_ON_ANS);
-").
+ % The type variable in these types isn't really a type variable,
+ % it is a place for polymorphism.m to put a representation of the
+ % class constraint about which the typeclass_info carries information.
+ %
+ % Note that, since these types look to the compiler as though they
+ % are candidates to become no_tag types, special code is required
+ % to handle them in type_util:type_is_no_tag_type/3.
-:- pragma c_code(table_not_working_on_ans(T::in), will_not_call_mercury, "
- SUCCESS_INDICATOR = (*((Word *) T) != ML_WORKING_ON_ANS);
-").
+:- type typeclass_info(T) ---> typeclass_info(base_typeclass_info(T)
+ /*, ... */).
+:- type base_typeclass_info(_) ---> typeclass_info(int /*, ... */).
-:- pragma c_code(table_mark_as_working(T::in), will_not_call_mercury, "
- *((Word *) T) = ML_WORKING_ON_ANS;
-").
+ % type_info_from_typeclass_info(TypeClassInfo, Index, TypeInfo)
+ % extracts TypeInfo from TypeClassInfo, where TypeInfo is the Indexth
+ % type_info in the typeclass_info.
+ %
+ % Note: Index must be equal to the number of the desired type_info
+ % plus the number of superclasses for this class.
+:- pred type_info_from_typeclass_info(typeclass_info(_), int, type_info(T)).
+:- mode type_info_from_typeclass_info(in, in, out) is det.
-:- pragma c_code(table_mark_done_working(T::in), will_not_call_mercury, "
- *((Word *) T) = ML_UNINITIALIZED;
-").
+ % superclass_from_typeclass_info(TypeClassInfo, Index, SuperClass)
+ % extracts SuperClass from TypeClassInfo where TypeInfo is the Indexth
+ % superclass of the class.
+:- pred superclass_from_typeclass_info(typeclass_info(_),
+ int, typeclass_info(_)).
+:- mode superclass_from_typeclass_info(in, in, out) is det.
-table_loopcheck_error(Message) :-
- error(Message).
+%-----------------------------------------------------------------------------%
-:- pragma c_code(table_lookup_insert_int(T0::in, I::in, T::out),
- will_not_call_mercury, "
- MR_DEBUG_NEW_TABLE_INT(T, T0, I);
-").
-
-:- pragma c_code(table_lookup_insert_char(T0::in, C::in, T::out),
- will_not_call_mercury, "
- MR_DEBUG_NEW_TABLE_CHAR(T, T0, C);
-").
-
-:- pragma c_code(table_lookup_insert_string(T0::in, S::in, T::out),
- will_not_call_mercury, "
- MR_DEBUG_NEW_TABLE_STRING(T, T0, S);
-").
-
-:- pragma c_code(table_lookup_insert_float(T0::in, F::in, T::out),
- will_not_call_mercury, "
- MR_DEBUG_NEW_TABLE_FLOAT(T, T0, F);
-").
-
-:- pragma c_code(table_lookup_insert_enum(T0::in, R::in, V::in, T::out),
- will_not_call_mercury, "
- MR_DEBUG_NEW_TABLE_ENUM(T, T0, R, V);
-").
-
-:- pragma c_code(table_lookup_insert_user(T0::in, V::in, T::out),
- will_not_call_mercury, "
- MR_DEBUG_NEW_TABLE_ANY(T, T0, TypeInfo_for_T, V);
-").
-
-:- pragma c_code(table_lookup_insert_poly(T0::in, V::in, T::out),
- will_not_call_mercury, "
- Word T1;
- MR_DEBUG_NEW_TABLE_TYPEINFO(T1, T0, TypeInfo_for_T);
- MR_DEBUG_NEW_TABLE_ANY(T, T1, TypeInfo_for_T, V);
-").
-
-:- pragma c_code(table_have_ans(T::in), will_not_call_mercury, "
- if (*((Word *) T) == ML_FAILED || *((Word *) T) >= ML_SUCCEEDED) {
- SUCCESS_INDICATOR = TRUE;
- } else {
- SUCCESS_INDICATOR = FALSE;
- }
-").
-
-:- pragma c_code(table_has_succeeded(T::in), will_not_call_mercury, "
- SUCCESS_INDICATOR = (*((Word *) T) >= ML_SUCCEEDED)
-").
-
-:- pragma c_code(table_has_failed(T::in), will_not_call_mercury, "
- SUCCESS_INDICATOR = (*((Word *) T) == ML_FAILED);
-").
+:- implementation.
-:- pragma c_code(table_create_ans_block(T0::in, Size::in, T::out) ,"
- MR_TABLE_CREATE_ANSWER_BLOCK(T0, Size);
- T = T0;
-").
+ % The definitions for type_ctor_info/1 and type_info/1.
:- pragma c_header_code("
@@ -624,849 +252,907 @@
mercury_data___type_ctor_info_character_0;
").
-
-:- pragma c_code(table_save_int_ans(T::in, Offset::in, I::in),
- will_not_call_mercury, "
- MR_TABLE_SAVE_ANSWER(Offset, T, 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_TABLE_SAVE_ANSWER(Offset, T, 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_TABLE_SAVE_ANSWER(Offset, T, (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_TABLE_SAVE_ANSWER(Offset, T, float_to_word(F),
- mercury_data___type_ctor_info_float_0);
-").
-
-:- pragma c_code(table_save_any_ans(T::in, Offset::in, V::in),
- will_not_call_mercury, "
- MR_TABLE_SAVE_ANSWER(Offset, T, V, TypeInfo_for_T);
-").
-
-:- pragma c_code(table_mark_as_succeeded(T::in), will_not_call_mercury, "
- *((Word *) T) = ML_SUCCEEDED;
-").
-:- pragma c_code(table_mark_as_failed(T::in), will_not_call_mercury, "
- *((Word *) T) = ML_FAILED;
-").
+:- pragma c_code("
-:- pragma c_code(table_restore_int_ans(T::in, Offset::in, I::out),
- will_not_call_mercury, "
- I = (Integer) MR_TABLE_GET_ANSWER(Offset, T);
-").
+Define_extern_entry(mercury____Unify___private_builtin__type_info_1_0);
+Define_extern_entry(mercury____Index___private_builtin__type_info_1_0);
+Define_extern_entry(mercury____Compare___private_builtin__type_info_1_0);
-:- pragma c_code(table_restore_char_ans(T::in, Offset::in, C::out),
- will_not_call_mercury, "
- C = (Char) MR_TABLE_GET_ANSWER(Offset, T);
-").
+extern const struct
+ mercury_data_private_builtin__type_ctor_layout_type_info_1_struct
+ mercury_data_private_builtin__type_ctor_layout_type_info_1;
+extern const struct
+ mercury_data_private_builtin__type_ctor_functors_type_info_1_struct
+ mercury_data_private_builtin__type_ctor_functors_type_info_1;
-:- pragma c_code(table_restore_string_ans(T::in, Offset::in, S::out),
- will_not_call_mercury, "
- S = (String) MR_TABLE_GET_ANSWER(Offset, T);
-").
+ /*
+ ** For most purposes, type_ctor_info can be treated just like
+ ** type_info. The code that handles type_infos can also handle
+ ** type_ctor_infos.
+ */
-:- pragma c_code(table_restore_float_ans(T::in, Offset::in, F::out),
- will_not_call_mercury, "
- F = word_to_float(MR_TABLE_GET_ANSWER(Offset, T));
-").
+MR_STATIC_CODE_CONST struct
+mercury_data_private_builtin__type_ctor_info_type_ctor_info_1_struct {
+ Integer f1;
+ Code *f2;
+ Code *f3;
+ Code *f4;
+ const Word *f5;
+ const Word *f6;
+ const Word *f7;
+ const Word *f8;
+ const Word *f9;
+} mercury_data_private_builtin__type_ctor_info_type_ctor_info_1 = {
+ ((Integer) 1),
+ MR_MAYBE_STATIC_CODE(ENTRY(
+ mercury____Unify___private_builtin__type_info_1_0)),
+ MR_MAYBE_STATIC_CODE(ENTRY(
+ mercury____Index___private_builtin__type_info_1_0)),
+ MR_MAYBE_STATIC_CODE(ENTRY(
+ mercury____Compare___private_builtin__type_info_1_0)),
+ (const Word *) &
+ mercury_data_private_builtin__type_ctor_layout_type_info_1,
+ (const Word *) &
+ mercury_data_private_builtin__type_ctor_functors_type_info_1,
+ (const Word *) &
+ mercury_data_private_builtin__type_ctor_layout_type_info_1,
+ (const Word *) string_const(""private_builtin"", 15),
+ (const Word *) string_const(""type_ctor_info"", 14)
+};
-:- pragma c_code(table_restore_any_ans(T::in, Offset::in, V::out),
- will_not_call_mercury, "
- V = (Word) MR_TABLE_GET_ANSWER(Offset, T);
-").
+MR_STATIC_CODE_CONST struct
+mercury_data_private_builtin__type_ctor_info_type_info_1_struct {
+ Integer f1;
+ Code *f2;
+ Code *f3;
+ Code *f4;
+ const Word *f5;
+ const Word *f6;
+ const Word *f7;
+ const Word *f8;
+ const Word *f9;
+} mercury_data_private_builtin__type_ctor_info_type_info_1 = {
+ ((Integer) 1),
+ MR_MAYBE_STATIC_CODE(ENTRY(
+ mercury____Unify___private_builtin__type_info_1_0)),
+ MR_MAYBE_STATIC_CODE(ENTRY(
+ mercury____Index___private_builtin__type_info_1_0)),
+ MR_MAYBE_STATIC_CODE(ENTRY(
+ mercury____Compare___private_builtin__type_info_1_0)),
+ (const Word *) &
+ mercury_data_private_builtin__type_ctor_layout_type_info_1,
+ (const Word *) &
+ mercury_data_private_builtin__type_ctor_functors_type_info_1,
+ (const Word *) string_const(""private_builtin"", 15),
+ (const Word *) string_const(""type_info"", 9)
+};
-:- pragma c_header_code("
-/*
-** The following structures are used by the code for non deterministic tabling.
-*/
+const struct mercury_data_private_builtin__type_ctor_layout_type_info_1_struct {
+ TYPE_LAYOUT_FIELDS
+} mercury_data_private_builtin__type_ctor_layout_type_info_1 = {
+ make_typelayout_for_all_tags(TYPE_CTOR_LAYOUT_CONST_TAG,
+ mkbody(MR_TYPE_CTOR_LAYOUT_TYPEINFO_VALUE))
+};
-/* Used to hold a single answer. */
-typedef struct {
- Word ans_num;
- Word ans;
-} AnswerListNode;
-
-/* Used to save the state of a subgoal */
-typedef struct {
- Word *last_ret_ans; /* Pointer to the last answer returned
- to the node */
- Code *succ_ip; /* Saved succip */
- Word *s_p; /* Saved SP */
- Word *cur_fr; /* Saved curfr */
- Word *max_fr; /* Saved maxfr */
- Word non_stack_block_size; /* Size of saved non stack block */
- Word *non_stack_block; /* Saved non stack */
- Word det_stack_block_size; /* Size of saved det stack block */
- Word *det_stack_block; /* Saved det stack */
-} SuspendListNode;
-
-typedef enum {
- have_no_ans,
- have_some_ans,
- have_all_ans
-} TableStatus;
-
-/* Used to save info about a single subgoal in the table */
-typedef struct {
- TableStatus status; /* Status of subgoal */
- Word answer_table; /* Table of answers returned by the
- subgoal */
- Word num_ans; /* Number of answers returned by the
- subgoal */
- Word answer_list; /* List of answers returned by the
- subgoal */
- Word *answer_list_tail; /* Pointer to the tail of the answer
- list. This is used to update the
- tail rather than the head of the
- ans list. */
- Word suspend_list; /* List of suspended calls to the
- subgoal */
- Word *suspend_list_tail; /* Ditto for answer_list_tail */
- Word *non_stack_bottom; /* Pointer to the bottom point of
- the nondet stack from which to
- copy */
- Word *det_stack_bottom; /* Pointer to the bottom point of
- the det stack from which to copy */
-
-} NondetTable;
-
- /* Flag used to indicate the answer has been returned */
-#define ML_ANS_NOT_RET 0
-#define ML_ANS_RET 1
+const struct mercury_data_private_builtin__type_ctor_functors_type_info_1_struct {
+ Integer f1;
+} mercury_data_private_builtin__type_ctor_functors_type_info_1 = {
+ MR_TYPE_CTOR_FUNCTORS_SPECIAL
+};
+BEGIN_MODULE(type_info_module)
+ init_entry(mercury____Unify___private_builtin__type_info_1_0);
+ init_entry(mercury____Index___private_builtin__type_info_1_0);
+ init_entry(mercury____Compare___private_builtin__type_info_1_0);
+BEGIN_CODE
+Define_entry(mercury____Unify___private_builtin__type_info_1_0);
+{
/*
- ** Cast a Word to a NondetTable*: saves on typing and improves
- ** readability.
+ ** Unification for type_info.
+ **
+ ** The two inputs are in the registers named by unify_input[12].
+ ** The success/failure indication should go in unify_output.
*/
-#define NON_TABLE(T) (*(NondetTable **) T)
-").
+ int comp;
+ save_transient_registers();
+ comp = MR_compare_type_info(unify_input1, unify_input2);
+ restore_transient_registers();
+ unify_output = (comp == COMPARE_EQUAL);
+ proceed();
+}
-:- pragma c_code(table_setup(T0::in, T::out), will_not_call_mercury, "
- /* Init the table if this is the first time me see it */
- if (NON_TABLE(T0) == NULL) {
- NondetTable *table = (NondetTable *) table_allocate_bytes(
- sizeof(NondetTable));
- table->status = have_no_ans;
- table->answer_table = (Word) NULL;
- table->num_ans = 0;
- table->answer_list = list_empty();
- table->answer_list_tail = &table->answer_list;
- table->suspend_list = list_empty();
- table->suspend_list_tail = &table->suspend_list;
- table->non_stack_bottom = MR_prevfr_slot(MR_curfr);
- table->det_stack_bottom = MR_sp;
- NON_TABLE(T0) = table;
- }
- T = T0;
-").
+Define_entry(mercury____Index___private_builtin__type_info_1_0);
+ index_output = -1;
+ proceed();
-table_return_all_ans(T, A) :-
- semipure table_return_all_ans_list(T, AnsList),
- list__member(Node, AnsList),
- semipure table_return_all_ans_2(Node, A).
+Define_entry(mercury____Compare___private_builtin__type_info_1_0);
+{
+ /*
+ ** Comparison for type_info:
+ **
+ ** The two inputs are in the registers named by compare_input[12].
+ ** The result should go in compare_output.
+ */
+ int comp;
+ save_transient_registers();
+ comp = MR_compare_type_info(compare_input1, compare_input2);
+ restore_transient_registers();
+ compare_output = comp;
+ proceed();
+}
+END_MODULE
-:- semipure pred table_return_all_ans_list(ml_table, list(ml_table)).
-:- mode table_return_all_ans_list(in, out) is det.
+/* Ensure that the initialization code for the above module gets run. */
+/*
+INIT sys_init_type_info_module
+*/
+extern ModuleFunc type_info_module;
+void sys_init_type_info_module(void); /* suppress gcc -Wmissing-decl warning */
+void sys_init_type_info_module(void) {
+ type_info_module();
+}
-:- pragma c_code(table_return_all_ans_list(T::in, A::out),
- will_not_call_mercury, "
- A = (Word) NON_TABLE(T)->answer_list;
").
-
-:- semipure pred table_return_all_ans_2(ml_table, ml_table).
-:- mode table_return_all_ans_2(in, out) is det.
-:- pragma c_code(table_return_all_ans_2(P::in, A::out),
- will_not_call_mercury, "
- A = (Word) &((AnswerListNode *) P)->ans;
+:- pragma c_code(type_info_from_typeclass_info(TypeClassInfo::in, Index::in,
+ TypeInfo::out), will_not_call_mercury,
+"
+ TypeInfo = MR_typeclass_info_type_info(TypeClassInfo, Index);
").
-:- pragma c_code(table_get_ans_table(T::in, AT::out),
- will_not_call_mercury, "
- AT = (Word) &(NON_TABLE(T)->answer_table);
+:- pragma c_code(superclass_from_typeclass_info(TypeClassInfo0::in, Index::in,
+ TypeClassInfo::out), will_not_call_mercury,
+"
+ TypeClassInfo =
+ MR_typeclass_info_superclass_info(TypeClassInfo0, Index);
").
-:- pragma c_code(table_have_all_ans(T::in),"
- SUCCESS_INDICATOR = (NON_TABLE(T)->status == have_all_ans);
-").
+%-----------------------------------------------------------------------------%
-:- pragma c_code(table_have_some_ans(T::in), will_not_call_mercury, "
- SUCCESS_INDICATOR = (NON_TABLE(T)->status == have_some_ans);
-").
+:- interface.
-:- pragma c_code(table_has_not_returned(T::in), will_not_call_mercury, "
- SUCCESS_INDICATOR = (*((Word *) T) == ML_ANS_NOT_RET);
-").
+ % This section of the module is for miscellaneous predicates
+ % that sometimes have calls to them emitted by the compiler.
-:- pragma c_code(table_mark_have_all_ans(T::in), will_not_call_mercury, "
- NON_TABLE(T)->status = have_all_ans;
-").
+ % unsafe_type_cast/2 is used internally by the compiler. Bad things
+ % will happen if this is used in programs. It has no definition,
+ % since for efficiency the code generator treats it as a builtin.
-:- pragma c_code(table_mark_have_some_ans(T::in), will_not_call_mercury, "
- NON_TABLE(T)->status = have_some_ans;
-").
+:- pred unsafe_type_cast(T1, T2).
+:- mode unsafe_type_cast(in, out) is det.
-:- pragma c_code(table_mark_as_returned(T::in), will_not_call_mercury, "
- *((Word *) T) = ML_ANS_RET;
-").
+:- pred unused is det.
-:- external(table_suspend/2).
-:- external(table_resume/1).
+:- implementation.
-:- pragma c_code("
+unused :-
+ ( semidet_succeed ->
+ error("attempted use of dead predicate")
+ ;
+ % the following is never executed
+ true
+ ).
-/*
-** The following procedure saves the state of the mercury runtime
-** so that it may be used in the table_resume procedure below to return
-** answers through this saved state. The procedure table_suspend is
-** declared as nondet but the code below is obviously of detism failure,
-** the reason for this is quite simple. Normally when a nondet proc
-** is called it will first return all of its answers and then fail. In the
-** case of calls to this procedure this is reversed first the call will fail
-** then later on, when the answers are found, answers will be returned.
-** It is also important to note that the answers are returned not from the
-** procedure that was originally called (table_suspend) but from the procedure
-** table_resume. So essentially what is below is the code to do the initial
-** fail; the code to return the answers is in table_resume.
-*/
-Define_extern_entry(mercury__table_suspend_2_0);
-MR_MAKE_PROC_LAYOUT(mercury__table_suspend_2_0,
- MR_DETISM_NON, 0, MR_LVAL_TYPE_UNKNOWN,
- MR_PREDICATE, ""private_builtin"", ""table_suspend"", 2, 0);
-BEGIN_MODULE(table_suspend_module)
- init_entry_sl(mercury__table_suspend_2_0);
- MR_INIT_PROC_LAYOUT_ADDR(mercury__table_suspend_2_0);
-BEGIN_CODE
+%-----------------------------------------------------------------------------%
-Define_entry(mercury__table_suspend_2_0);
- /*
- ** This frame is not used in table_suspend, but it is copied
- ** to the suspend list as part of the saved nondet stack fragment,
- ** and it *will* be used when table_resume copies back the nondet
- ** stack fragment.
- */
- mkframe(mercury__table_suspend/2, 0, ENTRY(do_fail));
-{
- NondetTable *table = NON_TABLE(r1);
- Word *non_stack_top = MR_maxfr;
- Word *det_stack_top = MR_sp;
- Word *non_stack_bottom = table->non_stack_bottom;
- Word *det_stack_bottom = table->det_stack_bottom;
- Word non_stack_delta = non_stack_top - non_stack_bottom;
- Word det_stack_delta = det_stack_top - det_stack_bottom;
- Word ListNode;
- SuspendListNode *Node = table_allocate_bytes(sizeof(SuspendListNode));
- Node->last_ret_ans = &table->answer_list;
-
- Node->non_stack_block_size = non_stack_delta;
- Node->non_stack_block = table_allocate_words(non_stack_delta);
- table_copy_words(Node->non_stack_block, non_stack_bottom,
- non_stack_delta);
-
- Node->det_stack_block_size = det_stack_delta;
- Node->det_stack_block = table_allocate_words(det_stack_delta);
- table_copy_words(Node->det_stack_block, det_stack_bottom,
- det_stack_delta);
-
- Node->succ_ip = MR_succip;
- Node->s_p = MR_sp;
- Node->cur_fr = MR_curfr;
- Node->max_fr = MR_maxfr;
+:- interface.
-#ifdef MR_TABLE_DEBUG
- if (MR_tabledebug) {
- printf(""suspension saves consumer stack: %d non, %d det\\n"",
- non_stack_delta, det_stack_delta);
- printf(""non region from %p to %p, det region from ""
- ""%p to %p\\n"",
- (void *) non_stack_bottom,
- (void *) MR_maxfr,
- (void *) det_stack_bottom,
- (void *) MR_sp);
- printf(""succip = %p, sp = %p, maxfr = %p, curfr = %p\\n"",
- (void *) MR_succip, (void *) MR_sp,
- (void *) MR_maxfr, (void *) MR_curfr);
- }
-#endif
+% 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.
- assert(list_is_empty(*table->suspend_list_tail));
- ListNode = MR_table_list_cons(Node, list_empty());
- *table->suspend_list_tail = ListNode;
- table->suspend_list_tail = &list_tail(ListNode);
-}
- fail();
-END_MODULE
+ % 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.
-/*
-** The following structure is used to hold the state and variables used in
-** the table_resume procedure. The state and variables must be held in a
-** globally rooted structure as the process of resuming overwrites the mercury
-** and C stacks. A new stack is used to avoid this overwriting. This stack is
-** defined and accessed by the following macros and global variables.
-*/
-typedef struct {
- NondetTable *table;
- Word non_stack_block_size;
- Word *non_stack_block;
- Word det_stack_block_size;
- Word *det_stack_block;
-
- Code *succ_ip;
- Word *s_p;
- Word *cur_fr;
- Word *max_fr;
-
- Word changed;
- Word num_ans;
- Word new_num_ans;
- Word suspend_list;
- SuspendListNode *suspend_node;
- Word ans_list;
- AnswerListNode *ansNode;
-} ResumeStackNode;
-
-Integer ML_resumption_sp = -1;
-Word ML_resumption_stack_size = 4; /* Half the initial size of
- the stack in ResumeStackNode's */
-
-ResumeStackNode **ML_resumption_stack = NULL;
-
-#define ML_RESUME_PUSH() \\
- do { \\
- ++ML_resumption_sp; \\
- if (ML_resumption_sp >= ML_resumption_stack_size || \\
- ML_resumption_stack == NULL) \\
- { \\
- ML_resumption_stack_size = \\
- ML_resumption_stack_size * 2; \\
- ML_resumption_stack = table_reallocate_bytes( \\
- ML_resumption_stack, \\
- ML_resumption_stack_size * sizeof( \\
- ResumeStackNode *)); \\
- } \\
- ML_resumption_stack[ML_resumption_sp] = \\
- table_allocate_bytes(sizeof(ResumeStackNode)); \\
- } while (0)
-
-#define ML_RESUME_POP() \\
- do { \\
- if (ML_resumption_sp < 0) { \\
- fatal_error(""resumption stack underflow""); \\
- } \\
- table_free(ML_resumption_stack[ML_resumption_sp]); \\
- --ML_resumption_sp; \\
- } while (0)
+ % This type is used in contexts where a node of a subgoal table is
+ % expected.
+:- type ml_subgoal_table_node.
-#define ML_RESUME_VAR \\
- ML_resumption_stack[ML_resumption_sp]
+ % This type is used in contexts where a node of an answer table is
+ % expected.
+:- type ml_answer_table_node.
-#ifdef MR_DEBUG_RESUME
- /*
- ** The ML_RESUME_DEBUG_VAR variable is not actually used.
- ** Its only purpose is to provide something that can be put
- ** onto a gdb command line without making it overflow :-(.
- **
- ** Therefore MR_DEBUG_RESUME should never be enabled except when
- ** debugging table_resume.
- */
+ % 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.
- ResumeStackNode *ML_RESUME_DEBUG_VAR;
+:- implementation.
- #define ML_SET_RESUME_DEBUG_VARS() \\
- do { \\
- ML_RESUME_DEBUG_VAR = ML_resumption_stack[ML_resumption_sp];\\
- } while (0)
+% 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.
-#else
+%-----------------------------------------------------------------------------%
- #define ML_SET_RESUME_DEBUG_VARS()
+:- interface.
-#endif
+%
+% Predicates that manage the tabling of simple subgoals.
+%
-/*
-** The procedure defined below restores answers to suspended nodes. It
-** works by restoring the states saved when calls to table_suspend were
-** made. By restoring the states saved in table_suspend and then returning
-** answers it is essentially returning answers out of the call to table_suspend
-** not out of the call to table_resume.
-** This procedure iterates until it has returned all answers to all
-** suspend nodes. The iteration is a fixpoint type as each time an answer
-** is returned to a suspended node it has the chance of introducing more
-** answers and/or suspended nodes.
-*/
-Define_extern_entry(mercury__table_resume_1_0);
-Declare_label(mercury__table_resume_1_0_ChangeLoop);
-Declare_label(mercury__table_resume_1_0_ChangeLoopDone);
-Declare_label(mercury__table_resume_1_0_SolutionsListLoop);
-Declare_label(mercury__table_resume_1_0_AnsListLoop);
-Declare_label(mercury__table_resume_1_0_AnsListLoopDone1);
-Declare_label(mercury__table_resume_1_0_AnsListLoopDone2);
-Declare_label(mercury__table_resume_1_0_RedoPoint);
-
-MR_MAKE_PROC_LAYOUT(mercury__table_resume_1_0,
- MR_DETISM_NON, MR_ENTRY_NO_SLOT_COUNT, MR_LVAL_TYPE_UNKNOWN,
- MR_PREDICATE, ""private_builtin"", ""table_resume"", 1, 0);
-MR_MAKE_INTERNAL_LAYOUT_WITH_ENTRY(
- mercury__table_resume_1_0_ChangeLoop, mercury__table_resume_1_0);
-MR_MAKE_INTERNAL_LAYOUT_WITH_ENTRY(
- mercury__table_resume_1_0_ChangeLoopDone, mercury__table_resume_1_0);
-MR_MAKE_INTERNAL_LAYOUT_WITH_ENTRY(
- mercury__table_resume_1_0_SolutionsListLoop, mercury__table_resume_1_0);
-MR_MAKE_INTERNAL_LAYOUT_WITH_ENTRY(
- mercury__table_resume_1_0_AnsListLoop, mercury__table_resume_1_0);
-MR_MAKE_INTERNAL_LAYOUT_WITH_ENTRY(
- mercury__table_resume_1_0_AnsListLoopDone1, mercury__table_resume_1_0);
-MR_MAKE_INTERNAL_LAYOUT_WITH_ENTRY(
- mercury__table_resume_1_0_AnsListLoopDone2, mercury__table_resume_1_0);
-MR_MAKE_INTERNAL_LAYOUT_WITH_ENTRY(
- mercury__table_resume_1_0_RedoPoint, mercury__table_resume_1_0);
-
-BEGIN_MODULE(table_resume_module)
- init_entry_sl(mercury__table_resume_1_0);
- MR_INIT_PROC_LAYOUT_ADDR(mercury__table_resume_1_0);
- init_label_sl(mercury__table_resume_1_0_ChangeLoop);
- init_label_sl(mercury__table_resume_1_0_ChangeLoopDone);
- init_label_sl(mercury__table_resume_1_0_SolutionsListLoop);
- init_label_sl(mercury__table_resume_1_0_AnsListLoop);
- init_label_sl(mercury__table_resume_1_0_AnsListLoopDone1);
- init_label_sl(mercury__table_resume_1_0_AnsListLoopDone2);
- init_label_sl(mercury__table_resume_1_0_RedoPoint);
-BEGIN_CODE
+ % 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.
-Define_entry(mercury__table_resume_1_0);
- /* Check that we have answers to return and nodes to return
- them to. */
- if (list_is_empty(NON_TABLE(r1)->answer_list))
- /* we should free the suspend list */
- proceed();
+ % 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.
- if (list_is_empty(NON_TABLE(r1)->suspend_list))
- proceed();
+ % 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.
- /* Save the current state. */
- ML_RESUME_PUSH();
- ML_RESUME_VAR->table = NON_TABLE(r1);
- ML_RESUME_VAR->non_stack_block_size =
- MR_maxfr - ML_RESUME_VAR->table->non_stack_bottom;
- ML_RESUME_VAR->det_stack_block_size =
- MR_sp - ML_RESUME_VAR->table->det_stack_bottom;
- ML_RESUME_VAR->succ_ip = MR_succip;
- ML_RESUME_VAR->s_p = MR_sp;
- ML_RESUME_VAR->cur_fr = MR_curfr;
- ML_RESUME_VAR->max_fr = MR_maxfr;
+ % 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.
- ML_SET_RESUME_DEBUG_VARS();
+ % 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.
-#ifdef MR_USE_TRAIL
- /*
- ** We ought to save the trail state here --
- ** this is not yet implemented.
- */
- fatal_error(""Sorry, not implemented: ""
- ""can't have both tabling and trailing"");
+ % 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, "
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""checking if %p is succeeded or failed: %lu\\n"",
+ (Unsigned *) T, (unsigned long) (*((Unsigned *) T)));
+ }
#endif
+ SUCCESS_INDICATOR =
+ ((*((Unsigned *) T) == MR_SIMPLETABLE_FAILED)
+ || (*((Unsigned *) T) >= MR_SIMPLETABLE_SUCCEEDED));
+").
- ML_RESUME_VAR->changed = 1;
+:- pragma c_code(table_simple_has_succeeded(T::in), will_not_call_mercury, "
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""checking if %p is succeeded: %lu\\n"",
+ (Unsigned *) T, (unsigned long) (*((Unsigned *) T)));
+ }
+#endif
+ SUCCESS_INDICATOR = (*((Unsigned *) T) >= MR_SIMPLETABLE_SUCCEEDED)
+").
- ML_RESUME_VAR->non_stack_block = (Word *) table_allocate_words(
- ML_RESUME_VAR->non_stack_block_size);
- table_copy_words(ML_RESUME_VAR->non_stack_block,
- ML_RESUME_VAR->table->non_stack_bottom,
- ML_RESUME_VAR->non_stack_block_size);
-
- ML_RESUME_VAR->det_stack_block = (Word *) table_allocate_words(
- ML_RESUME_VAR->det_stack_block_size);
- table_copy_words(ML_RESUME_VAR->det_stack_block,
- ML_RESUME_VAR->table->det_stack_bottom,
- ML_RESUME_VAR->det_stack_block_size);
+:- pragma c_code(table_simple_has_failed(T::in), will_not_call_mercury, "
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""checking if %p is failed: %lu\\n"",
+ (Unsigned *) T, (unsigned long) (*((Unsigned *) T)));
+ }
+#endif
+ SUCCESS_INDICATOR = (*((Unsigned *) T) == MR_SIMPLETABLE_FAILED);
+").
+:- pragma c_code(table_simple_is_active(T::in), will_not_call_mercury, "
#ifdef MR_TABLE_DEBUG
if (MR_tabledebug) {
- printf(""resumption saves generator stack: %d non, %d det\\n"",
- ML_RESUME_VAR->non_stack_block_size,
- ML_RESUME_VAR->det_stack_block_size);
- printf(""non region from %p to %p, det region ""
- ""from %p to %p\\n"",
- (void *) ML_RESUME_VAR->table->non_stack_bottom,
- (void *) MR_maxfr,
- (void *) ML_RESUME_VAR->table->det_stack_bottom,
- (void *) MR_sp);
- printf(""succip = %p, sp = %p, maxfr = %p, curfr = %p\\n"",
- (void *) MR_succip, (void *) MR_sp,
- (void *) MR_maxfr, (void *) MR_curfr);
+ printf(""checking if %p is active: %lu\\n"",
+ (Unsigned *) T, (unsigned long) (*((Unsigned *) T)));
}
#endif
+ SUCCESS_INDICATOR = (*((Unsigned *) T) == MR_SIMPLETABLE_WORKING);
+").
- /* If the number of ans or suspended nodes has changed. */
-Define_label(mercury__table_resume_1_0_ChangeLoop);
- ML_SET_RESUME_DEBUG_VARS();
+:- pragma c_code(table_simple_is_inactive(T::in), will_not_call_mercury, "
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""checking if %p is not inactive: %lu\\n"",
+ (Unsigned *) T, (unsigned long) (*((Unsigned *) T)));
+ }
+#endif
+ SUCCESS_INDICATOR = (*((Unsigned *) T) != MR_SIMPLETABLE_WORKING);
+").
- if (! ML_RESUME_VAR->changed)
- GOTO_LABEL(mercury__table_resume_1_0_ChangeLoopDone);
+:- pragma c_code(table_simple_mark_as_succeeded(T::in), will_not_call_mercury, "
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""marking %p as succeeded\\n"", (Unsigned *) T);
+ }
+#endif
+ *((Unsigned *) T) = MR_SIMPLETABLE_SUCCEEDED;
+").
- ML_RESUME_VAR->suspend_list = ML_RESUME_VAR->table->suspend_list;
+:- pragma c_code(table_simple_mark_as_failed(T::in), will_not_call_mercury, "
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""marking %p as failed\\n"", (Unsigned *) T);
+ }
+#endif
+ *((Unsigned *) T) = MR_SIMPLETABLE_FAILED;
+").
- ML_RESUME_VAR->changed = 0;
- ML_RESUME_VAR->num_ans = ML_RESUME_VAR->table->num_ans;
+:- pragma c_code(table_simple_mark_as_active(T::in), will_not_call_mercury, "
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""marking %p as working\\n"", (Unsigned *) T);
+ }
+#endif
+ *((Unsigned *) T) = MR_SIMPLETABLE_WORKING;
+").
- /* For each of the suspended nodes */
-Define_label(mercury__table_resume_1_0_SolutionsListLoop);
- ML_SET_RESUME_DEBUG_VARS();
+:- pragma c_code(table_simple_mark_as_inactive(T::in), will_not_call_mercury, "
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""marking %p as uninitialized\\n"", (Unsigned *) T);
+ }
+#endif
+ *((Unsigned *) T) = MR_SIMPLETABLE_UNINITIALIZED;
+").
- if (list_is_empty(ML_RESUME_VAR->suspend_list))
- GOTO_LABEL(mercury__table_resume_1_0_ChangeLoop);
+%-----------------------------------------------------------------------------%
- ML_RESUME_VAR->suspend_node = (SuspendListNode *) list_head(
- ML_RESUME_VAR->suspend_list);
+:- 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.
- ML_RESUME_VAR->ans_list = *ML_RESUME_VAR->suspend_node->last_ret_ans;
+ % 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.
- if (list_is_empty(ML_RESUME_VAR->ans_list))
- GOTO_LABEL(mercury__table_resume_1_0_AnsListLoopDone2);
+%-----------------------------------------------------------------------------%
- ML_RESUME_VAR->ansNode = (AnswerListNode *) list_head(
- ML_RESUME_VAR->ans_list);
+:- implementation.
+:- pragma c_code(table_nondet_setup(T0::in, T::out), will_not_call_mercury, "
+#ifdef MR_USE_MINIMAL_MODEL
+#ifdef MR_THREAD_SAFE
+#error ""Sorry, not yet implemented: mixing minimal model tabling and threads""
+#endif
/*
- ** Restore the state of the suspended node and return the answer
- ** through the redoip we saved when the node was originally
- ** suspended
+ ** 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.
*/
- table_copy_words(ML_RESUME_VAR->table->non_stack_bottom,
- ML_RESUME_VAR->suspend_node->non_stack_block,
- ML_RESUME_VAR->suspend_node->non_stack_block_size);
-
- table_copy_words(ML_RESUME_VAR->table->det_stack_bottom,
- ML_RESUME_VAR->suspend_node->det_stack_block,
- ML_RESUME_VAR->suspend_node->det_stack_block_size);
-
- MR_succip = ML_RESUME_VAR->suspend_node->succ_ip;
- MR_sp = ML_RESUME_VAR->suspend_node->s_p;
- MR_curfr = ML_RESUME_VAR->suspend_node->cur_fr;
- MR_maxfr = ML_RESUME_VAR->suspend_node->max_fr;
+ if (MR_SUBGOAL(T0) == NULL) {
+ MR_Subgoal *subgoal;
+ subgoal = (MR_Subgoal *)
+ table_allocate_bytes(sizeof(MR_Subgoal));
#ifdef MR_TABLE_DEBUG
if (MR_tabledebug) {
- printf(""resumption restores consumer stack: ""
- ""%d non, %d det\\n"",
- ML_RESUME_VAR->suspend_node->non_stack_block_size,
- ML_RESUME_VAR->suspend_node->det_stack_block_size);
- printf(""non region from %p to %p, det region ""
- ""from %p to %p\\n"",
- (void *) ML_RESUME_VAR->table->non_stack_bottom,
- (void *) (ML_RESUME_VAR->table->non_stack_bottom
- + ML_RESUME_VAR->suspend_node->
- non_stack_block_size),
- (void *) ML_RESUME_VAR->table->det_stack_bottom,
- (void *) (ML_RESUME_VAR->table->det_stack_bottom
- + ML_RESUME_VAR->suspend_node->
- det_stack_block_size));
- printf(""succip = %p, sp = %p, maxfr = %p, curfr = %p\\n"",
- (void *) MR_succip, (void *) MR_sp,
- (void *) MR_maxfr, (void *) MR_curfr);
+ printf(""setting up table %p -> %p\n"",
+ (MR_Subgoal **) T0, subgoal);
+ }
+#endif
+ subgoal->status = MR_SUBGOAL_INACTIVE;
+ subgoal->leader = NULL;
+ subgoal->followers = make(struct 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_maxfr != MR_curfr) {
+ fatal_error(""MR_maxfr != MR_curfr at table setup\n"");
+ }
+#endif
+ subgoal->generator_maxfr = MR_prevfr_slot(MR_maxfr);
+ subgoal->generator_sp = MR_sp;
+ MR_SUBGOAL(T0) = subgoal;
}
+ T = T0;
+#else
+ fatal_error(""minimal model code entered when not enabled"");
#endif
+").
- MR_redoip_slot(MR_maxfr) = LABEL(mercury__table_resume_1_0_RedoPoint);
- MR_redofr_slot(MR_maxfr) = MR_maxfr;
+ % 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
+ SUCCESS_INDICATOR = (MR_SUBGOAL(T)->status == MR_SUBGOAL_COMPLETE);
+#else
+ fatal_error(""minimal model code entered when not enabled"");
+#endif
+").
- /*
- ** Return each answer not previously returned to the node
- ** whose state we are currently in.
- */
-Define_label(mercury__table_resume_1_0_AnsListLoop);
- ML_SET_RESUME_DEBUG_VARS();
+:- pragma c_code(table_nondet_is_active(T::in), will_not_call_mercury, "
+#ifdef MR_USE_MINIMAL_MODEL
+ SUCCESS_INDICATOR = (MR_SUBGOAL(T)->status == MR_SUBGOAL_ACTIVE);
+#else
+ fatal_error(""minimal model code entered when not enabled"");
+#endif
+").
-#ifdef COMPACT_ARGS
- r1 = (Word) &ML_RESUME_VAR->ansNode->ans;
+:- pragma c_code(table_nondet_mark_as_active(T::in), will_not_call_mercury, "
+#ifdef MR_USE_MINIMAL_MODEL
+ MR_push_generator(MR_curfr, MR_SUBGOAL(T));
+ MR_register_generator_ptr((MR_Subgoal **) T);
+ MR_SUBGOAL(T)->status = MR_SUBGOAL_ACTIVE;
#else
- r2 = (word) &ML_RESUME_VAR->ansNode->ans;
+ 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
+ AT = (Word) &(MR_SUBGOAL(T)->answer_table);
+#else
+ 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, "
+#ifdef MR_USE_MINIMAL_MODEL
+ bool is_new_answer;
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""checking if %p is a duplicate answer: %d\\n"",
+ (Word *) T, *((Word *) T));
+ }
+#endif
+ is_new_answer = (*((Word *) T) == MR_ANS_NOT_GENERATED);
+ *((Word *) T) = MR_ANS_GENERATED;
+ SUCCESS_INDICATOR = is_new_answer;
+#else
+ fatal_error(""minimal model code entered when not enabled"");
+#endif
+").
+
+:- pragma c_code(table_nondet_new_ans_slot(T::in, Slot::out),
+ will_not_call_mercury, "
+#ifdef MR_USE_MINIMAL_MODEL
+ MR_Subgoal *table;
+ MR_AnswerListNode *answer_node;
+
+ table = MR_SUBGOAL(T);
+ table->num_ans += 1;
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""new answer slot %d, storing into addr %p\\n"",
+ table->num_ans, table->answer_list_tail);
+ }
+#endif
/*
- ** Return the answer through the point where suspend should have
- ** returned.
+ **
+ ** 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.
*/
- succeed();
-Define_label(mercury__table_resume_1_0_RedoPoint);
- ML_SET_RESUME_DEBUG_VARS();
+ answer_node = table_allocate_bytes(sizeof(MR_AnswerListNode));
+ answer_node->answer_num = table->num_ans;
+ answer_node->answer_data = 0;
+ answer_node->next_answer = NULL;
- update_prof_current_proc(LABEL(mercury__table_resume_1_0));
+ *(table->answer_list_tail) = answer_node;
+ table->answer_list_tail = &(answer_node->next_answer);
- ML_RESUME_VAR->ans_list = list_tail(ML_RESUME_VAR->ans_list);
+ Slot = (Word) &(answer_node->answer_data);
+#else
+ fatal_error(""minimal model code entered when not enabled"");
+#endif
+").
- if (list_is_empty(ML_RESUME_VAR->ans_list))
- GOTO_LABEL(mercury__table_resume_1_0_AnsListLoopDone1);
+% The following nondet pragma c code seems to be compiled to C all right,
+% but the C compiler seems to simply omit several statements from the
+% generated executable. This is the reason for the handwritten module below.
+
+% :- pragma c_code(table_nondet_return_all_ans(T::in, A::out),
+% will_not_call_mercury,
+% local_vars("
+% MR_AnswerList cur_node;
+% "),
+% first_code("
+% LOCALS->cur_node = MR_SUBGOAL(T)->answer_list;
+% "),
+% retry_code("
+% "),
+% shared_code("
+% if (LOCALS->cur_node == NULL) {
+% FAIL;
+% } else {
+% A = LOCALS->cur_node->answer_data;
+% LOCALS->cur_node = LOCALS->cur_node->next_answer;
+% SUCCEED;
+% }
+% ")
+% ).
- ML_RESUME_VAR->ansNode = (AnswerListNode *) list_head(
- ML_RESUME_VAR->ans_list);
+:- external(table_nondet_return_all_ans/2).
- GOTO_LABEL(mercury__table_resume_1_0_AnsListLoop);
+:- pragma c_code("
+BEGIN_MODULE(private_builtin_module_XXX)
+ init_entry(mercury__table_nondet_return_all_ans_2_0);
+ init_label(mercury__table_nondet_return_all_ans_2_0_i1);
+BEGIN_CODE
+Define_entry(mercury__table_nondet_return_all_ans_2_0);
+ mkframe(""private_builtin:table_nondet_return_all_ans/2"", 1,
+ LABEL(mercury__table_nondet_return_all_ans_2_0_i1));
+ MR_framevar(1) = (Word) MR_SUBGOAL(r1)->answer_list;
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""from subgoal %p, ""
+ ""returning everything in answer list %p\\n"",
+ MR_SUBGOAL(r1), MR_SUBGOAL(r1)->answer_list);
+ }
+#endif
+Define_label(mercury__table_nondet_return_all_ans_2_0_i1);
+ if ( ((MR_AnswerList) MR_framevar(1)) == NULL) {
+ fail();
+ } else {
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""returning answer block %p\\n"",
+ (MR_AnswerList) MR_framevar(1));
+ printf(""num %ld, answer %ld at %p, next %p\\n"",
+ (long) ((MR_AnswerList)
+ MR_framevar(1))->answer_num,
+ (long) ((MR_AnswerList)
+ MR_framevar(1))->answer_data,
+ &((MR_AnswerList) MR_framevar(1))->answer_data,
+ ((MR_AnswerList) MR_framevar(1))->next_answer);
+ }
+#endif
+ r1 = (Word) &((MR_AnswerList) MR_framevar(1))->answer_data;
+ MR_framevar(1) = (Word)
+ ((MR_AnswerList) MR_framevar(1))->next_answer;
+ succeed();
+ }
+END_MODULE
+").
-Define_label(mercury__table_resume_1_0_AnsListLoopDone1);
- ML_SET_RESUME_DEBUG_VARS();
+%-----------------------------------------------------------------------------%
- if (ML_RESUME_VAR->num_ans == ML_RESUME_VAR->table->num_ans)
- ML_RESUME_VAR->changed = 0;
- else
- ML_RESUME_VAR->changed = 1;
+:- interface.
- ML_RESUME_VAR->suspend_node->last_ret_ans = &ML_RESUME_VAR->ans_list;
+%
+% Utility predicates that are needed in the tabling of both
+% simple and nondet subgoals.
+%
-Define_label(mercury__table_resume_1_0_AnsListLoopDone2);
- ML_SET_RESUME_DEBUG_VARS();
+%
+% 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.
- ML_RESUME_VAR->suspend_list = list_tail(ML_RESUME_VAR->suspend_list);
- GOTO_LABEL(mercury__table_resume_1_0_SolutionsListLoop);
+ % 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.
-Define_label(mercury__table_resume_1_0_ChangeLoopDone);
- ML_SET_RESUME_DEBUG_VARS();
+ % 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.
- /* Restore the original state we had when this proc was called */
+ % 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.
- table_copy_words(ML_RESUME_VAR->table->non_stack_bottom,
- ML_RESUME_VAR->non_stack_block,
- ML_RESUME_VAR->non_stack_block_size);
- table_free(ML_RESUME_VAR->non_stack_block);
+ % 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.
- table_copy_words(ML_RESUME_VAR->table->det_stack_bottom,
- ML_RESUME_VAR->det_stack_block,
- ML_RESUME_VAR->det_stack_block_size);
- table_free(ML_RESUME_VAR->det_stack_block);
+ % 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.
- MR_succip = ML_RESUME_VAR->succ_ip;
- MR_sp = ML_RESUME_VAR->s_p;
- MR_curfr = ML_RESUME_VAR->cur_fr;
- MR_maxfr = ML_RESUME_VAR->max_fr;
+ % 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.
-#ifdef MR_TABLE_DEBUG
- if (MR_tabledebug) {
- printf(""resumption restores generator stack:""
- "" %d non, %d det\\n"",
- ML_RESUME_VAR->non_stack_block_size,
- ML_RESUME_VAR->det_stack_block_size);
- printf(""non region from %p to %p, det region ""
- ""from %p to %p\\n"",
- (void *) ML_RESUME_VAR->table->non_stack_bottom,
- (void *) (ML_RESUME_VAR->table->non_stack_bottom +
- ML_RESUME_VAR->non_stack_block_size),
- (void *) ML_RESUME_VAR->table->det_stack_bottom,
- (void *) (ML_RESUME_VAR->table->det_stack_bottom +
- ML_RESUME_VAR->det_stack_block_size));
- printf(""succip = %p, sp = %p, maxfr = %p, curfr = %p\\n"",
- (void *) MR_succip, (void *) MR_sp,
- (void *) MR_maxfr, (void *) MR_curfr);
- }
-#endif
+ % 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.
- ML_RESUME_POP();
+ % 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.
- proceed();
-END_MODULE
+ % 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.
-#undef ML_SET_RESUME_DEBUG_VARS
+ % 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.
-/* Ensure that the initialization code for the above module gets run. */
-/*
-INIT sys_init_table_suspend_module
-INIT sys_init_table_resume_module
-*/
+ % 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.
-extern ModuleFunc table_suspend_module;
-extern ModuleFunc table_resume_module;
+ % 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.
-void sys_init_table_suspend_module(void);
- /* extra declaration to suppress gcc -Wmissing-decl warning */
-void sys_init_table_suspend_module(void) {
- table_suspend_module();
-}
-void sys_init_table_resume_module(void);
- /* extra declaration to suppress gcc -Wmissing-decl warning */
-void sys_init_table_resume_module(void) {
- table_resume_module();
-}
+ % 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.
- % The definitions for type_ctor_info/1 and type_info/1.
+ % 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.
-:- pragma c_code("
+ % Report an error message about the current subgoal looping.
+:- pred table_loopcheck_error(string::in) is erroneous.
-Define_extern_entry(mercury____Unify___private_builtin__type_info_1_0);
-Define_extern_entry(mercury____Index___private_builtin__type_info_1_0);
-Define_extern_entry(mercury____Compare___private_builtin__type_info_1_0);
+ % 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.
-extern const struct
- mercury_data_private_builtin__type_ctor_layout_type_info_1_struct
- mercury_data_private_builtin__type_ctor_layout_type_info_1;
-extern const struct
- mercury_data_private_builtin__type_ctor_functors_type_info_1_struct
- mercury_data_private_builtin__type_ctor_functors_type_info_1;
+%-----------------------------------------------------------------------------%
- /*
- ** For most purposes, type_ctor_info can be treated just like
- ** type_info. The code that handles type_infos can also handle
- ** type_ctor_infos.
- */
+:- implementation.
-MR_STATIC_CODE_CONST struct
-mercury_data_private_builtin__type_ctor_info_type_ctor_info_1_struct {
- Integer f1;
- Code *f2;
- Code *f3;
- Code *f4;
- const Word *f5;
- const Word *f6;
- const Word *f7;
- const Word *f8;
- const Word *f9;
-} mercury_data_private_builtin__type_ctor_info_type_ctor_info_1 = {
- ((Integer) 1),
- MR_MAYBE_STATIC_CODE(ENTRY(
- mercury____Unify___private_builtin__type_info_1_0)),
- MR_MAYBE_STATIC_CODE(ENTRY(
- mercury____Index___private_builtin__type_info_1_0)),
- MR_MAYBE_STATIC_CODE(ENTRY(
- mercury____Compare___private_builtin__type_info_1_0)),
- (const Word *) &
- mercury_data_private_builtin__type_ctor_layout_type_info_1,
- (const Word *) &
- mercury_data_private_builtin__type_ctor_functors_type_info_1,
- (const Word *) &
- mercury_data_private_builtin__type_ctor_layout_type_info_1,
- (const Word *) string_const(""private_builtin"", 15),
- (const Word *) string_const(""type_ctor_info"", 14)
-};
+:- pragma c_code(table_lookup_insert_int(T0::in, I::in, T::out),
+ will_not_call_mercury, "
+ MR_DEBUG_NEW_TABLE_INT(T, T0, I);
+").
-MR_STATIC_CODE_CONST struct
-mercury_data_private_builtin__type_ctor_info_type_info_1_struct {
- Integer f1;
- Code *f2;
- Code *f3;
- Code *f4;
- const Word *f5;
- const Word *f6;
- const Word *f7;
- const Word *f8;
- const Word *f9;
-} mercury_data_private_builtin__type_ctor_info_type_info_1 = {
- ((Integer) 1),
- MR_MAYBE_STATIC_CODE(ENTRY(
- mercury____Unify___private_builtin__type_info_1_0)),
- MR_MAYBE_STATIC_CODE(ENTRY(
- mercury____Index___private_builtin__type_info_1_0)),
- MR_MAYBE_STATIC_CODE(ENTRY(
- mercury____Compare___private_builtin__type_info_1_0)),
- (const Word *) &
- mercury_data_private_builtin__type_ctor_layout_type_info_1,
- (const Word *) &
- mercury_data_private_builtin__type_ctor_functors_type_info_1,
- (const Word *) string_const(""private_builtin"", 15),
- (const Word *) string_const(""type_info"", 9)
-};
+:- pragma c_code(table_lookup_insert_char(T0::in, C::in, T::out),
+ will_not_call_mercury, "
+ MR_DEBUG_NEW_TABLE_CHAR(T, T0, C);
+").
+:- pragma c_code(table_lookup_insert_string(T0::in, S::in, T::out),
+ will_not_call_mercury, "
+ MR_DEBUG_NEW_TABLE_STRING(T, T0, S);
+").
-const struct mercury_data_private_builtin__type_ctor_layout_type_info_1_struct {
- TYPE_LAYOUT_FIELDS
-} mercury_data_private_builtin__type_ctor_layout_type_info_1 = {
- make_typelayout_for_all_tags(TYPE_CTOR_LAYOUT_CONST_TAG,
- mkbody(MR_TYPE_CTOR_LAYOUT_TYPEINFO_VALUE))
-};
+:- pragma c_code(table_lookup_insert_float(T0::in, F::in, T::out),
+ will_not_call_mercury, "
+ MR_DEBUG_NEW_TABLE_FLOAT(T, T0, F);
+").
-const struct mercury_data_private_builtin__type_ctor_functors_type_info_1_struct {
- Integer f1;
-} mercury_data_private_builtin__type_ctor_functors_type_info_1 = {
- MR_TYPE_CTOR_FUNCTORS_SPECIAL
-};
+:- pragma c_code(table_lookup_insert_enum(T0::in, R::in, V::in, T::out),
+ will_not_call_mercury, "
+ MR_DEBUG_NEW_TABLE_ENUM(T, T0, R, V);
+").
-BEGIN_MODULE(type_info_module)
- init_entry(mercury____Unify___private_builtin__type_info_1_0);
- init_entry(mercury____Index___private_builtin__type_info_1_0);
- init_entry(mercury____Compare___private_builtin__type_info_1_0);
-BEGIN_CODE
-Define_entry(mercury____Unify___private_builtin__type_info_1_0);
-{
- /*
- ** Unification for type_info.
- **
- ** The two inputs are in the registers named by unify_input[12].
- ** The success/failure indication should go in unify_output.
- */
- int comp;
- save_transient_registers();
- comp = MR_compare_type_info(unify_input1, unify_input2);
- restore_transient_registers();
- unify_output = (comp == COMPARE_EQUAL);
- proceed();
-}
+:- pragma c_code(table_lookup_insert_user(T0::in, V::in, T::out),
+ will_not_call_mercury, "
+ MR_DEBUG_NEW_TABLE_ANY(T, T0, TypeInfo_for_T, V);
+").
-Define_entry(mercury____Index___private_builtin__type_info_1_0);
- index_output = -1;
- proceed();
+:- pragma c_code(table_lookup_insert_poly(T0::in, V::in, T::out),
+ will_not_call_mercury, "
+ Word T1;
+ MR_DEBUG_NEW_TABLE_TYPEINFO(T1, T0, TypeInfo_for_T);
+ MR_DEBUG_NEW_TABLE_ANY(T, T1, TypeInfo_for_T, V);
+").
-Define_entry(mercury____Compare___private_builtin__type_info_1_0);
-{
- /*
- ** Comparison for type_info:
- **
- ** The two inputs are in the registers named by compare_input[12].
- ** The result should go in compare_output.
- */
- int comp;
- save_transient_registers();
- comp = MR_compare_type_info(compare_input1, compare_input2);
- restore_transient_registers();
- compare_output = comp;
- proceed();
-}
-END_MODULE
+:- pragma c_code(table_save_int_ans(T::in, Offset::in, I::in),
+ will_not_call_mercury, "
+ MR_TABLE_SAVE_ANSWER(Offset, T, I,
+ mercury_data___type_ctor_info_int_0);
+").
-/* Ensure that the initialization code for the above module gets run. */
-/*
-INIT sys_init_type_info_module
-*/
-extern ModuleFunc type_info_module;
-void sys_init_type_info_module(void); /* suppress gcc -Wmissing-decl warning */
-void sys_init_type_info_module(void) {
- type_info_module();
-}
+:- pragma c_code(table_save_char_ans(T::in, Offset::in, C::in),
+ will_not_call_mercury, "
+ MR_TABLE_SAVE_ANSWER(Offset, T, 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_TABLE_SAVE_ANSWER(Offset, T, (Word) S,
+ mercury_data___type_ctor_info_string_0);
").
-:- pragma c_code(table_new_ans_slot(T::in, Slot::out),
+:- pragma c_code(table_save_float_ans(T::in, Offset::in, F::in),
will_not_call_mercury, "
- Word ListNode;
- Word ans_num;
- NondetTable *table = NON_TABLE(T);
- AnswerListNode *n = table_allocate_bytes(sizeof(AnswerListNode));
+ MR_TABLE_SAVE_ANSWER(Offset, T, float_to_word(F),
+ mercury_data___type_ctor_info_float_0);
+").
- ++table->num_ans;
- ans_num = table->num_ans;
- n->ans_num = ans_num;
- n->ans = 0;
- ListNode = MR_table_list_cons(n, *table->answer_list_tail);
- *table->answer_list_tail = ListNode;
- table->answer_list_tail = &list_tail(ListNode);
+:- pragma c_code(table_save_any_ans(T::in, Offset::in, V::in),
+ will_not_call_mercury, "
+ MR_TABLE_SAVE_ANSWER(Offset, T, V, TypeInfo_for_T);
+").
- Slot = (Word) &n->ans;
+:- pragma c_code(table_restore_int_ans(T::in, Offset::in, I::out),
+ will_not_call_mercury, "
+ I = (Integer) MR_TABLE_GET_ANSWER(Offset, T);
+").
+
+:- pragma c_code(table_restore_char_ans(T::in, Offset::in, C::out),
+ will_not_call_mercury, "
+ C = (Char) MR_TABLE_GET_ANSWER(Offset, T);
+").
+
+:- pragma c_code(table_restore_string_ans(T::in, Offset::in, S::out),
+ will_not_call_mercury, "
+ S = (String) MR_TABLE_GET_ANSWER(Offset, T);
+").
+
+:- pragma c_code(table_restore_float_ans(T::in, Offset::in, F::out),
+ will_not_call_mercury, "
+ F = word_to_float(MR_TABLE_GET_ANSWER(Offset, T));
").
-:- end_module private_builtin.
+:- pragma c_code(table_restore_any_ans(T::in, Offset::in, V::out),
+ will_not_call_mercury, "
+ V = (Word) MR_TABLE_GET_ANSWER(Offset, T);
+").
+:- pragma c_code(table_create_ans_block(T0::in, Size::in, T::out),
+ will_not_call_mercury, "
+ MR_TABLE_CREATE_ANSWER_BLOCK(T0, Size);
+ T = T0;
+").
+
+table_loopcheck_error(Message) :-
+ error(Message).
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
cvs diff: Diffing lp_solve
cvs diff: Diffing profiler
--------------------------------------------------------------------------
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