for review: minimal model tabling
Zoltan Somogyi
zs at cs.mu.OZ.AU
Sat Mar 20 21:33:39 AEDT 1999
For review by Fergus (or by Oliver, if he reads this).
Note that the diff to private_builtin.m is a mess, since I reorganized the
file into sections that make sense. I therefore also include the entire new
version, which is significantly shorter than the diff.
Estimated hours taken: 120
Rewrite significant parts of minimal model tabling so that it works
in a much wider variety of situations, including coups. Also, clean up
the tabling implementation to make it more maintainable.
compiler/options.m:
Add a new option --use-minimal-model, which for now is documented
as "not for general use". This option is required if minimal model
tabling is to work. It is among the grade options, but there is
no grade component that corresponds to this option yet, since
that would make experimental work with tabling unnecessarily more
difficult. We should probably make it a proper grade component when
minimal model tabling is ready for general use.
compiler/handle_options.m:
When --use-minimal-model is given, do not allow nondet frame hijacks,
since minimal model tabling cannot cope with hijacks.
compiler/code_info.m:
When --use-minimal-model is given, insert calls to MR_commit_{mark,cut}
around goals being committed across. This is now necessary, so that we
can detect and handle sitations where a goal being committed across
starts but does not complete a tabled goal.
compiler/table_gen.m:
Rename many of the tabling helper predicates, using a naming scheme
that separates predicates used for model_non procedures from those
used to implement simpler forms of tabling, while bringing out
the parallels between these two sets of predicates.
When calls to two tabling helper predicates always occur
one after the other, merge the two into one.
Generate and use more meaningful variable names; having all of the
several variables inserted by this transformation named TableVar
was quite confusing.
library/private_builtin.m:
Reorganize this file, to separate out the different sections.
The contents of the non-tabling sections were not modified, only
moved around.
Rename the predicates referred to by table_gen.m.
Move most of the type declarations and complex code out of here,
into runtime/mercury_tabling.c. This makes it easier to debug them,
since (a) creating a new executable is quicker, since you don't have
to wait for lots of mercury compiler invocations, and (b) gdb doesn't
get confused by #line directives. It also makes it easier to write
them, since you don't have to !&(*U&( remember to double all your
double quotes and to backslash all your backslashes.
runtime/mercury_tabling.[ch]:
The implementation of the new tabling system. Much of the new code here
is stuff moved from library/private_builtin.m, but in a significantly
rewritten form. There is also substantial new code, e.g. to handle
the extension of saved stack segments, and to manage dependencies
between subgoals in general.
runtime/mercury_stacks.[ch]:
The changes to tabling require the addition of two new stacks,
the generator stack and the cut stack. This module defines the
structures of the frames of these stacks and provides the
operations on these stacks.
The header file also contains some additional macros that return
the addresses of fixed nondet stack slots, not their contents,
for use by tabling code.
runtime/mercury_context.[ch]:
runtime/mercury_memory.[ch]:
runtime/mercury_wrapper.[ch]:
Declare and set up the two new stacks, both in saved contexts and in
the active context.
runtime/mercury_engine.h:
runtime/mercury_wrapper.c:
Add support for a new debugging flag, -dS, which prints the contents
of the nondet stack at several points during tabling.
runtime/mercury_tabling.[ch]:
Move the significantly reimplemented code that handles minimal model
tabling here from library/private_builtin.m.
Improve the documentation considerably.
Replace lists stored as Mercury data structures with lists stored
as linked structures in the usual C fashion. This allows us to use
debuggers such as ddd on these data structures, whose complexity
requires this.
Ensure that global names start with MR_.
runtime/mercury_init.h:
Explicitly include mercury_regs.h at the start. Without this,
we get an error, because now mercury_wrappers.h, which mercury_init.h
includes, also includes mercury_regs.h, but not before functions
have been declared.
runtime/Mmakefile:
Refer to the new file mercury_stacks.c (mercury_stacks.h already
existed, but the module consisted entirely of macros.)
Fix a sorting error.
tests/tabling/*
Add several new test cases that we now pass, most of which we couldn't
pass before. Also add some new test cases that we don't pass yet,
due to interactions between tabling and negated contexts.
trace/mercury_trace_internal.c:
Add a new command to print the generator stack.
doc/mdb_doc:
Document the new command to print the generator stack.
Zoltan.
cvs diff: Diffing .
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing bytecode/test
cvs diff: Diffing compiler
Index: compiler/code_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_info.m,v
retrieving revision 1.236
diff -u -b -u -r1.236 code_info.m
--- code_info.m 1999/03/12 05:53:24 1.236
+++ code_info.m 1999/03/16 22:10:14
@@ -36,7 +36,7 @@
:- implementation.
-:- import_module code_util, code_exprn, prog_out.
+:- import_module code_util, code_exprn, llds_out, prog_out.
:- import_module arg_info, type_util, mode_util, options.
:- import_module term, varset.
@@ -1694,8 +1694,10 @@
:- type commit_hijack_info
---> commit_temp_frame(
- lval % The stack slot in which we saved
+ lval, % The stack slot in which we saved
% the old value of maxfr.
+ bool % Do we bracket the goal with
+ % MR_commit_mark and MR_commit_cut?
)
; commit_quarter_hijack
; commit_half_hijack(
@@ -1728,14 +1730,32 @@
{ Allow = not_allowed ; CondEnv = inside_non_condition }
->
code_info__acquire_temp_slot(lval(maxfr), MaxfrSlot),
- { HijackInfo = commit_temp_frame(MaxfrSlot) },
{ MaxfrCode = node([
assign(MaxfrSlot, lval(maxfr))
- "prepare for temp frame commit"
]) },
code_info__create_temp_frame(StackLabel,
"prepare for temp frame commit", TempFrameCode),
- { HijackCode = tree(MaxfrCode, TempFrameCode) }
+ code_info__get_globals(Globals),
+ { globals__lookup_bool_option(Globals, use_minimal_model,
+ UseMinimalModel) },
+ { HijackInfo = commit_temp_frame(MaxfrSlot, UseMinimalModel) },
+ {
+ UseMinimalModel = yes,
+ Components = [
+ pragma_c_raw_code("\tsave_transient_registers();\n"),
+ pragma_c_raw_code("\tMR_commit_mark();\n"),
+ pragma_c_raw_code("\trestore_transient_registers();\n")
+ ],
+ MarkCode = node([
+ pragma_c([], Components, will_not_call_mercury,
+ no, no) - ""
+ ])
+ ;
+ UseMinimalModel = no,
+ MarkCode = empty
+ },
+ { HijackCode = tree(MaxfrCode, tree(TempFrameCode, MarkCode)) }
;
{ ResumeKnown = resume_point_known },
{ CurfrMaxfr = must_be_equal }
@@ -1749,6 +1769,7 @@
{ CurfrMaxfr = must_be_equal }
->
% Here ResumeKnown must be resume_point_unknown.
+
code_info__acquire_temp_slot(lval(redoip(lval(curfr))),
RedoipSlot),
{ HijackInfo = commit_half_hijack(RedoipSlot) },
@@ -1792,12 +1813,27 @@
code_info__set_fail_info(FailInfo),
% XXX should release the temp slots in each arm of the switch
(
- { HijackInfo = commit_temp_frame(MaxfrSlot) },
- { SuccessUndoCode = node([
+ { HijackInfo = commit_temp_frame(MaxfrSlot, UseMinimalModel) },
+ { MaxfrCode = node([
assign(maxfr, lval(MaxfrSlot))
- - "restore maxfr for full commit hijack"
+ - "restore maxfr for temp frame hijack"
]) },
- { FailureUndoCode = SuccessUndoCode }
+ {
+ UseMinimalModel = yes,
+ Components = [
+ pragma_c_raw_code("\tMR_commit_cut();\n")
+ ],
+ CutCode = node([
+ pragma_c([], Components,
+ will_not_call_mercury, no, no)
+ - "commit for temp frame hijack"
+ ])
+ ;
+ UseMinimalModel = no,
+ CutCode = empty
+ },
+ { SuccessUndoCode = tree(MaxfrCode, CutCode) },
+ { FailureUndoCode = tree(MaxfrCode, CutCode) }
;
{ HijackInfo = commit_quarter_hijack },
{ FailInfo = fail_info(ResumePoints, _, _, _, _) },
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.70
diff -u -b -u -r1.70 handle_options.m
--- handle_options.m 1998/12/09 03:26:21 1.70
+++ handle_options.m 1999/03/16 21:51:48
@@ -398,6 +398,14 @@
% --use-trail.
option_implies(use_trail, optimize_value_number, bool(no)),
+ % Minimal model tabling needs to be able to rewrite all the redoips
+ % in a given nondet stack segments. If we allow hijacks, some of these
+ % redoips may have been saved in ordinary framevars, which means that
+ % tabling can't find them without label layout info. Since we want
+ % to allow tabling in grades that do not have label layout info,
+ % we disable hijacks instead.
+ option_implies(use_minimal_model, allow_hijacks, bool(no)),
+
% --dump-hlds and --statistics require compilation by phases
globals__io_lookup_accumulating_option(dump_hlds, DumpStages),
globals__io_lookup_bool_option(statistics, Statistics),
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.253
diff -u -b -u -r1.253 options.m
--- options.m 1999/03/19 01:43:40 1.253
+++ options.m 1999/03/19 06:15:14
@@ -140,6 +140,7 @@
; stack_trace
; require_tracing
; use_trail
+ ; use_minimal_model
; pic_reg
; tags
; num_tag_bits
@@ -454,6 +455,7 @@
require_tracing - bool(no),
stack_trace - bool(no),
use_trail - bool(no),
+ use_minimal_model - bool(no),
pic_reg - bool(no),
tags - string("low"),
num_tag_bits - int(-1),
@@ -810,6 +812,7 @@
% long_option("stack-trace", stack_trace).
% long_option("require-tracing", require_tracing).
long_option("use-trail", use_trail).
+long_option("use-minimal-model", use_minimal_model).
long_option("pic-reg", pic_reg).
long_option("tags", tags).
long_option("num-tag-bits", num_tag_bits).
@@ -1777,6 +1780,12 @@
% "\tKeeps typeinfo variables around for as long as any data",
% "\tthat has a type that contains that type variable is live",
%
+ "--use-minimal-model",
+ "(This option is not for general use.)",
+ "\tEnable the use of minimal model tabling.",
+ "\tYou must compile the entire program with this option",
+ "\tif any part of the program uses `:- pragma minimal_model'.",
+
"--unboxed-float",
"(This option is not for general use.)",
"\tDon't box floating point numbers.",
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.6
diff -u -b -u -r1.6 table_gen.m
--- table_gen.m 1998/11/24 03:57:20 1.6
+++ table_gen.m 1999/03/17 07:57:42
@@ -1,10 +1,11 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 1997-1998 The University of Melbourne.
+% Copyright (C) 1997-1999 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% Main author: ohutch
+% Significant modifications by zs.
%
% This module transforms HLDS code to a form that allows tabled evaluation,
% minimal model evaluation and loop detection. The tabling transformation
@@ -26,8 +27,13 @@
% the semantics behind the transformation. Currently only SLGd is
% implemented.
%
-% XXX the current implementation of minimal_model tabling is buggy;
-% e.g. it fails for tests/tabling/coup.m.
+% The current implementation does not attempt to do anything special
+% to handle cases where tabling interacts with if-then-else, solutions,
+% and negated contexts in general. Such situations are not even detected,
+% since the cost of such detection is quite substantial, and this cost
+% would be "distributed fat". Therefore in such cases the system may
+% silently produce incorrect answers. For time being, this is not a bug,
+% but a missing feature :-)
%
% Example of transformation for semidet minimal_model :
%
@@ -49,18 +55,18 @@
% impure table_lookup_insert_int(T0, A, T1),
% impure table_lookup_insert_int(T1, B, T2),
% (if
-% semipure table_have_ans(T2)
+% semipure table_simple_is_complete(T2)
% then
% % True if the subgoal has already succeeded
-% semipure table_has_succeeded(T2)
+% semipure table_simple_has_succeeded(T2)
% else
% (if
% % Fail if we are already working on
% % an ans for this subgoal
-% semipure table_not_working_on_ans(T2),
+% semipure table_simple_is_inactive(T2),
%
% % Mark this subgoal as being evaluated
-% impure table_mark_as_working(T2),
+% impure table_simple_mark_as_active(T2),
%
% (
% %
@@ -68,9 +74,9 @@
% %
% )
% then
-% impure table_mark_as_succeeded(T2)
+% impure table_simple_mark_as_succeeded(T2)
% else
-% impure table_mark_as_failed(T2)
+% impure table_simple_mark_as_failed(T2)
% )
% ).
%
@@ -87,30 +93,30 @@
% The transformed code would be :
%
% p(A, B) :-
-% % Code to get a handle on the table
+% % Code to get a handle on the table.
% T0 = <table pointer for p/2>,
%
-% % Code to lookup input arguments and setup table
+% % Code to lookup input arguments and setup table.
% impure table_lookup_insert_int(T0, A, T1),
-% impure table_setup(T1, T2),
+% impure table_nondet_setup(T1, T2),
% (if
-% semipure table_have_all_ans(T2)
+% semipure table_nondet_is_complete(T2)
% then
% % Code to return all ans if we have found
-% % them
-% impure table_return_all_ans(T2, Ans),
+% % them.
+% impure table_nondet_return_all_ans(T2, Ans),
% impure table_restore_int_ans(Ans, 0, B)
% else if
-% semipure table_have_some_ans(T2)
+% semipure table_nondet_is_active(T2)
% then
% % Code to suspend the current computational
-% % branch
-% impure table_suspend(T2, Ans),
+% % branch.
+% impure table_nondet_suspend(T2, Ans),
% impure table_restore_int_ans(Ans, 0, B)
% else
% ( % Mark that this subgoal is being
-% % evaluated
-% impure table_mark_have_some_ans(T2),
+% % evaluated.
+% impure table_nondet_mark_as_active(T2),
%
% (
% %
@@ -119,29 +125,25 @@
% ),
%
% % Code to check for duplicate
-% % answers
-% impure table_get_ans_table(T2, AT0),
+% % answers.
+% impure table_nondet_get_ans_table(T2, AT0),
% impure table_lookup_insert_int(AT0, B, AT1),
%
-% % The following pred is semidet
+% % The following pred is semidet;
% % it will fail if the answer is
% % already in the table.
-% semipure table_has_not_returned(AT1),
+% semipure table_nondet_answer_is_not_dupl(AT1),
%
% % Code to save a new ans in the
% % table.
-% impure table_mark_as_returned(AT1),
-% impure table_new_ans_slot(T2, AS),
+% impure table_nondet_new_ans_slot(T2, AS),
% impure table_create_ans_block(AS, 1, AB),
% impure table_save_int_ans(AB, 0, B)
-% ;
-% % Code to resume suspended nodes.
-% impure table_resume(T2),
-% fail
% ;
-% % Code to mark the current subgoal
+% % Code to resume all suspended nodes,
+% % and then mark the current subgoal
% % as totally evaluated.
-% impure table_mark_have_all_ans(T2),
+% impure table_nondet_resume(T2),
% fail
% )
% ).
@@ -153,6 +155,7 @@
% dropped and the loop handling code is modified to call an error predicate.
%
%-----------------------------------------------------------------------------%
+
:- module table_gen.
:- interface.
@@ -178,7 +181,7 @@
%-----------------------------------------------------------------------------%
- % NOTE : following preds seem to duplicate the code in passes_aux.m.
+ % NOTE: following preds seem to duplicate the code in passes_aux.m.
% This is not strictly true as the following code saved the value of
% the pred_info and passes this value on to the code for handling
% each of the procedures.
@@ -303,14 +306,14 @@
generate_det_lookup_goal(InputVars, Module, PredId, ProcId,
VarTypes0, VarTypes1, VarSet0, VarSet1, TableVar, LookUpGoal),
- generate_call("table_have_ans", [TableVar], semidet, semipure,
- [], Module, HaveAnsCheckGoal),
+ generate_call("table_simple_is_complete", [TableVar], semidet, semipure,
+ [], Module, CompleteCheckGoal),
generate_save_goal(OutputVars, TableVar, VarTypes1, VarTypes2,
VarSet1, VarSet2, Module, SaveAnsGoal0),
generate_restore_goal(OutputVars, TableVar, Module, VarTypes2,
VarTypes3, VarSet2, VarSet3, RestoreAnsGoal),
- generate_call("table_mark_done_working", [TableVar], det, impure,
- [], Module, DoneWorkingGoal),
+ generate_call("table_simple_mark_as_inactive", [TableVar], det, impure,
+ [], Module, MarkAsInactiveGoal),
generate_loop_error_goal(PredInfo, Module, VarTypes3, VarTypes,
VarSet3, VarSet, LoopErrorGoal),
@@ -321,23 +324,22 @@
set__insert(OrigNonLocals, TableVar, GenAnsNonLocals),
( EvalMethod = eval_loop_check ->
- SaveAnsGoal = DoneWorkingGoal
+ SaveAnsGoal = MarkAsInactiveGoal
; EvalMethod = eval_memo ->
SaveAnsGoal = SaveAnsGoal0
;
error(
"table_gen__create_new_det_goal: unsupported evaluation model")
),
+
+ generate_call("table_simple_is_active", [TableVar], semidet,
+ semipure, [], Module, ActiveCheckGoal),
+ generate_call("table_simple_mark_as_active", [TableVar], det,
+ impure, [], Module, MarkAsActiveGoal),
- generate_call("table_working_on_ans", [TableVar], semidet,
- semipure, [], Module, WorkingCheckGoal),
- generate_call("table_mark_as_working", [TableVar], det,
- impure, [], Module, MarkAsWorkingGoal),
-
- NoLoopGenAnsGoalEx = conj([MarkAsWorkingGoal, OrigGoal,
- SaveAnsGoal]),
- create_instmap_delta([MarkAsWorkingGoal, OrigGoal,
- SaveAnsGoal], NoLoopGenInstMapDelta0),
+ NoLoopGenAnsGoalEx = conj([MarkAsActiveGoal, OrigGoal, SaveAnsGoal]),
+ create_instmap_delta([MarkAsActiveGoal, OrigGoal, SaveAnsGoal],
+ NoLoopGenInstMapDelta0),
instmap_delta_restrict(NoLoopGenInstMapDelta0, GenAnsNonLocals,
NoLoopGenInstMapDelta),
goal_info_init(GenAnsNonLocals, NoLoopGenInstMapDelta, det,
@@ -345,9 +347,9 @@
NoLoopGenAnsGoal = NoLoopGenAnsGoalEx - NoLoopGenGoalInfo,
map__init(StoreMap),
- GenAnsGoalEx = if_then_else([], WorkingCheckGoal,
+ GenAnsGoalEx = if_then_else([], ActiveCheckGoal,
LoopErrorGoal, NoLoopGenAnsGoal, StoreMap),
- create_instmap_delta([WorkingCheckGoal, LoopErrorGoal,
+ create_instmap_delta([ActiveCheckGoal, LoopErrorGoal,
NoLoopGenAnsGoal], GenAnsInstMapDelta0),
instmap_delta_restrict(GenAnsInstMapDelta0, GenAnsNonLocals,
GenAnsInstMapDelta),
@@ -356,9 +358,9 @@
GenAnsGoal = GenAnsGoalEx - GenAnsGoalInfo,
- ITEGoalEx = if_then_else([], HaveAnsCheckGoal, RestoreAnsGoal,
+ ITEGoalEx = if_then_else([], CompleteCheckGoal, RestoreAnsGoal,
GenAnsGoal, StoreMap),
- create_instmap_delta([HaveAnsCheckGoal, RestoreAnsGoal, GenAnsGoal],
+ create_instmap_delta([CompleteCheckGoal, RestoreAnsGoal, GenAnsGoal],
ITEInstMapDelta0),
instmap_delta_restrict(ITEInstMapDelta0, GenAnsNonLocals,
ITEInstMapDelta),
@@ -391,20 +393,20 @@
generate_det_lookup_goal(InputVars, Module, PredId, ProcId,
VarTypes0, VarTypes1, VarSet0, VarSet1, TableVar, LookUpGoal),
- generate_call("table_have_ans", [TableVar], semidet, semipure,
- [], Module, HaveAnsCheckGoal),
+ generate_call("table_simple_is_complete", [TableVar],
+ semidet, semipure, [], Module, CompleteCheckGoal),
generate_save_goal(OutputVars, TableVar, VarTypes1, VarTypes2,
VarSet1, VarSet2, Module, SaveAnsGoal0),
generate_restore_goal(OutputVars, TableVar, Module, VarTypes2,
VarTypes3, VarSet2, VarSet3, RestoreTrueAnsGoal),
generate_loop_error_goal(PredInfo, Module, VarTypes3, VarTypes,
VarSet3, VarSet, LoopErrorGoal),
- generate_call("table_mark_as_failed", [TableVar], failure, impure,
- [], Module, MarkAsFailedGoal),
- generate_call("table_has_succeeded", [TableVar], semidet, semipure,
- [], Module, HasSucceededCheckGoal),
- generate_call("table_mark_done_working", [TableVar], det, impure,
- [], Module, DoneWorkingGoal),
+ generate_call("table_simple_mark_as_failed", [TableVar],
+ failure, impure, [], Module, MarkAsFailedGoal),
+ generate_call("table_simple_has_succeeded", [TableVar],
+ semidet, semipure, [], Module, HasSucceededCheckGoal),
+ generate_call("table_simple_mark_as_inactive", [TableVar],
+ det, impure, [], Module, MarkAsInactiveGoal),
OrigGoal = _ - OrigGoalInfo,
goal_info_get_nonlocals(OrigGoalInfo, OrigNonLocals),
@@ -423,17 +425,17 @@
(
EvalMethod = eval_loop_check
->
- SaveAnsGoal = DoneWorkingGoal
+ SaveAnsGoal = MarkAsInactiveGoal
;
SaveAnsGoal = SaveAnsGoal0
),
- generate_call("table_working_on_ans", [TableVar], semidet,
- semipure, [], Module, WorkingCheckGoal),
- generate_call("table_mark_as_working", [TableVar], det,
- impure, [], Module, MarkAsWorkingGoal),
+ generate_call("table_simple_is_active", [TableVar], semidet,
+ semipure, [], Module, ActiveCheckGoal),
+ generate_call("table_simple_mark_as_active", [TableVar], det,
+ impure, [], Module, MarkAsActiveGoal),
- NoLoopGenAnsGoalEx = conj([MarkAsWorkingGoal, OrigGoal]),
- create_instmap_delta([MarkAsWorkingGoal, OrigGoal],
+ NoLoopGenAnsGoalEx = conj([MarkAsActiveGoal, OrigGoal]),
+ create_instmap_delta([MarkAsActiveGoal, OrigGoal],
NoLoopGenInstMapDelta0),
instmap_delta_restrict(NoLoopGenInstMapDelta0, GenAnsNonLocals,
NoLoopGenInstMapDelta),
@@ -441,9 +443,9 @@
NoLoopGenGoalInfo),
NoLoopGenAnsGoal = NoLoopGenAnsGoalEx - NoLoopGenGoalInfo,
- GenTrueAnsGoalEx = if_then_else([], WorkingCheckGoal,
+ GenTrueAnsGoalEx = if_then_else([], ActiveCheckGoal,
LoopErrorGoal, NoLoopGenAnsGoal, StoreMap),
- create_instmap_delta([WorkingCheckGoal, LoopErrorGoal,
+ create_instmap_delta([ActiveCheckGoal, LoopErrorGoal,
NoLoopGenAnsGoal], GenTrueAnsInstMapDelta0),
instmap_delta_restrict(GenTrueAnsInstMapDelta0,
GenAnsNonLocals, GenTrueAnsInstMapDelta),
@@ -456,16 +458,16 @@
->
SaveAnsGoal = SaveAnsGoal0,
- generate_call("table_not_working_on_ans", [TableVar], semidet,
- semipure, [], Module, NotWorkingCheckGoal),
+ generate_call("table_simple_is_inactive", [TableVar], semidet,
+ semipure, [], Module, InactiveCheckGoal),
- generate_call("table_mark_as_working", [TableVar], det,
- impure, [], Module, MarkAsWorkingGoal),
+ generate_call("table_simple_mark_as_active", [TableVar], det,
+ impure, [], Module, MarkAsActiveGoal),
- GenTrueAnsGoalEx = conj([NotWorkingCheckGoal,
- MarkAsWorkingGoal, OrigGoal]),
+ GenTrueAnsGoalEx = conj([InactiveCheckGoal,
+ MarkAsActiveGoal, OrigGoal]),
- create_instmap_delta([NotWorkingCheckGoal, MarkAsWorkingGoal,
+ create_instmap_delta([InactiveCheckGoal, MarkAsActiveGoal,
OrigGoal, SaveAnsGoal], GenTrueAnsInstMapDelta0),
instmap_delta_restrict(GenTrueAnsInstMapDelta0,
GenAnsNonLocals, GenTrueAnsInstMapDelta),
@@ -499,9 +501,9 @@
GenAnsGoalInfo),
GenAnsGoal = GenAnsGoalEx - GenAnsGoalInfo,
- ITEGoalEx = if_then_else([], HaveAnsCheckGoal, RestoreAnsGoal,
+ ITEGoalEx = if_then_else([], CompleteCheckGoal, RestoreAnsGoal,
GenAnsGoal, StoreMap),
- create_instmap_delta([HaveAnsCheckGoal, RestoreAnsGoal, GenAnsGoal],
+ create_instmap_delta([CompleteCheckGoal, RestoreAnsGoal, GenAnsGoal],
ITEInstMapDelta0),
instmap_delta_restrict(ITEInstMapDelta0, GenAnsNonLocals,
ITEInstMapDelta),
@@ -534,24 +536,22 @@
generate_non_lookup_goal(InputVars, Module, PredId, ProcId,
VarTypes0, VarTypes1, VarSet0, VarSet1, TableVar, LookUpGoal),
- generate_call("table_have_all_ans", [TableVar], semidet, semipure,
- [], Module, HaveAllAnsCheckGoal),
+ generate_call("table_nondet_is_complete", [TableVar], semidet, semipure,
+ [], Module, CompleteCheckGoal),
generate_non_save_goal(OutputVars, TableVar, VarTypes1, VarTypes2,
VarSet1, VarSet2, Module, SaveAnsGoal0),
generate_restore_all_goal(OutputVars, TableVar, Module, VarTypes2,
VarTypes3, VarSet2, VarSet3, RestoreAllAnsGoal),
- generate_call("table_have_some_ans", [TableVar], semidet, semipure,
- [], Module, HaveSomeAnsCheckGoal),
+ generate_call("table_nondet_is_active", [TableVar], semidet, semipure,
+ [], Module, IsActiveCheckGoal),
generate_suspend_goal(OutputVars, TableVar, Module, VarTypes3,
VarTypes4, VarSet3, VarSet4, SuspendGoal),
generate_loop_error_goal(PredInfo, Module, VarTypes4, VarTypes,
VarSet4, VarSet, LoopErrorGoal),
- generate_call("table_mark_have_some_ans", [TableVar], det, impure,
- [], Module, MarkHaveSomeAnsGoal),
- generate_call("table_resume", [TableVar], failure, impure,
+ generate_call("table_nondet_mark_as_active", [TableVar], det, impure,
+ [], Module, MarkAsActiveGoal),
+ generate_call("table_nondet_resume", [TableVar], failure, impure,
[], Module, ResumeGoal0),
- generate_call("table_mark_have_all_ans", [TableVar], failure, impure,
- [], Module, MarkHaveAllAnsGoal),
true_goal(TrueGoal),
fail_goal(FailGoal),
@@ -565,25 +565,25 @@
EvalMethod = eval_memo
->
SaveAnsGoal = SaveAnsGoal0,
- WorkingOnAnsGoal = LoopErrorGoal
+ ActiveGoal = LoopErrorGoal
;
EvalMethod = eval_loop_check
->
SaveAnsGoal = TrueGoal,
- WorkingOnAnsGoal = LoopErrorGoal
+ ActiveGoal = LoopErrorGoal
;
EvalMethod = eval_minimal
->
SaveAnsGoal = SaveAnsGoal0,
- WorkingOnAnsGoal = SuspendGoal
+ ActiveGoal = SuspendGoal
;
error(
"table_gen__create_new_non_goal: unsupported evaluation model")
),
- GenAnsGoalPart1Ex = conj([MarkHaveSomeAnsGoal, OrigGoal, SaveAnsGoal]),
+ GenAnsGoalPart1Ex = conj([MarkAsActiveGoal, OrigGoal, SaveAnsGoal]),
set__insert(OrigNonLocals, TableVar, GenAnsGoalPart1NonLocals),
- create_instmap_delta([MarkHaveSomeAnsGoal, OrigGoal, SaveAnsGoal],
+ create_instmap_delta([MarkAsActiveGoal, OrigGoal, SaveAnsGoal],
GenAnsGoalPart1IMD0),
instmap_delta_restrict(GenAnsGoalPart1IMD0, GenAnsGoalPart1NonLocals,
GenAnsGoalPart1IMD),
@@ -598,11 +598,10 @@
;
ResumeGoal = FailGoal
),
- GenAnsGoalEx = disj([GenAnsGoalPart1, ResumeGoal, MarkHaveAllAnsGoal],
- StoreMap),
+ GenAnsGoalEx = disj([GenAnsGoalPart1, ResumeGoal], StoreMap),
GenAnsGoal = GenAnsGoalEx - GenAnsGoalPart1GoalInfo,
- ITE1GoalEx = if_then_else([], HaveSomeAnsCheckGoal, WorkingOnAnsGoal,
+ ITE1GoalEx = if_then_else([], IsActiveCheckGoal, ActiveGoal,
GenAnsGoal, StoreMap),
ITE1Goal = ITE1GoalEx - GenAnsGoalPart1GoalInfo,
@@ -611,7 +610,7 @@
->
ITE2Goal = ITE1Goal
;
- ITE2GoalEx = if_then_else([], HaveAllAnsCheckGoal,
+ ITE2GoalEx = if_then_else([], CompleteCheckGoal,
RestoreAllAnsGoal, ITE1Goal, StoreMap),
ITE2Goal = ITE2GoalEx - GenAnsGoalPart1GoalInfo
),
@@ -628,18 +627,19 @@
:- mode generate_get_table_goal(in, out, in, out, in, in, out, out) is det.
generate_get_table_goal(VarTypes0, VarTypes, VarSet0, VarSet,
- PredId, ProcId, TableVar, Goal) :-
- generate_new_table_var(VarTypes0, VarTypes, VarSet0, VarSet, TableVar),
+ PredId, ProcId, PredTableVar, Goal) :-
+ generate_new_table_var("PredTable", VarTypes0, VarTypes,
+ VarSet0, VarSet, PredTableVar),
ConsId = tabling_pointer_const(PredId, ProcId),
- TableVarInst = ground(unique, no),
- UnifyMode = (free -> TableVarInst) - (TableVarInst -> TableVarInst),
+ VarInst = ground(unique, no),
+ UnifyMode = (free -> VarInst) - (VarInst -> VarInst),
UnifyContext = unify_context(explicit, []),
- GoalExpr = unify(TableVar, functor(ConsId, []), UnifyMode,
- construct(TableVar, ConsId, [], []), UnifyContext),
+ GoalExpr = unify(PredTableVar, functor(ConsId, []), UnifyMode,
+ construct(PredTableVar, ConsId, [], []), UnifyContext),
- set__singleton_set(NonLocals, TableVar),
- instmap_delta_from_assoc_list([TableVar - TableVarInst],
+ set__singleton_set(NonLocals, PredTableVar),
+ instmap_delta_from_assoc_list([PredTableVar - VarInst],
InstMapDelta),
goal_info_init(NonLocals, InstMapDelta, det,
GoalInfo0),
@@ -658,8 +658,8 @@
VarSet0, VarSet, TableVar, Goal) :-
generate_get_table_goal(VarTypes0, VarTypes1, VarSet0, VarSet1,
- PredId, ProcId, TableVar0, GetTableGoal),
- generate_lookup_goals(Vars, TableVar0, TableVar, Module,
+ PredId, ProcId, PredTableVar, GetTableGoal),
+ generate_lookup_goals(Vars, PredTableVar, TableVar, Module,
VarTypes1, VarTypes, VarSet1, VarSet, LookupGoals),
GoalEx = conj([GetTableGoal | LookupGoals]),
@@ -676,20 +676,21 @@
is det.
generate_non_lookup_goal(Vars, Module, PredId, ProcId, VarTypes0, VarTypes,
- VarSet0, VarSet, TableVar, Goal) :-
+ VarSet0, VarSet, SubgoalVar, Goal) :-
generate_get_table_goal(VarTypes0, VarTypes1, VarSet0, VarSet1,
- PredId, ProcId, TableVar0, GetTableGoal),
- generate_lookup_goals(Vars, TableVar0, TableVar1, Module,
+ PredId, ProcId, PredTableVar, GetTableGoal),
+ generate_lookup_goals(Vars, PredTableVar, TableNodeVar, Module,
VarTypes1, VarTypes2, VarSet1, VarSet2, LookupGoals),
- generate_new_table_var(VarTypes2, VarTypes, VarSet2, VarSet,
- TableVar),
- generate_call("table_setup", [TableVar1, TableVar], det, impure,
- [TableVar - ground(unique, no)], Module, SetupGoal),
+ generate_new_table_var("SubgoalVar", VarTypes2, VarTypes,
+ VarSet2, VarSet, SubgoalVar),
+ generate_call("table_nondet_setup", [TableNodeVar, SubgoalVar],
+ det, impure, [SubgoalVar - ground(unique, no)],
+ Module, SetupGoal),
list__append([GetTableGoal | LookupGoals], [SetupGoal], Goals),
GoalEx = conj(Goals),
- set__singleton_set(NonLocals0, TableVar),
+ set__singleton_set(NonLocals0, SubgoalVar),
set__insert_list(NonLocals0, Vars, NonLocals),
create_instmap_delta(Goals, InstMapDelta0),
instmap_delta_restrict(InstMapDelta0, NonLocals, InstMapDelta),
@@ -743,12 +744,14 @@
VarTypes1, VarSet0, VarSet1, RangeVar,
RangeUnifyGoal),
- generate_new_table_var(VarTypes1, VarTypes, VarSet1,
- VarSet, NextTableVar),
- generate_call("table_lookup_insert_enum", [TableVar,
- RangeVar, ArgVar, NextTableVar], det, impure,
- [NextTableVar - ground(unique, no)], Module,
- LookupGoal),
+ generate_new_table_var("TableNodeVar",
+ VarTypes1, VarTypes, VarSet1, VarSet,
+ NextTableVar),
+ generate_call("table_lookup_insert_enum",
+ [TableVar, RangeVar, ArgVar, NextTableVar],
+ det, impure,
+ [NextTableVar - ground(unique, no)],
+ Module, LookupGoal),
set__init(NonLocals0),
set__insert_list(NonLocals0, [TableVar, ArgVar],
NonLocals),
@@ -780,8 +783,8 @@
string__append("table_lookup_insert_", CatString,
LookupPredName)
),
- generate_new_table_var(VarTypes0, VarTypes, VarSet0, VarSet,
- NextTableVar),
+ generate_new_table_var("TableNodeVar", VarTypes0, VarTypes,
+ VarSet0, VarSet, NextTableVar),
generate_call(LookupPredName, [TableVar, ArgVar, NextTableVar],
det, impure, [NextTableVar - ground(unique, no)],
Module, Goal)
@@ -805,22 +808,22 @@
VarTypes1, VarSet0, VarSet1, NumAnsVarsVar,
NumAnsVarsUnifyGoal),
- generate_new_table_var(VarTypes1, VarTypes2, VarSet1, VarSet2,
- AnsTableVar),
+ generate_new_table_var("AnswerTableVar", VarTypes1, VarTypes2,
+ VarSet1, VarSet2, AnsTableVar),
- generate_call("table_create_ans_block", [TableVar,
- NumAnsVarsVar, AnsTableVar], det, impure,
+ generate_call("table_create_ans_block",
+ [TableVar, NumAnsVarsVar, AnsTableVar], det, impure,
[AnsTableVar - ground(unique, no)], Module,
- GenAnsBlockGoal),
+ CreateAnsBlockGoal),
generate_save_goals(AnsList, AnsTableVar, 0, Module,
VarTypes2, VarTypes, VarSet2, VarSet, SaveGoals),
- GoalEx = conj([NumAnsVarsUnifyGoal, GenAnsBlockGoal |
+ GoalEx = conj([NumAnsVarsUnifyGoal, CreateAnsBlockGoal |
SaveGoals]),
set__singleton_set(NonLocals0, TableVar),
set__insert_list(NonLocals0, AnsList, NonLocals),
- create_instmap_delta([NumAnsVarsUnifyGoal, GenAnsBlockGoal |
+ create_instmap_delta([NumAnsVarsUnifyGoal, CreateAnsBlockGoal |
SaveGoals], InstMapDelta0),
instmap_delta_restrict(InstMapDelta0, NonLocals, InstMapDelta),
goal_info_init(NonLocals, InstMapDelta, det, GoalInfo),
@@ -837,42 +840,41 @@
module_info, hlds_goal).
:- mode generate_non_save_goal(in, in, in, out, in, out, in, out) is det.
-generate_non_save_goal(AnsList, TableVar, VarTypes0, VarTypes, VarSet0,
- VarSet, Module, Goal) :-
+generate_non_save_goal(AnsList, TableVar, VarTypes0, VarTypes,
+ VarSet0, VarSet, Module, Goal) :-
- generate_new_table_var(VarTypes0, VarTypes1, VarSet0, VarSet1,
- AnsTableVar0),
- generate_call("table_get_ans_table", [TableVar, AnsTableVar0], det,
- impure, [AnsTableVar0 - ground(unique, no)], Module,
- GetAnsTableGoal),
+ generate_new_table_var("AnswerTableVar", VarTypes0, VarTypes1,
+ VarSet0, VarSet1, AnsTableVar0),
+ generate_call("table_nondet_get_ans_table", [TableVar, AnsTableVar0],
+ det, impure, [AnsTableVar0 - ground(unique, no)],
+ Module, GetAnsTableGoal),
generate_lookup_goals(AnsList, AnsTableVar0, AnsTableVar1, Module,
VarTypes1, VarTypes2, VarSet1, VarSet2, LookupAnsGoals),
- generate_call("table_has_not_returned", [AnsTableVar1], semidet,
- semipure, [], Module, NewAnsCheckGoal),
- generate_call("table_mark_as_returned", [AnsTableVar1], det, impure,
- [], Module, MarkAsReturnedGoal),
-
- generate_new_table_var(VarTypes2, VarTypes3, VarSet2, VarSet3,
- AnsBlockVar0),
- generate_call("table_new_ans_slot", [TableVar, AnsBlockVar0], det,
- impure, [AnsBlockVar0 - ground(unique, no)], Module,
- GenAnsSlotGoal),
+ generate_call("table_nondet_answer_is_not_duplicate", [AnsTableVar1],
+ semidet, impure, [], Module, DuplicateCheckGoal),
+
+ generate_new_table_var("AnswerSlotVar", VarTypes2, VarTypes3,
+ VarSet2, VarSet3, AnsSlotVar),
+ generate_call("table_nondet_new_ans_slot", [TableVar, AnsSlotVar], det,
+ impure, [AnsSlotVar - ground(unique, no)],
+ Module, NewAnsSlotGoal),
list__length(AnsList, NumAnsVars),
gen_int_construction("NumAnsVars", NumAnsVars, VarTypes3, VarTypes4,
VarSet3, VarSet4, NumAnsVarsVar, NumAnsVarsUnifyGoal),
- generate_new_table_var(VarTypes4, VarTypes5, VarSet4, VarSet5,
- AnsBlockVar),
- generate_call("table_create_ans_block", [AnsBlockVar0, NumAnsVarsVar,
- AnsBlockVar], det, impure, [AnsBlockVar - ground(unique, no)],
- Module, GenAnsBlockGoal),
+ generate_new_table_var("AnswerBlock", VarTypes4, VarTypes5,
+ VarSet4, VarSet5, AnsBlockVar),
+ generate_call("table_create_ans_block",
+ [AnsSlotVar, NumAnsVarsVar, AnsBlockVar], det, impure,
+ [AnsBlockVar - ground(unique, no)],
+ Module, CreateAnsBlockGoal),
generate_save_goals(AnsList, AnsBlockVar, 0, Module, VarTypes5,
VarTypes, VarSet5, VarSet, SaveGoals),
list__append([GetAnsTableGoal | LookupAnsGoals],
- [NewAnsCheckGoal, MarkAsReturnedGoal, GenAnsSlotGoal,
- NumAnsVarsUnifyGoal, GenAnsBlockGoal | SaveGoals], Goals),
+ [DuplicateCheckGoal, NewAnsSlotGoal, NumAnsVarsUnifyGoal,
+ CreateAnsBlockGoal | SaveGoals], Goals),
GoalEx = conj(Goals),
set__singleton_set(NonLocals0, TableVar),
@@ -954,9 +956,9 @@
generate_restore_all_goal(OutputVars, TableVar, Module, VarTypes0, VarTypes,
VarSet0, VarSet, Goal) :-
- generate_new_table_var(VarTypes0, VarTypes1, VarSet0, VarSet1,
- AnsTableVar),
- generate_call("table_return_all_ans", [TableVar, AnsTableVar],
+ generate_new_table_var("AnswerTable", VarTypes0, VarTypes1,
+ VarSet0, VarSet1, AnsTableVar),
+ generate_call("table_nondet_return_all_ans", [TableVar, AnsTableVar],
nondet, semipure, [AnsTableVar - ground(unique, no)],
Module, ReturnAnsBlocksGoal),
@@ -1025,9 +1027,9 @@
generate_suspend_goal(OutputVars, TableVar, Module, VarTypes0, VarTypes,
VarSet0, VarSet, Goal) :-
- generate_new_table_var(VarTypes0, VarTypes1, VarSet0, VarSet1,
- AnsTableVar),
- generate_call("table_suspend", [TableVar, AnsTableVar],
+ generate_new_table_var("AnswerTable", VarTypes0, VarTypes1,
+ VarSet0, VarSet1, AnsTableVar),
+ generate_call("table_nondet_suspend", [TableVar, AnsTableVar],
nondet, semipure, [AnsTableVar - ground(unique, no)],
Module, ReturnAnsBlocksGoal),
@@ -1078,12 +1080,13 @@
%------------------------------------------------------------------------------%
-:- pred generate_new_table_var(map(prog_var, type), map(prog_var, type),
+:- pred generate_new_table_var(string,
+ map(prog_var, type), map(prog_var, type),
prog_varset, prog_varset, prog_var).
-:- mode generate_new_table_var(in, out, in, out, out) is det.
+:- mode generate_new_table_var(in, in, out, in, out, out) is det.
-generate_new_table_var(VarTypes0, VarTypes, VarSet0, VarSet, Var) :-
- varset__new_named_var(VarSet0, "TableVar", Var, VarSet),
+generate_new_table_var(Name, VarTypes0, VarTypes, VarSet0, VarSet, Var) :-
+ varset__new_named_var(VarSet0, Name, Var, VarSet),
get_table_var_type(Type),
map__set(VarTypes0, Var, Type, VarTypes).
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/exceptions
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing library
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.16
diff -u -b -u -r1.16 private_builtin.m
--- private_builtin.m 1998/12/02 00:51:56 1.16
+++ private_builtin.m 1999/03/18 01:50:17
@@ -1,11 +1,11 @@
%---------------------------------------------------------------------------%
-% Copyright (C) 1994-1998 The University of Melbourne.
+% Copyright (C) 1994-1999 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: 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
@@ -18,25 +18,26 @@
% The interface for this module does not get included in the
% Mercury library library reference manual.
+% Many of the predicates defined in this module are builtin -
+% they 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 base_type_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(base_type_info(T) /*, ... */).
-:- type base_type_info(T) ---> base_type_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("
-
-#include ""mercury_deep_copy.h""
-#include ""mercury_type_info.h""
+:- interface.
- /* 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..TYPELAYOUT_MAX_VARINT are reserved for future use */
-#define ML_SUCCEEDED TYPELAYOUT_MAX_VARINT
- /* This or any greater value indicate that the subgoal has
- ** succeeded. */
+ % This section of the module handles the runtime representation of
+ % type information.
-").
-
-:- pragma c_code(table_working_on_ans(T::in), will_not_call_mercury, "
- SUCCESS_INDICATOR = (*((Word *) T) == ML_WORKING_ON_ANS);
-").
-
-:- pragma c_code(table_not_working_on_ans(T::in), will_not_call_mercury, "
- SUCCESS_INDICATOR = (*((Word *) T) != ML_WORKING_ON_ANS);
-").
-
-:- pragma c_code(table_mark_as_working(T::in), will_not_call_mercury, "
- *((Word *) T) = ML_WORKING_ON_ANS;
-").
-
-:- pragma c_code(table_mark_done_working(T::in), will_not_call_mercury, "
- *((Word *) T) = ML_UNINITIALIZED;
-").
-
-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);
-").
+ % The code generated by polymorphism.m always requires
+ % the existence of a type_info functor, and requires
+ % the existence of a base_type_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.
-:- 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);
-").
+:- type type_info(T) ---> type_info(base_type_info(T) /*, ... */).
+:- type base_type_info(T) ---> base_type_info(int /*, ... */).
-:- 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);
-").
+ % 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_lookup_insert_user(T0::in, V::in, T::out),
- will_not_call_mercury, "
- MR_DEBUG_NEW_TABLE_ANY(T, T0, TypeInfo_for_T, V);
-").
+:- type typeclass_info(T) ---> typeclass_info(base_typeclass_info(T)
+ /*, ... */).
+:- type base_typeclass_info(_) ---> typeclass_info(int /*, ... */).
-:- 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);
-").
+ % 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_have_ans(T::in), will_not_call_mercury, "
- if (*((Word *) T) == ML_FAILED || *((Word *) T) >= ML_SUCCEEDED) {
- SUCCESS_INDICATOR = TRUE;
- } else {
- SUCCESS_INDICATOR = FALSE;
- }
-").
+ % 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.
-:- 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 base_type_info/1 and type_info/1.
:- pragma c_header_code("
@@ -624,845 +252,869 @@
mercury_data___base_type_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___base_type_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___base_type_info_character_0);
-").
+:- pragma c_code("
-:- 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___base_type_info_string_0);
-").
+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_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___base_type_info_float_0);
-").
+extern const struct
+ mercury_data_private_builtin__base_type_layout_type_info_1_struct
+ mercury_data_private_builtin__base_type_layout_type_info_1;
+extern const struct
+ mercury_data_private_builtin__base_type_functors_type_info_1_struct
+ mercury_data_private_builtin__base_type_functors_type_info_1;
-:- 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);
-").
+ /*
+ ** For most purposes, base_type_info can be treated just like
+ ** type_info. The code that handles type_infos can also handle
+ ** base_type_infos.
+ */
-:- pragma c_code(table_mark_as_succeeded(T::in), will_not_call_mercury, "
- *((Word *) T) = ML_SUCCEEDED;
-").
+MR_STATIC_CODE_CONST struct
+mercury_data_private_builtin__base_type_info_base_type_info_1_struct {
+ Integer f1;
+ Code *f2;
+ Code *f3;
+ Code *f4;
+ const Word *f5;
+ const Word *f6;
+ const Word *f7;
+ const Word *f8;
+} mercury_data_private_builtin__base_type_info_base_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__base_type_layout_type_info_1,
+ (const Word *) &
+ mercury_data_private_builtin__base_type_functors_type_info_1,
+ (const Word *) string_const(""private_builtin"", 15),
+ (const Word *) string_const(""base_type_info"", 14)
+};
-:- pragma c_code(table_mark_as_failed(T::in), will_not_call_mercury, "
- *((Word *) T) = ML_FAILED;
-").
+MR_STATIC_CODE_CONST struct
+mercury_data_private_builtin__base_type_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;
+} mercury_data_private_builtin__base_type_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__base_type_layout_type_info_1,
+ (const Word *) &
+ mercury_data_private_builtin__base_type_functors_type_info_1,
+ (const Word *) string_const(""private_builtin"", 15),
+ (const Word *) string_const(""type_info"", 9)
+};
-:- 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);
-").
+const struct mercury_data_private_builtin__base_type_layout_type_info_1_struct {
+ TYPE_LAYOUT_FIELDS
+} mercury_data_private_builtin__base_type_layout_type_info_1 = {
+ make_typelayout_for_all_tags(TYPELAYOUT_CONST_TAG,
+ mkbody(MR_TYPELAYOUT_TYPEINFO_VALUE))
+};
-:- 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);
-").
+const struct mercury_data_private_builtin__base_type_functors_type_info_1_struct {
+ Integer f1;
+} mercury_data_private_builtin__base_type_functors_type_info_1 = {
+ MR_TYPEFUNCTORS_SPECIAL
+};
-:- 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));
-").
+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_restore_any_ans(T::in, Offset::in, V::out),
- will_not_call_mercury, "
- V = (Word) MR_TABLE_GET_ANSWER(Offset, T);
-").
+Define_entry(mercury____Index___private_builtin__type_info_1_0);
+ index_output = -1;
+ proceed();
-:- pragma c_header_code("
+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
+/* Ensure that the initialization code for the above module gets run. */
/*
-** The following structures are used by the code for non deterministic tabling.
+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();
+}
-/* 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
-
- /*
- ** Cast a Word to a NondetTable*: saves on typing and improves
- ** readability.
- */
-#define NON_TABLE(T) (*(NondetTable **) T)
").
-:- 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;
+:- 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);
").
-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).
+:- 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);
+").
-:- semipure pred table_return_all_ans_list(ml_table, list(ml_table)).
-:- mode table_return_all_ans_list(in, out) is det.
+%-----------------------------------------------------------------------------%
-:- pragma c_code(table_return_all_ans_list(T::in, A::out),
- will_not_call_mercury, "
- A = (Word) NON_TABLE(T)->answer_list;
-").
+:- interface.
-:- semipure pred table_return_all_ans_2(ml_table, ml_table).
-:- mode table_return_all_ans_2(in, out) is det.
+ % This section of the module is for miscellaneous predicates
+ % that sometimes have calls to them emitted by the compiler.
-:- pragma c_code(table_return_all_ans_2(P::in, A::out),
- will_not_call_mercury, "
- A = (Word) &((AnswerListNode *) P)->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_get_ans_table(T::in, AT::out),
- will_not_call_mercury, "
- AT = (Word) &(NON_TABLE(T)->answer_table);
-").
+:- pred unsafe_type_cast(T1, T2).
+:- mode unsafe_type_cast(in, out) is det.
-:- pragma c_code(table_have_all_ans(T::in),"
- SUCCESS_INDICATOR = (NON_TABLE(T)->status == have_all_ans);
-").
+:- pred unused is det.
-:- pragma c_code(table_have_some_ans(T::in), will_not_call_mercury, "
- SUCCESS_INDICATOR = (NON_TABLE(T)->status == have_some_ans);
-").
+:- implementation.
-:- pragma c_code(table_has_not_returned(T::in), will_not_call_mercury, "
- SUCCESS_INDICATOR = (*((Word *) T) == ML_ANS_NOT_RET);
-").
+unused :-
+ ( semidet_succeed ->
+ error("attempted use of dead predicate")
+ ;
+ % the following is never executed
+ true
+ ).
-:- pragma c_code(table_mark_have_all_ans(T::in), will_not_call_mercury, "
- NON_TABLE(T)->status = have_all_ans;
-").
+%-----------------------------------------------------------------------------%
-:- pragma c_code(table_mark_have_some_ans(T::in), will_not_call_mercury, "
- NON_TABLE(T)->status = have_some_ans;
-").
+:- interface.
-:- pragma c_code(table_mark_as_returned(T::in), will_not_call_mercury, "
- *((Word *) T) = ML_ANS_RET;
-").
+% 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 status 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 status 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 for 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.
-:- external(table_suspend/2).
-:- external(table_resume/1).
+ % 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.
-:- pragma c_code("
+ % This type is used in contexts where a node of a subgoal table is
+ % expected.
+:- type ml_subgoal_table_node.
-/*
-** 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
+ % This type is used in contexts where a node of an answer table is
+ % expected.
+:- type ml_answer_table_node.
-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;
+ % This type is used in contexts where an answer slot is expected.
+:- type ml_answer_slot.
-#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 type is used in contexts where an answer block is expected.
+:- type ml_answer_block.
- 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
+ % 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.
-/*
-** 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)
+%-----------------------------------------------------------------------------%
-#define ML_RESUME_VAR \\
- ML_resumption_stack[ML_resumption_sp]
+:- interface.
-#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.
- */
+ % Return true if the subgoal represented by the given table has an
+ % answer.
+:- semipure pred table_simple_is_complete(ml_subgoal_table_node).
+:- mode table_simple_is_complete(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).
+:- mode table_simple_has_succeeded(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).
+:- mode table_simple_has_failed(in) is semidet.
+
+ % Currently being evaluated (working on an answer).
+:- semipure pred table_simple_is_active(ml_subgoal_table_node).
+:- mode table_simple_is_active(in) is semidet.
- ResumeStackNode *ML_RESUME_DEBUG_VAR;
+ % 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).
+:- mode table_simple_is_inactive(in) is semidet.
- #define ML_SET_RESUME_DEBUG_VARS() \\
- do { \\
- ML_RESUME_DEBUG_VAR = ML_resumption_stack[ML_resumption_sp];\\
- } while (0)
+ % Save the fact the the subgoal has succeeded in the given table.
+:- impure pred table_simple_mark_as_succeeded(ml_subgoal_table_node).
+:- mode table_simple_mark_as_succeeded(in) is det.
-#else
+ % Save the fact the the subgoal has failed in the given table.
+:- impure pred table_simple_mark_as_failed(ml_subgoal_table_node).
+:- mode table_simple_mark_as_failed(in) is det.
- #define ML_SET_RESUME_DEBUG_VARS()
+ % 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).
+:- mode table_simple_mark_as_active(in) is det.
-#endif
+ % 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).
+:- mode table_simple_mark_as_inactive(in) is det.
-/*
-** 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
+%-----------------------------------------------------------------------------%
-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();
+:- implementation.
- if (list_is_empty(NON_TABLE(r1)->suspend_list))
- proceed();
+:- 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: %d\\n"",
+ (Word *) T, *((Word *) T));
+ }
+#endif
+ if (*((Word *) T) == MR_SIMPLETABLE_FAILED
+ || *((Word *) T) >= MR_SIMPLETABLE_SUCCEEDED)
+ {
+ SUCCESS_INDICATOR = TRUE;
+ } else {
+ SUCCESS_INDICATOR = FALSE;
+ }
+").
+
+:- 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: %d\\n"",
+ (Word *) T, *((Word *) T));
+ }
+#endif
+ SUCCESS_INDICATOR = (*((Word *) T) >= MR_SIMPLETABLE_SUCCEEDED)
+").
+
+:- 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: %d\\n"",
+ (Word *) T, *((Word *) T));
+ }
+#endif
+ SUCCESS_INDICATOR = (*((Word *) T) == MR_SIMPLETABLE_FAILED);
+").
- /* 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;
+:- pragma c_code(table_simple_is_active(T::in), will_not_call_mercury, "
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""checking if %p is active: %d\\n"",
+ (Word *) T, *((Word *) T));
+ }
+#endif
+ SUCCESS_INDICATOR = (*((Word *) T) == MR_SIMPLETABLE_WORKING);
+").
- 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: %d\\n"",
+ (Word *) T, *((Word *) T));
+ }
+#endif
+ SUCCESS_INDICATOR = (*((Word *) T) != MR_SIMPLETABLE_WORKING);
+").
-#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"");
+:- 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"", (Word *) T);
+ }
#endif
+ *((Word *) T) = MR_SIMPLETABLE_SUCCEEDED;
+").
- ML_RESUME_VAR->changed = 1;
+:- 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"", (Word *) T);
+ }
+#endif
+ *((Word *) T) = MR_SIMPLETABLE_FAILED;
+").
- 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_mark_as_active(T::in), will_not_call_mercury, "
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""marking %p as working\\n"", (Word *) T);
+ }
+#endif
+ *((Word *) T) = MR_SIMPLETABLE_WORKING;
+").
+:- pragma c_code(table_simple_mark_as_inactive(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(""marking %p as uninitialized\\n"", (Word *) T);
}
#endif
+ *((Word *) T) = MR_SIMPLETABLE_UNINITIALIZED;
+").
- /* If the number of ans or suspended nodes has changed. */
-Define_label(mercury__table_resume_1_0_ChangeLoop);
- ML_SET_RESUME_DEBUG_VARS();
+%-----------------------------------------------------------------------------%
- if (! ML_RESUME_VAR->changed)
- GOTO_LABEL(mercury__table_resume_1_0_ChangeLoopDone);
+:- interface.
- ML_RESUME_VAR->suspend_list = ML_RESUME_VAR->table->suspend_list;
+ % 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,
+ ml_subgoal_table_node).
+:- mode table_nondet_setup(in, 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, ml_answer_block).
+:- mode table_nondet_suspend(in, out) is nondet.
- ML_RESUME_VAR->changed = 0;
- ML_RESUME_VAR->num_ans = ML_RESUME_VAR->table->num_ans;
+ % 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).
+:- mode table_nondet_resume(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).
+:- mode table_nondet_is_complete(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).
+:- mode table_nondet_is_active(in) is semidet.
+
+ % Mark a table as being active.
+:- impure pred table_nondet_mark_as_active(ml_subgoal_table_node).
+:- mode table_nondet_mark_as_active(in) is det.
- /* For each of the suspended nodes */
-Define_label(mercury__table_resume_1_0_SolutionsListLoop);
- ML_SET_RESUME_DEBUG_VARS();
+ % Return the table of answers already return to the given nondet
+ % table.
+:- impure pred table_nondet_get_ans_table(ml_subgoal_table_node, ml_table).
+:- mode table_nondet_get_ans_table(in, out) is det.
- if (list_is_empty(ML_RESUME_VAR->suspend_list))
- GOTO_LABEL(mercury__table_resume_1_0_ChangeLoop);
+ % 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.
+:- semipure pred table_nondet_answer_is_not_duplicate(ml_answer_table_node).
+:- mode table_nondet_answer_is_not_duplicate(in) is semidet.
- ML_RESUME_VAR->suspend_node = (SuspendListNode *) list_head(
- ML_RESUME_VAR->suspend_list);
+ % Create a new slot in the answer list.
+:- impure pred table_nondet_new_ans_slot(ml_subgoal_table_node,
+ ml_answer_slot).
+:- mode table_nondet_new_ans_slot(in, out) is det.
- ML_RESUME_VAR->ans_list = *ML_RESUME_VAR->suspend_node->last_ret_ans;
+ % Return all of the answer blocks stored in the given table.
+:- semipure pred table_nondet_return_all_ans(ml_subgoal_table_node,
+ ml_answer_block).
+:- mode table_nondet_return_all_ans(in, 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, "
/*
- ** 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
-
- MR_redoip_slot(MR_maxfr) = LABEL(mercury__table_resume_1_0_RedoPoint);
- MR_redofr_slot(MR_maxfr) = MR_maxfr;
-
- /*
- ** 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();
-
-#ifdef COMPACT_ARGS
- r1 = (Word) &ML_RESUME_VAR->ansNode->ans;
-#else
- r2 = (word) &ML_RESUME_VAR->ansNode->ans;
+ 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
-
- /*
- ** Return the answer through the point where suspend should have
- ** returned.
- */
- succeed();
-
-Define_label(mercury__table_resume_1_0_RedoPoint);
- ML_SET_RESUME_DEBUG_VARS();
-
- update_prof_current_proc(LABEL(mercury__table_resume_1_0));
-
- ML_RESUME_VAR->ans_list = list_tail(ML_RESUME_VAR->ans_list);
-
- if (list_is_empty(ML_RESUME_VAR->ans_list))
- GOTO_LABEL(mercury__table_resume_1_0_AnsListLoopDone1);
+ subgoal->generator_maxfr = MR_prevfr_slot(MR_maxfr);
+ subgoal->generator_sp = MR_sp;
+ MR_SUBGOAL(T0) = subgoal;
+ }
+ T = T0;
+").
- ML_RESUME_VAR->ansNode = (AnswerListNode *) list_head(
- ML_RESUME_VAR->ans_list);
+ % The definitions of these two predicates are in the runtime system.
+:- external(table_nondet_suspend/2).
+:- external(table_nondet_resume/1).
- GOTO_LABEL(mercury__table_resume_1_0_AnsListLoop);
+:- pragma c_code(table_nondet_is_complete(T::in),"
+ SUCCESS_INDICATOR = (MR_SUBGOAL(T)->status == MR_SUBGOAL_COMPLETE);
+").
-Define_label(mercury__table_resume_1_0_AnsListLoopDone1);
- ML_SET_RESUME_DEBUG_VARS();
+:- pragma c_code(table_nondet_is_active(T::in), will_not_call_mercury, "
+ SUCCESS_INDICATOR = (MR_SUBGOAL(T)->status == MR_SUBGOAL_ACTIVE);
+").
- if (ML_RESUME_VAR->num_ans == ML_RESUME_VAR->table->num_ans)
- ML_RESUME_VAR->changed = 0;
- else
- ML_RESUME_VAR->changed = 1;
+:- pragma c_code(table_nondet_mark_as_active(T::in), will_not_call_mercury, "
+ MR_push_generator(MR_curfr, MR_SUBGOAL(T));
+ MR_register_generator_ptr((MR_Subgoal **) T);
+ MR_SUBGOAL(T)->status = MR_SUBGOAL_ACTIVE;
+").
- ML_RESUME_VAR->suspend_node->last_ret_ans = &ML_RESUME_VAR->ans_list;
+:- pragma c_code(table_nondet_get_ans_table(T::in, AT::out),
+ will_not_call_mercury, "
+ AT = (Word) &(MR_SUBGOAL(T)->answer_table);
+").
-Define_label(mercury__table_resume_1_0_AnsListLoopDone2);
- ML_SET_RESUME_DEBUG_VARS();
+:- pragma c_code(table_nondet_answer_is_not_duplicate(T::in),
+ will_not_call_mercury, "
+ bool is_new_answer;
- ML_RESUME_VAR->suspend_list = list_tail(ML_RESUME_VAR->suspend_list);
- GOTO_LABEL(mercury__table_resume_1_0_SolutionsListLoop);
+#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;
+").
-Define_label(mercury__table_resume_1_0_ChangeLoopDone);
- ML_SET_RESUME_DEBUG_VARS();
+:- pragma c_code(table_nondet_new_ans_slot(T::in, Slot::out),
+ will_not_call_mercury, "
+ MR_Subgoal *table;
+ MR_AnswerListNode *answer_node;
- /* Restore the original state we had when this proc was called */
+ table = MR_SUBGOAL(T);
+ table->num_ans += 1;
- 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);
+#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
+ /*
+ **
+ ** 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.
+ */
- 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);
+ 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;
+
+ *(table->answer_list_tail) = answer_node;
+ table->answer_list_tail = &(answer_node->next_answer);
+
+ Slot = (Word) &(answer_node->answer_data);
+").
+
+% 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;
+% }
+% ")
+% ).
- 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;
+:- external(table_nondet_return_all_ans/2).
+:- 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(""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);
+ printf(""from subgoal %p, ""
+ ""returning everything in answer list %p\\n"",
+ MR_SUBGOAL(r1), MR_SUBGOAL(r1)->answer_list);
}
#endif
-
- ML_RESUME_POP();
-
- proceed();
+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
+").
-#undef ML_SET_RESUME_DEBUG_VARS
+%-----------------------------------------------------------------------------%
-/* Ensure that the initialization code for the above module gets run. */
-/*
-INIT sys_init_table_suspend_module
-INIT sys_init_table_resume_module
-*/
+:- interface.
-extern ModuleFunc table_suspend_module;
-extern ModuleFunc table_resume_module;
+%
+% 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.
-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();
-}
+ % 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.
- % The definitions for base_type_info/1 and type_info/1.
+ % 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.
-:- pragma c_code("
+ % 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.
-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);
+ % 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.
-extern const struct
- mercury_data_private_builtin__base_type_layout_type_info_1_struct
- mercury_data_private_builtin__base_type_layout_type_info_1;
-extern const struct
- mercury_data_private_builtin__base_type_functors_type_info_1_struct
- mercury_data_private_builtin__base_type_functors_type_info_1;
+ % 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.
- /*
- ** For most purposes, base_type_info can be treated just like
- ** type_info. The code that handles type_infos can also handle
- ** base_type_infos.
- */
+ % 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.
-MR_STATIC_CODE_CONST struct
-mercury_data_private_builtin__base_type_info_base_type_info_1_struct {
- Integer f1;
- Code *f2;
- Code *f3;
- Code *f4;
- const Word *f5;
- const Word *f6;
- const Word *f7;
- const Word *f8;
-} mercury_data_private_builtin__base_type_info_base_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__base_type_layout_type_info_1,
- (const Word *) &
- mercury_data_private_builtin__base_type_functors_type_info_1,
- (const Word *) string_const(""private_builtin"", 15),
- (const Word *) string_const(""base_type_info"", 14)
-};
+ % 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.
-MR_STATIC_CODE_CONST struct
-mercury_data_private_builtin__base_type_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;
-} mercury_data_private_builtin__base_type_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__base_type_layout_type_info_1,
- (const Word *) &
- mercury_data_private_builtin__base_type_functors_type_info_1,
- (const Word *) string_const(""private_builtin"", 15),
- (const Word *) string_const(""type_info"", 9)
-};
+ % 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.
-const struct mercury_data_private_builtin__base_type_layout_type_info_1_struct {
- TYPE_LAYOUT_FIELDS
-} mercury_data_private_builtin__base_type_layout_type_info_1 = {
- make_typelayout_for_all_tags(TYPELAYOUT_CONST_TAG,
- mkbody(MR_TYPELAYOUT_TYPEINFO_VALUE))
-};
+ % 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.
-const struct mercury_data_private_builtin__base_type_functors_type_info_1_struct {
- Integer f1;
-} mercury_data_private_builtin__base_type_functors_type_info_1 = {
- MR_TYPEFUNCTORS_SPECIAL
-};
+ % 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.
-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();
-}
+ % 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.
-Define_entry(mercury____Index___private_builtin__type_info_1_0);
- index_output = -1;
- proceed();
+ % 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.
-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
+ % 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.
-/* 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();
-}
+ % Report an error message about the current subgoal looping.
+:- pred table_loopcheck_error(string).
+:- mode table_loopcheck_error(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, int,
+ ml_answer_block).
+:- mode table_create_ans_block(in, in, out) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- 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_new_ans_slot(T::in, Slot::out),
+:- pragma c_code(table_save_int_ans(T::in, Offset::in, I::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, I,
+ mercury_data___base_type_info_int_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_char_ans(T::in, Offset::in, C::in),
+ will_not_call_mercury, "
+ MR_TABLE_SAVE_ANSWER(Offset, T, C,
+ mercury_data___base_type_info_character_0);
+").
- Slot = (Word) &n->ans;
+:- 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___base_type_info_string_0);
").
-:- end_module private_builtin.
+:- 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___base_type_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_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));
+").
+
+:- 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).
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: library/string.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/string.m,v
retrieving revision 1.110
diff -u -b -u -r1.110 string.m
cvs diff: Diffing lp_solve
cvs diff: Diffing lp_solve/lp_examples
cvs diff: Diffing profiler
cvs diff: Diffing readline
cvs diff: Diffing readline/doc
cvs diff: Diffing readline/examples
cvs diff: Diffing readline/shlib
cvs diff: Diffing readline/support
cvs diff: Diffing runtime
Index: runtime/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/Mmakefile,v
retrieving revision 1.44
diff -u -b -u -r1.44 Mmakefile
--- Mmakefile 1999/03/15 00:39:29 1.44
+++ Mmakefile 1999/03/16 01:13:32
@@ -61,9 +61,9 @@
mercury_regs.h \
mercury_signal.h \
mercury_std.h \
- mercury_stacks.h \
mercury_stack_layout.h \
mercury_stack_trace.h \
+ mercury_stacks.h \
mercury_string.h \
mercury_tabling.h \
mercury_tags.h \
@@ -118,6 +118,7 @@
mercury_regs.c \
mercury_signal.c \
mercury_stack_trace.c \
+ mercury_stacks.c \
mercury_tabling.c \
mercury_thread.c \
mercury_timing.c \
Index: runtime/mercury_context.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_context.c,v
retrieving revision 1.18
diff -u -b -u -r1.18 mercury_context.c
--- mercury_context.c 1998/12/16 17:10:28 1.18
+++ mercury_context.c 1999/03/11 08:32:44
@@ -117,6 +117,24 @@
MR_succip_slot(c->context_curfr) = ENTRY(do_not_reached);
MR_succfr_slot(c->context_curfr) = NULL;
+ if (c->generatorstack_zone != NULL) {
+ reset_redzone(c->generatorstack_zone);
+ } else {
+ c->generatorstack_zone = create_zone("generatorstack", 0,
+ generatorstack_size, next_offset(),
+ generatorstack_zone_size, default_handler);
+ }
+ c->context_gen_sp = 0;
+
+ if (c->cutstack_zone != NULL) {
+ reset_redzone(c->cutstack_zone);
+ } else {
+ c->cutstack_zone = create_zone("cutstack", 0,
+ cutstack_size, next_offset(),
+ cutstack_zone_size, default_handler);
+ }
+ c->context_cut_sp = 0;
+
#ifdef MR_USE_TRAIL
if (c->trail_zone != NULL) {
reset_redzone(c->trail_zone);
Index: runtime/mercury_context.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_context.h,v
retrieving revision 1.9
diff -u -b -u -r1.9 mercury_context.h
--- mercury_context.h 1998/12/15 00:22:15 1.9
+++ mercury_context.h 1999/03/11 08:26:10
@@ -106,6 +106,14 @@
/* saved maxfr pointer for this context */
Word *context_curfr;
/* saved curfr pointer for this context */
+ MemoryZone *generatorstack_zone;
+ /* pointer to the generatorstack_zone for this context */
+ Integer context_gen_sp;
+ /* saved generator stack pointer for this context */
+ MemoryZone *cutstack_zone;
+ /* pointer to the cutstack_zone for this context */
+ Integer context_cut_sp;
+ /* saved cut stack pointer for this context */
#ifdef MR_USE_TRAIL
MemoryZone *trail_zone;
@@ -324,6 +332,8 @@
MR_sp = load_context_c->context_sp; \
MR_maxfr = load_context_c->context_maxfr; \
MR_curfr = load_context_c->context_curfr; \
+ MR_gen_sp = load_context_c->context_gen_sp; \
+ MR_cut_sp = load_context_c->context_cut_sp; \
MR_IF_USE_TRAIL( \
MR_trail_zone = load_context_c->trail_zone; \
MR_trail_ptr = load_context_c->context_trail_ptr; \
@@ -334,6 +344,14 @@
load_context_c->detstack_zone; \
MR_ENGINE(context).nondetstack_zone = \
load_context_c->nondetstack_zone; \
+ MR_ENGINE(context).generatorstack_zone = \
+ load_context_c->generatorstack_zone; \
+ MR_ENGINE(context).cutstack_zone = \
+ load_context_c->cutstack_zone; \
+ MR_gen_stack = (MR_GeneratorStackFrame *) \
+ MR_ENGINE(context).generatorstack_zone;\
+ MR_cut_stack = (MR_CutStackFrame *) \
+ MR_ENGINE(context).cutstack_zone;\
set_min_heap_reclamation_point(load_context_c); \
} while (0)
@@ -345,6 +363,8 @@
save_context_c->context_sp = MR_sp; \
save_context_c->context_maxfr = MR_maxfr; \
save_context_c->context_curfr = MR_curfr; \
+ save_context_c->context_gen_sp = MR_gen_sp; \
+ save_context_c->context_cut_sp = MR_cut_sp; \
MR_IF_USE_TRAIL( \
save_context_c->trail_zone = MR_trail_zone; \
save_context_c->context_trail_ptr = MR_trail_ptr; \
@@ -355,6 +375,14 @@
MR_ENGINE(context).detstack_zone; \
save_context_c->nondetstack_zone = \
MR_ENGINE(context).nondetstack_zone; \
+ save_context_c->generatorstack_zone = \
+ MR_ENGINE(context).generatorstack_zone; \
+ save_context_c->cutstack_zone = \
+ MR_ENGINE(context).cutstack_zone; \
+ assert(MR_gen_stack == (MR_GeneratorStackFrame *) \
+ MR_ENGINE(context).generatorstack_zone);\
+ assert(MR_cut_stack == (MR_CutStackFrame *) \
+ MR_ENGINE(context).cutstack_zone); \
save_hp_in_context(save_context_c); \
} while (0)
Index: runtime/mercury_engine.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_engine.h,v
retrieving revision 1.11
diff -u -b -u -r1.11 mercury_engine.h
--- mercury_engine.h 1998/11/09 11:02:35 1.11
+++ mercury_engine.h 1999/03/11 06:27:11
@@ -47,8 +47,9 @@
#define MR_SREGFLAG 8
#define MR_TRACEFLAG 9
#define MR_TABLEFLAG 10
-#define MR_DETAILFLAG 11
-#define MR_MAXFLAG 12
+#define MR_TABLESTACKFLAG 11
+#define MR_DETAILFLAG 12
+#define MR_MAXFLAG 13
/* MR_DETAILFLAG should be the last real flag */
#define MR_progdebug MR_debugflag[MR_PROGFLAG]
@@ -62,6 +63,7 @@
#define MR_sregdebug MR_debugflag[MR_SREGFLAG]
#define MR_tracedebug MR_debugflag[MR_TRACEFLAG]
#define MR_tabledebug MR_debugflag[MR_TABLEFLAG]
+#define MR_tablestackdebug MR_debugflag[MR_TABLESTACKFLAG]
#define MR_detaildebug MR_debugflag[MR_DETAILFLAG]
/*
Index: runtime/mercury_init.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_init.h,v
retrieving revision 1.10
diff -u -b -u -r1.10 mercury_init.h
--- mercury_init.h 1999/02/04 10:52:57 1.10
+++ mercury_init.h 1999/03/11 08:58:55
@@ -76,6 +76,7 @@
** by C programs that wish to interface to Mercury.
*/
+#include "mercury_regs.h" /* must be before prototypes */
#include "mercury_goto.h" /* for Declare_entry */
#include "mercury_types.h" /* for `Word' */
#include "mercury_wrapper.h" /* for do_init_modules,
Index: runtime/mercury_memory.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_memory.c,v
retrieving revision 1.15
diff -u -b -u -r1.15 mercury_memory.c
--- mercury_memory.c 1998/09/29 05:10:58 1.15
+++ mercury_memory.c 1999/03/11 07:38:18
@@ -109,6 +109,8 @@
MemoryZone *heap_zone;
MemoryZone *solutions_heap_zone;
#endif
+MemoryZone *generatorstack_zone;
+MemoryZone *cutstack_zone;
#ifdef MR_LOWLEVEL_DEBUG
MemoryZone *dumpstack_zone;
@@ -136,29 +138,34 @@
unit = max(page_size, pcache_size);
#ifdef CONSERVATIVE_GC
- heap_zone_size = 0;
heap_size = 0;
- solutions_heap_zone_size = 0;
+ heap_zone_size = 0;
solutions_heap_size = 0;
- global_heap_zone_size = 0;
+ solutions_heap_zone_size = 0;
global_heap_size = 0;
- debug_heap_zone_size = 0;
+ global_heap_zone_size = 0;
debug_heap_size = 0;
+ debug_heap_zone_size = 0;
#else
- heap_zone_size = round_up(heap_zone_size * 1024, unit);
heap_size = round_up(heap_size * 1024, unit);
+ heap_zone_size = round_up(heap_zone_size * 1024, unit);
+ solutions_heap_size = round_up(solutions_heap_size * 1024, unit);
solutions_heap_zone_size = round_up(solutions_heap_zone_size * 1024,
unit);
- solutions_heap_size = round_up(solutions_heap_size * 1024, unit);
- global_heap_zone_size = round_up(global_heap_zone_size * 1024, unit);
global_heap_size = round_up(global_heap_size * 1024, unit);
- debug_heap_zone_size = round_up(debug_heap_zone_size * 1024, unit);
+ global_heap_zone_size = round_up(global_heap_zone_size * 1024, unit);
debug_heap_size = round_up(debug_heap_size * 1024, unit);
+ debug_heap_zone_size = round_up(debug_heap_zone_size * 1024, unit);
#endif
detstack_size = round_up(detstack_size * 1024, unit);
detstack_zone_size = round_up(detstack_zone_size * 1024, unit);
nondstack_size = round_up(nondstack_size * 1024, unit);
nondstack_zone_size = round_up(nondstack_zone_size * 1024, unit);
+ generatorstack_size = round_up(generatorstack_size * 1024, unit);
+ generatorstack_zone_size = round_up(generatorstack_zone_size * 1024,
+ unit);
+ cutstack_size = round_up(cutstack_size * 1024, unit);
+ cutstack_zone_size = round_up(cutstack_zone_size * 1024, unit);
#ifdef MR_USE_TRAIL
trail_size = round_up(trail_size * 1024, unit);
Index: runtime/mercury_stacks.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_stacks.h,v
retrieving revision 1.15
diff -u -b -u -r1.15 mercury_stacks.h
--- mercury_stacks.h 1998/12/16 20:38:15 1.15
+++ mercury_stacks.h 1999/03/18 01:42:12
@@ -14,6 +14,7 @@
#include "mercury_overflow.h"
#include "mercury_debug.h"
#include "mercury_goto.h"
+#include "mercury_tabling.h"
/* DEFINITIONS FOR MANIPULATING THE DET STACK */
@@ -97,6 +98,15 @@
#define MR_SAVEVAL (-MR_NONDET_FIXED_SIZE)
/* saved values start at this offset */
+#define MR_prevfr_addr(fr) (&((Word *) (fr))[MR_PREVFR])
+#define MR_redoip_addr(fr) (&((Word *) (fr))[MR_REDOIP])
+#define MR_redofr_addr(fr) (&((Word *) (fr))[MR_REDOFR])
+#define MR_succip_addr(fr) (&((Word *) (fr))[MR_SUCCIP])
+#define MR_succfr_addr(fr) (&((Word *) (fr))[MR_SUCCFR])
+#define MR_detfr_addr(fr) (&((Word *) (fr))[MR_DETFR])
+#define MR_based_framevar_addr(fr, n) \
+ (&(((Word *) (fr))[MR_SAVEVAL + 1 - (n)]))
+
#define MR_prevfr_slot(fr) LVALUE_CAST(Word *, ((Word *) (fr))[MR_PREVFR])
#define MR_redoip_slot(fr) LVALUE_CAST(Code *, ((Word *) (fr))[MR_REDOIP])
#define MR_redofr_slot(fr) LVALUE_CAST(Word *, ((Word *) (fr))[MR_REDOFR])
@@ -223,5 +233,37 @@
MR_curfr = MR_redofr_slot(MR_maxfr); \
GOTO(MR_redoip_slot(MR_maxfr)); \
} while (0)
+
+/* DEFINITIONS FOR GENERATOR STACK FRAMES */
+
+typedef struct {
+ Word *generator_frame;
+ MR_Subgoal *generator_table;
+} MR_GeneratorStackFrame;
+
+extern void MR_push_generator(Word *frame_addr,
+ MR_Subgoal *table_addr);
+extern MR_Subgoal *MR_top_generator_table(void);
+extern void MR_pop_generator(void);
+extern void MR_print_gen_stack(FILE *fp);
+
+/* DEFINITIONS FOR CUT STACK FRAMES */
+
+typedef struct MR_CutGeneratorListNode *MR_CutGeneratorList;
+struct MR_CutGeneratorListNode {
+ MR_Subgoal **generator_ptr;
+ MR_CutGeneratorList next_generator;
+};
+
+typedef struct {
+ Word *frame;
+ Integer gen_sp;
+ MR_CutGeneratorList generators;
+} MR_CutStackFrame;
+
+extern void MR_commit_mark(void);
+extern void MR_commit_cut(void);
+
+extern void MR_register_generator_ptr(MR_Subgoal **);
#endif /* not MERCURY_STACKS_H */
Index: runtime/mercury_tabling.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.c,v
retrieving revision 1.1
diff -u -b -u -r1.1 mercury_tabling.c
--- mercury_tabling.c 1998/11/09 10:24:46 1.1
+++ mercury_tabling.c 1999/03/17 00:19:55
@@ -1,5 +1,5 @@
/*
-** Copyright (C) 1997-1998 The University of Melbourne.
+** Copyright (C) 1997-1999 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.
*/
@@ -43,7 +43,6 @@
Word elements;
} TableRoot;
-
static Word next_prime(Word);
static Word * create_hash_table(Word);
static void re_hash(Word *, Word, TableNode * Node);
@@ -125,8 +124,8 @@
** If it is not; create a new element for the key in the table and
** return the address of its data pointer.
*/
-TrieNode
-MR_int_hash_lookup_or_add(TrieNode t, Integer key)
+MR_TrieNode
+MR_int_hash_lookup_or_add(MR_TrieNode t, Integer key)
{
TableNode * p, * q;
Word * table = *t; /* Deref the table pointer */
@@ -195,8 +194,8 @@
** If it is not create a new element for the key in the table and
** return the address of its data pointer.
*/
-TrieNode
-MR_float_hash_lookup_or_add(TrieNode t, Float key)
+MR_TrieNode
+MR_float_hash_lookup_or_add(MR_TrieNode t, Float key)
{
TableNode * p, * q;
Word * table = *t; /* Deref the table pointer */
@@ -271,8 +270,8 @@
** If it is not create a new element for the key in the table and
** return the address of its data pointer.
*/
-TrieNode
-MR_string_hash_lookup_or_add(TrieNode t, String key)
+MR_TrieNode
+MR_string_hash_lookup_or_add(MR_TrieNode t, String key)
{
TableNode * p, * q;
Word * table = *t; /* Deref the table pointer */
@@ -355,8 +354,8 @@
** table of size Range.
*/
-TrieNode
-MR_int_index_lookup_or_add(TrieNode t, Integer range, Integer key)
+MR_TrieNode
+MR_int_index_lookup_or_add(MR_TrieNode t, Integer range, Integer key)
{
Word *table = *t; /* Deref table */
@@ -389,8 +388,8 @@
struct TreeNode_struct * left;
} TreeNode;
-TrieNode
-MR_type_info_lookup_or_add(TrieNode table, Word * type_info)
+MR_TrieNode
+MR_type_info_lookup_or_add(MR_TrieNode table, Word * type_info)
{
TreeNode *p, *q;
int i;
@@ -458,8 +457,8 @@
** in mercury_deep_copy.c and std_util::ML_expand().
*/
-TrieNode
-MR_table_type(TrieNode table, Word *type_info, Word data)
+MR_TrieNode
+MR_table_type(MR_TrieNode table, Word *type_info, Word data)
{
Word *base_type_info, *base_type_layout, *base_type_functors;
Word layout_for_tag, *layout_vector_for_tag, *data_value;
@@ -651,3 +650,953 @@
} /* end table_any() */
/*---------------------------------------------------------------------------*/
+
+static void
+save_state(MR_SavedState *saved_state,
+ Word *generator_maxfr, Word *generator_sp,
+ const char *who, const char *what)
+{
+ restore_transient_registers();
+
+ saved_state->succ_ip = MR_succip;
+ saved_state->s_p = MR_sp;
+ saved_state->cur_fr = MR_curfr;
+ saved_state->max_fr = MR_maxfr;
+
+ saved_state->non_stack_block_start = generator_maxfr + 1;
+ if (MR_maxfr > generator_maxfr) {
+ saved_state->non_stack_block_size = MR_maxfr - generator_maxfr;
+ saved_state->non_stack_block =
+ table_allocate_words(saved_state->non_stack_block_size);
+ table_copy_words(saved_state->non_stack_block,
+ saved_state->non_stack_block_start,
+ saved_state->non_stack_block_size);
+ } else {
+ saved_state->non_stack_block_size = 0;
+ saved_state->non_stack_block = NULL;
+ }
+
+ saved_state->det_stack_block_start = generator_sp;
+ if (MR_sp > generator_sp) {
+ saved_state->det_stack_block_size = (MR_sp - 1) - generator_sp;
+ saved_state->det_stack_block =
+ table_allocate_words(saved_state->det_stack_block_size);
+ table_copy_words(saved_state->det_stack_block,
+ saved_state->det_stack_block_start,
+ saved_state->det_stack_block_size);
+ } else {
+ saved_state->det_stack_block_size = 0;
+ saved_state->det_stack_block = NULL;
+ }
+
+ saved_state->gen_sp = MR_gen_sp;
+ saved_state->generator_stack_block = table_allocate_bytes(
+ MR_gen_sp * sizeof(MR_GeneratorStackFrame));
+ table_copy_bytes(saved_state->generator_stack_block,
+ (char *) MR_gen_stack,
+ MR_gen_sp * sizeof(MR_GeneratorStackFrame));
+
+ saved_state->cut_sp = MR_cut_sp;
+ saved_state->cut_stack_block = table_allocate_bytes(
+ (MR_cut_sp + 1) * sizeof(MR_CutStackFrame));
+ table_copy_bytes(saved_state->cut_stack_block,
+ (char *) MR_cut_stack,
+ (MR_cut_sp + 1) * sizeof(MR_CutStackFrame));
+
+#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");
+#endif
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("\n%s saves %s stacks: ", who, what);
+ printf("%d non, %d det, %d generator, %d cut\n",
+ saved_state->non_stack_block_size,
+ saved_state->det_stack_block_size,
+ MR_gen_sp, MR_cut_sp);
+
+ printf("non region from ");
+ MR_printnondstackptr(saved_state->non_stack_block_start);
+ printf(" to ");
+ MR_printnondstackptr(MR_maxfr);
+ printf(" (both inclusive)\n");
+ printf("stored at %p to %p (both inclusive)\n",
+ saved_state->non_stack_block,
+ saved_state->non_stack_block +
+ saved_state->non_stack_block_size - 1);
+
+ printf("det region from ");
+ MR_printdetstackptr(saved_state->det_stack_block_start);
+ printf(" to ");
+ MR_printdetstackptr(MR_sp);
+ printf(" (both inclusive)\n");
+ printf("stored at %p to %p (both inclusive)\n",
+ saved_state->det_stack_block,
+ saved_state->det_stack_block +
+ saved_state->det_stack_block_size - 1);
+
+ printf("succip = %p, sp = ", (void *) MR_succip);
+ MR_printdetstackptr(MR_sp);
+ printf("\nmaxfr = ");
+ MR_printnondstackptr(MR_maxfr);
+ printf(", curfr = ");
+ MR_printnondstackptr(MR_curfr);
+ printf("\n\n");
+
+ MR_print_gen_stack(stdout);
+
+ if (MR_tablestackdebug) {
+ MR_dump_nondet_stack_from_layout(stdout, MR_maxfr);
+ }
+ }
+#endif
+
+ save_transient_registers();
+}
+
+static void
+restore_state(MR_SavedState *saved_state, const char *who, const char *what)
+{
+ restore_transient_registers();
+
+ MR_succip = saved_state->succ_ip;
+ MR_sp = saved_state->s_p;
+ MR_curfr = saved_state->cur_fr;
+ MR_maxfr = saved_state->max_fr;
+
+ table_copy_words(saved_state->non_stack_block_start,
+ saved_state->non_stack_block,
+ saved_state->non_stack_block_size);
+
+ table_copy_words(saved_state->det_stack_block_start,
+ saved_state->det_stack_block,
+ saved_state->det_stack_block_size);
+
+ MR_gen_sp = saved_state->gen_sp;
+ table_copy_bytes((char *) MR_gen_stack,
+ saved_state->generator_stack_block,
+ saved_state->gen_sp);
+
+ MR_cut_sp = saved_state->cut_sp;
+ table_copy_bytes((char *) MR_cut_stack,
+ (char *) saved_state->cut_stack_block,
+ (saved_state->cut_sp + 1) * sizeof(MR_CutStackFrame));
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("\n%s restores %s stacks: ", who, what);
+ printf("%d non, %d det, %d generator, %d cut\n",
+ saved_state->non_stack_block_size,
+ saved_state->det_stack_block_size,
+ saved_state->gen_sp, saved_state->cut_sp);
+
+ printf("non region from ");
+ MR_printnondstackptr(saved_state->non_stack_block_start);
+ printf(" to ");
+ MR_printnondstackptr(saved_state->non_stack_block_start +
+ saved_state->non_stack_block_size - 1);
+ printf(" (both inclusive)\n");
+ printf("stored at %p to %p (both inclusive)\n",
+ saved_state->non_stack_block,
+ saved_state->non_stack_block +
+ saved_state->non_stack_block_size - 1);
+
+ printf("det region from ");
+ MR_printdetstackptr(saved_state->det_stack_block_start);
+ printf(" to ");
+ MR_printdetstackptr(saved_state->det_stack_block_start +
+ saved_state->det_stack_block_size - 1);
+ printf(" (both inclusive)\n");
+ printf("stored at %p to %p (both inclusive)\n",
+ saved_state->det_stack_block,
+ saved_state->det_stack_block +
+ saved_state->det_stack_block_size - 1);
+
+ printf("succip = %p, sp = ", (void *) MR_succip);
+ MR_printdetstackptr(MR_sp);
+ printf("\nmaxfr = ");
+ MR_printnondstackptr(MR_maxfr);
+ printf(", curfr = ");
+ MR_printnondstackptr(MR_curfr);
+ printf("\n");
+
+ MR_print_gen_stack(stdout);
+
+ if (MR_tablestackdebug) {
+ MR_dump_nondet_stack_from_layout(stdout, MR_maxfr);
+ }
+ }
+#endif
+
+ save_transient_registers();
+}
+
+static void
+print_saved_state_stacks(MR_SavedState *saved_state)
+{
+ int i;
+
+ printf("saved state parameters:\n");
+ printf("succip:\t");
+ printlabel(saved_state->succ_ip);
+ printf("sp:\t");
+ MR_printdetstackptr(saved_state->s_p);
+ printf("\ncurfr:\t");
+ MR_printnondstackptr(saved_state->cur_fr);
+ printf("\nmaxfr:\t");
+ MR_printnondstackptr(saved_state->max_fr);
+
+ printf("\n\nnondet stack block: %d words from %p\n",
+ saved_state->non_stack_block_size,
+ saved_state->non_stack_block_start);
+ for (i = 0; i < saved_state->non_stack_block_size; i++) {
+ printf("%2d: %x\n", i, saved_state->non_stack_block[i]);
+ }
+
+ printf("\ndet stack block: %d words from %p\n",
+ saved_state->det_stack_block_size,
+ saved_state->det_stack_block_start);
+ for (i = 0; i < saved_state->det_stack_block_size; i++) {
+ printf("%2d: %x\n", i, saved_state->det_stack_block[i]);
+ }
+
+ printf("\n");
+}
+
+Declare_entry(mercury__table_nondet_resume_1_0);
+
+static void
+extend_consumer_stacks(MR_Subgoal *leader, MR_Consumer *suspension)
+{
+ Word *arena_block;
+ Word *arena_start;
+ Word arena_size;
+ Word extension_size;
+ Word *saved_fr;
+ Word *real_fr;
+ Word frame_size;
+ Word offset;
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tablestackdebug) {
+ printf("\nextending saved consumer stacks\n");
+ print_saved_state_stacks(&suspension->saved_state);
+ }
+#endif
+
+ arena_start = leader->generator_sp;
+ extension_size = suspension->saved_state.det_stack_block_start
+ - arena_start;
+ arena_size = extension_size
+ + suspension->saved_state.det_stack_block_size;
+ if (arena_size != 0) {
+ assert(arena_start + arena_size
+ == suspension->saved_state.s_p - 1);
+ }
+
+ arena_block = table_allocate_words(arena_size);
+
+ table_copy_words(arena_block, arena_start, extension_size);
+ table_copy_words(arena_block + extension_size,
+ suspension->saved_state.det_stack_block,
+ suspension->saved_state.det_stack_block_size);
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("extending det stack of suspension %p for %p\n",
+ suspension, leader);
+ printf("start: old %p, new %p\n",
+ suspension->saved_state.det_stack_block_start,
+ arena_start);
+ printf("size: old %d, new %d\n",
+ suspension->saved_state.det_stack_block_size,
+ arena_size);
+ printf("block: old %p, new %p\n",
+ suspension->saved_state.det_stack_block,
+ arena_block);
+ }
+#endif
+
+ suspension->saved_state.det_stack_block = arena_block;
+ suspension->saved_state.det_stack_block_size = arena_size;
+ suspension->saved_state.det_stack_block_start = arena_start;
+
+ arena_start = leader->generator_maxfr + 1;
+ extension_size = suspension->saved_state.non_stack_block_start
+ - arena_start;
+ arena_size = extension_size
+ + suspension->saved_state.non_stack_block_size;
+ assert(leader->generator_maxfr + arena_size
+ == suspension->saved_state.max_fr);
+
+ arena_block = table_allocate_words(arena_size);
+
+ table_copy_words(arena_block, arena_start, extension_size);
+ table_copy_words(arena_block + extension_size,
+ suspension->saved_state.non_stack_block,
+ suspension->saved_state.non_stack_block_size);
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("extending non stack of suspension %p for %p\n",
+ suspension, leader);
+ printf("start: old %p, new %p\n",
+ suspension->saved_state.non_stack_block_start,
+ arena_start);
+ printf("size: old %d, new %d\n",
+ suspension->saved_state.non_stack_block_size,
+ arena_size);
+ printf("block: old %p, new %p\n",
+ suspension->saved_state.non_stack_block,
+ arena_block);
+ }
+#endif
+
+ suspension->saved_state.non_stack_block = arena_block;
+ suspension->saved_state.non_stack_block_size = arena_size;
+ suspension->saved_state.non_stack_block_start = arena_start;
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tablestackdebug) {
+ printf("\nbefore pickling nondet stack\n");
+ print_saved_state_stacks(&suspension->saved_state);
+ }
+#endif
+
+ saved_fr = suspension->saved_state.non_stack_block +
+ suspension->saved_state.non_stack_block_size - 1;
+ real_fr = suspension->saved_state.non_stack_block_start +
+ suspension->saved_state.non_stack_block_size - 1;
+ while (saved_fr > suspension->saved_state.non_stack_block) {
+ frame_size = real_fr - MR_prevfr_slot(saved_fr);
+
+ if (saved_fr - frame_size
+ > suspension->saved_state.non_stack_block)
+ {
+ *MR_redoip_addr(saved_fr) = (Word) ENTRY(do_fail);
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("do_fail to redoip at %p (%d)\n",
+ MR_redoip_addr(saved_fr),
+ MR_redoip_addr(saved_fr) -
+ suspension->
+ saved_state.non_stack_block);
+ }
+#endif
+ } else {
+ *MR_redoip_addr(saved_fr) = (Word)
+ ENTRY(mercury__table_nondet_resume_1_0);
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("resume to redoip at %p (%d)\n",
+ MR_redoip_addr(saved_fr),
+ MR_redoip_addr(saved_fr) -
+ suspension->
+ saved_state.non_stack_block);
+ }
+#endif
+ }
+
+ saved_fr -= frame_size;
+ real_fr -= frame_size;
+ }
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tablestackdebug) {
+ printf("\nfinished extending saved consumer stacks\n");
+ print_saved_state_stacks(&suspension->saved_state);
+ }
+#endif
+}
+
+static void
+make_subgoal_follow_leader(MR_Subgoal *this_follower, MR_Subgoal *leader)
+{
+ MR_Consumer *suspension;
+ MR_SubgoalList sub_followers;
+ MR_ConsumerList suspend_list;
+
+ restore_transient_registers();
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("making %p follow %p\n", this_follower, leader);
+ }
+#endif
+
+ for (sub_followers = this_follower->followers;
+ sub_followers != NULL; sub_followers = sub_followers->next)
+ {
+ for (suspend_list = sub_followers->item->consumer_list;
+ suspend_list != NULL;
+ suspend_list = suspend_list->next)
+ {
+ save_transient_registers();
+ extend_consumer_stacks(leader, suspend_list->item);
+ restore_transient_registers();
+ }
+ }
+
+ this_follower->leader = leader;
+ *(leader->followers_tail) = this_follower->followers;
+ this_follower->followers = NULL;
+
+ save_transient_registers();
+}
+
+/*
+** The following procedure saves the state of the mercury runtime
+** so that it may be used in the table_nondet_resume procedure below to return
+** answers through this saved state. The procedure table_nondet_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_nondet_suspend) but from the
+** procedure table_nondet_resume. So essentially what is below is the code
+** to do the initial fail; the code to return the answers is in
+** table_nondet_resume.
+*/
+
+Declare_entry(mercury__table_nondet_resume_1_0);
+Declare_entry(MR_do_trace_redo_fail);
+Declare_entry(MR_table_nondet_commit);
+Define_extern_entry(mercury__table_nondet_suspend_2_0);
+MR_MAKE_PROC_LAYOUT(mercury__table_nondet_suspend_2_0,
+ MR_DETISM_NON, 0, MR_LVAL_TYPE_UNKNOWN,
+ MR_PREDICATE, "private_builtin", "table_nondet_suspend", 2, 0);
+BEGIN_MODULE(table_nondet_suspend_module)
+ init_entry_sl(mercury__table_nondet_suspend_2_0);
+ MR_INIT_PROC_LAYOUT_ADDR(mercury__table_nondet_suspend_2_0);
+BEGIN_CODE
+
+Define_entry(mercury__table_nondet_suspend_2_0);
+{
+ MR_Subgoal *table;
+ MR_Consumer *consumer;
+ MR_ConsumerList listnode;
+ Integer cur_gen;
+ Integer cur_cut;
+ Word *fr;
+ Word *prev_fr;
+ Word *stop_addr;
+ Word offset;
+ Word *clobber_addr;
+
+ /*
+ ** This frame is not used in table_nondet_suspend, but it is copied
+ ** to the suspend list as part of the saved nondet stack fragment,
+ ** and it *will* be used when table_nondet_resume copies back the
+ ** nondet stack fragment. The framevar slot is for use by
+ ** table_nondet_resume.
+ */
+ mkframe(mercury__table_nondet_suspend/2, 1, ENTRY(do_fail));
+
+ table = MR_SUBGOAL(r1);
+ consumer = table_allocate_bytes(sizeof(MR_Consumer));
+ consumer->remaining_answer_list_ptr = &table->answer_list;
+
+ save_transient_registers();
+ save_state(&(consumer->saved_state),
+ table->generator_maxfr, table->generator_sp,
+ "suspension", "consumer");
+ restore_transient_registers();
+
+ cur_gen = MR_gen_sp - 1;
+ cur_cut = MR_cut_sp;
+ stop_addr = consumer->saved_state.non_stack_block_start;
+ for (fr = MR_maxfr; fr > stop_addr; fr = MR_prevfr_slot(fr))
+ {
+ offset = MR_redoip_addr(fr) -
+ consumer->saved_state.non_stack_block_start;
+ clobber_addr = consumer->saved_state.non_stack_block + offset;
+#if 0
+ if (MR_tablestackdebug) {
+ printf("redoip addr ");
+ MR_printnondstackptr(MR_redoip_addr(fr));
+ printf(", offset %d from start, ", offset);
+ printf("saved copy at %p\n", clobber_addr);
+ }
+#endif
+
+ if (fr == MR_gen_stack[cur_gen].generator_frame) {
+ if (MR_gen_stack[cur_gen].generator_table == table) {
+ /*
+ ** This is the nondet stack frame of the
+ ** generator corresponding to this consumer.
+ */
+
+ assert(MR_prevfr_slot(fr) == (stop_addr - 1));
+ *clobber_addr = (Word) ENTRY(mercury__table_nondet_resume_1_0);
+#ifdef MR_TABLE_DEBUG
+ if (MR_tablestackdebug) {
+ printf("completing redoip of frame at ");
+ MR_printnondstackptr(fr);
+ printf(" (in saved copy)\n");
+ }
+#endif
+
+ consumer->saved_state.gen_sp = cur_gen + 1;
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("saved gen_sp set to %d\n",
+ cur_gen + 1);
+ }
+#endif
+ } else {
+ /*
+ ** This is the nondet stack frame of some
+ ** other generator.
+ */
+
+ assert(MR_prevfr_slot(fr) != (stop_addr - 1));
+
+ *clobber_addr = (Word) ENTRY(do_fail);
+#ifdef MR_TABLE_DEBUG
+ if (MR_tablestackdebug) {
+ printf("clobbering redoip of frame at ");
+ MR_printnondstackptr(fr);
+ printf(" (in saved copy)\n");
+ }
+#endif
+
+ save_transient_registers();
+ make_subgoal_follow_leader(
+ MR_gen_stack[cur_gen].generator_table,
+ table);
+ restore_transient_registers();
+ }
+
+ cur_gen--;
+ } else if (cur_cut > 0 && fr == MR_cut_stack[cur_cut].frame) {
+ *clobber_addr = (Word) ENTRY(MR_table_nondet_commit);
+#ifdef MR_TABLE_DEBUG
+ if (MR_tablestackdebug) {
+ printf("committing redoip of frame at ");
+ MR_printnondstackptr(fr);
+ printf(" (in saved copy)\n");
+ }
+#endif
+
+ cur_cut--;
+ } else {
+ *clobber_addr = (Word) ENTRY(do_fail);
+#ifdef MR_TABLE_DEBUG
+ if (MR_tablestackdebug) {
+ printf("clobbering redoip of frame at ");
+ MR_printnondstackptr(fr);
+ printf(" (in saved copy)\n");
+ }
+#endif
+ }
+ }
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("adding suspension node %p to table %p",
+ (void *) consumer, (void *) table);
+ printf(" at slot %p\n", table->consumer_list_tail);
+ }
+#endif
+
+ assert(*(table->consumer_list_tail) == NULL);
+ listnode = table_allocate_bytes(sizeof(struct MR_ConsumerListNode));
+ *(table->consumer_list_tail) = listnode;
+ table->consumer_list_tail = &(listnode->next);
+ listnode->item = consumer;
+ listnode->next = NULL;
+}
+ fail();
+END_MODULE
+
+MR_Subgoal *MR_cur_leader;
+
+/*
+** The procedure defined below restores answers to suspended consumers.
+** It works by restoring the consumer state saved by the consumer's call
+** to table_nondet_suspend. By restoring such states and then returning
+** answers, table_nondet_resume is essentially returning answers out of
+** the call to table_nondet_suspend, not out of the call to
+** table_nondet_resume.
+**
+** The code is arranged as a three level iteration to a fixpoint.
+** The three levels are: iterating over all subgoals in a connected component,
+** iterating over all consumers of each of those subgoals, and iterating
+** over all the answers to be returned to each of those consumers.
+** Note that returning an answer could lead to further answers for
+** any of the subgoals in the connected component; it can even lead
+** to the expansion of the component (i.e. the addition of more subgoals
+** to it).
+*/
+
+Define_extern_entry(mercury__table_nondet_resume_1_0);
+Declare_label(mercury__table_nondet_resume_1_0_ChangeLoop);
+Declare_label(mercury__table_nondet_resume_1_0_ReachedFixpoint);
+Declare_label(mercury__table_nondet_resume_1_0_LoopOverSuspensions);
+Declare_label(mercury__table_nondet_resume_1_0_ReturnAnswer);
+Declare_label(mercury__table_nondet_resume_1_0_RedoPoint);
+
+MR_MAKE_PROC_LAYOUT(mercury__table_nondet_resume_1_0,
+ MR_DETISM_NON, MR_ENTRY_NO_SLOT_COUNT, MR_LVAL_TYPE_UNKNOWN,
+ MR_PREDICATE, "private_builtin", "table_nondet_resume", 1, 0);
+MR_MAKE_INTERNAL_LAYOUT_WITH_ENTRY(
+ mercury__table_nondet_resume_1_0_ChangeLoop,
+ mercury__table_nondet_resume_1_0);
+MR_MAKE_INTERNAL_LAYOUT_WITH_ENTRY(
+ mercury__table_nondet_resume_1_0_ReachedFixpoint,
+ mercury__table_nondet_resume_1_0);
+MR_MAKE_INTERNAL_LAYOUT_WITH_ENTRY(
+ mercury__table_nondet_resume_1_0_LoopOverSubgoals,
+ mercury__table_nondet_resume_1_0);
+MR_MAKE_INTERNAL_LAYOUT_WITH_ENTRY(
+ mercury__table_nondet_resume_1_0_LoopOverSuspensions,
+ mercury__table_nondet_resume_1_0);
+MR_MAKE_INTERNAL_LAYOUT_WITH_ENTRY(
+ mercury__table_nondet_resume_1_0_ReturnAnswer,
+ mercury__table_nondet_resume_1_0);
+MR_MAKE_INTERNAL_LAYOUT_WITH_ENTRY(
+ mercury__table_nondet_resume_1_0_RedoPoint,
+ mercury__table_nondet_resume_1_0);
+MR_MAKE_INTERNAL_LAYOUT_WITH_ENTRY(
+ mercury__table_nondet_resume_1_0_RestartPoint,
+ mercury__table_nondet_resume_1_0);
+
+BEGIN_MODULE(table_nondet_resume_module)
+ init_entry_sl(mercury__table_nondet_resume_1_0);
+ MR_INIT_PROC_LAYOUT_ADDR(mercury__table_nondet_resume_1_0);
+ init_label_sl(mercury__table_nondet_resume_1_0_ChangeLoop);
+ init_label_sl(mercury__table_nondet_resume_1_0_ReachedFixpoint);
+ init_label_sl(mercury__table_nondet_resume_1_0_LoopOverSubgoals);
+ init_label_sl(mercury__table_nondet_resume_1_0_LoopOverSuspensions);
+ init_label_sl(mercury__table_nondet_resume_1_0_ReturnAnswer);
+ init_label_sl(mercury__table_nondet_resume_1_0_RedoPoint);
+ init_label_sl(mercury__table_nondet_resume_1_0_RestartPoint);
+BEGIN_CODE
+
+Define_entry(mercury__table_nondet_resume_1_0);
+ MR_cur_leader = MR_top_generator_table();
+
+ if (MR_cur_leader->leader != NULL) {
+ /*
+ ** The predicate that called table_nondet_resume
+ ** is not the leader of its component.
+ ** We will leave all answers to be returned
+ ** by the leader.
+ */
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("non-leader table_nondet_resume fails\n");
+ }
+#endif
+
+ (void) MR_pop_generator();
+ redo();
+ }
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("table_nondet_resume enter: current leader is %p\n",
+ MR_cur_leader);
+ }
+#endif
+
+ if (MR_cur_leader->resume_info != NULL) {
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("using existing resume info %p\n",
+ MR_cur_leader->resume_info);
+ }
+#endif
+ } else {
+ MR_cur_leader->resume_info = make(MR_ResumeInfo);
+
+ save_transient_registers();
+ save_state(&(MR_cur_leader->resume_info->leader_state),
+ MR_cur_leader->generator_maxfr,
+ MR_cur_leader->generator_sp,
+ "resumption", "generator");
+ restore_transient_registers();
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("creating new resume info %p\n",
+ MR_cur_leader->resume_info);
+ }
+#endif
+ }
+
+ MR_cur_leader->resume_info->changed = TRUE;
+
+Define_label(mercury__table_nondet_resume_1_0_ChangeLoop);
+
+ if (MR_cur_leader->resume_info->changed) {
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("changed flag set\n");
+ }
+#endif
+ } else {
+ MR_SubgoalList table_list;
+
+ for (table_list = MR_cur_leader->resume_info->subgoal_list;
+ table_list != NULL; table_list = table_list->next)
+ {
+ if (table_list->item->num_committed_ans
+ != table_list->item->num_ans)
+ {
+ MR_cur_leader->resume_info->changed = TRUE;
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("table %p has new answers\n",
+ table_list->item);
+ }
+#endif
+ }
+ }
+ }
+
+ if (! MR_cur_leader->resume_info->changed) {
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("no more changes\n");
+ }
+#endif
+ GOTO_LABEL(mercury__table_nondet_resume_1_0_ReachedFixpoint);
+ }
+
+ MR_cur_leader->resume_info->subgoal_list = MR_cur_leader->followers;
+
+ /* For each of the subgoals on our list of followers */
+Define_label(mercury__table_nondet_resume_1_0_LoopOverSubgoals);
+
+ if (MR_cur_leader->resume_info->subgoal_list == NULL) {
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("no more subgoals in the followers list\n");
+ }
+#endif
+
+ GOTO_LABEL(mercury__table_nondet_resume_1_0_ChangeLoop);
+ }
+
+ MR_cur_leader->resume_info->cur_subgoal =
+ MR_cur_leader->resume_info->subgoal_list->item;
+ MR_cur_leader->resume_info->subgoal_list =
+ MR_cur_leader->resume_info->subgoal_list->next;
+
+ MR_cur_leader->resume_info->consumer_list =
+ MR_cur_leader->resume_info->cur_subgoal->consumer_list;
+
+ MR_cur_leader->resume_info->changed = FALSE;
+ MR_cur_leader->resume_info->cur_subgoal->num_committed_ans =
+ MR_cur_leader->resume_info->cur_subgoal->num_ans;
+
+ /* For each of the suspended nodes for cur_subgoal */
+Define_label(mercury__table_nondet_resume_1_0_LoopOverSuspensions);
+
+ if (MR_cur_leader->resume_info->consumer_list == NULL) {
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("no more suspensions for current subgoal\n");
+ }
+#endif
+ GOTO_LABEL(mercury__table_nondet_resume_1_0_LoopOverSubgoals);
+ }
+
+ MR_cur_leader->resume_info->cur_consumer =
+ MR_cur_leader->resume_info->consumer_list->item;
+ MR_cur_leader->resume_info->consumer_list =
+ MR_cur_leader->resume_info->consumer_list->next;
+
+ MR_cur_leader->resume_info->cur_consumer_answer_list =
+ *(MR_cur_leader->resume_info->cur_consumer->
+ remaining_answer_list_ptr);
+
+ if (MR_cur_leader->resume_info->cur_consumer_answer_list == NULL) {
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("no first answer for this suspension\n");
+ }
+#endif
+ GOTO_LABEL(mercury__table_nondet_resume_1_0_LoopOverSuspensions);
+ }
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("resuming consumer %p from table %p\n",
+ (void *) MR_cur_leader->resume_info->cur_consumer,
+ (void *) MR_cur_leader->resume_info->cur_subgoal);
+ }
+#endif
+
+ save_transient_registers();
+ restore_state(
+ &(MR_cur_leader->resume_info->cur_consumer->saved_state),
+ "resumption", "consumer");
+ restore_transient_registers();
+
+ /* check that there is room for exactly one framevar */
+ assert((MR_maxfr - MR_prevfr_slot(MR_maxfr)) ==
+ (MR_NONDET_FIXED_SIZE + 1));
+
+ MR_gen_sp = MR_cur_leader->resume_info->leader_state.gen_sp;
+ MR_redoip_slot(MR_maxfr) =
+ LABEL(mercury__table_nondet_resume_1_0_RedoPoint);
+ MR_redofr_slot(MR_maxfr) = MR_maxfr;
+ MR_based_framevar(MR_maxfr, 1) = (Word) MR_cur_leader;
+
+Define_label(mercury__table_nondet_resume_1_0_ReturnAnswer);
+
+ /*
+ ** Return the next answer in MR_cur_leader->resume_info->
+ ** cur_consumer_answer_list to the current consumer. Since we have
+ ** already restored the context of the suspended consumer before
+ ** we returned the first answer, we don't need to restore it again,
+ ** since will not have changed in the meantime.
+ */
+
+
+#ifdef COMPACT_ARGS
+ r1 = (Word) &MR_cur_leader->resume_info->cur_consumer_answer_list->
+ answer_data;
+#else
+ r2 = (Word) &MR_cur_leader->resume_info->cur_consumer_answer_list->
+ answer_data;
+#endif
+
+ MR_cur_leader->resume_info->cur_consumer->remaining_answer_list_ptr =
+ &(MR_cur_leader->resume_info->cur_consumer_answer_list->
+ next_answer);
+
+ MR_cur_leader->resume_info->cur_consumer_answer_list =
+ MR_cur_leader->resume_info->cur_consumer_answer_list->
+ next_answer;
+
+ /*
+ ** Return the answer. Since we just restored the state of the
+ ** computation that existed when suspend was called, the code
+ ** that we return to is the code following the call to suspend.
+ */
+ succeed();
+
+Define_label(mercury__table_nondet_resume_1_0_RedoPoint);
+ update_prof_current_proc(LABEL(mercury__table_nondet_resume_1_0));
+
+ /*
+ ** This is where the current consumer suspension will go on
+ ** backtracking when it wants the next solution. If there is a solution
+ ** we haven't returned to this consumer yet, we do so, otherwise we
+ ** remember how many answers we have returned to this consumer so far
+ ** and move on to the next suspended consumer of the current subgoal.
+ */
+
+ MR_cur_leader = (MR_Subgoal *) MR_based_framevar(MR_maxfr, 1);
+
+Define_label(mercury__table_nondet_resume_1_0_RestartPoint);
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("cur_consumer_answer_list: %p\n",
+ MR_cur_leader->resume_info->cur_consumer_answer_list);
+ printf("*cur_consumer->remaining_answer_list_ptr: %p\n",
+ *(MR_cur_leader->resume_info->cur_consumer->
+ remaining_answer_list_ptr));
+ }
+#endif
+
+#if 1
+ if (MR_cur_leader->resume_info->cur_consumer_answer_list != NULL) {
+ GOTO_LABEL(mercury__table_nondet_resume_1_0_ReturnAnswer);
+ }
+#else
+ if (*(MR_cur_leader->resume_info->cur_consumer->
+ remaining_answer_list_ptr) != NULL)
+ {
+ MR_cur_leader->resume_info->cur_consumer_answer_list =
+ *(MR_cur_leader->resume_info->cur_consumer->
+ remaining_answer_list_ptr);
+ GOTO_LABEL(mercury__table_nondet_resume_1_0_ReturnAnswer);
+ }
+#endif
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("no more unreturned answers for this suspension\n");
+ }
+#endif
+
+ if (MR_cur_leader->resume_info->cur_subgoal->num_committed_ans
+ != MR_cur_leader->resume_info->cur_subgoal->num_ans)
+ {
+ MR_cur_leader->resume_info->changed = TRUE;
+ }
+
+ GOTO_LABEL(mercury__table_nondet_resume_1_0_LoopOverSuspensions);
+
+Define_label(mercury__table_nondet_resume_1_0_ReachedFixpoint);
+ {
+ MR_SubgoalList table_list;
+
+ for (table_list = MR_cur_leader->followers;
+ table_list != NULL; table_list = table_list->next)
+ {
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("marking table %p complete\n",
+ table_list->item);
+ }
+#endif
+
+ table_list->item->status = MR_SUBGOAL_COMPLETE;
+ table_list->item->num_committed_ans = -1;
+ }
+ }
+
+ /* Restore the state we had when table_nondet_resume was called */
+ save_transient_registers();
+ restore_state(&(MR_cur_leader->resume_info->leader_state),
+ "resumption", "generator");
+ restore_transient_registers();
+
+ /* XXX we should free this cell and its components */
+ MR_cur_leader->resume_info = NULL;
+
+ /* We are done with this generator */
+ (void) MR_pop_generator();
+
+ proceed();
+END_MODULE
+
+Define_extern_entry(MR_table_nondet_commit);
+BEGIN_MODULE(table_nondet_commit_module)
+ init_entry_ai(MR_table_nondet_commit);
+BEGIN_CODE
+Define_entry(MR_table_nondet_commit);
+ MR_commit_cut();
+ fail();
+END_MODULE
+
+/* Ensure that the initialization code for the above modules get run. */
+/*
+INIT mercury_sys_init_table_modules
+*/
+
+extern ModuleFunc table_nondet_suspend_module;
+extern ModuleFunc table_nondet_resume_module;
+extern ModuleFunc table_nondet_commit_module;
+
+void mercury_sys_init_table_modules(void);
+ /* extra declaration to suppress gcc -Wmissing-decl warning */
+void mercury_sys_init_table_modules(void) {
+ table_nondet_suspend_module();
+ table_nondet_resume_module();
+ table_nondet_commit_module();
+}
Index: runtime/mercury_tabling.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.h,v
retrieving revision 1.11
diff -u -b -u -r1.11 mercury_tabling.h
--- mercury_tabling.h 1999/03/10 22:05:25 1.11
+++ mercury_tabling.h 1999/03/11 09:34:51
@@ -19,15 +19,13 @@
#include "mercury_float.h"
/*---------------------------------------------------------------------------*/
-
-typedef Word **TrieNode;
-typedef Word **AnswerBlock;
-
-/*---------------------------------------------------------------------------*/
/*
** The functions defined here are used only via the macros defined below.
*/
+typedef Word **MR_TrieNode;
+typedef Word **MR_AnswerBlock;
+
/* functions to handle the builtin types: string, int, float, type_info */
/*
@@ -36,7 +34,7 @@
** If it is not, create a new element for the key in the table and
** return the address of its data pointer.
**/
-TrieNode MR_int_hash_lookup_or_add(TrieNode Table, Integer Key);
+MR_TrieNode MR_int_hash_lookup_or_add(MR_TrieNode Table, Integer Key);
/*
** Look to see if the given float key is in the given table. If it
@@ -44,7 +42,7 @@
** If it is not create a new element for the key in the table and
** return the address of its data pointer.
**/
-TrieNode MR_float_hash_lookup_or_add(TrieNode Table, Float Key);
+MR_TrieNode MR_float_hash_lookup_or_add(MR_TrieNode Table, Float Key);
/*
** Look to see if the given string key is in the given table. If it
@@ -52,13 +50,13 @@
** If it is not create a new element for the key in the table and
** return the address of its data pointer.
**/
-TrieNode MR_string_hash_lookup_or_add(TrieNode Table, String Key);
+MR_TrieNode MR_string_hash_lookup_or_add(MR_TrieNode Table, String Key);
/*
** Lookup or insert the given type_info into the given table. Return a
** pointer to the node of the table reached by the lookup/insert.
*/
-TrieNode MR_type_info_lookup_or_add(TrieNode, Word *);
+MR_TrieNode MR_type_info_lookup_or_add(MR_TrieNode, Word *);
/* --- a function to handle enumerated types --- */
@@ -67,7 +65,7 @@
** table of size Range. The return value is a pointer to the table
** node found by the lookup/insert.
*/
-TrieNode MR_int_index_lookup_or_add(TrieNode table, Integer range, Integer key);
+MR_TrieNode MR_int_index_lookup_or_add(MR_TrieNode table, Integer range, Integer key);
/* --- a function to handle any type at all --- */
@@ -77,7 +75,7 @@
** info to do this. It returns a pointer to the node found by the
** insertion/lookup.
*/
-TrieNode MR_table_type(TrieNode Table, Word *type_info, Word data_value);
+MR_TrieNode MR_table_type(MR_TrieNode Table, Word *type_info, Word data_value);
/*---------------------------------------------------------------------------*/
@@ -122,7 +120,7 @@
} while (0)
#define MR_DEBUG_TABLE_ANY(table, type_info, value) \
do { \
- TrieNode prev_table = (table); \
+ MR_TrieNode prev_table = (table); \
(table) = (Word **) MR_RAW_TABLE_ANY((table), \
(type_info), (value)); \
if (MR_tabledebug) { \
@@ -144,7 +142,7 @@
} while (0)
#define MR_DEBUG_TABLE_TAG(table, value) \
do { \
- TrieNode prev_table = (table); \
+ MR_TrieNode prev_table = (table); \
(table) = (Word **) MR_RAW_TABLE_TAG((table), (value)); \
if (MR_tabledebug) { \
printf("TABLE %p: tag %d => %p\n", prev_table, \
@@ -164,7 +162,7 @@
} while (0)
#define MR_DEBUG_TABLE_ENUM(table, count, value) \
do { \
- TrieNode prev_table = (table); \
+ MR_TrieNode prev_table = (table); \
(table) = (Word **) MR_RAW_TABLE_ENUM((table), (count), \
(value)); \
if (MR_tabledebug) { \
@@ -185,7 +183,7 @@
} while (0)
#define MR_DEBUG_TABLE_WORD(table, value) \
do { \
- TrieNode prev_table = (table); \
+ MR_TrieNode prev_table = (table); \
(table) = (Word **) MR_RAW_TABLE_WORD((table), (value));\
if (MR_tabledebug) { \
printf("TABLE %p: word %d => %p\n", \
@@ -205,7 +203,7 @@
} while (0)
#define MR_DEBUG_TABLE_INT(table, value) \
do { \
- TrieNode prev_table = (table); \
+ MR_TrieNode prev_table = (table); \
(table) = (Word **) MR_RAW_TABLE_INT((table), (value)); \
if (MR_tabledebug) { \
printf("TABLE %p: int %d => %p\n", \
@@ -225,7 +223,7 @@
} while (0)
#define MR_DEBUG_TABLE_CHAR(table, value) \
do { \
- TrieNode prev_table = (table); \
+ MR_TrieNode prev_table = (table); \
(table) = (Word **) MR_RAW_TABLE_CHAR((table), (value));\
if (MR_tabledebug) { \
printf("TABLE %p: char `%c'/%d => %p\n", \
@@ -246,7 +244,7 @@
} while (0)
#define MR_DEBUG_TABLE_FLOAT(table, value) \
do { \
- TrieNode prev_table = (table); \
+ MR_TrieNode prev_table = (table); \
(table) = (Word **) MR_RAW_TABLE_FLOAT((table), (value));\
if (MR_tabledebug) { \
printf("TABLE %p: float %f => %p\n", \
@@ -267,7 +265,7 @@
} while (0)
#define MR_DEBUG_TABLE_STRING(table, value) \
do { \
- TrieNode prev_table = (table); \
+ MR_TrieNode prev_table = (table); \
(table) = (Word **) MR_RAW_TABLE_STRING((table), (value));\
if (MR_tabledebug) { \
printf("TABLE %p: string `%s' => %p\n", \
@@ -287,7 +285,7 @@
} while (0)
#define MR_DEBUG_TABLE_TYPEINFO(table, value) \
do { \
- TrieNode prev_table = (table); \
+ MR_TrieNode prev_table = (table); \
(table) = (Word **) MR_RAW_TABLE_TYPE_INFO((table), (value));\
if (MR_tabledebug) { \
printf("TABLE %p: typeinfo %p => %p\n", \
@@ -393,20 +391,47 @@
/***********************************************************************/
+#ifdef MR_TABLE_DEBUG
+
#define MR_TABLE_CREATE_ANSWER_BLOCK(ABlock, Elements) \
do { \
- *((AnswerBlock) ABlock) = \
+ *((MR_AnswerBlock) ABlock) = \
(Word *) table_allocate_words(Elements); \
+ if (MR_tabledebug) \
+ printf("allocated answer block %p -> %p\n", \
+ ((MR_AnswerBlock) ABlock), \
+ *((MR_AnswerBlock) ABlock)); \
} while(0)
#define MR_TABLE_GET_ANSWER(Offset, ABlock) \
- (* ((AnswerBlock) ABlock))[Offset]
+ (( MR_tabledebug ? \
+ (printf("using answer block: %p\n", \
+ ((MR_AnswerBlock) ABlock)), \
+ printf("pointing to: %p\n", \
+ *((MR_AnswerBlock) ABlock))) \
+ : \
+ 0 /* do nothing */ \
+ ), \
+ (* ((MR_AnswerBlock) ABlock))[Offset])
+
+#else
+#define MR_TABLE_CREATE_ANSWER_BLOCK(ABlock, Elements) \
+ do { \
+ *((MR_AnswerBlock) ABlock) = \
+ (Word *) table_allocate_words(Elements); \
+ } while(0)
+
+#define MR_TABLE_GET_ANSWER(Offset, ABlock) \
+ (* ((MR_AnswerBlock) ABlock))[Offset]
+
+#endif
+
#ifdef CONSERVATIVE_GC
#define MR_TABLE_SAVE_ANSWER(Offset, ABlock, Value, TypeInfo) \
do { \
- (* ((AnswerBlock) ABlock))[Offset] = Value; \
+ (* ((MR_AnswerBlock) ABlock))[Offset] = Value; \
} while(0)
#else /* not CONSERVATIVE_GC */
@@ -415,7 +440,7 @@
do { \
save_transient_hp(); \
{ Word local_val = Value; \
- (* ((AnswerBlock) ABlock))[Offset] = \
+ (* ((MR_AnswerBlock) ABlock))[Offset] = \
deep_copy(&local_val, (Word *) (Word) &TypeInfo,\
NULL, NULL); \
} \
@@ -467,9 +492,175 @@
#endif /* CONSERVATIVE_GC */
#define table_copy_bytes(Dest, Source, Size) \
- memcpy(Dest, Source, Size)
+ MR_memcpy(Dest, Source, Size)
#define table_copy_words(Dest, Source, Size) \
- memcpy((char *) Dest, (char *) Source, sizeof(Word) * Size)
+ MR_memcpy((char *) (Dest), (char *) (Source), sizeof(Word) * Size)
+
+/*---------------------------------------------------------------------------*/
+
+typedef struct MR_AnswerListNodeStruct MR_AnswerListNode;
+typedef struct MR_AnswerListNodeStruct *MR_AnswerList;
+
+struct MR_AnswerListNodeStruct {
+ Integer answer_num;
+ Word answer_data;
+ MR_AnswerList next_answer;
+};
+
+typedef enum {
+ MR_ANS_NOT_GENERATED,
+ MR_ANS_GENERATED
+} MR_AnswerDuplState;
+
+/*
+** The state of a model_det or model_semi subgoal.
+**
+** Note that the word containing the MR_SimpletableStatus,
+** which is at the end of the chain of trie nodes given by
+** the input arguments of the tabled subgoal, will be overwritten
+** by a pointer to the answer block containing the output arguments
+** when the goal succeeds. The MR_SIMPLETABLE_SUCCEEDED status code
+** is used only when the goal has no outputs. This is why
+** MR_SIMPLETABLE_SUCCEEDED must the last entry in the enum,
+** and why code looking at an MR_SimpletableStatus must test
+** for success with "x >= MR_SIMPLETABLE_SUCCEEDED".
+*/
+
+typedef enum {
+ MR_SIMPLETABLE_UNINITIALIZED,
+ MR_SIMPLETABLE_WORKING,
+ MR_SIMPLETABLE_FAILED,
+ MR_SIMPLETABLE_SUCCEEDED
+} MR_SimpletableStatus;
+
+typedef enum {
+ MR_SUBGOAL_INACTIVE,
+ MR_SUBGOAL_ACTIVE,
+ MR_SUBGOAL_COMPLETE
+} MR_SubgoalStatus;
+
+/*
+** The saved state of a generator or a consumer. While consumers get
+** suspended while they are waiting for generators to produce more solutions,
+** generators need their state saved when they restore the state of a consumer
+** to consume a new solution.
+**
+** The saved state contains copies of
+**
+** - several virtual machine registers:
+** MR_succip, MR_sp, MR_curfr and MR_maxfr
+**
+** - segments of the nondet and det stacks:
+** the parts that cannot possibly change between the times of saving
+** and restoring the saved state are not saved.
+**
+** The segments are described by three fields each. The *_block_start
+** field gives the address of the first word in the real stack
+** that is part of the saved segment, the *_block_size field
+** gives the size of the saved segment in words, and the *_block
+** field points to the area of memory containing the saved segment.
+**
+** - the entire generator stack and the entire cut stack:
+** they are usually so small, it is faster to save them all
+** than to figure out which parts need saving.
+**
+** Each stack is described by its size in words and a pointer to
+** an area of memory containing the entire saved stack.
+*/
+
+typedef struct {
+ Code *succ_ip;
+ Word *s_p;
+ Word *cur_fr;
+ Word *max_fr;
+ Word *non_stack_block_start;
+ Word non_stack_block_size;
+ Word *non_stack_block;
+ Word *det_stack_block_start;
+ Word det_stack_block_size;
+ Word *det_stack_block;
+ Integer gen_sp;
+ char *generator_stack_block;
+ Integer cut_sp;
+ char *cut_stack_block;
+} MR_SavedState;
+
+/* The state of a consumer subgoal */
+typedef struct {
+ MR_SavedState saved_state;
+ MR_AnswerList *remaining_answer_list_ptr;
+} MR_Consumer;
+
+typedef struct MR_ConsumerListNode *MR_ConsumerList;
+
+struct MR_ConsumerListNode {
+ MR_Consumer *item;
+ MR_ConsumerList next;
+};
+
+typedef struct MR_SubgoalStruct MR_Subgoal;
+typedef struct MR_SubgoalListNode *MR_SubgoalList;
+
+/*
+** The following structure is used to hold the state and variables used in
+** the table_resume procedure.
+*/
+
+typedef struct {
+ MR_SavedState leader_state;
+ MR_SubgoalList subgoal_list;
+ MR_Subgoal *cur_subgoal;
+ MR_ConsumerList consumer_list; /* for the current subgoal */
+ MR_Consumer *cur_consumer;
+ MR_AnswerList cur_consumer_answer_list;
+ bool changed;
+} MR_ResumeInfo;
+
+struct MR_SubgoalListNode {
+ MR_Subgoal *item;
+ MR_SubgoalList next;
+};
+
+/* Used to save info about a single subgoal in the table */
+struct MR_SubgoalStruct {
+ MR_SubgoalStatus status;
+ MR_Subgoal *leader;
+ MR_SubgoalList followers;
+ MR_SubgoalList *followers_tail;
+ MR_ResumeInfo *resume_info;
+ Word answer_table; /* Table of answers returned */
+ /* by the subgoal */
+ Integer num_ans; /* # of answers returned */
+ /* by the subgoal */
+ Integer num_committed_ans;
+ /* # of answers our leader */
+ /* is committed to returning */
+ /* to every consumer. */
+ MR_AnswerList answer_list; /* List of answers returned */
+ /* by the subgoal */
+ MR_AnswerList *answer_list_tail;
+ /* Pointer to the tail of */
+ /* the answer list. This is */
+ /* used to update the tail. */
+ MR_ConsumerList consumer_list; /* List of suspended calls */
+ /* to the subgoal */
+ MR_ConsumerList *consumer_list_tail;
+ /* As for answer_list_tail */
+ Word *generator_maxfr;
+ /* MR_maxfr at the time of */
+ /* the call to the generator */
+ Word *generator_sp;
+ /* MR_sp at the time of the */
+ /* call to the generator */
+};
+
+ /*
+ ** Cast a Word to a MR_Subgoal*: saves on typing and improves
+ ** readability.
+ */
+#define MR_SUBGOAL(T) (*(MR_Subgoal **) T)
+
+/*---------------------------------------------------------------------------*/
#endif /* not MERCURY_TABLING_H */
Index: runtime/mercury_wrapper.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_wrapper.c,v
retrieving revision 1.32
diff -u -b -u -r1.32 mercury_wrapper.c
--- mercury_wrapper.c 1999/03/17 08:10:53 1.32
+++ mercury_wrapper.c 1999/03/18 21:24:17
@@ -57,6 +57,8 @@
size_t global_heap_size = 1024;
size_t trail_size = 128;
size_t debug_heap_size = 4096;
+size_t generatorstack_size = 32;
+size_t cutstack_size = 32;
/* size of the redzones at the end of data areas, in kilobytes */
/* (but we later multiply by 1024 to convert to bytes) */
@@ -71,7 +73,15 @@
size_t global_heap_zone_size = 16;
size_t trail_zone_size = 16;
size_t debug_heap_zone_size = 16;
+size_t generatorstack_zone_size = 16;
+size_t cutstack_zone_size = 16;
+/* virtual machine registers that we don't even try to make real ones */
+Integer MR_gen_sp = 0;
+Integer MR_cut_sp = 0;
+MR_GeneratorStackFrame *MR_gen_stack = NULL;
+MR_CutStackFrame *MR_cut_stack = NULL;
+
/* primary cache size to optimize for, in bytes */
size_t pcache_size = 8192;
@@ -680,6 +690,8 @@
MR_sregdebug = TRUE;
else if (streq(MR_optarg, "t"))
MR_tracedebug = TRUE;
+ else if (streq(MR_optarg, "S"))
+ MR_tablestackdebug = TRUE;
else if (streq(MR_optarg, "T"))
MR_tabledebug = TRUE;
else if (streq(MR_optarg, "a")) {
Index: runtime/mercury_wrapper.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_wrapper.h,v
retrieving revision 1.17
diff -u -b -u -r1.17 mercury_wrapper.h
--- mercury_wrapper.h 1999/02/04 10:52:58 1.17
+++ mercury_wrapper.h 1999/03/11 08:38:02
@@ -16,6 +16,7 @@
#include "mercury_std.h" /* for `bool' */
#include "mercury_stack_layout.h" /* for `MR_Stack_Layout_Label' */
#include "mercury_trace_base.h" /* for `MR_trace_port' */
+#include "mercury_stacks.h" /* for `MR_{Cut,Generator}StackFrame' */
/*
** mercury_runtime_init() does some stuff to initialize the garbage collector
@@ -105,6 +106,8 @@
extern size_t trail_size;
extern size_t global_heap_size;
extern size_t debug_heap_size;
+extern size_t generatorstack_size;
+extern size_t cutstack_size;
/* sizes of the red zones */
extern size_t heap_zone_size;
@@ -114,7 +117,15 @@
extern size_t trail_zone_size;
extern size_t global_heap_zone_size;
extern size_t debug_heap_zone_size;
+extern size_t generatorstack_zone_size;
+extern size_t cutstack_zone_size;
+/* virtual machine registers that we don't even try to make real ones */
+extern Integer MR_gen_sp;
+extern Integer MR_cut_sp;
+extern MR_GeneratorStackFrame *MR_gen_stack;
+extern MR_CutStackFrame *MR_cut_stack;
+
/* file names for the mdb debugging streams */
extern const char *MR_mdb_in_filename;
extern const char *MR_mdb_out_filename;
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/tabling
Index: tests/tabling/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/tabling/Mmakefile,v
retrieving revision 1.4
diff -u -b -u -r1.4 Mmakefile
--- Mmakefile 1998/09/24 11:45:33 1.4
+++ Mmakefile 1999/03/18 01:37:50
@@ -8,27 +8,47 @@
PROGS= \
boyer \
+ coup \
+ coup_det_frame \
+ coup_no_commit \
+ coup_non_tabled_frame \
fib \
+ generator_in_commit \
+ repeat \
+ seq \
tc_loop \
tc_minimal
-# We don't yet pass the following tests:
-# coup
+# We don't yet pass the following tests. The reason is that they contain
+# interactions between tabling and constructs that function as negated
+# contexts.
+#
+# consumer_in_commit
+# consumer_in_solutions
#-----------------------------------------------------------------------------#
# at the moment tabling only works with conservative gc
GRADEFLAGS = --gc conservative
+# and minimal model tabling requires its own flags
+EXTRA_MCFLAGS = --use-minimal-model
+
# With the Mercury system as of 17 September 1998,
# tc_minimal works on some machines even in the presence of a known bug
# if inlining is turned on, so we turn inlining off to make the test tougher.
MCFLAGS-tc_minimal = --no-inlining
-# tc_loop is expected to abort, so we need to ignore the exit status
+# Some test cases are expected to abort, so we need to ignore the exit status
# (hence the leading `-')
tc_loop.out: tc_loop
-./tc_loop > tc_loop.out 2>&1;
+
+consumer_in_commit.out: consumer_in_commit
+ -./consumer_in_commit > consumer_in_commit.out 2>&1;
+
+consumer_in_solutions.out: consumer_in_solutions
+ -./consumer_in_solutions > consumer_in_solutions.out 2>&1;
#-----------------------------------------------------------------------------#
Index: tests/tabling/consumer_in_commit.exp
===================================================================
RCS file: consumer_in_commit.exp
diff -N consumer_in_commit.exp
--- /dev/null Wed May 28 10:49:58 1997
+++ consumer_in_commit.exp Fri Mar 12 11:51:19 1999
@@ -0,0 +1,2 @@
+Mercury runtime: Sorry, not implemented:
+committing across a suspended call to a tabled predicate
Index: tests/tabling/consumer_in_commit.m
===================================================================
RCS file: consumer_in_commit.m
diff -N consumer_in_commit.m
--- /dev/null Wed May 28 10:49:58 1997
+++ consumer_in_commit.m Fri Mar 12 11:44:18 1999
@@ -0,0 +1,46 @@
+% This test case checks whether we get incorrect answers
+% when a consumer gets suspended inside a commit.
+
+:- module consumer_in_commit.
+
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module int, list.
+:- import_module std_util.
+
+main -->
+ { solutions(p, Solns) },
+ io__write(Solns),
+ io__write_string("\n").
+
+:- pred p(int).
+:- mode p(out) is nondet.
+
+p(X) :-
+ q(X),
+ r(X).
+
+:- pragma minimal_model(q/1).
+:- pred q(int).
+:- mode q(out) is nondet.
+
+q(X) :-
+ (
+ X = 1
+ ;
+ q(Y),
+ X = Y + 1,
+ X < 10
+ ).
+
+:- pred r(int).
+:- mode r(in) is semidet.
+
+r(X) :-
+ X < 5,
+ q(_).
Index: tests/tabling/consumer_in_solutions.exp
===================================================================
RCS file: consumer_in_solutions.exp
diff -N consumer_in_solutions.exp
--- /dev/null Wed May 28 10:49:58 1997
+++ consumer_in_solutions.exp Fri Feb 26 18:00:42 1999
@@ -0,0 +1 @@
+[1 - [1, 2, 3], 2 - [1, 2, 3], 3 - [1, 2, 3]]
Index: tests/tabling/consumer_in_solutions.m
===================================================================
RCS file: consumer_in_solutions.m
diff -N consumer_in_solutions.m
--- /dev/null Wed May 28 10:49:58 1997
+++ consumer_in_solutions.m Fri Mar 12 11:46:11 1999
@@ -0,0 +1,35 @@
+% This test case checks whether we get incorrect answers
+% when a consumer gets suspended inside solutions.
+
+:- module consumer_in_solutions.
+
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module int, list.
+:- import_module std_util.
+
+main -->
+ { solutions(q, Solns) },
+ io__write(Solns),
+ io__write_string("\n").
+
+:- pragma minimal_model(q/1).
+:- pred q(pair(int, list(int))).
+:- mode q(out) is nondet.
+
+q(X - L) :-
+ p(X),
+ solutions(p, L).
+
+:- pragma minimal_model(p/1).
+:- pred p(int).
+:- mode p(out) is nondet.
+
+p(1).
+p(2).
+p(3).
Index: tests/tabling/coup.exp
===================================================================
RCS file: coup.exp
diff -N coup.exp
--- /dev/null Wed May 28 10:49:58 1997
+++ coup.exp Fri Feb 26 18:03:17 1999
@@ -0,0 +1 @@
+[1, 3, 4]
Index: tests/tabling/coup.m
===================================================================
RCS file: /home/mercury1/repository/tests/tabling/coup.m,v
retrieving revision 1.1
diff -u -b -u -r1.1 coup.m
--- coup.m 1998/09/24 11:45:36 1.1
+++ coup.m 1999/02/26 06:45:23
@@ -16,8 +16,9 @@
:- import_module std_util.
main -->
- { solutions(p, L) },
- writeilist(L).
+ { solutions(p, Solns) },
+ io__write(Solns),
+ io__write_string("\n").
:- pragma minimal_model(p/1).
:- pred p(int).
@@ -34,11 +35,3 @@
q(3) :- q(_).
q(4) :- p(_).
-
-:- pred writeilist(list(int)::in,io__state::di, io__state::uo) is det.
-
-writeilist([]) --> [].
-writeilist([X|R]) -->
- io__write_int(X),
- io__write_string(" "),
- writeilist(R).
Index: tests/tabling/coup_det_frame.exp
===================================================================
RCS file: coup_det_frame.exp
diff -N coup_det_frame.exp
--- /dev/null Wed May 28 10:49:58 1997
+++ coup_det_frame.exp Fri Feb 26 18:13:24 1999
@@ -0,0 +1 @@
+[1, 3, 4]
Index: tests/tabling/coup_det_frame.m
===================================================================
RCS file: coup_det_frame.m
diff -N coup_det_frame.m
--- /dev/null Wed May 28 10:49:58 1997
+++ coup_det_frame.m Fri Feb 26 17:48:53 1999
@@ -0,0 +1,51 @@
+% This test is a variant of coup, with the commits around the recursive
+% calls wrapped up inside exlicit predicates. This means that when a
+% subgoal is suspended, coup2 will require a non-empty det stack segment
+% to be saved, whereas in coup the saved det stack segment is empty.
+% Both need to be tested.
+%
+% In case there are any problems with the interaction of the commits
+% and tabling, this version is more likely to be easy to debug, since
+% putting breakpoints on any_p and any_q effectively puts breakpoint
+% on the commits, which otherwise you can't easily do.
+
+:- module coup_det_frame.
+
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module int, list.
+:- import_module std_util.
+
+main -->
+ { solutions(p, Solns) },
+ io__write(Solns),
+ io__write_string("\n").
+
+:- pragma minimal_model(p/1).
+:- pred p(int).
+:- mode p(out) is nondet.
+
+p(X) :-
+ q(X).
+p(X) :-
+ X = 1.
+
+:- pragma minimal_model(q/1).
+:- pred q(int).
+:- mode q(out) is nondet.
+
+q(3) :- any_q.
+q(4) :- any_p.
+
+:- pred any_q is semidet.
+
+any_q :- q(_).
+
+:- pred any_p is semidet.
+
+any_p :- p(_).
Index: tests/tabling/coup_no_commit.exp
===================================================================
RCS file: coup_no_commit.exp
diff -N coup_no_commit.exp
--- /dev/null Wed May 28 10:49:58 1997
+++ coup_no_commit.exp Fri Feb 26 18:13:38 1999
@@ -0,0 +1 @@
+[1, 4]
Index: tests/tabling/coup_no_commit.m
===================================================================
RCS file: coup_no_commit.m
diff -N coup_no_commit.m
--- /dev/null Wed May 28 10:49:58 1997
+++ coup_no_commit.m Fri Feb 26 17:48:07 1999
@@ -0,0 +1,39 @@
+% This test case is a variant of coup. It does not use commits,
+% but does use the output value of every tabled subgoal.
+
+:- module coup_no_commit.
+
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module int, list.
+:- import_module std_util.
+
+main -->
+ { solutions(p, Solns) },
+ io__write(Solns),
+ io__write_string("\n").
+
+:- pragma minimal_model(p/1).
+:- pred p(int).
+:- mode p(out) is nondet.
+
+p(X) :-
+ (
+ q(X)
+ ;
+ X = 1
+ ).
+
+:- pragma minimal_model(q/1).
+:- pred q(int).
+:- mode q(out) is nondet.
+
+q(Y) :-
+ p(Z),
+ Y is Z + 3,
+ Y < 10.
Index: tests/tabling/coup_non_tabled_frame.exp
===================================================================
RCS file: coup_non_tabled_frame.exp
diff -N coup_non_tabled_frame.exp
--- /dev/null Wed May 28 10:49:58 1997
+++ coup_non_tabled_frame.exp Fri Feb 26 18:03:47 1999
@@ -0,0 +1 @@
+[1, 3, 4, 5, 6]
Index: tests/tabling/coup_non_tabled_frame.m
===================================================================
RCS file: coup_non_tabled_frame.m
diff -N coup_non_tabled_frame.m
--- /dev/null Wed May 28 10:49:58 1997
+++ coup_non_tabled_frame.m Fri Feb 26 17:49:06 1999
@@ -0,0 +1,44 @@
+% This is yet another variant of the coup test case. This one includes
+% a non-tabled model_non procedure in the nondet stack segment that needs
+% to be saved and restored, checking that the frames of such procedures
+% are handled correctly.
+
+:- module coup_non_tabled_frame.
+
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module int, list.
+:- import_module std_util.
+
+main -->
+ { solutions(p, Solns) },
+ io__write(Solns),
+ io__write_string("\n").
+
+:- pragma minimal_model(p/1).
+:- pred p(int).
+:- mode p(out) is nondet.
+
+p(X) :-
+ r(X).
+p(X) :-
+ X = 1.
+
+:- pred r(int).
+:- mode r(out) is multi.
+
+r(X) :- q(X).
+r(6).
+
+:- pragma minimal_model(q/1).
+:- pred q(int).
+:- mode q(out) is nondet.
+
+q(3) :- q(_).
+q(4) :- p(_).
+q(5).
Index: tests/tabling/generator_in_commit.exp
===================================================================
RCS file: generator_in_commit.exp
diff -N generator_in_commit.exp
--- /dev/null Wed May 28 10:49:58 1997
+++ generator_in_commit.exp Wed Mar 17 18:28:09 1999
@@ -0,0 +1 @@
+[21, 22, 23, 24, 25, 26, 27, 28, 29, 42]
Index: tests/tabling/generator_in_commit.m
===================================================================
RCS file: generator_in_commit.m
diff -N generator_in_commit.m
--- /dev/null Wed May 28 10:49:58 1997
+++ generator_in_commit.m Wed Mar 17 17:31:16 1999
@@ -0,0 +1,44 @@
+% This test case checks whether we get incorrect answers
+% when a generated gets started but not finished inside a commit.
+
+:- module generator_in_commit.
+
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module int, list.
+:- import_module std_util.
+
+main -->
+ { solutions(p, Solns) },
+ io__write(Solns),
+ io__write_string("\n").
+
+:- pred p(int).
+:- mode p(out) is nondet.
+
+p(X) :-
+ (
+ q(_),
+ X = 42
+ ;
+ q(Y),
+ X = Y + 20
+ ).
+
+:- pragma minimal_model(q/1).
+:- pred q(int).
+:- mode q(out) is nondet.
+
+q(X) :-
+ (
+ q(Y),
+ X = Y + 1,
+ X < 10
+ ;
+ X = 1
+ ).
Index: tests/tabling/repeat.exp
===================================================================
RCS file: repeat.exp
diff -N repeat.exp
--- /dev/null Wed May 28 10:49:58 1997
+++ repeat.exp Thu Mar 11 15:42:37 1999
@@ -0,0 +1,2 @@
+[1, 2, 3]
+[1, 2, 3]
Index: tests/tabling/seq.exp
===================================================================
RCS file: seq.exp
diff -N seq.exp
--- /dev/null Wed May 28 10:49:58 1997
+++ seq.exp Fri Feb 26 18:04:21 1999
@@ -0,0 +1 @@
+[0, 1, 2, 3, 4, 5, 6, 7, 8, 9]
Index: tests/tabling/seq.m
===================================================================
RCS file: seq.m
diff -N seq.m
--- /dev/null Wed May 28 10:49:58 1997
+++ seq.m Fri Feb 26 17:49:27 1999
@@ -0,0 +1,33 @@
+% This test case checks the correctness of the code that performs
+% the fixpoint loop returning answers to consumers.
+
+:- module seq.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module std_util, int, list.
+
+main -->
+ { solutions(p, Solns) },
+ io__write(Solns),
+ io__write_string("\n").
+
+:- pred p(int).
+:- mode p(out) is nondet.
+
+:- pragma minimal_model(p/1).
+
+p(X) :-
+ (
+ p(Y),
+ X is Y + 1,
+ X < 10
+ ;
+ X = 0
+ ).
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
Index: trace/mercury_trace_internal.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.33
diff -u -b -u -r1.33 mercury_trace_internal.c
--- mercury_trace_internal.c 1999/03/18 08:19:17 1.33
+++ mercury_trace_internal.c 1999/03/20 10:26:14
@@ -1265,6 +1265,13 @@
} else {
MR_trace_usage("developer", "nondet_stack");
}
+ } else if (streq(words[0], "gen_stack")) {
+ if (word_count == 1) {
+ do_init_modules();
+ MR_print_gen_stack(MR_mdb_out);
+ } else {
+ MR_trace_usage("developer", "gen_stack");
+ }
} else if (streq(words[0], "stack_regs")) {
if (word_count == 1) {
fprintf(MR_mdb_out, "sp = ");
@@ -2496,6 +2503,7 @@
{ "exp", "clear_histogram" },
#endif
{ "developer", "nondet_stack" },
+ { "developer", "gen_stack" },
{ "developer", "stack_regs" },
{ "misc", "source" },
{ "misc", "quit" },
cvs diff: Diffing trial
cvs diff: Diffing util
%---------------------------------------------------------------------------%
% Copyright (C) 1994-1999 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: private_builtin.m.
% Main authors: fjh, ohutch, 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.
% 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.
% Many of the predicates defined in this module are builtin -
% they have definitions because the compiler generates code for them inline.
% Some others are implemented in the runtime.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- module private_builtin.
%-----------------------------------------------------------------------------%
:- interface.
% 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.
% 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.
:- pred builtin_compare_int(comparison_result::uo, int::in, int::in) is det.
:- pred builtin_unify_character(character::in, character::in) is semidet.
:- pred builtin_index_character(character::in, int::out) is det.
:- pred builtin_compare_character(comparison_result::uo, character::in,
character::in) is det.
:- pred builtin_unify_string(string::in, string::in) is semidet.
:- pred builtin_index_string(string::in, int::out) is det.
:- pred builtin_compare_string(comparison_result::uo, string::in, string::in)
is det.
:- pred builtin_unify_float(float::in, float::in) is semidet.
:- pred builtin_index_float(float::in, int::out) is det.
:- pred builtin_compare_float(comparison_result::uo, float::in, float::in)
is det.
:- pred builtin_unify_pred((pred)::in, (pred)::in) is semidet.
:- pred builtin_index_pred((pred)::in, int::out) is det.
:- 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).
:- 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.
% Compare_error is used in the code generated for compare/3 preds.
:- pred compare_error is erroneous.
% 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.
:- pred builtin_int_gt(int, int).
:- mode builtin_int_gt(in, in) is semidet.
:- external(builtin_int_gt/2).
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module require, string, std_util, int, float, char, string, list.
builtin_unify_int(X, X).
builtin_index_int(X, X).
builtin_compare_int(R, X, Y) :-
( X < Y ->
R = (<)
; X = Y ->
R = (=)
;
R = (>)
).
builtin_unify_character(C, C).
builtin_index_character(C, N) :-
char__to_int(C, N).
builtin_compare_character(R, X, Y) :-
char__to_int(X, XI),
char__to_int(Y, YI),
( XI < YI ->
R = (<)
; XI = YI ->
R = (=)
;
R = (>)
).
builtin_unify_string(S, S).
builtin_index_string(_, -1).
builtin_compare_string(R, S1, S2) :-
builtin_strcmp(Res, S1, S2),
( Res < 0 ->
R = (<)
; Res = 0 ->
R = (=)
;
R = (>)
).
builtin_unify_float(F, F).
builtin_index_float(_, -1).
builtin_compare_float(R, F1, F2) :-
( F1 < F2 ->
R = (<)
; F1 > F2 ->
R = (>)
;
R = (=)
).
:- pred builtin_strcmp(int, string, string).
:- mode builtin_strcmp(out, in, in) is det.
:- pragma c_code(builtin_strcmp(Res::out, S1::in, S2::in),
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) :-
% suppress determinism warning
( semidet_succeed ->
string__append_list([
"call to compare/3 for non-canonical type `",
type_name(type_of(X)),
"'"],
Message),
error(Message)
;
% the following is never executed
Res = (<)
).
% This is used by the code that the compiler generates for compare/3.
compare_error :-
error("internal error in compare/3").
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- interface.
% This section of the module handles the runtime representation of
% type information.
% The code generated by polymorphism.m always requires
% the existence of a type_info functor, and requires
% the existence of a base_type_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(base_type_info(T) /*, ... */).
:- type base_type_info(T) ---> base_type_info(int /*, ... */).
% 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.
:- 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.
%-----------------------------------------------------------------------------%
:- implementation.
% The definitions for base_type_info/1 and type_info/1.
:- pragma c_header_code("
extern MR_STATIC_CODE_CONST struct
mercury_data___base_type_info_int_0_struct
mercury_data___base_type_info_int_0;
extern MR_STATIC_CODE_CONST struct
mercury_data___base_type_info_string_0_struct
mercury_data___base_type_info_string_0;
extern MR_STATIC_CODE_CONST struct
mercury_data___base_type_info_float_0_struct
mercury_data___base_type_info_float_0;
extern MR_STATIC_CODE_CONST struct
mercury_data___base_type_info_character_0_struct
mercury_data___base_type_info_character_0;
").
:- pragma c_code("
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);
extern const struct
mercury_data_private_builtin__base_type_layout_type_info_1_struct
mercury_data_private_builtin__base_type_layout_type_info_1;
extern const struct
mercury_data_private_builtin__base_type_functors_type_info_1_struct
mercury_data_private_builtin__base_type_functors_type_info_1;
/*
** For most purposes, base_type_info can be treated just like
** type_info. The code that handles type_infos can also handle
** base_type_infos.
*/
MR_STATIC_CODE_CONST struct
mercury_data_private_builtin__base_type_info_base_type_info_1_struct {
Integer f1;
Code *f2;
Code *f3;
Code *f4;
const Word *f5;
const Word *f6;
const Word *f7;
const Word *f8;
} mercury_data_private_builtin__base_type_info_base_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__base_type_layout_type_info_1,
(const Word *) &
mercury_data_private_builtin__base_type_functors_type_info_1,
(const Word *) string_const(""private_builtin"", 15),
(const Word *) string_const(""base_type_info"", 14)
};
MR_STATIC_CODE_CONST struct
mercury_data_private_builtin__base_type_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;
} mercury_data_private_builtin__base_type_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__base_type_layout_type_info_1,
(const Word *) &
mercury_data_private_builtin__base_type_functors_type_info_1,
(const Word *) string_const(""private_builtin"", 15),
(const Word *) string_const(""type_info"", 9)
};
const struct mercury_data_private_builtin__base_type_layout_type_info_1_struct {
TYPE_LAYOUT_FIELDS
} mercury_data_private_builtin__base_type_layout_type_info_1 = {
make_typelayout_for_all_tags(TYPELAYOUT_CONST_TAG,
mkbody(MR_TYPELAYOUT_TYPEINFO_VALUE))
};
const struct mercury_data_private_builtin__base_type_functors_type_info_1_struct {
Integer f1;
} mercury_data_private_builtin__base_type_functors_type_info_1 = {
MR_TYPEFUNCTORS_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);
{
/*
** 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();
}
Define_entry(mercury____Index___private_builtin__type_info_1_0);
index_output = -1;
proceed();
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
/* 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(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);
").
%-----------------------------------------------------------------------------%
:- interface.
% This section of the module is for miscellaneous predicates
% that sometimes have calls to them emitted by the compiler.
% 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.
:- pred unsafe_type_cast(T1, T2).
:- mode unsafe_type_cast(in, out) is det.
:- pred unused is det.
:- implementation.
unused :-
( semidet_succeed ->
error("attempted use of dead predicate")
;
% 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 status 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 status 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 for 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_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.
%-----------------------------------------------------------------------------%
:- interface.
% Return true if the subgoal represented by the given table has an
% answer.
:- semipure pred table_simple_is_complete(ml_subgoal_table_node).
:- mode table_simple_is_complete(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).
:- mode table_simple_has_succeeded(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).
:- mode table_simple_has_failed(in) is semidet.
% Currently being evaluated (working on an answer).
:- semipure pred table_simple_is_active(ml_subgoal_table_node).
:- mode table_simple_is_active(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).
:- mode table_simple_is_inactive(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).
:- mode table_simple_mark_as_succeeded(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).
:- mode table_simple_mark_as_failed(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).
:- mode table_simple_mark_as_active(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).
:- mode table_simple_mark_as_inactive(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: %d\\n"",
(Word *) T, *((Word *) T));
}
#endif
if (*((Word *) T) == MR_SIMPLETABLE_FAILED
|| *((Word *) T) >= MR_SIMPLETABLE_SUCCEEDED)
{
SUCCESS_INDICATOR = TRUE;
} else {
SUCCESS_INDICATOR = FALSE;
}
").
:- 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: %d\\n"",
(Word *) T, *((Word *) T));
}
#endif
SUCCESS_INDICATOR = (*((Word *) T) >= MR_SIMPLETABLE_SUCCEEDED)
").
:- 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: %d\\n"",
(Word *) T, *((Word *) T));
}
#endif
SUCCESS_INDICATOR = (*((Word *) 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(""checking if %p is active: %d\\n"",
(Word *) T, *((Word *) T));
}
#endif
SUCCESS_INDICATOR = (*((Word *) T) == MR_SIMPLETABLE_WORKING);
").
:- 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: %d\\n"",
(Word *) T, *((Word *) T));
}
#endif
SUCCESS_INDICATOR = (*((Word *) T) != MR_SIMPLETABLE_WORKING);
").
:- 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"", (Word *) T);
}
#endif
*((Word *) T) = MR_SIMPLETABLE_SUCCEEDED;
").
:- 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"", (Word *) T);
}
#endif
*((Word *) T) = MR_SIMPLETABLE_FAILED;
").
:- 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"", (Word *) T);
}
#endif
*((Word *) T) = MR_SIMPLETABLE_WORKING;
").
:- 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"", (Word *) T);
}
#endif
*((Word *) T) = MR_SIMPLETABLE_UNINITIALIZED;
").
%-----------------------------------------------------------------------------%
:- interface.
% 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,
ml_subgoal_table_node).
:- mode table_nondet_setup(in, 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, ml_answer_block).
:- mode table_nondet_suspend(in, 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).
:- mode table_nondet_resume(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).
:- mode table_nondet_is_complete(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).
:- mode table_nondet_is_active(in) is semidet.
% Mark a table as being active.
:- impure pred table_nondet_mark_as_active(ml_subgoal_table_node).
:- mode table_nondet_mark_as_active(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, ml_table).
:- mode table_nondet_get_ans_table(in, 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.
:- semipure pred table_nondet_answer_is_not_duplicate(ml_answer_table_node).
:- mode table_nondet_answer_is_not_duplicate(in) is semidet.
% Create a new slot in the answer list.
:- impure pred table_nondet_new_ans_slot(ml_subgoal_table_node,
ml_answer_slot).
:- mode table_nondet_new_ans_slot(in, 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,
ml_answer_block).
:- mode table_nondet_return_all_ans(in, out) is nondet.
%-----------------------------------------------------------------------------%
:- implementation.
:- pragma c_code(table_nondet_setup(T0::in, T::out), will_not_call_mercury, "
/*
** 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 (MR_SUBGOAL(T0) == NULL) {
MR_Subgoal *subgoal;
subgoal = (MR_Subgoal *)
table_allocate_bytes(sizeof(MR_Subgoal));
#ifdef MR_TABLE_DEBUG
if (MR_tabledebug) {
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;
").
% The definitions of these two predicates are in the runtime system.
:- external(table_nondet_suspend/2).
:- external(table_nondet_resume/1).
:- pragma c_code(table_nondet_is_complete(T::in),"
SUCCESS_INDICATOR = (MR_SUBGOAL(T)->status == MR_SUBGOAL_COMPLETE);
").
:- pragma c_code(table_nondet_is_active(T::in), will_not_call_mercury, "
SUCCESS_INDICATOR = (MR_SUBGOAL(T)->status == MR_SUBGOAL_ACTIVE);
").
:- pragma c_code(table_nondet_mark_as_active(T::in), will_not_call_mercury, "
MR_push_generator(MR_curfr, MR_SUBGOAL(T));
MR_register_generator_ptr((MR_Subgoal **) T);
MR_SUBGOAL(T)->status = MR_SUBGOAL_ACTIVE;
").
:- pragma c_code(table_nondet_get_ans_table(T::in, AT::out),
will_not_call_mercury, "
AT = (Word) &(MR_SUBGOAL(T)->answer_table);
").
:- pragma c_code(table_nondet_answer_is_not_duplicate(T::in),
will_not_call_mercury, "
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;
").
:- pragma c_code(table_nondet_new_ans_slot(T::in, Slot::out),
will_not_call_mercury, "
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
/*
**
** 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 = table_allocate_bytes(sizeof(MR_AnswerListNode));
answer_node->answer_num = table->num_ans;
answer_node->answer_data = 0;
answer_node->next_answer = NULL;
*(table->answer_list_tail) = answer_node;
table->answer_list_tail = &(answer_node->next_answer);
Slot = (Word) &(answer_node->answer_data);
").
% 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;
% }
% ")
% ).
:- external(table_nondet_return_all_ans/2).
:- 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
").
%-----------------------------------------------------------------------------%
:- interface.
%
% 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.
% 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.
% Report an error message about the current subgoal looping.
:- pred table_loopcheck_error(string).
:- mode table_loopcheck_error(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, int,
ml_answer_block).
:- mode table_create_ans_block(in, in, out) is det.
%-----------------------------------------------------------------------------%
:- implementation.
:- 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_save_int_ans(T::in, Offset::in, I::in),
will_not_call_mercury, "
MR_TABLE_SAVE_ANSWER(Offset, T, I,
mercury_data___base_type_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___base_type_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___base_type_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___base_type_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_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));
").
:- 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).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
More information about the developers
mailing list