[m-rev.] for review: specify tabling extra arguments by address
Peter Wang
novalazy at gmail.com
Fri Nov 16 12:43:34 AEDT 2007
For your consideration.
Estimated hours taken: 3
Branches: main
Add an optional argument to the `specified' attribute of `pragma memo' that
allows the user to choose to table arguments introduced by the polymorphism
transformation by address instead of by value. e.g.
:- pragma memo(p/2, [specified([addr, output], hidden_arg_addr)]).
compiler/prog_io_pragma.m:
Accept the optional argument when parsing `pragma memo'.
Add some missing spaces in long error messages.
compiler/prog_data.m:
Hold the tabling method for hidden arguments when the `specified'
attribute is used.
compiler/table_gen.m:
Respect the hidden argument tabling method.
Allow typeclass_infos and base_typeclass_infos to be tabled by address
instead of aborting. The compiler still aborts if asked to table them
by value, as it's not yet implemented.
compiler/add_pragma.m:
compiler/hlds_out.m:
compiler/mercury_to_mercury.m:
Conform to the changes above.
doc/reference_manual.texi:
Add (currently commented out) documentation for the `hidden_arg_addr'
option.
tests/tabling/Mmakefile:
tests/tabling/specified_hidden_addr.exp:
tests/tabling/specified_hidden_addr.m:
tests/invalid/specified.err_exp:
tests/invalid/specified.m:
Add test cases.
Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.71
diff -u -r1.71 add_pragma.m
--- compiler/add_pragma.m 25 Sep 2007 04:56:37 -0000 1.71
+++ compiler/add_pragma.m 16 Nov 2007 01:24:18 -0000
@@ -2657,7 +2657,7 @@
Statistics = table_gather_statistics,
AllowReset = table_allow_reset
),
- ( Strictness = specified(MaybeArgMethods) ->
+ ( Strictness = specified(MaybeArgMethods, _HiddenArgMethod) ->
check_pred_args_against_tabling_methods(DeclaredArgModes,
MaybeArgMethods, !.ModuleInfo, 1, MaybeError)
;
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.437
diff -u -r1.437 hlds_out.m
--- compiler/hlds_out.m 12 Nov 2007 03:52:42 -0000 1.437
+++ compiler/hlds_out.m 16 Nov 2007 01:24:18 -0000
@@ -3676,11 +3676,17 @@
Strictness = all_fast_loose,
io.write_string("% all fast_loose\n", !IO)
;
- Strictness = specified(ArgMethods),
- write_arg_tabling_methods("", ArgMethods, !IO),
+ Strictness = specified(ArgMethods, HiddenArgMethod),
io.write_string("% specified [", !IO),
-
- io.write_string("]\n", !IO)
+ write_arg_tabling_methods("", ArgMethods, !IO),
+ io.write_string("]", !IO),
+ (
+ HiddenArgMethod = hidden_arg_value,
+ io.write_string("\n", !IO)
+ ;
+ HiddenArgMethod = hidden_arg_addr,
+ io.write_string(", hidden args by addr\n", !IO)
+ )
),
(
SizeLimit = no,
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.320
diff -u -r1.320 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 31 Oct 2007 03:58:26 -0000 1.320
+++ compiler/mercury_to_mercury.m 16 Nov 2007 01:24:18 -0000
@@ -628,11 +628,20 @@
Strictness = all_fast_loose,
!:Strs = ["fast_loose" | !.Strs]
;
- Strictness = specified(Args),
+ Strictness = specified(Args, HiddenArgMethod),
ArgStrs = list.map(maybe_arg_tabling_method_to_string,
Args),
ArgsStr = string.join_list(", ", ArgStrs),
- !:Strs = ["specified(" ++ ArgsStr ++ ")" | !.Strs]
+ (
+ HiddenArgMethod = hidden_arg_value,
+ HiddenArgStr = ""
+ ;
+ HiddenArgMethod = hidden_arg_addr,
+ HiddenArgStr = ", hidden_arg_addr"
+ ),
+ SpecifiedStr = "specified([" ++ ArgsStr ++ "]" ++
+ HiddenArgStr ++ ")",
+ !:Strs = [SpecifiedStr | !.Strs]
),
(
MaybeSizeLimit = yes(SizeLimit),
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.197
diff -u -r1.197 prog_data.m
--- compiler/prog_data.m 31 Oct 2007 03:58:29 -0000 1.197
+++ compiler/prog_data.m 16 Nov 2007 01:24:18 -0000
@@ -247,12 +247,16 @@
---> all_strict
; all_fast_loose
; specified(
- list(maybe(arg_tabling_method))
+ 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.
+
+ hidden_arg_tabling_method
+ % This specifies the tabling method for hidden arguments
+ % introduced by the compiler.
).
:- type arg_tabling_method
@@ -260,6 +264,10 @@
; arg_addr
; arg_promise_implied.
+:- type hidden_arg_tabling_method
+ ---> hidden_arg_value
+ ; hidden_arg_addr.
+
:- type table_io_is_decl
---> table_io_decl % The procedure is tabled for
% declarative debugging.
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.128
diff -u -r1.128 prog_io_pragma.m
--- compiler/prog_io_pragma.m 27 Aug 2007 06:22:14 -0000 1.128
+++ compiler/prog_io_pragma.m 16 Nov 2007 01:24:18 -0000
@@ -2262,7 +2262,7 @@
MaybeAttributes)
;
Msg = "duplicate argument tabling methods attribute"
- ++ "in `:- pragma memo' declaration",
+ ++ " in `:- pragma memo' declaration",
MaybeAttributes = error1([Msg - Term])
)
;
@@ -2273,7 +2273,7 @@
MaybeAttributes)
;
Msg = "duplicate size limits attribute"
- ++ "in `:- pragma memo' declaration",
+ ++ " in `:- pragma memo' declaration",
MaybeAttributes = error1([Msg - Term])
)
;
@@ -2288,7 +2288,7 @@
MaybeAttributes)
;
Msg = "duplicate statistics attribute"
- ++ "in `:- pragma memo' declaration",
+ ++ " in `:- pragma memo' declaration",
MaybeAttributes = error1([Msg - Term])
)
;
@@ -2300,7 +2300,7 @@
MaybeAttributes)
;
Msg = "duplicate allow_reset attribute"
- ++ "in `:- pragma memo' declaration",
+ ++ " in `:- pragma memo' declaration",
MaybeAttributes = error1([Msg - Term])
)
).
@@ -2323,14 +2323,35 @@
)
;
Functor = "specified",
- Args = [Arg],
- convert_list(Arg, parse_arg_tabling_method,
+ Args = [Arg1 | MoreArgs],
+ convert_list(Arg1, parse_arg_tabling_method,
"expected argument tabling method", MaybeMaybeArgMethods),
(
MaybeMaybeArgMethods = ok1(MaybeArgMethods),
( eval_method_allows_fast_loose(EvalMethod) = yes ->
- Attribute = attr_strictness(specified(MaybeArgMethods)),
- MaybeTermAttribute = ok1(Term - Attribute)
+ (
+ MoreArgs = [],
+ Attribute = attr_strictness(specified(MaybeArgMethods,
+ hidden_arg_value)),
+ MaybeTermAttribute = ok1(Term - Attribute)
+ ;
+ MoreArgs = [Arg2],
+ (
+ Arg2 = term.functor(
+ term.atom("hidden_arg_addr"), [], _)
+ ->
+ Attribute = attr_strictness(specified(MaybeArgMethods,
+ hidden_arg_addr)),
+ MaybeTermAttribute = ok1(Term - Attribute)
+ ;
+ Msg = "expected hidden argument tabling method",
+ MaybeTermAttribute = error1([Msg - Arg2])
+ )
+ ;
+ MoreArgs = [_, _ | _],
+ Msg = "expected fewer arguments",
+ MaybeTermAttribute = error1([Msg - Term])
+ )
;
Msg = "evaluation method " ++
eval_method_to_string(EvalMethod) ++
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.139
diff -u -r1.139 table_gen.m
--- compiler/table_gen.m 25 Sep 2007 04:56:42 -0000 1.139
+++ compiler/table_gen.m 16 Nov 2007 01:24:18 -0000
@@ -414,8 +414,8 @@
CallStrictness = all_fast_loose,
MaybeSpecMethod = all_same(arg_addr)
;
- CallStrictness = specified(ArgMethods),
- MaybeSpecMethod = specified(ArgMethods)
+ CallStrictness = specified(ArgMethods, HiddenArgMethod),
+ MaybeSpecMethod = specified(ArgMethods, HiddenArgMethod)
),
( EvalMethod = eval_minimal(_) ->
expect(unify(MaybeSizeLimit, no), this_file,
@@ -2420,6 +2420,28 @@
TypeCat = type_cat_variable
;
TypeCat = type_cat_user_ctor
+ ;
+ TypeCat = type_cat_typeclass_info,
+ (
+ ArgTablingMethod = arg_value,
+ unexpected(this_file,
+ "gen_lookup_call_for_type: typeclass_info_type")
+ ;
+ ( ArgTablingMethod = arg_addr
+ ; ArgTablingMethod = arg_promise_implied
+ )
+ )
+ ;
+ TypeCat = type_cat_base_typeclass_info,
+ (
+ ArgTablingMethod = arg_value,
+ unexpected(this_file,
+ "gen_lookup_call_for_type: base_typeclass_info_type")
+ ;
+ ( ArgTablingMethod = arg_addr
+ ; ArgTablingMethod = arg_promise_implied
+ )
+ )
),
type_vars(Type, TypeVars),
(
@@ -2469,13 +2491,6 @@
;
TypeCat = type_cat_void,
unexpected(this_file, "gen_lookup_call_for_type: void")
- ;
- TypeCat = type_cat_typeclass_info,
- unexpected(this_file, "gen_lookup_call_for_type: typeclass_info_type")
- ;
- TypeCat = type_cat_base_typeclass_info,
- unexpected(this_file,
- "gen_lookup_call_for_type: base_typeclass_info_type")
),
CodeStr = CodeStr0 ++ "\t" ++ cur_table_node_name ++ " = " ++
next_table_node_name ++ ";\n".
@@ -3178,7 +3193,10 @@
:- type maybe_specified_method
---> all_same(arg_tabling_method)
- ; specified(list(maybe(arg_tabling_method))).
+ ; specified(
+ list(maybe(arg_tabling_method)),
+ hidden_arg_tabling_method
+ ).
:- pred get_input_output_vars(list(prog_var)::in, list(mer_mode)::in,
module_info::in, maybe_specified_method::in, maybe_specified_method::out,
@@ -3197,7 +3215,7 @@
(
!.MaybeSpecMethod = all_same(ArgMethod)
;
- !.MaybeSpecMethod = specified(MaybeArgMethods0),
+ !.MaybeSpecMethod = specified(MaybeArgMethods0, HiddenArgMethod),
(
list.split_last(MaybeArgMethods0, MaybeArgMethods,
LastMaybeArgMethod)
@@ -3209,13 +3227,20 @@
unexpected(this_file,
"get_input_output_vars: bad method for input var")
),
- !:MaybeSpecMethod = specified(MaybeArgMethods)
+ !:MaybeSpecMethod = specified(MaybeArgMethods,
+ HiddenArgMethod)
;
% 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)
+ (
+ HiddenArgMethod = hidden_arg_value,
+ ArgMethod = arg_value
+ ;
+ HiddenArgMethod = hidden_arg_addr,
+ ArgMethod = arg_addr
+ ),
+ !:MaybeSpecMethod = all_same(ArgMethod)
)
),
InVarModes = [var_mode_method(Var, Mode, ArgMethod) | InVarModes0]
@@ -3228,19 +3253,27 @@
% to look up computed output arguments in them. The argument of
% all_same refers only to the treatment of input arguments.
;
- !.MaybeSpecMethod = specified(MaybeArgMethods0),
+ !.MaybeSpecMethod = specified(MaybeArgMethods0, HiddenArgMethod),
(
list.split_last(MaybeArgMethods0, MaybeArgMethods,
LastMaybeArgMethod)
->
expect(unify(LastMaybeArgMethod, no), this_file,
"get_input_output_vars: bad method for output var"),
- !:MaybeSpecMethod = specified(MaybeArgMethods)
+ !:MaybeSpecMethod = specified(MaybeArgMethods,
+ HiddenArgMethod)
;
% 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)
+ (
+ HiddenArgMethod = hidden_arg_value,
+ ArgMethod = arg_value
+ ;
+ HiddenArgMethod = hidden_arg_addr,
+ ArgMethod = arg_addr
+ ),
+ !:MaybeSpecMethod = all_same(ArgMethod)
)
),
OutVarModes = [var_mode_method(Var, Mode, arg_value) | OutVarModes0]
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.412
diff -u -r1.412 reference_manual.texi
--- doc/reference_manual.texi 8 Nov 2007 05:00:19 -0000 1.412
+++ doc/reference_manual.texi 16 Nov 2007 01:24:20 -0000
@@ -10195,6 +10195,12 @@
(It is ok for it to use the untabled argument
to decide what exception to throw.)
+ at c Experimental:
+ at c The @samp{specified} can additionally take an argument after the list,
+ at c which must be @samp{hidden_arg_addr}. If specified, extra arguments
+ at c introduced by the compiler will be tabled by address. Otherwise such
+ at c arguments are tabled by value.
+
If the tabled predicate or function has only one mode,
then this declaration can also be specified without giving the argument modes:
Index: tests/invalid/specified.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/specified.err_exp,v
retrieving revision 1.4
diff -u -r1.4 specified.err_exp
--- tests/invalid/specified.err_exp 7 Sep 2006 05:51:32 -0000 1.4
+++ tests/invalid/specified.err_exp 16 Nov 2007 01:24:21 -0000
@@ -1,4 +1,6 @@
specified.m:155: Error: expected argument tabling method: implied.
+specified.m:274: Error: expected fewer arguments: specified([addr, output], hidden_arg_addr, hidden_arg_addr).
+specified.m:282: Error: expected hidden argument tabling method: voodoo.
specified.m:138: Error in `pragma memo' declaration for predicate
specified.m:138: `specified.ap_lp_fib'/3:
specified.m:138: argument 3: argument tabling method `addr' is not compatible
Index: tests/invalid/specified.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/specified.m,v
retrieving revision 1.3
diff -u -r1.3 specified.m
--- tests/invalid/specified.m 8 Jun 2006 08:20:11 -0000 1.3
+++ tests/invalid/specified.m 16 Nov 2007 01:24:21 -0000
@@ -270,12 +270,16 @@
Num = digits_to_num_2(RevDigits).
:- func digits_to_num_2(list(int)) = int.
+:- pragma memo(digits_to_num_2/1,
+ [specified([addr, output], hidden_arg_addr, hidden_arg_addr)]).
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).
+:- pragma memo(num_to_digits/1,
+ [specified([value, output], voodoo)]).
num_to_digits(Int) = Digits :-
( Int < 10 ->
Index: tests/tabling/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/tabling/Mmakefile,v
retrieving revision 1.49
diff -u -r1.49 Mmakefile
--- tests/tabling/Mmakefile 9 Oct 2007 07:59:55 -0000 1.49
+++ tests/tabling/Mmakefile 16 Nov 2007 01:24:21 -0000
@@ -22,6 +22,7 @@
mercury_java_parser_dead_proc_elim_bug \
mercury_java_parser_dead_proc_elim_bug2 \
oota \
+ specified_hidden_arg \
table_foreign_output \
test_enum \
unused_args
Index: tests/tabling/specified_hidden_addr.exp
===================================================================
RCS file: tests/tabling/specified_hidden_addr.exp
diff -N tests/tabling/specified_hidden_addr.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/tabling/specified_hidden_addr.exp 16 Nov 2007 01:24:21 -0000
@@ -0,0 +1 @@
+{foo(246), foo(246)}
Index: tests/tabling/specified_hidden_addr.m
===================================================================
RCS file: tests/tabling/specified_hidden_addr.m
diff -N tests/tabling/specified_hidden_addr.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/tabling/specified_hidden_addr.m 16 Nov 2007 01:24:21 -0000
@@ -0,0 +1,43 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Test the hidden_arg_addr option in
+% :- pragma memo(..., [specified(...), hidden_arg_addr]).
+
+:- module specified_hidden_addr.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module int.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ p(foo(123), F1),
+ p(foo(123), F2),
+ io.write({F1, F2}, !IO),
+ io.nl(!IO).
+
+:- typeclass tc(T) where [
+ pred double(T::in, T::out) is det
+].
+
+:- type foo
+ ---> foo(int).
+
+:- instance tc(foo) where [
+ double(foo(F), foo(F + F))
+].
+
+:- pred p(T::in, T::out) is det <= tc(T).
+
+:- pragma memo(p/2,
+ [specified([value, output], hidden_arg_addr)]).
+
+p(F, G) :-
+ double(F, G).
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list