[m-rev.] diff: allow "pragma memo" to specify how to table each argument
Zoltan Somogyi
zs at cs.mu.OZ.AU
Sun Aug 14 13:14:02 AEST 2005
This is what we talked about at the HAL meeting about ten days ago.
I'll address any comments after commit.
Zoltan.
Add a new tabling method, one which specifies how each argument should
be treated, like this:
:- pragma memo(p(in, in, in, out), [value, addr, promise_implied, output]).
doc/reference_manual.texi:
Document the new tabling method.
compiler/prog_data.m:
Add a new tabling method, one which specifies how each argument should
be treated.
compiler/hlds_pred.m:
Provide for the description of untabled input arguments of tabled
procedures.
compiler/prog_io_pragma.m:
Parse the new tabling method.
Fix a bunch of formatting problems.
compiler/add_pragma.m:
When adding a tabling pragma to the HLDS, check that if the pragma
individually specifies the tabling methods of a procedure's arguments,
then those tabling methods agree with the modes of those arguments.
Fix an old bug: check whether a tabled predicate's arguments are
fully input or fully output, and print an error message if not.
We used to check this only in table_gen.m, but there we could only
abort the compiler if the check failed.
Factor out some common code and thereby fix an old bug: check for
conflicting tabling pragmas not just when adding the pragma to all
procedures of a predicate, but also when adding it to only a
specified procedure.
compiler/table_gen.m:
Implement the new tabling method.
compiler/prog_out.m:
compiler/layout_out.m:
Conform to the changes above.
runtime/mercury_stack_layout.h:
Provide for the description of untabled input arguments of tabled
procedures.
trace/mercury_trace.c:
Handle the new tabling method.
trace/mercury_trace_internal.c:
Handle the new tabling method. Delete the defaults from some switches
on enums to allow gcc to recognize missing cases.
Handle the untabled input arguments of tabled procedures: skip over
them when printing procedures' call tables.
Enable better completion for mdb's "table" command.
trace/mercury_trace_tables.[ch]:
Rename the breakpoint completer the proc_spec completer, since it does
completions on procedure specifications.
tests/debugger/print_table.{m,inp,exp}:
Modify this test case to test the ability to print the tables of
predicates with some untabled arguments.
tests/tabling/specified.{m,exp}:
New test case to check the functioning of the new tabling method
by testing whether it is in fact faster to table the address of
an argument instead of its value, or to not table it at all.
Since the gains here are not quite as dramatic as tabled vs untabled,
use a slightly looser criterion for comparing speeds than we use
in the various versions of the fib test case.
tests/tabling/Mmakefile:
tests/tabling/Mercury.options:
Enable the new test case, and set up the option it needs.
tests/invalid/specified.{m,err_exp}:
New test case, a slight variant of tests/tabling/specified.m,
to check the compiler's ability to detect errors in the new form
of tabling pragma.
tests/invalid/Mmakefile:
Enable the new test case.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.2
diff -u -b -r1.2 add_pragma.m
--- compiler/add_pragma.m 8 Aug 2005 02:33:08 -0000 1.2
+++ compiler/add_pragma.m 13 Aug 2005 07:44:37 -0000
@@ -1356,8 +1356,7 @@
module_add_pragma_tabled(EvalMethod, PredName, Arity, MaybePredOrFunc,
MaybeModes, Status, Context, !ModuleInfo, !IO) :-
module_info_get_predicate_table(!.ModuleInfo, PredicateTable0),
- EvalMethodS = eval_method_to_string(EvalMethod),
-
+ EvalMethodStr = eval_method_to_one_string(EvalMethod),
(
MaybePredOrFunc = yes(PredOrFunc0),
PredOrFunc = PredOrFunc0,
@@ -1374,7 +1373,7 @@
;
module_info_name(!.ModuleInfo, ModuleName),
string__format("`:- pragma %s' declaration",
- [s(EvalMethodS)], Message1),
+ [s(EvalMethodStr)], Message1),
preds_add_implicit_report_error(ModuleName, PredOrFunc, PredName,
Arity, Status, no, Context, user(PredName), Message1, PredId,
!ModuleInfo, !IO),
@@ -1390,7 +1389,7 @@
;
module_info_name(!.ModuleInfo, ModuleName),
string__format("`:- pragma %s' declaration",
- [s(EvalMethodS)], Message1),
+ [s(EvalMethodStr)], Message1),
preds_add_implicit_report_error(ModuleName, predicate, PredName,
Arity, Status, no, Context, user(PredName), Message1, PredId,
!ModuleInfo, !IO),
@@ -1435,12 +1434,12 @@
),
adjust_func_arity(PredOrFunc, Arity0, Arity),
- EvalMethodS = eval_method_to_string(EvalMethod),
+ EvalMethodStr = eval_method_to_one_string(EvalMethod),
globals__io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
(
VeryVerbose = yes,
io__write_string("% Processing `:- pragma ", !IO),
- io__write_string(EvalMethodS, !IO),
+ io__write_string(EvalMethodStr, !IO),
io__write_string("' for ", !IO),
write_simple_call_id(PredOrFunc, PredName/Arity, !IO),
io__write_string("...\n", !IO)
@@ -1453,7 +1452,7 @@
pred_info_get_markers(PredInfo0, Markers),
globals.io_lookup_bool_option(warn_table_with_inline, WarnInline, !IO),
( check_marker(Markers, inline), WarnInline = yes ->
- TablePragmaStr = string.format("`:- pragma %s'", [s(EvalMethodS)]),
+ TablePragmaStr = string.format("`:- pragma %s'", [s(EvalMethodStr)]),
InlineWarning = [
words("Warning: "), simple_call_id(PredOrFunc - PredName/Arity),
words("has a"), fixed(TablePragmaStr),
@@ -1471,7 +1470,7 @@
( pred_info_is_imported(PredInfo0) ->
module_info_incr_errors(!ModuleInfo),
Pieces1 = [words("Error: "),
- fixed("`:- pragma " ++ EvalMethodS ++ "'"),
+ fixed("`:- pragma " ++ EvalMethodStr ++ "'"),
words("declaration for imported"),
simple_call_id(PredOrFunc - PredName/Arity), suffix(".")],
write_error_pieces(Context, 0, Pieces1, !IO)
@@ -1486,25 +1485,26 @@
),
% Add the eval model to the proc_info for this procedure.
- pred_info_procedures(PredInfo0, Procs0),
- map__to_assoc_list(Procs0, ExistingProcs),
+ pred_info_procedures(PredInfo0, ProcTable0),
+ map__to_assoc_list(ProcTable0, ExistingProcs),
+ SimpleCallId = PredOrFunc - PredName/Arity,
(
MaybeModes = yes(Modes),
(
get_procedure_matching_argmodes(ExistingProcs, Modes,
!.ModuleInfo, ProcId)
->
- map__lookup(Procs0, ProcId, ProcInfo0),
- proc_info_set_eval_method(EvalMethod, ProcInfo0, ProcInfo),
- map__det_update(Procs0, ProcId, ProcInfo, Procs),
- pred_info_set_procedures(Procs, PredInfo0, PredInfo),
+ map__lookup(ProcTable0, ProcId, ProcInfo0),
+ set_eval_method(ProcId, ProcInfo0, Context, SimpleCallId,
+ EvalMethod, ProcTable0, ProcTable, !ModuleInfo, !IO),
+ pred_info_set_procedures(ProcTable, PredInfo0, PredInfo),
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo)
;
module_info_incr_errors(!ModuleInfo),
Pieces2 = [words("Error:"),
- fixed("`:- pragma " ++ EvalMethodS ++ "'"),
+ fixed("`:- pragma " ++ EvalMethodStr ++ "'"),
words("declaration for undeclared mode of"),
- simple_call_id(PredOrFunc - PredName/Arity), suffix(".")],
+ simple_call_id(SimpleCallId), suffix(".")],
write_error_pieces(Context, 0, Pieces2, !IO)
)
;
@@ -1513,30 +1513,39 @@
ExistingProcs = [],
module_info_incr_errors(!ModuleInfo),
Pieces3 = [words("Error: "),
- fixed("`:- pragma " ++ EvalMethodS ++ "'"),
- words("declaration for"),
- simple_call_id(PredOrFunc - PredName/Arity),
+ fixed("`:- pragma " ++ EvalMethodStr ++ "'"),
+ words("declaration for"), simple_call_id(SimpleCallId),
words("with no declared modes.")],
write_error_pieces(Context, 0, Pieces3, !IO)
;
ExistingProcs = [_ | _],
- set_eval_method_list(ExistingProcs, Context, PredOrFunc,
- PredName/Arity, EvalMethod, Procs0, Procs, !ModuleInfo,
- !IO),
- pred_info_set_procedures(Procs, PredInfo0, PredInfo),
+ set_eval_method_list(ExistingProcs, Context, SimpleCallId,
+ EvalMethod, ProcTable0, ProcTable, !ModuleInfo, !IO),
+ pred_info_set_procedures(ProcTable, PredInfo0, PredInfo),
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo)
)
)
).
:- pred set_eval_method_list(assoc_list(proc_id, proc_info)::in,
- prog_context::in, pred_or_func::in, sym_name_and_arity::in,
- eval_method::in, proc_table::in, proc_table::out,
+ prog_context::in, simple_call_id::in, eval_method::in,
+ proc_table::in, proc_table::out, module_info::in, module_info::out,
+ io::di, io::uo) is det.
+
+set_eval_method_list([], _, _, _, !ProcTable, !ModuleInfo, !IO).
+set_eval_method_list([ProcId - ProcInfo0 | Rest], Context, SimpleCallId,
+ EvalMethod, !ProcTable, !ModuleInfo, !IO) :-
+ set_eval_method(ProcId, ProcInfo0, Context, SimpleCallId,
+ EvalMethod, !ProcTable, !ModuleInfo, !IO),
+ set_eval_method_list(Rest, Context, SimpleCallId,
+ EvalMethod, !ProcTable, !ModuleInfo, !IO).
+
+:- pred set_eval_method(proc_id::in, proc_info::in, prog_context::in,
+ simple_call_id::in, eval_method::in, proc_table::in, proc_table::out,
module_info::in, module_info::out, io::di, io::uo) is det.
-set_eval_method_list([], _, _, _, _, !Procs, !ModuleInfo, !IO).
-set_eval_method_list([ProcId - ProcInfo0 | Rest], Context, PredOrFunc,
- PredNameAndArity, EvalMethod, !Procs, !ModuleInfo, !IO) :-
+set_eval_method(ProcId, ProcInfo0, Context, SimpleCallId, EvalMethod,
+ !ProcTable, !ModuleInfo, !IO) :-
proc_info_eval_method(ProcInfo0, OldEvalMethod),
% NOTE: We don't bother detecting multiple tabling pragmas
% of the same type here.
@@ -1544,25 +1553,114 @@
OldEvalMethod \= eval_normal,
OldEvalMethod \= EvalMethod
->
- % If there are conflicting tabling pragmas then
- % emit an error message and do not bother changing
- % the evaluation method.
- OldEvalMethodStr = eval_method_to_string(OldEvalMethod),
- EvalMethodStr = eval_method_to_string(EvalMethod),
- Name = simple_call_id_to_string(PredOrFunc, PredNameAndArity),
- ErrorMsg = [words("Error:"), fixed(Name), words("has both"),
- fixed(OldEvalMethodStr), words("and"), fixed(EvalMethodStr),
- words("pragmas specified."),
+ % If there are conflicting tabling pragmas then emit an error message
+ % and do not bother changing the evaluation method.
+ OldEvalMethodStr = eval_method_to_one_string(OldEvalMethod),
+ EvalMethodStr = eval_method_to_one_string(EvalMethod),
+ Pieces = [words("Error:"), simple_call_id(SimpleCallId),
+ words("has both"), fixed(OldEvalMethodStr), words("and"),
+ fixed(EvalMethodStr), words("pragmas specified."),
words("Only one kind of tabling pragma may be applied to it.")
],
module_info_incr_errors(!ModuleInfo),
- error_util.write_error_pieces(Context, 0, ErrorMsg, !IO)
+ write_error_pieces(Context, 0, Pieces, !IO)
;
- proc_info_set_eval_method(EvalMethod, ProcInfo0, ProcInfo),
- map__det_update(!.Procs, ProcId, ProcInfo, !:Procs)
+ proc_info_maybe_declared_argmodes(ProcInfo0, MaybeDeclaredArgModes),
+ (
+ MaybeDeclaredArgModes = no,
+ EvalMethodStr = eval_method_to_one_string(EvalMethod),
+ Pieces = [words("Error:"),
+ fixed("`pragma" ++ EvalMethodStr ++ "'"),
+ words("declaration for"), simple_call_id(SimpleCallId),
+ suffix(","), words("which has no declared modes.")
+ ],
+ module_info_incr_errors(!ModuleInfo),
+ write_error_pieces(Context, 0, Pieces, !IO)
+ ;
+ MaybeDeclaredArgModes = yes(DeclaredArgModes),
+ ( EvalMethod = eval_memo(specified(MaybeArgMethods)) ->
+ check_pred_args_against_tabling_methods(DeclaredArgModes,
+ MaybeArgMethods, !.ModuleInfo, 1, MaybeError)
+ ;
+ check_pred_args_against_tabling(DeclaredArgModes, !.ModuleInfo,
+ 1, MaybeError)
),
- set_eval_method_list(Rest, Context, PredOrFunc, PredNameAndArity,
- EvalMethod, !Procs, !ModuleInfo, !IO).
+ (
+ MaybeError = no,
+ proc_info_set_eval_method(EvalMethod, ProcInfo0, ProcInfo),
+ svmap__det_update(ProcId, ProcInfo, !ProcTable)
+ ;
+ MaybeError = yes(ArgMsg - ErrorMsg),
+ EvalMethodStr = eval_method_to_one_string(EvalMethod),
+ Pieces = [words("Error in"),
+ fixed("`pragma " ++ EvalMethodStr ++ "'"),
+ words("declaration for"), simple_call_id(SimpleCallId),
+ suffix(":"), nl, fixed(ArgMsg), words(ErrorMsg)
+ ],
+ module_info_incr_errors(!ModuleInfo),
+ write_error_pieces(Context, 0, Pieces, !IO)
+ )
+ )
+ ).
+
+:- pred check_pred_args_against_tabling_methods(list(mode)::in,
+ list(maybe(arg_tabling_method))::in, module_info::in, int::in,
+ maybe(pair(string))::out) is det.
+
+check_pred_args_against_tabling_methods([], [], _, _, no).
+check_pred_args_against_tabling_methods([], [_ | _], _, _, MaybeError) :-
+ MaybeError = yes("too many argument tabling methods specified." - "").
+check_pred_args_against_tabling_methods([_ | _], [], _, _, MaybeError) :-
+ MaybeError = yes("not enough argument tabling methods specified." - "").
+check_pred_args_against_tabling_methods([Mode | Modes],
+ [MaybeArgMethod | MaybeArgMethods], ModuleInfo, ArgNum, MaybeError) :-
+ % XXX We should check not just the boundedness of the argument, but also
+ % whether it has any uniqueness annotation: tabling destroys uniqueness.
+ ( mode_is_fully_input(ModuleInfo, Mode) ->
+ (
+ MaybeArgMethod = yes(_),
+ check_pred_args_against_tabling_methods(Modes, MaybeArgMethods,
+ ModuleInfo, ArgNum + 1, MaybeError)
+ ;
+ MaybeArgMethod = no,
+ MaybeError = yes(("argument " ++ int_to_string(ArgNum) ++ ":") -
+ ("argument tabling method `" ++
+ maybe_arg_tabling_method_to_string(MaybeArgMethod) ++
+ "' is not compatible with input modes."))
+ )
+ ; mode_is_fully_output(ModuleInfo, Mode) ->
+ (
+ MaybeArgMethod = yes(_),
+ MaybeError = yes(("argument " ++ int_to_string(ArgNum) ++ ":") -
+ ("argument tabling method `" ++
+ maybe_arg_tabling_method_to_string(MaybeArgMethod) ++
+ "' is not compatible with output modes."))
+ ;
+ MaybeArgMethod = no,
+ check_pred_args_against_tabling_methods(Modes, MaybeArgMethods,
+ ModuleInfo, ArgNum + 1, MaybeError)
+ )
+ ;
+ MaybeError = yes(("argument " ++ int_to_string(ArgNum) ++ ":") -
+ "is neither input or output.")
+ ).
+
+:- pred check_pred_args_against_tabling(list(mode)::in, module_info::in,
+ int::in, maybe(pair(string))::out) is det.
+
+check_pred_args_against_tabling([], _, _, no).
+check_pred_args_against_tabling([Mode | Modes], ModuleInfo, ArgNum,
+ MaybeError) :-
+ ( mode_is_fully_input(ModuleInfo, Mode) ->
+ check_pred_args_against_tabling(Modes, ModuleInfo, ArgNum + 1,
+ MaybeError)
+ ; mode_is_fully_output(ModuleInfo, Mode) ->
+ check_pred_args_against_tabling(Modes, ModuleInfo, ArgNum + 1,
+ MaybeError)
+ ;
+ MaybeError = yes(("argument " ++ int_to_string(ArgNum)) -
+ "is neither input or output.")
+ ).
% Extract the modes from the list of pragma_vars.
%
Index: compiler/det_report.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_report.m,v
retrieving revision 1.100
diff -u -b -r1.100 det_report.m
--- compiler/det_report.m 24 Mar 2005 05:34:01 -0000 1.100
+++ compiler/det_report.m 13 Aug 2005 04:30:13 -0000
@@ -284,7 +284,7 @@
proc_info_context(ProcInfo0, Context),
write_error_pieces(Context, 0,
[words("Error: `pragma "
- ++ eval_method_to_string(EvalMethod)
+ ++ eval_method_to_one_string(EvalMethod)
++ "'"),
words("declaration not allowed for procedure"),
words("with determinism `"
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.361
diff -u -b -r1.361 hlds_out.m
--- compiler/hlds_out.m 12 Aug 2005 05:14:11 -0000 1.361
+++ compiler/hlds_out.m 13 Aug 2005 04:30:59 -0000
@@ -3823,7 +3823,7 @@
hlds_out__can_fail_to_string(cannot_fail) = "cannot_fail".
hlds_out__write_eval_method(EvalMethod, !IO) :-
- io__write_string(eval_method_to_string(EvalMethod), !IO).
+ io__write_string(eval_method_to_one_string(EvalMethod), !IO).
%-----------------------------------------------------------------------------%
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.170
diff -u -b -r1.170 hlds_pred.m
--- compiler/hlds_pred.m 12 Aug 2005 05:14:11 -0000 1.170
+++ compiler/hlds_pred.m 12 Aug 2005 23:25:28 -0000
@@ -2360,7 +2360,8 @@
; table_trie_step_poly
; table_trie_step_poly_fast_loose
; table_trie_step_typeinfo
- ; table_trie_step_typeclassinfo.
+ ; table_trie_step_typeclassinfo
+ ; table_trie_step_promise_implied.
:- type table_arg_infos
---> table_arg_infos(
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.172
diff -u -b -r1.172 intermod.m
--- compiler/intermod.m 12 Aug 2005 05:14:12 -0000 1.172
+++ compiler/intermod.m 13 Aug 2005 07:21:35 -0000
@@ -1804,12 +1804,13 @@
intermod__write_pragmas(_, _, [], _, !IO).
intermod__write_pragmas(SymName, Arity, [Marker | Markers], PredOrFunc, !IO) :-
intermod__should_output_marker(Marker, ShouldOutput),
- ( ShouldOutput = yes ->
+ (
+ ShouldOutput = yes,
hlds_out__marker_name(Marker, Name),
mercury_output_pragma_decl(SymName, Arity, PredOrFunc, Name,
- !IO)
+ no, !IO)
;
- true
+ ShouldOutput = no
),
intermod__write_pragmas(SymName, Arity, Markers, PredOrFunc, !IO).
Index: compiler/layout_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/layout_out.m,v
retrieving revision 1.49
diff -u -b -r1.49 layout_out.m
--- compiler/layout_out.m 7 Jun 2005 02:59:55 -0000 1.49
+++ compiler/layout_out.m 6 Aug 2005 06:08:43 -0000
@@ -990,11 +990,14 @@
eval_method_to_c_string(eval_loop_check) = "MR_EVAL_METHOD_LOOP_CHECK".
eval_method_to_c_string(eval_memo(CallStrictness)) = Str :-
(
- CallStrictness = strict,
+ CallStrictness = all_strict,
Str = "MR_EVAL_METHOD_MEMO_STRICT"
;
- CallStrictness = fast_loose,
+ CallStrictness = all_fast_loose,
Str = "MR_EVAL_METHOD_MEMO_FAST_LOOSE"
+ ;
+ CallStrictness = specified(_),
+ Str = "MR_EVAL_METHOD_MEMO_SPECIFIED"
).
eval_method_to_c_string(eval_minimal(MinimalMethod)) = Str :-
(
@@ -1842,6 +1845,10 @@
;
Step = table_trie_step_typeclassinfo,
StepType = "MR_TABLE_STEP_TYPECLASSINFO",
+ MaybeEnumParam = no
+ ;
+ Step = table_trie_step_promise_implied,
+ StepType = "MR_TABLE_STEP_PROMISE_IMPLIED",
MaybeEnumParam = no
),
io__write_string(StepType, !IO),
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.2
diff -u -b -r1.2 make_hlds_passes.m
--- compiler/make_hlds_passes.m 8 Aug 2005 02:33:10 -0000 1.2
+++ compiler/make_hlds_passes.m 13 Aug 2005 04:31:26 -0000
@@ -591,7 +591,7 @@
module_info_incr_errors(!ModuleInfo),
prog_out__write_context(Context, !IO),
io__write_string("Error: `:- pragma ", !IO),
- EvalMethodS = eval_method_to_string(Type),
+ EvalMethodS = eval_method_to_one_string(Type),
io__write_string(EvalMethodS, !IO),
io__write_string("' declaration requires the type_ctor_layout\n",
!IO),
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.260
diff -u -b -r1.260 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 13 Jul 2005 11:41:44 -0000 1.260
+++ compiler/mercury_to_mercury.m 13 Aug 2005 07:21:45 -0000
@@ -71,6 +71,7 @@
list(item_and_context)::in, io::di, io::uo) is det.
% Output the specified item, followed by ".\n".
+ %
:- pred mercury_output_item(item::in, prog_context::in, io::di, io::uo) is det.
% Output a `:- pred' declaration, making sure that the variable
@@ -125,9 +126,9 @@
mode, maybe(determinism), prog_context) = string.
:- pred mercury_output_pragma_decl(sym_name::in, int::in, pred_or_func::in,
- string::in, io::di, io::uo) is det.
-:- func mercury_pragma_decl_to_string(sym_name, int, pred_or_func, string)
- = string.
+ string::in, maybe(string)::in, io::di, io::uo) is det.
+:- func mercury_pragma_decl_to_string(sym_name, int, pred_or_func, string,
+ maybe(string)) = string.
:- pred mercury_output_foreign_language_string(foreign_language::in,
io::di, io::uo) is det.
@@ -155,9 +156,11 @@
int::in, mode_num::in, exception_status::in, io::di, io::uo) is det.
% Write an Aditi index specifier.
+ %
:- pred mercury_output_index_spec(index_spec::in, io::di, io::uo) is det.
- % Output the given foreign_decl declaration
+ % Output the given foreign_decl declaration.
+ %
:- pred mercury_output_pragma_foreign_decl(foreign_language::in,
foreign_decl_is_local::in, string::in, io::di, io::uo) is det.
:- func mercury_pragma_foreign_decl_to_string(foreign_language,
@@ -564,21 +567,23 @@
!IO)
;
Pragma = obsolete(Pred, Arity),
- mercury_output_pragma_decl(Pred, Arity, predicate, "obsolete", !IO)
+ mercury_output_pragma_decl(Pred, Arity, predicate, "obsolete", no, !IO)
;
Pragma = tabled(Type, Pred, Arity, _PredOrFunc, _Mode),
- TypeS = eval_method_to_string(Type),
- mercury_output_pragma_decl(Pred, Arity, predicate, TypeS, !IO)
+ TypeS - MaybeAfter = eval_method_to_string(Type),
+ mercury_output_pragma_decl(Pred, Arity, predicate, TypeS, MaybeAfter,
+ !IO)
;
Pragma = type_spec(_, _, _, _, _, _, _, _),
AppendVarnums = no,
mercury_output_pragma_type_spec(Pragma, AppendVarnums, !IO)
;
Pragma = inline(Pred, Arity),
- mercury_output_pragma_decl(Pred, Arity, predicate, "inline", !IO)
+ mercury_output_pragma_decl(Pred, Arity, predicate, "inline", no, !IO)
;
Pragma = no_inline(Pred, Arity),
- mercury_output_pragma_decl(Pred, Arity, predicate, "no_inline", !IO)
+ mercury_output_pragma_decl(Pred, Arity, predicate, "no_inline", no,
+ !IO)
;
Pragma = unused_args(PredOrFunc, PredName, Arity, ModeNum, UnusedArgs),
mercury_output_pragma_unused_args(PredOrFunc,
@@ -600,43 +605,46 @@
add_string(").\n", !IO)
;
Pragma = aditi(Pred, Arity),
- mercury_output_pragma_decl(Pred, Arity, predicate, "aditi", !IO)
+ mercury_output_pragma_decl(Pred, Arity, predicate, "aditi", no, !IO)
;
Pragma = base_relation(Pred, Arity),
mercury_output_pragma_decl(Pred, Arity, predicate, "base_relation",
- !IO)
+ no, !IO)
;
Pragma = aditi_index(Pred, Arity, Index),
mercury_format_pragma_index(Pred, Arity, Index, !IO)
;
Pragma = aditi_memo(Pred, Arity),
- mercury_output_pragma_decl(Pred, Arity, predicate, "aditi_memo", !IO)
+ mercury_output_pragma_decl(Pred, Arity, predicate, "aditi_memo",
+ no, !IO)
;
Pragma = aditi_no_memo(Pred, Arity),
mercury_output_pragma_decl(Pred, Arity, predicate, "aditi_no_memo",
- !IO)
+ no, !IO)
;
Pragma = supp_magic(Pred, Arity),
- mercury_output_pragma_decl(Pred, Arity, predicate, "supp_magic", !IO)
+ mercury_output_pragma_decl(Pred, Arity, predicate, "supp_magic",
+ no, !IO)
;
Pragma = context(Pred, Arity),
- mercury_output_pragma_decl(Pred, Arity, predicate, "context", !IO)
+ mercury_output_pragma_decl(Pred, Arity, predicate, "context", no, !IO)
;
Pragma = owner(Pred, Arity, Owner),
mercury_format_pragma_owner(Pred, Arity, Owner, !IO)
;
Pragma = naive(Pred, Arity),
- mercury_output_pragma_decl(Pred, Arity, predicate, "naive", !IO)
+ mercury_output_pragma_decl(Pred, Arity, predicate, "naive", no, !IO)
;
Pragma = psn(Pred, Arity),
- mercury_output_pragma_decl(Pred, Arity, predicate, "psn", !IO)
+ mercury_output_pragma_decl(Pred, Arity, predicate, "psn", no, !IO)
;
Pragma = promise_pure(Pred, Arity),
- mercury_output_pragma_decl(Pred, Arity, predicate, "promise_pure", !IO)
+ mercury_output_pragma_decl(Pred, Arity, predicate, "promise_pure", no,
+ !IO)
;
Pragma = promise_semipure(Pred, Arity),
mercury_output_pragma_decl(Pred, Arity, predicate, "promise_semipure",
- !IO)
+ no, !IO)
;
Pragma = termination_info(PredOrFunc, PredName, ModeList,
MaybePragmaArgSizeInfo, MaybePragmaTerminationInfo),
@@ -650,19 +658,20 @@
MaybeTermination, Context, !IO)
;
Pragma = terminates(Pred, Arity),
- mercury_output_pragma_decl(Pred, Arity, predicate, "terminates", !IO)
+ mercury_output_pragma_decl(Pred, Arity, predicate, "terminates", no,
+ !IO)
;
Pragma = does_not_terminate(Pred, Arity),
mercury_output_pragma_decl(Pred, Arity, predicate,
- "does_not_terminate", !IO)
+ "does_not_terminate", no, !IO)
;
Pragma = check_termination(Pred, Arity),
mercury_output_pragma_decl(Pred, Arity, predicate,
- "check_termination", !IO)
+ "check_termination", no, !IO)
;
Pragma = mode_check_clauses(Pred, Arity),
mercury_output_pragma_decl(Pred, Arity, predicate,
- "mode_check_clauses", !IO)
+ "mode_check_clauses", no, !IO)
).
mercury_output_item(_, promise(PromiseType, Goal0, VarSet, UnivVars), _,
@@ -3257,18 +3266,21 @@
%-----------------------------------------------------------------------------%
-mercury_output_pragma_decl(PredName, Arity, PredOrFunc, PragmaName, !IO) :-
- mercury_format_pragma_decl(PredName, Arity, PredOrFunc, PragmaName, !IO).
+mercury_output_pragma_decl(PredName, Arity, PredOrFunc, PragmaName, MaybeAfter,
+ !IO) :-
+ mercury_format_pragma_decl(PredName, Arity, PredOrFunc, PragmaName,
+ MaybeAfter, !IO).
-mercury_pragma_decl_to_string(PredName, Arity, PredOrFunc, PragmaName)
- = String :-
+mercury_pragma_decl_to_string(PredName, Arity, PredOrFunc, PragmaName,
+ MaybeAfter) = String :-
mercury_format_pragma_decl(PredName, Arity, PredOrFunc, PragmaName,
- "", String).
+ MaybeAfter, "", String).
:- pred mercury_format_pragma_decl(sym_name::in, int::in, pred_or_func::in,
- string::in, U::di, U::uo) is det <= output(U).
+ string::in, maybe(string)::in, U::di, U::uo) is det <= output(U).
-mercury_format_pragma_decl(PredName, Arity, PredOrFunc, PragmaName, !U) :-
+mercury_format_pragma_decl(PredName, Arity, PredOrFunc, PragmaName, MaybeAfter,
+ !U) :-
(
PredOrFunc = predicate,
DeclaredArity = Arity
@@ -3282,6 +3294,13 @@
mercury_format_bracketed_sym_name(PredName, next_to_graphic_token, !U),
add_string("/", !U),
add_int(DeclaredArity, !U),
+ (
+ MaybeAfter = yes(After),
+ add_string(", ", !U),
+ add_string(After, !U)
+ ;
+ MaybeAfter = no
+ ),
add_string(").\n", !U).
%-----------------------------------------------------------------------------%
@@ -4019,7 +4038,7 @@
output_eval_method(EvalMethod, !Str) :-
output_string("eval_", !Str),
- output_string(eval_method_to_string(EvalMethod), !Str).
+ output_string(eval_method_to_one_string(EvalMethod), !Str).
:- pred output_lambda_eval_method(lambda_eval_method::in,
string::di, string::uo) is det.
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.304
diff -u -b -r1.304 modes.m
--- compiler/modes.m 12 Aug 2005 05:14:13 -0000 1.304
+++ compiler/modes.m 13 Aug 2005 04:30:40 -0000
@@ -3319,7 +3319,7 @@
report_eval_method_requires_ground_args(ProcInfo, !ModuleInfo, !IO) :-
proc_info_eval_method(ProcInfo, EvalMethod),
proc_info_context(ProcInfo, Context),
- EvalMethodS = eval_method_to_string(EvalMethod),
+ EvalMethodS = eval_method_to_one_string(EvalMethod),
globals__io_lookup_bool_option(verbose_errors, VerboseErrors, !IO),
Pieces1 = [words("Sorry, not implemented:"),
fixed("`pragma " ++ EvalMethodS ++ "'"),
@@ -3343,7 +3343,7 @@
report_eval_method_destroys_uniqueness(ProcInfo, !ModuleInfo, !IO) :-
proc_info_eval_method(ProcInfo, EvalMethod),
proc_info_context(ProcInfo, Context),
- EvalMethodS = eval_method_to_string(EvalMethod),
+ EvalMethodS = eval_method_to_one_string(EvalMethod),
globals__io_lookup_bool_option(verbose_errors, VerboseErrors, !IO),
Pieces1 = [words("Error:"),
fixed("`pragma " ++ EvalMethodS ++ "'"),
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.131
diff -u -b -r1.131 prog_data.m
--- compiler/prog_data.m 8 Aug 2005 02:33:11 -0000 1.131
+++ compiler/prog_data.m 8 Aug 2005 02:43:23 -0000
@@ -169,8 +169,8 @@
% used for items that should be ignored (for the
% purposes of backwards compatibility etc)
- % indicates the type of information the compiler should get from the
- % declaration's clause
+ % Indicates the type of information the compiler should get from the
+ % declaration's clause.
:- type promise_type
% promise ex declarations
---> exclusive % each disjunct is mutually exclusive
@@ -600,8 +600,22 @@
% minimal model evaluation
:- type call_table_strictness
- ---> strict
- ; fast_loose.
+ ---> all_strict
+ ; all_fast_loose
+ ; specified(
+ list(maybe(arg_tabling_method))
+ % This list contains one element for each user-visible
+ % argument of the predicate. Elements that correspond
+ % to output arguments should be "no". Elements that
+ % correspond to input arguments should be "yes",
+ % specifying how to look up that argument in the call
+ % table.
+ ).
+
+:- type arg_tabling_method
+ ---> arg_value
+ ; arg_addr
+ ; arg_promise_implied.
:- type table_io_is_decl
---> table_io_decl % The procedure is tabled for
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.84
diff -u -b -r1.84 prog_io_pragma.m
--- compiler/prog_io_pragma.m 13 Jul 2005 11:41:45 -0000 1.84
+++ compiler/prog_io_pragma.m 13 Aug 2005 07:38:25 -0000
@@ -153,12 +153,8 @@
parse_maybe_foreign_type_assertions(MaybeAssertionTerm,
Assertions)
->
- % rafe: XXX I'm not
- % sure that
- % `no'
- % here is right - we
- % might need some more
- % parsing...
+ % rafe: XXX I'm not sure that `no' here is right
+ % - we might need some more parsing...
Result = ok(type_defn(TVarSet, MercuryTypeSymName,
MercuryArgs,
foreign_type( ForeignType, no, Assertions),
@@ -269,13 +265,11 @@
foreign_import_module(Language, Import)))
;
Result = error("invalid foreign language in " ++
- "`:- pragma foreign_import_module' " ++
- "declaration", LangTerm)
+ "`:- pragma foreign_import_module' declaration", LangTerm)
)
;
- Result = error("wrong number of arguments or invalid " ++
- "module name in `:- pragma foreign_import_module' " ++
- "declaration", ErrorTerm)
+ Result = error("wrong number of arguments or invalid module name " ++
+ "in `:- pragma foreign_import_module' declaration", ErrorTerm)
).
:- pred parse_foreign_decl_is_local(term::in, foreign_decl_is_local::out)
@@ -325,7 +319,6 @@
Result = error("invalid backend specification term", InputTerm)
)
;
-
Result = error("unsupported language specified, " ++
"unable to parse backend type", InputTerm)
).
@@ -360,8 +353,9 @@
).
% Parse all the special assembler names for all the builtin types.
- % See Parition I 'Built-In Types' (Section 8.2.2) for the list
+ % See Partition I 'Built-In Types' (Section 8.2.2) for the list
% of all builtin types.
+ %
:- pred parse_special_il_type_name(string::in, il_foreign_type::out) is semidet.
parse_special_il_type_name("bool", il(value, "mscorlib",
@@ -438,6 +432,7 @@
Assertion = stable.
% This predicate parses both c_header_code and foreign_decl pragmas.
+ %
:- pred parse_pragma_foreign_decl_pragma(module_name::in, string::in,
list(term)::in, term::in, varset::in, maybe1(item)::out) is det.
@@ -484,7 +479,6 @@
ErrorTerm, _VarSet, Result) :-
string__format("invalid `:- pragma %s' declaration ", [s(Pragma)],
InvalidDeclStr),
-
Check1 = (func(PTerms1, ForeignLanguage) = Res is semidet :-
PTerms1 = [Just_Code_Term],
( Just_Code_Term = term__functor(term__string(Just_Code), [], _) ->
@@ -494,7 +488,6 @@
Res = error(string__append(InvalidDeclStr, ErrMsg), ErrorTerm)
)
),
-
CheckLength = (func(PTermsLen, ForeignLanguage) = Res :-
( Res0 = Check1(PTermsLen, ForeignLanguage) ->
Res = Res0
@@ -503,7 +496,6 @@
Res = error(string__append(InvalidDeclStr, ErrMsg), ErrorTerm)
)
),
-
CheckLanguage = (func(PTermsLang) = Res is semidet :-
PTermsLang = [Lang | Rest],
( parse_foreign_language(Lang, ForeignLanguage) ->
@@ -513,7 +505,6 @@
Res = error(string__append(InvalidDeclStr, ErrMsg), Lang)
)
),
-
( Result0 = CheckLanguage(PragmaTerms) ->
Result = Result0
;
@@ -530,7 +521,6 @@
ErrorTerm, VarSet, Result) :-
string__format("invalid `:- pragma %s' declaration ", [s(Pragma)],
InvalidDeclStr),
-
Check6 = (func(PTerms6, ForeignLanguage) = Res is semidet :-
PTerms6 = [PredAndVarsTerm, FlagsTerm, FieldsTerm,
FirstTerm, LaterTerm, SharedTerm],
@@ -612,7 +602,6 @@
Res = error(string__append(InvalidDeclStr, ErrMsg), ErrorTerm)
)
),
-
Check5 = (func(PTerms5, ForeignLanguage) = Res is semidet :-
PTerms5 = [PredAndVarsTerm, FlagsTerm, FieldsTerm,
FirstTerm, LaterTerm],
@@ -623,7 +612,6 @@
Res = Check6([PredAndVarsTerm, FlagsTerm, FieldsTerm, FirstTerm,
LaterTerm, SharedTerm], ForeignLanguage)
),
-
Check3 = (func(PTerms3, ForeignLanguage) = Res is semidet :-
PTerms3 = [PredAndVarsTerm, FlagsTerm, CodeTerm],
( CodeTerm = term__functor(term__string(Code), [], Context) ->
@@ -668,7 +656,6 @@
Res = error(string__append(InvalidDeclStr, ErrMsg), CodeTerm)
)
),
-
Check2 = (func(PTerms2, ForeignLanguage) = Res is semidet :-
PTerms2 = [PredAndVarsTerm, CodeTerm],
% XXX we should issue a warning; this syntax is deprecated.
@@ -693,7 +680,6 @@
Res = error(string__append(InvalidDeclStr, ErrMsg), ErrorTerm)
)
),
-
CheckLength = (func(PTermsLen, ForeignLanguage) = Res :-
( Res0 = Check2(PTermsLen, ForeignLanguage) ->
Res = Res0
@@ -708,7 +694,6 @@
Res = error(string__append(InvalidDeclStr, ErrMsg), ErrorTerm)
)
),
-
CheckLanguage = (func(PTermsLang) = Res is semidet :-
PTermsLang = [Lang | Rest],
( parse_foreign_language(Lang, ForeignLanguage) ->
@@ -718,7 +703,6 @@
Res = error(string__append(InvalidDeclStr, ErrMsg), Lang)
)
),
-
( Result0 = CheckLanguage(PragmaTerms) ->
Result = Result0
;
@@ -757,8 +741,7 @@
PredAndModesTerm, ErrorTerm, "`:- pragma import' declaration",
PredAndArgModesResult),
(
- PredAndArgModesResult = ok(PredName - PredOrFunc,
- ArgModes),
+ PredAndArgModesResult = ok(PredName - PredOrFunc, ArgModes),
(
FlagsResult = ok(Attributes),
Result = ok(pragma(import(PredName, PredOrFunc,
@@ -822,12 +805,14 @@
parse_pragma_type(ModuleName, "memo", PragmaTerms, ErrorTerm, _VarSet,
Result) :-
- parse_tabling_pragma(ModuleName, "memo", eval_memo(strict),
- PragmaTerms, ErrorTerm, Result).
+ % The eval_memo(all_strict) could be converted to eval_memo(specified(_))
+ % if the pragma specifies the ways to table the arguments.
+ parse_tabling_pragma(ModuleName, "memo",
+ eval_memo(all_strict), PragmaTerms, ErrorTerm, Result).
parse_pragma_type(ModuleName, "fast_loose_memo", PragmaTerms, ErrorTerm,
_VarSet, Result) :-
- parse_tabling_pragma(ModuleName, "fast_loose_memo", eval_memo(fast_loose),
- PragmaTerms, ErrorTerm, Result).
+ parse_tabling_pragma(ModuleName, "fast_loose_memo",
+ eval_memo(all_fast_loose), PragmaTerms, ErrorTerm, Result).
parse_pragma_type(ModuleName, "loop_check", PragmaTerms, ErrorTerm, _VarSet,
Result) :-
parse_tabling_pragma(ModuleName, "loop_check", eval_loop_check,
@@ -910,9 +895,11 @@
% The varset is actually a tvarset.
varset__coerce(VarSet0, TVarSet),
( list__map(convert_type_spec_pair, TypeSubnList, TypeSubn) ->
- ( MaybeName = yes(SpecializedName0) ->
+ (
+ MaybeName = yes(SpecializedName0),
SpecializedName = SpecializedName0
;
+ MaybeName = no,
unqualify_name(PredName, UnqualName),
make_pred_name(ModuleName, "TypeSpecOf", MaybePredOrFunc,
UnqualName, type_subst(TVarSet, TypeSubn),
@@ -1154,8 +1141,7 @@
TerminationTerm = term__functor(term__atom("can_loop"), [], _),
MaybeTerminationInfo = yes(can_loop(unit))
;
- TerminationTerm = term__functor(term__atom("cannot_loop"),
- [], _),
+ TerminationTerm = term__functor(term__atom("cannot_loop"), [], _),
MaybeTerminationInfo = yes(cannot_loop(unit))
),
Result0 = ok(pragma(termination2_info(PredOrFunc, PredName,
@@ -1228,8 +1214,7 @@
),
ThrowStatus = may_throw(ExceptionType)
;
- ThrowStatusTerm = term.functor(
- term.atom("conditional"), [], _),
+ ThrowStatusTerm = term.functor( term.atom("conditional"), [], _),
ThrowStatus = conditional
)
->
@@ -1255,8 +1240,7 @@
parse_simple_pragma(ModuleName, PragmaType, MakePragma, PragmaTerms, ErrorTerm,
Result) :-
parse_simple_pragma_base(ModuleName, PragmaType,
- "predicate or function", MakePragma, PragmaTerms, ErrorTerm,
- Result).
+ "predicate or function", MakePragma, PragmaTerms, ErrorTerm, Result).
% This parses a pragma that refers to type.
%
@@ -1354,8 +1338,7 @@
ConflictingAttributes = [
may_call_mercury(will_not_call_mercury) -
may_call_mercury(may_call_mercury),
- thread_safe(thread_safe) -
- thread_safe(not_thread_safe),
+ thread_safe(thread_safe) - thread_safe(not_thread_safe),
tabled_for_io(tabled_for_io) -
tabled_for_io(tabled_for_io_unitize),
tabled_for_io(tabled_for_io) -
@@ -1372,10 +1355,8 @@
purity(pure) - purity(semipure),
purity(semipure) - purity(impure),
terminates(terminates) - terminates(does_not_terminate),
- terminates(depends_on_mercury_calls) -
- terminates(terminates),
- terminates(depends_on_mercury_calls) -
- terminates(does_not_terminate)
+ terminates(depends_on_mercury_calls) - terminates(terminates),
+ terminates(depends_on_mercury_calls) - terminates(does_not_terminate)
],
(
parse_pragma_foreign_proc_attributes_term0(Term, AttrList)
@@ -1399,6 +1380,7 @@
% Update the pragma_foreign_proc_attributes according to the given
% collected_pragma_foreign_proc_attribute.
+ %
:- pred process_attribute(collected_pragma_foreign_proc_attribute::in,
pragma_foreign_proc_attributes::in,
pragma_foreign_proc_attributes::out) is det.
@@ -1423,10 +1405,12 @@
set_ordinary_despite_detism(yes, !Attrs).
% Aliasing is currently ignored in the main branch compiler.
+ %
process_attribute(aliasing, Attrs, Attrs).
% Check whether all the required attributes have been set for
% a particular language
+ %
:- func check_required_attributes(foreign_language,
pragma_foreign_proc_attributes, term)
= maybe1(pragma_foreign_proc_attributes).
@@ -1435,12 +1419,14 @@
check_required_attributes(managed_cplusplus, Attrs, _Term) = ok(Attrs).
check_required_attributes(csharp, Attrs, _Term) = ok(Attrs).
check_required_attributes(il, Attrs, Term) = Res :-
- ( [] = list__filter_map(
+ MaxStackAttrs = list__filter_map(
(func(X) = X is semidet :- X = max_stack_size(_)),
- Attrs ^ extra_attributes)
- ->
+ Attrs ^ extra_attributes),
+ (
+ MaxStackAttrs = [],
Res = error("expecting max_stack_size attribute for IL code", Term)
;
+ MaxStackAttrs = [_ | _],
Res = ok(Attrs)
).
check_required_attributes(java, Attrs, _Term) = ok(Attrs).
@@ -1532,6 +1518,7 @@
% These attributes are used for aliasing on the reuse branch,
% and ignoring them allows the main branch compiler to compile
% the reuse branch.
+ %
:- pred parse_aliasing(term::in) is semidet.
parse_aliasing(term__functor(term__atom("no_aliasing"), [], _)).
@@ -1579,8 +1566,8 @@
parse_ordinary_despite_detism(
term__functor(term__atom("ordinary_despite_detism"), [], _)).
-% parse a pragma foreign_code declaration
-
+ % Parse a pragma foreign_code declaration.
+ %
:- pred parse_pragma_foreign_code(module_name::in,
pragma_foreign_proc_attributes::in, term::in,
pragma_foreign_code_impl::in, varset::in, maybe1(item)::out) is det.
@@ -1592,14 +1579,12 @@
(
PredAndArgsResult = ok(PredName, VarList0 - MaybeRetTerm),
(
- % is this a function or a predicate?
+ % Is this a function or a predicate?
MaybeRetTerm = yes(FuncResultTerm0)
->
- % function
PredOrFunc = function,
list__append(VarList0, [FuncResultTerm0], VarList)
;
- % predicate
PredOrFunc = predicate,
VarList = VarList0
),
@@ -1618,8 +1603,9 @@
Result = error(Msg, Term)
).
- % parse the variable list in the pragma c code declaration.
+ % Parse the variable list in the pragma c code declaration.
% The final argument is 'no' for no error, or 'yes(ErrorMessage)'.
+ %
:- pred parse_pragma_c_code_varlist(varset::in, list(term)::in,
list(pragma_var)::out, maybe(string)::out) is det.
@@ -1641,14 +1627,14 @@
Error = yes("unknown mode in pragma c_code")
)
;
- % if the variable wasn't in the varset it must be an
+ % If the variable wasn't in the varset it must be an
% underscore variable.
PragmaVars = [], % return any old junk for that.
Error = yes("sorry, not implemented: anonymous " ++
"`_' variable in pragma c_code")
)
;
- PragmaVars = [], % return any old junk in PragmaVars
+ PragmaVars = [], % Return any old junk in PragmaVars.
Error = yes("arguments not in form 'Var :: mode'")
).
@@ -1657,7 +1643,16 @@
parse_tabling_pragma(ModuleName, PragmaName, TablingType, PragmaTerms,
ErrorTerm, Result) :-
- ( PragmaTerms = [PredAndModesTerm0] ->
+ (
+ (
+ PragmaTerms = [PredAndModesTerm0],
+ MaybeSpec = no
+ ;
+ PragmaTerms = [PredAndModesTerm0, SpecListTerm0],
+ TablingType = eval_memo(all_strict),
+ MaybeSpec = yes(SpecListTerm0)
+ )
+ ->
string__append_list(["`:- pragma ", PragmaName, "' declaration"],
ParseMsg),
parse_arity_or_modes(ModuleName, PredAndModesTerm0, ErrorTerm,
@@ -1665,8 +1660,23 @@
(
ArityModesResult = ok(arity_or_modes(PredName, Arity,
MaybePredOrFunc, MaybeModes)),
+ (
+ MaybeSpec = yes(SpecListTerm),
+ convert_list(SpecListTerm, parse_arg_tabling_method,
+ "expected argument tabling method", MaybeArgMethods),
+ (
+ MaybeArgMethods = ok(ArgMethods),
+ Result = ok(pragma(tabled(eval_memo(specified(ArgMethods)),
+ PredName, Arity, MaybePredOrFunc, MaybeModes)))
+ ;
+ MaybeArgMethods = error(Msg, Term),
+ Result = error(Msg, Term)
+ )
+ ;
+ MaybeSpec = no,
Result = ok(pragma(tabled(TablingType, PredName, Arity,
MaybePredOrFunc, MaybeModes)))
+ )
;
ArityModesResult = error(Msg, Term),
Result = error(Msg, Term)
@@ -1677,6 +1687,17 @@
Result = error(ErrorMessage, ErrorTerm)
).
+:- pred parse_arg_tabling_method(term::in, maybe(arg_tabling_method)::out)
+ is semidet.
+
+parse_arg_tabling_method(term__functor(term__atom("value"), [], _),
+ yes(arg_value)).
+parse_arg_tabling_method(term__functor(term__atom("addr"), [], _),
+ yes(arg_addr)).
+parse_arg_tabling_method(term__functor(term__atom("promise_implied"), [], _),
+ yes(arg_promise_implied)).
+parse_arg_tabling_method(term__functor(term__atom("output"), [], _), no).
+
:- type arity_or_modes
---> arity_or_modes(
sym_name,
@@ -1691,7 +1712,7 @@
parse_arity_or_modes(ModuleName, PredAndModesTerm0,
ErrorTerm, ErrorMsg, Result) :-
(
- % Is this a simple pred/arity pragma
+ % Is this a simple pred/arity pragma.
PredAndModesTerm0 = term__functor(term__atom("/"),
[PredNameTerm, ArityTerm], _)
->
@@ -1769,28 +1790,29 @@
Result = error(ErrorMsg, Term)
).
+:- pred convert_bool(term::in, bool::out) is semidet.
-:- pred convert_bool_list(term::in, list(bool)::out) is semidet.
-
-convert_bool_list(ListTerm, Bools) :-
- convert_list(ListTerm,
- (pred(Term::in, Bool::out) is semidet :-
+convert_bool(Term, Bool) :-
Term = term__functor(term__atom(Name), [], _),
( Name = "yes", Bool = yes
; Name = "no", Bool = no
- )
- ),
- ok(Bools)).
+ ).
+
+:- pred convert_bool_list(term::in, list(bool)::out) is semidet.
+
+convert_bool_list(ListTerm, Bools) :-
+ convert_list(ListTerm, convert_bool, "expected boolean", ok(Bools)).
+
+:- pred convert_int(term::in, int::out) is semidet.
+
+convert_int(Term, Int) :-
+ Term = term__functor(term__integer(Int), [], _).
:- pred convert_int_list(term::in, maybe1(list(int))::out) is det.
convert_int_list(ListTerm, Result) :-
- convert_list(ListTerm,
- (pred(Term::in, Int::out) is semidet :-
- Term = term__functor(term__integer(Int), [], _)
- ), Result).
+ convert_list(ListTerm, convert_int, "expected integer", Result).
- %
% convert_list(T, P, M) will convert a term T into a list of
% type X where P is a predicate that converts each element of
% the list into the correct type. M will hold the list if the
@@ -1798,17 +1820,18 @@
% hold the error.
%
:- pred convert_list(term::in, pred(term, T)::(pred(in, out) is semidet),
- maybe1(list(T))::out) is det.
+ string::in, maybe1(list(T))::out) is det.
-convert_list(term__variable(V),_, error("variable in list",
- term__variable(V))).
-convert_list(term__functor(Functor, Args, Context), Pred, Result) :-
+convert_list(term__variable(V), _, UnrecognizedMsg,
+ error(UnrecognizedMsg, term__variable(V))).
+convert_list(term__functor(Functor, Args, Context), Pred, UnrecognizedMsg,
+ Result) :-
(
Functor = term__atom("[|]"),
- Args = [Term, RestTerm],
- call(Pred, Term, Element)
+ Args = [Term, RestTerm]
->
- convert_list(RestTerm, Pred, RestResult),
+ ( call(Pred, Term, Element) ->
+ convert_list(RestTerm, Pred, UnrecognizedMsg, RestResult),
(
RestResult = ok(List0),
Result = ok([Element | List0])
@@ -1817,6 +1840,9 @@
Result = RestResult
)
;
+ Result = error(UnrecognizedMsg, Term)
+ )
+ ;
Functor = term__atom("[]"),
Args = []
->
@@ -1850,7 +1876,7 @@
ArgSizeTerm = term__functor(term__atom("constraints"),
[Constraints0], _),
convert_list(Constraints0, parse_arg_size_constraint,
- ConstraintsResult),
+ "expected constraint", ConstraintsResult),
ConstraintsResult = ok(Constraints),
Result = ok(yes(Constraints))
).
@@ -1859,17 +1885,17 @@
parse_arg_size_constraint(Term, Constr) :-
(
- Term = term__functor(term__atom("le"),
- [Terms, ConstantTerm], _),
- convert_list(Terms, parse_lp_term, TermsResult),
+ Term = term__functor(term__atom("le"), [Terms, ConstantTerm], _),
+ convert_list(Terms, parse_lp_term, "expected linear term",
+ TermsResult),
TermsResult = ok(LPTerms),
parse_rational(ConstantTerm, Constant),
Constr = le(LPTerms, Constant)
;
- Term = term__functor(term__atom("eq"),
- [Terms, ConstantTerm], _),
- convert_list(Terms, parse_lp_term, TermsResult),
+ Term = term__functor(term__atom("eq"), [Terms, ConstantTerm], _),
+ convert_list(Terms, parse_lp_term, "expected linear term",
+ TermsResult),
TermsResult = ok(LPTerms),
parse_rational(ConstantTerm, Constant),
Constr = eq(LPTerms, Constant)
Index: compiler/prog_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_out.m,v
retrieving revision 1.60
diff -u -b -r1.60 prog_out.m
--- compiler/prog_out.m 8 Aug 2005 02:33:11 -0000 1.60
+++ compiler/prog_out.m 13 Aug 2005 04:09:58 -0000
@@ -27,6 +27,7 @@
:- import_module bool.
:- import_module io.
:- import_module list.
+:- import_module std_util.
:- pred maybe_report_stats(bool::in, io::di, io::uo) is det.
:- pred maybe_write_string(bool::in, string::in, io::di, io::uo) is det.
@@ -139,9 +140,20 @@
:- pred write_purity_prefix(purity::in, io::di, io::uo) is det.
:- func purity_prefix_to_string(purity) = string.
- % Convert an evaluation method to a string.
+ % Convert an eval_method to a string giving the name of the pragma,
+ % and if the eval_method specifies tabling methods for individual
+ % arguments, a description of those argument tabling methods.
+ %
+:- func eval_method_to_string(eval_method) = pair(string, maybe(string)).
+
+ % Convert an eval_method to a single string. This is suitable for use
+ % in error messages, but not for generating valid Mercury code.
%
-:- func eval_method_to_string(eval_method) = string.
+:- func eval_method_to_one_string(eval_method) = string.
+
+:- func maybe_arg_tabling_method_to_string(maybe(arg_tabling_method)) = string.
+
+:- func arg_tabling_method_to_string(arg_tabling_method) = string.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -153,7 +165,6 @@
:- import_module int.
:- import_module require.
-:- import_module std_util.
:- import_module string.
:- import_module term.
:- import_module term_io.
@@ -389,11 +400,24 @@
purity_name((semipure), "semipure").
purity_name((impure), "impure").
-eval_method_to_string(eval_normal) = "normal".
-eval_method_to_string(eval_loop_check) = "loop_check".
-eval_method_to_string(eval_memo(strict)) = "memo".
-eval_method_to_string(eval_memo(fast_loose)) = "fast_loose_memo".
-eval_method_to_string(eval_minimal(MinimalMethod)) = Str :-
+eval_method_to_one_string(EvalMethod) = Str :-
+ BaseStr - MaybeArgsStr = eval_method_to_string(EvalMethod),
+ (
+ MaybeArgsStr = yes(ArgsStr),
+ Str = BaseStr ++ "(" ++ ArgsStr ++ ")"
+ ;
+ MaybeArgsStr = no,
+ Str = BaseStr
+ ).
+
+eval_method_to_string(eval_normal) = "normal" - no.
+eval_method_to_string(eval_loop_check) = "loop_check" - no.
+eval_method_to_string(eval_memo(all_strict)) = "memo" - no.
+eval_method_to_string(eval_memo(all_fast_loose)) = "fast_loose_memo" - no.
+eval_method_to_string(eval_memo(specified(Args))) = "memo" - yes(ArgsStr) :-
+ ArgStrs = list__map(maybe_arg_tabling_method_to_string, Args),
+ ArgsStr = "[" ++ string__join_list(", ", ArgStrs) ++ "]".
+eval_method_to_string(eval_minimal(MinimalMethod)) = Str - no :-
(
MinimalMethod = own_stacks,
Str = "minimal_model_own_stacks"
@@ -401,7 +425,7 @@
MinimalMethod = stack_copy,
Str = "minimal_model_stack_copy"
).
-eval_method_to_string(eval_table_io(IsDecl, IsUnitize)) = Str :-
+eval_method_to_string(eval_table_io(IsDecl, IsUnitize)) = Str - no :-
(
IsDecl = table_io_decl,
DeclStr = "decl, "
@@ -417,6 +441,14 @@
UnitizeStr = "alone"
),
Str = "table_io(" ++ DeclStr ++ UnitizeStr ++ ")".
+
+maybe_arg_tabling_method_to_string(yes(ArgTablingMethod)) =
+ arg_tabling_method_to_string(ArgTablingMethod).
+maybe_arg_tabling_method_to_string(no) = "output".
+
+arg_tabling_method_to_string(arg_value) = "value".
+arg_tabling_method_to_string(arg_addr) = "addr".
+arg_tabling_method_to_string(arg_promise_implied) = "promise_implied".
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.86
diff -u -b -r1.86 table_gen.m
--- compiler/table_gen.m 10 Jun 2005 07:12:46 -0000 1.86
+++ compiler/table_gen.m 13 Aug 2005 04:41:14 -0000
@@ -168,7 +168,7 @@
pred_id_to_int(PredId, PredIdInt),
Msg = string__format("I/O procedure pred id %d not model_det",
[i(PredIdInt)]),
- error(Msg)
+ unexpected(this_file, Msg)
),
globals__lookup_bool_option(Globals, trace_table_io_all, TransformAll),
globals__lookup_bool_option(Globals, trace_table_io_require, Require),
@@ -264,7 +264,7 @@
TabledForIoAttrs = [_, _ | _],
% Since table_gen is run before inlining, each procedure
% should contain at most one foreign_proc goal.
- error("should_io_procedure_be_transformed: " ++
+ unexpected(this_file, "should_io_procedure_be_transformed: " ++
"different tabled_for_io attributes in one procedure")
).
@@ -363,21 +363,20 @@
pred_info_context(!.PredInfo, Context),
ProcPieces = describe_one_proc_name(!.ModuleInfo,
should_module_qualify, proc(PredId, ProcId)),
- EvalMethodStr = eval_method_to_string(EvalMethod),
+ EvalMethodStr = eval_method_to_one_string(EvalMethod),
Msg = [words("Ignoring the pragma"), fixed(EvalMethodStr),
words("for")] ++ ProcPieces ++
[words("due to lack of support on this back end."), nl],
error_util__write_error_pieces(Context, 0, Msg, !IO),
%
- % XXX We set the evaluation method to eval_normal here
- % to prevent problems in the ml code generator if we are
- % compiling in a grade that does not support tabling.
- % (See ml_gen_maybe_add_table_var/6 in ml_code_gen.m for
- % further details.)
- %
- % We do this here rather than when processing the tabling
- % pragmas (in make_hlds.m) so that we can still generate
- % error message for misuses of the tabling pragmas.
+ % XXX We set the evaluation method to eval_normal here to prevent
+ % problems in the ml code generator if we are compiling in a grade
+ % that does not support tabling. (See ml_gen_maybe_add_table_var/6
+ % in ml_code_gen.m for further details.)
+ %
+ % We do this here rather than when processing the tabling pragmas
+ % (in add_pragma.m) so that we can still generate error message
+ % for misuses of the tabling pragmas.
%
proc_info_set_eval_method(eval_normal, !ProcInfo),
module_info_set_pred_proc_info(PredId, ProcId, !.PredInfo,
@@ -402,27 +401,43 @@
proc_info_goal(!.ProcInfo, OrigGoal),
proc_info_argmodes(!.ProcInfo, ArgModes),
- get_input_output_vars(HeadVars, ArgModes, !.ModuleInfo, BadVars,
- InputVarModes, OutputVarModes),
- % assoc_list__keys(InputVarModes, InputVars),
- % assoc_list__keys(OutputVarModes, OutputVars),
- allocate_slot_numbers(InputVarModes, 0, NumberedInputVars),
- allocate_slot_numbers(OutputVarModes, 0, NumberedOutputVars),
- (
- BadVars = []
- ;
- BadVars = [_ | _],
- report_bad_mode_for_tabling(!.ModuleInfo, !.PredInfo,
- PredId, ProcId, VarSet0, BadVars, !IO),
- % We continue the transformation as best we can,
- % but prevent the creation of an executable.
- module_info_incr_errors(!ModuleInfo)
+ (
+ EvalMethod = eval_normal,
+ % This should have been caught by our caller.
+ unexpected(this_file, "table_gen__transform_proc: eval_normal")
+ ;
+ EvalMethod = eval_table_io(_, _),
+ % Since we don't actually create a call table for I/O tabled
+ % procedures, the value of MaybeSpecMethod doesn't really matter.
+ MaybeSpecMethod = all_same(arg_value)
+ ;
+ EvalMethod = eval_loop_check,
+ MaybeSpecMethod = all_same(arg_value)
+ ;
+ EvalMethod = eval_memo(CallStrictness),
+ (
+ CallStrictness = all_strict,
+ MaybeSpecMethod = all_same(arg_value)
+ ;
+ CallStrictness = all_fast_loose,
+ MaybeSpecMethod = all_same(arg_addr)
+ ;
+ CallStrictness = specified(ArgMethods),
+ MaybeSpecMethod = specified(ArgMethods)
+ )
+ ;
+ EvalMethod = eval_minimal(_),
+ MaybeSpecMethod = all_same(arg_value)
),
+ get_input_output_vars(HeadVars, ArgModes, !.ModuleInfo, MaybeSpecMethod, _,
+ InputVarModeMethods, OutputVarModeMethods),
+ allocate_slot_numbers(InputVarModeMethods, 0, NumberedInputVars),
+ allocate_slot_numbers(OutputVarModeMethods, 0, NumberedOutputVars),
tabling_via_extra_args(!.ModuleInfo, TablingViaExtraArgs),
(
EvalMethod = eval_normal,
% This should have been caught by our caller.
- error("table_gen__transform_proc: eval_normal")
+ unexpected(this_file, "table_gen__transform_proc: eval_normal")
;
EvalMethod = eval_table_io(Decl, Unitize),
module_info_globals(!.ModuleInfo, Globals),
@@ -443,36 +458,36 @@
VarTypes0, VarTypes, VarSet0, VarSet,
TableInfo0, TableInfo, CallTableTip, Goal, Steps),
generate_gen_proc_table_info(TableInfo, Steps,
- InputVarModes, OutputVarModes, ProcTableInfo),
+ InputVarModeMethods, OutputVarModeMethods, ProcTableInfo),
MaybeCallTableTip = yes(CallTableTip),
MaybeProcTableInfo = yes(ProcTableInfo)
;
- EvalMethod = eval_memo(CallStrictness),
+ EvalMethod = eval_memo(_CallStrictness),
( CodeModel = model_non ->
- table_gen__create_new_memo_non_goal(CallStrictness, Detism,
+ table_gen__create_new_memo_non_goal(Detism,
OrigGoal, PredId, ProcId, HeadVars,
NumberedInputVars, NumberedOutputVars,
VarTypes0, VarTypes, VarSet0, VarSet, TableInfo0, TableInfo,
CallTableTip, Goal, Steps)
;
- table_gen__create_new_memo_goal(CallStrictness, Detism,
+ table_gen__create_new_memo_goal(Detism,
OrigGoal, PredId, ProcId, TablingViaExtraArgs,
HeadVars, NumberedInputVars, NumberedOutputVars,
VarTypes0, VarTypes, VarSet0, VarSet,
TableInfo0, TableInfo, CallTableTip, Goal, Steps)
),
generate_gen_proc_table_info(TableInfo, Steps,
- InputVarModes, OutputVarModes, ProcTableInfo),
+ InputVarModeMethods, OutputVarModeMethods, ProcTableInfo),
MaybeCallTableTip = yes(CallTableTip),
MaybeProcTableInfo = yes(ProcTableInfo)
;
EvalMethod = eval_minimal(MinimalMethod),
(
CodeModel = model_det,
- error("table_gen__transform_proc: minimal det")
+ unexpected(this_file, "table_gen__transform_proc: minimal det")
;
CodeModel = model_semi,
- error("table_gen__transform_proc: minimal semi")
+ unexpected(this_file, "table_gen__transform_proc: minimal semi")
;
CodeModel = model_non,
MinimalMethod = stack_copy,
@@ -493,7 +508,7 @@
MaybeCallTableTip = no
),
generate_gen_proc_table_info(TableInfo, Steps,
- InputVarModes, OutputVarModes, ProcTableInfo),
+ InputVarModeMethods, OutputVarModeMethods, ProcTableInfo),
MaybeProcTableInfo = yes(ProcTableInfo)
),
@@ -611,8 +626,8 @@
% ).
:- pred create_new_loop_goal(determinism::in, hlds_goal::in,
- pred_id::in, proc_id::in, bool::in,
- list(prog_var)::in, list(var_mode_pos)::in, list(var_mode_pos)::in,
+ pred_id::in, proc_id::in, bool::in, list(prog_var)::in,
+ list(var_mode_pos_method)::in, list(var_mode_pos_method)::in,
vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
table_info::in, table_info::out, prog_var::out, hlds_goal::out,
list(table_trie_step)::out) is det.
@@ -630,7 +645,7 @@
goal_info_get_context(OrigGoalInfo, Context),
ModuleInfo = !.TableInfo ^ table_module_info,
- generate_simple_call_table_lookup_goal(strict, loop_status_type,
+ generate_simple_call_table_lookup_goal(loop_status_type,
"table_loop_setup", NumberedInputVars, PredId, ProcId,
TablingViaExtraArgs, Context, !VarTypes, !VarSet, !TableInfo,
TableTipVar, StatusVar, LookUpGoal, Steps),
@@ -851,14 +866,14 @@
% If there are no output variables, then instead of creating an answer block
% and filling it in, we call table_memo_mark_as_succeeded.
-:- pred create_new_memo_goal(call_table_strictness::in, determinism::in,
- hlds_goal::in, pred_id::in, proc_id::in, bool::in,
- list(prog_var)::in, list(var_mode_pos)::in, list(var_mode_pos)::in,
+:- pred create_new_memo_goal(determinism::in, hlds_goal::in,
+ pred_id::in, proc_id::in, bool::in, list(prog_var)::in,
+ list(var_mode_pos_method)::in, list(var_mode_pos_method)::in,
vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
table_info::in, table_info::out, prog_var::out, hlds_goal::out,
list(table_trie_step)::out) is det.
-create_new_memo_goal(CallStrictness, Detism, OrigGoal, PredId, ProcId,
+create_new_memo_goal(Detism, OrigGoal, PredId, ProcId,
TablingViaExtraArgs, HeadVars, NumberedInputVars, NumberedOutputVars,
!VarTypes, !VarSet, !TableInfo, TableTipVar, Goal, Steps) :-
% Even if the original goal doesn't use all of the headvars,
@@ -882,10 +897,10 @@
SetupPred = "table_memo_semi_setup"
;
CodeModel = model_non,
- error("create_new_memo_goal: model_non")
+ unexpected(this_file, "create_new_memo_goal: model_non")
),
- generate_simple_call_table_lookup_goal(CallStrictness, StatusType,
- SetupPred, NumberedInputVars, PredId, ProcId, TablingViaExtraArgs,
+ generate_simple_call_table_lookup_goal(StatusType, SetupPred,
+ NumberedInputVars, PredId, ProcId, TablingViaExtraArgs,
Context, !VarTypes, !VarSet, !TableInfo, TableTipVar, StatusVar,
LookUpGoal, Steps),
@@ -962,7 +977,7 @@
]
;
CodeModel = model_non,
- error("create_new_memo_goal: model_non")
+ unexpected(this_file, "create_new_memo_goal: model_non")
),
SwitchExpr = switch(StatusVar, cannot_fail, SwitchArms),
@@ -976,14 +991,14 @@
Context, GoalInfo),
Goal = GoalExpr - GoalInfo.
-:- pred create_new_memo_non_goal(call_table_strictness::in, determinism::in,
- hlds_goal::in, pred_id::in, proc_id::in,
- list(prog_var)::in, list(var_mode_pos)::in, list(var_mode_pos)::in,
+:- pred create_new_memo_non_goal(determinism::in, hlds_goal::in,
+ pred_id::in, proc_id::in, list(prog_var)::in,
+ list(var_mode_pos_method)::in, list(var_mode_pos_method)::in,
vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
table_info::in, table_info::out, prog_var::out, hlds_goal::out,
list(table_trie_step)::out) is det.
-create_new_memo_non_goal(CallStrictness, Detism, OrigGoal, PredId, ProcId,
+create_new_memo_non_goal(Detism, OrigGoal, PredId, ProcId,
HeadVars, NumberedInputVars, NumberedOutputVars, !VarTypes, !VarSet,
!TableInfo, RecordVar, Goal, Steps) :-
% Even if the original goal doesn't use all of the headvars,
@@ -1003,11 +1018,11 @@
generate_error_goal(!.TableInfo, Context, need_minimal_model_msg,
!VarTypes, !VarSet, NeedMinModelGoal),
- generate_memo_non_call_table_lookup_goal(CallStrictness, NumberedInputVars,
+ generate_memo_non_call_table_lookup_goal(NumberedInputVars,
PredId, ProcId, Context, !VarTypes, !VarSet, !TableInfo,
RecordVar, StatusVar, LookUpGoal, Steps),
- generate_memo_non_save_goals(NumberedOutputVars, RecordVar, BlockSize,
- Context, !VarTypes, !VarSet, !TableInfo, SaveAnswerGoals),
+ generate_memo_non_save_goals(NumberedOutputVars, RecordVar,
+ BlockSize, Context, !VarTypes, !VarSet, !TableInfo, SaveAnswerGoals),
generate_memo_non_restore_goal(Detism, NumberedOutputVars,
OrigInstMapDelta, RecordVar, ModuleInfo, Context,
@@ -1154,7 +1169,7 @@
:- pred table_gen__create_new_io_goal(hlds_goal::in, table_io_is_decl::in,
table_io_is_unitize::in, bool::in, pred_id::in, proc_id::in, bool::in,
assoc_list(prog_var, mode)::in,
- list(var_mode_pos)::in, list(var_mode_pos)::in,
+ list(var_mode_pos_method)::in, list(var_mode_pos_method)::in,
vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
table_info::in, table_info::out,
hlds_goal::out, maybe(proc_table_info)::out) is det.
@@ -1208,8 +1223,9 @@
make_const_construction(TableIoDeclConsId, c_pointer_type,
yes("TableIoDeclPtr"), TableIoDeclGoal, TableIoDeclPtrVar,
!VarTypes, !VarSet),
- allocate_slot_numbers(SavedHeadVars, 1, NumberedSavedHeadVars),
- NumberedSaveVars = [var_mode_pos(TableIoDeclPtrVar, in_mode, 0)
+ allocate_plain_slot_numbers(SavedHeadVars, 1, NumberedSavedHeadVars),
+ NumberedSaveVars = [
+ var_mode_pos_method(TableIoDeclPtrVar, in_mode, 0, unit)
| NumberedSavedHeadVars],
UnnumberedSavedOutputVars = list__map(project_var, SavedOutputVars),
list__filter(var_belong_to_list(UnnumberedSavedOutputVars),
@@ -1225,8 +1241,9 @@
;
TableDecl = table_io_proc,
true_goal(TableIoDeclGoal),
- NumberedRestoreVars = SavedOutputVars,
- NumberedSaveVars = SavedOutputVars,
+ NumberedRestoreVars =
+ list__map(project_out_arg_method, SavedOutputVars),
+ NumberedSaveVars = list__map(project_out_arg_method, SavedOutputVars),
MaybeProcTableInfo = no
),
list__length(NumberedSaveVars, BlockSize),
@@ -1391,7 +1408,7 @@
:- pred table_gen__create_new_mm_goal(determinism::in,
hlds_goal::in, pred_id::in, proc_id::in, bool::in, list(prog_var)::in,
- list(var_mode_pos)::in, list(var_mode_pos)::in,
+ list(var_mode_pos_method)::in, list(var_mode_pos_method)::in,
vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
table_info::in, table_info::out, prog_var::out, hlds_goal::out,
list(table_trie_step)::out) is det.
@@ -1500,7 +1517,7 @@
:- pred table_gen__do_own_stack_transform(determinism::in, hlds_goal::in,
pred_id::in, proc_id::in, pred_info::in, proc_info::in, list(prog_var)::in,
- list(var_mode_pos)::in, list(var_mode_pos)::in,
+ list(var_mode_pos_method)::in, list(var_mode_pos_method)::in,
vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
table_info::in, table_info::out, generator_map::in, generator_map::out,
hlds_goal::out, list(table_trie_step)::out) is det.
@@ -1544,10 +1561,10 @@
make_const_construction(GeneratorPredVar, GeneratorConsId,
MakeGeneratorVarGoal),
- generate_call_table_lookup_goals(strict, NumberedInputVars, PredId, ProcId,
- Context, !VarTypes, !VarSet, !TableInfo, _TableTipVar, _LookupGoals,
- Steps, PredTableVar, LookupForeignArgs, LookupPrefixGoals,
- LookupCodeStr),
+ generate_call_table_lookup_goals(NumberedInputVars,
+ PredId, ProcId, Context, !VarTypes, !VarSet, !TableInfo, _TableTipVar,
+ _LookupGoals, Steps, PredTableVar, LookupForeignArgs,
+ LookupPrefixGoals, LookupCodeStr),
InputVarModes = list__map(project_mode, NumberedInputVars),
assoc_list__from_corresponding_lists(LookupForeignArgs, InputVarModes,
@@ -1609,7 +1626,7 @@
; Detism = nondet ->
ConsumePredName = "table_mmos_consume_next_answer_nondet"
;
- error("do_own_stack_transform: invalid determinism")
+ unexpected(this_file, "do_own_stack_transform: invalid determinism")
),
% XXX consider inlining the predicate being called
generate_call(ConsumePredName, Detism, [ConsumerVar, AnswerBlockVar],
@@ -1655,7 +1672,7 @@
MaybeArgNameMode = yes(InputVarName - _InMode)
;
MaybeArgNameMode = no,
- error("generate_save_input_vars_code: no InputVarName")
+ unexpected(this_file, "generate_save_input_vars_code: no InputVarName")
),
mode_get_insts(ModuleInfo, Mode, InitInst, _FinalInst),
PickupMode = (free -> InitInst),
@@ -1669,7 +1686,8 @@
:- pred do_own_stack_create_generator(pred_id::in, proc_id::in,
pred_info::in, proc_info::in, term__context::in, prog_var::in, string::in,
- list(foreign_arg)::in, list(var_mode_pos)::in, list(var_mode_pos)::in,
+ list(foreign_arg)::in,
+ list(var_mode_pos_method)::in, list(var_mode_pos_method)::in,
set(prog_var)::in, instmap_delta::in,
vartypes::in, prog_varset::in, table_info::in, table_info::out) is det.
@@ -1723,7 +1741,7 @@
!:TableInfo = !.TableInfo ^ table_module_info := ModuleInfo.
:- pred clone_pred_info(pred_id::in, pred_info::in, list(prog_var)::in,
- list(var_mode_pos)::in, pred_id::out,
+ list(var_mode_pos_method)::in, pred_id::out,
table_info::in, table_info::out) is det.
clone_pred_info(OrigPredId, PredInfo0, HeadVars, NumberedOutputVars,
@@ -1771,12 +1789,12 @@
!:TableInfo = !.TableInfo ^ table_module_info := ModuleInfo.
:- pred keep_only_output_arg_types(assoc_list(prog_var, type)::in,
- list(var_mode_pos)::in, list(type)::out) is det.
+ list(var_mode_pos_method)::in, list(type)::out) is det.
keep_only_output_arg_types([], _, []).
keep_only_output_arg_types([_ | _], [], []).
keep_only_output_arg_types([Var - Type | VarTypes], [Out | Outs], OutTypes) :-
- Out = var_mode_pos(OutVar, _, _),
+ Out = var_mode_pos_method(OutVar, _, _, _),
( Var = OutVar ->
keep_only_output_arg_types(VarTypes, Outs, OutTypesTail),
OutTypes = [Type | OutTypesTail]
@@ -1823,7 +1841,7 @@
%-----------------------------------------------------------------------------%
:- pred generate_gen_proc_table_info(table_info::in, list(table_trie_step)::in,
- assoc_list(prog_var, mode)::in, assoc_list(prog_var, mode)::in,
+ list(var_mode_method)::in, list(var_mode_method)::in,
proc_table_info::out) is det.
generate_gen_proc_table_info(TableInfo, Steps, InputVars, OutputVars,
@@ -1844,20 +1862,19 @@
% Generate a goal for doing lookups in call tables for
% loopcheck and memo predicates.
%
-:- pred generate_simple_call_table_lookup_goal(call_table_strictness::in,
- (type)::in, string::in, list(var_mode_pos)::in, pred_id::in, proc_id::in,
- bool::in, term__context::in, vartypes::in, vartypes::out,
- prog_varset::in, prog_varset::out, table_info::in, table_info::out,
- prog_var::out, prog_var::out, hlds_goal::out,
- list(table_trie_step)::out) is det.
+:- pred generate_simple_call_table_lookup_goal((type)::in, string::in,
+ list(var_mode_pos_method)::in, pred_id::in, proc_id::in, bool::in,
+ term__context::in,
+ vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
+ table_info::in, table_info::out, prog_var::out, prog_var::out,
+ hlds_goal::out, list(table_trie_step)::out) is det.
-generate_simple_call_table_lookup_goal(CallStrictness, StatusType, SetupPred,
+generate_simple_call_table_lookup_goal(StatusType, SetupPred,
NumberedVars, PredId, ProcId, TablingViaExtraArgs, Context,
!VarTypes, !VarSet, !TableInfo, TableTipVar, StatusVar, Goal, Steps) :-
- generate_call_table_lookup_goals(CallStrictness, NumberedVars,
- PredId, ProcId, Context, !VarTypes, !VarSet, !TableInfo, TableTipVar,
- LookupGoals, Steps, PredTableVar, LookupForeignArgs, LookupPrefixGoals,
- LookupCodeStr),
+ generate_call_table_lookup_goals(NumberedVars, PredId, ProcId, Context,
+ !VarTypes, !VarSet, !TableInfo, TableTipVar, LookupGoals, Steps,
+ PredTableVar, LookupForeignArgs, LookupPrefixGoals, LookupCodeStr),
generate_new_table_var("Status", StatusType, !VarTypes, !VarSet,
StatusVar),
ModuleInfo = !.TableInfo ^ table_module_info,
@@ -1923,16 +1940,16 @@
% Generate a goal for doing lookups in call tables for
% model_non memo predicates.
%
-:- pred generate_memo_non_call_table_lookup_goal(call_table_strictness::in,
- list(var_mode_pos)::in, pred_id::in, proc_id::in, term__context::in,
+:- pred generate_memo_non_call_table_lookup_goal(list(var_mode_pos_method)::in,
+ pred_id::in, proc_id::in, term__context::in,
vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
table_info::in, table_info::out, prog_var::out, prog_var::out,
hlds_goal::out, list(table_trie_step)::out) is det.
-generate_memo_non_call_table_lookup_goal(CallStrictness, NumberedVars,
+generate_memo_non_call_table_lookup_goal(NumberedVars,
PredId, ProcId, Context, !VarTypes, !VarSet, !TableInfo,
RecordVar, StatusVar, Goal, Steps) :-
- generate_call_table_lookup_goals(CallStrictness, NumberedVars,
+ generate_call_table_lookup_goals(NumberedVars,
PredId, ProcId, Context, !VarTypes, !VarSet, !TableInfo,
_TableTipVar, _LookupGoals, Steps, PredTableVar,
LookupForeignArgs, LookupPrefixGoals, LookupCodeStr),
@@ -1976,7 +1993,7 @@
% Generate a goal for doing lookups in call tables for
% minimal model predicates.
%
-:- pred generate_mm_call_table_lookup_goal(list(var_mode_pos)::in,
+:- pred generate_mm_call_table_lookup_goal(list(var_mode_pos_method)::in,
pred_id::in, proc_id::in, bool::in, term__context::in,
vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
table_info::in, table_info::out, prog_var::out, prog_var::out,
@@ -1985,7 +2002,7 @@
generate_mm_call_table_lookup_goal(NumberedVars, PredId, ProcId,
TablingViaExtraArgs, Context, !VarTypes, !VarSet, !TableInfo,
SubgoalVar, StatusVar, Goal, Steps) :-
- generate_call_table_lookup_goals(strict, NumberedVars, PredId, ProcId,
+ generate_call_table_lookup_goals(NumberedVars, PredId, ProcId,
Context, !VarTypes, !VarSet, !TableInfo, TableTipVar, LookupGoals,
Steps, PredTableVar, LookupForeignArgs, LookupPrefixGoals,
LookupCodeStr),
@@ -2042,19 +2059,19 @@
% Utility predicates used when creating call table lookup goals.
-:- pred generate_call_table_lookup_goals(call_table_strictness::in,
- list(var_mode_pos)::in, pred_id::in, proc_id::in, term__context::in,
+:- pred generate_call_table_lookup_goals(list(var_mode_pos_method)::in,
+ pred_id::in, proc_id::in, term__context::in,
vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
table_info::in, table_info::out, prog_var::out,
list(hlds_goal)::out, list(table_trie_step)::out, prog_var::out,
list(foreign_arg)::out, list(hlds_goal)::out, string::out) is det.
-generate_call_table_lookup_goals(CallStrictness, NumberedVars, PredId, ProcId,
+generate_call_table_lookup_goals(NumberedVars, PredId, ProcId,
Context, !VarTypes, !VarSet, !TableInfo, TableTipVar, Goals, Steps,
PredTableVar, ForeignArgs, PrefixGoals, CodeStr) :-
generate_get_table_goal(PredId, ProcId, !VarTypes, !VarSet,
PredTableVar, GetTableGoal),
- generate_table_lookup_goals(NumberedVars, CallStrictness, "CallTableNode",
+ generate_table_lookup_goals(NumberedVars, "CallTableNode",
Context, PredTableVar, TableTipVar, !VarTypes, !VarSet, !TableInfo,
LookupGoals, Steps, ForeignArgs, LookupPrefixGoals, CodeStr),
Goals = [GetTableGoal | LookupGoals],
@@ -2087,39 +2104,53 @@
% The generated code is used for lookups in both call tables
% and answer tables.
%
-:- pred generate_table_lookup_goals(list(var_mode_pos)::in,
- call_table_strictness::in, string::in,
+:- pred generate_table_lookup_goals(list(var_mode_pos_method)::in, string::in,
term__context::in, prog_var::in, prog_var::out,
vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
table_info::in, table_info::out, list(hlds_goal)::out,
list(table_trie_step)::out, list(foreign_arg)::out,
list(hlds_goal)::out, string::out) is det.
-generate_table_lookup_goals([], _, _, _, !TableVar, !VarTypes, !VarSet,
+generate_table_lookup_goals([], _, _, !TableVar, !VarTypes, !VarSet,
!TableInfo, [], [], [], [], "").
-generate_table_lookup_goals([VarModePos | NumberedVars], CallStrictness,
+generate_table_lookup_goals([VarModePos | NumberedVars],
Prefix, Context, !TableVar, !VarTypes, !VarSet, !TableInfo,
Goals ++ RestGoals, [Step | Steps], ForeignArgs ++ RestForeignArgs,
PrefixGoals ++ RestPrefixGoals, CodeStr ++ RestCodeStr) :-
- VarModePos = var_mode_pos(Var, _, VarSeqNum),
+ VarModePos = var_mode_pos_method(Var, _, VarSeqNum, ArgMethod),
ModuleInfo = !.TableInfo ^ table_module_info,
map__lookup(!.VarTypes, Var, VarType),
classify_type(ModuleInfo, VarType) = TypeCat,
- gen_lookup_call_for_type(CallStrictness, TypeCat, VarType, Var, Prefix,
- VarSeqNum, Context, !VarTypes, !VarSet, !TableInfo, !TableVar,
- Goals, Step, ForeignArgs, PrefixGoals, CodeStr),
- generate_table_lookup_goals(NumberedVars, CallStrictness, Prefix, Context,
+ (
+ ArgMethod = arg_promise_implied,
+ Goals = [],
+ Step = table_trie_step_promise_implied,
+ ForeignArgs = [],
+ PrefixGoals = [],
+ CodeStr = "\t/* promise_implied for " ++ arg_name(VarSeqNum) ++ " */\n"
+ ;
+ ArgMethod = arg_value,
+ gen_lookup_call_for_type(ArgMethod, TypeCat, VarType, Var,
+ Prefix, VarSeqNum, Context, !VarTypes, !VarSet, !TableInfo,
+ !TableVar, Goals, Step, ForeignArgs, PrefixGoals, CodeStr)
+ ;
+ ArgMethod = arg_addr,
+ gen_lookup_call_for_type(ArgMethod, TypeCat, VarType, Var,
+ Prefix, VarSeqNum, Context, !VarTypes, !VarSet, !TableInfo,
+ !TableVar, Goals, Step, ForeignArgs, PrefixGoals, CodeStr)
+ ),
+ generate_table_lookup_goals(NumberedVars, Prefix, Context,
!TableVar, !VarTypes, !VarSet, !TableInfo, RestGoals, Steps,
RestForeignArgs, RestPrefixGoals, RestCodeStr).
-:- pred gen_lookup_call_for_type(call_table_strictness::in, type_category::in,
+:- pred gen_lookup_call_for_type(arg_tabling_method::in, type_category::in,
(type)::in, prog_var::in, string::in, int::in, term__context::in,
vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
table_info::in, table_info::out, prog_var::in, prog_var::out,
list(hlds_goal)::out, table_trie_step::out,
list(foreign_arg)::out, list(hlds_goal)::out, string::out) is det.
-gen_lookup_call_for_type(CallStrictness, TypeCat, Type, ArgVar, Prefix,
+gen_lookup_call_for_type(ArgTablingMethod, TypeCat, Type, ArgVar, Prefix,
VarSeqNum, Context, !VarTypes, !VarSet, !TableInfo, TableVar,
NextTableVar, Goals, Step, ExtraArgs, PrefixGoals, CodeStr) :-
ModuleInfo = !.TableInfo ^ table_module_info,
@@ -2141,7 +2172,8 @@
->
list__length(Ctors, EnumRange)
;
- error("gen_lookup_call_for_type: enum type is not du_type?")
+ unexpected(this_file,
+ "gen_lookup_call_for_type: enum type is not du_type?")
),
gen_int_construction("RangeVar", EnumRange, !VarTypes,
!VarSet, RangeVar, RangeUnifyGoal),
@@ -2158,7 +2190,8 @@
cur_table_node_name ++ ", " ++ int_to_string(EnumRange) ++
", " ++ ArgName ++ ", " ++ next_table_node_name ++ ");\n"
;
- error("gen_lookup_call_for_type: unexpected enum type")
+ unexpected(this_file,
+ "gen_lookup_call_for_type: unexpected enum type")
)
;
lookup_tabling_category(TypeCat, MaybeCatStringStep),
@@ -2166,7 +2199,7 @@
MaybeCatStringStep = no,
prog_type__vars(Type, TypeVars),
(
- CallStrictness = strict,
+ ArgTablingMethod = arg_value,
(
TypeVars = [],
LookupPredName = "table_lookup_insert_user",
@@ -2177,7 +2210,7 @@
Step = table_trie_step_poly
)
;
- CallStrictness = fast_loose,
+ ArgTablingMethod = arg_addr,
(
TypeVars = [],
LookupPredName = "table_lookup_insert_user_fast_loose",
@@ -2187,6 +2220,10 @@
LookupPredName = "table_lookup_insert_poly_fast_loose",
Step = table_trie_step_poly_fast_loose
)
+ ;
+ ArgTablingMethod = arg_promise_implied,
+ unexpected(this_file,
+ "gen_lookup_call_for_type: arg_promise_implied")
),
make_type_info_var(Type, Context, !VarTypes, !VarSet,
!TableInfo, TypeInfoVar, ExtraGoals),
@@ -2225,7 +2262,7 @@
% Generate a goal for saving the output arguments in an answer block
% in memo predicates.
%
-:- pred generate_memo_save_goals(list(var_mode_pos)::in,
+:- pred generate_memo_save_goals(list(var_mode_pos_method(T))::in,
prog_var::in, int::in, bool::in, term__context::in,
vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
table_info::in, table_info::out, list(hlds_goal)::out) is det.
@@ -2263,13 +2300,13 @@
% Generate a goal for saving the output arguments in an answer block
% in model_non memo predicates.
%
-:- pred generate_memo_non_save_goals(list(var_mode_pos)::in,
+:- pred generate_memo_non_save_goals(list(var_mode_pos_method)::in,
prog_var::in, int::in, term__context::in,
vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
table_info::in, table_info::out, list(hlds_goal)::out) is det.
-generate_memo_non_save_goals(NumberedSaveVars, RecordVar, BlockSize, Context,
- !VarTypes, !VarSet, !TableInfo, Goals) :-
+generate_memo_non_save_goals(NumberedSaveVars, RecordVar,
+ BlockSize, Context, !VarTypes, !VarSet, !TableInfo, Goals) :-
ModuleInfo = !.TableInfo ^ table_module_info,
generate_new_table_var("AnswerTableVar", trie_node_type,
!VarTypes, !VarSet, AnswerTableVar),
@@ -2286,8 +2323,8 @@
[RecordArg, AnswerTableArg], [], "", GetPredCode, "",
semipure_code, ground_vars([AnswerTableVar]),
ModuleInfo, Context, GetAnswerTableGoal),
- generate_table_lookup_goals(NumberedSaveVars, strict, "AnswerTableNode",
- Context, AnswerTableVar, _AnswerTableTipVar,
+ generate_table_lookup_goals(NumberedSaveVars,
+ "AnswerTableNode", Context, AnswerTableVar, _AnswerTableTipVar,
!VarTypes, !VarSet, !TableInfo, _LookupAnswerGoals, _,
LookupForeignArgs, LookupPrefixGoals, LookupCodeStr),
@@ -2330,7 +2367,7 @@
% Generate a goal for saving the output arguments in an answer block
% in minimal model predicates.
%
-:- pred generate_mm_save_goals(list(var_mode_pos)::in,
+:- pred generate_mm_save_goals(list(var_mode_pos_method)::in,
prog_var::in, int::in, bool::in, term__context::in,
vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
table_info::in, table_info::out, list(hlds_goal)::out) is det.
@@ -2344,10 +2381,10 @@
generate_call(GetPredName, det, [SubgoalVar, AnswerTableVar],
semipure_code, ground_vars([AnswerTableVar]),
ModuleInfo, Context, GetAnswerTableGoal),
- generate_table_lookup_goals(NumberedSaveVars, strict, "AnswerTableNode",
- Context, AnswerTableVar, AnswerTableTipVar, !VarTypes, !VarSet,
- !TableInfo, LookupAnswerGoals, _, LookupForeignArgs,
- LookupPrefixGoals, LookupCodeStr),
+ generate_table_lookup_goals(NumberedSaveVars,
+ "AnswerTableNode", Context, AnswerTableVar, AnswerTableTipVar,
+ !VarTypes, !VarSet, !TableInfo, LookupAnswerGoals, _,
+ LookupForeignArgs, LookupPrefixGoals, LookupCodeStr),
CreatePredName = "table_mm_create_answer_block",
ShortcutCreatePredName = "table_mm_fill_answer_block_shortcut",
@@ -2398,7 +2435,7 @@
% Generate a save goal for the given variables.
%
-:- pred generate_all_save_goals(list(var_mode_pos)::in,
+:- pred generate_all_save_goals(list(var_mode_pos_method(T))::in,
prog_var::in, (type)::in, string::in, int::in, string::in, string::in,
bool::in, term__context::in, vartypes::in, vartypes::out,
prog_varset::in, prog_varset::out, table_info::in, table_info::out,
@@ -2448,7 +2485,7 @@
% Generate a sequence of save goals for the given variables.
%
-:- pred generate_own_stack_save_goal(list(var_mode_pos)::in,
+:- pred generate_own_stack_save_goal(list(var_mode_pos_method)::in,
prog_var::in, int::in, term__context::in,
vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
table_info::in, table_info::out, list(hlds_goal)::out) is det.
@@ -2461,10 +2498,10 @@
GeneratorName = generator_name,
GeneratorArg = foreign_arg(GeneratorVar, yes(GeneratorName - in_mode),
generator_type),
- generate_table_lookup_goals(NumberedOutputVars, strict, "AnswerTableNode",
- Context, AnswerTableVar, _AnswerTableTipVar, !VarTypes, !VarSet,
- !TableInfo, _LookupAnswerGoals, _Steps, LookupForeignArgs,
- LookupPrefixGoals, LookupCodeStr),
+ generate_table_lookup_goals(NumberedOutputVars,
+ "AnswerTableNode", Context, AnswerTableVar, _AnswerTableTipVar,
+ !VarTypes, !VarSet, !TableInfo, _LookupAnswerGoals, _Steps,
+ LookupForeignArgs, LookupPrefixGoals, LookupCodeStr),
CreatePredName = "table_mm_create_answer_block",
generate_new_table_var("AnswerBlock", answer_block_type,
@@ -2505,7 +2542,7 @@
ModuleInfo, Context, DuplicateCheckSaveGoal),
Goals = LookupPrefixGoals ++ SavePrefixGoals ++ [DuplicateCheckSaveGoal].
-:- pred generate_save_goals(list(var_mode_pos)::in, prog_var::in,
+:- pred generate_save_goals(list(var_mode_pos_method(T))::in, prog_var::in,
term__context::in, vartypes::in, vartypes::out,
prog_varset::in, prog_varset::out, table_info::in, table_info::out,
list(hlds_goal)::out, list(foreign_arg)::out, list(hlds_goal)::out,
@@ -2516,7 +2553,7 @@
generate_save_goals([NumberedVar | NumberedRest], TableVar, Context,
!VarTypes, !VarSet, !TableInfo, Goals, Args ++ RestArgs,
PrefixGoals ++ RestPrefixGoals, CodeStr ++ RestCodeStr) :-
- NumberedVar = var_mode_pos(Var, _Mode, Offset),
+ NumberedVar = var_mode_pos_method(Var, _Mode, Offset, _),
gen_int_construction("OffsetVar", Offset, !VarTypes, !VarSet,
OffsetVar, OffsetUnifyGoal),
ModuleInfo = !.TableInfo ^ table_module_info,
@@ -2592,10 +2629,10 @@
% Generate a goal for restoring the output arguments from
% an answer block in memo predicates.
%
-:- pred generate_memo_restore_goal(list(var_mode_pos)::in, instmap_delta::in,
- prog_var::in, module_info::in, bool::in, term__context::in,
- vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
- hlds_goal::out) is det.
+:- pred generate_memo_restore_goal(list(var_mode_pos_method(T))::in,
+ instmap_delta::in, prog_var::in, module_info::in, bool::in,
+ term__context::in, vartypes::in, vartypes::out,
+ prog_varset::in, prog_varset::out, hlds_goal::out) is det.
generate_memo_restore_goal(NumberedOutputVars, OrigInstMapDelta, TipVar,
ModuleInfo, TablingViaExtraArgs, Context, !VarTypes, !VarSet, Goal) :-
@@ -2646,7 +2683,7 @@
% an answer block in model_non memo predicates.
%
:- pred generate_memo_non_restore_goal(determinism::in,
- list(var_mode_pos)::in, instmap_delta::in, prog_var::in,
+ list(var_mode_pos_method)::in, instmap_delta::in, prog_var::in,
module_info::in, term__context::in, vartypes::in, vartypes::out,
prog_varset::in, prog_varset::out, hlds_goal::out) is det.
@@ -2657,7 +2694,7 @@
; Detism = nondet ->
ReturnAllAns = "table_memo_return_all_answers_nondet"
;
- error("generate_mm_restore_goal: invalid determinism")
+ unexpected(this_file, "generate_mm_restore_goal: invalid determinism")
),
generate_new_table_var("AnswerBlock", answer_block_type,
!VarTypes, !VarSet, AnswerBlockVar),
@@ -2688,7 +2725,7 @@
% an answer block in minimal model predicates without a suspension.
%
:- pred generate_mm_restore_goal(determinism::in,
- list(var_mode_pos)::in, instmap_delta::in, prog_var::in,
+ list(var_mode_pos_method)::in, instmap_delta::in, prog_var::in,
module_info::in, bool::in, term__context::in,
vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
hlds_goal::out) is det.
@@ -2701,7 +2738,7 @@
; Detism = nondet ->
ReturnAllAns = "table_mm_return_all_nondet"
;
- error("generate_mm_restore_goal: invalid determinism")
+ unexpected(this_file, "generate_mm_restore_goal: invalid determinism")
),
generate_mm_restore_or_suspend_goal(ReturnAllAns, Detism, semipure,
NumberedOutputVars, OrigInstMapDelta, SubgoalVar, ModuleInfo,
@@ -2710,7 +2747,7 @@
% Generate a goal for restoring the output arguments from
% an answer block in minimal model predicates after a suspension.
%
-:- pred generate_mm_suspend_goal(list(var_mode_pos)::in,
+:- pred generate_mm_suspend_goal(list(var_mode_pos_method)::in,
instmap_delta::in, prog_var::in, module_info::in,
bool::in, term__context::in,
vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
@@ -2728,7 +2765,7 @@
% is after a suspension depends on the arguments.
%
:- pred generate_mm_restore_or_suspend_goal(string::in, determinism::in,
- purity::in, list(var_mode_pos)::in, instmap_delta::in,
+ purity::in, list(var_mode_pos_method)::in, instmap_delta::in,
prog_var::in, module_info::in, bool::in, term__context::in,
vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
hlds_goal::out) is det.
@@ -2771,7 +2808,7 @@
% Generate a sequence of restore goals for the given variables.
%
-:- pred generate_restore_goals(list(var_mode_pos)::in,
+:- pred generate_restore_goals(list(var_mode_pos_method(T))::in,
instmap_delta::in, prog_var::in, module_info::in, term__context::in,
vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
list(hlds_goal)::out, assoc_list(prog_var, inst)::out,
@@ -2782,7 +2819,7 @@
AnswerBlockVar, ModuleInfo, Context, !VarTypes, !VarSet,
[OffsetUnifyGoal, CallGoal | RestGoals], [VarInst | VarInsts],
[Arg | Args], CodeStr ++ RestCodeStr) :-
- NumberedVar = var_mode_pos(Var, _Mode, Offset),
+ NumberedVar = var_mode_pos_method(Var, _Mode, Offset, _),
gen_int_construction("OffsetVar", Offset, !VarTypes, !VarSet,
OffsetVar, OffsetUnifyGoal),
map__lookup(!.VarTypes, Var, VarType),
@@ -2818,7 +2855,7 @@
( instmap_delta_search_var(OrigInstmapDelta, Var, InstPrime) ->
Inst = InstPrime
;
- error("gen_restore_call_for_type: no inst")
+ unexpected(this_file, "gen_restore_call_for_type: no inst")
),
Arg = foreign_arg(Var, yes(Name - (free -> Inst)), ArgType),
CodeStr = "\tMR_" ++ RestorePredName ++ "(" ++ answer_block_name ++ ", "
@@ -3014,31 +3051,77 @@
mercury_table_builtin_module(TB),
construct_type(qualified(TB, "ml_generator") - 0, [], Type).
+:- type maybe_specified_method
+ ---> all_same(arg_tabling_method)
+ ; specified(list(maybe(arg_tabling_method))).
+
:- pred get_input_output_vars(list(prog_var)::in, list(mode)::in,
- module_info::in, list(prog_var)::out,
- assoc_list(prog_var, mode)::out, assoc_list(prog_var, mode)::out) is det.
+ module_info::in, maybe_specified_method::in, maybe_specified_method::out,
+ list(var_mode_method)::out, list(var_mode_method)::out) is det.
-get_input_output_vars([], [], _, [], [], []).
-get_input_output_vars([_|_], [], _, _, _, _) :-
- error("get_input_output_vars: lists not same length").
-get_input_output_vars([], [_|_], _, _, _, _) :-
- error("get_input_output_vars: lists not same length").
+get_input_output_vars([], [], _, !MaybeSpecMethod, [], []).
+get_input_output_vars([_ | _], [], _, !MaybeSpecMethod, _, _) :-
+ unexpected(this_file, "get_input_output_vars: lists not same length").
+get_input_output_vars([], [_ | _], _, !MaybeSpecMethod, _, _) :-
+ unexpected(this_file, "get_input_output_vars: lists not same length").
get_input_output_vars([Var | Vars], [Mode | Modes], ModuleInfo,
- BadVars, InVarModes, OutVarModes) :-
- % XXX We should check not just the boundedness of Var, but also
- % its sharing state: tabled arguments should not share.
+ !MaybeSpecMethod, InVarModes, OutVarModes) :-
( mode_is_fully_input(ModuleInfo, Mode) ->
- get_input_output_vars(Vars, Modes, ModuleInfo,
- BadVars, InVarModes0, OutVarModes),
- InVarModes = [Var - Mode | InVarModes0]
+ get_input_output_vars(Vars, Modes, ModuleInfo, !MaybeSpecMethod,
+ InVarModes0, OutVarModes),
+ (
+ !.MaybeSpecMethod = all_same(ArgMethod)
+ ;
+ !.MaybeSpecMethod = specified(MaybeArgMethods0),
+ (
+ list__split_last(MaybeArgMethods0, MaybeArgMethods,
+ LastMaybeArgMethod)
+ ->
+ (
+ LastMaybeArgMethod = yes(ArgMethod)
+ ;
+ LastMaybeArgMethod = no,
+ error("get_input_output_vars: bad method for input var")
+ ),
+ !:MaybeSpecMethod = specified(MaybeArgMethods)
+ ;
+ % We have run out of specified arg_methods, which means the
+ % variable we are looking at right now is one that was added
+ % by the polymorphism transformation.
+ ArgMethod = arg_value,
+ !:MaybeSpecMethod = all_same(arg_value)
+ )
+ ),
+ InVarModes = [var_mode_method(Var, Mode, ArgMethod) | InVarModes0]
; mode_is_fully_output(ModuleInfo, Mode) ->
- get_input_output_vars(Vars, Modes, ModuleInfo,
- BadVars, InVarModes, OutVarModes0),
- OutVarModes = [Var - Mode | OutVarModes0]
- ;
- get_input_output_vars(Vars, Modes, ModuleInfo,
- BadVars0, InVarModes, OutVarModes),
- BadVars = [Var | BadVars0]
+ get_input_output_vars(Vars, Modes, ModuleInfo, !MaybeSpecMethod,
+ InVarModes, OutVarModes0),
+ (
+ !.MaybeSpecMethod = all_same(_ArgMethod)
+ % The tabling methods that use answer tables always use arg_value
+ % to look up computed output arguments in them. The argument of
+ % all_same refers only to the treatment of input arguments.
+ ;
+ !.MaybeSpecMethod = specified(MaybeArgMethods0),
+ (
+ list__split_last(MaybeArgMethods0, MaybeArgMethods,
+ LastMaybeArgMethod)
+ ->
+ require(unify(LastMaybeArgMethod, no),
+ "get_input_output_vars: bad method for output var"),
+ !:MaybeSpecMethod = specified(MaybeArgMethods)
+ ;
+ % We have run out of specified arg_methods, which means the
+ % variable we are looking at right now is one that was added
+ % by the polymorphism transformation.
+ !:MaybeSpecMethod = all_same(arg_value)
+ )
+ ),
+ OutVarModes = [var_mode_method(Var, Mode, arg_value) | OutVarModes0]
+ ;
+ % We should have caught this when we added the tabling pragma
+ % to the proc_info.
+ unexpected(this_file, "get_input_output_vars: bad var")
).
%-----------------------------------------------------------------------------%
@@ -3055,49 +3138,99 @@
%-----------------------------------------------------------------------------%
-:- type var_mode_pos
- ---> var_mode_pos(prog_var, mode, int).
+:- type var_mode_method
+ ---> var_mode_method(
+ prog_var, % The head variable.
+ mode, % The mode of the head variable.
+ arg_tabling_method
+ % For input arguments, this is the arg method to
+ % use in looking up the argument in the call table.
+ % For output arguments, this is the arg method to
+ % use in looking up the argument in the answer
+ % table (if any).
+ ).
-:- func project_var(var_mode_pos) = prog_var.
+:- type var_mode_pos_method == var_mode_pos_method(arg_tabling_method).
+
+:- type var_mode_pos_method(T)
+ ---> var_mode_pos_method(
+ prog_var, % The head variable.
+ mode, % The mode of the head variable.
+ int, % The position of the head variable in the list of
+ % inputs or outputs; first element is in the
+ % position numbered 0.
+ T
+ % For input arguments, this is the arg method to
+ % use in looking up the argument in the call table.
+ % For output arguments, this is the arg method to
+ % use in looking up the argument in the answer
+ % table (if any), which for now is always
+ % arg_value.
+ %
+ % When T is unit, there is no info about how to
+ % look up the variable in a call or return table.
+ % This is useful for recording the structure of
+ % answer blocks and sequences of arguments
+ % for I/O tabling.
+ ).
-project_var(var_mode_pos(Var, _, _)) = Var.
+:- func project_var(var_mode_pos_method(T)) = prog_var.
-:- func project_var_pos(var_mode_pos) = pair(prog_var, int).
+project_var(var_mode_pos_method(Var, _, _, _)) = Var.
-project_var_pos(var_mode_pos(Var, _, Pos)) = Var - Pos.
+:- func project_var_pos(var_mode_pos_method(T)) = pair(prog_var, int).
-:- func project_var_init_inst(module_info, var_mode_pos) =
+project_var_pos(var_mode_pos_method(Var, _, Pos, _)) = Var - Pos.
+
+:- func project_var_init_inst(module_info, var_mode_pos_method(T)) =
pair(prog_var, inst).
-project_var_init_inst(ModuleInfo, var_mode_pos(Var, Mode, _)) = Var - Inst :-
+project_var_init_inst(ModuleInfo, var_mode_pos_method(Var, Mode, _, _))
+ = Var - Inst :-
mode_get_insts(ModuleInfo, Mode, Inst, _).
-:- func project_mode(var_mode_pos) = (mode).
+:- func project_mode(var_mode_pos_method(T)) = (mode).
+
+project_mode(var_mode_pos_method(_, Mode, _, _)) = Mode.
-project_mode(var_mode_pos(_, Mode, _)) = Mode.
+:- func project_out_arg_method(var_mode_pos_method) =
+ var_mode_pos_method(unit).
-:- pred allocate_slot_numbers(assoc_list(prog_var, mode)::in, int::in,
- list(var_mode_pos)::out) is det.
+project_out_arg_method(var_mode_pos_method(Var, Mode, Pos, _)) =
+ var_mode_pos_method(Var, Mode, Pos, unit).
+
+:- pred allocate_slot_numbers(list(var_mode_method)::in,
+ int::in, list(var_mode_pos_method)::out) is det.
allocate_slot_numbers([], _, []).
-allocate_slot_numbers([Var - Mode | VarModes], Offset0,
- [VarModePos | VarModePoss]) :-
- VarModePos = var_mode_pos(Var, Mode, Offset0),
+allocate_slot_numbers([var_mode_method(Var, Mode, ArgMethod) | VarModes],
+ Offset0, [VarModePos | VarModePoss]) :-
+ VarModePos = var_mode_pos_method(Var, Mode, Offset0, ArgMethod),
allocate_slot_numbers(VarModes, Offset0 + 1, VarModePoss).
-:- pred reallocate_slot_numbers(list(var_mode_pos)::in, int::in,
- list(var_mode_pos)::out) is det.
+:- pred allocate_plain_slot_numbers(assoc_list(prog_var, mode)::in,
+ int::in, list(var_mode_pos_method(unit))::out) is det.
+
+allocate_plain_slot_numbers([], _, []).
+allocate_plain_slot_numbers([Var - Mode | VarModes],
+ Offset0, [VarModePos | VarModePoss]) :-
+ VarModePos = var_mode_pos_method(Var, Mode, Offset0, unit),
+ allocate_plain_slot_numbers(VarModes, Offset0 + 1, VarModePoss).
+
+:- pred reallocate_slot_numbers(list(var_mode_pos_method(T))::in, int::in,
+ list(var_mode_pos_method(T))::out) is det.
reallocate_slot_numbers([], _, []).
reallocate_slot_numbers([VarModePos0 | VarModes], Offset0,
[VarModePos | VarModePoss]) :-
- VarModePos0 = var_mode_pos(Var, Mode, _),
- VarModePos = var_mode_pos(Var, Mode, Offset0),
+ VarModePos0 = var_mode_pos_method(Var, Mode, _, ArgMethod),
+ VarModePos = var_mode_pos_method(Var, Mode, Offset0, ArgMethod),
reallocate_slot_numbers(VarModes, Offset0 + 1, VarModePoss).
-:- pred var_belong_to_list(list(prog_var)::in, var_mode_pos::in) is semidet.
+:- pred var_belong_to_list(list(prog_var)::in, var_mode_pos_method(T)::in)
+ is semidet.
-var_belong_to_list(List, var_mode_pos(Var, _, _)) :-
+var_belong_to_list(List, var_mode_pos_method(Var, _, _, _)) :-
list__member(Var, List).
:- func bind_vars(list(prog_var)) = instmap_delta.
@@ -3131,7 +3264,7 @@
% this makes the tabling of type_infos more expensive than necessary, since
% we essentially table the information in the type_info twice, once by tabling
% the type represented by the type_info (since this is the value of the type
-% argument of the type constructor private_builtin.type_info/1, and then
+% argument of the type constructor private_builtin.type_info/1), and then
% tabling the type_info itself.
:- func builtin_type(type_category) = bool.
@@ -3162,15 +3295,15 @@
lookup_tabling_category(str_type, yes("string" - table_trie_step_string)).
lookup_tabling_category(float_type, yes("float" - table_trie_step_float)).
lookup_tabling_category(void_type, _) :-
- error("lookup_tabling_category: void").
+ unexpected(this_file, "lookup_tabling_category: void").
lookup_tabling_category(type_info_type,
yes("typeinfo" - table_trie_step_typeinfo)).
lookup_tabling_category(type_ctor_info_type,
yes("typeinfo" - table_trie_step_typeinfo)).
lookup_tabling_category(typeclass_info_type, _) :-
- error("lookup_tabling_category: typeclass_info_type").
+ unexpected(this_file, "lookup_tabling_category: typeclass_info_type").
lookup_tabling_category(base_typeclass_info_type, _) :-
- error("lookup_tabling_category: base_typeclass_info_type").
+ unexpected(this_file, "lookup_tabling_category: base_typeclass_info_type").
lookup_tabling_category(enum_type, no).
lookup_tabling_category(higher_order_type, no).
lookup_tabling_category(tuple_type, no).
@@ -3194,14 +3327,14 @@
type_save_category(user_ctor_type, "any"). % could do better
type_save_category(variable_type, "any"). % could do better
type_save_category(void_type, _) :-
- error("type_save_category: void").
+ unexpected(this_file, "type_save_category: void").
type_save_category(type_info_type, "any"). % could do better
type_save_category(type_ctor_info_type, _) :-
- error("type_save_category: type_ctor_info").
+ unexpected(this_file, "type_save_category: type_ctor_info").
type_save_category(typeclass_info_type, _) :-
- error("type_save_category: typeclass_info").
+ unexpected(this_file, "type_save_category: typeclass_info").
type_save_category(base_typeclass_info_type, _) :-
- error("type_save_category: base_typeclass_info").
+ unexpected(this_file, "type_save_category: base_typeclass_info").
%-----------------------------------------------------------------------------%
@@ -3217,7 +3350,7 @@
( TypeInfoVars = [TypeInfoVar0] ->
TypeInfoVar = TypeInfoVar0
;
- error("table_gen__make_type_info_var: list length != 1")
+ unexpected(this_file, "table_gen__make_type_info_var: list length != 1")
).
:- pred table_gen__make_type_info_vars(list(type)::in, term__context::in,
@@ -3262,11 +3395,11 @@
%-----------------------------------------------------------------------------%
-:- pred table_gen__var_mode_pos_is_io_state(vartypes::in, var_mode_pos::in)
- is semidet.
+:- pred table_gen__var_mode_pos_is_io_state(vartypes::in,
+ var_mode_pos_method::in) is semidet.
-table_gen__var_mode_pos_is_io_state(VarTypes, var_mode_pos(Var, _, _)) :-
- table_gen__var_is_io_state(VarTypes, Var).
+table_gen__var_mode_pos_is_io_state(VarTypes, VarModePosMethod) :-
+ table_gen__var_is_io_state(VarTypes, project_var(VarModePosMethod)).
:- pred table_gen__var_mode_is_io_state(vartypes::in, pair(prog_var, mode)::in)
is semidet.
@@ -3366,5 +3499,11 @@
table_info_extract(TableInfo, ModuleInfo, PredInfo, ProcInfo) :-
TableInfo = table_info(ModuleInfo, PredInfo, ProcInfo).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "table.m".
%-----------------------------------------------------------------------------%
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.318
diff -u -b -r1.318 reference_manual.texi
--- doc/reference_manual.texi 17 Jun 2005 10:13:55 -0000 1.318
+++ doc/reference_manual.texi 14 Aug 2005 02:59:47 -0000
@@ -8846,72 +8846,132 @@
The implementation can optionally also check at runtime for the situation
where a procedure calls itself recursively with the same arguments,
-which would normally result in a infinite loop; if this situation is
-encountered, it can (at the programmer's option) either throw an
-exception, or avoid the infinite loop by computing solutions
-using the ``minimal model'' semantics.
-
-The current Mercury implementation thus supports three different
-pragmas for tabling, to cover these three cases: @samp{pragma memo}
-does no loop checking, @samp{pragma loop_check} checks for loops
-and throws an exception if a loop is detected, while
- at samp{pragma minimal_model} computes the ``minimal model'' semantics.
- at samp{pragma fast_loose_memo} is a variant of @samp{pragma memo}.
-While @samp{memo} tabling requires time proportional to the size of
-the input arguments to look up the current call in its table,
- at samp{fast_loose_memo} requires constant time.
-The tradeoff is that @samp{fast_loose_memo} does not recognize
-calls as duplicates if they involve input arguments that are logically equal
-but are stored at different locations in memory.
+which would normally result in a infinite loop;
+if this situation is encountered, it can (at the programmer's option)
+either throw an exception, or avoid the infinite loop
+by computing solutions using the ``minimal model'' semantics.
+
+The current Mercury implementation thus supports
+three different pragmas for tabling, to cover these three cases:
+ at samp{pragma memo} does no loop checking,
+ at samp{pragma loop_check} checks for loops
+and throws an exception if a loop is detected,
+while @samp{pragma minimal_model} computes the ``minimal model'' semantics.
@c XXX we should fix this bug...
@cartouche
@strong{Warning:}
-The current implementation of @samp{pragma minimal_model} is broken:
-the generated code sometimes produces incorrect results. It should
-not be used. Also the current implementation of all three pragmas
-is broken for procedures with determinism @samp{nondet} or @samp{multi}.
-The @samp{pragma memo} and @samp{pragma loop_check} declarations
-should not be used on such procedures.
+The current implementation of @samp{pragma memo} declarations
+is not designed to work for procedures
+with determinism @samp{nondet} or @samp{multi}.
@end cartouche
The syntax for each of these declarations is
@example
:- pragma memo(@var{Name}/@var{Arity}).
-:- pragma fast_loose_memo(@var{Name}/@var{Arity}).
:- pragma loop_check(@var{Name}/@var{Arity}).
:- pragma minimal_model(@var{Name}/@var{Arity}).
@end example
@noindent
-where @var{Name}/@var{Arity} specifies the predicate or
-function to which the declaration applies. The declaration
-applies to all modes of the predicate and/or function named.
+where @var{Name}/@var{Arity} specifies
+the predicate or function to which the declaration applies.
+The declaration applies to all modes of the predicate and/or function named.
At most one of these declarations may be specified
for any given predicate or function.
+Programmers can also request the application of tabling
+only to one particular mode of a predicate or function,
+via declarations such as these:
+
+ at example
+:- pragma memo(@var{Name}(in, in, out)).
+:- pragma loop_check(@var{Name}(in, out)).
+:- pragma minimal_model(@var{Name}(in, in, out, out)).
+ at end example
+
+We also support two faster variants of @samp{pragma memo}
+that may be applicable in some circumstances.
+The implementation of @samp{pragma memo}
+looks up the value of each input argument in the call table,
+and thus requires time proportional to
+the number of function symbols in the input arguments
+to look up the current call in the call table.
+The @samp{pragma fast_loose_memo} variant
+looks up only the address of each input argument in the call table,
+which means that the time required
+to look up the current call in the call table
+is linear only in the number of input arguments.
+The tradeoff is that @samp{fast_loose_memo} does not recognize
+calls as duplicates if they involve input arguments that are logically equal
+but are stored at different locations in memory.
+The following declarations call for this variable of tabling.
+
+ at example
+:- pragma fast_loose_memo(@var{Name}/@var{Arity}).
+:- pragma fast_loose_memo(@var{Name}(in, in, out)).
+ at end example
+
+The second variant of @samp{pragma memo} allows programmers to choose
+individually for each input argument whether that argument
+should be looked up in the call table by value or by address,
+or whether it should be looked up at all:
+
+ at example
+:- pragma memo(@var{Name}(in, in, in, out),
+ [value, addr, promise_implied, output]).
+ at end example
+
+The second argument of this form of @samp{pragma memo} should be a list
+with an element for each argument of the predicate or function concerned
+(if a function, last element is for the return value).
+For output arguments, the list element should be @samp{output};
+For input arguments, the list element may be
+ at samp{value}, @samp{addr} or @samp{promise_implied}.
+The first calls for tabling the argument by value,
+the second calls for tabling the argument by address,
+and the third calls for not tabling the argument at all.
+This last course of action promises that any two calls
+that agree on the values of the value-tabled input arguments
+and on the addresses of the address-tabled input arguments
+will behave the same regardless of the values of the untabled input arguments.
+In most cases, this will mean that the values of the untabled arguments
+are implied by the values of the value-tabled arguments
+and the addresses of the address-tabled arguments,
+though the promise can also be fulfilled
+if the table predicate or function does not actually use
+the untabled argument for computing any of its output.
+(It is ok for it to use the untabled argument
+to decide what exception to throw.)
+
+If the tabled predicate or function has only one mode,
+then this declaration can also be specified without giving the argument modes:
+
+ at example
+:- pragma memo(@var{Name}/@var{Arity},
+ [value, addr, promise_implied, output]).
+ at end example
+
Note that a @samp{pragma minimal_model} declaration
-changes the declarative semantics of the specified predicate or
-function: instead of using the completion of the clauses
-as the basis for the semantics, as is normally the case
-in Mercury, the declarative semantics that is used is
-the ``minimal model'' semantics. Anything which is
-true or false in the completion semantics is also true
-or false (respectively) in the minimal model semantics,
+changes the declarative semantics of the specified predicate or function:
+instead of using the completion of the clauses as the basis for the semantics,
+as is normally the case in Mercury,
+the declarative semantics that is used is the ``minimal model'' semantics.
+Anything which is true or false in the completion semantics
+is also true or false (respectively) in the minimal model semantics,
but there are goals for which the minimal model specifies
-that the result is true or false, whereas the completion semantics
-leaves the result unspecified.
+that the result is true or false,
+whereas the completion semantics leaves the result unspecified.
For these goals, the usual Mercury semantics requires the
implementation to either loop or report an error message,
-but the minimal model semantics requires a particular
-answer to be returned.
-In particular, the minimal model semantics says that any
-call that is not true in @emph{all} models is false.
-
-Programmers should therefore use a @samp{pragma minimal_model}
-declaration only in cases where their intended interpretation for a
-procedure coincides with the minimal model for that procedure.
+but the minimal model semantics requires a particular answer to be returned.
+In particular, the minimal model semantics says that
+any call that is not true in @emph{all} models is false.
+
+Programmers should therefore use a @samp{pragma minimal_model} declaration
+only in cases where their intended interpretation for a procedure
+coincides with the minimal model for that procedure.
Fortunately, however, this is usually what programmers intend.
@c XXX give an example
@@ -8923,34 +8983,28 @@
The operational semantics of procedures with a @samp{pragma minimal_model}
declaration corresponds to what Sagonas calls ``SLGd resolution''.
-In the general case, the execution mechanism required by
-minimal model tabling is quite complicated, requiring
-the ability to delay goals and then wake them up again.
-The Mercury implementation uses a technique based on copying
-relevant parts of the stack to the heap when delaying goals,
+In the general case,
+the execution mechanism required by minimal model tabling is quite complicated,
+requiring the ability to delay goals and then wake them up again.
+The Mercury implementation uses a technique based on
+copying relevant parts of the stack to the heap when delaying goals,
similar to the one described in
@c XXX this citation doesn't come out properly in DVI format
@cite{CAT: the copying approach to tabling},
by B. Demoen and K. Sagonas. @xref{[5]}.
-This ensures that code which does not use tabling does not pay any
-runtime overheads from the more complicated execution mechanism
+This ensures that code which does not use tabling
+does not pay any runtime overheads
+from the more complicated execution mechanism
required by (minimal model) tabling.
@cartouche
@strong{Please note:}
-the current implementation of tabling does not support all the
-possible compilation grades (see the ``Compilation model options''
-section of the Mercury User's Guide) allowed by the Mercury
-implementation. In particular, minimal model tabling
-is incompatible with high level code, the use of trailing,
-and accurate garbage collection.
-
- at c XXX we should fix this bug...
- at strong{Reminder}: the current implementation of
- at samp{pragma minimal_model} is broken,
-and the current implementation of @samp{pragma memo}
-and @samp{pragma loop_check} is broken for procedures
-with determinism @samp{nondet} or @samp{multi}.
+the current implementation of tabling does not support
+all the possible compilation grades
+(see the ``Compilation model options'' section of the Mercury User's Guide)
+allowed by the Mercury implementation.
+In particular, minimal model tabling is incompatible with
+high level code, the use of trailing, and accurate garbage collection.
@end cartouche
@node Termination analysis
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/mercury_stack_layout.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_stack_layout.h,v
retrieving revision 1.91
diff -u -b -r1.91 mercury_stack_layout.h
--- runtime/mercury_stack_layout.h 21 Jun 2005 03:12:03 -0000 1.91
+++ runtime/mercury_stack_layout.h 12 Aug 2005 08:49:52 -0000
@@ -631,7 +631,8 @@
MR_TABLE_STEP_POLY,
MR_TABLE_STEP_POLY_FAST_LOOSE,
MR_TABLE_STEP_TYPEINFO,
- MR_TABLE_STEP_TYPECLASSINFO
+ MR_TABLE_STEP_TYPECLASSINFO,
+ MR_TABLE_STEP_PROMISE_IMPLIED
} MR_Table_Trie_Step;
typedef struct MR_Table_Gen_Struct {
@@ -775,6 +776,7 @@
MR_EVAL_METHOD_LOOP_CHECK,
MR_EVAL_METHOD_MEMO_STRICT,
MR_EVAL_METHOD_MEMO_FAST_LOOSE,
+ MR_EVAL_METHOD_MEMO_SPECIFIED,
MR_EVAL_METHOD_MINIMAL_STACK_COPY,
MR_EVAL_METHOD_MINIMAL_OWN_STACKS,
MR_EVAL_METHOD_TABLE_IO,
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
Index: tests/debugger/print_table.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/print_table.exp,v
retrieving revision 1.8
diff -u -b -r1.8 print_table.exp
--- tests/debugger/print_table.exp 16 Nov 2004 00:16:39 -0000 1.8
+++ tests/debugger/print_table.exp 12 Aug 2005 10:26:04 -0000
@@ -381,6 +381,19 @@
answer #2: <210>
<2, 2>: complete
end of table (2 entries)
+mdb> delete 1
+ 1: E stop interface pred print_table.tdone/0-0 (det)
+mdb> b udone
+ 1: + stop interface pred print_table.udone/0-0 (det)
+mdb> c
+ E33: C17 CALL pred print_table.udone/0-0 (det)
+mdb> table u
+memo table for pred print_table.u/4-0 (nondet):
+<1, 2>: complete
+answer #1: <120>
+answer #2: <210>
+<2, 2>: complete
+end of table (2 entries)
mdb> c -S -n
75
24
@@ -394,5 +407,7 @@
[3.5xyz2][3.5xyz2][3.5xyz2] 6.50000000000000
[3.5xyz2][3.5xyz2][3.5xyz2][3.5xyz2] 7.50000000000000
[9.2def2][9.2def2][9.2def2][9.2def2][9.2def2] 14.2000000000000
+[120, 210]
+[]
[120, 210]
[]
Index: tests/debugger/print_table.inp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/print_table.inp,v
retrieving revision 1.3
diff -u -b -r1.3 print_table.inp
--- tests/debugger/print_table.inp 20 Jul 2004 04:41:36 -0000 1.3
+++ tests/debugger/print_table.inp 12 Aug 2005 10:04:00 -0000
@@ -103,4 +103,8 @@
b tdone
c
table t
+delete 1
+b udone
+c
+table u
c -S -n
Index: tests/debugger/print_table.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/print_table.m,v
retrieving revision 1.3
diff -u -b -r1.3 print_table.m
--- tests/debugger/print_table.m 20 Jul 2004 04:41:36 -0000 1.3
+++ tests/debugger/print_table.m 12 Aug 2005 10:02:29 -0000
@@ -34,6 +34,9 @@
{ solutions(t(1, 2), T12) },
{ solutions(t(2, 2), T22) },
{ tdone },
+ { solutions(u(1, 2, 2), U12) },
+ { solutions(u(2, 2, 2), U22) },
+ { udone },
io__write_int(P55),
io__nl,
io__write_int(P43),
@@ -71,6 +74,10 @@
io__write(T12),
io__nl,
io__write(T22),
+ io__nl,
+ io__write(U12),
+ io__nl,
+ io__write(U22),
io__nl.
:- pred p(int::in, int::in, int::out) is det.
@@ -137,3 +144,21 @@
:- pred tdone is det.
tdone.
+
+:- pred u(int::in, int::in, int::in, int::out) is nondet.
+:- pragma memo(u/4, [value, value, promise_implied, output]).
+
+u(A, B, Bcopy, C) :-
+ ( A = 1 ->
+ (
+ C = (A * 100) + (B * 10)
+ ;
+ C = (Bcopy * 100) + (A * 10)
+ )
+ ;
+ fail
+ ).
+
+:- pred udone is det.
+
+udone.
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.171
diff -u -b -r1.171 Mmakefile
--- tests/invalid/Mmakefile 8 Aug 2005 02:33:16 -0000 1.171
+++ tests/invalid/Mmakefile 12 Aug 2005 10:34:46 -0000
@@ -140,6 +140,7 @@
range_restrict \
record_syntax_errors \
some \
+ specified \
spurious_mode_error \
state_vars_test1 \
state_vars_test2 \
Index: tests/invalid/conflicting_tabling_pragmas.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/conflicting_tabling_pragmas.err_exp,v
retrieving revision 1.1
diff -u -b -r1.1 conflicting_tabling_pragmas.err_exp
--- tests/invalid/conflicting_tabling_pragmas.err_exp 8 Dec 2004 05:39:14 -0000 1.1
+++ tests/invalid/conflicting_tabling_pragmas.err_exp 13 Aug 2005 01:54:59 -0000
@@ -1,6 +1,6 @@
-conflicting_tabling_pragmas.m:012: Error:
-conflicting_tabling_pragmas.m:012: function `conflicting_tabling_pragmas.fac/1'
-conflicting_tabling_pragmas.m:012: has both memo and loop_check pragmas
+conflicting_tabling_pragmas.m:012: Error: function
+conflicting_tabling_pragmas.m:012: `conflicting_tabling_pragmas.fac/1' has
+conflicting_tabling_pragmas.m:012: both memo and loop_check pragmas
conflicting_tabling_pragmas.m:012: specified. Only one kind of tabling pragma
conflicting_tabling_pragmas.m:012: may be applied to it.
For more information, try recompiling with `-E'.
Index: tests/invalid/specified.err_exp
===================================================================
RCS file: tests/invalid/specified.err_exp
diff -N tests/invalid/specified.err_exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/specified.err_exp 13 Aug 2005 09:25:14 -0000
@@ -0,0 +1,16 @@
+specified.m:167: Error: expected argument tabling method: implied.
+specified.m:152: Error in `pragma memo([addr, promise_implied, addr])'
+specified.m:152: declaration for predicate `specified.ap_lp_fib/3':
+specified.m:152: argument 3: argument tabling method `addr' is not compatible
+specified.m:152: with output modes.
+specified.m:182: Error in `pragma memo([addr, promise_implied])' declaration
+specified.m:182: for predicate `specified.ap_li_fib/3':
+specified.m:182: not enough argument tabling methods specified.
+specified.m:220: Error in `pragma memo([output, value, promise_implied])'
+specified.m:220: declaration for predicate `specified.vp_ll_fib/3':
+specified.m:220: argument 1: argument tabling method `output' is not
+specified.m:220: compatible with input modes.
+specified.m:239: Error in `pragma memo([value, value, output, output])'
+specified.m:239: declaration for predicate `specified.vv_ll_fib/3':
+specified.m:239: too many argument tabling methods specified.
+For more information, try recompiling with `-E'.
Index: tests/invalid/specified.m
===================================================================
RCS file: tests/invalid/specified.m
diff -N tests/invalid/specified.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/specified.m 13 Aug 2005 07:44:13 -0000
@@ -0,0 +1,295 @@
+:- module specified.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module assoc_list.
+:- import_module benchmarking.
+:- import_module int.
+:- import_module list.
+:- import_module require.
+:- import_module std_util.
+
+main(!IO) :-
+ perform_trials(aplp_vs_vplp, [1, 4], 14, 3, 0, 0, !IO),
+ perform_trials(apli_vs_vpli, [1, 4], 14, 3, 0, 0, !IO),
+ perform_trials(vvll_vs_vpll, [4, 4, 4], 444, 30, 0, 0, !IO).
+
+:- type trial_type
+ ---> aplp_vs_vplp
+ ; apli_vs_vpli
+ ; vvll_vs_vpll.
+
+:- pred perform_trials(trial_type::in, list(int)::in, int::in, int::in,
+ int::in, int::in, io::di, io::uo) is cc_multi.
+
+perform_trials(TrialType, ListN, IntN, Incr, NumDouble0, NumTrials0, !IO) :-
+ trial(TrialType, ListN, IntN, Time, MTime, !IO),
+ % io__write(TrialType, !IO),
+ % io__write_string(" ", !IO),
+ % io__write(IntN, !IO),
+ % io__write_string(": ", !IO),
+ % io__write_int(Time, !IO),
+ % io__write_string("ms vs ", !IO),
+ % io__write_int(MTime, !IO),
+ % io__write_string("ms\n", !IO),
+ (
+ MTime > 10,
+ Time > MTime * 2
+ ->
+ NumDouble = NumDouble0 + 1
+ ;
+ NumDouble = 0
+ ),
+ (
+ (
+ Time > 10 * MTime,
+ MTime > 0 % "should be slower" version takes ten times as long
+ ;
+ Time > 100, % "should be slower" version takes at least 100 ms
+ MTime < 1 % while "should be faster" version takes at most 1 ms
+ ;
+ NumDouble >= 10
+ % The "should be faster" version has been at least
+ % double the speed of the "should be slower" version
+ % for the last ten trials.
+ )
+ ->
+ io__write(TrialType, !IO),
+ io__write_string(": tabling works\n", !IO)
+ ;
+ (
+ Time > 10000 % "should be slower" takes at least 10 seconds
+ ;
+ NumTrials0 > 1000
+ )
+ ->
+ io__write(TrialType, !IO),
+ io__write_string(": tabling does not appear to work\n", !IO)
+ ;
+ % We couldn't get a measurable result with N,
+ % and it looks like we can afford a bigger trial
+ perform_trials(TrialType,
+ add_digits(ListN, num_to_digits(Incr)), IntN + Incr, Incr,
+ NumDouble, NumTrials0 + 1, !IO)
+ ).
+
+:- pred trial(trial_type::in, list(int)::in, int::in, int::out, int::out,
+ io::di, io::uo) is cc_multi.
+
+trial(TrialType, ListN, IntN, Time, MTime, !IO) :-
+ (
+ TrialType = aplp_vs_vplp,
+ benchmark_det(ap_lp_fib_test, ListN - [42], Res, 1, Time),
+ benchmark_det(vp_lp_fib_test, ListN - [42], MRes, 1, MTime)
+ ;
+ TrialType = apli_vs_vpli,
+ benchmark_det(ap_li_fib_test, ListN - IntN, Res, 1, Time),
+ benchmark_det(vp_li_fib_test, ListN - IntN, MRes, 1, MTime)
+ ;
+ TrialType = vvll_vs_vpll,
+ reset_tables(!IO),
+ benchmark_det(vv_ll_fib_test, ListN - ListN, Res, 1, Time),
+ benchmark_det(vp_ll_fib_test, ListN - ListN, MRes, 1, MTime)
+ ),
+ require(unify(Res, MRes), "tabling produces wrong answer").
+
+:- pred reset_tables(io::di, io::uo) is det.
+
+:- pragma foreign_decl("C",
+"
+extern void mercury__specified__reset_tables(void);
+").
+
+:- pragma foreign_proc("C",
+ reset_tables(IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ /* Mention IO0, IO */
+ mercury__specified__reset_tables();
+").
+
+%-----------------------------------------------------------------------------%
+
+:- pred ap_lp_fib_test(pair(list(int), T)::in, list(int)::out) is det.
+
+ap_lp_fib_test(N - Dummy, F) :-
+ ap_lp_fib(N, Dummy, F).
+
+:- pred vp_lp_fib_test(pair(list(int), T)::in, list(int)::out) is det.
+
+vp_lp_fib_test(N - Dummy, F) :-
+ vp_lp_fib(N, Dummy, F).
+
+:- pred ap_li_fib_test(pair(list(int), int)::in, list(int)::out) is det.
+
+ap_li_fib_test(N - CopyN, F) :-
+ ap_li_fib(N, CopyN, F).
+
+:- pred vp_li_fib_test(pair(list(int), int)::in, list(int)::out) is det.
+
+vp_li_fib_test(N - CopyN, F) :-
+ vp_li_fib(N, CopyN, F).
+
+:- pred vp_ll_fib_test(pair(list(int), list(int))::in, list(int)::out) is det.
+
+vp_ll_fib_test(N - CopyN, F) :-
+ vp_ll_fib(N, CopyN, F).
+
+:- pred vv_ll_fib_test(pair(list(int), list(int))::in, list(int)::out) is det.
+
+vv_ll_fib_test(N - CopyN, F) :-
+ vv_ll_fib(N, CopyN, F).
+
+%-----------------------------------------------------------------------------%
+
+:- pred ap_lp_fib(list(int)::in, T::in, list(int)::out) is det.
+:- pragma memo(ap_lp_fib(in, in, out), [addr, promise_implied, addr]).
+
+ap_lp_fib(N, Dummy, F) :-
+ RawN = digits_to_num(N),
+ ( RawN < 2 ->
+ F = num_to_digits(1)
+ ;
+ One = num_to_digits(1),
+ Two = num_to_digits(2),
+ ap_lp_fib(subtract_digits(N, One), Dummy, F1),
+ ap_lp_fib(subtract_digits(N, Two), Dummy, F2),
+ F = add_digits(F1, F2)
+ ).
+
+:- pred vp_lp_fib(list(int)::in, T::in, list(int)::out) is det.
+:- pragma memo(vp_lp_fib/3, [value, implied, output]).
+
+vp_lp_fib(N, Dummy, F) :-
+ RawN = digits_to_num(N),
+ ( RawN < 2 ->
+ F = num_to_digits(1)
+ ;
+ One = num_to_digits(1),
+ Two = num_to_digits(2),
+ vp_lp_fib(subtract_digits(N, One), Dummy, F1),
+ vp_lp_fib(subtract_digits(N, Two), Dummy, F2),
+ F = add_digits(F1, F2)
+ ).
+
+:- pred ap_li_fib(list(int)::in, int::in, list(int)::out) is det.
+:- pragma memo(ap_li_fib(in, in, out), [addr, promise_implied]).
+
+ap_li_fib(N, CopyN, F) :-
+ RawN = digits_to_num(N),
+ ( RawN < 2 ->
+ ( RawN = CopyN ->
+ F = num_to_digits(1)
+ ;
+ error("ap_li_fib")
+ )
+ ;
+ One = num_to_digits(1),
+ Two = num_to_digits(2),
+ ap_li_fib(subtract_digits(N, One), RawN - 1, F1),
+ ap_li_fib(subtract_digits(N, Two), RawN - 2, F2),
+ F = add_digits(F1, F2)
+ ).
+
+:- pred vp_li_fib(list(int)::in, int::in, list(int)::out) is det.
+:- pragma memo(vp_li_fib/3, [value, promise_implied, output]).
+
+vp_li_fib(N, CopyN, F) :-
+ RawN = digits_to_num(N),
+ ( RawN < 2 ->
+ ( RawN = CopyN ->
+ F = num_to_digits(1)
+ ;
+ error("vp_li_fib")
+ )
+ ;
+ One = num_to_digits(1),
+ Two = num_to_digits(2),
+ vp_li_fib(subtract_digits(N, One), CopyN - 1, F1),
+ vp_li_fib(subtract_digits(N, Two), CopyN - 2, F2),
+ F = add_digits(F1, F2)
+ ).
+
+:- pred vp_ll_fib(list(int)::in, list(int)::in, list(int)::out) is det.
+:- pragma memo(vp_ll_fib/3, [output, value, promise_implied]).
+
+vp_ll_fib(N, CopyN, F) :-
+ RawN = digits_to_num(N),
+ ( RawN < 2 ->
+ ( RawN = digits_to_num(CopyN) ->
+ F = num_to_digits(1)
+ ;
+ error("vp_ll_fib")
+ )
+ ;
+ One = num_to_digits(1),
+ Two = num_to_digits(2),
+ vp_ll_fib(subtract_digits(N, One), subtract_digits(N, One), F1),
+ vp_ll_fib(subtract_digits(N, Two), subtract_digits(N, Two), F2),
+ F = add_digits(F1, F2)
+ ).
+
+:- pred vv_ll_fib(list(int)::in, list(int)::in, list(int)::out) is det.
+:- pragma memo(vv_ll_fib/3, [value, value, output, output]).
+
+vv_ll_fib(N, CopyN, F) :-
+ RawN = digits_to_num(N),
+ ( RawN < 2 ->
+ ( RawN = digits_to_num(CopyN) ->
+ F = num_to_digits(1)
+ ;
+ error("vv_ll_fib")
+ )
+ ;
+ One = num_to_digits(1),
+ Two = num_to_digits(2),
+ vv_ll_fib(subtract_digits(N, One), subtract_digits(N, One), F1),
+ vv_ll_fib(subtract_digits(N, Two), subtract_digits(N, Two), F2),
+ F = add_digits(F1, F2)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- func add_digits(list(int), list(int)) = list(int).
+
+add_digits(S1, S2) =
+ num_to_digits(digits_to_num(S1) + digits_to_num(S2)).
+
+:- func mul_digits(list(int), list(int)) = list(int).
+
+mul_digits(S1, S2) =
+ num_to_digits(digits_to_num(S1) * digits_to_num(S2)).
+
+:- func subtract_digits(list(int), list(int)) = list(int).
+
+subtract_digits(S1, S2) =
+ num_to_digits(digits_to_num(S1) - digits_to_num(S2)).
+
+:- func digits_to_num(list(int)) = int.
+
+digits_to_num(Digits) = Num :-
+ list__reverse(Digits, RevDigits),
+ Num = digits_to_num_2(RevDigits).
+
+:- func digits_to_num_2(list(int)) = int.
+
+digits_to_num_2([]) = 0.
+digits_to_num_2([Last | Rest]) =
+ 10 * digits_to_num_2(Rest) + Last.
+
+:- func num_to_digits(int) = list(int).
+
+num_to_digits(Int) = Digits :-
+ ( Int < 10 ->
+ Digits = [Int]
+ ;
+ Last = Int mod 10,
+ Rest = Int // 10,
+ list__append(num_to_digits(Rest), [Last], Digits)
+ ).
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
Index: tests/tabling/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/tabling/Mercury.options,v
retrieving revision 1.1
diff -u -b -r1.1 Mercury.options
--- tests/tabling/Mercury.options 17 Aug 2002 13:52:28 -0000 1.1
+++ tests/tabling/Mercury.options 12 Aug 2005 09:26:47 -0000
@@ -2,3 +2,6 @@
# tc_minimal works on some machines even in the presence of a known bug
# if inlining is turned on, so we turn inlining off to make the test tougher.
MCFLAGS-tc_minimal = --no-inlining
+
+# The specified test case needs to reset some tables between trials.
+MCFLAGS-specified = --allow-table-reset
Index: tests/tabling/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/tabling/Mmakefile,v
retrieving revision 1.37
diff -u -b -r1.37 Mmakefile
--- tests/tabling/Mmakefile 30 Jul 2005 11:44:40 -0000 1.37
+++ tests/tabling/Mmakefile 12 Aug 2005 08:47:07 -0000
@@ -18,6 +18,7 @@
loopcheck_no_loop \
loopcheck_nondet_no_loop \
oota \
+ specified \
table_foreign_output \
test_enum \
unused_args
Index: tests/tabling/specified.exp
===================================================================
RCS file: tests/tabling/specified.exp
diff -N tests/tabling/specified.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/tabling/specified.exp 12 Aug 2005 10:30:40 -0000
@@ -0,0 +1,3 @@
+aplp_vs_vplp: tabling works
+apli_vs_vpli: tabling works
+vvll_vs_vpll: tabling works
Index: tests/tabling/specified.m
===================================================================
RCS file: tests/tabling/specified.m
diff -N tests/tabling/specified.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/tabling/specified.m 12 Aug 2005 10:30:21 -0000
@@ -0,0 +1,304 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% This test case is designed to test the functionality of tabling pragmas
+% that explicitly specify how each input argument should be looked up in the
+% call table:
+%
+% :- pragma memo(p(in, in, out), [value, promise_implied, output]).
+
+:- module specified.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module assoc_list.
+:- import_module benchmarking.
+:- import_module int.
+:- import_module list.
+:- import_module require.
+:- import_module std_util.
+
+main(!IO) :-
+ perform_trials(aplp_vs_vplp, [1, 4], 14, 3, 0, 0, !IO),
+ perform_trials(apli_vs_vpli, [1, 4], 14, 3, 0, 0, !IO),
+ perform_trials(vvll_vs_vpll, [4, 4, 4], 444, 30, 0, 0, !IO).
+
+:- type trial_type
+ ---> aplp_vs_vplp
+ ; apli_vs_vpli
+ ; vvll_vs_vpll.
+
+:- pred perform_trials(trial_type::in, list(int)::in, int::in, int::in,
+ int::in, int::in, io::di, io::uo) is cc_multi.
+
+perform_trials(TrialType, ListN, IntN, Incr, NumDouble0, NumTrials0, !IO) :-
+ trial(TrialType, ListN, IntN, Time, MTime, !IO),
+ % io__write(TrialType, !IO),
+ % io__write_string(" ", !IO),
+ % io__write(IntN, !IO),
+ % io__write_string(": ", !IO),
+ % io__write_int(Time, !IO),
+ % io__write_string("ms vs ", !IO),
+ % io__write_int(MTime, !IO),
+ % io__write_string("ms\n", !IO),
+ (
+ MTime > 10,
+ Time > MTime * 2
+ ->
+ NumDouble = NumDouble0 + 1
+ ;
+ NumDouble = 0
+ ),
+ (
+ (
+ Time > 10 * MTime,
+ MTime > 0 % "should be slower" version takes ten times as long
+ ;
+ Time > 100, % "should be slower" version takes at least 100 ms
+ MTime < 1 % while "should be faster" version takes at most 1 ms
+ ;
+ NumDouble >= 10
+ % The "should be faster" version has been at least
+ % double the speed of the "should be slower" version
+ % for the last ten trials.
+ )
+ ->
+ io__write(TrialType, !IO),
+ io__write_string(": tabling works\n", !IO)
+ ;
+ (
+ Time > 10000 % "should be slower" takes at least 10 seconds
+ ;
+ NumTrials0 > 1000
+ )
+ ->
+ io__write(TrialType, !IO),
+ io__write_string(": tabling does not appear to work\n", !IO)
+ ;
+ % We couldn't get a measurable result with N,
+ % and it looks like we can afford a bigger trial
+ perform_trials(TrialType,
+ add_digits(ListN, num_to_digits(Incr)), IntN + Incr, Incr,
+ NumDouble, NumTrials0 + 1, !IO)
+ ).
+
+:- pred trial(trial_type::in, list(int)::in, int::in, int::out, int::out,
+ io::di, io::uo) is cc_multi.
+
+trial(TrialType, ListN, IntN, Time, MTime, !IO) :-
+ (
+ TrialType = aplp_vs_vplp,
+ benchmark_det(ap_lp_fib_test, ListN - [42], Res, 1, Time),
+ benchmark_det(vp_lp_fib_test, ListN - [42], MRes, 1, MTime)
+ ;
+ TrialType = apli_vs_vpli,
+ benchmark_det(ap_li_fib_test, ListN - IntN, Res, 1, Time),
+ benchmark_det(vp_li_fib_test, ListN - IntN, MRes, 1, MTime)
+ ;
+ TrialType = vvll_vs_vpll,
+ reset_tables(!IO),
+ benchmark_det(vv_ll_fib_test, ListN - ListN, Res, 1, Time),
+ benchmark_det(vp_ll_fib_test, ListN - ListN, MRes, 1, MTime)
+ ),
+ require(unify(Res, MRes), "tabling produces wrong answer").
+
+:- pred reset_tables(io::di, io::uo) is det.
+
+:- pragma foreign_decl("C",
+"
+extern void mercury__specified__reset_tables(void);
+").
+
+:- pragma foreign_proc("C",
+ reset_tables(IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ /* Mention IO0, IO */
+ mercury__specified__reset_tables();
+").
+
+%-----------------------------------------------------------------------------%
+
+:- pred ap_lp_fib_test(pair(list(int), T)::in, list(int)::out) is det.
+
+ap_lp_fib_test(N - Dummy, F) :-
+ ap_lp_fib(N, Dummy, F).
+
+:- pred vp_lp_fib_test(pair(list(int), T)::in, list(int)::out) is det.
+
+vp_lp_fib_test(N - Dummy, F) :-
+ vp_lp_fib(N, Dummy, F).
+
+:- pred ap_li_fib_test(pair(list(int), int)::in, list(int)::out) is det.
+
+ap_li_fib_test(N - CopyN, F) :-
+ ap_li_fib(N, CopyN, F).
+
+:- pred vp_li_fib_test(pair(list(int), int)::in, list(int)::out) is det.
+
+vp_li_fib_test(N - CopyN, F) :-
+ vp_li_fib(N, CopyN, F).
+
+:- pred vp_ll_fib_test(pair(list(int), list(int))::in, list(int)::out) is det.
+
+vp_ll_fib_test(N - CopyN, F) :-
+ vp_ll_fib(N, CopyN, F).
+
+:- pred vv_ll_fib_test(pair(list(int), list(int))::in, list(int)::out) is det.
+
+vv_ll_fib_test(N - CopyN, F) :-
+ vv_ll_fib(N, CopyN, F).
+
+%-----------------------------------------------------------------------------%
+
+:- pred ap_lp_fib(list(int)::in, T::in, list(int)::out) is det.
+:- pragma memo(ap_lp_fib(in, in, out), [addr, promise_implied, output]).
+
+ap_lp_fib(N, Dummy, F) :-
+ RawN = digits_to_num(N),
+ ( RawN < 2 ->
+ F = num_to_digits(1)
+ ;
+ One = num_to_digits(1),
+ Two = num_to_digits(2),
+ ap_lp_fib(subtract_digits(N, One), Dummy, F1),
+ ap_lp_fib(subtract_digits(N, Two), Dummy, F2),
+ F = add_digits(F1, F2)
+ ).
+
+:- pred vp_lp_fib(list(int)::in, T::in, list(int)::out) is det.
+:- pragma memo(vp_lp_fib/3, [value, promise_implied, output]).
+
+vp_lp_fib(N, Dummy, F) :-
+ RawN = digits_to_num(N),
+ ( RawN < 2 ->
+ F = num_to_digits(1)
+ ;
+ One = num_to_digits(1),
+ Two = num_to_digits(2),
+ vp_lp_fib(subtract_digits(N, One), Dummy, F1),
+ vp_lp_fib(subtract_digits(N, Two), Dummy, F2),
+ F = add_digits(F1, F2)
+ ).
+
+:- pred ap_li_fib(list(int)::in, int::in, list(int)::out) is det.
+:- pragma memo(ap_li_fib(in, in, out), [addr, promise_implied, output]).
+
+ap_li_fib(N, CopyN, F) :-
+ RawN = digits_to_num(N),
+ ( RawN < 2 ->
+ ( RawN = CopyN ->
+ F = num_to_digits(1)
+ ;
+ error("ap_li_fib")
+ )
+ ;
+ One = num_to_digits(1),
+ Two = num_to_digits(2),
+ ap_li_fib(subtract_digits(N, One), RawN - 1, F1),
+ ap_li_fib(subtract_digits(N, Two), RawN - 2, F2),
+ F = add_digits(F1, F2)
+ ).
+
+:- pred vp_li_fib(list(int)::in, int::in, list(int)::out) is det.
+:- pragma memo(vp_li_fib/3, [value, promise_implied, output]).
+
+vp_li_fib(N, CopyN, F) :-
+ RawN = digits_to_num(N),
+ ( RawN < 2 ->
+ ( RawN = CopyN ->
+ F = num_to_digits(1)
+ ;
+ error("vp_li_fib")
+ )
+ ;
+ One = num_to_digits(1),
+ Two = num_to_digits(2),
+ vp_li_fib(subtract_digits(N, One), CopyN - 1, F1),
+ vp_li_fib(subtract_digits(N, Two), CopyN - 2, F2),
+ F = add_digits(F1, F2)
+ ).
+
+:- pred vp_ll_fib(list(int)::in, list(int)::in, list(int)::out) is det.
+:- pragma memo(vp_ll_fib/3, [value, promise_implied, output]).
+
+vp_ll_fib(N, CopyN, F) :-
+ RawN = digits_to_num(N),
+ ( RawN < 2 ->
+ ( RawN = digits_to_num(CopyN) ->
+ F = num_to_digits(1)
+ ;
+ error("vp_ll_fib")
+ )
+ ;
+ One = num_to_digits(1),
+ Two = num_to_digits(2),
+ vp_ll_fib(subtract_digits(N, One), subtract_digits(N, One), F1),
+ vp_ll_fib(subtract_digits(N, Two), subtract_digits(N, Two), F2),
+ F = add_digits(F1, F2)
+ ).
+
+:- pred vv_ll_fib(list(int)::in, list(int)::in, list(int)::out) is det.
+:- pragma memo(vv_ll_fib/3, [value, value, output]).
+
+vv_ll_fib(N, CopyN, F) :-
+ RawN = digits_to_num(N),
+ ( RawN < 2 ->
+ ( RawN = digits_to_num(CopyN) ->
+ F = num_to_digits(1)
+ ;
+ error("vv_ll_fib")
+ )
+ ;
+ One = num_to_digits(1),
+ Two = num_to_digits(2),
+ vv_ll_fib(subtract_digits(N, One), subtract_digits(N, One), F1),
+ vv_ll_fib(subtract_digits(N, Two), subtract_digits(N, Two), F2),
+ F = add_digits(F1, F2)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- func add_digits(list(int), list(int)) = list(int).
+
+add_digits(S1, S2) =
+ num_to_digits(digits_to_num(S1) + digits_to_num(S2)).
+
+:- func mul_digits(list(int), list(int)) = list(int).
+
+mul_digits(S1, S2) =
+ num_to_digits(digits_to_num(S1) * digits_to_num(S2)).
+
+:- func subtract_digits(list(int), list(int)) = list(int).
+
+subtract_digits(S1, S2) =
+ num_to_digits(digits_to_num(S1) - digits_to_num(S2)).
+
+:- func digits_to_num(list(int)) = int.
+
+digits_to_num(Digits) = Num :-
+ list__reverse(Digits, RevDigits),
+ Num = digits_to_num_2(RevDigits).
+
+:- func digits_to_num_2(list(int)) = int.
+
+digits_to_num_2([]) = 0.
+digits_to_num_2([Last | Rest]) =
+ 10 * digits_to_num_2(Rest) + Last.
+
+:- func num_to_digits(int) = list(int).
+
+num_to_digits(Int) = Digits :-
+ ( Int < 10 ->
+ Digits = [Int]
+ ;
+ Last = Int mod 10,
+ Rest = Int // 10,
+ list__append(num_to_digits(Rest), [Last], Digits)
+ ).
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
Index: trace/mercury_trace.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace.c,v
retrieving revision 1.85
diff -u -b -r1.85 mercury_trace.c
--- trace/mercury_trace.c 12 Aug 2005 05:04:48 -0000 1.85
+++ trace/mercury_trace.c 12 Aug 2005 08:51:05 -0000
@@ -1510,6 +1510,7 @@
case MR_EVAL_METHOD_MEMO_STRICT:
case MR_EVAL_METHOD_MEMO_FAST_LOOSE:
+ case MR_EVAL_METHOD_MEMO_SPECIFIED:
case MR_EVAL_METHOD_LOOP_CHECK:
if (MR_DETISM_DET_STACK(level_layout->MR_sle_detism)) {
call_table = (MR_TrieNode) MR_based_stackvar(base_sp,
Index: trace/mercury_trace_internal.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.211
diff -u -b -r1.211 mercury_trace_internal.c
--- trace/mercury_trace_internal.c 12 Aug 2005 02:01:27 -0000 1.211
+++ trace/mercury_trace_internal.c 12 Aug 2005 10:24:29 -0000
@@ -323,10 +323,11 @@
**
** The step field specifies what data structure the tabling system uses to
** implement the trie nodes at the level of the call table corresponding to
-** the relevant argument. At the moment, we support only three values of this
-** field, MR_TABLE_STEP_INT, MR_TABLE_STEP_FLOAT and MR_TABLE_STEP_STRING;
-** each of those implicitly selects the corresponding alternative in the
-** arg_values union.
+** the relevant argument. At the moment, we support only four values of this
+** field, MR_TABLE_STEP_INT, MR_TABLE_STEP_FLOAT, MR_TABLE_STEP_STRING and
+** MR_TABLE_STEP_PROMISE_IMPLIED. The first three of these implicitly select
+** the corresponding alternative in the arg_values union; the last one
+** indicates the absence of a step.
**
** The start_node field specifies the start node of the relevant trie. For the
** first input argument, this will be the tabling pointer variable for the
@@ -388,6 +389,7 @@
typedef struct {
MR_Table_Trie_Step MR_cta_step;
+ int MR_cta_unfiltered_arg_num;
MR_TrieNode MR_cta_start_node;
MR_bool MR_cta_valid;
MR_Table_Arg_Values MR_cta_arg_values;
@@ -673,8 +675,8 @@
/* Prints the given subgoal of the given procedure to MR_mdb_out. */
static void MR_trace_cmd_table_print_tip(const MR_Proc_Layout *proc,
- int num_inputs, MR_Call_Table_Arg *call_table_args,
- MR_TrieNode table);
+ int filtered_num_inputs,
+ MR_Call_Table_Arg *call_table_args, MR_TrieNode table);
/* Prints the given subgoal of the given procedure to MR_mdb_out. */
static void MR_trace_print_subgoal(const MR_Proc_Layout *proc,
@@ -4529,7 +4531,9 @@
const MR_Table_Gen *table_gen;
MR_TrieNode table_cur;
int num_inputs;
+ int filtered_num_inputs;
int cur_arg;
+ int filtered_cur_arg;
int num_tips;
if (word_count < 2) {
@@ -4557,6 +4561,7 @@
case MR_EVAL_METHOD_LOOP_CHECK:
case MR_EVAL_METHOD_MEMO_STRICT:
case MR_EVAL_METHOD_MEMO_FAST_LOOSE:
+ case MR_EVAL_METHOD_MEMO_SPECIFIED:
case MR_EVAL_METHOD_MINIMAL_STACK_COPY:
case MR_EVAL_METHOD_MINIMAL_OWN_STACKS:
break;
@@ -4568,10 +4573,6 @@
fprintf(MR_mdb_out,
"IO tabled predicates do not have their own tables.\n");
return KEEP_INTERACTING;
-
- default:
- MR_fatal_error("unrecognized eval method");
- return KEEP_INTERACTING;
}
/*
@@ -4600,23 +4601,38 @@
}
table_cur = proc->MR_sle_tabling_pointer;
- for (cur_arg = 0; cur_arg < num_inputs; cur_arg++) {
+ for (cur_arg = 0, filtered_cur_arg = 0; cur_arg < num_inputs; cur_arg++) {
switch (table_gen->MR_table_gen_input_steps[cur_arg]) {
case MR_TABLE_STEP_INT:
case MR_TABLE_STEP_FLOAT:
case MR_TABLE_STEP_STRING:
/* these are OK */
+ call_table_args[filtered_cur_arg].MR_cta_step =
+ table_gen->MR_table_gen_input_steps[filtered_cur_arg];
+ call_table_args[filtered_cur_arg].MR_cta_valid = MR_FALSE;
+ call_table_args[filtered_cur_arg].MR_cta_unfiltered_arg_num =
+ cur_arg;
+ filtered_cur_arg++;
+
+ case MR_TABLE_STEP_PROMISE_IMPLIED:
+ /* this argument doesn't exist in the table */
break;
+
default:
fprintf(MR_mdb_out, "Sorry, can handle only "
"integer, float and string arguments for now.\n");
MR_GC_free(call_table_args);
return KEEP_INTERACTING;
}
+ }
- call_table_args[cur_arg].MR_cta_step =
- table_gen->MR_table_gen_input_steps[cur_arg];
- call_table_args[cur_arg].MR_cta_valid = MR_FALSE;
+ filtered_num_inputs = filtered_cur_arg;
+ if (word_count > filtered_num_inputs) {
+ fprintf(MR_mdb_out,
+ "Sorry, this procedure has only %d tabled arguments\n",
+ filtered_num_inputs);
+ MR_GC_free(call_table_args);
+ return KEEP_INTERACTING;
}
/*
@@ -4624,23 +4640,29 @@
** line, to enable us to print them out in each call table entry.
*/
- for (cur_arg = 0; cur_arg < word_count; cur_arg++) {
+ for (filtered_cur_arg = 0;
+ filtered_cur_arg < word_count;
+ filtered_cur_arg++)
+ {
MR_bool success;
- switch (call_table_args[cur_arg].MR_cta_step) {
+ switch (call_table_args[filtered_cur_arg].MR_cta_step) {
case MR_TABLE_STEP_INT:
success = MR_trace_fill_in_int_table_arg_slot(&table_cur,
- cur_arg + 1, words[cur_arg], &call_table_args[cur_arg]);
+ filtered_cur_arg + 1, words[filtered_cur_arg],
+ &call_table_args[filtered_cur_arg]);
break;
case MR_TABLE_STEP_FLOAT:
success = MR_trace_fill_in_float_table_arg_slot(&table_cur,
- cur_arg + 1, words[cur_arg], &call_table_args[cur_arg]);
+ filtered_cur_arg + 1, words[filtered_cur_arg],
+ &call_table_args[filtered_cur_arg]);
break;
case MR_TABLE_STEP_STRING:
success = MR_trace_fill_in_string_table_arg_slot(&table_cur,
- cur_arg + 1, words[cur_arg], &call_table_args[cur_arg]);
+ filtered_cur_arg + 1, words[filtered_cur_arg],
+ &call_table_args[filtered_cur_arg]);
break;
default:
@@ -4654,15 +4676,15 @@
}
}
- if (word_count == num_inputs) {
+ if (word_count == filtered_num_inputs) {
/*
** The user specified values for all the input arguments,
** so what we print is a single entry, not a table of entries,
** and we don't need to loop over all the entries.
*/
- MR_trace_cmd_table_print_tip(proc, num_inputs, call_table_args,
- table_cur);
+ MR_trace_cmd_table_print_tip(proc, filtered_num_inputs,
+ call_table_args, table_cur);
MR_GC_free(call_table_args);
return KEEP_INTERACTING;
}
@@ -4681,6 +4703,7 @@
case MR_EVAL_METHOD_MEMO_STRICT:
case MR_EVAL_METHOD_MEMO_FAST_LOOSE:
+ case MR_EVAL_METHOD_MEMO_SPECIFIED:
fprintf(MR_mdb_out, "memo table for ");
MR_print_proc_id(MR_mdb_out, proc);
fprintf(MR_mdb_out, ":\n");
@@ -4693,7 +4716,11 @@
fprintf(MR_mdb_out, ":\n");
break;
- default:
+ case MR_EVAL_METHOD_NORMAL:
+ case MR_EVAL_METHOD_TABLE_IO:
+ case MR_EVAL_METHOD_TABLE_IO_DECL:
+ case MR_EVAL_METHOD_TABLE_IO_UNITIZE:
+ case MR_EVAL_METHOD_TABLE_IO_UNITIZE_DECL:
MR_fatal_error("MR_trace_cmd_table: bad eval method");
}
@@ -4723,12 +4750,12 @@
** in the current trie node in the values array of the relevant
** argument.
**
- ** We number the input arguments from 0 to num_inputs-1. When cur_arg
- ** becomes equal to num_inputs, this means that we have values for all
- ** the input arguments, so we print the corresponding call table entry.
- ** We then initiate backtracking: we decrement cur_arg to get the next
- ** value of the last argument. We also do this whenever we run out of
- ** values in any trie.
+ ** We number the input arguments from 0 to filtered_num_inputs-1.
+ ** When cur_arg becomes equal to filtered_num_inputs, this means that
+ ** we have values for all the tabled input arguments, so we print the
+ ** corresponding call table entry. We then initiate backtracking:
+ ** we decrement cur_arg to get the next value of the last argument.
+ ** We also do this whenever we run out of values in any trie.
**
** We stop when we are about to backtrack out of the outermost loop.
*/
@@ -4775,9 +4802,9 @@
cur_arg++;
- if (cur_arg >= num_inputs) {
- MR_trace_cmd_table_print_tip(proc, num_inputs, call_table_args,
- table_cur);
+ if (cur_arg >= filtered_num_inputs) {
+ MR_trace_cmd_table_print_tip(proc, filtered_num_inputs,
+ call_table_args, table_cur);
num_tips++;
start_backtrack = MR_TRUE;
} else {
@@ -5050,14 +5077,15 @@
}
static void
-MR_trace_cmd_table_print_tip(const MR_Proc_Layout *proc, int num_inputs,
- MR_Call_Table_Arg *call_table_args, MR_TrieNode table)
+MR_trace_cmd_table_print_tip(const MR_Proc_Layout *proc,
+ int num_filtered_inputs, MR_Call_Table_Arg *call_table_args,
+ MR_TrieNode table)
{
int i;
MR_EvalMethod eval_method;
fprintf(MR_mdb_out, "<");
- for (i = 0; i < num_inputs; i++) {
+ for (i = 0; i < num_filtered_inputs; i++) {
if (i > 0) {
fprintf(MR_mdb_out, ", ");
}
@@ -5118,6 +5146,7 @@
case MR_EVAL_METHOD_MEMO_STRICT:
case MR_EVAL_METHOD_MEMO_FAST_LOOSE:
+ case MR_EVAL_METHOD_MEMO_SPECIFIED:
{
MR_Determinism detism;
@@ -8273,7 +8302,7 @@
NULL, MR_trace_var_completer },
{ "breakpoint", "break", MR_trace_cmd_break,
- MR_trace_break_cmd_args, MR_trace_breakpoint_completer },
+ MR_trace_break_cmd_args, MR_trace_proc_spec_completer },
{ "breakpoint", "condition", MR_trace_cmd_condition,
NULL, MR_trace_null_completer },
{ "breakpoint", "ignore", MR_trace_cmd_ignore,
@@ -8338,7 +8367,7 @@
{ "dd", "dd", MR_trace_cmd_dd,
MR_trace_dd_cmd_args, MR_trace_null_completer },
{ "dd", "trust", MR_trace_cmd_trust,
- NULL, MR_trace_breakpoint_completer },
+ NULL, MR_trace_proc_spec_completer },
{ "dd", "untrust", MR_trace_cmd_untrust,
NULL, MR_trace_null_completer },
{ "dd", "trusted", MR_trace_cmd_trusted, NULL,
@@ -8395,7 +8424,7 @@
{ "developer", "unhide_events", MR_trace_cmd_unhide_events,
MR_trace_on_off_args, MR_trace_null_completer },
{ "developer", "table", MR_trace_cmd_table,
- NULL, MR_trace_null_completer },
+ NULL, MR_trace_proc_spec_completer },
{ "developer", "type_ctor", MR_trace_cmd_type_ctor,
NULL, MR_trace_null_completer },
{ "developer", "class_decl", MR_trace_cmd_class_decl,
Index: trace/mercury_trace_tables.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_tables.c,v
retrieving revision 1.36
diff -u -b -r1.36 mercury_trace_tables.c
--- trace/mercury_trace_tables.c 1 Aug 2005 02:40:13 -0000 1.36
+++ trace/mercury_trace_tables.c 12 Aug 2005 09:40:29 -0000
@@ -103,12 +103,12 @@
int MR_complete_current_proc;
} MR_Proc_Completer_Data;
-static char *MR_trace_breakpoint_completer_next(const char *word,
+static char *MR_trace_proc_spec_completer_next(const char *word,
size_t word_len, MR_Completer_Data *completer_data);
-static void MR_trace_breakpoint_completer_init_module(
+static void MR_trace_proc_spec_completer_init_module(
MR_Proc_Completer_Data *data);
static char *MR_trace_complete_proc(MR_Proc_Completer_Data *data);
-static char *MR_format_breakpoint_completion(MR_PredFunc pred_or_func,
+static char *MR_format_proc_spec_completion(MR_PredFunc pred_or_func,
const char *module, const char *name);
static void MR_free_proc_completer_data(MR_Completer_Data completer_data);
@@ -749,7 +749,7 @@
}
MR_Completer_List *
-MR_trace_breakpoint_completer(const char *word, size_t word_len)
+MR_trace_proc_spec_completer(const char *word, size_t word_len)
{
MR_Proc_Completer_Data *data;
int slot;
@@ -815,12 +815,12 @@
data->MR_unambiguous_matching_module = -1;
}
- return MR_new_completer_elem(MR_trace_breakpoint_completer_next,
+ return MR_new_completer_elem(MR_trace_proc_spec_completer_next,
(MR_Completer_Data) data, MR_free_proc_completer_data);
}
static char *
-MR_trace_breakpoint_completer_next(const char *dont_use_this_word,
+MR_trace_proc_spec_completer_next(const char *dont_use_this_word,
size_t dont_use_this_len, MR_Completer_Data *completer_data)
{
MR_Proc_Completer_Data *data;
@@ -849,7 +849,7 @@
if (data->MR_complete_current_module >= MR_module_info_next) {
return NULL;
}
- MR_trace_breakpoint_completer_init_module(data);
+ MR_trace_proc_spec_completer_init_module(data);
/*
** Complete on the module name if we aren't finding
@@ -860,7 +860,7 @@
if (data->MR_complete_word_matches_module == 0 &&
MR_strneq(name, module_name, name_len))
{
- return MR_format_breakpoint_completion(data->MR_complete_pf,
+ return MR_format_proc_spec_completion(data->MR_complete_pf,
module_name, "");
} else {
goto try_completion;
@@ -883,7 +883,7 @@
** Set up the completer data for processing a module.
*/
static void
-MR_trace_breakpoint_completer_init_module(MR_Proc_Completer_Data *data)
+MR_trace_proc_spec_completer_init_module(MR_Proc_Completer_Data *data)
{
char *name;
size_t name_len;
@@ -977,7 +977,7 @@
} else {
complete_module = NULL;
}
- completion = MR_format_breakpoint_completion(data->MR_complete_pf,
+ completion = MR_format_proc_spec_completion(data->MR_complete_pf,
complete_module, proc_layout->MR_sle_user.MR_user_name);
} else {
completion = NULL;
@@ -1005,7 +1005,7 @@
}
static char *
-MR_format_breakpoint_completion(MR_PredFunc pred_or_func,
+MR_format_proc_spec_completion(MR_PredFunc pred_or_func,
const char *module, const char *name)
{
int size;
Index: trace/mercury_trace_tables.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_tables.h,v
retrieving revision 1.19
diff -u -b -r1.19 mercury_trace_tables.h
--- trace/mercury_trace_tables.h 28 Jul 2005 07:03:35 -0000 1.19
+++ trace/mercury_trace_tables.h 12 Aug 2005 09:41:13 -0000
@@ -215,7 +215,7 @@
/* A Readline completer for module names. */
extern MR_Completer_List *MR_trace_module_completer(const char *, size_t);
-/* A Readline completer for breakpoint specifications. */
-extern MR_Completer_List *MR_trace_breakpoint_completer(const char *, size_t);
+/* A Readline completer for procedure specifications. */
+extern MR_Completer_List *MR_trace_proc_spec_completer(const char *, size_t);
#endif /* not MERCURY_TRACE_TABLES_H */
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list